CRAN Package Check Results for Package vcrpart

Last updated on 2020-02-17 00:49:31 CET.

Flavor Version Tinstall Tcheck Ttotal Status Flags
r-devel-linux-x86_64-debian-clang 1.0-2 21.66 111.97 133.63 ERROR
r-devel-linux-x86_64-debian-gcc 1.0-2 16.13 87.00 103.13 ERROR
r-devel-linux-x86_64-fedora-clang 1.0-2 167.89 ERROR
r-devel-linux-x86_64-fedora-gcc 1.0-2 157.10 ERROR
r-devel-windows-ix86+x86_64 1.0-2 40.00 154.00 194.00 OK
r-devel-windows-ix86+x86_64-gcc8 1.0-2 48.00 160.00 208.00 OK
r-patched-linux-x86_64 1.0-2 17.32 108.66 125.98 OK
r-patched-solaris-x86 1.0-2 231.50 OK
r-release-linux-x86_64 1.0-2 17.23 108.16 125.39 OK
r-release-windows-ix86+x86_64 1.0-2 33.00 155.00 188.00 OK
r-release-osx-x86_64 1.0-2 OK
r-oldrel-windows-ix86+x86_64 1.0-2 26.00 168.00 194.00 OK
r-oldrel-osx-x86_64 1.0-2 OK

Check Details

Version: 1.0-2
Check: examples
Result: ERROR
    Running examples in 'vcrpart-Ex.R' failed
    The error most likely occurred in:
    
    > base::assign(".ptime", proc.time(), pos = "CheckExEnv")
    > ### Name: fvcm-methods
    > ### Title: Methods for 'fvcm' objects
    > ### Aliases: fvcm-methods fitted.fvcm print.fvcm oobloss.fvcm plot.fvcm
    > ### predict.fvcm print.fvcm ranef.fvcm
    > ### Keywords: methods hplot
    >
    > ### ** Examples
    >
    >
    > ## ------------------------------------------------------------------- #
    > ## Dummy example 1:
    > ##
    > ## Fitting a random forest tvcm on artificially generated ordinal
    > ## longitudinal data. The parameters 'maxstep = 1' and 'K = 2' are
    > ## chosen to restrict the computations.
    > ## ------------------------------------------------------------------- #
    >
    > ## load the data
    >
    > data(vcrpart_1)
    >
    > ## fit and analyse the model
    >
    > control <-
    + fvcolmm_control(mtry = 2, maxstep = 1,
    + folds = folds_control(type = "subsampling", K = 2, prob = 0.75))
    >
    > model.1 <-
    + fvcolmm(y ~ -1 + wave + vc(z3, z4, by = treat, intercept = TRUE) + re(1|id),
    + family = cumulative(), subset = 1:100,
    + data = vcrpart_1, control = control)
    * fitting an initial tree ... OK
    [ 1 ][ 2 ]
    >
    > ## estimating the out of bag loss
    > suppressWarnings(oobloss(model.1))
    [1] Inf
    >
    > ## predicting responses and varying coefficients for subject '27'
    > subs <- vcrpart_1$id == "27"
    >
    > ## predict coefficients
    > predict(model.1, newdata = vcrpart_1[subs,], type = "coef")
     Eta1:(Intercept) Eta2:(Intercept) treat wave ranefCholFac1
    105 -3.209406 -0.3906967 2.835036 0.2515896 1.617485
    106 -3.209406 -0.3906967 2.835036 0.2515896 1.617485
    107 -3.209406 -0.3906967 2.835036 0.2515896 1.617485
    108 -2.812295 0.1968348 1.481318 0.2515896 1.617485
    >
    > ## marginal response prediction
    > predict(model.1, vcrpart_1[subs,], "response", ranef = FALSE)
     1 2 3
    105 0.64487105 0.3030852 0.05204376
    106 0.05173905 0.3021793 0.64608161
    107 0.05963581 0.3241881 0.61617604
    108 0.08089282 0.4062962 0.51281095
    >
    > ## conditional response prediction
    > re <- matrix(5, 1, 1, dimnames = list("27", "(Intercept)"))
    > predict(model.1, vcrpart_1[subs,], "response", ranef = re)
     ----------- FAILURE REPORT --------------
     --- failure: the condition has length > 1 ---
     --- srcref ---
    :
     --- package (from environment) ---
    vcrpart
     --- call from context ---
    predict.fvcm(model.1, vcrpart_1[subs, ], "response", ranef = re)
     --- call from argument ---
    if (!class(ranef) %in% c("logical", "matrix")) stop("'ranef' must be a 'logical' or a 'matrix'.")
     --- R stacktrace ---
    where 1: predict.fvcm(model.1, vcrpart_1[subs, ], "response", ranef = re)
    where 2: predict(model.1, vcrpart_1[subs, ], "response", ranef = re)
    
     --- value of length: 2 type: logical ---
    [1] FALSE TRUE
     --- function from context ---
    function (object, newdata = NULL, type = c("link", "response",
     "prob", "class", "coef", "ranef"), ranef = FALSE, na.action = na.pass,
     verbose = FALSE, ...)
    {
     type <- match.arg(type)
     if (type == "prob")
     type = "response"
     if (!is.null(newdata) && !is.data.frame(newdata))
     stop("'newdata' must be a 'data.frame'.")
     if (!class(ranef) %in% c("logical", "matrix"))
     stop("'ranef' must be a 'logical' or a 'matrix'.")
     if (!is.null(newdata) && is.logical(ranef) && ranef)
     stop("'ranef' should be 'FALSE' or a 'matrix' if 'newdata' is ",
     "not 'NULL'.")
     if (type == "ranef" & (!is.logical(ranef) | is.logical(ranef) &&
     ranef))
     stop("for 'type = 'ranef'' the argument 'ranef' must be 'FALSE'.")
     if (type == "ranef" & !is.null(newdata))
     stop("prediction for random effects for 'newdata' is not ",
     "implemented.")
     oob <- if (!is.null(list(...)$oob))
     list(...)$oob
     else FALSE
     if (oob && !is.null(newdata))
     stop("'oob' should be 'FALSE' if 'newdata' is not 'NULL'")
     class(object) <- class(object)[-1L]
     md <- object$info$data
     dummymodel <- object$info$model
     if (is.null(newdata))
     newdata <- md
     folds <- if (oob) {
     object$info$folds
     }
     else {
     matrix(1L, nrow(newdata), length(object$info$forest))
     }
     formList <- object$info$formula
     rootForm <- tvcm_formula(formList, rep(TRUE, length(formList$vc)),
     object$info$family)$full
     formList <- vcrpart_formula(rootForm, object$info$family)
     yName <- all.vars(lhs(formList$original))
     yLevs <- if (object$info$fit == "olmm")
     levels(md[, yName])
     else yName
     nYLevs <- length(yLevs)
     if (type != "coef") {
     if (!yName %in% colnames(newdata))
     newdata[, yName] <- sample(md[, yName], nrow(newdata),
     replace = TRUE)
     feVars <- unlist(lapply(formList$fe$eta, all.vars))
     if (!all(subs <- feVars %in% colnames(newdata)))
     stop("variable(s) ", paste("'", feVars[!subs], "'",
     collapse = ", "), " are not available in 'newdata'.")
     reVars <- unlist(lapply(unlist(formList$re[c("eta", "cond")]),
     all.vars))
     if (length(reVars) > 0L) {
     if (is.logical(ranef) && ranef | is.matrix(ranef)) {
     if (!all(subs <- reVars %in% colnames(newdata)))
     stop("variables ", feVars[!subs], " are not available in 'newdata'.")
     }
     else {
     for (var in reVars) newdata[, var] <- sample(md[,
     var], nrow(newdata), replace = TRUE)
     }
     }
     Terms <- attr(md, "terms")
     xlevels <- .getXlevels(attr(md, "terms"), md)
     if (is.matrix(ranef)) {
     subjectName <- dummymodel$subjectName
     xlevels <- xlevels[names(xlevels) != subjectName]
     }
     newdata <- as.data.frame(model.frame(Terms, newdata,
     na.action = na.pass, xlev = xlevels))
     attr(newdata, "terms") <- NULL
     }
     if (verbose)
     cat("* predicting the coefficient functions ... ")
     nEta <- if (object$info$fit == "olmm")
     nYLevs - 1L
     else 1L
     etaLabs <- paste("Eta", 1L:nEta, sep = "")
     coef <- count <- 0 * predict(object, newdata, type = "coef")
     rownames(coef) <- rownames(newdata)
     subs <- matrix(TRUE, nrow(coef), ncol(coef), dimnames = list(rownames(coef),
     colnames(coef)))
     for (i in seq_along(object$info$forest)) {
     if (verbose)
     cat(".")
     object$info$node <- object$info$forest[[i]]
     object$info$model$coefficients <- object$info$coefficients[[i]]
     object$info$model$contrasts <- object$info$contrasts[[i]]
     coefi <- predict(object, newdata = newdata, type = "coef",
     ranef = FALSE, na.action = na.pass, ...)
     if (!is.matrix(coefi))
     coefi <- matrix(coefi, nrow = nrow(newdata))
     if (object$info$fit == "olmm" && ncol(coefi) < ncol(coef)) {
     subsiCols <- table(md[folds[, i] > 0, yName]) > 0L
     subsiCols <- subsiCols[-length(subsiCols)]
     etaLabsShould <- etaLabs[subsiCols]
     colnamesi <- colnames(coefi)
     etaLabsIs <- grep("Eta[1-9]+:", colnamesi, value = TRUE)
     etaLabsIs <- unique(sapply(strsplit(etaLabsIs, ":"),
     function(x) x[1]))
     colnamesi <- strsplit(colnamesi, ":")
     for (j in rev(seq_along(etaLabsIs))) {
     colnamesi <- lapply(colnamesi, function(x) {
     if (x[1L] == etaLabsIs[j])
     x[1L] <- etaLabsShould[j]
     return(x)
     })
     }
     colnamesi <- sapply(colnamesi, function(x) paste(x,
     collapse = ":"))
     colnames(coefi) <- colnamesi
     }
     coefi <- coefi[, intersect(colnames(coef), colnames(coefi)),
     drop = FALSE]
     subsi <- subs
     if (oob)
     subsi[folds[, i] > 0L, ] <- FALSE
     subsi[is.na(coefi)] <- FALSE
     coef[subsi] <- coef[subsi] + coefi[subsi]
     count <- count + 1 * subsi
     }
     if (verbose)
     cat(" OK\n")
     coef <- coef/count
     coef[apply(count, 1, function(x) any(x == 0)), ] <- NA
     if (length(setdiff(names(coef(dummymodel)), colnames(coef))) >
     0 | length(setdiff(colnames(coef), names(coef(dummymodel)))) >
     0)
     stop("ups. This shouldn't happen. Please contact the author of this package and ",
     "indicate to have problems with 'fvcm.predict'.")
     coef <- coef[, match(names(coef(dummymodel)), colnames(coef)),
     drop = FALSE]
     if (type == "coef")
     return(na.action(coef))
     if (object$info$fit == "olmm") {
     X <- olmm_merge_mm(model.matrix(terms(formList$fe$eta$ce,
     keep.order = TRUE), newdata, attr(object$info$model$X,
     "contrasts")), model.matrix(terms(formList$fe$eta$ge,
     keep.order = TRUE), newdata, attr(object$info$model$X,
     "contrasts")), TRUE)
     }
     else {
     X <- model.matrix(terms(rootForm), newdata, dummymodel$contrasts)
     }
     if (object$info$fit == "olmm") {
     coef <- coef[, substr(colnames(coef), 1, 12) != "ranefCholFac",
     drop = FALSE]
     dims <- dummymodel$dims
     fixefMat <- function(fixef) {
     return(rbind(matrix(fixef[1:(dims["pCe"] * dims["nEta"])],
     dims["pCe"], dims["nEta"], byrow = FALSE), if (dims["pGe"] >
     0) matrix(rep(fixef[(dims["pCe"] * dims["nEta"] +
     1):dims["p"]], each = dims["nEta"]), dims["pGe"],
     dims["nEta"], byrow = TRUE) else NULL))
     }
     eta <- sapply(1:nrow(newdata), function(i) {
     X[i, , drop = FALSE] %*% fixefMat(coef[i, ])
     })
     if (dims["nEta"] == 1)
     eta <- matrix(eta, ncol = 1)
     else eta <- t(eta)
     colnames(eta) <- etaLabs
     rownames(eta) <- rownames(newdata)
     }
     else {
     eta <- t(sapply(1:nrow(newdata), function(i) {
     X[i, , drop = FALSE] %*% coef[i, ]
     }))
     eta <- matrix(eta, ncol = 1L)
     }
     if (type == "link") {
     if (object$info$fit != "olmm")
     eta <- c(eta)
     return(na.action(eta))
     }
     start <- NULL
     if (object$info$fit == "olmm") {
     terms <- "fe(intercept=FALSE)"
     mTerms <- terms(object$info$formula$original, specials = "re")
     if (length(subs <- attr(mTerms, "specials")$re) > 0L) {
     terms <- c(terms, rownames(attr(mTerms, "factors"))[subs])
     reTerms <- grep("ranefCholFac", names(object$info$coefficients[[1L]]),
     value = TRUE)
     start <- sapply(seq_along(object$info$coefficients),
     function(i) object$info$coefficients[[i]][reTerms])
     start <- apply(matrix(start, ncol = length(reTerms)),
     2L, mean)
     names(start) <- reTerms
     }
     }
     else {
     terms <- "-1"
     }
     form <- as.formula(paste(yName, "~", paste(terms, collapse = "+")))
     if (is.factor(newdata[, yName]) && length(unique(newdata[,
     yName])) < nYLevs) {
     subs <- nrow(newdata) + 1L:nYLevs
     newdata <- rbind(newdata, newdata[rep(1L, nYLevs), ,
     drop = FALSE])
     newdata[subs, yName] <- yLevs
     if (object$info$fit == "olmm") {
     sN <- object$info$model$subjectName
     levs <- c(levels(newdata[, sN]), "RetoBuergin")
     newdata[sN] <- factor(newdata[, sN], levels = levs)
     newdata[subs, sN] <- "RetoBuergin"
     }
     eta <- rbind(eta, matrix(0, nYLevs, ncol(eta)))
     folds <- rbind(folds, matrix(-1L, nYLevs, length(object$info$forest)))
     }
     offset <- eta
     offset[is.na(offset)] <- 0
     oobCall <- call(name = object$info$fit, form = quote(form),
     data = quote(newdata), offset = quote(offset), family = quote(object$info$family),
     start = quote(start), na.action = na.pass)
     for (arg in names(object$info$dotargs)) oobCall[[arg]] <- object$info$dotargs[[arg]]
     oobCall <- oobCall[!duplicated(names(oobCall))]
     if (object$info$fit == "olmm")
     oobCall$doFit <- FALSE
     model <- suppressWarnings(eval(oobCall))
     if (type == "ranef") {
     ranef <- ranef(model)
     ranef <- ranef[rownames(ranef) != "RetoBuergin", , drop = FALSE]
     return(na.action(ranef))
     }
     else {
     if (is.matrix(ranef)) {
     ranefMat <- ranef(model)
     ranefMat[rownames(ranef), ] <- ranef
     ranef <- ranefMat
     }
     pred <- predict(model, type = type, ranef = ranef, ...)
     if (!is.matrix(pred))
     pred <- matrix(pred, nrow = nrow(newdata))
     pred[apply(eta, 1, function(x) any(is.na(x))), ] <- NA
     pred <- pred[folds[, 1] >= 0L, , drop = FALSE]
     }
     folds <- folds[folds[, 1] >= 0L, , drop = FALSE]
     if (oob)
     pred[apply(folds, 1L, function(x) all(x == 0L)), ] <- NA
     if (object$info$fit != "olmm")
     pred <- c(pred)
     return(na.action(pred))
    }
    <bytecode: 0xc53c9d0>
    <environment: namespace:vcrpart>
     --- function search by body ---
    Function predict.fvcm in namespace vcrpart has this body.
     ----------- END OF FAILURE REPORT --------------
    Error in if (!class(ranef) %in% c("logical", "matrix")) stop("'ranef' must be a 'logical' or a 'matrix'.") :
     the condition has length > 1
    Calls: predict -> predict.fvcm
    Execution halted
Flavor: r-devel-linux-x86_64-debian-clang

Version: 1.0-2
Check: examples
Result: ERROR
    Running examples in ‘vcrpart-Ex.R’ failed
    The error most likely occurred in:
    
    > base::assign(".ptime", proc.time(), pos = "CheckExEnv")
    > ### Name: fvcm-methods
    > ### Title: Methods for 'fvcm' objects
    > ### Aliases: fvcm-methods fitted.fvcm print.fvcm oobloss.fvcm plot.fvcm
    > ### predict.fvcm print.fvcm ranef.fvcm
    > ### Keywords: methods hplot
    >
    > ### ** Examples
    >
    >
    > ## ------------------------------------------------------------------- #
    > ## Dummy example 1:
    > ##
    > ## Fitting a random forest tvcm on artificially generated ordinal
    > ## longitudinal data. The parameters 'maxstep = 1' and 'K = 2' are
    > ## chosen to restrict the computations.
    > ## ------------------------------------------------------------------- #
    >
    > ## load the data
    >
    > data(vcrpart_1)
    >
    > ## fit and analyse the model
    >
    > control <-
    + fvcolmm_control(mtry = 2, maxstep = 1,
    + folds = folds_control(type = "subsampling", K = 2, prob = 0.75))
    >
    > model.1 <-
    + fvcolmm(y ~ -1 + wave + vc(z3, z4, by = treat, intercept = TRUE) + re(1|id),
    + family = cumulative(), subset = 1:100,
    + data = vcrpart_1, control = control)
    * fitting an initial tree ... OK
    [ 1 ][ 2 ]
    >
    > ## estimating the out of bag loss
    > suppressWarnings(oobloss(model.1))
    [1] Inf
    >
    > ## predicting responses and varying coefficients for subject '27'
    > subs <- vcrpart_1$id == "27"
    >
    > ## predict coefficients
    > predict(model.1, newdata = vcrpart_1[subs,], type = "coef")
     Eta1:(Intercept) Eta2:(Intercept) treat wave ranefCholFac1
    105 -3.209406 -0.3906967 2.835036 0.2515896 1.617485
    106 -3.209406 -0.3906967 2.835036 0.2515896 1.617485
    107 -3.209406 -0.3906967 2.835036 0.2515896 1.617485
    108 -2.812295 0.1968348 1.481318 0.2515896 1.617485
    >
    > ## marginal response prediction
    > predict(model.1, vcrpart_1[subs,], "response", ranef = FALSE)
     1 2 3
    105 0.64487105 0.3030852 0.05204376
    106 0.05173905 0.3021793 0.64608161
    107 0.05963581 0.3241881 0.61617604
    108 0.08089282 0.4062962 0.51281095
    >
    > ## conditional response prediction
    > re <- matrix(5, 1, 1, dimnames = list("27", "(Intercept)"))
    > predict(model.1, vcrpart_1[subs,], "response", ranef = re)
     ----------- FAILURE REPORT --------------
     --- failure: the condition has length > 1 ---
     --- srcref ---
    :
     --- package (from environment) ---
    vcrpart
     --- call from context ---
    predict.fvcm(model.1, vcrpart_1[subs, ], "response", ranef = re)
     --- call from argument ---
    if (!class(ranef) %in% c("logical", "matrix")) stop("'ranef' must be a 'logical' or a 'matrix'.")
     --- R stacktrace ---
    where 1: predict.fvcm(model.1, vcrpart_1[subs, ], "response", ranef = re)
    where 2: predict(model.1, vcrpart_1[subs, ], "response", ranef = re)
    
     --- value of length: 2 type: logical ---
    [1] FALSE TRUE
     --- function from context ---
    function (object, newdata = NULL, type = c("link", "response",
     "prob", "class", "coef", "ranef"), ranef = FALSE, na.action = na.pass,
     verbose = FALSE, ...)
    {
     type <- match.arg(type)
     if (type == "prob")
     type = "response"
     if (!is.null(newdata) && !is.data.frame(newdata))
     stop("'newdata' must be a 'data.frame'.")
     if (!class(ranef) %in% c("logical", "matrix"))
     stop("'ranef' must be a 'logical' or a 'matrix'.")
     if (!is.null(newdata) && is.logical(ranef) && ranef)
     stop("'ranef' should be 'FALSE' or a 'matrix' if 'newdata' is ",
     "not 'NULL'.")
     if (type == "ranef" & (!is.logical(ranef) | is.logical(ranef) &&
     ranef))
     stop("for 'type = 'ranef'' the argument 'ranef' must be 'FALSE'.")
     if (type == "ranef" & !is.null(newdata))
     stop("prediction for random effects for 'newdata' is not ",
     "implemented.")
     oob <- if (!is.null(list(...)$oob))
     list(...)$oob
     else FALSE
     if (oob && !is.null(newdata))
     stop("'oob' should be 'FALSE' if 'newdata' is not 'NULL'")
     class(object) <- class(object)[-1L]
     md <- object$info$data
     dummymodel <- object$info$model
     if (is.null(newdata))
     newdata <- md
     folds <- if (oob) {
     object$info$folds
     }
     else {
     matrix(1L, nrow(newdata), length(object$info$forest))
     }
     formList <- object$info$formula
     rootForm <- tvcm_formula(formList, rep(TRUE, length(formList$vc)),
     object$info$family)$full
     formList <- vcrpart_formula(rootForm, object$info$family)
     yName <- all.vars(lhs(formList$original))
     yLevs <- if (object$info$fit == "olmm")
     levels(md[, yName])
     else yName
     nYLevs <- length(yLevs)
     if (type != "coef") {
     if (!yName %in% colnames(newdata))
     newdata[, yName] <- sample(md[, yName], nrow(newdata),
     replace = TRUE)
     feVars <- unlist(lapply(formList$fe$eta, all.vars))
     if (!all(subs <- feVars %in% colnames(newdata)))
     stop("variable(s) ", paste("'", feVars[!subs], "'",
     collapse = ", "), " are not available in 'newdata'.")
     reVars <- unlist(lapply(unlist(formList$re[c("eta", "cond")]),
     all.vars))
     if (length(reVars) > 0L) {
     if (is.logical(ranef) && ranef | is.matrix(ranef)) {
     if (!all(subs <- reVars %in% colnames(newdata)))
     stop("variables ", feVars[!subs], " are not available in 'newdata'.")
     }
     else {
     for (var in reVars) newdata[, var] <- sample(md[,
     var], nrow(newdata), replace = TRUE)
     }
     }
     Terms <- attr(md, "terms")
     xlevels <- .getXlevels(attr(md, "terms"), md)
     if (is.matrix(ranef)) {
     subjectName <- dummymodel$subjectName
     xlevels <- xlevels[names(xlevels) != subjectName]
     }
     newdata <- as.data.frame(model.frame(Terms, newdata,
     na.action = na.pass, xlev = xlevels))
     attr(newdata, "terms") <- NULL
     }
     if (verbose)
     cat("* predicting the coefficient functions ... ")
     nEta <- if (object$info$fit == "olmm")
     nYLevs - 1L
     else 1L
     etaLabs <- paste("Eta", 1L:nEta, sep = "")
     coef <- count <- 0 * predict(object, newdata, type = "coef")
     rownames(coef) <- rownames(newdata)
     subs <- matrix(TRUE, nrow(coef), ncol(coef), dimnames = list(rownames(coef),
     colnames(coef)))
     for (i in seq_along(object$info$forest)) {
     if (verbose)
     cat(".")
     object$info$node <- object$info$forest[[i]]
     object$info$model$coefficients <- object$info$coefficients[[i]]
     object$info$model$contrasts <- object$info$contrasts[[i]]
     coefi <- predict(object, newdata = newdata, type = "coef",
     ranef = FALSE, na.action = na.pass, ...)
     if (!is.matrix(coefi))
     coefi <- matrix(coefi, nrow = nrow(newdata))
     if (object$info$fit == "olmm" && ncol(coefi) < ncol(coef)) {
     subsiCols <- table(md[folds[, i] > 0, yName]) > 0L
     subsiCols <- subsiCols[-length(subsiCols)]
     etaLabsShould <- etaLabs[subsiCols]
     colnamesi <- colnames(coefi)
     etaLabsIs <- grep("Eta[1-9]+:", colnamesi, value = TRUE)
     etaLabsIs <- unique(sapply(strsplit(etaLabsIs, ":"),
     function(x) x[1]))
     colnamesi <- strsplit(colnamesi, ":")
     for (j in rev(seq_along(etaLabsIs))) {
     colnamesi <- lapply(colnamesi, function(x) {
     if (x[1L] == etaLabsIs[j])
     x[1L] <- etaLabsShould[j]
     return(x)
     })
     }
     colnamesi <- sapply(colnamesi, function(x) paste(x,
     collapse = ":"))
     colnames(coefi) <- colnamesi
     }
     coefi <- coefi[, intersect(colnames(coef), colnames(coefi)),
     drop = FALSE]
     subsi <- subs
     if (oob)
     subsi[folds[, i] > 0L, ] <- FALSE
     subsi[is.na(coefi)] <- FALSE
     coef[subsi] <- coef[subsi] + coefi[subsi]
     count <- count + 1 * subsi
     }
     if (verbose)
     cat(" OK\n")
     coef <- coef/count
     coef[apply(count, 1, function(x) any(x == 0)), ] <- NA
     if (length(setdiff(names(coef(dummymodel)), colnames(coef))) >
     0 | length(setdiff(colnames(coef), names(coef(dummymodel)))) >
     0)
     stop("ups. This shouldn't happen. Please contact the author of this package and ",
     "indicate to have problems with 'fvcm.predict'.")
     coef <- coef[, match(names(coef(dummymodel)), colnames(coef)),
     drop = FALSE]
     if (type == "coef")
     return(na.action(coef))
     if (object$info$fit == "olmm") {
     X <- olmm_merge_mm(model.matrix(terms(formList$fe$eta$ce,
     keep.order = TRUE), newdata, attr(object$info$model$X,
     "contrasts")), model.matrix(terms(formList$fe$eta$ge,
     keep.order = TRUE), newdata, attr(object$info$model$X,
     "contrasts")), TRUE)
     }
     else {
     X <- model.matrix(terms(rootForm), newdata, dummymodel$contrasts)
     }
     if (object$info$fit == "olmm") {
     coef <- coef[, substr(colnames(coef), 1, 12) != "ranefCholFac",
     drop = FALSE]
     dims <- dummymodel$dims
     fixefMat <- function(fixef) {
     return(rbind(matrix(fixef[1:(dims["pCe"] * dims["nEta"])],
     dims["pCe"], dims["nEta"], byrow = FALSE), if (dims["pGe"] >
     0) matrix(rep(fixef[(dims["pCe"] * dims["nEta"] +
     1):dims["p"]], each = dims["nEta"]), dims["pGe"],
     dims["nEta"], byrow = TRUE) else NULL))
     }
     eta <- sapply(1:nrow(newdata), function(i) {
     X[i, , drop = FALSE] %*% fixefMat(coef[i, ])
     })
     if (dims["nEta"] == 1)
     eta <- matrix(eta, ncol = 1)
     else eta <- t(eta)
     colnames(eta) <- etaLabs
     rownames(eta) <- rownames(newdata)
     }
     else {
     eta <- t(sapply(1:nrow(newdata), function(i) {
     X[i, , drop = FALSE] %*% coef[i, ]
     }))
     eta <- matrix(eta, ncol = 1L)
     }
     if (type == "link") {
     if (object$info$fit != "olmm")
     eta <- c(eta)
     return(na.action(eta))
     }
     start <- NULL
     if (object$info$fit == "olmm") {
     terms <- "fe(intercept=FALSE)"
     mTerms <- terms(object$info$formula$original, specials = "re")
     if (length(subs <- attr(mTerms, "specials")$re) > 0L) {
     terms <- c(terms, rownames(attr(mTerms, "factors"))[subs])
     reTerms <- grep("ranefCholFac", names(object$info$coefficients[[1L]]),
     value = TRUE)
     start <- sapply(seq_along(object$info$coefficients),
     function(i) object$info$coefficients[[i]][reTerms])
     start <- apply(matrix(start, ncol = length(reTerms)),
     2L, mean)
     names(start) <- reTerms
     }
     }
     else {
     terms <- "-1"
     }
     form <- as.formula(paste(yName, "~", paste(terms, collapse = "+")))
     if (is.factor(newdata[, yName]) && length(unique(newdata[,
     yName])) < nYLevs) {
     subs <- nrow(newdata) + 1L:nYLevs
     newdata <- rbind(newdata, newdata[rep(1L, nYLevs), ,
     drop = FALSE])
     newdata[subs, yName] <- yLevs
     if (object$info$fit == "olmm") {
     sN <- object$info$model$subjectName
     levs <- c(levels(newdata[, sN]), "RetoBuergin")
     newdata[sN] <- factor(newdata[, sN], levels = levs)
     newdata[subs, sN] <- "RetoBuergin"
     }
     eta <- rbind(eta, matrix(0, nYLevs, ncol(eta)))
     folds <- rbind(folds, matrix(-1L, nYLevs, length(object$info$forest)))
     }
     offset <- eta
     offset[is.na(offset)] <- 0
     oobCall <- call(name = object$info$fit, form = quote(form),
     data = quote(newdata), offset = quote(offset), family = quote(object$info$family),
     start = quote(start), na.action = na.pass)
     for (arg in names(object$info$dotargs)) oobCall[[arg]] <- object$info$dotargs[[arg]]
     oobCall <- oobCall[!duplicated(names(oobCall))]
     if (object$info$fit == "olmm")
     oobCall$doFit <- FALSE
     model <- suppressWarnings(eval(oobCall))
     if (type == "ranef") {
     ranef <- ranef(model)
     ranef <- ranef[rownames(ranef) != "RetoBuergin", , drop = FALSE]
     return(na.action(ranef))
     }
     else {
     if (is.matrix(ranef)) {
     ranefMat <- ranef(model)
     ranefMat[rownames(ranef), ] <- ranef
     ranef <- ranefMat
     }
     pred <- predict(model, type = type, ranef = ranef, ...)
     if (!is.matrix(pred))
     pred <- matrix(pred, nrow = nrow(newdata))
     pred[apply(eta, 1, function(x) any(is.na(x))), ] <- NA
     pred <- pred[folds[, 1] >= 0L, , drop = FALSE]
     }
     folds <- folds[folds[, 1] >= 0L, , drop = FALSE]
     if (oob)
     pred[apply(folds, 1L, function(x) all(x == 0L)), ] <- NA
     if (object$info$fit != "olmm")
     pred <- c(pred)
     return(na.action(pred))
    }
    <bytecode: 0x55ae1eca2570>
    <environment: namespace:vcrpart>
     --- function search by body ---
    Function predict.fvcm in namespace vcrpart has this body.
     ----------- END OF FAILURE REPORT --------------
    Error in if (!class(ranef) %in% c("logical", "matrix")) stop("'ranef' must be a 'logical' or a 'matrix'.") :
     the condition has length > 1
    Calls: predict -> predict.fvcm
    Execution halted
Flavor: r-devel-linux-x86_64-debian-gcc

Version: 1.0-2
Check: examples
Result: ERROR
    Running examples in ‘vcrpart-Ex.R’ failed
    The error most likely occurred in:
    
    > ### Name: fvcm-methods
    > ### Title: Methods for 'fvcm' objects
    > ### Aliases: fvcm-methods fitted.fvcm print.fvcm oobloss.fvcm plot.fvcm
    > ### predict.fvcm print.fvcm ranef.fvcm
    > ### Keywords: methods hplot
    >
    > ### ** Examples
    >
    >
    > ## ------------------------------------------------------------------- #
    > ## Dummy example 1:
    > ##
    > ## Fitting a random forest tvcm on artificially generated ordinal
    > ## longitudinal data. The parameters 'maxstep = 1' and 'K = 2' are
    > ## chosen to restrict the computations.
    > ## ------------------------------------------------------------------- #
    >
    > ## load the data
    >
    > data(vcrpart_1)
    >
    > ## fit and analyse the model
    >
    > control <-
    + fvcolmm_control(mtry = 2, maxstep = 1,
    + folds = folds_control(type = "subsampling", K = 2, prob = 0.75))
    >
    > model.1 <-
    + fvcolmm(y ~ -1 + wave + vc(z3, z4, by = treat, intercept = TRUE) + re(1|id),
    + family = cumulative(), subset = 1:100,
    + data = vcrpart_1, control = control)
    * fitting an initial tree ... OK
    [ 1 ][ 2 ]
    >
    > ## estimating the out of bag loss
    > suppressWarnings(oobloss(model.1))
    [1] Inf
    >
    > ## predicting responses and varying coefficients for subject '27'
    > subs <- vcrpart_1$id == "27"
    >
    > ## predict coefficients
    > predict(model.1, newdata = vcrpart_1[subs,], type = "coef")
     Eta1:(Intercept) Eta2:(Intercept) treat wave ranefCholFac1
    105 -3.209406 -0.3906967 2.835036 0.2515896 1.617485
    106 -3.209406 -0.3906967 2.835036 0.2515896 1.617485
    107 -3.209406 -0.3906967 2.835036 0.2515896 1.617485
    108 -2.812295 0.1968348 1.481318 0.2515896 1.617485
    >
    > ## marginal response prediction
    > predict(model.1, vcrpart_1[subs,], "response", ranef = FALSE)
     1 2 3
    105 0.64487105 0.3030852 0.05204376
    106 0.05173905 0.3021793 0.64608161
    107 0.05963581 0.3241881 0.61617604
    108 0.08089282 0.4062962 0.51281095
    >
    > ## conditional response prediction
    > re <- matrix(5, 1, 1, dimnames = list("27", "(Intercept)"))
    > predict(model.1, vcrpart_1[subs,], "response", ranef = re)
     ----------- FAILURE REPORT --------------
     --- failure: the condition has length > 1 ---
     --- srcref ---
    :
     --- package (from environment) ---
    vcrpart
     --- call from context ---
    predict.fvcm(model.1, vcrpart_1[subs, ], "response", ranef = re)
     --- call from argument ---
    if (!class(ranef) %in% c("logical", "matrix")) stop("'ranef' must be a 'logical' or a 'matrix'.")
     --- R stacktrace ---
    where 1: predict.fvcm(model.1, vcrpart_1[subs, ], "response", ranef = re)
    where 2: predict(model.1, vcrpart_1[subs, ], "response", ranef = re)
    
     --- value of length: 2 type: logical ---
    [1] FALSE TRUE
     --- function from context ---
    function (object, newdata = NULL, type = c("link", "response",
     "prob", "class", "coef", "ranef"), ranef = FALSE, na.action = na.pass,
     verbose = FALSE, ...)
    {
     type <- match.arg(type)
     if (type == "prob")
     type = "response"
     if (!is.null(newdata) && !is.data.frame(newdata))
     stop("'newdata' must be a 'data.frame'.")
     if (!class(ranef) %in% c("logical", "matrix"))
     stop("'ranef' must be a 'logical' or a 'matrix'.")
     if (!is.null(newdata) && is.logical(ranef) && ranef)
     stop("'ranef' should be 'FALSE' or a 'matrix' if 'newdata' is ",
     "not 'NULL'.")
     if (type == "ranef" & (!is.logical(ranef) | is.logical(ranef) &&
     ranef))
     stop("for 'type = 'ranef'' the argument 'ranef' must be 'FALSE'.")
     if (type == "ranef" & !is.null(newdata))
     stop("prediction for random effects for 'newdata' is not ",
     "implemented.")
     oob <- if (!is.null(list(...)$oob))
     list(...)$oob
     else FALSE
     if (oob && !is.null(newdata))
     stop("'oob' should be 'FALSE' if 'newdata' is not 'NULL'")
     class(object) <- class(object)[-1L]
     md <- object$info$data
     dummymodel <- object$info$model
     if (is.null(newdata))
     newdata <- md
     folds <- if (oob) {
     object$info$folds
     }
     else {
     matrix(1L, nrow(newdata), length(object$info$forest))
     }
     formList <- object$info$formula
     rootForm <- tvcm_formula(formList, rep(TRUE, length(formList$vc)),
     object$info$family)$full
     formList <- vcrpart_formula(rootForm, object$info$family)
     yName <- all.vars(lhs(formList$original))
     yLevs <- if (object$info$fit == "olmm")
     levels(md[, yName])
     else yName
     nYLevs <- length(yLevs)
     if (type != "coef") {
     if (!yName %in% colnames(newdata))
     newdata[, yName] <- sample(md[, yName], nrow(newdata),
     replace = TRUE)
     feVars <- unlist(lapply(formList$fe$eta, all.vars))
     if (!all(subs <- feVars %in% colnames(newdata)))
     stop("variable(s) ", paste("'", feVars[!subs], "'",
     collapse = ", "), " are not available in 'newdata'.")
     reVars <- unlist(lapply(unlist(formList$re[c("eta", "cond")]),
     all.vars))
     if (length(reVars) > 0L) {
     if (is.logical(ranef) && ranef | is.matrix(ranef)) {
     if (!all(subs <- reVars %in% colnames(newdata)))
     stop("variables ", feVars[!subs], " are not available in 'newdata'.")
     }
     else {
     for (var in reVars) newdata[, var] <- sample(md[,
     var], nrow(newdata), replace = TRUE)
     }
     }
     Terms <- attr(md, "terms")
     xlevels <- .getXlevels(attr(md, "terms"), md)
     if (is.matrix(ranef)) {
     subjectName <- dummymodel$subjectName
     xlevels <- xlevels[names(xlevels) != subjectName]
     }
     newdata <- as.data.frame(model.frame(Terms, newdata,
     na.action = na.pass, xlev = xlevels))
     attr(newdata, "terms") <- NULL
     }
     if (verbose)
     cat("* predicting the coefficient functions ... ")
     nEta <- if (object$info$fit == "olmm")
     nYLevs - 1L
     else 1L
     etaLabs <- paste("Eta", 1L:nEta, sep = "")
     coef <- count <- 0 * predict(object, newdata, type = "coef")
     rownames(coef) <- rownames(newdata)
     subs <- matrix(TRUE, nrow(coef), ncol(coef), dimnames = list(rownames(coef),
     colnames(coef)))
     for (i in seq_along(object$info$forest)) {
     if (verbose)
     cat(".")
     object$info$node <- object$info$forest[[i]]
     object$info$model$coefficients <- object$info$coefficients[[i]]
     object$info$model$contrasts <- object$info$contrasts[[i]]
     coefi <- predict(object, newdata = newdata, type = "coef",
     ranef = FALSE, na.action = na.pass, ...)
     if (!is.matrix(coefi))
     coefi <- matrix(coefi, nrow = nrow(newdata))
     if (object$info$fit == "olmm" && ncol(coefi) < ncol(coef)) {
     subsiCols <- table(md[folds[, i] > 0, yName]) > 0L
     subsiCols <- subsiCols[-length(subsiCols)]
     etaLabsShould <- etaLabs[subsiCols]
     colnamesi <- colnames(coefi)
     etaLabsIs <- grep("Eta[1-9]+:", colnamesi, value = TRUE)
     etaLabsIs <- unique(sapply(strsplit(etaLabsIs, ":"),
     function(x) x[1]))
     colnamesi <- strsplit(colnamesi, ":")
     for (j in rev(seq_along(etaLabsIs))) {
     colnamesi <- lapply(colnamesi, function(x) {
     if (x[1L] == etaLabsIs[j])
     x[1L] <- etaLabsShould[j]
     return(x)
     })
     }
     colnamesi <- sapply(colnamesi, function(x) paste(x,
     collapse = ":"))
     colnames(coefi) <- colnamesi
     }
     coefi <- coefi[, intersect(colnames(coef), colnames(coefi)),
     drop = FALSE]
     subsi <- subs
     if (oob)
     subsi[folds[, i] > 0L, ] <- FALSE
     subsi[is.na(coefi)] <- FALSE
     coef[subsi] <- coef[subsi] + coefi[subsi]
     count <- count + 1 * subsi
     }
     if (verbose)
     cat(" OK\n")
     coef <- coef/count
     coef[apply(count, 1, function(x) any(x == 0)), ] <- NA
     if (length(setdiff(names(coef(dummymodel)), colnames(coef))) >
     0 | length(setdiff(colnames(coef), names(coef(dummymodel)))) >
     0)
     stop("ups. This shouldn't happen. Please contact the author of this package and ",
     "indicate to have problems with 'fvcm.predict'.")
     coef <- coef[, match(names(coef(dummymodel)), colnames(coef)),
     drop = FALSE]
     if (type == "coef")
     return(na.action(coef))
     if (object$info$fit == "olmm") {
     X <- olmm_merge_mm(model.matrix(terms(formList$fe$eta$ce,
     keep.order = TRUE), newdata, attr(object$info$model$X,
     "contrasts")), model.matrix(terms(formList$fe$eta$ge,
     keep.order = TRUE), newdata, attr(object$info$model$X,
     "contrasts")), TRUE)
     }
     else {
     X <- model.matrix(terms(rootForm), newdata, dummymodel$contrasts)
     }
     if (object$info$fit == "olmm") {
     coef <- coef[, substr(colnames(coef), 1, 12) != "ranefCholFac",
     drop = FALSE]
     dims <- dummymodel$dims
     fixefMat <- function(fixef) {
     return(rbind(matrix(fixef[1:(dims["pCe"] * dims["nEta"])],
     dims["pCe"], dims["nEta"], byrow = FALSE), if (dims["pGe"] >
     0) matrix(rep(fixef[(dims["pCe"] * dims["nEta"] +
     1):dims["p"]], each = dims["nEta"]), dims["pGe"],
     dims["nEta"], byrow = TRUE) else NULL))
     }
     eta <- sapply(1:nrow(newdata), function(i) {
     X[i, , drop = FALSE] %*% fixefMat(coef[i, ])
     })
     if (dims["nEta"] == 1)
     eta <- matrix(eta, ncol = 1)
     else eta <- t(eta)
     colnames(eta) <- etaLabs
     rownames(eta) <- rownames(newdata)
     }
     else {
     eta <- t(sapply(1:nrow(newdata), function(i) {
     X[i, , drop = FALSE] %*% coef[i, ]
     }))
     eta <- matrix(eta, ncol = 1L)
     }
     if (type == "link") {
     if (object$info$fit != "olmm")
     eta <- c(eta)
     return(na.action(eta))
     }
     start <- NULL
     if (object$info$fit == "olmm") {
     terms <- "fe(intercept=FALSE)"
     mTerms <- terms(object$info$formula$original, specials = "re")
     if (length(subs <- attr(mTerms, "specials")$re) > 0L) {
     terms <- c(terms, rownames(attr(mTerms, "factors"))[subs])
     reTerms <- grep("ranefCholFac", names(object$info$coefficients[[1L]]),
     value = TRUE)
     start <- sapply(seq_along(object$info$coefficients),
     function(i) object$info$coefficients[[i]][reTerms])
     start <- apply(matrix(start, ncol = length(reTerms)),
     2L, mean)
     names(start) <- reTerms
     }
     }
     else {
     terms <- "-1"
     }
     form <- as.formula(paste(yName, "~", paste(terms, collapse = "+")))
     if (is.factor(newdata[, yName]) && length(unique(newdata[,
     yName])) < nYLevs) {
     subs <- nrow(newdata) + 1L:nYLevs
     newdata <- rbind(newdata, newdata[rep(1L, nYLevs), ,
     drop = FALSE])
     newdata[subs, yName] <- yLevs
     if (object$info$fit == "olmm") {
     sN <- object$info$model$subjectName
     levs <- c(levels(newdata[, sN]), "RetoBuergin")
     newdata[sN] <- factor(newdata[, sN], levels = levs)
     newdata[subs, sN] <- "RetoBuergin"
     }
     eta <- rbind(eta, matrix(0, nYLevs, ncol(eta)))
     folds <- rbind(folds, matrix(-1L, nYLevs, length(object$info$forest)))
     }
     offset <- eta
     offset[is.na(offset)] <- 0
     oobCall <- call(name = object$info$fit, form = quote(form),
     data = quote(newdata), offset = quote(offset), family = quote(object$info$family),
     start = quote(start), na.action = na.pass)
     for (arg in names(object$info$dotargs)) oobCall[[arg]] <- object$info$dotargs[[arg]]
     oobCall <- oobCall[!duplicated(names(oobCall))]
     if (object$info$fit == "olmm")
     oobCall$doFit <- FALSE
     model <- suppressWarnings(eval(oobCall))
     if (type == "ranef") {
     ranef <- ranef(model)
     ranef <- ranef[rownames(ranef) != "RetoBuergin", , drop = FALSE]
     return(na.action(ranef))
     }
     else {
     if (is.matrix(ranef)) {
     ranefMat <- ranef(model)
     ranefMat[rownames(ranef), ] <- ranef
     ranef <- ranefMat
     }
     pred <- predict(model, type = type, ranef = ranef, ...)
     if (!is.matrix(pred))
     pred <- matrix(pred, nrow = nrow(newdata))
     pred[apply(eta, 1, function(x) any(is.na(x))), ] <- NA
     pred <- pred[folds[, 1] >= 0L, , drop = FALSE]
     }
     folds <- folds[folds[, 1] >= 0L, , drop = FALSE]
     if (oob)
     pred[apply(folds, 1L, function(x) all(x == 0L)), ] <- NA
     if (object$info$fit != "olmm")
     pred <- c(pred)
     return(na.action(pred))
    }
    <bytecode: 0xcf09f20>
    <environment: namespace:vcrpart>
     --- function search by body ---
    Function predict.fvcm in namespace vcrpart has this body.
     ----------- END OF FAILURE REPORT --------------
    Error in if (!class(ranef) %in% c("logical", "matrix")) stop("'ranef' must be a 'logical' or a 'matrix'.") :
     the condition has length > 1
    Calls: predict -> predict.fvcm
    Execution halted
Flavor: r-devel-linux-x86_64-fedora-clang

Version: 1.0-2
Check: examples
Result: ERROR
    Running examples in ‘vcrpart-Ex.R’ failed
    The error most likely occurred in:
    
    > ### Name: fvcm-methods
    > ### Title: Methods for 'fvcm' objects
    > ### Aliases: fvcm-methods fitted.fvcm print.fvcm oobloss.fvcm plot.fvcm
    > ### predict.fvcm print.fvcm ranef.fvcm
    > ### Keywords: methods hplot
    >
    > ### ** Examples
    >
    >
    > ## ------------------------------------------------------------------- #
    > ## Dummy example 1:
    > ##
    > ## Fitting a random forest tvcm on artificially generated ordinal
    > ## longitudinal data. The parameters 'maxstep = 1' and 'K = 2' are
    > ## chosen to restrict the computations.
    > ## ------------------------------------------------------------------- #
    >
    > ## load the data
    >
    > data(vcrpart_1)
    >
    > ## fit and analyse the model
    >
    > control <-
    + fvcolmm_control(mtry = 2, maxstep = 1,
    + folds = folds_control(type = "subsampling", K = 2, prob = 0.75))
    >
    > model.1 <-
    + fvcolmm(y ~ -1 + wave + vc(z3, z4, by = treat, intercept = TRUE) + re(1|id),
    + family = cumulative(), subset = 1:100,
    + data = vcrpart_1, control = control)
    * fitting an initial tree ... OK
    [ 1 ][ 2 ]
    >
    > ## estimating the out of bag loss
    > suppressWarnings(oobloss(model.1))
    [1] Inf
    >
    > ## predicting responses and varying coefficients for subject '27'
    > subs <- vcrpart_1$id == "27"
    >
    > ## predict coefficients
    > predict(model.1, newdata = vcrpart_1[subs,], type = "coef")
     Eta1:(Intercept) Eta2:(Intercept) treat wave ranefCholFac1
    105 -3.209406 -0.3906967 2.835036 0.2515896 1.617485
    106 -3.209406 -0.3906967 2.835036 0.2515896 1.617485
    107 -3.209406 -0.3906967 2.835036 0.2515896 1.617485
    108 -2.812295 0.1968348 1.481318 0.2515896 1.617485
    >
    > ## marginal response prediction
    > predict(model.1, vcrpart_1[subs,], "response", ranef = FALSE)
     1 2 3
    105 0.64487105 0.3030852 0.05204376
    106 0.05173905 0.3021793 0.64608161
    107 0.05963581 0.3241881 0.61617604
    108 0.08089282 0.4062962 0.51281095
    >
    > ## conditional response prediction
    > re <- matrix(5, 1, 1, dimnames = list("27", "(Intercept)"))
    > predict(model.1, vcrpart_1[subs,], "response", ranef = re)
     ----------- FAILURE REPORT --------------
     --- failure: the condition has length > 1 ---
     --- srcref ---
    :
     --- package (from environment) ---
    vcrpart
     --- call from context ---
    predict.fvcm(model.1, vcrpart_1[subs, ], "response", ranef = re)
     --- call from argument ---
    if (!class(ranef) %in% c("logical", "matrix")) stop("'ranef' must be a 'logical' or a 'matrix'.")
     --- R stacktrace ---
    where 1: predict.fvcm(model.1, vcrpart_1[subs, ], "response", ranef = re)
    where 2: predict(model.1, vcrpart_1[subs, ], "response", ranef = re)
    
     --- value of length: 2 type: logical ---
    [1] FALSE TRUE
     --- function from context ---
    function (object, newdata = NULL, type = c("link", "response",
     "prob", "class", "coef", "ranef"), ranef = FALSE, na.action = na.pass,
     verbose = FALSE, ...)
    {
     type <- match.arg(type)
     if (type == "prob")
     type = "response"
     if (!is.null(newdata) && !is.data.frame(newdata))
     stop("'newdata' must be a 'data.frame'.")
     if (!class(ranef) %in% c("logical", "matrix"))
     stop("'ranef' must be a 'logical' or a 'matrix'.")
     if (!is.null(newdata) && is.logical(ranef) && ranef)
     stop("'ranef' should be 'FALSE' or a 'matrix' if 'newdata' is ",
     "not 'NULL'.")
     if (type == "ranef" & (!is.logical(ranef) | is.logical(ranef) &&
     ranef))
     stop("for 'type = 'ranef'' the argument 'ranef' must be 'FALSE'.")
     if (type == "ranef" & !is.null(newdata))
     stop("prediction for random effects for 'newdata' is not ",
     "implemented.")
     oob <- if (!is.null(list(...)$oob))
     list(...)$oob
     else FALSE
     if (oob && !is.null(newdata))
     stop("'oob' should be 'FALSE' if 'newdata' is not 'NULL'")
     class(object) <- class(object)[-1L]
     md <- object$info$data
     dummymodel <- object$info$model
     if (is.null(newdata))
     newdata <- md
     folds <- if (oob) {
     object$info$folds
     }
     else {
     matrix(1L, nrow(newdata), length(object$info$forest))
     }
     formList <- object$info$formula
     rootForm <- tvcm_formula(formList, rep(TRUE, length(formList$vc)),
     object$info$family)$full
     formList <- vcrpart_formula(rootForm, object$info$family)
     yName <- all.vars(lhs(formList$original))
     yLevs <- if (object$info$fit == "olmm")
     levels(md[, yName])
     else yName
     nYLevs <- length(yLevs)
     if (type != "coef") {
     if (!yName %in% colnames(newdata))
     newdata[, yName] <- sample(md[, yName], nrow(newdata),
     replace = TRUE)
     feVars <- unlist(lapply(formList$fe$eta, all.vars))
     if (!all(subs <- feVars %in% colnames(newdata)))
     stop("variable(s) ", paste("'", feVars[!subs], "'",
     collapse = ", "), " are not available in 'newdata'.")
     reVars <- unlist(lapply(unlist(formList$re[c("eta", "cond")]),
     all.vars))
     if (length(reVars) > 0L) {
     if (is.logical(ranef) && ranef | is.matrix(ranef)) {
     if (!all(subs <- reVars %in% colnames(newdata)))
     stop("variables ", feVars[!subs], " are not available in 'newdata'.")
     }
     else {
     for (var in reVars) newdata[, var] <- sample(md[,
     var], nrow(newdata), replace = TRUE)
     }
     }
     Terms <- attr(md, "terms")
     xlevels <- .getXlevels(attr(md, "terms"), md)
     if (is.matrix(ranef)) {
     subjectName <- dummymodel$subjectName
     xlevels <- xlevels[names(xlevels) != subjectName]
     }
     newdata <- as.data.frame(model.frame(Terms, newdata,
     na.action = na.pass, xlev = xlevels))
     attr(newdata, "terms") <- NULL
     }
     if (verbose)
     cat("* predicting the coefficient functions ... ")
     nEta <- if (object$info$fit == "olmm")
     nYLevs - 1L
     else 1L
     etaLabs <- paste("Eta", 1L:nEta, sep = "")
     coef <- count <- 0 * predict(object, newdata, type = "coef")
     rownames(coef) <- rownames(newdata)
     subs <- matrix(TRUE, nrow(coef), ncol(coef), dimnames = list(rownames(coef),
     colnames(coef)))
     for (i in seq_along(object$info$forest)) {
     if (verbose)
     cat(".")
     object$info$node <- object$info$forest[[i]]
     object$info$model$coefficients <- object$info$coefficients[[i]]
     object$info$model$contrasts <- object$info$contrasts[[i]]
     coefi <- predict(object, newdata = newdata, type = "coef",
     ranef = FALSE, na.action = na.pass, ...)
     if (!is.matrix(coefi))
     coefi <- matrix(coefi, nrow = nrow(newdata))
     if (object$info$fit == "olmm" && ncol(coefi) < ncol(coef)) {
     subsiCols <- table(md[folds[, i] > 0, yName]) > 0L
     subsiCols <- subsiCols[-length(subsiCols)]
     etaLabsShould <- etaLabs[subsiCols]
     colnamesi <- colnames(coefi)
     etaLabsIs <- grep("Eta[1-9]+:", colnamesi, value = TRUE)
     etaLabsIs <- unique(sapply(strsplit(etaLabsIs, ":"),
     function(x) x[1]))
     colnamesi <- strsplit(colnamesi, ":")
     for (j in rev(seq_along(etaLabsIs))) {
     colnamesi <- lapply(colnamesi, function(x) {
     if (x[1L] == etaLabsIs[j])
     x[1L] <- etaLabsShould[j]
     return(x)
     })
     }
     colnamesi <- sapply(colnamesi, function(x) paste(x,
     collapse = ":"))
     colnames(coefi) <- colnamesi
     }
     coefi <- coefi[, intersect(colnames(coef), colnames(coefi)),
     drop = FALSE]
     subsi <- subs
     if (oob)
     subsi[folds[, i] > 0L, ] <- FALSE
     subsi[is.na(coefi)] <- FALSE
     coef[subsi] <- coef[subsi] + coefi[subsi]
     count <- count + 1 * subsi
     }
     if (verbose)
     cat(" OK\n")
     coef <- coef/count
     coef[apply(count, 1, function(x) any(x == 0)), ] <- NA
     if (length(setdiff(names(coef(dummymodel)), colnames(coef))) >
     0 | length(setdiff(colnames(coef), names(coef(dummymodel)))) >
     0)
     stop("ups. This shouldn't happen. Please contact the author of this package and ",
     "indicate to have problems with 'fvcm.predict'.")
     coef <- coef[, match(names(coef(dummymodel)), colnames(coef)),
     drop = FALSE]
     if (type == "coef")
     return(na.action(coef))
     if (object$info$fit == "olmm") {
     X <- olmm_merge_mm(model.matrix(terms(formList$fe$eta$ce,
     keep.order = TRUE), newdata, attr(object$info$model$X,
     "contrasts")), model.matrix(terms(formList$fe$eta$ge,
     keep.order = TRUE), newdata, attr(object$info$model$X,
     "contrasts")), TRUE)
     }
     else {
     X <- model.matrix(terms(rootForm), newdata, dummymodel$contrasts)
     }
     if (object$info$fit == "olmm") {
     coef <- coef[, substr(colnames(coef), 1, 12) != "ranefCholFac",
     drop = FALSE]
     dims <- dummymodel$dims
     fixefMat <- function(fixef) {
     return(rbind(matrix(fixef[1:(dims["pCe"] * dims["nEta"])],
     dims["pCe"], dims["nEta"], byrow = FALSE), if (dims["pGe"] >
     0) matrix(rep(fixef[(dims["pCe"] * dims["nEta"] +
     1):dims["p"]], each = dims["nEta"]), dims["pGe"],
     dims["nEta"], byrow = TRUE) else NULL))
     }
     eta <- sapply(1:nrow(newdata), function(i) {
     X[i, , drop = FALSE] %*% fixefMat(coef[i, ])
     })
     if (dims["nEta"] == 1)
     eta <- matrix(eta, ncol = 1)
     else eta <- t(eta)
     colnames(eta) <- etaLabs
     rownames(eta) <- rownames(newdata)
     }
     else {
     eta <- t(sapply(1:nrow(newdata), function(i) {
     X[i, , drop = FALSE] %*% coef[i, ]
     }))
     eta <- matrix(eta, ncol = 1L)
     }
     if (type == "link") {
     if (object$info$fit != "olmm")
     eta <- c(eta)
     return(na.action(eta))
     }
     start <- NULL
     if (object$info$fit == "olmm") {
     terms <- "fe(intercept=FALSE)"
     mTerms <- terms(object$info$formula$original, specials = "re")
     if (length(subs <- attr(mTerms, "specials")$re) > 0L) {
     terms <- c(terms, rownames(attr(mTerms, "factors"))[subs])
     reTerms <- grep("ranefCholFac", names(object$info$coefficients[[1L]]),
     value = TRUE)
     start <- sapply(seq_along(object$info$coefficients),
     function(i) object$info$coefficients[[i]][reTerms])
     start <- apply(matrix(start, ncol = length(reTerms)),
     2L, mean)
     names(start) <- reTerms
     }
     }
     else {
     terms <- "-1"
     }
     form <- as.formula(paste(yName, "~", paste(terms, collapse = "+")))
     if (is.factor(newdata[, yName]) && length(unique(newdata[,
     yName])) < nYLevs) {
     subs <- nrow(newdata) + 1L:nYLevs
     newdata <- rbind(newdata, newdata[rep(1L, nYLevs), ,
     drop = FALSE])
     newdata[subs, yName] <- yLevs
     if (object$info$fit == "olmm") {
     sN <- object$info$model$subjectName
     levs <- c(levels(newdata[, sN]), "RetoBuergin")
     newdata[sN] <- factor(newdata[, sN], levels = levs)
     newdata[subs, sN] <- "RetoBuergin"
     }
     eta <- rbind(eta, matrix(0, nYLevs, ncol(eta)))
     folds <- rbind(folds, matrix(-1L, nYLevs, length(object$info$forest)))
     }
     offset <- eta
     offset[is.na(offset)] <- 0
     oobCall <- call(name = object$info$fit, form = quote(form),
     data = quote(newdata), offset = quote(offset), family = quote(object$info$family),
     start = quote(start), na.action = na.pass)
     for (arg in names(object$info$dotargs)) oobCall[[arg]] <- object$info$dotargs[[arg]]
     oobCall <- oobCall[!duplicated(names(oobCall))]
     if (object$info$fit == "olmm")
     oobCall$doFit <- FALSE
     model <- suppressWarnings(eval(oobCall))
     if (type == "ranef") {
     ranef <- ranef(model)
     ranef <- ranef[rownames(ranef) != "RetoBuergin", , drop = FALSE]
     return(na.action(ranef))
     }
     else {
     if (is.matrix(ranef)) {
     ranefMat <- ranef(model)
     ranefMat[rownames(ranef), ] <- ranef
     ranef <- ranefMat
     }
     pred <- predict(model, type = type, ranef = ranef, ...)
     if (!is.matrix(pred))
     pred <- matrix(pred, nrow = nrow(newdata))
     pred[apply(eta, 1, function(x) any(is.na(x))), ] <- NA
     pred <- pred[folds[, 1] >= 0L, , drop = FALSE]
     }
     folds <- folds[folds[, 1] >= 0L, , drop = FALSE]
     if (oob)
     pred[apply(folds, 1L, function(x) all(x == 0L)), ] <- NA
     if (object$info$fit != "olmm")
     pred <- c(pred)
     return(na.action(pred))
    }
    <bytecode: 0xd019148>
    <environment: namespace:vcrpart>
     --- function search by body ---
    Function predict.fvcm in namespace vcrpart has this body.
     ----------- END OF FAILURE REPORT --------------
    Error in if (!class(ranef) %in% c("logical", "matrix")) stop("'ranef' must be a 'logical' or a 'matrix'.") :
     the condition has length > 1
    Calls: predict -> predict.fvcm
    Execution halted
Flavor: r-devel-linux-x86_64-fedora-gcc