Last updated on 2020-02-19 14:48:30 CET.
| Flavor | Version | Tinstall | Tcheck | Ttotal | Status | Flags |
|---|---|---|---|---|---|---|
| r-devel-linux-x86_64-debian-clang | 2.1-0 | 21.91 | 207.00 | 228.91 | ERROR | |
| r-devel-linux-x86_64-debian-gcc | 2.1-0 | 19.85 | 154.94 | 174.79 | ERROR | |
| r-devel-linux-x86_64-fedora-clang | 2.1-0 | 263.02 | ERROR | |||
| r-devel-linux-x86_64-fedora-gcc | 2.1-0 | 263.30 | ERROR | |||
| r-devel-windows-ix86+x86_64 | 2.1-0 | 41.00 | 192.00 | 233.00 | OK | --no-examples --no-tests --no-vignettes |
| r-devel-windows-ix86+x86_64-gcc8 | 2.1-0 | 65.00 | 129.00 | 194.00 | OK | --no-examples --no-tests --no-vignettes |
| r-patched-linux-x86_64 | 2.1-0 | 15.70 | 355.12 | 370.82 | WARN | |
| r-patched-solaris-x86 | 2.1-0 | 609.00 | WARN | |||
| r-release-linux-x86_64 | 2.1-0 | 16.01 | 356.00 | 372.01 | OK | |
| r-release-windows-ix86+x86_64 | 2.1-0 | 40.00 | 101.00 | 141.00 | OK | --no-examples --no-tests --no-vignettes |
| r-release-osx-x86_64 | 2.1-0 | OK | ||||
| r-oldrel-windows-ix86+x86_64 | 2.1-0 | 21.00 | 110.00 | 131.00 | OK | --no-examples --no-tests --no-vignettes |
| r-oldrel-osx-x86_64 | 2.1-0 | OK |
Version: 2.1-0
Check: Rd \usage sections
Result: WARN
Documented arguments not in \usage in documentation object 'plotLSMEANS':
'...'
Functions with \usage entries need to have the appropriate \alias
entries, and all their arguments documented.
The \usage entries must correspond to syntactically valid R code.
See chapter 'Writing R documentation files' in the 'Writing R
Extensions' manual.
Flavors: r-devel-linux-x86_64-debian-clang, r-devel-linux-x86_64-debian-gcc, r-devel-linux-x86_64-fedora-clang, r-devel-linux-x86_64-fedora-gcc, r-patched-linux-x86_64, r-patched-solaris-x86
Version: 2.1-0
Check: examples
Result: ERROR
Running examples in 'SensMixed-Ex.R' failed
The error most likely occurred in:
> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: TVbo
> ### Title: TV dataset
> ### Aliases: TVbo
> ### Keywords: datasets
>
> ### ** Examples
>
> ## import SensMixed package
> library(SensMixed)
>
> ## convert some variables to factors in TVbo
> TVbo <- convertToFactors(TVbo, c("Assessor", "Repeat", "Picture"))
>
> ## run automated selection process
> res <- sensmixed(c("Coloursaturation", "Colourbalance"),
+ prod_effects = c("TVset", "Picture"),
+ assessor="Assessor", data=TVbo, MAM=FALSE)
|
| | 0%Warning in checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, :
Model failed to converge with max|grad| = 0.00592903 (tol = 0.002, component 1)
----------- FAILURE REPORT --------------
--- failure: the condition has length > 1 ---
--- srcref ---
:
--- package (from environment) ---
SensMixed
--- call from context ---
calcSatterthMultDF(rho, L)
--- call from argument ---
if (class(g) == "numeric") {
lapply(1:length(theopt), function(i) array(g[i], dim = dim(vcov.final)))
} else {
lapply(1:length(theopt), function(i) array(g[, i], dim = dim(vcov.final)))
}
--- R stacktrace ---
where 1: calcSatterthMultDF(rho, L)
where 2: calcSatt(rho, Lc)
where 3: calcFpvalueSS(Lc, rho, ddf, type)
where 4: calcFpvalueMAIN(term = tt, L = L, rho = rho, ddf = ddf, type = type)
where 5: FUN(X[[i]], ...)
where 6: lapply(test.terms, function(tt) calcFpvalueMAIN(term = tt, L = L,
rho = rho, ddf = ddf, type = type))
where 7: stepFun(model = model, ddf = ddf, type = type, alpha.random = alpha.random,
alpha.fixed = alpha.fixed, reduce.fixed = reduce.fixed, reduce.random = reduce.random,
fixed.calc = fixed.calc, lsmeans.calc = lsmeans.calc, difflsmeans.calc = difflsmeans.calc,
test.effs = test.effs, keep.effs = keep.effs, change.contr = TRUE)
where 8: step(m, reduce.fixed = FALSE, reduce.random = reduce.random,
alpha.random = alpha.random, alpha.fixed = alpha.fixed, lsmeans.calc = TRUE,
difflsmeans.calc = calc_post_hoc, keep.effs = keep.effs)
where 9: withCallingHandlers(expr, message = function(c) invokeRestart("muffleMessage"))
where 10: suppressMessages(st <- step(m, reduce.fixed = FALSE, reduce.random = reduce.random,
alpha.random = alpha.random, alpha.fixed = alpha.fixed, lsmeans.calc = TRUE,
difflsmeans.calc = calc_post_hoc, keep.effs = keep.effs))
where 11: .fun(piece, ...)
where 12: (function (i)
{
piece <- pieces[[i]]
if (.inform) {
res <- try(.fun(piece, ...))
if (inherits(res, "try-error")) {
piece <- paste(utils::capture.output(print(piece)),
collapse = "\n")
stop("with piece ", i, ": \n", piece, call. = FALSE)
}
}
else {
res <- .fun(piece, ...)
}
progress$step()
res
})(1L)
where 13: loop_apply(n, do.ply)
where 14: llply(attributes, .stepAllAttrNoMAM, product_structure = product_structure,
error_structure = error_structure, data = data, prod_effects = prod_effects,
random = random, reduce.random = rmatch(control, "reduce.random"),
alpha.random = rmatch(control, "alpha.random"), alpha.fixed = rmatch(control,
"alpha.fixed"), calc_post_hoc = rmatch(control, "calc_post_hoc"),
keep.effs = keep.effs, .progress = "text")
where 15: sensmixedFun(attributes = attributes, prod_effects = prod_effects,
assessor = assessor, replication = replication, data = data,
product_structure = product_structure, error_structure = error_structure,
MAM = MAM, control = control)
where 16: sensmixed(c("Coloursaturation", "Colourbalance"), prod_effects = c("TVset",
"Picture"), assessor = "Assessor", data = TVbo, MAM = FALSE)
--- value of length: 2 type: logical ---
[1] FALSE FALSE
--- function from context ---
function (rho, Lc)
{
vcov.final <- as.matrix(vcov(rho$model))
if (is.vector(Lc))
C.theta.optim <- as.matrix(t(Lc) %*% vcov.final %*% Lc)
else C.theta.optim <- as.matrix(Lc %*% vcov.final %*% t(Lc))
invC.theta <- tryCatch({
solve(C.theta.optim)
}, error = function(e) {
NULL
})
if (is.null(invC.theta))
return(list(denom = 0, Fstat = NA, pvalue = NA, ndf = NA,
ss = NA, ms = NA))
q <- qr(C.theta.optim)$rank
F.stat <- (t(Lc %*% rho$fixEffs) %*% invC.theta %*% (Lc %*%
rho$fixEffs))/q
svdec <- eigen(C.theta.optim)
PL <- t(svdec$vectors) %*% Lc
vss2 <- vcovTheta(rho$model)
theopt <- c(rho$thopt, rho$sigma)
g <- mygrad(function(x) vss2(x), theopt)
mat.grad <- if (class(g) == "numeric") {
lapply(1:length(theopt), function(i) array(g[i], dim = dim(vcov.final)))
}
else {
lapply(1:length(theopt), function(i) array(g[, i], dim = dim(vcov.final)))
}
nu.m.fun <- function(m) {
den.nu <- unlist(lapply(1:length(mat.grad), function(i) as.matrix(t(PL[m,
]) %*% mat.grad[[i]] %*% PL[m, ])))
2 * (svdec$values[m])^2/(t(den.nu) %*% rho$A %*% den.nu)
}
nu.m <- unlist(lapply(1:length(svdec$values), nu.m.fun))
nu.m[which(abs(2 - nu.m) < 1e-05)] <- 2.00001
E <- sum((nu.m/(nu.m - 2)) * as.numeric(nu.m > 2))
nu.F <- 2 * E * as.numeric(E > q)/(E - q)
pvalueF <- pf(F.stat, qr(Lc)$rank, nu.F, lower.tail = FALSE)
if (is.na(F.stat))
ms <- ss <- NA
else {
ms <- F.stat * rho$sigma^2
ss <- ms * q
}
return(list(ss = ss, ms = ms, denom = nu.F, Fstat = F.stat,
pvalue = pvalueF, ndf = q))
}
<bytecode: 0x9d7bbb0>
<environment: namespace:SensMixed>
--- function search by body ---
Function calcSatterthMultDF in namespace SensMixed has this body.
----------- END OF FAILURE REPORT --------------
Error in if (class(g) == "numeric") { : the condition has length > 1
Calls: sensmixed ... calcFpvalueMAIN -> calcFpvalueSS -> calcSatt -> calcSatterthMultDF
Execution halted
Flavor: r-devel-linux-x86_64-debian-clang
Version: 2.1-0
Check: tests
Result: ERROR
Running 'bugBO.R' [5s/7s]
Running 'bugKEEPdprime.R' [5s/6s]
Running 'testBugResiduals.R' [9s/11s]
Running 'testDprimes.R' [11s/12s]
Running 'testKEEPeffs.R' [32s/34s]
Running 'testRep.R' [5s/5s]
Running the tests in 'tests/testBugResiduals.R' failed.
Complete output:
> testOST <- FALSE
>
> library(SensMixed)
> load(system.file("testdata","bugResiddat.RData",package="SensMixed"))
> load(system.file("testdata","bb.RData",package="SensMixed"))
> load(system.file("testdata","ost.RData",package="SensMixed"))
>
> response <- c("liking")
> fixed <- list(Product = c("Sugar", "Acid"))
> random <- c("consumer")
> facs <- c("consumer", "Sugar", "Acid")
>
> res <- conjoint(structure = 3, dat, response, fixed, random, facs)
[1] "Calculating liking ..."
Number of levels for interaction consumer:Sugar:Acid is more or equal to the number of observations in data
Number of levels for interaction consumer:Sugar:Acid is more or equal to the number of observations in data
boundary (singular) fit: see ?isSingular
----------- FAILURE REPORT --------------
--- failure: the condition has length > 1 ---
--- srcref ---
:
--- package (from environment) ---
SensMixed
--- call from context ---
calcSatterthMultDF(rho, L)
--- call from argument ---
if (class(g) == "numeric") {
lapply(1:length(theopt), function(i) array(g[i], dim = dim(vcov.final)))
} else {
lapply(1:length(theopt), function(i) array(g[, i], dim = dim(vcov.final)))
}
--- R stacktrace ---
where 1: calcSatterthMultDF(rho, L)
where 2: calcSatt(rho, Lc)
where 3: calcFpvalueSS(Lc, rho, ddf, type)
where 4: calcFpvalueMAIN(term = tt, L = L, rho = rho, ddf = ddf, type = type)
where 5: FUN(X[[i]], ...)
where 6: lapply(test.terms, function(tt) calcFpvalueMAIN(term = tt, L = L,
rho = rho, ddf = ddf, type = type))
where 7: stepFun(model = model, ddf = ddf, type = type, alpha.random = alpha.random,
alpha.fixed = alpha.fixed, reduce.fixed = reduce.fixed, reduce.random = reduce.random,
fixed.calc = fixed.calc, lsmeans.calc = lsmeans.calc, difflsmeans.calc = difflsmeans.calc,
test.effs = test.effs, keep.effs = keep.effs, change.contr = TRUE)
where 8: step(model, reduce.fixed = isFixReduce, reduce.random = isRandReduce,
alpha.random = alpha.random, alpha.fixed = alpha.fixed)
where 9: withCallingHandlers(expr, message = function(c) invokeRestart("muffleMessage"))
where 10: suppressMessages(t <- step(model, reduce.fixed = isFixReduce,
reduce.random = isRandReduce, alpha.random = alpha.random,
alpha.fixed = alpha.fixed))
where 11: conjointFun(structure = structure, data = data, response = response,
fixed = fixed, random = random, facs = facs, corr = FALSE,
alpha.random = alpha.random, alpha.fixed = alpha.fixed)
where 12: conjoint(structure = 3, dat, response, fixed, random, facs)
--- value of length: 2 type: logical ---
[1] FALSE FALSE
--- function from context ---
function (rho, Lc)
{
vcov.final <- as.matrix(vcov(rho$model))
if (is.vector(Lc))
C.theta.optim <- as.matrix(t(Lc) %*% vcov.final %*% Lc)
else C.theta.optim <- as.matrix(Lc %*% vcov.final %*% t(Lc))
invC.theta <- tryCatch({
solve(C.theta.optim)
}, error = function(e) {
NULL
})
if (is.null(invC.theta))
return(list(denom = 0, Fstat = NA, pvalue = NA, ndf = NA,
ss = NA, ms = NA))
q <- qr(C.theta.optim)$rank
F.stat <- (t(Lc %*% rho$fixEffs) %*% invC.theta %*% (Lc %*%
rho$fixEffs))/q
svdec <- eigen(C.theta.optim)
PL <- t(svdec$vectors) %*% Lc
vss2 <- vcovTheta(rho$model)
theopt <- c(rho$thopt, rho$sigma)
g <- mygrad(function(x) vss2(x), theopt)
mat.grad <- if (class(g) == "numeric") {
lapply(1:length(theopt), function(i) array(g[i], dim = dim(vcov.final)))
}
else {
lapply(1:length(theopt), function(i) array(g[, i], dim = dim(vcov.final)))
}
nu.m.fun <- function(m) {
den.nu <- unlist(lapply(1:length(mat.grad), function(i) as.matrix(t(PL[m,
]) %*% mat.grad[[i]] %*% PL[m, ])))
2 * (svdec$values[m])^2/(t(den.nu) %*% rho$A %*% den.nu)
}
nu.m <- unlist(lapply(1:length(svdec$values), nu.m.fun))
nu.m[which(abs(2 - nu.m) < 1e-05)] <- 2.00001
E <- sum((nu.m/(nu.m - 2)) * as.numeric(nu.m > 2))
nu.F <- 2 * E * as.numeric(E > q)/(E - q)
pvalueF <- pf(F.stat, qr(Lc)$rank, nu.F, lower.tail = FALSE)
if (is.na(F.stat))
ms <- ss <- NA
else {
ms <- F.stat * rho$sigma^2
ss <- ms * q
}
return(list(ss = ss, ms = ms, denom = nu.F, Fstat = F.stat,
pvalue = pvalueF, ndf = q))
}
<bytecode: 0xc2c4950>
<environment: namespace:SensMixed>
--- function search by body ---
Function calcSatterthMultDF in namespace SensMixed has this body.
----------- END OF FAILURE REPORT --------------
Error in if (class(g) == "numeric") { : the condition has length > 1
Calls: conjoint ... calcFpvalueMAIN -> calcFpvalueSS -> calcSatt -> calcSatterthMultDF
Execution halted
Running the tests in 'tests/testDprimes.R' failed.
Complete output:
> require(SensMixed)
Loading required package: SensMixed
> load(system.file("testdata","sensBObalanc.RData",package="SensMixed"))
> load(system.file("testdata","sensBO.RData",package="SensMixed"))
> testBO <- FALSE
> ###########################################
> ## check for TVbo without replication
> ###########################################
>
>
>
> TVbo <- convertToFactors(TVbo, c("Assessor", "Repeat", "Picture"))
> result <- sensmixed(c("Noise", "Elasticeffect"),
+ prod_effects = c("TVset", "Picture"),
+ assessor = "Assessor", data = TVbo,
+ control = list(calc_post_hoc = TRUE), MAM = FALSE)
|
| | 0% ----------- FAILURE REPORT --------------
--- failure: the condition has length > 1 ---
--- srcref ---
:
--- package (from environment) ---
SensMixed
--- call from context ---
calcSatterthMultDF(rho, L)
--- call from argument ---
if (class(g) == "numeric") {
lapply(1:length(theopt), function(i) array(g[i], dim = dim(vcov.final)))
} else {
lapply(1:length(theopt), function(i) array(g[, i], dim = dim(vcov.final)))
}
--- R stacktrace ---
where 1: calcSatterthMultDF(rho, L)
where 2: calcSatt(rho, Lc)
where 3: calcFpvalueSS(Lc, rho, ddf, type)
where 4: calcFpvalueMAIN(term = tt, L = L, rho = rho, ddf = ddf, type = type)
where 5: FUN(X[[i]], ...)
where 6: lapply(test.terms, function(tt) calcFpvalueMAIN(term = tt, L = L,
rho = rho, ddf = ddf, type = type))
where 7: stepFun(model = model, ddf = ddf, type = type, alpha.random = alpha.random,
alpha.fixed = alpha.fixed, reduce.fixed = reduce.fixed, reduce.random = reduce.random,
fixed.calc = fixed.calc, lsmeans.calc = lsmeans.calc, difflsmeans.calc = difflsmeans.calc,
test.effs = test.effs, keep.effs = keep.effs, change.contr = TRUE)
where 8: step(m, reduce.fixed = FALSE, reduce.random = reduce.random,
alpha.random = alpha.random, alpha.fixed = alpha.fixed, lsmeans.calc = TRUE,
difflsmeans.calc = calc_post_hoc, keep.effs = keep.effs)
where 9: withCallingHandlers(expr, message = function(c) invokeRestart("muffleMessage"))
where 10: suppressMessages(st <- step(m, reduce.fixed = FALSE, reduce.random = reduce.random,
alpha.random = alpha.random, alpha.fixed = alpha.fixed, lsmeans.calc = TRUE,
difflsmeans.calc = calc_post_hoc, keep.effs = keep.effs))
where 11: .fun(piece, ...)
where 12: (function (i)
{
piece <- pieces[[i]]
if (.inform) {
res <- try(.fun(piece, ...))
if (inherits(res, "try-error")) {
piece <- paste(utils::capture.output(print(piece)),
collapse = "\n")
stop("with piece ", i, ": \n", piece, call. = FALSE)
}
}
else {
res <- .fun(piece, ...)
}
progress$step()
res
})(1L)
where 13: loop_apply(n, do.ply)
where 14: llply(attributes, .stepAllAttrNoMAM, product_structure = product_structure,
error_structure = error_structure, data = data, prod_effects = prod_effects,
random = random, reduce.random = rmatch(control, "reduce.random"),
alpha.random = rmatch(control, "alpha.random"), alpha.fixed = rmatch(control,
"alpha.fixed"), calc_post_hoc = rmatch(control, "calc_post_hoc"),
keep.effs = keep.effs, .progress = "text")
where 15: sensmixedFun(attributes = attributes, prod_effects = prod_effects,
assessor = assessor, replication = replication, data = data,
product_structure = product_structure, error_structure = error_structure,
MAM = MAM, control = control)
where 16: sensmixed(c("Noise", "Elasticeffect"), prod_effects = c("TVset",
"Picture"), assessor = "Assessor", data = TVbo, control = list(calc_post_hoc = TRUE),
MAM = FALSE)
--- value of length: 2 type: logical ---
[1] FALSE FALSE
--- function from context ---
function (rho, Lc)
{
vcov.final <- as.matrix(vcov(rho$model))
if (is.vector(Lc))
C.theta.optim <- as.matrix(t(Lc) %*% vcov.final %*% Lc)
else C.theta.optim <- as.matrix(Lc %*% vcov.final %*% t(Lc))
invC.theta <- tryCatch({
solve(C.theta.optim)
}, error = function(e) {
NULL
})
if (is.null(invC.theta))
return(list(denom = 0, Fstat = NA, pvalue = NA, ndf = NA,
ss = NA, ms = NA))
q <- qr(C.theta.optim)$rank
F.stat <- (t(Lc %*% rho$fixEffs) %*% invC.theta %*% (Lc %*%
rho$fixEffs))/q
svdec <- eigen(C.theta.optim)
PL <- t(svdec$vectors) %*% Lc
vss2 <- vcovTheta(rho$model)
theopt <- c(rho$thopt, rho$sigma)
g <- mygrad(function(x) vss2(x), theopt)
mat.grad <- if (class(g) == "numeric") {
lapply(1:length(theopt), function(i) array(g[i], dim = dim(vcov.final)))
}
else {
lapply(1:length(theopt), function(i) array(g[, i], dim = dim(vcov.final)))
}
nu.m.fun <- function(m) {
den.nu <- unlist(lapply(1:length(mat.grad), function(i) as.matrix(t(PL[m,
]) %*% mat.grad[[i]] %*% PL[m, ])))
2 * (svdec$values[m])^2/(t(den.nu) %*% rho$A %*% den.nu)
}
nu.m <- unlist(lapply(1:length(svdec$values), nu.m.fun))
nu.m[which(abs(2 - nu.m) < 1e-05)] <- 2.00001
E <- sum((nu.m/(nu.m - 2)) * as.numeric(nu.m > 2))
nu.F <- 2 * E * as.numeric(E > q)/(E - q)
pvalueF <- pf(F.stat, qr(Lc)$rank, nu.F, lower.tail = FALSE)
if (is.na(F.stat))
ms <- ss <- NA
else {
ms <- F.stat * rho$sigma^2
ss <- ms * q
}
return(list(ss = ss, ms = ms, denom = nu.F, Fstat = F.stat,
pvalue = pvalueF, ndf = q))
}
<bytecode: 0xb8dea78>
<environment: namespace:SensMixed>
--- function search by body ---
Function calcSatterthMultDF in namespace SensMixed has this body.
----------- END OF FAILURE REPORT --------------
Error in if (class(g) == "numeric") { : the condition has length > 1
Calls: sensmixed ... calcFpvalueMAIN -> calcFpvalueSS -> calcSatt -> calcSatterthMultDF
Execution halted
Running the tests in 'tests/testKEEPeffs.R' failed.
Complete output:
> require(SensMixed)
Loading required package: SensMixed
>
> #convert some variables to factors in TVbo
> TVbo <- convertToFactors(TVbo, c("Assessor", "Repeat", "Picture"))
>
> res <- sensmixed(c("Coloursaturation", "Colourbalance"),
+ prod_effects = c("TVset", "Picture"), replication="Repeat",
+ assessor="Assessor", data=TVbo,
+ control = list(keep.effs = "Assessor"), MAM = FALSE)
|
| | 0%
----------- FAILURE REPORT --------------
--- failure: the condition has length > 1 ---
--- srcref ---
:
--- package (from environment) ---
SensMixed
--- call from context ---
calcSatterthMultDF(rho, L)
--- call from argument ---
if (class(g) == "numeric") {
lapply(1:length(theopt), function(i) array(g[i], dim = dim(vcov.final)))
} else {
lapply(1:length(theopt), function(i) array(g[, i], dim = dim(vcov.final)))
}
--- R stacktrace ---
where 1: calcSatterthMultDF(rho, L)
where 2: calcSatt(rho, Lc)
where 3: calcFpvalueSS(Lc, rho, ddf, type)
where 4: calcFpvalueMAIN(term = tt, L = L, rho = rho, ddf = ddf, type = type)
where 5: FUN(X[[i]], ...)
where 6: lapply(test.terms, function(tt) calcFpvalueMAIN(term = tt, L = L,
rho = rho, ddf = ddf, type = type))
where 7: stepFun(model = model, ddf = ddf, type = type, alpha.random = alpha.random,
alpha.fixed = alpha.fixed, reduce.fixed = reduce.fixed, reduce.random = reduce.random,
fixed.calc = fixed.calc, lsmeans.calc = lsmeans.calc, difflsmeans.calc = difflsmeans.calc,
test.effs = test.effs, keep.effs = keep.effs, change.contr = TRUE)
where 8: step(m, reduce.fixed = FALSE, reduce.random = reduce.random,
alpha.random = alpha.random, alpha.fixed = alpha.fixed, lsmeans.calc = TRUE,
difflsmeans.calc = calc_post_hoc, keep.effs = keep.effs)
where 9: withCallingHandlers(expr, message = function(c) invokeRestart("muffleMessage"))
where 10: suppressMessages(st <- step(m, reduce.fixed = FALSE, reduce.random = reduce.random,
alpha.random = alpha.random, alpha.fixed = alpha.fixed, lsmeans.calc = TRUE,
difflsmeans.calc = calc_post_hoc, keep.effs = keep.effs))
where 11: .fun(piece, ...)
where 12: (function (i)
{
piece <- pieces[[i]]
if (.inform) {
res <- try(.fun(piece, ...))
if (inherits(res, "try-error")) {
piece <- paste(utils::capture.output(print(piece)),
collapse = "\n")
stop("with piece ", i, ": \n", piece, call. = FALSE)
}
}
else {
res <- .fun(piece, ...)
}
progress$step()
res
})(1L)
where 13: loop_apply(n, do.ply)
where 14: llply(attributes, .stepAllAttrNoMAM, product_structure = product_structure,
error_structure = error_structure, data = data, prod_effects = prod_effects,
random = random, reduce.random = rmatch(control, "reduce.random"),
alpha.random = rmatch(control, "alpha.random"), alpha.fixed = rmatch(control,
"alpha.fixed"), calc_post_hoc = rmatch(control, "calc_post_hoc"),
keep.effs = keep.effs, .progress = "text")
where 15: sensmixedFun(attributes = attributes, prod_effects = prod_effects,
assessor = assessor, replication = replication, data = data,
product_structure = product_structure, error_structure = error_structure,
MAM = MAM, control = control)
where 16: sensmixed(c("Coloursaturation", "Colourbalance"), prod_effects = c("TVset",
"Picture"), replication = "Repeat", assessor = "Assessor",
data = TVbo, control = list(keep.effs = "Assessor"), MAM = FALSE)
--- value of length: 2 type: logical ---
[1] FALSE FALSE
--- function from context ---
function (rho, Lc)
{
vcov.final <- as.matrix(vcov(rho$model))
if (is.vector(Lc))
C.theta.optim <- as.matrix(t(Lc) %*% vcov.final %*% Lc)
else C.theta.optim <- as.matrix(Lc %*% vcov.final %*% t(Lc))
invC.theta <- tryCatch({
solve(C.theta.optim)
}, error = function(e) {
NULL
})
if (is.null(invC.theta))
return(list(denom = 0, Fstat = NA, pvalue = NA, ndf = NA,
ss = NA, ms = NA))
q <- qr(C.theta.optim)$rank
F.stat <- (t(Lc %*% rho$fixEffs) %*% invC.theta %*% (Lc %*%
rho$fixEffs))/q
svdec <- eigen(C.theta.optim)
PL <- t(svdec$vectors) %*% Lc
vss2 <- vcovTheta(rho$model)
theopt <- c(rho$thopt, rho$sigma)
g <- mygrad(function(x) vss2(x), theopt)
mat.grad <- if (class(g) == "numeric") {
lapply(1:length(theopt), function(i) array(g[i], dim = dim(vcov.final)))
}
else {
lapply(1:length(theopt), function(i) array(g[, i], dim = dim(vcov.final)))
}
nu.m.fun <- function(m) {
den.nu <- unlist(lapply(1:length(mat.grad), function(i) as.matrix(t(PL[m,
]) %*% mat.grad[[i]] %*% PL[m, ])))
2 * (svdec$values[m])^2/(t(den.nu) %*% rho$A %*% den.nu)
}
nu.m <- unlist(lapply(1:length(svdec$values), nu.m.fun))
nu.m[which(abs(2 - nu.m) < 1e-05)] <- 2.00001
E <- sum((nu.m/(nu.m - 2)) * as.numeric(nu.m > 2))
nu.F <- 2 * E * as.numeric(E > q)/(E - q)
pvalueF <- pf(F.stat, qr(Lc)$rank, nu.F, lower.tail = FALSE)
if (is.na(F.stat))
ms <- ss <- NA
else {
ms <- F.stat * rho$sigma^2
ss <- ms * q
}
return(list(ss = ss, ms = ms, denom = nu.F, Fstat = F.stat,
pvalue = pvalueF, ndf = q))
}
<bytecode: 0x103fd7c0>
<environment: namespace:SensMixed>
--- function search by body ---
Function calcSatterthMultDF in namespace SensMixed has this body.
----------- END OF FAILURE REPORT --------------
Error in if (class(g) == "numeric") { : the condition has length > 1
Calls: sensmixed ... calcFpvalueMAIN -> calcFpvalueSS -> calcSatt -> calcSatterthMultDF
In addition: Warning messages:
1: In checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, :
Model failed to converge with max|grad| = 0.00767249 (tol = 0.002, component 1)
2: In checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, :
Model failed to converge with max|grad| = 0.00296669 (tol = 0.002, component 1)
3: In checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, :
Model failed to converge with max|grad| = 0.0227178 (tol = 0.002, component 1)
4: In checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, :
unable to evaluate scaled gradient
5: In checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, :
Model failed to converge: degenerate Hessian with 1 negative eigenvalues
6: In checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, :
Model failed to converge with max|grad| = 0.00329232 (tol = 0.002, component 1)
Execution halted
Flavor: r-devel-linux-x86_64-debian-clang
Version: 2.1-0
Check: examples
Result: ERROR
Running examples in ‘SensMixed-Ex.R’ failed
The error most likely occurred in:
> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: TVbo
> ### Title: TV dataset
> ### Aliases: TVbo
> ### Keywords: datasets
>
> ### ** Examples
>
> ## import SensMixed package
> library(SensMixed)
>
> ## convert some variables to factors in TVbo
> TVbo <- convertToFactors(TVbo, c("Assessor", "Repeat", "Picture"))
>
> ## run automated selection process
> res <- sensmixed(c("Coloursaturation", "Colourbalance"),
+ prod_effects = c("TVset", "Picture"),
+ assessor="Assessor", data=TVbo, MAM=FALSE)
|
| | 0%Warning in checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, :
Model failed to converge with max|grad| = 0.00592903 (tol = 0.002, component 1)
----------- FAILURE REPORT --------------
--- failure: the condition has length > 1 ---
--- srcref ---
:
--- package (from environment) ---
SensMixed
--- call from context ---
calcSatterthMultDF(rho, L)
--- call from argument ---
if (class(g) == "numeric") {
lapply(1:length(theopt), function(i) array(g[i], dim = dim(vcov.final)))
} else {
lapply(1:length(theopt), function(i) array(g[, i], dim = dim(vcov.final)))
}
--- R stacktrace ---
where 1: calcSatterthMultDF(rho, L)
where 2: calcSatt(rho, Lc)
where 3: calcFpvalueSS(Lc, rho, ddf, type)
where 4: calcFpvalueMAIN(term = tt, L = L, rho = rho, ddf = ddf, type = type)
where 5: FUN(X[[i]], ...)
where 6: lapply(test.terms, function(tt) calcFpvalueMAIN(term = tt, L = L,
rho = rho, ddf = ddf, type = type))
where 7: stepFun(model = model, ddf = ddf, type = type, alpha.random = alpha.random,
alpha.fixed = alpha.fixed, reduce.fixed = reduce.fixed, reduce.random = reduce.random,
fixed.calc = fixed.calc, lsmeans.calc = lsmeans.calc, difflsmeans.calc = difflsmeans.calc,
test.effs = test.effs, keep.effs = keep.effs, change.contr = TRUE)
where 8: step(m, reduce.fixed = FALSE, reduce.random = reduce.random,
alpha.random = alpha.random, alpha.fixed = alpha.fixed, lsmeans.calc = TRUE,
difflsmeans.calc = calc_post_hoc, keep.effs = keep.effs)
where 9: withCallingHandlers(expr, message = function(c) invokeRestart("muffleMessage"))
where 10: suppressMessages(st <- step(m, reduce.fixed = FALSE, reduce.random = reduce.random,
alpha.random = alpha.random, alpha.fixed = alpha.fixed, lsmeans.calc = TRUE,
difflsmeans.calc = calc_post_hoc, keep.effs = keep.effs))
where 11: .fun(piece, ...)
where 12: (function (i)
{
piece <- pieces[[i]]
if (.inform) {
res <- try(.fun(piece, ...))
if (inherits(res, "try-error")) {
piece <- paste(utils::capture.output(print(piece)),
collapse = "\n")
stop("with piece ", i, ": \n", piece, call. = FALSE)
}
}
else {
res <- .fun(piece, ...)
}
progress$step()
res
})(1L)
where 13: loop_apply(n, do.ply)
where 14: llply(attributes, .stepAllAttrNoMAM, product_structure = product_structure,
error_structure = error_structure, data = data, prod_effects = prod_effects,
random = random, reduce.random = rmatch(control, "reduce.random"),
alpha.random = rmatch(control, "alpha.random"), alpha.fixed = rmatch(control,
"alpha.fixed"), calc_post_hoc = rmatch(control, "calc_post_hoc"),
keep.effs = keep.effs, .progress = "text")
where 15: sensmixedFun(attributes = attributes, prod_effects = prod_effects,
assessor = assessor, replication = replication, data = data,
product_structure = product_structure, error_structure = error_structure,
MAM = MAM, control = control)
where 16: sensmixed(c("Coloursaturation", "Colourbalance"), prod_effects = c("TVset",
"Picture"), assessor = "Assessor", data = TVbo, MAM = FALSE)
--- value of length: 2 type: logical ---
[1] FALSE FALSE
--- function from context ---
function (rho, Lc)
{
vcov.final <- as.matrix(vcov(rho$model))
if (is.vector(Lc))
C.theta.optim <- as.matrix(t(Lc) %*% vcov.final %*% Lc)
else C.theta.optim <- as.matrix(Lc %*% vcov.final %*% t(Lc))
invC.theta <- tryCatch({
solve(C.theta.optim)
}, error = function(e) {
NULL
})
if (is.null(invC.theta))
return(list(denom = 0, Fstat = NA, pvalue = NA, ndf = NA,
ss = NA, ms = NA))
q <- qr(C.theta.optim)$rank
F.stat <- (t(Lc %*% rho$fixEffs) %*% invC.theta %*% (Lc %*%
rho$fixEffs))/q
svdec <- eigen(C.theta.optim)
PL <- t(svdec$vectors) %*% Lc
vss2 <- vcovTheta(rho$model)
theopt <- c(rho$thopt, rho$sigma)
g <- mygrad(function(x) vss2(x), theopt)
mat.grad <- if (class(g) == "numeric") {
lapply(1:length(theopt), function(i) array(g[i], dim = dim(vcov.final)))
}
else {
lapply(1:length(theopt), function(i) array(g[, i], dim = dim(vcov.final)))
}
nu.m.fun <- function(m) {
den.nu <- unlist(lapply(1:length(mat.grad), function(i) as.matrix(t(PL[m,
]) %*% mat.grad[[i]] %*% PL[m, ])))
2 * (svdec$values[m])^2/(t(den.nu) %*% rho$A %*% den.nu)
}
nu.m <- unlist(lapply(1:length(svdec$values), nu.m.fun))
nu.m[which(abs(2 - nu.m) < 1e-05)] <- 2.00001
E <- sum((nu.m/(nu.m - 2)) * as.numeric(nu.m > 2))
nu.F <- 2 * E * as.numeric(E > q)/(E - q)
pvalueF <- pf(F.stat, qr(Lc)$rank, nu.F, lower.tail = FALSE)
if (is.na(F.stat))
ms <- ss <- NA
else {
ms <- F.stat * rho$sigma^2
ss <- ms * q
}
return(list(ss = ss, ms = ms, denom = nu.F, Fstat = F.stat,
pvalue = pvalueF, ndf = q))
}
<bytecode: 0x5580d4ab5ec0>
<environment: namespace:SensMixed>
--- function search by body ---
Function calcSatterthMultDF in namespace SensMixed has this body.
----------- END OF FAILURE REPORT --------------
Error in if (class(g) == "numeric") { : the condition has length > 1
Calls: sensmixed ... calcFpvalueMAIN -> calcFpvalueSS -> calcSatt -> calcSatterthMultDF
Execution halted
Flavor: r-devel-linux-x86_64-debian-gcc
Version: 2.1-0
Check: tests
Result: ERROR
Running ‘bugBO.R’ [3s/6s]
Running ‘bugKEEPdprime.R’ [3s/5s]
Running ‘testBugResiduals.R’ [7s/10s]
Running ‘testDprimes.R’ [8s/13s]
Running ‘testKEEPeffs.R’ [25s/34s]
Running ‘testRep.R’ [3s/6s]
Running the tests in ‘tests/testBugResiduals.R’ failed.
Complete output:
> testOST <- FALSE
>
> library(SensMixed)
> load(system.file("testdata","bugResiddat.RData",package="SensMixed"))
> load(system.file("testdata","bb.RData",package="SensMixed"))
> load(system.file("testdata","ost.RData",package="SensMixed"))
>
> response <- c("liking")
> fixed <- list(Product = c("Sugar", "Acid"))
> random <- c("consumer")
> facs <- c("consumer", "Sugar", "Acid")
>
> res <- conjoint(structure = 3, dat, response, fixed, random, facs)
[1] "Calculating liking ..."
Number of levels for interaction consumer:Sugar:Acid is more or equal to the number of observations in data
Number of levels for interaction consumer:Sugar:Acid is more or equal to the number of observations in data
boundary (singular) fit: see ?isSingular
----------- FAILURE REPORT --------------
--- failure: the condition has length > 1 ---
--- srcref ---
:
--- package (from environment) ---
SensMixed
--- call from context ---
calcSatterthMultDF(rho, L)
--- call from argument ---
if (class(g) == "numeric") {
lapply(1:length(theopt), function(i) array(g[i], dim = dim(vcov.final)))
} else {
lapply(1:length(theopt), function(i) array(g[, i], dim = dim(vcov.final)))
}
--- R stacktrace ---
where 1: calcSatterthMultDF(rho, L)
where 2: calcSatt(rho, Lc)
where 3: calcFpvalueSS(Lc, rho, ddf, type)
where 4: calcFpvalueMAIN(term = tt, L = L, rho = rho, ddf = ddf, type = type)
where 5: FUN(X[[i]], ...)
where 6: lapply(test.terms, function(tt) calcFpvalueMAIN(term = tt, L = L,
rho = rho, ddf = ddf, type = type))
where 7: stepFun(model = model, ddf = ddf, type = type, alpha.random = alpha.random,
alpha.fixed = alpha.fixed, reduce.fixed = reduce.fixed, reduce.random = reduce.random,
fixed.calc = fixed.calc, lsmeans.calc = lsmeans.calc, difflsmeans.calc = difflsmeans.calc,
test.effs = test.effs, keep.effs = keep.effs, change.contr = TRUE)
where 8: step(model, reduce.fixed = isFixReduce, reduce.random = isRandReduce,
alpha.random = alpha.random, alpha.fixed = alpha.fixed)
where 9: withCallingHandlers(expr, message = function(c) invokeRestart("muffleMessage"))
where 10: suppressMessages(t <- step(model, reduce.fixed = isFixReduce,
reduce.random = isRandReduce, alpha.random = alpha.random,
alpha.fixed = alpha.fixed))
where 11: conjointFun(structure = structure, data = data, response = response,
fixed = fixed, random = random, facs = facs, corr = FALSE,
alpha.random = alpha.random, alpha.fixed = alpha.fixed)
where 12: conjoint(structure = 3, dat, response, fixed, random, facs)
--- value of length: 2 type: logical ---
[1] FALSE FALSE
--- function from context ---
function (rho, Lc)
{
vcov.final <- as.matrix(vcov(rho$model))
if (is.vector(Lc))
C.theta.optim <- as.matrix(t(Lc) %*% vcov.final %*% Lc)
else C.theta.optim <- as.matrix(Lc %*% vcov.final %*% t(Lc))
invC.theta <- tryCatch({
solve(C.theta.optim)
}, error = function(e) {
NULL
})
if (is.null(invC.theta))
return(list(denom = 0, Fstat = NA, pvalue = NA, ndf = NA,
ss = NA, ms = NA))
q <- qr(C.theta.optim)$rank
F.stat <- (t(Lc %*% rho$fixEffs) %*% invC.theta %*% (Lc %*%
rho$fixEffs))/q
svdec <- eigen(C.theta.optim)
PL <- t(svdec$vectors) %*% Lc
vss2 <- vcovTheta(rho$model)
theopt <- c(rho$thopt, rho$sigma)
g <- mygrad(function(x) vss2(x), theopt)
mat.grad <- if (class(g) == "numeric") {
lapply(1:length(theopt), function(i) array(g[i], dim = dim(vcov.final)))
}
else {
lapply(1:length(theopt), function(i) array(g[, i], dim = dim(vcov.final)))
}
nu.m.fun <- function(m) {
den.nu <- unlist(lapply(1:length(mat.grad), function(i) as.matrix(t(PL[m,
]) %*% mat.grad[[i]] %*% PL[m, ])))
2 * (svdec$values[m])^2/(t(den.nu) %*% rho$A %*% den.nu)
}
nu.m <- unlist(lapply(1:length(svdec$values), nu.m.fun))
nu.m[which(abs(2 - nu.m) < 1e-05)] <- 2.00001
E <- sum((nu.m/(nu.m - 2)) * as.numeric(nu.m > 2))
nu.F <- 2 * E * as.numeric(E > q)/(E - q)
pvalueF <- pf(F.stat, qr(Lc)$rank, nu.F, lower.tail = FALSE)
if (is.na(F.stat))
ms <- ss <- NA
else {
ms <- F.stat * rho$sigma^2
ss <- ms * q
}
return(list(ss = ss, ms = ms, denom = nu.F, Fstat = F.stat,
pvalue = pvalueF, ndf = q))
}
<bytecode: 0x558fc247e880>
<environment: namespace:SensMixed>
--- function search by body ---
Function calcSatterthMultDF in namespace SensMixed has this body.
----------- END OF FAILURE REPORT --------------
Error in if (class(g) == "numeric") { : the condition has length > 1
Calls: conjoint ... calcFpvalueMAIN -> calcFpvalueSS -> calcSatt -> calcSatterthMultDF
Execution halted
Running the tests in ‘tests/testDprimes.R’ failed.
Complete output:
> require(SensMixed)
Loading required package: SensMixed
> load(system.file("testdata","sensBObalanc.RData",package="SensMixed"))
> load(system.file("testdata","sensBO.RData",package="SensMixed"))
> testBO <- FALSE
> ###########################################
> ## check for TVbo without replication
> ###########################################
>
>
>
> TVbo <- convertToFactors(TVbo, c("Assessor", "Repeat", "Picture"))
> result <- sensmixed(c("Noise", "Elasticeffect"),
+ prod_effects = c("TVset", "Picture"),
+ assessor = "Assessor", data = TVbo,
+ control = list(calc_post_hoc = TRUE), MAM = FALSE)
|
| | 0% ----------- FAILURE REPORT --------------
--- failure: the condition has length > 1 ---
--- srcref ---
:
--- package (from environment) ---
SensMixed
--- call from context ---
calcSatterthMultDF(rho, L)
--- call from argument ---
if (class(g) == "numeric") {
lapply(1:length(theopt), function(i) array(g[i], dim = dim(vcov.final)))
} else {
lapply(1:length(theopt), function(i) array(g[, i], dim = dim(vcov.final)))
}
--- R stacktrace ---
where 1: calcSatterthMultDF(rho, L)
where 2: calcSatt(rho, Lc)
where 3: calcFpvalueSS(Lc, rho, ddf, type)
where 4: calcFpvalueMAIN(term = tt, L = L, rho = rho, ddf = ddf, type = type)
where 5: FUN(X[[i]], ...)
where 6: lapply(test.terms, function(tt) calcFpvalueMAIN(term = tt, L = L,
rho = rho, ddf = ddf, type = type))
where 7: stepFun(model = model, ddf = ddf, type = type, alpha.random = alpha.random,
alpha.fixed = alpha.fixed, reduce.fixed = reduce.fixed, reduce.random = reduce.random,
fixed.calc = fixed.calc, lsmeans.calc = lsmeans.calc, difflsmeans.calc = difflsmeans.calc,
test.effs = test.effs, keep.effs = keep.effs, change.contr = TRUE)
where 8: step(m, reduce.fixed = FALSE, reduce.random = reduce.random,
alpha.random = alpha.random, alpha.fixed = alpha.fixed, lsmeans.calc = TRUE,
difflsmeans.calc = calc_post_hoc, keep.effs = keep.effs)
where 9: withCallingHandlers(expr, message = function(c) invokeRestart("muffleMessage"))
where 10: suppressMessages(st <- step(m, reduce.fixed = FALSE, reduce.random = reduce.random,
alpha.random = alpha.random, alpha.fixed = alpha.fixed, lsmeans.calc = TRUE,
difflsmeans.calc = calc_post_hoc, keep.effs = keep.effs))
where 11: .fun(piece, ...)
where 12: (function (i)
{
piece <- pieces[[i]]
if (.inform) {
res <- try(.fun(piece, ...))
if (inherits(res, "try-error")) {
piece <- paste(utils::capture.output(print(piece)),
collapse = "\n")
stop("with piece ", i, ": \n", piece, call. = FALSE)
}
}
else {
res <- .fun(piece, ...)
}
progress$step()
res
})(1L)
where 13: loop_apply(n, do.ply)
where 14: llply(attributes, .stepAllAttrNoMAM, product_structure = product_structure,
error_structure = error_structure, data = data, prod_effects = prod_effects,
random = random, reduce.random = rmatch(control, "reduce.random"),
alpha.random = rmatch(control, "alpha.random"), alpha.fixed = rmatch(control,
"alpha.fixed"), calc_post_hoc = rmatch(control, "calc_post_hoc"),
keep.effs = keep.effs, .progress = "text")
where 15: sensmixedFun(attributes = attributes, prod_effects = prod_effects,
assessor = assessor, replication = replication, data = data,
product_structure = product_structure, error_structure = error_structure,
MAM = MAM, control = control)
where 16: sensmixed(c("Noise", "Elasticeffect"), prod_effects = c("TVset",
"Picture"), assessor = "Assessor", data = TVbo, control = list(calc_post_hoc = TRUE),
MAM = FALSE)
--- value of length: 2 type: logical ---
[1] FALSE FALSE
--- function from context ---
function (rho, Lc)
{
vcov.final <- as.matrix(vcov(rho$model))
if (is.vector(Lc))
C.theta.optim <- as.matrix(t(Lc) %*% vcov.final %*% Lc)
else C.theta.optim <- as.matrix(Lc %*% vcov.final %*% t(Lc))
invC.theta <- tryCatch({
solve(C.theta.optim)
}, error = function(e) {
NULL
})
if (is.null(invC.theta))
return(list(denom = 0, Fstat = NA, pvalue = NA, ndf = NA,
ss = NA, ms = NA))
q <- qr(C.theta.optim)$rank
F.stat <- (t(Lc %*% rho$fixEffs) %*% invC.theta %*% (Lc %*%
rho$fixEffs))/q
svdec <- eigen(C.theta.optim)
PL <- t(svdec$vectors) %*% Lc
vss2 <- vcovTheta(rho$model)
theopt <- c(rho$thopt, rho$sigma)
g <- mygrad(function(x) vss2(x), theopt)
mat.grad <- if (class(g) == "numeric") {
lapply(1:length(theopt), function(i) array(g[i], dim = dim(vcov.final)))
}
else {
lapply(1:length(theopt), function(i) array(g[, i], dim = dim(vcov.final)))
}
nu.m.fun <- function(m) {
den.nu <- unlist(lapply(1:length(mat.grad), function(i) as.matrix(t(PL[m,
]) %*% mat.grad[[i]] %*% PL[m, ])))
2 * (svdec$values[m])^2/(t(den.nu) %*% rho$A %*% den.nu)
}
nu.m <- unlist(lapply(1:length(svdec$values), nu.m.fun))
nu.m[which(abs(2 - nu.m) < 1e-05)] <- 2.00001
E <- sum((nu.m/(nu.m - 2)) * as.numeric(nu.m > 2))
nu.F <- 2 * E * as.numeric(E > q)/(E - q)
pvalueF <- pf(F.stat, qr(Lc)$rank, nu.F, lower.tail = FALSE)
if (is.na(F.stat))
ms <- ss <- NA
else {
ms <- F.stat * rho$sigma^2
ss <- ms * q
}
return(list(ss = ss, ms = ms, denom = nu.F, Fstat = F.stat,
pvalue = pvalueF, ndf = q))
}
<bytecode: 0x55df6b19cef0>
<environment: namespace:SensMixed>
--- function search by body ---
Function calcSatterthMultDF in namespace SensMixed has this body.
----------- END OF FAILURE REPORT --------------
Error in if (class(g) == "numeric") { : the condition has length > 1
Calls: sensmixed ... calcFpvalueMAIN -> calcFpvalueSS -> calcSatt -> calcSatterthMultDF
Execution halted
Running the tests in ‘tests/testKEEPeffs.R’ failed.
Complete output:
> require(SensMixed)
Loading required package: SensMixed
>
> #convert some variables to factors in TVbo
> TVbo <- convertToFactors(TVbo, c("Assessor", "Repeat", "Picture"))
>
> res <- sensmixed(c("Coloursaturation", "Colourbalance"),
+ prod_effects = c("TVset", "Picture"), replication="Repeat",
+ assessor="Assessor", data=TVbo,
+ control = list(keep.effs = "Assessor"), MAM = FALSE)
|
| | 0%
----------- FAILURE REPORT --------------
--- failure: the condition has length > 1 ---
--- srcref ---
:
--- package (from environment) ---
SensMixed
--- call from context ---
calcSatterthMultDF(rho, L)
--- call from argument ---
if (class(g) == "numeric") {
lapply(1:length(theopt), function(i) array(g[i], dim = dim(vcov.final)))
} else {
lapply(1:length(theopt), function(i) array(g[, i], dim = dim(vcov.final)))
}
--- R stacktrace ---
where 1: calcSatterthMultDF(rho, L)
where 2: calcSatt(rho, Lc)
where 3: calcFpvalueSS(Lc, rho, ddf, type)
where 4: calcFpvalueMAIN(term = tt, L = L, rho = rho, ddf = ddf, type = type)
where 5: FUN(X[[i]], ...)
where 6: lapply(test.terms, function(tt) calcFpvalueMAIN(term = tt, L = L,
rho = rho, ddf = ddf, type = type))
where 7: stepFun(model = model, ddf = ddf, type = type, alpha.random = alpha.random,
alpha.fixed = alpha.fixed, reduce.fixed = reduce.fixed, reduce.random = reduce.random,
fixed.calc = fixed.calc, lsmeans.calc = lsmeans.calc, difflsmeans.calc = difflsmeans.calc,
test.effs = test.effs, keep.effs = keep.effs, change.contr = TRUE)
where 8: step(m, reduce.fixed = FALSE, reduce.random = reduce.random,
alpha.random = alpha.random, alpha.fixed = alpha.fixed, lsmeans.calc = TRUE,
difflsmeans.calc = calc_post_hoc, keep.effs = keep.effs)
where 9: withCallingHandlers(expr, message = function(c) invokeRestart("muffleMessage"))
where 10: suppressMessages(st <- step(m, reduce.fixed = FALSE, reduce.random = reduce.random,
alpha.random = alpha.random, alpha.fixed = alpha.fixed, lsmeans.calc = TRUE,
difflsmeans.calc = calc_post_hoc, keep.effs = keep.effs))
where 11: .fun(piece, ...)
where 12: (function (i)
{
piece <- pieces[[i]]
if (.inform) {
res <- try(.fun(piece, ...))
if (inherits(res, "try-error")) {
piece <- paste(utils::capture.output(print(piece)),
collapse = "\n")
stop("with piece ", i, ": \n", piece, call. = FALSE)
}
}
else {
res <- .fun(piece, ...)
}
progress$step()
res
})(1L)
where 13: loop_apply(n, do.ply)
where 14: llply(attributes, .stepAllAttrNoMAM, product_structure = product_structure,
error_structure = error_structure, data = data, prod_effects = prod_effects,
random = random, reduce.random = rmatch(control, "reduce.random"),
alpha.random = rmatch(control, "alpha.random"), alpha.fixed = rmatch(control,
"alpha.fixed"), calc_post_hoc = rmatch(control, "calc_post_hoc"),
keep.effs = keep.effs, .progress = "text")
where 15: sensmixedFun(attributes = attributes, prod_effects = prod_effects,
assessor = assessor, replication = replication, data = data,
product_structure = product_structure, error_structure = error_structure,
MAM = MAM, control = control)
where 16: sensmixed(c("Coloursaturation", "Colourbalance"), prod_effects = c("TVset",
"Picture"), replication = "Repeat", assessor = "Assessor",
data = TVbo, control = list(keep.effs = "Assessor"), MAM = FALSE)
--- value of length: 2 type: logical ---
[1] FALSE FALSE
--- function from context ---
function (rho, Lc)
{
vcov.final <- as.matrix(vcov(rho$model))
if (is.vector(Lc))
C.theta.optim <- as.matrix(t(Lc) %*% vcov.final %*% Lc)
else C.theta.optim <- as.matrix(Lc %*% vcov.final %*% t(Lc))
invC.theta <- tryCatch({
solve(C.theta.optim)
}, error = function(e) {
NULL
})
if (is.null(invC.theta))
return(list(denom = 0, Fstat = NA, pvalue = NA, ndf = NA,
ss = NA, ms = NA))
q <- qr(C.theta.optim)$rank
F.stat <- (t(Lc %*% rho$fixEffs) %*% invC.theta %*% (Lc %*%
rho$fixEffs))/q
svdec <- eigen(C.theta.optim)
PL <- t(svdec$vectors) %*% Lc
vss2 <- vcovTheta(rho$model)
theopt <- c(rho$thopt, rho$sigma)
g <- mygrad(function(x) vss2(x), theopt)
mat.grad <- if (class(g) == "numeric") {
lapply(1:length(theopt), function(i) array(g[i], dim = dim(vcov.final)))
}
else {
lapply(1:length(theopt), function(i) array(g[, i], dim = dim(vcov.final)))
}
nu.m.fun <- function(m) {
den.nu <- unlist(lapply(1:length(mat.grad), function(i) as.matrix(t(PL[m,
]) %*% mat.grad[[i]] %*% PL[m, ])))
2 * (svdec$values[m])^2/(t(den.nu) %*% rho$A %*% den.nu)
}
nu.m <- unlist(lapply(1:length(svdec$values), nu.m.fun))
nu.m[which(abs(2 - nu.m) < 1e-05)] <- 2.00001
E <- sum((nu.m/(nu.m - 2)) * as.numeric(nu.m > 2))
nu.F <- 2 * E * as.numeric(E > q)/(E - q)
pvalueF <- pf(F.stat, qr(Lc)$rank, nu.F, lower.tail = FALSE)
if (is.na(F.stat))
ms <- ss <- NA
else {
ms <- F.stat * rho$sigma^2
ss <- ms * q
}
return(list(ss = ss, ms = ms, denom = nu.F, Fstat = F.stat,
pvalue = pvalueF, ndf = q))
}
<bytecode: 0x55cafb06c250>
<environment: namespace:SensMixed>
--- function search by body ---
Function calcSatterthMultDF in namespace SensMixed has this body.
----------- END OF FAILURE REPORT --------------
Error in if (class(g) == "numeric") { : the condition has length > 1
Calls: sensmixed ... calcFpvalueMAIN -> calcFpvalueSS -> calcSatt -> calcSatterthMultDF
In addition: Warning messages:
1: In checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, :
Model failed to converge with max|grad| = 0.00767249 (tol = 0.002, component 1)
2: In checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, :
Model failed to converge with max|grad| = 0.00296669 (tol = 0.002, component 1)
3: In checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, :
Model failed to converge with max|grad| = 0.0227178 (tol = 0.002, component 1)
4: In checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, :
unable to evaluate scaled gradient
5: In checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, :
Model failed to converge: degenerate Hessian with 1 negative eigenvalues
6: In checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, :
Model failed to converge with max|grad| = 0.00329232 (tol = 0.002, component 1)
Execution halted
Flavor: r-devel-linux-x86_64-debian-gcc
Version: 2.1-0
Check: examples
Result: ERROR
Running examples in ‘SensMixed-Ex.R’ failed
The error most likely occurred in:
> ### Name: TVbo
> ### Title: TV dataset
> ### Aliases: TVbo
> ### Keywords: datasets
>
> ### ** Examples
>
> ## import SensMixed package
> library(SensMixed)
>
> ## convert some variables to factors in TVbo
> TVbo <- convertToFactors(TVbo, c("Assessor", "Repeat", "Picture"))
>
> ## run automated selection process
> res <- sensmixed(c("Coloursaturation", "Colourbalance"),
+ prod_effects = c("TVset", "Picture"),
+ assessor="Assessor", data=TVbo, MAM=FALSE)
|
| | 0%Warning in checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, :
Model failed to converge with max|grad| = 0.00592903 (tol = 0.002, component 1)
----------- FAILURE REPORT --------------
--- failure: the condition has length > 1 ---
--- srcref ---
:
--- package (from environment) ---
SensMixed
--- call from context ---
calcSatterthMultDF(rho, L)
--- call from argument ---
if (class(g) == "numeric") {
lapply(1:length(theopt), function(i) array(g[i], dim = dim(vcov.final)))
} else {
lapply(1:length(theopt), function(i) array(g[, i], dim = dim(vcov.final)))
}
--- R stacktrace ---
where 1: calcSatterthMultDF(rho, L)
where 2: calcSatt(rho, Lc)
where 3: calcFpvalueSS(Lc, rho, ddf, type)
where 4: calcFpvalueMAIN(term = tt, L = L, rho = rho, ddf = ddf, type = type)
where 5: FUN(X[[i]], ...)
where 6: lapply(test.terms, function(tt) calcFpvalueMAIN(term = tt, L = L,
rho = rho, ddf = ddf, type = type))
where 7: stepFun(model = model, ddf = ddf, type = type, alpha.random = alpha.random,
alpha.fixed = alpha.fixed, reduce.fixed = reduce.fixed, reduce.random = reduce.random,
fixed.calc = fixed.calc, lsmeans.calc = lsmeans.calc, difflsmeans.calc = difflsmeans.calc,
test.effs = test.effs, keep.effs = keep.effs, change.contr = TRUE)
where 8: step(m, reduce.fixed = FALSE, reduce.random = reduce.random,
alpha.random = alpha.random, alpha.fixed = alpha.fixed, lsmeans.calc = TRUE,
difflsmeans.calc = calc_post_hoc, keep.effs = keep.effs)
where 9: withCallingHandlers(expr, message = function(c) invokeRestart("muffleMessage"))
where 10: suppressMessages(st <- step(m, reduce.fixed = FALSE, reduce.random = reduce.random,
alpha.random = alpha.random, alpha.fixed = alpha.fixed, lsmeans.calc = TRUE,
difflsmeans.calc = calc_post_hoc, keep.effs = keep.effs))
where 11: .fun(piece, ...)
where 12: (function (i)
{
piece <- pieces[[i]]
if (.inform) {
res <- try(.fun(piece, ...))
if (inherits(res, "try-error")) {
piece <- paste(utils::capture.output(print(piece)),
collapse = "\n")
stop("with piece ", i, ": \n", piece, call. = FALSE)
}
}
else {
res <- .fun(piece, ...)
}
progress$step()
res
})(1L)
where 13: loop_apply(n, do.ply)
where 14: llply(attributes, .stepAllAttrNoMAM, product_structure = product_structure,
error_structure = error_structure, data = data, prod_effects = prod_effects,
random = random, reduce.random = rmatch(control, "reduce.random"),
alpha.random = rmatch(control, "alpha.random"), alpha.fixed = rmatch(control,
"alpha.fixed"), calc_post_hoc = rmatch(control, "calc_post_hoc"),
keep.effs = keep.effs, .progress = "text")
where 15: sensmixedFun(attributes = attributes, prod_effects = prod_effects,
assessor = assessor, replication = replication, data = data,
product_structure = product_structure, error_structure = error_structure,
MAM = MAM, control = control)
where 16: sensmixed(c("Coloursaturation", "Colourbalance"), prod_effects = c("TVset",
"Picture"), assessor = "Assessor", data = TVbo, MAM = FALSE)
--- value of length: 2 type: logical ---
[1] FALSE FALSE
--- function from context ---
function (rho, Lc)
{
vcov.final <- as.matrix(vcov(rho$model))
if (is.vector(Lc))
C.theta.optim <- as.matrix(t(Lc) %*% vcov.final %*% Lc)
else C.theta.optim <- as.matrix(Lc %*% vcov.final %*% t(Lc))
invC.theta <- tryCatch({
solve(C.theta.optim)
}, error = function(e) {
NULL
})
if (is.null(invC.theta))
return(list(denom = 0, Fstat = NA, pvalue = NA, ndf = NA,
ss = NA, ms = NA))
q <- qr(C.theta.optim)$rank
F.stat <- (t(Lc %*% rho$fixEffs) %*% invC.theta %*% (Lc %*%
rho$fixEffs))/q
svdec <- eigen(C.theta.optim)
PL <- t(svdec$vectors) %*% Lc
vss2 <- vcovTheta(rho$model)
theopt <- c(rho$thopt, rho$sigma)
g <- mygrad(function(x) vss2(x), theopt)
mat.grad <- if (class(g) == "numeric") {
lapply(1:length(theopt), function(i) array(g[i], dim = dim(vcov.final)))
}
else {
lapply(1:length(theopt), function(i) array(g[, i], dim = dim(vcov.final)))
}
nu.m.fun <- function(m) {
den.nu <- unlist(lapply(1:length(mat.grad), function(i) as.matrix(t(PL[m,
]) %*% mat.grad[[i]] %*% PL[m, ])))
2 * (svdec$values[m])^2/(t(den.nu) %*% rho$A %*% den.nu)
}
nu.m <- unlist(lapply(1:length(svdec$values), nu.m.fun))
nu.m[which(abs(2 - nu.m) < 1e-05)] <- 2.00001
E <- sum((nu.m/(nu.m - 2)) * as.numeric(nu.m > 2))
nu.F <- 2 * E * as.numeric(E > q)/(E - q)
pvalueF <- pf(F.stat, qr(Lc)$rank, nu.F, lower.tail = FALSE)
if (is.na(F.stat))
ms <- ss <- NA
else {
ms <- F.stat * rho$sigma^2
ss <- ms * q
}
return(list(ss = ss, ms = ms, denom = nu.F, Fstat = F.stat,
pvalue = pvalueF, ndf = q))
}
<bytecode: 0xee20718>
<environment: namespace:SensMixed>
--- function search by body ---
Function calcSatterthMultDF in namespace SensMixed has this body.
----------- END OF FAILURE REPORT --------------
Error in if (class(g) == "numeric") { : the condition has length > 1
Calls: sensmixed ... calcFpvalueMAIN -> calcFpvalueSS -> calcSatt -> calcSatterthMultDF
Execution halted
Flavor: r-devel-linux-x86_64-fedora-clang
Version: 2.1-0
Check: tests
Result: ERROR
Running ‘bugBO.R’
Running ‘bugKEEPdprime.R’
Running ‘testBugResiduals.R’ [10s/11s]
Running ‘testDprimes.R’ [12s/13s]
Running ‘testKEEPeffs.R’ [36s/41s]
Running ‘testRep.R’
Running the tests in ‘tests/testBugResiduals.R’ failed.
Complete output:
> testOST <- FALSE
>
> library(SensMixed)
> load(system.file("testdata","bugResiddat.RData",package="SensMixed"))
> load(system.file("testdata","bb.RData",package="SensMixed"))
> load(system.file("testdata","ost.RData",package="SensMixed"))
>
> response <- c("liking")
> fixed <- list(Product = c("Sugar", "Acid"))
> random <- c("consumer")
> facs <- c("consumer", "Sugar", "Acid")
>
> res <- conjoint(structure = 3, dat, response, fixed, random, facs)
[1] "Calculating liking ..."
Number of levels for interaction consumer:Sugar:Acid is more or equal to the number of observations in data
Number of levels for interaction consumer:Sugar:Acid is more or equal to the number of observations in data
boundary (singular) fit: see ?isSingular
----------- FAILURE REPORT --------------
--- failure: the condition has length > 1 ---
--- srcref ---
:
--- package (from environment) ---
SensMixed
--- call from context ---
calcSatterthMultDF(rho, L)
--- call from argument ---
if (class(g) == "numeric") {
lapply(1:length(theopt), function(i) array(g[i], dim = dim(vcov.final)))
} else {
lapply(1:length(theopt), function(i) array(g[, i], dim = dim(vcov.final)))
}
--- R stacktrace ---
where 1: calcSatterthMultDF(rho, L)
where 2: calcSatt(rho, Lc)
where 3: calcFpvalueSS(Lc, rho, ddf, type)
where 4: calcFpvalueMAIN(term = tt, L = L, rho = rho, ddf = ddf, type = type)
where 5: FUN(X[[i]], ...)
where 6: lapply(test.terms, function(tt) calcFpvalueMAIN(term = tt, L = L,
rho = rho, ddf = ddf, type = type))
where 7: stepFun(model = model, ddf = ddf, type = type, alpha.random = alpha.random,
alpha.fixed = alpha.fixed, reduce.fixed = reduce.fixed, reduce.random = reduce.random,
fixed.calc = fixed.calc, lsmeans.calc = lsmeans.calc, difflsmeans.calc = difflsmeans.calc,
test.effs = test.effs, keep.effs = keep.effs, change.contr = TRUE)
where 8: step(model, reduce.fixed = isFixReduce, reduce.random = isRandReduce,
alpha.random = alpha.random, alpha.fixed = alpha.fixed)
where 9: withCallingHandlers(expr, message = function(c) invokeRestart("muffleMessage"))
where 10: suppressMessages(t <- step(model, reduce.fixed = isFixReduce,
reduce.random = isRandReduce, alpha.random = alpha.random,
alpha.fixed = alpha.fixed))
where 11: conjointFun(structure = structure, data = data, response = response,
fixed = fixed, random = random, facs = facs, corr = FALSE,
alpha.random = alpha.random, alpha.fixed = alpha.fixed)
where 12: conjoint(structure = 3, dat, response, fixed, random, facs)
--- value of length: 2 type: logical ---
[1] FALSE FALSE
--- function from context ---
function (rho, Lc)
{
vcov.final <- as.matrix(vcov(rho$model))
if (is.vector(Lc))
C.theta.optim <- as.matrix(t(Lc) %*% vcov.final %*% Lc)
else C.theta.optim <- as.matrix(Lc %*% vcov.final %*% t(Lc))
invC.theta <- tryCatch({
solve(C.theta.optim)
}, error = function(e) {
NULL
})
if (is.null(invC.theta))
return(list(denom = 0, Fstat = NA, pvalue = NA, ndf = NA,
ss = NA, ms = NA))
q <- qr(C.theta.optim)$rank
F.stat <- (t(Lc %*% rho$fixEffs) %*% invC.theta %*% (Lc %*%
rho$fixEffs))/q
svdec <- eigen(C.theta.optim)
PL <- t(svdec$vectors) %*% Lc
vss2 <- vcovTheta(rho$model)
theopt <- c(rho$thopt, rho$sigma)
g <- mygrad(function(x) vss2(x), theopt)
mat.grad <- if (class(g) == "numeric") {
lapply(1:length(theopt), function(i) array(g[i], dim = dim(vcov.final)))
}
else {
lapply(1:length(theopt), function(i) array(g[, i], dim = dim(vcov.final)))
}
nu.m.fun <- function(m) {
den.nu <- unlist(lapply(1:length(mat.grad), function(i) as.matrix(t(PL[m,
]) %*% mat.grad[[i]] %*% PL[m, ])))
2 * (svdec$values[m])^2/(t(den.nu) %*% rho$A %*% den.nu)
}
nu.m <- unlist(lapply(1:length(svdec$values), nu.m.fun))
nu.m[which(abs(2 - nu.m) < 1e-05)] <- 2.00001
E <- sum((nu.m/(nu.m - 2)) * as.numeric(nu.m > 2))
nu.F <- 2 * E * as.numeric(E > q)/(E - q)
pvalueF <- pf(F.stat, qr(Lc)$rank, nu.F, lower.tail = FALSE)
if (is.na(F.stat))
ms <- ss <- NA
else {
ms <- F.stat * rho$sigma^2
ss <- ms * q
}
return(list(ss = ss, ms = ms, denom = nu.F, Fstat = F.stat,
pvalue = pvalueF, ndf = q))
}
<bytecode: 0xc1e5958>
<environment: namespace:SensMixed>
--- function search by body ---
Function calcSatterthMultDF in namespace SensMixed has this body.
----------- END OF FAILURE REPORT --------------
Error in if (class(g) == "numeric") { : the condition has length > 1
Calls: conjoint ... calcFpvalueMAIN -> calcFpvalueSS -> calcSatt -> calcSatterthMultDF
Execution halted
Running the tests in ‘tests/testDprimes.R’ failed.
Complete output:
> require(SensMixed)
Loading required package: SensMixed
> load(system.file("testdata","sensBObalanc.RData",package="SensMixed"))
> load(system.file("testdata","sensBO.RData",package="SensMixed"))
> testBO <- FALSE
> ###########################################
> ## check for TVbo without replication
> ###########################################
>
>
>
> TVbo <- convertToFactors(TVbo, c("Assessor", "Repeat", "Picture"))
> result <- sensmixed(c("Noise", "Elasticeffect"),
+ prod_effects = c("TVset", "Picture"),
+ assessor = "Assessor", data = TVbo,
+ control = list(calc_post_hoc = TRUE), MAM = FALSE)
|
| | 0% ----------- FAILURE REPORT --------------
--- failure: the condition has length > 1 ---
--- srcref ---
:
--- package (from environment) ---
SensMixed
--- call from context ---
calcSatterthMultDF(rho, L)
--- call from argument ---
if (class(g) == "numeric") {
lapply(1:length(theopt), function(i) array(g[i], dim = dim(vcov.final)))
} else {
lapply(1:length(theopt), function(i) array(g[, i], dim = dim(vcov.final)))
}
--- R stacktrace ---
where 1: calcSatterthMultDF(rho, L)
where 2: calcSatt(rho, Lc)
where 3: calcFpvalueSS(Lc, rho, ddf, type)
where 4: calcFpvalueMAIN(term = tt, L = L, rho = rho, ddf = ddf, type = type)
where 5: FUN(X[[i]], ...)
where 6: lapply(test.terms, function(tt) calcFpvalueMAIN(term = tt, L = L,
rho = rho, ddf = ddf, type = type))
where 7: stepFun(model = model, ddf = ddf, type = type, alpha.random = alpha.random,
alpha.fixed = alpha.fixed, reduce.fixed = reduce.fixed, reduce.random = reduce.random,
fixed.calc = fixed.calc, lsmeans.calc = lsmeans.calc, difflsmeans.calc = difflsmeans.calc,
test.effs = test.effs, keep.effs = keep.effs, change.contr = TRUE)
where 8: step(m, reduce.fixed = FALSE, reduce.random = reduce.random,
alpha.random = alpha.random, alpha.fixed = alpha.fixed, lsmeans.calc = TRUE,
difflsmeans.calc = calc_post_hoc, keep.effs = keep.effs)
where 9: withCallingHandlers(expr, message = function(c) invokeRestart("muffleMessage"))
where 10: suppressMessages(st <- step(m, reduce.fixed = FALSE, reduce.random = reduce.random,
alpha.random = alpha.random, alpha.fixed = alpha.fixed, lsmeans.calc = TRUE,
difflsmeans.calc = calc_post_hoc, keep.effs = keep.effs))
where 11: .fun(piece, ...)
where 12: (function (i)
{
piece <- pieces[[i]]
if (.inform) {
res <- try(.fun(piece, ...))
if (inherits(res, "try-error")) {
piece <- paste(utils::capture.output(print(piece)),
collapse = "\n")
stop("with piece ", i, ": \n", piece, call. = FALSE)
}
}
else {
res <- .fun(piece, ...)
}
progress$step()
res
})(1L)
where 13: loop_apply(n, do.ply)
where 14: llply(attributes, .stepAllAttrNoMAM, product_structure = product_structure,
error_structure = error_structure, data = data, prod_effects = prod_effects,
random = random, reduce.random = rmatch(control, "reduce.random"),
alpha.random = rmatch(control, "alpha.random"), alpha.fixed = rmatch(control,
"alpha.fixed"), calc_post_hoc = rmatch(control, "calc_post_hoc"),
keep.effs = keep.effs, .progress = "text")
where 15: sensmixedFun(attributes = attributes, prod_effects = prod_effects,
assessor = assessor, replication = replication, data = data,
product_structure = product_structure, error_structure = error_structure,
MAM = MAM, control = control)
where 16: sensmixed(c("Noise", "Elasticeffect"), prod_effects = c("TVset",
"Picture"), assessor = "Assessor", data = TVbo, control = list(calc_post_hoc = TRUE),
MAM = FALSE)
--- value of length: 2 type: logical ---
[1] FALSE FALSE
--- function from context ---
function (rho, Lc)
{
vcov.final <- as.matrix(vcov(rho$model))
if (is.vector(Lc))
C.theta.optim <- as.matrix(t(Lc) %*% vcov.final %*% Lc)
else C.theta.optim <- as.matrix(Lc %*% vcov.final %*% t(Lc))
invC.theta <- tryCatch({
solve(C.theta.optim)
}, error = function(e) {
NULL
})
if (is.null(invC.theta))
return(list(denom = 0, Fstat = NA, pvalue = NA, ndf = NA,
ss = NA, ms = NA))
q <- qr(C.theta.optim)$rank
F.stat <- (t(Lc %*% rho$fixEffs) %*% invC.theta %*% (Lc %*%
rho$fixEffs))/q
svdec <- eigen(C.theta.optim)
PL <- t(svdec$vectors) %*% Lc
vss2 <- vcovTheta(rho$model)
theopt <- c(rho$thopt, rho$sigma)
g <- mygrad(function(x) vss2(x), theopt)
mat.grad <- if (class(g) == "numeric") {
lapply(1:length(theopt), function(i) array(g[i], dim = dim(vcov.final)))
}
else {
lapply(1:length(theopt), function(i) array(g[, i], dim = dim(vcov.final)))
}
nu.m.fun <- function(m) {
den.nu <- unlist(lapply(1:length(mat.grad), function(i) as.matrix(t(PL[m,
]) %*% mat.grad[[i]] %*% PL[m, ])))
2 * (svdec$values[m])^2/(t(den.nu) %*% rho$A %*% den.nu)
}
nu.m <- unlist(lapply(1:length(svdec$values), nu.m.fun))
nu.m[which(abs(2 - nu.m) < 1e-05)] <- 2.00001
E <- sum((nu.m/(nu.m - 2)) * as.numeric(nu.m > 2))
nu.F <- 2 * E * as.numeric(E > q)/(E - q)
pvalueF <- pf(F.stat, qr(Lc)$rank, nu.F, lower.tail = FALSE)
if (is.na(F.stat))
ms <- ss <- NA
else {
ms <- F.stat * rho$sigma^2
ss <- ms * q
}
return(list(ss = ss, ms = ms, denom = nu.F, Fstat = F.stat,
pvalue = pvalueF, ndf = q))
}
<bytecode: 0xde8b5e0>
<environment: namespace:SensMixed>
--- function search by body ---
Function calcSatterthMultDF in namespace SensMixed has this body.
----------- END OF FAILURE REPORT --------------
Error in if (class(g) == "numeric") { : the condition has length > 1
Calls: sensmixed ... calcFpvalueMAIN -> calcFpvalueSS -> calcSatt -> calcSatterthMultDF
Execution halted
Running the tests in ‘tests/testKEEPeffs.R’ failed.
Complete output:
> require(SensMixed)
Loading required package: SensMixed
>
> #convert some variables to factors in TVbo
> TVbo <- convertToFactors(TVbo, c("Assessor", "Repeat", "Picture"))
>
> res <- sensmixed(c("Coloursaturation", "Colourbalance"),
+ prod_effects = c("TVset", "Picture"), replication="Repeat",
+ assessor="Assessor", data=TVbo,
+ control = list(keep.effs = "Assessor"), MAM = FALSE)
|
| | 0%
----------- FAILURE REPORT --------------
--- failure: the condition has length > 1 ---
--- srcref ---
:
--- package (from environment) ---
SensMixed
--- call from context ---
calcSatterthMultDF(rho, L)
--- call from argument ---
if (class(g) == "numeric") {
lapply(1:length(theopt), function(i) array(g[i], dim = dim(vcov.final)))
} else {
lapply(1:length(theopt), function(i) array(g[, i], dim = dim(vcov.final)))
}
--- R stacktrace ---
where 1: calcSatterthMultDF(rho, L)
where 2: calcSatt(rho, Lc)
where 3: calcFpvalueSS(Lc, rho, ddf, type)
where 4: calcFpvalueMAIN(term = tt, L = L, rho = rho, ddf = ddf, type = type)
where 5: FUN(X[[i]], ...)
where 6: lapply(test.terms, function(tt) calcFpvalueMAIN(term = tt, L = L,
rho = rho, ddf = ddf, type = type))
where 7: stepFun(model = model, ddf = ddf, type = type, alpha.random = alpha.random,
alpha.fixed = alpha.fixed, reduce.fixed = reduce.fixed, reduce.random = reduce.random,
fixed.calc = fixed.calc, lsmeans.calc = lsmeans.calc, difflsmeans.calc = difflsmeans.calc,
test.effs = test.effs, keep.effs = keep.effs, change.contr = TRUE)
where 8: step(m, reduce.fixed = FALSE, reduce.random = reduce.random,
alpha.random = alpha.random, alpha.fixed = alpha.fixed, lsmeans.calc = TRUE,
difflsmeans.calc = calc_post_hoc, keep.effs = keep.effs)
where 9: withCallingHandlers(expr, message = function(c) invokeRestart("muffleMessage"))
where 10: suppressMessages(st <- step(m, reduce.fixed = FALSE, reduce.random = reduce.random,
alpha.random = alpha.random, alpha.fixed = alpha.fixed, lsmeans.calc = TRUE,
difflsmeans.calc = calc_post_hoc, keep.effs = keep.effs))
where 11: .fun(piece, ...)
where 12: (function (i)
{
piece <- pieces[[i]]
if (.inform) {
res <- try(.fun(piece, ...))
if (inherits(res, "try-error")) {
piece <- paste(utils::capture.output(print(piece)),
collapse = "\n")
stop("with piece ", i, ": \n", piece, call. = FALSE)
}
}
else {
res <- .fun(piece, ...)
}
progress$step()
res
})(1L)
where 13: loop_apply(n, do.ply)
where 14: llply(attributes, .stepAllAttrNoMAM, product_structure = product_structure,
error_structure = error_structure, data = data, prod_effects = prod_effects,
random = random, reduce.random = rmatch(control, "reduce.random"),
alpha.random = rmatch(control, "alpha.random"), alpha.fixed = rmatch(control,
"alpha.fixed"), calc_post_hoc = rmatch(control, "calc_post_hoc"),
keep.effs = keep.effs, .progress = "text")
where 15: sensmixedFun(attributes = attributes, prod_effects = prod_effects,
assessor = assessor, replication = replication, data = data,
product_structure = product_structure, error_structure = error_structure,
MAM = MAM, control = control)
where 16: sensmixed(c("Coloursaturation", "Colourbalance"), prod_effects = c("TVset",
"Picture"), replication = "Repeat", assessor = "Assessor",
data = TVbo, control = list(keep.effs = "Assessor"), MAM = FALSE)
--- value of length: 2 type: logical ---
[1] FALSE FALSE
--- function from context ---
function (rho, Lc)
{
vcov.final <- as.matrix(vcov(rho$model))
if (is.vector(Lc))
C.theta.optim <- as.matrix(t(Lc) %*% vcov.final %*% Lc)
else C.theta.optim <- as.matrix(Lc %*% vcov.final %*% t(Lc))
invC.theta <- tryCatch({
solve(C.theta.optim)
}, error = function(e) {
NULL
})
if (is.null(invC.theta))
return(list(denom = 0, Fstat = NA, pvalue = NA, ndf = NA,
ss = NA, ms = NA))
q <- qr(C.theta.optim)$rank
F.stat <- (t(Lc %*% rho$fixEffs) %*% invC.theta %*% (Lc %*%
rho$fixEffs))/q
svdec <- eigen(C.theta.optim)
PL <- t(svdec$vectors) %*% Lc
vss2 <- vcovTheta(rho$model)
theopt <- c(rho$thopt, rho$sigma)
g <- mygrad(function(x) vss2(x), theopt)
mat.grad <- if (class(g) == "numeric") {
lapply(1:length(theopt), function(i) array(g[i], dim = dim(vcov.final)))
}
else {
lapply(1:length(theopt), function(i) array(g[, i], dim = dim(vcov.final)))
}
nu.m.fun <- function(m) {
den.nu <- unlist(lapply(1:length(mat.grad), function(i) as.matrix(t(PL[m,
]) %*% mat.grad[[i]] %*% PL[m, ])))
2 * (svdec$values[m])^2/(t(den.nu) %*% rho$A %*% den.nu)
}
nu.m <- unlist(lapply(1:length(svdec$values), nu.m.fun))
nu.m[which(abs(2 - nu.m) < 1e-05)] <- 2.00001
E <- sum((nu.m/(nu.m - 2)) * as.numeric(nu.m > 2))
nu.F <- 2 * E * as.numeric(E > q)/(E - q)
pvalueF <- pf(F.stat, qr(Lc)$rank, nu.F, lower.tail = FALSE)
if (is.na(F.stat))
ms <- ss <- NA
else {
ms <- F.stat * rho$sigma^2
ss <- ms * q
}
return(list(ss = ss, ms = ms, denom = nu.F, Fstat = F.stat,
pvalue = pvalueF, ndf = q))
}
<bytecode: 0xca19168>
<environment: namespace:SensMixed>
--- function search by body ---
Function calcSatterthMultDF in namespace SensMixed has this body.
----------- END OF FAILURE REPORT --------------
Error in if (class(g) == "numeric") { : the condition has length > 1
Calls: sensmixed ... calcFpvalueMAIN -> calcFpvalueSS -> calcSatt -> calcSatterthMultDF
In addition: Warning messages:
1: In checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, :
Model failed to converge with max|grad| = 0.00767249 (tol = 0.002, component 1)
2: In checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, :
Model failed to converge with max|grad| = 0.00296669 (tol = 0.002, component 1)
3: In checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, :
Model failed to converge with max|grad| = 0.0227178 (tol = 0.002, component 1)
4: In checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, :
unable to evaluate scaled gradient
5: In checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, :
Model failed to converge: degenerate Hessian with 1 negative eigenvalues
6: In checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, :
Model failed to converge with max|grad| = 0.00329232 (tol = 0.002, component 1)
Execution halted
Flavor: r-devel-linux-x86_64-fedora-clang
Version: 2.1-0
Check: examples
Result: ERROR
Running examples in ‘SensMixed-Ex.R’ failed
The error most likely occurred in:
> ### Name: TVbo
> ### Title: TV dataset
> ### Aliases: TVbo
> ### Keywords: datasets
>
> ### ** Examples
>
> ## import SensMixed package
> library(SensMixed)
>
> ## convert some variables to factors in TVbo
> TVbo <- convertToFactors(TVbo, c("Assessor", "Repeat", "Picture"))
>
> ## run automated selection process
> res <- sensmixed(c("Coloursaturation", "Colourbalance"),
+ prod_effects = c("TVset", "Picture"),
+ assessor="Assessor", data=TVbo, MAM=FALSE)
|
| | 0%Warning in checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, :
Model failed to converge with max|grad| = 0.00592903 (tol = 0.002, component 1)
----------- FAILURE REPORT --------------
--- failure: the condition has length > 1 ---
--- srcref ---
:
--- package (from environment) ---
SensMixed
--- call from context ---
calcSatterthMultDF(rho, L)
--- call from argument ---
if (class(g) == "numeric") {
lapply(1:length(theopt), function(i) array(g[i], dim = dim(vcov.final)))
} else {
lapply(1:length(theopt), function(i) array(g[, i], dim = dim(vcov.final)))
}
--- R stacktrace ---
where 1: calcSatterthMultDF(rho, L)
where 2: calcSatt(rho, Lc)
where 3: calcFpvalueSS(Lc, rho, ddf, type)
where 4: calcFpvalueMAIN(term = tt, L = L, rho = rho, ddf = ddf, type = type)
where 5: FUN(X[[i]], ...)
where 6: lapply(test.terms, function(tt) calcFpvalueMAIN(term = tt, L = L,
rho = rho, ddf = ddf, type = type))
where 7: stepFun(model = model, ddf = ddf, type = type, alpha.random = alpha.random,
alpha.fixed = alpha.fixed, reduce.fixed = reduce.fixed, reduce.random = reduce.random,
fixed.calc = fixed.calc, lsmeans.calc = lsmeans.calc, difflsmeans.calc = difflsmeans.calc,
test.effs = test.effs, keep.effs = keep.effs, change.contr = TRUE)
where 8: step(m, reduce.fixed = FALSE, reduce.random = reduce.random,
alpha.random = alpha.random, alpha.fixed = alpha.fixed, lsmeans.calc = TRUE,
difflsmeans.calc = calc_post_hoc, keep.effs = keep.effs)
where 9: withCallingHandlers(expr, message = function(c) invokeRestart("muffleMessage"))
where 10: suppressMessages(st <- step(m, reduce.fixed = FALSE, reduce.random = reduce.random,
alpha.random = alpha.random, alpha.fixed = alpha.fixed, lsmeans.calc = TRUE,
difflsmeans.calc = calc_post_hoc, keep.effs = keep.effs))
where 11: .fun(piece, ...)
where 12: (function (i)
{
piece <- pieces[[i]]
if (.inform) {
res <- try(.fun(piece, ...))
if (inherits(res, "try-error")) {
piece <- paste(utils::capture.output(print(piece)),
collapse = "\n")
stop("with piece ", i, ": \n", piece, call. = FALSE)
}
}
else {
res <- .fun(piece, ...)
}
progress$step()
res
})(1L)
where 13: loop_apply(n, do.ply)
where 14: llply(attributes, .stepAllAttrNoMAM, product_structure = product_structure,
error_structure = error_structure, data = data, prod_effects = prod_effects,
random = random, reduce.random = rmatch(control, "reduce.random"),
alpha.random = rmatch(control, "alpha.random"), alpha.fixed = rmatch(control,
"alpha.fixed"), calc_post_hoc = rmatch(control, "calc_post_hoc"),
keep.effs = keep.effs, .progress = "text")
where 15: sensmixedFun(attributes = attributes, prod_effects = prod_effects,
assessor = assessor, replication = replication, data = data,
product_structure = product_structure, error_structure = error_structure,
MAM = MAM, control = control)
where 16: sensmixed(c("Coloursaturation", "Colourbalance"), prod_effects = c("TVset",
"Picture"), assessor = "Assessor", data = TVbo, MAM = FALSE)
--- value of length: 2 type: logical ---
[1] FALSE FALSE
--- function from context ---
function (rho, Lc)
{
vcov.final <- as.matrix(vcov(rho$model))
if (is.vector(Lc))
C.theta.optim <- as.matrix(t(Lc) %*% vcov.final %*% Lc)
else C.theta.optim <- as.matrix(Lc %*% vcov.final %*% t(Lc))
invC.theta <- tryCatch({
solve(C.theta.optim)
}, error = function(e) {
NULL
})
if (is.null(invC.theta))
return(list(denom = 0, Fstat = NA, pvalue = NA, ndf = NA,
ss = NA, ms = NA))
q <- qr(C.theta.optim)$rank
F.stat <- (t(Lc %*% rho$fixEffs) %*% invC.theta %*% (Lc %*%
rho$fixEffs))/q
svdec <- eigen(C.theta.optim)
PL <- t(svdec$vectors) %*% Lc
vss2 <- vcovTheta(rho$model)
theopt <- c(rho$thopt, rho$sigma)
g <- mygrad(function(x) vss2(x), theopt)
mat.grad <- if (class(g) == "numeric") {
lapply(1:length(theopt), function(i) array(g[i], dim = dim(vcov.final)))
}
else {
lapply(1:length(theopt), function(i) array(g[, i], dim = dim(vcov.final)))
}
nu.m.fun <- function(m) {
den.nu <- unlist(lapply(1:length(mat.grad), function(i) as.matrix(t(PL[m,
]) %*% mat.grad[[i]] %*% PL[m, ])))
2 * (svdec$values[m])^2/(t(den.nu) %*% rho$A %*% den.nu)
}
nu.m <- unlist(lapply(1:length(svdec$values), nu.m.fun))
nu.m[which(abs(2 - nu.m) < 1e-05)] <- 2.00001
E <- sum((nu.m/(nu.m - 2)) * as.numeric(nu.m > 2))
nu.F <- 2 * E * as.numeric(E > q)/(E - q)
pvalueF <- pf(F.stat, qr(Lc)$rank, nu.F, lower.tail = FALSE)
if (is.na(F.stat))
ms <- ss <- NA
else {
ms <- F.stat * rho$sigma^2
ss <- ms * q
}
return(list(ss = ss, ms = ms, denom = nu.F, Fstat = F.stat,
pvalue = pvalueF, ndf = q))
}
<bytecode: 0xab7cb90>
<environment: namespace:SensMixed>
--- function search by body ---
Function calcSatterthMultDF in namespace SensMixed has this body.
----------- END OF FAILURE REPORT --------------
Error in if (class(g) == "numeric") { : the condition has length > 1
Calls: sensmixed ... calcFpvalueMAIN -> calcFpvalueSS -> calcSatt -> calcSatterthMultDF
Execution halted
Flavor: r-devel-linux-x86_64-fedora-gcc
Version: 2.1-0
Check: tests
Result: ERROR
Running ‘bugBO.R’
Running ‘bugKEEPdprime.R’
Running ‘testBugResiduals.R’ [10s/12s]
Running ‘testDprimes.R’ [12s/13s]
Running ‘testKEEPeffs.R’ [38s/44s]
Running ‘testRep.R’
Running the tests in ‘tests/testBugResiduals.R’ failed.
Complete output:
> testOST <- FALSE
>
> library(SensMixed)
> load(system.file("testdata","bugResiddat.RData",package="SensMixed"))
> load(system.file("testdata","bb.RData",package="SensMixed"))
> load(system.file("testdata","ost.RData",package="SensMixed"))
>
> response <- c("liking")
> fixed <- list(Product = c("Sugar", "Acid"))
> random <- c("consumer")
> facs <- c("consumer", "Sugar", "Acid")
>
> res <- conjoint(structure = 3, dat, response, fixed, random, facs)
[1] "Calculating liking ..."
Number of levels for interaction consumer:Sugar:Acid is more or equal to the number of observations in data
Number of levels for interaction consumer:Sugar:Acid is more or equal to the number of observations in data
boundary (singular) fit: see ?isSingular
----------- FAILURE REPORT --------------
--- failure: the condition has length > 1 ---
--- srcref ---
:
--- package (from environment) ---
SensMixed
--- call from context ---
calcSatterthMultDF(rho, L)
--- call from argument ---
if (class(g) == "numeric") {
lapply(1:length(theopt), function(i) array(g[i], dim = dim(vcov.final)))
} else {
lapply(1:length(theopt), function(i) array(g[, i], dim = dim(vcov.final)))
}
--- R stacktrace ---
where 1: calcSatterthMultDF(rho, L)
where 2: calcSatt(rho, Lc)
where 3: calcFpvalueSS(Lc, rho, ddf, type)
where 4: calcFpvalueMAIN(term = tt, L = L, rho = rho, ddf = ddf, type = type)
where 5: FUN(X[[i]], ...)
where 6: lapply(test.terms, function(tt) calcFpvalueMAIN(term = tt, L = L,
rho = rho, ddf = ddf, type = type))
where 7: stepFun(model = model, ddf = ddf, type = type, alpha.random = alpha.random,
alpha.fixed = alpha.fixed, reduce.fixed = reduce.fixed, reduce.random = reduce.random,
fixed.calc = fixed.calc, lsmeans.calc = lsmeans.calc, difflsmeans.calc = difflsmeans.calc,
test.effs = test.effs, keep.effs = keep.effs, change.contr = TRUE)
where 8: step(model, reduce.fixed = isFixReduce, reduce.random = isRandReduce,
alpha.random = alpha.random, alpha.fixed = alpha.fixed)
where 9: withCallingHandlers(expr, message = function(c) invokeRestart("muffleMessage"))
where 10: suppressMessages(t <- step(model, reduce.fixed = isFixReduce,
reduce.random = isRandReduce, alpha.random = alpha.random,
alpha.fixed = alpha.fixed))
where 11: conjointFun(structure = structure, data = data, response = response,
fixed = fixed, random = random, facs = facs, corr = FALSE,
alpha.random = alpha.random, alpha.fixed = alpha.fixed)
where 12: conjoint(structure = 3, dat, response, fixed, random, facs)
--- value of length: 2 type: logical ---
[1] FALSE FALSE
--- function from context ---
function (rho, Lc)
{
vcov.final <- as.matrix(vcov(rho$model))
if (is.vector(Lc))
C.theta.optim <- as.matrix(t(Lc) %*% vcov.final %*% Lc)
else C.theta.optim <- as.matrix(Lc %*% vcov.final %*% t(Lc))
invC.theta <- tryCatch({
solve(C.theta.optim)
}, error = function(e) {
NULL
})
if (is.null(invC.theta))
return(list(denom = 0, Fstat = NA, pvalue = NA, ndf = NA,
ss = NA, ms = NA))
q <- qr(C.theta.optim)$rank
F.stat <- (t(Lc %*% rho$fixEffs) %*% invC.theta %*% (Lc %*%
rho$fixEffs))/q
svdec <- eigen(C.theta.optim)
PL <- t(svdec$vectors) %*% Lc
vss2 <- vcovTheta(rho$model)
theopt <- c(rho$thopt, rho$sigma)
g <- mygrad(function(x) vss2(x), theopt)
mat.grad <- if (class(g) == "numeric") {
lapply(1:length(theopt), function(i) array(g[i], dim = dim(vcov.final)))
}
else {
lapply(1:length(theopt), function(i) array(g[, i], dim = dim(vcov.final)))
}
nu.m.fun <- function(m) {
den.nu <- unlist(lapply(1:length(mat.grad), function(i) as.matrix(t(PL[m,
]) %*% mat.grad[[i]] %*% PL[m, ])))
2 * (svdec$values[m])^2/(t(den.nu) %*% rho$A %*% den.nu)
}
nu.m <- unlist(lapply(1:length(svdec$values), nu.m.fun))
nu.m[which(abs(2 - nu.m) < 1e-05)] <- 2.00001
E <- sum((nu.m/(nu.m - 2)) * as.numeric(nu.m > 2))
nu.F <- 2 * E * as.numeric(E > q)/(E - q)
pvalueF <- pf(F.stat, qr(Lc)$rank, nu.F, lower.tail = FALSE)
if (is.na(F.stat))
ms <- ss <- NA
else {
ms <- F.stat * rho$sigma^2
ss <- ms * q
}
return(list(ss = ss, ms = ms, denom = nu.F, Fstat = F.stat,
pvalue = pvalueF, ndf = q))
}
<bytecode: 0xce7aca0>
<environment: namespace:SensMixed>
--- function search by body ---
Function calcSatterthMultDF in namespace SensMixed has this body.
----------- END OF FAILURE REPORT --------------
Error in if (class(g) == "numeric") { : the condition has length > 1
Calls: conjoint ... calcFpvalueMAIN -> calcFpvalueSS -> calcSatt -> calcSatterthMultDF
Execution halted
Running the tests in ‘tests/testDprimes.R’ failed.
Complete output:
> require(SensMixed)
Loading required package: SensMixed
> load(system.file("testdata","sensBObalanc.RData",package="SensMixed"))
> load(system.file("testdata","sensBO.RData",package="SensMixed"))
> testBO <- FALSE
> ###########################################
> ## check for TVbo without replication
> ###########################################
>
>
>
> TVbo <- convertToFactors(TVbo, c("Assessor", "Repeat", "Picture"))
> result <- sensmixed(c("Noise", "Elasticeffect"),
+ prod_effects = c("TVset", "Picture"),
+ assessor = "Assessor", data = TVbo,
+ control = list(calc_post_hoc = TRUE), MAM = FALSE)
|
| | 0% ----------- FAILURE REPORT --------------
--- failure: the condition has length > 1 ---
--- srcref ---
:
--- package (from environment) ---
SensMixed
--- call from context ---
calcSatterthMultDF(rho, L)
--- call from argument ---
if (class(g) == "numeric") {
lapply(1:length(theopt), function(i) array(g[i], dim = dim(vcov.final)))
} else {
lapply(1:length(theopt), function(i) array(g[, i], dim = dim(vcov.final)))
}
--- R stacktrace ---
where 1: calcSatterthMultDF(rho, L)
where 2: calcSatt(rho, Lc)
where 3: calcFpvalueSS(Lc, rho, ddf, type)
where 4: calcFpvalueMAIN(term = tt, L = L, rho = rho, ddf = ddf, type = type)
where 5: FUN(X[[i]], ...)
where 6: lapply(test.terms, function(tt) calcFpvalueMAIN(term = tt, L = L,
rho = rho, ddf = ddf, type = type))
where 7: stepFun(model = model, ddf = ddf, type = type, alpha.random = alpha.random,
alpha.fixed = alpha.fixed, reduce.fixed = reduce.fixed, reduce.random = reduce.random,
fixed.calc = fixed.calc, lsmeans.calc = lsmeans.calc, difflsmeans.calc = difflsmeans.calc,
test.effs = test.effs, keep.effs = keep.effs, change.contr = TRUE)
where 8: step(m, reduce.fixed = FALSE, reduce.random = reduce.random,
alpha.random = alpha.random, alpha.fixed = alpha.fixed, lsmeans.calc = TRUE,
difflsmeans.calc = calc_post_hoc, keep.effs = keep.effs)
where 9: withCallingHandlers(expr, message = function(c) invokeRestart("muffleMessage"))
where 10: suppressMessages(st <- step(m, reduce.fixed = FALSE, reduce.random = reduce.random,
alpha.random = alpha.random, alpha.fixed = alpha.fixed, lsmeans.calc = TRUE,
difflsmeans.calc = calc_post_hoc, keep.effs = keep.effs))
where 11: .fun(piece, ...)
where 12: (function (i)
{
piece <- pieces[[i]]
if (.inform) {
res <- try(.fun(piece, ...))
if (inherits(res, "try-error")) {
piece <- paste(utils::capture.output(print(piece)),
collapse = "\n")
stop("with piece ", i, ": \n", piece, call. = FALSE)
}
}
else {
res <- .fun(piece, ...)
}
progress$step()
res
})(1L)
where 13: loop_apply(n, do.ply)
where 14: llply(attributes, .stepAllAttrNoMAM, product_structure = product_structure,
error_structure = error_structure, data = data, prod_effects = prod_effects,
random = random, reduce.random = rmatch(control, "reduce.random"),
alpha.random = rmatch(control, "alpha.random"), alpha.fixed = rmatch(control,
"alpha.fixed"), calc_post_hoc = rmatch(control, "calc_post_hoc"),
keep.effs = keep.effs, .progress = "text")
where 15: sensmixedFun(attributes = attributes, prod_effects = prod_effects,
assessor = assessor, replication = replication, data = data,
product_structure = product_structure, error_structure = error_structure,
MAM = MAM, control = control)
where 16: sensmixed(c("Noise", "Elasticeffect"), prod_effects = c("TVset",
"Picture"), assessor = "Assessor", data = TVbo, control = list(calc_post_hoc = TRUE),
MAM = FALSE)
--- value of length: 2 type: logical ---
[1] FALSE FALSE
--- function from context ---
function (rho, Lc)
{
vcov.final <- as.matrix(vcov(rho$model))
if (is.vector(Lc))
C.theta.optim <- as.matrix(t(Lc) %*% vcov.final %*% Lc)
else C.theta.optim <- as.matrix(Lc %*% vcov.final %*% t(Lc))
invC.theta <- tryCatch({
solve(C.theta.optim)
}, error = function(e) {
NULL
})
if (is.null(invC.theta))
return(list(denom = 0, Fstat = NA, pvalue = NA, ndf = NA,
ss = NA, ms = NA))
q <- qr(C.theta.optim)$rank
F.stat <- (t(Lc %*% rho$fixEffs) %*% invC.theta %*% (Lc %*%
rho$fixEffs))/q
svdec <- eigen(C.theta.optim)
PL <- t(svdec$vectors) %*% Lc
vss2 <- vcovTheta(rho$model)
theopt <- c(rho$thopt, rho$sigma)
g <- mygrad(function(x) vss2(x), theopt)
mat.grad <- if (class(g) == "numeric") {
lapply(1:length(theopt), function(i) array(g[i], dim = dim(vcov.final)))
}
else {
lapply(1:length(theopt), function(i) array(g[, i], dim = dim(vcov.final)))
}
nu.m.fun <- function(m) {
den.nu <- unlist(lapply(1:length(mat.grad), function(i) as.matrix(t(PL[m,
]) %*% mat.grad[[i]] %*% PL[m, ])))
2 * (svdec$values[m])^2/(t(den.nu) %*% rho$A %*% den.nu)
}
nu.m <- unlist(lapply(1:length(svdec$values), nu.m.fun))
nu.m[which(abs(2 - nu.m) < 1e-05)] <- 2.00001
E <- sum((nu.m/(nu.m - 2)) * as.numeric(nu.m > 2))
nu.F <- 2 * E * as.numeric(E > q)/(E - q)
pvalueF <- pf(F.stat, qr(Lc)$rank, nu.F, lower.tail = FALSE)
if (is.na(F.stat))
ms <- ss <- NA
else {
ms <- F.stat * rho$sigma^2
ss <- ms * q
}
return(list(ss = ss, ms = ms, denom = nu.F, Fstat = F.stat,
pvalue = pvalueF, ndf = q))
}
<bytecode: 0xb880d20>
<environment: namespace:SensMixed>
--- function search by body ---
Function calcSatterthMultDF in namespace SensMixed has this body.
----------- END OF FAILURE REPORT --------------
Error in if (class(g) == "numeric") { : the condition has length > 1
Calls: sensmixed ... calcFpvalueMAIN -> calcFpvalueSS -> calcSatt -> calcSatterthMultDF
Execution halted
Running the tests in ‘tests/testKEEPeffs.R’ failed.
Complete output:
> require(SensMixed)
Loading required package: SensMixed
>
> #convert some variables to factors in TVbo
> TVbo <- convertToFactors(TVbo, c("Assessor", "Repeat", "Picture"))
>
> res <- sensmixed(c("Coloursaturation", "Colourbalance"),
+ prod_effects = c("TVset", "Picture"), replication="Repeat",
+ assessor="Assessor", data=TVbo,
+ control = list(keep.effs = "Assessor"), MAM = FALSE)
|
| | 0%
----------- FAILURE REPORT --------------
--- failure: the condition has length > 1 ---
--- srcref ---
:
--- package (from environment) ---
SensMixed
--- call from context ---
calcSatterthMultDF(rho, L)
--- call from argument ---
if (class(g) == "numeric") {
lapply(1:length(theopt), function(i) array(g[i], dim = dim(vcov.final)))
} else {
lapply(1:length(theopt), function(i) array(g[, i], dim = dim(vcov.final)))
}
--- R stacktrace ---
where 1: calcSatterthMultDF(rho, L)
where 2: calcSatt(rho, Lc)
where 3: calcFpvalueSS(Lc, rho, ddf, type)
where 4: calcFpvalueMAIN(term = tt, L = L, rho = rho, ddf = ddf, type = type)
where 5: FUN(X[[i]], ...)
where 6: lapply(test.terms, function(tt) calcFpvalueMAIN(term = tt, L = L,
rho = rho, ddf = ddf, type = type))
where 7: stepFun(model = model, ddf = ddf, type = type, alpha.random = alpha.random,
alpha.fixed = alpha.fixed, reduce.fixed = reduce.fixed, reduce.random = reduce.random,
fixed.calc = fixed.calc, lsmeans.calc = lsmeans.calc, difflsmeans.calc = difflsmeans.calc,
test.effs = test.effs, keep.effs = keep.effs, change.contr = TRUE)
where 8: step(m, reduce.fixed = FALSE, reduce.random = reduce.random,
alpha.random = alpha.random, alpha.fixed = alpha.fixed, lsmeans.calc = TRUE,
difflsmeans.calc = calc_post_hoc, keep.effs = keep.effs)
where 9: withCallingHandlers(expr, message = function(c) invokeRestart("muffleMessage"))
where 10: suppressMessages(st <- step(m, reduce.fixed = FALSE, reduce.random = reduce.random,
alpha.random = alpha.random, alpha.fixed = alpha.fixed, lsmeans.calc = TRUE,
difflsmeans.calc = calc_post_hoc, keep.effs = keep.effs))
where 11: .fun(piece, ...)
where 12: (function (i)
{
piece <- pieces[[i]]
if (.inform) {
res <- try(.fun(piece, ...))
if (inherits(res, "try-error")) {
piece <- paste(utils::capture.output(print(piece)),
collapse = "\n")
stop("with piece ", i, ": \n", piece, call. = FALSE)
}
}
else {
res <- .fun(piece, ...)
}
progress$step()
res
})(1L)
where 13: loop_apply(n, do.ply)
where 14: llply(attributes, .stepAllAttrNoMAM, product_structure = product_structure,
error_structure = error_structure, data = data, prod_effects = prod_effects,
random = random, reduce.random = rmatch(control, "reduce.random"),
alpha.random = rmatch(control, "alpha.random"), alpha.fixed = rmatch(control,
"alpha.fixed"), calc_post_hoc = rmatch(control, "calc_post_hoc"),
keep.effs = keep.effs, .progress = "text")
where 15: sensmixedFun(attributes = attributes, prod_effects = prod_effects,
assessor = assessor, replication = replication, data = data,
product_structure = product_structure, error_structure = error_structure,
MAM = MAM, control = control)
where 16: sensmixed(c("Coloursaturation", "Colourbalance"), prod_effects = c("TVset",
"Picture"), replication = "Repeat", assessor = "Assessor",
data = TVbo, control = list(keep.effs = "Assessor"), MAM = FALSE)
--- value of length: 2 type: logical ---
[1] FALSE FALSE
--- function from context ---
function (rho, Lc)
{
vcov.final <- as.matrix(vcov(rho$model))
if (is.vector(Lc))
C.theta.optim <- as.matrix(t(Lc) %*% vcov.final %*% Lc)
else C.theta.optim <- as.matrix(Lc %*% vcov.final %*% t(Lc))
invC.theta <- tryCatch({
solve(C.theta.optim)
}, error = function(e) {
NULL
})
if (is.null(invC.theta))
return(list(denom = 0, Fstat = NA, pvalue = NA, ndf = NA,
ss = NA, ms = NA))
q <- qr(C.theta.optim)$rank
F.stat <- (t(Lc %*% rho$fixEffs) %*% invC.theta %*% (Lc %*%
rho$fixEffs))/q
svdec <- eigen(C.theta.optim)
PL <- t(svdec$vectors) %*% Lc
vss2 <- vcovTheta(rho$model)
theopt <- c(rho$thopt, rho$sigma)
g <- mygrad(function(x) vss2(x), theopt)
mat.grad <- if (class(g) == "numeric") {
lapply(1:length(theopt), function(i) array(g[i], dim = dim(vcov.final)))
}
else {
lapply(1:length(theopt), function(i) array(g[, i], dim = dim(vcov.final)))
}
nu.m.fun <- function(m) {
den.nu <- unlist(lapply(1:length(mat.grad), function(i) as.matrix(t(PL[m,
]) %*% mat.grad[[i]] %*% PL[m, ])))
2 * (svdec$values[m])^2/(t(den.nu) %*% rho$A %*% den.nu)
}
nu.m <- unlist(lapply(1:length(svdec$values), nu.m.fun))
nu.m[which(abs(2 - nu.m) < 1e-05)] <- 2.00001
E <- sum((nu.m/(nu.m - 2)) * as.numeric(nu.m > 2))
nu.F <- 2 * E * as.numeric(E > q)/(E - q)
pvalueF <- pf(F.stat, qr(Lc)$rank, nu.F, lower.tail = FALSE)
if (is.na(F.stat))
ms <- ss <- NA
else {
ms <- F.stat * rho$sigma^2
ss <- ms * q
}
return(list(ss = ss, ms = ms, denom = nu.F, Fstat = F.stat,
pvalue = pvalueF, ndf = q))
}
<bytecode: 0x10cf6e00>
<environment: namespace:SensMixed>
--- function search by body ---
Function calcSatterthMultDF in namespace SensMixed has this body.
----------- END OF FAILURE REPORT --------------
Error in if (class(g) == "numeric") { : the condition has length > 1
Calls: sensmixed ... calcFpvalueMAIN -> calcFpvalueSS -> calcSatt -> calcSatterthMultDF
In addition: Warning messages:
1: In checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, :
Model failed to converge with max|grad| = 0.00767249 (tol = 0.002, component 1)
2: In checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, :
Model failed to converge with max|grad| = 0.00296669 (tol = 0.002, component 1)
3: In checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, :
Model failed to converge with max|grad| = 0.0227178 (tol = 0.002, component 1)
4: In checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, :
unable to evaluate scaled gradient
5: In checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, :
Model failed to converge: degenerate Hessian with 1 negative eigenvalues
6: In checkConv(attr(opt, "derivs"), opt$par, ctrl = control$checkConv, :
Model failed to converge with max|grad| = 0.00329232 (tol = 0.002, component 1)
Execution halted
Flavor: r-devel-linux-x86_64-fedora-gcc