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

> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: daarem
> ### Title: Damped Anderson Acceleration with Restarts and
> ###   Epsilon-Montonicity for Accelerating Slowly-Convergent, Monotone
> ###   Fixed-Point Iterations
> ### Aliases: daarem
> ### Keywords: optimization EM algorithm
> 
> ### ** Examples
> 
> 
> n <- 2000
> npars <- 25
> true.beta <- .5*rt(npars, df=2) + 2
> XX <- matrix(rnorm(n*npars), nrow=n, ncol=npars)
> yy <- ProbitSimulate(true.beta, XX)
> max.iter <- 1000
> beta.init <- rep(0.0, npars)
> 
> # Estimating Probit model with DAAREM acceleration
> aa.probit <- daarem(par=beta.init, fixptfn = ProbitUpdate, objfn = ProbitLogLik,
+                     X=XX, y=yy, control=list(maxiter=max.iter))
 ----------- FAILURE REPORT -------------- 
 --- failure: the condition has length > 1 ---
 --- srcref --- 
: 
 --- package (from environment) --- 
daarem
 --- call from context --- 
daarem_base_objfn(par, fixptfn, objfn, maxiter, tol, mon.tol, 
    cycl.mon.tol, a1, kappa, num.params, nlag, ...)
 --- call from argument --- 
if (class(gamma_vec) != "try-error") {
    xbar <- xnew - drop(Xtmp %*% gamma_vec)
    fbar <- fnew - drop(Ftmp %*% gamma_vec)
    x.propose <- xbar + fbar
    new.objective.val <- try(objfn(x.propose, ...), silent = TRUE)
    obj.evals <- obj.evals + 1
    if (class(new.objective.val) != "try-error" & !is.na(obj_funvals[k + 
        1]) & !is.nan(new.objective.val)) {
        if (new.objective.val >= obj_funvals[k + 1] - mon.tol) {
            obj_funvals[k + 2] <- new.objective.val
            fold <- fnew
            xold <- xnew
            xnew <- x.propose
            shrink.count <- shrink.count + 1
        }
        else {
            fold <- fnew
            xold <- xnew
            xnew <- fold + xold
            obj_funvals[k + 2] <- objfn(xnew, ...)
            obj.evals <- obj.evals + 1
        }
    }
    else {
        fold <- fnew
        xold <- xnew
        xnew <- fold + xold
        obj_funvals[k + 2] <- objfn(xnew, ...)
        obj.evals <- obj.evals + 1
        count <- 0
    }
} else {
    fold <- fnew
    xold <- xnew
    xnew <- fold + xold
    obj_funvals[k + 2] <- objfn(xnew, ...)
    obj.evals <- obj.evals + 1
    count <- 0
}
 --- R stacktrace ---
where 1: daarem_base_objfn(par, fixptfn, objfn, maxiter, tol, mon.tol, 
    cycl.mon.tol, a1, kappa, num.params, nlag, ...)
where 2: daarem(par = beta.init, fixptfn = ProbitUpdate, objfn = ProbitLogLik, 
    X = XX, y = yy, control = list(maxiter = max.iter))

 --- value of length: 2 type: logical ---
[1] TRUE TRUE
 --- function from context --- 
function (par, fixptfn, objfn, maxiter, tol, mon.tol, cycl.mon.tol, 
    a1, kappa, num.params, nlag, ...) 
{
    Fdiff <- Xdiff <- matrix(0, nrow = num.params, ncol = nlag)
    obj_funvals <- rep(NA, maxiter + 2)
    xold <- par
    xnew <- fixptfn(xold, ...)
    obj_funvals[1] <- objfn(xold, ...)
    obj_funvals[2] <- objfn(xnew, ...)
    likchg <- obj_funvals[2] - obj_funvals[1]
    obj.evals <- 2
    fold <- xnew - xold
    k <- 1
    count <- 0
    shrink.count <- 0
    shrink.target <- 1/(1 + a1^kappa)
    lambda.ridge <- 1e+05
    r.penalty <- 0
    conv <- TRUE
    ell.star <- obj_funvals[2]
    while (k < maxiter) {
        count <- count + 1
        fnew <- fixptfn(xnew, ...) - xnew
        ss.resids <- sqrt(crossprod(fnew))
        if (ss.resids < tol & count == nlag) 
            break
        Fdiff[, count] <- fnew - fold
        Xdiff[, count] <- xnew - xold
        np <- count
        if (np == 1) {
            Ftmp <- matrix(Fdiff[, 1], nrow = num.params, ncol = np)
            Xtmp <- matrix(Xdiff[, 1], nrow = num.params, ncol = np)
        }
        else {
            Ftmp <- Fdiff[, 1:np]
            Xtmp <- Xdiff[, 1:np]
        }
        tmp <- La.svd(Ftmp)
        dvec <- tmp$d
        dvec.sq <- dvec * dvec
        uy <- crossprod(tmp$u, fnew)
        uy.sq <- uy * uy
        Ftf <- sqrt(sum(uy.sq * dvec.sq))
        tmp_lam <- DampingFind(uy.sq, dvec, a1, kappa, shrink.count, 
            Ftf, lambda.start = lambda.ridge, r.start = r.penalty)
        lambda.ridge <- tmp_lam$lambda
        r.penalty <- tmp_lam$rr
        dd <- (dvec * uy)/(dvec.sq + lambda.ridge)
        gamma_vec <- crossprod(tmp$vt, dd)
        if (class(gamma_vec) != "try-error") {
            xbar <- xnew - drop(Xtmp %*% gamma_vec)
            fbar <- fnew - drop(Ftmp %*% gamma_vec)
            x.propose <- xbar + fbar
            new.objective.val <- try(objfn(x.propose, ...), silent = TRUE)
            obj.evals <- obj.evals + 1
            if (class(new.objective.val) != "try-error" & !is.na(obj_funvals[k + 
                1]) & !is.nan(new.objective.val)) {
                if (new.objective.val >= obj_funvals[k + 1] - 
                  mon.tol) {
                  obj_funvals[k + 2] <- new.objective.val
                  fold <- fnew
                  xold <- xnew
                  xnew <- x.propose
                  shrink.count <- shrink.count + 1
                }
                else {
                  fold <- fnew
                  xold <- xnew
                  xnew <- fold + xold
                  obj_funvals[k + 2] <- objfn(xnew, ...)
                  obj.evals <- obj.evals + 1
                }
            }
            else {
                fold <- fnew
                xold <- xnew
                xnew <- fold + xold
                obj_funvals[k + 2] <- objfn(xnew, ...)
                obj.evals <- obj.evals + 1
                count <- 0
            }
        }
        else {
            fold <- fnew
            xold <- xnew
            xnew <- fold + xold
            obj_funvals[k + 2] <- objfn(xnew, ...)
            obj.evals <- obj.evals + 1
            count <- 0
        }
        if (count == nlag) {
            count <- 0
            if (obj_funvals[k + 2] < ell.star - cycl.mon.tol) {
                shrink.count <- max(shrink.count - nlag, -2 * 
                  kappa)
            }
            ell.star <- obj_funvals[k + 2]
        }
        shrink.target <- 1/(1 + a1^(kappa - shrink.count))
        k <- k + 1
    }
    obj_funvals <- obj_funvals[!is.na(obj_funvals)]
    value.obj <- objfn(xnew, ...)
    if (k >= maxiter) {
        conv <- FALSE
    }
    return(list(par = c(xnew), fpevals = k, value.objfn = value.obj, 
        objfevals = obj.evals, convergence = conv, objfn.track = obj_funvals))
}
<bytecode: 0x55a967dbf3d8>
<environment: namespace:daarem>
 --- function search by body ---
Function daarem_base_objfn in namespace daarem has this body.
 ----------- END OF FAILURE REPORT -------------- 
Fatal error: the condition has length > 1