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

> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: dfa_xerrors
> ### Title: Discriminant Function Approach for Estimating Odds Ratio with
> ###   Normal Exposure Subject to Measurement Error
> ### Aliases: dfa_xerrors
> 
> ### ** Examples
> 
> # Load datasets - dat1 has (Y, C) values and dat1_xtilde is list with 1 or 2
> # Xtilde measurements for each subject. Xtilde values are affected by
> # measurement error.
> data(dat1)
> data(dat1_xtilde)
> 
> # Estimate log-OR for X and Y adjusted for C, ignoring measurement error
> fit1 <- dfa_xerrors(y = dat1$y, xtilde = dat1_xtilde, c = dat1$c, merror = FALSE)
 ----------- FAILURE REPORT -------------- 
 --- failure: the condition has length > 1 ---
 --- srcref --- 
: 
 --- package (from environment) --- 
pooling
 --- call from context --- 
dfa_xerrors(y = dat1$y, xtilde = dat1_xtilde, c = dat1$c, merror = FALSE)
 --- call from argument --- 
if (class(theta.variance) == "try-error") {
    message("Estimated Hessian matrix is singular, so variance-covariance matrix cannot be obtained and bias adjustment cannot be applied.")
    theta.variance <- NULL
    logOR.var <- logOR.var <- logOR_adj.hat <- logOR_adj.var <- NA
} else {
    fprime <- matrix(c(1/sigsq.hat, -gamma_y.hat/sigsq.hat^2), 
        nrow = 1)
    colnames(theta.variance) <- rownames(theta.variance) <- theta.labels
    logOR.var <- fprime %*% theta.variance[c(2, loc.sigsq), c(2, 
        loc.sigsq)] %*% t(fprime)
    sigsq.var <- theta.variance[loc.sigsq, loc.sigsq]
    logOR_adj.hat <- logOR.hat - gamma_y.hat * sigsq.var/sigsq.hat^3
    logOR_adj.var <- logOR.var * (logOR_adj.hat/logOR.hat)^2
    if (sign(logOR.hat) != sign(logOR_adj.hat)) {
        message("Bias adjustment flipped the sign of the log-OR estimate, so you may want to use the non-bias adjusted version.")
    }
}
 --- R stacktrace ---
where 1: dfa_xerrors(y = dat1$y, xtilde = dat1_xtilde, c = dat1$c, merror = FALSE)

 --- value of length: 2 type: logical ---
[1] FALSE FALSE
 --- function from context --- 
function (y, xtilde, c = NULL, merror = TRUE, ...) 
{
    y.varname <- deparse(substitute(y))
    if (length(grep("$", y.varname, fixed = TRUE)) > 0) {
        y.varname <- substr(y.varname, start = which(unlist(strsplit(y.varname, 
            "")) == "$") + 1, stop = nchar(y.varname))
    }
    if (is.null(c)) {
        c.varnames <- NULL
        n.cvars <- 0
    }
    else {
        c.varname <- deparse(substitute(c))
        if (class(c) != "matrix") {
            c <- as.matrix(c)
        }
        n.cvars <- ncol(c)
        c.varnames <- colnames(c)
        if (is.null(c.varnames)) {
            if (n.cvars == 1) {
                if (length(grep("$", c.varname, fixed = TRUE)) > 
                  0) {
                  c.varname <- substr(c.varname, start = which(unlist(strsplit(c.varname, 
                    "")) == "$") + 1, stop = nchar(c.varname))
                }
                c.varnames <- c.varname
            }
            else {
                c.varnames <- paste("c", 1:n.cvars, sep = "")
            }
        }
    }
    n.gammas <- 2 + n.cvars
    n <- length(y)
    oneyc <- cbind(rep(1, n), y, c)
    if (!merror & class(xtilde) == "list") {
        xtilde <- sapply(xtilde, function(x) x[1])
    }
    class.xtilde <- class(xtilde)
    if (class.xtilde == "list") {
        k <- sapply(xtilde, length)
        which.r <- which(k > 1)
        n.r <- length(which.r)
        some.r <- n.r > 0
        if (some.r) {
            k.r <- k[which.r]
            y.r <- y[which.r]
            oneyc.r <- oneyc[which.r, , drop = FALSE]
            xtilde.r <- xtilde[which.r]
        }
        n <- n - n.r
        some.s <- n > 0
        if (some.s) {
            y <- y[-which.r]
            oneyc <- oneyc[-which.r, , drop = FALSE]
            xtilde <- unlist(xtilde[-which.r])
        }
    }
    else {
        some.r <- FALSE
        some.s <- TRUE
    }
    loc.gammas <- 1:n.gammas
    gamma.labels <- paste("gamma", c("0", y.varname, c.varnames), 
        sep = "_")
    loc.sigsq <- n.gammas + 1
    loc.sigsq_m <- n.gammas + 2
    theta.labels <- c(gamma.labels, "sigsq")
    if (merror) {
        theta.labels <- c(theta.labels, "sigsq_m")
    }
    ll.f <- function(f.theta) {
        f.gammas <- matrix(f.theta[loc.gammas], ncol = 1)
        f.sigsq <- f.theta[loc.sigsq]
        if (merror) {
            f.sigsq_m <- f.theta[loc.sigsq_m]
            if (some.r) {
                ll.vals <- c()
                for (ii in 1:length(xtilde.r)) {
                  k_i <- k.r[ii]
                  oneyc_i <- oneyc.r[ii, ]
                  xtilde_i <- xtilde.r[[ii]]
                  Mu_xtilde.yc <- matrix(oneyc_i %*% f.gammas, 
                    ncol = k_i)
                  Sigma_xtilde.yc <- f.sigsq + diag(x = f.sigsq_m, 
                    ncol = k_i, nrow = k_i)
                  ll.vals[ii] <- dmvnorm(x = xtilde_i, log = TRUE, 
                    mean = Mu_xtilde.yc, sigma = Sigma_xtilde.yc)
                }
                ll.r <- sum(ll.vals)
            }
            else {
                ll.r <- 0
            }
            if (some.s) {
                mu_xtilde.yc <- oneyc %*% f.gammas
                ll.s <- sum(dnorm(x = xtilde, log = TRUE, mean = mu_xtilde.yc, 
                  sd = sqrt(f.sigsq + f.sigsq_m)))
            }
            else {
                ll.s <- 0
            }
            ll <- ll.r + ll.s
        }
        else {
            mu_x.yc <- oneyc %*% f.gammas
            ll <- sum(dnorm(x = xtilde, log = TRUE, mean = mu_x.yc, 
                sd = sqrt(f.sigsq)))
        }
        return(-ll)
    }
    extra.args <- list(...)
    if (is.null(extra.args$start)) {
        if (!merror) {
            extra.args$start <- c(rep(0.01, n.gammas), 1)
        }
        else {
            extra.args$start <- c(rep(0.01, n.gammas), 1, 1)
        }
    }
    if (is.null(extra.args$lower)) {
        if (!merror) {
            extra.args$lower <- c(rep(-Inf, n.gammas), 0.001)
        }
        else {
            extra.args$lower <- c(rep(-Inf, n.gammas), rep(0.001, 
                2))
        }
    }
    if (is.null(extra.args$control$rel.tol)) {
        extra.args$control$rel.tol <- 1e-06
    }
    if (is.null(extra.args$control$eval.max)) {
        extra.args$control$eval.max <- 1000
    }
    if (is.null(extra.args$control$iter.max)) {
        extra.args$control$iter.max <- 750
    }
    ml.max <- do.call(nlminb, c(list(objective = ll.f), extra.args))
    ml.estimates <- ml.max$par
    gamma_y.hat <- ml.estimates[2]
    sigsq.hat <- ml.estimates[loc.sigsq]
    logOR.hat <- gamma_y.hat/sigsq.hat
    hessian.mat <- pracma::hessian(f = ll.f, x0 = ml.estimates)
    theta.variance <- try(solve(hessian.mat), silent = TRUE)
    if (class(theta.variance) == "try-error") {
        message("Estimated Hessian matrix is singular, so variance-covariance matrix cannot be obtained and bias adjustment cannot be applied.")
        theta.variance <- NULL
        logOR.var <- logOR.var <- logOR_adj.hat <- logOR_adj.var <- NA
    }
    else {
        fprime <- matrix(c(1/sigsq.hat, -gamma_y.hat/sigsq.hat^2), 
            nrow = 1)
        colnames(theta.variance) <- rownames(theta.variance) <- theta.labels
        logOR.var <- fprime %*% theta.variance[c(2, loc.sigsq), 
            c(2, loc.sigsq)] %*% t(fprime)
        sigsq.var <- theta.variance[loc.sigsq, loc.sigsq]
        logOR_adj.hat <- logOR.hat - gamma_y.hat * sigsq.var/sigsq.hat^3
        logOR_adj.var <- logOR.var * (logOR_adj.hat/logOR.hat)^2
        if (sign(logOR.hat) != sign(logOR_adj.hat)) {
            message("Bias adjustment flipped the sign of the log-OR estimate, so you may want to use the non-bias adjusted version.")
        }
    }
    estimates <- c(ml.estimates, logOR.hat, logOR.var, logOR_adj.hat, 
        logOR_adj.var)
    names(estimates) <- c(theta.labels, "logOR.hat", "logOR.var", 
        "logOR_adj.hat", "logOR_adj.var")
    ret.list <- list(estimates = estimates, theta.var = theta.variance, 
        nlminb.object = ml.max, aic = 2 * (length(ml.estimates) + 
            ml.max$objective))
    return(ret.list)
}
<bytecode: 0x8d2d9d8>
<environment: namespace:pooling>
 --- function search by body ---
Function dfa_xerrors in namespace pooling has this body.
 ----------- END OF FAILURE REPORT -------------- 
Error in if (class(theta.variance) == "try-error") { : 
  the condition has length > 1
Calls: dfa_xerrors
Execution halted