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: 0xc04e8b0>
<environment: namespace:vcrpart>
 --- function search by body ---
Function predict.fvcm in namespace vcrpart has this body.
 ----------- END OF FAILURE REPORT -------------- 
Fatal error: the condition has length > 1