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

> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: HL_test
> ### Title: Hosmer-Lemeshow Goodness of Fit Test
> ### Aliases: HL_test
> 
> ### ** Examples
> 
> require(lbreg)
> 
> # data preparation
> data(PCS)
> w <- PCS
> w <- w[,-1]
> w$race <- factor(w$race)
> w$dpros <- factor(w$dpros)
> w$dcaps <- factor(w$dcaps)
> 
> fm <- lbreg(tumor ~ ., data=w)
 ----------- FAILURE REPORT -------------- 
 --- failure: the condition has length > 1 ---
 --- srcref --- 
: 
 --- package (from environment) --- 
lbreg
 --- call from context --- 
lbreg.fit(x = as.matrix(x), y = y, start.beta = b0, tol = tol)
 --- call from argument --- 
if (class(meat) != "try-error") {
    new.vcov <- W %*% meat %*% t(W)
    out$vcov <- new.vcov
} else {
    warning("could not invert (W'JW) --- reported 'vcov' is ignoring active constraints")
}
 --- R stacktrace ---
where 1: lbreg.fit(x = as.matrix(x), y = y, start.beta = b0, tol = tol)
where 2: lbreg.default(x = model.matrix(terms, mf), y = model.response(mf), 
    ...)
where 3: lbreg.formula(tumor ~ ., data = w)
where 4: lbreg(tumor ~ ., data = w)

 --- value of length: 2 type: logical ---
[1] TRUE TRUE
 --- function from context --- 
function (x, y, start.beta, tol, ...) 
{
    X <- x
    out <- constrOptim(theta = start.beta, f = negll, grad = gr, 
        method = "BFGS", hessian = TRUE, ui = -X, ci = rep(0, 
            nrow(X)), x = X, y = y, control = list(maxit = 200))
    beta <- out$par
    J <- -hess(beta = beta, x = X, y = y)
    vcov0 <- MASS::ginv(J)
    colnames(vcov0) <- rownames(vcov0) <- names(beta) <- colnames(X)
    yhat <- as.vector(exp(X %*% beta))
    a <- yhat >= tol
    A <- active <- NULL
    if (any(a)) {
        Afull = X[a, ]
        A = Afull
        if (sum(a) == 1) {
            r = 1
            p = ncol(X)
            dim(A) = c(r, p)
        }
        else {
            A = unique(A)
            r = nrow(A)
            p = ncol(X)
            dim(A) = c(r, p)
        }
        Wtil = diag(p) - projx(t(A))
        W = Wtil[1:p, 1:(p - r)]
        if (max(A %*% W) > sqrt(1e-06)) {
            warning("max AW is > 1e-6")
        }
        meat = try(MASS::ginv(t(W) %*% J %*% W))
        if (class(meat) != "try-error") {
            new.vcov <- W %*% meat %*% t(W)
            out$vcov <- new.vcov
        }
        else {
            warning("could not invert (W'JW) --- reported 'vcov' is ignoring active constraints")
        }
        active <- Afull
        if (any(a)) {
            dim(active) <- dim(A)
        }
        rownames(active) <- (1:nrow(X))[a]
        colnames(active) <- colnames(X)
    }
    else {
        out$vcov <- vcov0
    }
    SE <- sqrt(diag(out$vcov))
    names(SE) <- names(beta)
    rownames(out$vcov) <- colnames(out$vcov) <- names(beta)
    y1 <- y[, 1]
    if (ncol(y) == 1) {
        n <- 1
        i <- y1 == 0
        j <- y1 == 1
        Y <- y1
        d <- y1 * log(Y/yhat) + (1 - Y) * log((1 - Y)/(1 - yhat))
        di <- -log(1 - yhat[i])
        dj <- -log(yhat[j])
        d[i] <- di
        d[j] <- dj
    }
    if (ncol(y) == 2) {
        n <- rowSums(y)
        i <- y1 == 0
        j <- y1 == n
        Y <- y1/n
        d <- y1 * log(y1/(n * yhat)) + (n - y1) * log((1 - Y)/(1 - 
            yhat))
        di <- -n[i] * log(1 - yhat[i])
        dj <- -n[j] * log(yhat[j])
        d[i] <- di
        d[j] <- dj
    }
    vu <- yhat * (1 - yhat)/n
    pear.res <- (Y - yhat)/sqrt(vu)
    Xp <- sum(pear.res^2)
    w <- diag(n * yhat/(1 - yhat))
    inv <- MASS::ginv(t(X) %*% w %*% X)
    H <- w %*% X %*% inv %*% t(X)
    lev <- diag(H)
    cook <- lev * (pear.res/(1 - lev))^2/ncol(X)
    fit <- list(coefficients = beta, se = SE, vcov = out$vcov, 
        vcov0 = vcov0, fitted.values = yhat, df = nrow(X) - ncol(X), 
        loglik = -out$value, deviance = 2 * sum(d), dev.resid = sign(Y - 
            yhat) * sqrt(2 * d), residuals = pear.res, X2 = Xp, 
        hat.matrix = H, cook.distance = cook, convergence = out$convergence, 
        barrier.value = out$barrier.value, outer.iterations = out$outer.iterations, 
        Active = active, formula = formula, tol = tol, start.beta = start.beta)
    class(fit) <- "lbreg"
    return(fit)
}
<bytecode: 0x3d44c90>
<environment: namespace:lbreg>
 --- function search by body ---
Function lbreg.fit in namespace lbreg has this body.
 ----------- END OF FAILURE REPORT -------------- 
Error in if (class(meat) != "try-error") { : the condition has length > 1
Calls: lbreg -> lbreg.formula -> lbreg.default -> lbreg.fit
Execution halted