Running examples in ‘BayesFM-Ex.R’ failed
The error most likely occurred in:

> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: befa
> ### Title: Bayesian Exploratory Factor Analysis
> ### Aliases: befa
> 
> ### ** Examples
> 
> #### model without covariates
> 
> set.seed(6)
> 
> # generate fake data with 15 manifest variables and 3 factors
> N <- 200    # number of observations
> Y <- simul.dedic.facmod(N, dedic = rep(1:3, each = 5))
> 
> # run MCMC sampler
> # notice: 1000 MCMC iterations for illustration purposes only,
> #  increase this number to obtain reliable posterior results!
> mcmc <- befa(Y, Kmax = 5, iter = 1000)
 ----------- FAILURE REPORT -------------- 
 --- failure: the condition has length > 1 ---
 --- srcref --- 
: 
 --- package (from environment) --- 
BayesFM
 --- call from context --- 
befa(Y, Kmax = 5, iter = 1000)
 --- call from argument --- 
if (!is.invertible.matrix(R.start)) {
    checkArgs$push("R.start is not invertible (singular matrix).")
}
 --- R stacktrace ---
where 1: befa(Y, Kmax = 5, iter = 1000)

 --- value of length: 2 type: logical ---
[1] FALSE  TRUE
 --- function from context --- 
function (model, data, burnin = 1000, iter = 10000, Nid = 3, 
    Kmax, A0 = 10, B0 = 10, c0 = 2, C0 = 1, HW.prior = TRUE, 
    nu0 = Kmax + 1, S0 = 1, kappa0 = 2, xi0 = 1, kappa = 1/Kmax, 
    indp.tau0 = TRUE, rnd.step = TRUE, n.step = 5, search.delay = min(burnin, 
        10), R.delay = min(burnin, 100), dedic.start, alpha.start, 
    sigma.start, beta.start, R.start, verbose = TRUE) 
{
    checkArgs <- makeAssertCollection()
    if (missing(data)) 
        data <- parent.frame()
    else assertDataFrame(data)
    if (is.matrix(model)) 
        model <- as.data.frame(model)
    if (is.data.frame(model)) {
        assertDataFrame(model, types = c("double", "logical"), 
            all.missing = FALSE)
        Ytype <- sapply(model, typeof)
        Yobs <- as.matrix(model)
        Xobs <- nX <- 0
        YXloc <- FALSE
    }
    else if (is.list(model) & all(sapply(model, is.formula))) {
        tmp <- extract.data(model, data)
        if (!is.null(tmp$errmsg)) {
            for (w in tmp$errmsg) checkArgs$push(w)
        }
        else {
            for (w in tmp$warnmsg) warning(w, immediate. = TRUE)
            Yobs <- tmp$Yobs
            Ytype <- tmp$Ytype
            Xobs <- tmp$Xobs
            Xlab <- colnames(Xobs)
            YXloc <- tmp$YXloc
            nX <- ncol(Xobs)
        }
    }
    else {
        checkArgs$push("Y should be a matrix, a data frame or a list of formulas.")
    }
    reportAssertions(checkArgs)
    Ycat <- rep(0, length(Ytype))
    Ycat[Ytype == "logical"] <- 2
    Yind <- Ytype %in% c("double", "numeric", "logical")
    if (any(!Yind)) {
        checkArgs$push(paste("following variables not continuous nor dichotomous:", 
            paste0(Ylab[!Yind], collapse = ", ")))
    }
    Ylab <- colnames(Yobs)
    nobs <- nrow(Yobs)
    nvar <- ncol(Yobs)
    nbeta <- sum(YXloc)
    Ymiss <- is.na(Yobs)
    Yobs[Ymiss] <- -99999
    assertInt(Nid, lower = 1, upper = nvar, add = checkArgs)
    Ledermann.bound <- 0.5 * (2 * nvar + 1 - sqrt(8 * nvar + 
        1))
    if (missing(Kmax)) {
        Kmax <- floor(min(nvar/Nid, Ledermann.bound))
    }
    else {
        assertInt(Kmax, lower = 1, upper = nvar, add = checkArgs)
    }
    if (Kmax > Ledermann.bound) {
        warning("Check identification! (Kmax exceeds Ledermann bound)", 
            immediate. = TRUE)
    }
    if (Kmax > floor(nvar/Nid)) {
        msg <- paste("Too many latent factors specified given identification", 
            "restriction. Check arguments Nid and Kmax.")
        checkArgs$push(msg)
    }
    if (Kmax == 1) {
        checkArgs$push("Single-factor model not allowed.")
    }
    reportAssertions(checkArgs)
    check.prior <- function(x, n, min, name) {
        if (length(x) == 1) 
            x <- rep(x, n)
        assertNumeric(x, len = n, lower = min, finite = TRUE, 
            any.missing = FALSE, .var.name = name, add = checkArgs)
        return(x)
    }
    tiny <- 10^-9
    A0 <- check.prior(A0, nvar, tiny, "A0")
    B0 <- check.prior(B0, nvar, tiny, "B0")
    c0 <- check.prior(c0, nvar, tiny, "c0")
    C0 <- check.prior(C0, nvar, tiny, "C0")
    S0 <- check.prior(S0, Kmax, tiny, "S0")
    nu0 <- check.prior(nu0, 1, Kmax, "nu0")
    xi0 <- check.prior(xi0, 1, tiny, "xi0")
    kappa <- check.prior(kappa, Kmax, tiny, "kappa")
    kappa0 <- check.prior(kappa0, 1, tiny, "kappa0")
    assertFlag(HW.prior, add = checkArgs)
    assertFlag(indp.tau0, add = checkArgs)
    reportAssertions(checkArgs)
    prior.idiovar <- cbind(c0, C0)
    prior.loading <- 1/A0
    prior.beta <- 1/B0
    prior.dedic <- c(indp.tau0, 1/A0, c0, C0, xi0, kappa0, kappa)
    prior.facdist <- c(HW.prior, nu0, S0)
    if (missing(sigma.start)) {
        sigma.start <- 1/rgamma(nvar, shape = c0, rate = C0)
    }
    else {
        assertNumeric(sigma.start, len = nvar, lower = tiny, 
            any.missing = FALSE, add = checkArgs)
    }
    sigma.start[Ycat > 0] <- 1
    if (missing(alpha.start)) {
        alpha.start <- rnorm(nvar, mean = 0, sd = sqrt(A0))
    }
    else {
        assertNumeric(alpha.start, len = nvar, any.missing = FALSE, 
            add = checkArgs)
    }
    if (missing(beta.start)) {
        if (nbeta > 0) {
            beta.start <- rnorm(nbeta, mean = 0, sd = rep(sqrt(B0), 
                rowSums(YXloc)))
        }
        else {
            beta.start <- double()
        }
    }
    assertNumeric(beta.start, len = nbeta, any.missing = FALSE, 
        add = checkArgs)
    beta.start.1 <- matrix(-99999, nX, nvar)
    if (length(beta.start) == nbeta) {
        beta.start.1[t(YXloc)] <- beta.start
        beta.start.1 <- t(beta.start.1)
    }
    if (missing(R.start)) {
        R.start <- diag(Kmax)
    }
    assertMatrix(R.start, mode = "double", nrows = Kmax, ncols = Kmax, 
        any.missing = FALSE, add = checkArgs)
    if (!all(diag(R.start) == 1)) {
        checkArgs$push("R.start should be a correlation matrix.")
    }
    if (!is.pos.semidefinite.matrix(R.start)) {
        checkArgs$push("R.start should be a positive semi-definite matrix.")
    }
    if (!is.invertible.matrix(R.start)) {
        checkArgs$push("R.start is not invertible (singular matrix).")
    }
    if (missing(dedic.start)) {
        dedic.start <- rep(0, nvar)
        ind <- matrix(sample(Nid * Kmax), ncol = Kmax)
        for (k in 1:Kmax) dedic.start[ind[, k]] <- k
        dedic.start[dedic.start == 0] <- sample(Kmax, nvar - 
            Nid * Kmax, replace = TRUE)
    }
    assertIntegerish(dedic.start, len = nvar, lower = 0, upper = Kmax, 
        any.missing = FALSE, add = checkArgs)
    if (any(table(dedic.start[dedic.start != 0]) < Nid)) {
        checkArgs$push("dedic.start does not correspond to an identified model.")
    }
    start.factor <- replicate(Kmax, rnorm(nobs))
    assertCount(iter, positive = TRUE, add = checkArgs)
    assertCount(burnin, positive = FALSE, add = checkArgs)
    assertInt(search.delay, lower = 0, upper = burnin + iter)
    assertInt(R.delay, lower = 0, upper = burnin + iter)
    assertFlag(rnd.step, add = checkArgs)
    if (rnd.step) {
        assertNumber(n.step, lower = 1.1, add = checkArgs)
        n.step <- n.step - 1
    }
    else {
        assertCount(n.step, positive = TRUE, add = checkArgs)
    }
    assertFlag(verbose, add = checkArgs)
    reportAssertions(checkArgs)
    npar <- c(nvar, nvar, Kmax * (Kmax - 1)/2, nbeta)
    npar.all <- sum(npar)
    seed <- round(runif(1) * 10^9)
    if (verbose) 
        cat("starting MCMC sampling...\n")
    mcmc <- .Fortran(F_befa, as.integer(nvar), as.integer(nobs), 
        as.integer(Kmax), as.integer(Nid), as.double(Yobs), as.integer(Ycat), 
        as.logical(Ymiss), as.integer(nX), as.double(Xobs), as.logical(YXloc), 
        as.integer(burnin + iter), as.integer(burnin), as.integer(search.delay), 
        as.integer(R.delay), as.logical(rnd.step), as.double(n.step), 
        as.integer(seed), as.double(cbind(prior.loading, prior.idiovar)), 
        as.double(prior.beta), as.double(prior.dedic), as.double(prior.facdist), 
        as.double(cbind(alpha.start, sigma.start)), as.double(beta.start.1), 
        as.integer(dedic.start), as.double(start.factor), as.double(R.start), 
        as.logical(verbose), as.integer(npar.all), MCMCdraws = double(iter * 
            npar.all), MCMCdedic = integer(iter * nvar), MHacc = logical(iter))
    if (verbose) 
        cat("done with sampling!\n")
    par.mcmc <- split(mcmc$MCMCdraws, rep(1:4, times = iter * 
        npar))
    par.mcmc <- lapply(par.mcmc, matrix, nrow = iter)
    names(par.mcmc)[1:3] <- c("alpha", "sigma", "R")
    colnames(par.mcmc$R) <- paste("R", rep(1:(Kmax - 1), times = (Kmax - 
        1):1), unlist(mapply(seq, 2:Kmax, Kmax)), sep = ":")
    colnames(par.mcmc$alpha) <- paste0("alpha:", Ylab)
    colnames(par.mcmc$sigma) <- paste0("sigma:", Ylab)
    iter.lab <- burnin + 1:iter
    rownames(par.mcmc$alpha) <- iter.lab
    rownames(par.mcmc$sigma) <- iter.lab
    rownames(par.mcmc$R) <- iter.lab
    if (nbeta > 0) {
        names(par.mcmc)[4] <- "beta"
        beta.lab <- c()
        for (i in 1:nvar) {
            if (!any(YXloc[i, ])) 
                next
            beta.lab <- c(beta.lab, paste(Ylab[i], Xlab[YXloc[i, 
                ]], sep = ":"))
        }
        colnames(par.mcmc$beta) <- beta.lab
        rownames(par.mcmc$beta) <- iter.lab
    }
    dedic.mcmc <- as.integer(mcmc$MCMCdedic)
    dedic.mcmc <- matrix(dedic.mcmc, nrow = iter, ncol = nvar)
    colnames(dedic.mcmc) <- paste0("dedic:", Ylab)
    rownames(dedic.mcmc) <- iter.lab
    nfac.mcmc <- apply(dedic.mcmc, 1, count.unique.nonzero)
    output <- par.mcmc
    output$dedic <- dedic.mcmc
    output$nfac <- nfac.mcmc
    output$MHacc <- mcmc$MHacc
    attr(output, "call") <- match.call()
    attr(output, "title") <- "BEFA posterior sample"
    attr(output, "Kmax") <- Kmax
    attr(output, "Nid") <- Nid
    attr(output, "iter") <- iter
    attr(output, "burnin") <- burnin
    attr(output, "post.column.switch") <- FALSE
    attr(output, "post.sign.switch") <- FALSE
    class(output) <- "befa"
    return(output)
}
<bytecode: 0x558135d53e68>
<environment: namespace:BayesFM>
 --- function search by body ---
Function befa in namespace BayesFM has this body.
 ----------- END OF FAILURE REPORT -------------- 
Fatal error: the condition has length > 1