Last updated on 2020-02-19 10:49:00 CET.
| Flavor | Version | Tinstall | Tcheck | Ttotal | Status | Flags |
|---|---|---|---|---|---|---|
| r-devel-linux-x86_64-debian-clang | 2.0.1 | 70.05 | 68.65 | 138.70 | ERROR | |
| r-devel-linux-x86_64-debian-gcc | 2.0.1 | 61.82 | 55.32 | 117.14 | ERROR | |
| r-devel-linux-x86_64-fedora-clang | 2.0.1 | 182.01 | ERROR | |||
| r-devel-linux-x86_64-fedora-gcc | 2.0.1 | 195.36 | ERROR | |||
| r-devel-windows-ix86+x86_64 | 2.0.1 | 96.00 | 112.00 | 208.00 | OK | |
| r-devel-windows-ix86+x86_64-gcc8 | 2.0.1 | 152.00 | 152.00 | 304.00 | OK | |
| r-patched-linux-x86_64 | 2.0.1 | 65.98 | 66.18 | 132.16 | OK | |
| r-patched-solaris-x86 | 2.0.1 | 202.90 | OK | |||
| r-release-linux-x86_64 | 2.0.1 | 69.52 | 64.91 | 134.43 | OK | |
| r-release-windows-ix86+x86_64 | 2.0.1 | 102.00 | 106.00 | 208.00 | OK | |
| r-release-osx-x86_64 | 2.0.1 | NOTE | ||||
| r-oldrel-windows-ix86+x86_64 | 2.0.1 | 88.00 | 110.00 | 198.00 | OK | |
| r-oldrel-osx-x86_64 | 2.0.1 | NOTE |
Version: 2.0.1
Check: examples
Result: ERROR
Running examples in 'MM4LMM-Ex.R' failed
The error most likely occurred in:
> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: AnovaTest
> ### Title: Type I and Type III Tests for mixed models.
> ### Aliases: AnovaTest
> ### Keywords: Test
>
> ### ** Examples
>
> require('MM4LMM')
> data(QTLDetectionExample)
> Pheno <- QTLDetectionExample$Phenotype
> Geno <- QTLDetectionExample$Genotype
> Kinship <- QTLDetectionExample$Kinship
>
> ##Build the VarList object
> VL <- list(Additive = Kinship , Error = diag(1,length(Pheno)))
>
> ##Perform inference
> Result <- MMEst(Y=Pheno , X = Geno , VarList = VL)
----------- FAILURE REPORT --------------
--- failure: the condition has length > 1 ---
--- srcref ---
:
--- package (from environment) ---
MM4LMM
--- call from context ---
MMEst(Y = Pheno, X = Geno, VarList = VL)
--- call from argument ---
if (class(X) == "matrix") {
if (nrow(X) != Nind) {
stop("Incompatible dimension between Y and X")
}
} else {
if (class(X) == "list") {
invisible(mclapply(X, function(x) {
if (nrow(x) != Nind) {
stop("Incompatible dimension between Y and a matrix in the list X")
}
}, mc.cores = NbCores))
}
else {
stop("X should be a matrix or a list")
}
}
--- R stacktrace ---
where 1: MMEst(Y = Pheno, X = Geno, VarList = VL)
--- value of length: 2 type: logical ---
[1] TRUE FALSE
--- function from context ---
function (Y, Cofactor = NULL, X = NULL, formula = NULL, VarList,
ZList = NULL, Method = "Reml", Henderson = NULL, Init = NULL,
CritVar = 0.001, CritLogLik = 0.001, MaxIter = 100, NbCores = 1)
{
if (Sys.info()[["sysname"]] == "Windows") {
if (NbCores != 1) {
NbCores <- 1
message("NbCores > 1 is not supported on Windows (mclapply), NbCores is set to 1")
}
}
Nind <- length(Y)
if (is.null(Cofactor)) {
Cofactor <- matrix(rep(1, Nind), ncol = 1)
}
if (is.vector(Cofactor))
Cofactor <- matrix(Cofactor, ncol = 1)
if ((length(Cofactor) != 0) * (Nind != nrow(Cofactor))) {
stop("Incompatible dimension between Y and Cofactor")
}
if ((length(X) != 0)) {
if (class(X) == "matrix") {
if (nrow(X) != Nind) {
stop("Incompatible dimension between Y and X")
}
}
else {
if (class(X) == "list") {
invisible(mclapply(X, function(x) {
if (nrow(x) != Nind) {
stop("Incompatible dimension between Y and a matrix in the list X")
}
}, mc.cores = NbCores))
}
else {
stop("X should be a matrix or a list")
}
}
}
NbVar <- length(VarList)
NbZ <- length(ZList)
if ((NbVar != NbZ) * (NbZ > 0)) {
stop("Lists ZList and VarList should have the same number of elements")
}
if (!is.data.frame(Cofactor)) {
if (!is.matrix(Cofactor)) {
stop("Cofactor should be either a matrix or a data.frame")
}
else {
Cofactor <- as.data.frame(Cofactor)
names(Cofactor) <- colnames(Cofactor)
}
Names <- names(Cofactor)
if (is.null(Names)) {
names(Cofactor) <- paste0("Cof", 1:ncol(Cofactor))
}
else {
names(Cofactor) <- gsub("([[:punct:]])|\\s+", "",
Names)
}
}
CofName <- names(Cofactor)
if (!is.null(X)) {
if (is.matrix(X)) {
if (is.null(colnames(X)))
colnames(X) <- paste0("X", 1:ncol(X))
Xname <- "Xeffect"
}
else {
if (is.list(X)) {
if (is.null(colnames(X[[1]]))) {
Xname <- paste0("X", 1:ncol(X[[1]]))
}
else {
Xname <- colnames(X[[1]])
}
}
else {
stop("X should be either a matrix or a list.")
}
}
}
else {
Xname <- NULL
}
if (is.null(formula)) {
formulaCof <- as.formula(paste0("~", paste0(CofName,
collapse = "+")))
formulaComp <- as.formula(paste0("~", paste0(c(CofName,
Xname), collapse = "+")))
Factors <- c(CofName, Xname)
}
else {
SplitForm <- strsplit(as.character(formula), " \\+ ")
Factors <- SplitForm[[length(SplitForm)]]
WhatInX <- unique(unlist(sapply(Xname, function(n) grep(n,
Factors))))
if (length(WhatInX) != 0) {
formulaCof <- as.formula(paste0("~", Factors[-WhatInX],
collapse = "+"))
}
else {
formulaCof <- as.formula(paste0("~", Factors, collapse = "+"))
}
formulaComp <- formula
}
if ((length(Init) != 0) * (length(Init) != NbVar)) {
stop("The length of Init and the number of variance are not compatible")
}
if (NbVar == 1) {
if (NbZ > 0) {
Rdiag <- isDiagonal(ZList[[NbZ]]) && isDiagonal(VarList[[NbZ]])
if (Rdiag) {
Tmp <- diag(ZList[[1]])^2 * diag(VarList[[1]])
VarInv <- 1/VarList[[NbZ]]
logdetVar <- sum(log(Tmp))
}
else {
Tmp <- .sym_inverseRcpp(tcrossprod(tcrossprod(ZList[[1]],
VarList[[1]]), ZList[[1]]))
VarInv <- Tmp$inverse
logdetVar <- Tmp$log_det
}
}
else {
Tmp <- .sym_inverseRcpp(VarList[[1]])
VarInv <- Tmp$inverse
logdetVar <- Tmp$log_det
}
rm(Tmp)
NamesSigma <- names(VarList)
Res <- .MM_Reml1Mat(Y = Y, Cofactor = Cofactor, X = X,
formula = formulaComp, Factors = Factors, VarInv = VarInv,
logdetVar = logdetVar, NamesSigma = NamesSigma, NbCores = NbCores)
}
else {
DimVar <- sapply(1:(length(VarList) - 1), function(x) ncol(VarList[[x]]))
if (is.null(Henderson)) {
if (Method == "ML") {
Henderson <- FALSE
}
else {
Henderson <- FALSE
if ((length(Y) > sum(DimVar) + ncol(Cofactor)))
Henderson <- TRUE
}
}
if ((NbVar == 2) || (!Henderson) || (Method == "ML")) {
if (NbZ > 0) {
NamesVar <- names(VarList)
VarList <- mclapply(1:NbZ, function(x) {
Z <- ZList[[x]]
Var <- VarList[[x]]
if (ncol(Z) == nrow(Var)) {
if (nrow(Z) == Nind) {
return(tcrossprod(Z, tcrossprod(Z, Var)))
}
else {
stop("Incompatible dimensions between Y and ZList")
}
}
else {
stop("Incompatible dimensions between Zlist and VarList")
}
}, mc.cores = NbCores)
names(VarList) <- NamesVar
}
else {
invisible(lapply(1:length(VarList), function(x) {
if (nrow(VarList[[x]]) != Nind) {
stop(paste0("Incompatible dimensions between Y and VarList"))
}
}))
}
if (Method == "Reml") {
if (NbVar == 2) {
if (Henderson)
message("Henderson's trick is not implemented for 2 variance components, joint diagonalization trick is used")
InfMethod <- .MM_Reml2Mat
}
else {
InfMethod <- .MM_Reml
}
}
else {
if (Henderson)
message("Henderson's trick is not available for ML inference, classical MM is used")
if (NbVar == 2) {
InfMethod <- .MM_ML2Mat
}
else {
InfMethod <- .MM_ML
}
}
if (length(Init) == 0) {
Init <- rep(var(Y)/NbVar, NbVar)
if (!is.null(X)) {
Res <- InfMethod(Y = Y, Cofactor = Cofactor,
X = NULL, formula = formulaCof, Factors = Factors,
VarList = VarList, Init = Init, CritVar = CritVar,
CritLogLik = CritLogLik, MaxIter = MaxIter,
NbCores = 1)
Init <- Res[[1]]$Sigma
}
}
Res <- InfMethod(Y = Y, Cofactor = Cofactor, X = X,
formula = formulaComp, Factors = Factors, VarList = VarList,
Init = Init, CritVar = CritVar, CritLogLik = CritLogLik,
MaxIter = MaxIter, NbCores = NbCores)
}
else {
invisible(sapply(1:NbZ, function(x) {
if (ncol(ZList[[x]]) != nrow(VarList[[x]])) stop("Incompatible dimensions between Zlist and VarList")
if (nrow(ZList[[x]]) != length(Y)) stop("Incompatible dimensions between Y and ZList")
}))
Rdiag <- isDiagonal(ZList[[NbZ]]) && isDiagonal(VarList[[NbZ]])
if (Rdiag) {
VarList[[NbZ]] <- diag(ZList[[NbZ]])^2 * diag(VarList[[NbZ]])
Rinv <- 1/VarList[[NbZ]]
Tmp <- mclapply(1:(NbZ - 1), function(x) .sym_inverseRcpp(VarList[[x]]),
mc.cores = NbCores)
GinvList <- lapply(Tmp, function(x) x$inverse)
logdetV <- c(sapply(Tmp, function(x) x$log_det),
sum(log(VarList[[NbZ]])))
rm(Tmp)
GList <- VarList
NamesVar <- names(VarList)
logdetV <- c(logdetV, sum(log(VarList[[NbZ]])))
rm(VarList)
InfMethod <- .MM_RemlHenDiag
}
else {
VarList[[NbZ]] <- tcrossprod(tcrossprod(ZList[[NbZ]],
VarList[[NbZ]]), ZList[[NbZ]])
Tmp <- mclapply(VarList, function(x) .sym_inverseRcpp(x),
mc.cores = NbCores)
Varinv <- lapply(Tmp, function(x) x$inverse)
logdetV <- sapply(Tmp, function(x) x$log_det)
Rinv <- Varinv[[length(Varinv)]]
GinvList <- lapply(1:(length(Varinv) - 1), function(x) Varinv[[x]])
rm(Varinv)
GList <- VarList
NamesVar <- names(VarList)
rm(VarList)
rm(Tmp)
InfMethod <- .MM_RemlHen
}
Zg = Reduce(cbind, lapply(1:(length(ZList) - 1),
function(x) ZList[[x]]))
if (length(Init) == 0) {
Init <- rep(var(Y)/NbVar, NbVar)
if (!is.null(X)) {
Res <- InfMethod(Y = Y, Cofactor = Cofactor,
X = NULL, formula = formulaCof, Factors = Factors,
Z = Zg, GList = GList, GinvList = GinvList,
Rinv = Rinv, logdetV = logdetV, NameVar = NamesVar,
Init = Init, CritVar = CritVar, CritLogLik = CritLogLik,
MaxIter = MaxIter, NbCores = 1)
Init <- Res[[1]]$Sigma2
}
}
Res <- InfMethod(Y = Y, Cofactor = Cofactor, X = X,
formula = formulaComp, Factors = Factors, Z = Zg,
GList = GList, GinvList = GinvList, Rinv = Rinv,
logdetV = logdetV, NameVar = NamesVar, Init = Init,
CritVar = CritVar, CritLogLik = CritLogLik, MaxIter = MaxIter,
NbCores = NbCores)
}
}
return(Res)
}
<bytecode: 0xc6b8f78>
<environment: namespace:MM4LMM>
--- function search by body ---
Function MMEst in namespace MM4LMM has this body.
----------- END OF FAILURE REPORT --------------
Error in if (class(X) == "matrix") { : the condition has length > 1
Calls: MMEst
Execution halted
Flavor: r-devel-linux-x86_64-debian-clang
Version: 2.0.1
Check: examples
Result: ERROR
Running examples in ‘MM4LMM-Ex.R’ failed
The error most likely occurred in:
> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: AnovaTest
> ### Title: Type I and Type III Tests for mixed models.
> ### Aliases: AnovaTest
> ### Keywords: Test
>
> ### ** Examples
>
> require('MM4LMM')
> data(QTLDetectionExample)
> Pheno <- QTLDetectionExample$Phenotype
> Geno <- QTLDetectionExample$Genotype
> Kinship <- QTLDetectionExample$Kinship
>
> ##Build the VarList object
> VL <- list(Additive = Kinship , Error = diag(1,length(Pheno)))
>
> ##Perform inference
> Result <- MMEst(Y=Pheno , X = Geno , VarList = VL)
----------- FAILURE REPORT --------------
--- failure: the condition has length > 1 ---
--- srcref ---
:
--- package (from environment) ---
MM4LMM
--- call from context ---
MMEst(Y = Pheno, X = Geno, VarList = VL)
--- call from argument ---
if (class(X) == "matrix") {
if (nrow(X) != Nind) {
stop("Incompatible dimension between Y and X")
}
} else {
if (class(X) == "list") {
invisible(mclapply(X, function(x) {
if (nrow(x) != Nind) {
stop("Incompatible dimension between Y and a matrix in the list X")
}
}, mc.cores = NbCores))
}
else {
stop("X should be a matrix or a list")
}
}
--- R stacktrace ---
where 1: MMEst(Y = Pheno, X = Geno, VarList = VL)
--- value of length: 2 type: logical ---
[1] TRUE FALSE
--- function from context ---
function (Y, Cofactor = NULL, X = NULL, formula = NULL, VarList,
ZList = NULL, Method = "Reml", Henderson = NULL, Init = NULL,
CritVar = 0.001, CritLogLik = 0.001, MaxIter = 100, NbCores = 1)
{
if (Sys.info()[["sysname"]] == "Windows") {
if (NbCores != 1) {
NbCores <- 1
message("NbCores > 1 is not supported on Windows (mclapply), NbCores is set to 1")
}
}
Nind <- length(Y)
if (is.null(Cofactor)) {
Cofactor <- matrix(rep(1, Nind), ncol = 1)
}
if (is.vector(Cofactor))
Cofactor <- matrix(Cofactor, ncol = 1)
if ((length(Cofactor) != 0) * (Nind != nrow(Cofactor))) {
stop("Incompatible dimension between Y and Cofactor")
}
if ((length(X) != 0)) {
if (class(X) == "matrix") {
if (nrow(X) != Nind) {
stop("Incompatible dimension between Y and X")
}
}
else {
if (class(X) == "list") {
invisible(mclapply(X, function(x) {
if (nrow(x) != Nind) {
stop("Incompatible dimension between Y and a matrix in the list X")
}
}, mc.cores = NbCores))
}
else {
stop("X should be a matrix or a list")
}
}
}
NbVar <- length(VarList)
NbZ <- length(ZList)
if ((NbVar != NbZ) * (NbZ > 0)) {
stop("Lists ZList and VarList should have the same number of elements")
}
if (!is.data.frame(Cofactor)) {
if (!is.matrix(Cofactor)) {
stop("Cofactor should be either a matrix or a data.frame")
}
else {
Cofactor <- as.data.frame(Cofactor)
names(Cofactor) <- colnames(Cofactor)
}
Names <- names(Cofactor)
if (is.null(Names)) {
names(Cofactor) <- paste0("Cof", 1:ncol(Cofactor))
}
else {
names(Cofactor) <- gsub("([[:punct:]])|\\s+", "",
Names)
}
}
CofName <- names(Cofactor)
if (!is.null(X)) {
if (is.matrix(X)) {
if (is.null(colnames(X)))
colnames(X) <- paste0("X", 1:ncol(X))
Xname <- "Xeffect"
}
else {
if (is.list(X)) {
if (is.null(colnames(X[[1]]))) {
Xname <- paste0("X", 1:ncol(X[[1]]))
}
else {
Xname <- colnames(X[[1]])
}
}
else {
stop("X should be either a matrix or a list.")
}
}
}
else {
Xname <- NULL
}
if (is.null(formula)) {
formulaCof <- as.formula(paste0("~", paste0(CofName,
collapse = "+")))
formulaComp <- as.formula(paste0("~", paste0(c(CofName,
Xname), collapse = "+")))
Factors <- c(CofName, Xname)
}
else {
SplitForm <- strsplit(as.character(formula), " \\+ ")
Factors <- SplitForm[[length(SplitForm)]]
WhatInX <- unique(unlist(sapply(Xname, function(n) grep(n,
Factors))))
if (length(WhatInX) != 0) {
formulaCof <- as.formula(paste0("~", Factors[-WhatInX],
collapse = "+"))
}
else {
formulaCof <- as.formula(paste0("~", Factors, collapse = "+"))
}
formulaComp <- formula
}
if ((length(Init) != 0) * (length(Init) != NbVar)) {
stop("The length of Init and the number of variance are not compatible")
}
if (NbVar == 1) {
if (NbZ > 0) {
Rdiag <- isDiagonal(ZList[[NbZ]]) && isDiagonal(VarList[[NbZ]])
if (Rdiag) {
Tmp <- diag(ZList[[1]])^2 * diag(VarList[[1]])
VarInv <- 1/VarList[[NbZ]]
logdetVar <- sum(log(Tmp))
}
else {
Tmp <- .sym_inverseRcpp(tcrossprod(tcrossprod(ZList[[1]],
VarList[[1]]), ZList[[1]]))
VarInv <- Tmp$inverse
logdetVar <- Tmp$log_det
}
}
else {
Tmp <- .sym_inverseRcpp(VarList[[1]])
VarInv <- Tmp$inverse
logdetVar <- Tmp$log_det
}
rm(Tmp)
NamesSigma <- names(VarList)
Res <- .MM_Reml1Mat(Y = Y, Cofactor = Cofactor, X = X,
formula = formulaComp, Factors = Factors, VarInv = VarInv,
logdetVar = logdetVar, NamesSigma = NamesSigma, NbCores = NbCores)
}
else {
DimVar <- sapply(1:(length(VarList) - 1), function(x) ncol(VarList[[x]]))
if (is.null(Henderson)) {
if (Method == "ML") {
Henderson <- FALSE
}
else {
Henderson <- FALSE
if ((length(Y) > sum(DimVar) + ncol(Cofactor)))
Henderson <- TRUE
}
}
if ((NbVar == 2) || (!Henderson) || (Method == "ML")) {
if (NbZ > 0) {
NamesVar <- names(VarList)
VarList <- mclapply(1:NbZ, function(x) {
Z <- ZList[[x]]
Var <- VarList[[x]]
if (ncol(Z) == nrow(Var)) {
if (nrow(Z) == Nind) {
return(tcrossprod(Z, tcrossprod(Z, Var)))
}
else {
stop("Incompatible dimensions between Y and ZList")
}
}
else {
stop("Incompatible dimensions between Zlist and VarList")
}
}, mc.cores = NbCores)
names(VarList) <- NamesVar
}
else {
invisible(lapply(1:length(VarList), function(x) {
if (nrow(VarList[[x]]) != Nind) {
stop(paste0("Incompatible dimensions between Y and VarList"))
}
}))
}
if (Method == "Reml") {
if (NbVar == 2) {
if (Henderson)
message("Henderson's trick is not implemented for 2 variance components, joint diagonalization trick is used")
InfMethod <- .MM_Reml2Mat
}
else {
InfMethod <- .MM_Reml
}
}
else {
if (Henderson)
message("Henderson's trick is not available for ML inference, classical MM is used")
if (NbVar == 2) {
InfMethod <- .MM_ML2Mat
}
else {
InfMethod <- .MM_ML
}
}
if (length(Init) == 0) {
Init <- rep(var(Y)/NbVar, NbVar)
if (!is.null(X)) {
Res <- InfMethod(Y = Y, Cofactor = Cofactor,
X = NULL, formula = formulaCof, Factors = Factors,
VarList = VarList, Init = Init, CritVar = CritVar,
CritLogLik = CritLogLik, MaxIter = MaxIter,
NbCores = 1)
Init <- Res[[1]]$Sigma
}
}
Res <- InfMethod(Y = Y, Cofactor = Cofactor, X = X,
formula = formulaComp, Factors = Factors, VarList = VarList,
Init = Init, CritVar = CritVar, CritLogLik = CritLogLik,
MaxIter = MaxIter, NbCores = NbCores)
}
else {
invisible(sapply(1:NbZ, function(x) {
if (ncol(ZList[[x]]) != nrow(VarList[[x]])) stop("Incompatible dimensions between Zlist and VarList")
if (nrow(ZList[[x]]) != length(Y)) stop("Incompatible dimensions between Y and ZList")
}))
Rdiag <- isDiagonal(ZList[[NbZ]]) && isDiagonal(VarList[[NbZ]])
if (Rdiag) {
VarList[[NbZ]] <- diag(ZList[[NbZ]])^2 * diag(VarList[[NbZ]])
Rinv <- 1/VarList[[NbZ]]
Tmp <- mclapply(1:(NbZ - 1), function(x) .sym_inverseRcpp(VarList[[x]]),
mc.cores = NbCores)
GinvList <- lapply(Tmp, function(x) x$inverse)
logdetV <- c(sapply(Tmp, function(x) x$log_det),
sum(log(VarList[[NbZ]])))
rm(Tmp)
GList <- VarList
NamesVar <- names(VarList)
logdetV <- c(logdetV, sum(log(VarList[[NbZ]])))
rm(VarList)
InfMethod <- .MM_RemlHenDiag
}
else {
VarList[[NbZ]] <- tcrossprod(tcrossprod(ZList[[NbZ]],
VarList[[NbZ]]), ZList[[NbZ]])
Tmp <- mclapply(VarList, function(x) .sym_inverseRcpp(x),
mc.cores = NbCores)
Varinv <- lapply(Tmp, function(x) x$inverse)
logdetV <- sapply(Tmp, function(x) x$log_det)
Rinv <- Varinv[[length(Varinv)]]
GinvList <- lapply(1:(length(Varinv) - 1), function(x) Varinv[[x]])
rm(Varinv)
GList <- VarList
NamesVar <- names(VarList)
rm(VarList)
rm(Tmp)
InfMethod <- .MM_RemlHen
}
Zg = Reduce(cbind, lapply(1:(length(ZList) - 1),
function(x) ZList[[x]]))
if (length(Init) == 0) {
Init <- rep(var(Y)/NbVar, NbVar)
if (!is.null(X)) {
Res <- InfMethod(Y = Y, Cofactor = Cofactor,
X = NULL, formula = formulaCof, Factors = Factors,
Z = Zg, GList = GList, GinvList = GinvList,
Rinv = Rinv, logdetV = logdetV, NameVar = NamesVar,
Init = Init, CritVar = CritVar, CritLogLik = CritLogLik,
MaxIter = MaxIter, NbCores = 1)
Init <- Res[[1]]$Sigma2
}
}
Res <- InfMethod(Y = Y, Cofactor = Cofactor, X = X,
formula = formulaComp, Factors = Factors, Z = Zg,
GList = GList, GinvList = GinvList, Rinv = Rinv,
logdetV = logdetV, NameVar = NamesVar, Init = Init,
CritVar = CritVar, CritLogLik = CritLogLik, MaxIter = MaxIter,
NbCores = NbCores)
}
}
return(Res)
}
<bytecode: 0x560c254b6240>
<environment: namespace:MM4LMM>
--- function search by body ---
Function MMEst in namespace MM4LMM has this body.
----------- END OF FAILURE REPORT --------------
Error in if (class(X) == "matrix") { : the condition has length > 1
Calls: MMEst
Execution halted
Flavor: r-devel-linux-x86_64-debian-gcc
Version: 2.0.1
Check: installed package size
Result: NOTE
installed size is 19.9Mb
sub-directories of 1Mb or more:
libs 19.3Mb
Flavors: r-devel-linux-x86_64-fedora-clang, r-release-osx-x86_64, r-oldrel-osx-x86_64
Version: 2.0.1
Check: examples
Result: ERROR
Running examples in ‘MM4LMM-Ex.R’ failed
The error most likely occurred in:
> ### Name: AnovaTest
> ### Title: Type I and Type III Tests for mixed models.
> ### Aliases: AnovaTest
> ### Keywords: Test
>
> ### ** Examples
>
> require('MM4LMM')
> data(QTLDetectionExample)
> Pheno <- QTLDetectionExample$Phenotype
> Geno <- QTLDetectionExample$Genotype
> Kinship <- QTLDetectionExample$Kinship
>
> ##Build the VarList object
> VL <- list(Additive = Kinship , Error = diag(1,length(Pheno)))
>
> ##Perform inference
> Result <- MMEst(Y=Pheno , X = Geno , VarList = VL)
----------- FAILURE REPORT --------------
--- failure: the condition has length > 1 ---
--- srcref ---
:
--- package (from environment) ---
MM4LMM
--- call from context ---
MMEst(Y = Pheno, X = Geno, VarList = VL)
--- call from argument ---
if (class(X) == "matrix") {
if (nrow(X) != Nind) {
stop("Incompatible dimension between Y and X")
}
} else {
if (class(X) == "list") {
invisible(mclapply(X, function(x) {
if (nrow(x) != Nind) {
stop("Incompatible dimension between Y and a matrix in the list X")
}
}, mc.cores = NbCores))
}
else {
stop("X should be a matrix or a list")
}
}
--- R stacktrace ---
where 1: MMEst(Y = Pheno, X = Geno, VarList = VL)
--- value of length: 2 type: logical ---
[1] TRUE FALSE
--- function from context ---
function (Y, Cofactor = NULL, X = NULL, formula = NULL, VarList,
ZList = NULL, Method = "Reml", Henderson = NULL, Init = NULL,
CritVar = 0.001, CritLogLik = 0.001, MaxIter = 100, NbCores = 1)
{
if (Sys.info()[["sysname"]] == "Windows") {
if (NbCores != 1) {
NbCores <- 1
message("NbCores > 1 is not supported on Windows (mclapply), NbCores is set to 1")
}
}
Nind <- length(Y)
if (is.null(Cofactor)) {
Cofactor <- matrix(rep(1, Nind), ncol = 1)
}
if (is.vector(Cofactor))
Cofactor <- matrix(Cofactor, ncol = 1)
if ((length(Cofactor) != 0) * (Nind != nrow(Cofactor))) {
stop("Incompatible dimension between Y and Cofactor")
}
if ((length(X) != 0)) {
if (class(X) == "matrix") {
if (nrow(X) != Nind) {
stop("Incompatible dimension between Y and X")
}
}
else {
if (class(X) == "list") {
invisible(mclapply(X, function(x) {
if (nrow(x) != Nind) {
stop("Incompatible dimension between Y and a matrix in the list X")
}
}, mc.cores = NbCores))
}
else {
stop("X should be a matrix or a list")
}
}
}
NbVar <- length(VarList)
NbZ <- length(ZList)
if ((NbVar != NbZ) * (NbZ > 0)) {
stop("Lists ZList and VarList should have the same number of elements")
}
if (!is.data.frame(Cofactor)) {
if (!is.matrix(Cofactor)) {
stop("Cofactor should be either a matrix or a data.frame")
}
else {
Cofactor <- as.data.frame(Cofactor)
names(Cofactor) <- colnames(Cofactor)
}
Names <- names(Cofactor)
if (is.null(Names)) {
names(Cofactor) <- paste0("Cof", 1:ncol(Cofactor))
}
else {
names(Cofactor) <- gsub("([[:punct:]])|\\s+", "",
Names)
}
}
CofName <- names(Cofactor)
if (!is.null(X)) {
if (is.matrix(X)) {
if (is.null(colnames(X)))
colnames(X) <- paste0("X", 1:ncol(X))
Xname <- "Xeffect"
}
else {
if (is.list(X)) {
if (is.null(colnames(X[[1]]))) {
Xname <- paste0("X", 1:ncol(X[[1]]))
}
else {
Xname <- colnames(X[[1]])
}
}
else {
stop("X should be either a matrix or a list.")
}
}
}
else {
Xname <- NULL
}
if (is.null(formula)) {
formulaCof <- as.formula(paste0("~", paste0(CofName,
collapse = "+")))
formulaComp <- as.formula(paste0("~", paste0(c(CofName,
Xname), collapse = "+")))
Factors <- c(CofName, Xname)
}
else {
SplitForm <- strsplit(as.character(formula), " \\+ ")
Factors <- SplitForm[[length(SplitForm)]]
WhatInX <- unique(unlist(sapply(Xname, function(n) grep(n,
Factors))))
if (length(WhatInX) != 0) {
formulaCof <- as.formula(paste0("~", Factors[-WhatInX],
collapse = "+"))
}
else {
formulaCof <- as.formula(paste0("~", Factors, collapse = "+"))
}
formulaComp <- formula
}
if ((length(Init) != 0) * (length(Init) != NbVar)) {
stop("The length of Init and the number of variance are not compatible")
}
if (NbVar == 1) {
if (NbZ > 0) {
Rdiag <- isDiagonal(ZList[[NbZ]]) && isDiagonal(VarList[[NbZ]])
if (Rdiag) {
Tmp <- diag(ZList[[1]])^2 * diag(VarList[[1]])
VarInv <- 1/VarList[[NbZ]]
logdetVar <- sum(log(Tmp))
}
else {
Tmp <- .sym_inverseRcpp(tcrossprod(tcrossprod(ZList[[1]],
VarList[[1]]), ZList[[1]]))
VarInv <- Tmp$inverse
logdetVar <- Tmp$log_det
}
}
else {
Tmp <- .sym_inverseRcpp(VarList[[1]])
VarInv <- Tmp$inverse
logdetVar <- Tmp$log_det
}
rm(Tmp)
NamesSigma <- names(VarList)
Res <- .MM_Reml1Mat(Y = Y, Cofactor = Cofactor, X = X,
formula = formulaComp, Factors = Factors, VarInv = VarInv,
logdetVar = logdetVar, NamesSigma = NamesSigma, NbCores = NbCores)
}
else {
DimVar <- sapply(1:(length(VarList) - 1), function(x) ncol(VarList[[x]]))
if (is.null(Henderson)) {
if (Method == "ML") {
Henderson <- FALSE
}
else {
Henderson <- FALSE
if ((length(Y) > sum(DimVar) + ncol(Cofactor)))
Henderson <- TRUE
}
}
if ((NbVar == 2) || (!Henderson) || (Method == "ML")) {
if (NbZ > 0) {
NamesVar <- names(VarList)
VarList <- mclapply(1:NbZ, function(x) {
Z <- ZList[[x]]
Var <- VarList[[x]]
if (ncol(Z) == nrow(Var)) {
if (nrow(Z) == Nind) {
return(tcrossprod(Z, tcrossprod(Z, Var)))
}
else {
stop("Incompatible dimensions between Y and ZList")
}
}
else {
stop("Incompatible dimensions between Zlist and VarList")
}
}, mc.cores = NbCores)
names(VarList) <- NamesVar
}
else {
invisible(lapply(1:length(VarList), function(x) {
if (nrow(VarList[[x]]) != Nind) {
stop(paste0("Incompatible dimensions between Y and VarList"))
}
}))
}
if (Method == "Reml") {
if (NbVar == 2) {
if (Henderson)
message("Henderson's trick is not implemented for 2 variance components, joint diagonalization trick is used")
InfMethod <- .MM_Reml2Mat
}
else {
InfMethod <- .MM_Reml
}
}
else {
if (Henderson)
message("Henderson's trick is not available for ML inference, classical MM is used")
if (NbVar == 2) {
InfMethod <- .MM_ML2Mat
}
else {
InfMethod <- .MM_ML
}
}
if (length(Init) == 0) {
Init <- rep(var(Y)/NbVar, NbVar)
if (!is.null(X)) {
Res <- InfMethod(Y = Y, Cofactor = Cofactor,
X = NULL, formula = formulaCof, Factors = Factors,
VarList = VarList, Init = Init, CritVar = CritVar,
CritLogLik = CritLogLik, MaxIter = MaxIter,
NbCores = 1)
Init <- Res[[1]]$Sigma
}
}
Res <- InfMethod(Y = Y, Cofactor = Cofactor, X = X,
formula = formulaComp, Factors = Factors, VarList = VarList,
Init = Init, CritVar = CritVar, CritLogLik = CritLogLik,
MaxIter = MaxIter, NbCores = NbCores)
}
else {
invisible(sapply(1:NbZ, function(x) {
if (ncol(ZList[[x]]) != nrow(VarList[[x]])) stop("Incompatible dimensions between Zlist and VarList")
if (nrow(ZList[[x]]) != length(Y)) stop("Incompatible dimensions between Y and ZList")
}))
Rdiag <- isDiagonal(ZList[[NbZ]]) && isDiagonal(VarList[[NbZ]])
if (Rdiag) {
VarList[[NbZ]] <- diag(ZList[[NbZ]])^2 * diag(VarList[[NbZ]])
Rinv <- 1/VarList[[NbZ]]
Tmp <- mclapply(1:(NbZ - 1), function(x) .sym_inverseRcpp(VarList[[x]]),
mc.cores = NbCores)
GinvList <- lapply(Tmp, function(x) x$inverse)
logdetV <- c(sapply(Tmp, function(x) x$log_det),
sum(log(VarList[[NbZ]])))
rm(Tmp)
GList <- VarList
NamesVar <- names(VarList)
logdetV <- c(logdetV, sum(log(VarList[[NbZ]])))
rm(VarList)
InfMethod <- .MM_RemlHenDiag
}
else {
VarList[[NbZ]] <- tcrossprod(tcrossprod(ZList[[NbZ]],
VarList[[NbZ]]), ZList[[NbZ]])
Tmp <- mclapply(VarList, function(x) .sym_inverseRcpp(x),
mc.cores = NbCores)
Varinv <- lapply(Tmp, function(x) x$inverse)
logdetV <- sapply(Tmp, function(x) x$log_det)
Rinv <- Varinv[[length(Varinv)]]
GinvList <- lapply(1:(length(Varinv) - 1), function(x) Varinv[[x]])
rm(Varinv)
GList <- VarList
NamesVar <- names(VarList)
rm(VarList)
rm(Tmp)
InfMethod <- .MM_RemlHen
}
Zg = Reduce(cbind, lapply(1:(length(ZList) - 1),
function(x) ZList[[x]]))
if (length(Init) == 0) {
Init <- rep(var(Y)/NbVar, NbVar)
if (!is.null(X)) {
Res <- InfMethod(Y = Y, Cofactor = Cofactor,
X = NULL, formula = formulaCof, Factors = Factors,
Z = Zg, GList = GList, GinvList = GinvList,
Rinv = Rinv, logdetV = logdetV, NameVar = NamesVar,
Init = Init, CritVar = CritVar, CritLogLik = CritLogLik,
MaxIter = MaxIter, NbCores = 1)
Init <- Res[[1]]$Sigma2
}
}
Res <- InfMethod(Y = Y, Cofactor = Cofactor, X = X,
formula = formulaComp, Factors = Factors, Z = Zg,
GList = GList, GinvList = GinvList, Rinv = Rinv,
logdetV = logdetV, NameVar = NamesVar, Init = Init,
CritVar = CritVar, CritLogLik = CritLogLik, MaxIter = MaxIter,
NbCores = NbCores)
}
}
return(Res)
}
<bytecode: 0xdb6a608>
<environment: namespace:MM4LMM>
--- function search by body ---
Function MMEst in namespace MM4LMM has this body.
----------- END OF FAILURE REPORT --------------
Error in if (class(X) == "matrix") { : the condition has length > 1
Calls: MMEst
Execution halted
Flavor: r-devel-linux-x86_64-fedora-clang
Version: 2.0.1
Check: examples
Result: ERROR
Running examples in ‘MM4LMM-Ex.R’ failed
The error most likely occurred in:
> ### Name: AnovaTest
> ### Title: Type I and Type III Tests for mixed models.
> ### Aliases: AnovaTest
> ### Keywords: Test
>
> ### ** Examples
>
> require('MM4LMM')
> data(QTLDetectionExample)
> Pheno <- QTLDetectionExample$Phenotype
> Geno <- QTLDetectionExample$Genotype
> Kinship <- QTLDetectionExample$Kinship
>
> ##Build the VarList object
> VL <- list(Additive = Kinship , Error = diag(1,length(Pheno)))
>
> ##Perform inference
> Result <- MMEst(Y=Pheno , X = Geno , VarList = VL)
----------- FAILURE REPORT --------------
--- failure: the condition has length > 1 ---
--- srcref ---
:
--- package (from environment) ---
MM4LMM
--- call from context ---
MMEst(Y = Pheno, X = Geno, VarList = VL)
--- call from argument ---
if (class(X) == "matrix") {
if (nrow(X) != Nind) {
stop("Incompatible dimension between Y and X")
}
} else {
if (class(X) == "list") {
invisible(mclapply(X, function(x) {
if (nrow(x) != Nind) {
stop("Incompatible dimension between Y and a matrix in the list X")
}
}, mc.cores = NbCores))
}
else {
stop("X should be a matrix or a list")
}
}
--- R stacktrace ---
where 1: MMEst(Y = Pheno, X = Geno, VarList = VL)
--- value of length: 2 type: logical ---
[1] TRUE FALSE
--- function from context ---
function (Y, Cofactor = NULL, X = NULL, formula = NULL, VarList,
ZList = NULL, Method = "Reml", Henderson = NULL, Init = NULL,
CritVar = 0.001, CritLogLik = 0.001, MaxIter = 100, NbCores = 1)
{
if (Sys.info()[["sysname"]] == "Windows") {
if (NbCores != 1) {
NbCores <- 1
message("NbCores > 1 is not supported on Windows (mclapply), NbCores is set to 1")
}
}
Nind <- length(Y)
if (is.null(Cofactor)) {
Cofactor <- matrix(rep(1, Nind), ncol = 1)
}
if (is.vector(Cofactor))
Cofactor <- matrix(Cofactor, ncol = 1)
if ((length(Cofactor) != 0) * (Nind != nrow(Cofactor))) {
stop("Incompatible dimension between Y and Cofactor")
}
if ((length(X) != 0)) {
if (class(X) == "matrix") {
if (nrow(X) != Nind) {
stop("Incompatible dimension between Y and X")
}
}
else {
if (class(X) == "list") {
invisible(mclapply(X, function(x) {
if (nrow(x) != Nind) {
stop("Incompatible dimension between Y and a matrix in the list X")
}
}, mc.cores = NbCores))
}
else {
stop("X should be a matrix or a list")
}
}
}
NbVar <- length(VarList)
NbZ <- length(ZList)
if ((NbVar != NbZ) * (NbZ > 0)) {
stop("Lists ZList and VarList should have the same number of elements")
}
if (!is.data.frame(Cofactor)) {
if (!is.matrix(Cofactor)) {
stop("Cofactor should be either a matrix or a data.frame")
}
else {
Cofactor <- as.data.frame(Cofactor)
names(Cofactor) <- colnames(Cofactor)
}
Names <- names(Cofactor)
if (is.null(Names)) {
names(Cofactor) <- paste0("Cof", 1:ncol(Cofactor))
}
else {
names(Cofactor) <- gsub("([[:punct:]])|\\s+", "",
Names)
}
}
CofName <- names(Cofactor)
if (!is.null(X)) {
if (is.matrix(X)) {
if (is.null(colnames(X)))
colnames(X) <- paste0("X", 1:ncol(X))
Xname <- "Xeffect"
}
else {
if (is.list(X)) {
if (is.null(colnames(X[[1]]))) {
Xname <- paste0("X", 1:ncol(X[[1]]))
}
else {
Xname <- colnames(X[[1]])
}
}
else {
stop("X should be either a matrix or a list.")
}
}
}
else {
Xname <- NULL
}
if (is.null(formula)) {
formulaCof <- as.formula(paste0("~", paste0(CofName,
collapse = "+")))
formulaComp <- as.formula(paste0("~", paste0(c(CofName,
Xname), collapse = "+")))
Factors <- c(CofName, Xname)
}
else {
SplitForm <- strsplit(as.character(formula), " \\+ ")
Factors <- SplitForm[[length(SplitForm)]]
WhatInX <- unique(unlist(sapply(Xname, function(n) grep(n,
Factors))))
if (length(WhatInX) != 0) {
formulaCof <- as.formula(paste0("~", Factors[-WhatInX],
collapse = "+"))
}
else {
formulaCof <- as.formula(paste0("~", Factors, collapse = "+"))
}
formulaComp <- formula
}
if ((length(Init) != 0) * (length(Init) != NbVar)) {
stop("The length of Init and the number of variance are not compatible")
}
if (NbVar == 1) {
if (NbZ > 0) {
Rdiag <- isDiagonal(ZList[[NbZ]]) && isDiagonal(VarList[[NbZ]])
if (Rdiag) {
Tmp <- diag(ZList[[1]])^2 * diag(VarList[[1]])
VarInv <- 1/VarList[[NbZ]]
logdetVar <- sum(log(Tmp))
}
else {
Tmp <- .sym_inverseRcpp(tcrossprod(tcrossprod(ZList[[1]],
VarList[[1]]), ZList[[1]]))
VarInv <- Tmp$inverse
logdetVar <- Tmp$log_det
}
}
else {
Tmp <- .sym_inverseRcpp(VarList[[1]])
VarInv <- Tmp$inverse
logdetVar <- Tmp$log_det
}
rm(Tmp)
NamesSigma <- names(VarList)
Res <- .MM_Reml1Mat(Y = Y, Cofactor = Cofactor, X = X,
formula = formulaComp, Factors = Factors, VarInv = VarInv,
logdetVar = logdetVar, NamesSigma = NamesSigma, NbCores = NbCores)
}
else {
DimVar <- sapply(1:(length(VarList) - 1), function(x) ncol(VarList[[x]]))
if (is.null(Henderson)) {
if (Method == "ML") {
Henderson <- FALSE
}
else {
Henderson <- FALSE
if ((length(Y) > sum(DimVar) + ncol(Cofactor)))
Henderson <- TRUE
}
}
if ((NbVar == 2) || (!Henderson) || (Method == "ML")) {
if (NbZ > 0) {
NamesVar <- names(VarList)
VarList <- mclapply(1:NbZ, function(x) {
Z <- ZList[[x]]
Var <- VarList[[x]]
if (ncol(Z) == nrow(Var)) {
if (nrow(Z) == Nind) {
return(tcrossprod(Z, tcrossprod(Z, Var)))
}
else {
stop("Incompatible dimensions between Y and ZList")
}
}
else {
stop("Incompatible dimensions between Zlist and VarList")
}
}, mc.cores = NbCores)
names(VarList) <- NamesVar
}
else {
invisible(lapply(1:length(VarList), function(x) {
if (nrow(VarList[[x]]) != Nind) {
stop(paste0("Incompatible dimensions between Y and VarList"))
}
}))
}
if (Method == "Reml") {
if (NbVar == 2) {
if (Henderson)
message("Henderson's trick is not implemented for 2 variance components, joint diagonalization trick is used")
InfMethod <- .MM_Reml2Mat
}
else {
InfMethod <- .MM_Reml
}
}
else {
if (Henderson)
message("Henderson's trick is not available for ML inference, classical MM is used")
if (NbVar == 2) {
InfMethod <- .MM_ML2Mat
}
else {
InfMethod <- .MM_ML
}
}
if (length(Init) == 0) {
Init <- rep(var(Y)/NbVar, NbVar)
if (!is.null(X)) {
Res <- InfMethod(Y = Y, Cofactor = Cofactor,
X = NULL, formula = formulaCof, Factors = Factors,
VarList = VarList, Init = Init, CritVar = CritVar,
CritLogLik = CritLogLik, MaxIter = MaxIter,
NbCores = 1)
Init <- Res[[1]]$Sigma
}
}
Res <- InfMethod(Y = Y, Cofactor = Cofactor, X = X,
formula = formulaComp, Factors = Factors, VarList = VarList,
Init = Init, CritVar = CritVar, CritLogLik = CritLogLik,
MaxIter = MaxIter, NbCores = NbCores)
}
else {
invisible(sapply(1:NbZ, function(x) {
if (ncol(ZList[[x]]) != nrow(VarList[[x]])) stop("Incompatible dimensions between Zlist and VarList")
if (nrow(ZList[[x]]) != length(Y)) stop("Incompatible dimensions between Y and ZList")
}))
Rdiag <- isDiagonal(ZList[[NbZ]]) && isDiagonal(VarList[[NbZ]])
if (Rdiag) {
VarList[[NbZ]] <- diag(ZList[[NbZ]])^2 * diag(VarList[[NbZ]])
Rinv <- 1/VarList[[NbZ]]
Tmp <- mclapply(1:(NbZ - 1), function(x) .sym_inverseRcpp(VarList[[x]]),
mc.cores = NbCores)
GinvList <- lapply(Tmp, function(x) x$inverse)
logdetV <- c(sapply(Tmp, function(x) x$log_det),
sum(log(VarList[[NbZ]])))
rm(Tmp)
GList <- VarList
NamesVar <- names(VarList)
logdetV <- c(logdetV, sum(log(VarList[[NbZ]])))
rm(VarList)
InfMethod <- .MM_RemlHenDiag
}
else {
VarList[[NbZ]] <- tcrossprod(tcrossprod(ZList[[NbZ]],
VarList[[NbZ]]), ZList[[NbZ]])
Tmp <- mclapply(VarList, function(x) .sym_inverseRcpp(x),
mc.cores = NbCores)
Varinv <- lapply(Tmp, function(x) x$inverse)
logdetV <- sapply(Tmp, function(x) x$log_det)
Rinv <- Varinv[[length(Varinv)]]
GinvList <- lapply(1:(length(Varinv) - 1), function(x) Varinv[[x]])
rm(Varinv)
GList <- VarList
NamesVar <- names(VarList)
rm(VarList)
rm(Tmp)
InfMethod <- .MM_RemlHen
}
Zg = Reduce(cbind, lapply(1:(length(ZList) - 1),
function(x) ZList[[x]]))
if (length(Init) == 0) {
Init <- rep(var(Y)/NbVar, NbVar)
if (!is.null(X)) {
Res <- InfMethod(Y = Y, Cofactor = Cofactor,
X = NULL, formula = formulaCof, Factors = Factors,
Z = Zg, GList = GList, GinvList = GinvList,
Rinv = Rinv, logdetV = logdetV, NameVar = NamesVar,
Init = Init, CritVar = CritVar, CritLogLik = CritLogLik,
MaxIter = MaxIter, NbCores = 1)
Init <- Res[[1]]$Sigma2
}
}
Res <- InfMethod(Y = Y, Cofactor = Cofactor, X = X,
formula = formulaComp, Factors = Factors, Z = Zg,
GList = GList, GinvList = GinvList, Rinv = Rinv,
logdetV = logdetV, NameVar = NamesVar, Init = Init,
CritVar = CritVar, CritLogLik = CritLogLik, MaxIter = MaxIter,
NbCores = NbCores)
}
}
return(Res)
}
<bytecode: 0xc2c1410>
<environment: namespace:MM4LMM>
--- function search by body ---
Function MMEst in namespace MM4LMM has this body.
----------- END OF FAILURE REPORT --------------
Error in if (class(X) == "matrix") { : the condition has length > 1
Calls: MMEst
Execution halted
Flavor: r-devel-linux-x86_64-fedora-gcc