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

> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: countgmifs
> ### Title: Discrete Response Generalized Monotone Incremental Forward
> ###   Stagewise Regression.
> ### Aliases: countgmifs
> ### Keywords: methods regression
> 
> ### ** Examples
> 
> set.seed(26)
> n <- 50 # Sample size
> p <- 500 # Number of covariates
> intercept<- .5
> #True parameter values for the 500 covariates
> beta<- c(log(1.5), log(1.5), -log(1.5), -log(1.5), -log(1.5), rep(0,495)) 
> alpha<- 0.5 # Intercept
> x<- matrix(rnorm(n*p,0,1), nrow=n, ncol=p, byrow=TRUE) #Covariate values
> colnames(x)<- paste("Var",1:p, sep="")  
> mu<- exp(intercept + crossprod(t(x),beta))
> y<- rnbinom(n=n, size=1/alpha ,mu=mu) # Discrete response
> data<- data.frame(y,x)
> nb<-countgmifs(y ~ 1 , data=data, offset=NULL, x=x, epsilon=0.01, tol=0.001, 
+        scale=TRUE, verbose=FALSE)
 ----------- FAILURE REPORT -------------- 
 --- failure: the condition has length > 1 ---
 --- srcref --- 
: 
 --- package (from environment) --- 
countgmifs
 --- call from context --- 
countgmifs(y ~ 1, data = data, offset = NULL, x = x, epsilon = 0.01, 
    tol = 0.001, scale = TRUE, verbose = FALSE)
 --- call from argument --- 
if (class(x) == "character") {
    nl <- as.list(1:ncol(data))
    names(nl) <- names(data)
    vars <- eval(substitute(x), nl, parent.frame())
    x <- data[r, vars, drop = FALSE]
    x <- as.matrix(x)
} else if (class(x) == "matrix" || class(x) == "data.frame") {
    x <- x[r, , drop = FALSE]
    x <- as.matrix(x)
}
 --- R stacktrace ---
where 1: countgmifs(y ~ 1, data = data, offset = NULL, x = x, epsilon = 0.01, 
    tol = 0.001, scale = TRUE, verbose = FALSE)

 --- value of length: 2 type: logical ---
[1] FALSE FALSE
 --- function from context --- 
function (formula, data, x = NULL, offset, subset, epsilon = 0.001, 
    tol = 1e-05, scale = TRUE, verbose = FALSE, family = "nb", 
    ...) 
{
    mf <- match.call(expand.dots = FALSE)
    cl <- match.call()
    m <- match(c("formula", "data", "subset", "offset"), names(mf), 
        0L)
    mf <- mf[c(1L, m)]
    mf[[1L]] <- as.name("model.frame")
    mf <- eval(mf, parent.frame())
    mt <- attr(mf, "terms")
    y <- model.response(mf)
    w <- model.matrix(mt, mf)
    offset <- model.offset(mf)
    if (!is.null(x)) {
        if (missing(subset)) 
            r <- TRUE
        else {
            e <- substitute(subset)
            r <- eval(e, data)
            if (!is.logical(r)) 
                stop("'subset' must evaluate to logical")
            r <- r & !is.na(r)
        }
        if (class(x) == "character") {
            nl <- as.list(1:ncol(data))
            names(nl) <- names(data)
            vars <- eval(substitute(x), nl, parent.frame())
            x <- data[r, vars, drop = FALSE]
            x <- as.matrix(x)
        }
        else if (class(x) == "matrix" || class(x) == "data.frame") {
            x <- x[r, , drop = FALSE]
            x <- as.matrix(x)
        }
    }
    if (is.na(match(family, c("poisson", "nb")))) {
        stop("Error:")
        cat("Only poisson and nb are available for family.\n")
    }
    if (!is.null(offset)) {
        offset <- log(offset)
    }
    data <- data.matrix(data)
    n <- length(y)
    if (!is.null(x)) {
        vars <- dim(x)[2]
        oldx <- x
        if (scale) {
            x <- scale(x, center = TRUE, scale = TRUE)
        }
        x_original <- x
        x <- cbind(x, -1 * x)
        beta <- rep(0, dim(x)[2])
        names(beta) <- dimnames(x)[[2]]
        step <- 1
        Estimates <- matrix(0, ncol = vars)
        if (family == "nb") {
            if (!is.null(offset)) {
                initialize <- glm.nb(y ~ w - 1 + offset(offset), 
                  control = glm.control(maxit = 100))
            }
            else {
                initialize <- glm.nb(y ~ w - 1, control = glm.control(maxit = 100))
            }
            a <- 1/theta.mm(initialize)
            a.update <- a
        }
        else {
            if (!is.null(offset)) {
                initialize <- glm(y ~ w - 1, offset = offset, 
                  family = poisson)
            }
            else {
                initialize <- glm(y ~ w - 1, family = poisson)
            }
        }
        LL0 <- Likelihood <- logLik(initialize)
        AIC <- AIC(initialize)
        BIC <- BIC(initialize)
        theta <- coef(initialize)
        theta.update <- matrix(theta, ncol = length(theta))
        repeat {
            step <- 1 + step
            if (!is.null(offset)) {
                Xb <- cbind(offset, w, x) %*% c(1, theta, beta)
            }
            else {
                Xb <- cbind(w, x) %*% c(theta, beta)
            }
            if (family == "nb") {
                u <- t(x) %*% ((y - exp(Xb))/(1 + (a * exp(Xb))))
            }
            else {
                u <- t(x) %*% (y - exp(Xb))
            }
            update.j <- which.min(-u)
            if (-u[update.j] < 0) {
                beta[update.j] <- beta[update.j] + epsilon
            }
            Estimates <- rbind(Estimates, beta[1:vars] - beta[(vars + 
                1):length(beta)])
            if (family == "nb") {
                out <- optim(theta, nb.theta, a = a, w = w, x = x_original, 
                  y = y, offset = offset, beta = beta[1:vars] - 
                    beta[(vars + 1):length(beta)], method = "BFGS")
                theta <- out$par
                a <- hilbe(w = w, y = y, x = x_original, theta = theta, 
                  beta = beta[1:vars] - beta[(vars + 1):length(beta)], 
                  offset = offset, delta = 1e-05)
                a.update <- c(a.update, a)
                p <- sum(Estimates[step, ] != 0) + length(theta) + 
                  1
                Likelihood[step] <- LL1 <- -out$value
                AIC[step] <- 2 * p - 2 * Likelihood[step]
                BIC[step] <- p * log(n) - 2 * Likelihood[step]
            }
            else {
                out <- optim(theta, poisson.theta, w = w, x = x, 
                  y = y, offset = offset, beta = beta, method = "BFGS")
                theta <- out$par
                p <- sum(Estimates[step + 1, ] != 0) + length(theta)
                Likelihood[step] <- LL1 <- -out$value
                AIC[step] <- 2 * p - 2 * Likelihood[step]
                BIC[step] <- p * log(n) - 2 * Likelihood[step]
            }
            theta.update <- rbind(theta.update, theta)
            if (verbose) 
                cat("step = ", step, "\n")
            if (step >= 1 && ((abs(LL1 - LL0) < tol) || (p >= 
                n - 1))) {
                break
            }
            LL0 <- LL1
        }
        if (family == "nb") {
            output <- list(a = a.update, beta = Estimates, theta = theta.update, 
                x = oldx, y = y, scale = scale, logLik = Likelihood, 
                AIC = AIC, BIC = BIC, w = w, offset = offset, 
                family = family)
        }
        else {
            output <- list(beta = Estimates, theta = theta.update, 
                x = oldx, y = y, scale = scale, logLik = Likelihood, 
                AIC = AIC, BIC = BIC, w = w, offset = offset, 
                family = family)
        }
        class(output) <- "countgmifs"
    }
    else {
        if (family == "nb") {
            out <- glm.nb(y ~ w - 1, offset = offset)
            output <- list(coef(out), a = 1/out$theta)
        }
        else {
            output <- glm(y ~ w - 1, offset = offset, family = poisson)
        }
    }
    output
}
<bytecode: 0x55ed5f4eded0>
<environment: namespace:countgmifs>
 --- function search by body ---
Function countgmifs in namespace countgmifs has this body.
 ----------- END OF FAILURE REPORT -------------- 
Fatal error: the condition has length > 1