Running examples in 'mvProbit-Ex.R' failed
The error most likely occurred in:

> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: mvProbit
> ### Title: Estimation of Multivariate Probit Models
> ### Aliases: mvProbit print.mvProbit
> ### Keywords: models regression
> 
> ### ** Examples
> 
> ## generate a simulated data set
> set.seed( 123 )
> # number of observations
> nObs <- 50
> 
> # generate explanatory variables
> xMat <- cbind( 
+    const = rep( 1, nObs ),
+    x1 = as.numeric( rnorm( nObs ) > 0 ),
+    x2 = rnorm( nObs ) )
> 
> # model coefficients
> beta <- cbind( c(  0.8,  1.2, -0.8 ),
+                c( -0.6,  1.0, -1.6 ),
+                c(  0.5, -0.6,  1.2 ) )
> 
> # covariance matrix of error terms
> library( miscTools )
> sigma <- symMatrix( c( 1, 0.2, 0.4, 1, -0.1, 1 ) )
> 
> # generate dependent variables
> yMatLin <- xMat %*% beta 
> yMat <- ( yMatLin + rmvnorm( nObs, sigma = sigma ) ) > 0
> colnames( yMat ) <- paste( "y", 1:3, sep = "" )
> 
> # estimation (BHHH optimizer and GHK algorithm)
> estResult <- mvProbit( cbind( y1, y2, y3 ) ~ x1 + x2,
+    data = as.data.frame( cbind( xMat, yMat ) ), iterlim = 1, nGHK = 50 )
Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
 ----------- FAILURE REPORT -------------- 
 --- failure: the condition has length > 1 ---
 --- srcref --- 
: 
 --- package (from environment) --- 
mvProbit
 --- call from context --- 
pmvnormWrap(upper = xBetaTmp, sigma = sigmaTmp, algorithm = algorithm, 
    nGHK = nGHK, random.seed = randomSeed, ...)
 --- call from argument --- 
if (class(L) == "try-error") {
    warning("the correlation matrix is not positive definite")
    return(NA)
}
 --- R stacktrace ---
where 1: pmvnormWrap(upper = xBetaTmp, sigma = sigmaTmp, algorithm = algorithm, 
    nGHK = nGHK, random.seed = randomSeed, ...)
where 2: mvProbitLogLikInternal(yMat = yMat, xMat = xMat, coef = param, 
    sigma = NULL, algorithm = llAlgorithm, nGHK = llNGHK, returnGrad = llIntGrad, 
    oneSidedGrad = llOneSidedGrad, eps = llEps, randomSeed = llRandom.seed, 
    ...)
where 3: fnOrig(theta, ...)
where 4: fn(start1, fixed = fixed, sumObs = TRUE, returnHessian = returnHessian, 
    ...)
where 5: maxNRCompute(fn = function (theta, fnOrig, gradOrig = NULL, hessOrig = NULL, 
    fixed, sumObs = FALSE, returnHessian = TRUE, ...) 
{
    nParam <- length(theta)
    f <- fnOrig(theta, ...)
    if (any(is.na(f))) {
        attr(f, "gradient") <- NA
        attr(f, "hessian") <- NA
        return(f)
    }
    gr <- attr(f, "gradient")
    if (is.null(gr)) {
        if (!is.null(gradOrig)) {
            gr <- gradOrig(theta, ...)
        }
        else {
            gr <- numericGradient(f = fnOrig, t0 = theta, fixed = fixed, 
                ...)
        }
    }
    if (is.matrix(gr)) {
        if (ncol(gr) != length(theta)) {
            stop(paste0("if gradient is a matrix, it must have length(parameter) colums (currently ", 
                length(theta), "), not ", ncol(gr)))
        }
        activeGr <- gr[, !fixed]
    }
    else {
        activeGr <- gr[!fixed]
    }
    if (any(is.na(activeGr))) {
        attr(f, "gradient") <- gr
        attr(f, "hessian") <- NA
        return(f)
    }
    if (observationGradient(gr, length(theta))) {
        gr <- as.matrix(gr)
    }
    if (is.null(dim(gr))) {
        gr[fixed] <- NA
    }
    else {
        gr[, fixed] <- NA
    }
    if (isTRUE(returnHessian)) {
        h <- attr(f, "hessian")
        if (is.null(h)) {
            if (!is.null(hessOrig)) {
                h <- as.matrix(hessOrig(theta, ...))
            }
            else {
                llFunc <- function(theta, ...) {
                  return(sum(fnOrig(theta, ...)))
                }
                if (!is.null(attr(f, "gradient"))) {
                  gradFunc <- function(theta, ...) {
                    return(sumGradients(attr(fnOrig(theta, ...), 
                      "gradient"), nParam))
                  }
                }
                else if (!is.null(gradOrig)) {
                  gradFunc <- function(theta, ...) {
                    return(sumGradients(gradOrig(theta, ...), 
                      nParam))
                  }
                }
                else {
                  gradFunc <- NULL
                }
                h <- numericHessian(f = llFunc, grad = gradFunc, 
                  t0 = theta, fixed = fixed, ...)
            }
        }
        if ((dim(h)[1] != nParam) | (dim(h)[2] != nParam)) {
            stop("Wrong hessian dimension.  Needed ", nParam, 
                "x", nParam, " but supplied ", dim(h)[1], "x", 
                dim(h)[2])
        }
        else {
            h[fixed, ] <- NA
            h[, fixed] <- NA
        }
    }
    else if (tolower(returnHessian) == "bhhh") {
        h <- NULL
        if (is.null(dim(gr)) & any(is.na(gr[!fixed]))) {
            h <- NA
        }
        else if (is.matrix(gr)) {
            if (any(is.na(gr[, !fixed]))) {
                h <- NA
            }
        }
        if (is.null(h)) {
            checkBhhhGrad(g = gr, theta = theta, analytic = (!is.null(attr(f, 
                "gradient")) || !is.null(gradOrig)), fixed = fixed)
            h <- -crossprod(gr)
        }
        attr(h, "type") = "BHHH"
    }
    else {
        h <- NULL
    }
    if (sumObs) {
        f <- sumKeepAttr(f)
    }
    if (sumObs) {
        gr <- sumGradients(gr, nParam)
    }
    if (!is.null(gradOrig) && !is.null(attr(f, "gradient"))) {
        attr(f, "gradBoth") <- TRUE
    }
    if (!is.null(hessOrig) && !is.null(attr(f, "hessian"))) {
        attr(f, "hessBoth") <- TRUE
    }
    attr(f, "gradient") <- gr
    attr(f, "hessian") <- h
    return(f)
}, fnOrig = function (param, yMat, xMat, llAlgorithm, llNGHK, 
    llIntGrad, llOneSidedGrad, llEps, llRandom.seed, ...) 
{
    logLikVal <- mvProbitLogLikInternal(yMat = yMat, xMat = xMat, 
        coef = param, sigma = NULL, algorithm = llAlgorithm, 
        nGHK = llNGHK, returnGrad = llIntGrad, oneSidedGrad = llOneSidedGrad, 
        eps = llEps, randomSeed = llRandom.seed, ...)
    return(logLikVal)
}, start = c(b_1_0 = 0.598378200054935, b_1_1 = 6.336646267785, 
b_1_2 = -1.01231147815159, b_2_0 = -1.03564793824529, b_2_1 = 1.26302210717712, 
b_2_2 = -1.70638777681512, b_3_0 = 0.410893287564513, b_3_1 = -0.373151392833251, 
b_3_2 = 2.92074017047352, R_1_2 = 0.172617843070694, R_1_3 = -0.0160393443285098, 
R_2_3 = -0.0704265674853818), finalHessian = "BHHH", bhhhHessian = TRUE, 
    fixed = c(b_1_0 = FALSE, b_1_1 = FALSE, b_1_2 = FALSE, b_2_0 = FALSE, 
    b_2_1 = FALSE, b_2_2 = FALSE, b_3_0 = FALSE, b_3_1 = FALSE, 
    b_3_2 = FALSE, R_1_2 = FALSE, R_1_3 = FALSE, R_2_3 = FALSE
    ), control = new("MaxControl", tol = 1e-08, reltol = 1.49011611938477e-08, 
        gradtol = 1e-06, steptol = 1e-10, lambdatol = 1e-06, 
        qrtol = 1e-10, qac = "stephalving", marquardt_lambda0 = 0.01, 
        marquardt_lambdaStep = 2, marquardt_maxLambda = 1e+12, 
        nm_alpha = 1, nm_beta = 0.5, nm_gamma = 2, sann_cand = NULL, 
        sann_temp = 10, sann_tmax = 10L, sann_randomSeed = 123L, 
        iterlim = 1L, printLevel = 0L), yMat = c(0, 1, 1, 1, 
    1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 0, 1, 1, 1, 
    1, 1, 0, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1, 0, 0, 1, 
    1, 1, 1, 1, 0, 0, 1, 1, 0, 0, 0, 0, 1, 0, 1, 0, 0, 0, 1, 
    0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 1, 0, 1, 1, 0, 1, 1, 0, 1, 
    1, 0, 0, 1, 1, 0, 0, 0, 1, 0, 0, 0, 0, 1, 0, 1, 0, 0, 1, 
    1, 1, 1, 0, 1, 0, 1, 0, 1, 1, 1, 1, 1, 1, 0, 0, 1, 1, 0, 
    1, 1, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, 1, 1, 0, 1, 0, 0, 1, 
    1, 0, 1, 1, 1, 1, 0, 1, 0, 1, 1, 0, 0), xMat = c(1, 1, 1, 
    1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 
    1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 
    1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0, 1, 1, 1, 1, 1, 0, 0, 0, 
    1, 1, 1, 1, 0, 1, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 
    1, 1, 0, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 
    1, 0, 0.253318513994755, -0.028546755348703, -0.0428704572913161, 
    1.36860228401446, -0.225770985659268, 1.51647060442954, -1.54875280423022, 
    0.584613749636069, 0.123854243844614, 0.215941568743973, 
    0.379639482759882, -0.502323453109302, -0.33320738366942, 
    -1.01857538310709, -1.07179122647558, 0.303528641404258, 
    0.448209778629426, 0.0530042267305041, 0.922267467879738, 
    2.05008468562714, -0.491031166056535, -2.30916887564081, 
    1.00573852446226, -0.709200762582393, -0.688008616467358, 
    1.0255713696967, -0.284773007051009, -1.22071771225454, 0.18130347974915, 
    -0.138891362439045, 0.00576418589988693, 0.38528040112633, 
    -0.370660031792409, 0.644376548518833, -0.220486561818751, 
    0.331781963915697, 1.09683901314935, 0.435181490833803, -0.325931585531227, 
    1.14880761845109, 0.993503855962119, 0.54839695950807, 0.238731735111441, 
    -0.627906076039371, 1.36065244853001, -0.600259587147127, 
    2.18733299301658, 1.53261062618519, -0.235700359100477, -1.02642090030678
    ), llAlgorithm = "GHK", llNGHK = 50, llIntGrad = TRUE, llOneSidedGrad = FALSE, 
    llEps = 1e-06, llRandom.seed = 123)
where 6: eval(as.call(cl))
where 7: eval(as.call(cl))
where 8: maxNR(fn = fn, grad = grad, hess = hess, start = start, finalHessian = finalHessian, 
    bhhhHessian = TRUE, ...)
where 9: maxRoutine(fn = logLik, grad = grad, hess = hess, start = start, 
    constraints = constraints, ...)
where 10: maxLik(logLik = logLik, start = start, method = method, finalHessian = finalHessian, 
    yMat = yMat, xMat = xMat, llAlgorithm = algorithm, llNGHK = nGHK, 
    llIntGrad = intGrad, llOneSidedGrad = oneSidedGrad, llEps = eps, 
    llRandom.seed = random.seed, ...)
where 11: mvProbit(cbind(y1, y2, y3) ~ x1 + x2, data = as.data.frame(cbind(xMat, 
    yMat)), iterlim = 1, nGHK = 50)

 --- value of length: 2 type: logical ---
[1] FALSE FALSE
 --- function from context --- 
function (lower = -Inf, upper = Inf, sigma, algorithm, random.seed, 
    nGHK = NULL, ...) 
{
    if (!is.matrix(sigma)) {
        stop("argument 'sigma' must be a matrix")
    }
    else if (nrow(sigma) != ncol(sigma)) {
        stop("argument 'sigma' must be a square matrix")
    }
    else if (!all(is.numeric(sigma))) {
        stop("argument 'sigma must be a numeric matrix")
    }
    if (!all(is.numeric(lower))) {
        stop("argument 'lower' must be numeric")
    }
    else if (length(lower) == 1) {
        lower <- rep(lower, nrow(sigma))
    }
    else if (length(lower) != nrow(sigma)) {
        stop("argument 'lower' must either be a single numeric value", 
            " or a vector with length equal to the number of rows/columns", 
            " of argument 'sigma'")
    }
    if (!all(is.numeric(upper))) {
        stop("argument 'upper' must be numeric")
    }
    else if (length(upper) == 1) {
        upper <- rep(upper, nrow(sigma))
    }
    else if (length(upper) != nrow(sigma)) {
        stop("argument 'upper' must either be a single numeric value", 
            " or a vector with length equal to the number of rows/columns", 
            " of argument 'sigma'")
    }
    algOkay <- TRUE
    ghk <- FALSE
    if (!is.list(algorithm) && length(algorithm) != 1) {
        stop("argument 'algorithm' must be a single function", 
            " or a single character string")
    }
    else if (is.function(algorithm)) {
        algResult <- do.call(algorithm, list())
        if (!class(algResult)[1] %in% c("GenzBretz", "Miwa", 
            "TVPACK")) {
            algOkay <- FALSE
        }
    }
    else if (is.character(algorithm)) {
        if (tolower(algorithm) == "ghk") {
            ghk <- TRUE
        }
        else if (!algorithm %in% c("GenzBretz", "Miwa", "TVPACK")) {
            algOkay <- FALSE
        }
    }
    else if (!class(algorithm) %in% c("GenzBretz", "Miwa", "TVPACK")) {
        algOkay <- FALSE
    }
    if (!algOkay) {
        stop("argument 'algorithm' must be either one of the functions", 
            " 'GenzBretz()', 'Miwa()', or 'TVPACK()'", " or one of the character strings", 
            " \"GenzBretz\", \"Miwa\", or \"TVPACK\"")
    }
    if (length(random.seed) != 1) {
        stop("argument 'random.seed' must be a single numerical value")
    }
    else if (!is.numeric(random.seed)) {
        stop("argument 'random.seed' must be numerical")
    }
    if (exists(".Random.seed")) {
        savedSeed <- .Random.seed
    }
    set.seed(random.seed)
    if (exists("savedSeed")) {
        on.exit(assign(".Random.seed", savedSeed, envir = sys.frame()))
    }
    else {
        on.exit(rm(.Random.seed, envir = sys.frame()))
    }
    if (ghk) {
        if (is.null(nGHK)) {
            stop("if the GHK algorithm is used,", " argument 'nGHK' must be specified")
        }
        else if (length(nGHK) != 1) {
            stop("argument 'nGHK' must be a single integer value")
        }
        else if (!is.numeric(nGHK)) {
            stop("argument 'nGHK' must be numeric")
        }
        else if (nGHK <= 0) {
            stop("argument 'nGHK' must be positive")
        }
        L <- try(t(chol(sigma)), silent = TRUE)
        if (class(L) == "try-error") {
            warning("the correlation matrix is not positive definite")
            return(NA)
        }
        trunpt <- rep(NA, length(lower))
        above <- rep(NA, length(lower))
        for (i in 1:length(lower)) {
            if (lower[i] == -Inf) {
                trunpt[i] <- upper[i]
                above[i] <- 1
            }
            else if (upper[i] == Inf) {
                trunpt[i] <- lower[i]
                above[i] <- 0
            }
            else {
                stop("if algorithm 'GHK' is used,", " either the lower truncation point must be '-Inf'", 
                  " or the upper truncation point must be 'Inf'")
            }
        }
        sink(tempfile())
        on.exit(sink(), add = TRUE)
        result <- ghkvec(L = L, trunpt = trunpt, above = above, 
            r = nGHK)
        result <- drop(result)
    }
    else {
        result <- pmvnorm(lower = lower, upper = upper, sigma = sigma, 
            algorithm = algorithm, ...)
    }
    return(result)
}
<bytecode: 0x20a7430>
<environment: namespace:mvProbit>
 --- function search by body ---
Function pmvnormWrap in namespace mvProbit has this body.
 ----------- END OF FAILURE REPORT -------------- 
Error in if (class(L) == "try-error") { : the condition has length > 1
Calls: mvProbit ... fn -> fnOrig -> mvProbitLogLikInternal -> pmvnormWrap
Execution halted