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

> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: cglm
> ### Title: Estimates the ratio of the regression coefficients and the
> ###   dispersion parameter in conditional generalized linear models for
> ###   clustered data.
> ### Aliases: cglm
> 
> ### ** Examples
> 
> 
> data(teenpov)
> 
> fit.ide <- cglm(method="ts", formula=hours~nonpov+inschool+spouse+age+mother, 
+   data=teenpov, id="ID", link="identity")
> summary(fit.ide)

Call:  
cglm(method = "ts", formula = hours ~ nonpov + inschool + spouse + 
    age + mother, data = teenpov, id = "ID", link = "identity")

Coefficients: 
          Estimate Std. Error z value Pr(>|z|)    
nonpov    0.050888   0.010115   5.031 4.88e-07 ***
inschool -0.070630   0.015834  -4.461 8.18e-06 ***
spouse   -0.035060   0.037408  -0.937 0.348641    
age       0.006511   0.003512   1.854 0.063715 .  
mother   -0.056710   0.015293  -3.708 0.000209 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

> 
> fit.log <- cglm(method="ts", formula=hours~nonpov+inschool+spouse+age+mother, 
+   data=teenpov, id="ID", link="log")
> summary(fit.log)

Call:  
cglm(method = "ts", formula = hours ~ nonpov + inschool + spouse + 
    age + mother, data = teenpov, id = "ID", link = "log")

Coefficients: 
          Estimate Std. Error z value Pr(>|z|)   
nonpov    0.019020   0.010531   1.806  0.07091 . 
inschool -0.039352   0.013810  -2.850  0.00438 **
spouse   -0.027948   0.039615  -0.705  0.48051   
age       0.016113   0.006397   2.519  0.01177 * 
mother   -0.056161   0.027556  -2.038  0.04154 * 
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

> 
> fit.cglm <- cglm(method="cml", formula=hours~nonpov+inschool+spouse+age+mother,
+   data=teenpov, id="ID")
 ----------- FAILURE REPORT -------------- 
 --- failure: the condition has length > 1 ---
 --- srcref --- 
: 
 --- package (from environment) --- 
cglm
 --- call from context --- 
cglm(method = "cml", formula = hours ~ nonpov + inschool + spouse + 
    age + mother, data = teenpov, id = "ID")
 --- call from argument --- 
if (class(var) == "try-error") {
    var <- matrix(nrow = nbeta, ncol = nbeta)
    convergence <- FALSE
}
 --- R stacktrace ---
where 1: cglm(method = "cml", formula = hours ~ nonpov + inschool + spouse + 
    age + mother, data = teenpov, id = "ID")

 --- value of length: 2 type: logical ---
[1] FALSE FALSE
 --- function from context --- 
function (method, formula, data, id, link, ...) 
{
    dots <- list(...)
    data <- data[order(data[, id]), ]
    id <- data[, id]
    X <- model.matrix(object = formula, data = data)[, -1, drop = FALSE]
    y <- data[, as.character(formula)[2]]
    ni <- as.vector(tapply(X = id, INDEX = id, FUN = length))
    n <- length(unique(id))
    nbeta <- ncol(X)
    if (method == "cml") {
        nidcumsum <- c(0, cumsum(ni))
        args <- list(par = rep(0, ncol(X)), fn = llfun, y = y, 
            design = X, nidcumsum = nidcumsum, hessian = TRUE)
        args[names(dots)] <- dots
        if (is.na(match("control", names(args)))) 
            args$control <- list(maxit = 1000)
        fit <- do.call("optim", args = args)
        convergence <- fit$convergence == 0
        coefficients <- fit$par
        var <- try(solve(fit$hessian))
        if (class(var) == "try-error") {
            var <- matrix(nrow = nbeta, ncol = nbeta)
            convergence <- FALSE
        }
        coeff.names <- attr(terms(formula), "term.labels")
        names(coefficients) <- coeff.names
        colnames(var) <- coeff.names
        rownames(var) <- coeff.names
    }
    if (method == "ts") {
        X.mean <- aggr(x = X, clusters = id)/ni
        X.mean <- X.mean[rep(1:n, ni), ]
        X.cent <- X - X.mean
        resfun <- function(betastar) {
            pred <- as.vector(X %*% matrix(betastar))
            if (link == "identity") 
                res <- y - pred
            if (link == "log") 
                res <- y * exp(-pred)
            return(res)
        }
        Ubetastarfun <- function(betastar) {
            res <- resfun(betastar)
            U <- aggr(x = X.cent * res, clusters = id)
            return(U)
        }
        Ubetastarfunsums <- function(betastar) {
            return(colSums(Ubetastarfun(betastar)))
        }
        if (link == "identity") {
            betastar <- as.vector(solve(t(X.cent) %*% X.cent) %*% 
                (t(X.cent) %*% matrix(y)))
            convergence <- TRUE
        }
        if (link == "log") {
            args <- list(x = rep(0, nbeta), fn = Ubetastarfunsums)
            args[names(dots)] <- dots
            if (is.na(match("control", names(args)))) 
                args$control <- list(maxit = 100)
            fit <- do.call("nleqslv", args = args)
            betastar <- fit$x
            convergence <- fit$termcd == 1
        }
        res <- resfun(betastar)
        pred <- as.vector(X %*% matrix(betastar))
        if (link == "identity") {
            b <- rep(as.vector(aggr(x = res, clusters = id))/ni, 
                ni)
            m <- b + pred
            App <- 1
            Bi <- ni > 1
        }
        if (link == "log") {
            b <- log(rep(as.vector(aggr(x = res, clusters = id))/ni, 
                ni))
            m <- exp(b + pred)
            App <- m
            all.zeros <- tapply(abs(y), id, FUN = sum) == 0
            Bi <- ni > 1 & !all.zeros
        }
        eps <- y - m
        phiij <- eps^2/App
        phii <- tapply(phiij, id, FUN = mean)
        phii <- phii * ni/(ni - 1)
        phii[!Bi] <- 0
        phi <- mean(phii[Bi])
        beta <- betastar/phi
        names(beta) <- colnames(X)
        coefficients <- beta
        Ubetastar <- Ubetastarfun(betastar)
        Uphi <- Bi * (phii - phi)
        Ubeta <- matrix(rep(betastar/phi - beta, each = n), nrow = n, 
            ncol = nbeta)
        U <- cbind(Ubetastar, Uphi, Ubeta)
        J <- var(U)
        if (link == "identity") 
            dUbetastar.dbetastar <- -t(X.cent) %*% X/n
        if (link == "log") 
            dUbetastar.dbetastar <- -t(X.cent) %*% (X * res)/n
        dUbetastar.dphi <- 0
        dUbetastar.dbeta <- matrix(0, nrow = nbeta, ncol = nbeta)
        dUbetastar <- cbind(dUbetastar.dbetastar, dUbetastar.dphi, 
            dUbetastar.dbeta)
        if (link == "identity") {
            dm.dbetastar <- X.cent
            dUphi.dbetastar <- -2 * eps * dm.dbetastar
        }
        if (link == "log") {
            tmp1 <- X * res
            tmp1 <- aggr(x = tmp1, clusters = id)/ni
            tmp1 <- tmp1[rep(1:n, ni), ]
            res <- rep(as.vector(aggr(x = res, clusters = id))/ni, 
                ni)
            res <- res[rep(1:n, ni)]
            tmp2 <- X * res
            dm.dbetastar <- exp(pred) * (tmp2 - tmp1)
            dUphi.dbetastar <- -dm.dbetastar * eps/m * (1 + eps/m)
        }
        dUphi.dbetastar <- aggr(x = dUphi.dbetastar, clusters = id)/(ni - 
            1)
        dUphi.dbetastar[!Bi, ] <- 0
        dUphi.dbetastar <- colMeans(dUphi.dbetastar)
        dUphi.dphi <- -mean(Bi)
        dUphi.dbeta <- rep(0, nbeta)
        dUphi <- c(dUphi.dbetastar, dUphi.dphi, dUphi.dbeta)
        dUbeta.dbetastar <- diag(1/phi, nbeta)
        dUbeta.dphi <- -betastar/phi^2
        dUbeta.dbeta <- -diag(nbeta)
        dUbeta <- cbind(dUbeta.dbetastar, dUbeta.dphi, dUbeta.dbeta)
        I <- rbind(dUbetastar, dUphi, dUbeta)
        var <- solve(I) %*% J %*% t(solve(I))/n
        var <- var[(nbeta + 2):(2 * nbeta + 1), (nbeta + 2):(2 * 
            nbeta + 1), drop = FALSE]
        rownames(var) <- colnames(X)
        colnames(var) <- colnames(X)
    }
    out <- list(call = match.call(), coefficients = coefficients, 
        var = var, convergence = convergence)
    class(out) <- "cglm"
    return(out)
}
<bytecode: 0x562e72954a88>
<environment: namespace:cglm>
 --- function search by body ---
Function cglm in namespace cglm has this body.
 ----------- END OF FAILURE REPORT -------------- 
Fatal error: the condition has length > 1