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

> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: coef
> ### Title: Summarize opm object
> ### Aliases: coef<- coef.opm coef<-.opm coef.optimx coef<-.optimx
> ### Keywords: nonlinear optimize
> 
> ### ** Examples
> 
> ans <- opm(fn = function(x) sum(x*x), par = 1:2, method="ALL", control=list(trace=0))
This problem is unconstrained.
Warning in optimr(par, fn, gr, hess = hess, method = meth, lower = lower,  :
  Note: snewton needs gradient function specified
Warning in optimr(par, fn, gr, hess = hess, method = meth, lower = lower,  :
  Note: snewton needs Hessian function (hess) specified
Warning in optimr(par, fn, gr, hess = hess, method = meth, lower = lower,  :
  Note: snewtonm needs gradient function specified
Warning in optimr(par, fn, gr, hess = hess, method = meth, lower = lower,  :
  Note: snewtonm needs Hessian function specified
Warning in optimr(par, fn, gr, hess = hess, method = meth, lower = lower,  :
  Successful convergence  Restarts for stagnation =0
> print(coef(ans))
                       p1            p2
BFGS         2.228468e-13 -1.109715e-13
CG          -4.103643e-07 -8.207287e-07
Nelder-Mead  1.274686e-04  1.447624e-04
L-BFGS-B     7.623310e-21 -3.515189e-20
nlm         -3.558074e-17  1.766298e-17
nlminb       2.953466e-31  9.870427e-31
lbfgsb3     -2.838207e-11 -3.036971e-11
Rcgmin                 NA            NA
Rtnmin                 NA            NA
Rvmmin                 NA            NA
snewton                NA            NA
snewtonm               NA            NA
spg         -5.240253e-08 -5.595524e-08
ucminf      -4.356895e-09 -5.256497e-09
newuoa       7.801992e-10 -5.695938e-10
bobyqa       6.933067e-08  2.918226e-08
nmkb         6.289555e-04  3.953361e-04
hjkb         0.000000e+00  0.000000e+00
hjn          0.000000e+00  0.000000e+00
lbfgs                  NA            NA
subplex      2.818926e-17 -1.084202e-18
> 
> ansx <- optimx(fn = function(x) sum(x*x), par = 1:2, control=list(all.methods=TRUE, trace=0))
 ----------- FAILURE REPORT -------------- 
 --- failure: the condition has length > 1 ---
 --- srcref --- 
: 
 --- package (from environment) --- 
optimx
 --- call from context --- 
optimx.run(par, optcfg$ufn, optcfg$ugr, optcfg$uhess, lower, 
    upper, optcfg$method, itnmax, hessian, optcfg$ctrl, ...)
 --- call from argument --- 
if (class(nhatend) != "try-error") {
    hessOK <- TRUE
}
 --- R stacktrace ---
where 1: optimx.run(par, optcfg$ufn, optcfg$ugr, optcfg$uhess, lower, 
    upper, optcfg$method, itnmax, hessian, optcfg$ctrl, ...)
where 2: optimx(fn = function(x) sum(x * x), par = 1:2, control = list(all.methods = TRUE, 
    trace = 0))

 --- value of length: 2 type: logical ---
[1] TRUE TRUE
 --- function from context --- 
function (par, ufn, ugr = NULL, uhess = NULL, lower = -Inf, upper = Inf, 
    method = c("Nelder-Mead", "BFGS"), itnmax = NULL, hessian = FALSE, 
    ctrl, ...) 
{
    have.bounds <- ctrl$have.bounds
    ctrl$have.bounds <- NULL
    npar <- length(par)
    if (length(lower) == 1 && is.finite(lower)) 
        lower <- rep(lower, npar)
    if (length(upper) == 1 && is.finite(upper)) 
        upper <- rep(upper, npar)
    nmeth <- length(method)
    pstring <- names(par)
    if (is.null(pstring)) {
        pstring <- NULL
        for (j in 1:npar) {
            pstring[[j]] <- paste("p", j, sep = "")
        }
    }
    cnames <- c(pstring, "value", "fevals", "gevals", "niter", 
        "convcode", "kkt1", "kkt2", "xtime")
    ans.ret <- matrix(NA, nrow = nmeth, ncol = npar + 8)
    colnames(ans.ret) <- cnames
    row.names(ans.ret) <- method
    ans.details <- list()
    ansout <- NULL
    for (i in 1:nmeth) {
        meth <- method[i]
        conv <- -1
        if (!is.null(itnmax)) {
            if (length(itnmax) == 1) {
                ctrl$maxit <- itnmax
            }
            else {
                if (length(itnmax) != nmeth) {
                  stop("Length of itnmax =", length(itnmax), 
                    " but should be ", nmeth)
                }
                else {
                  ctrl$maxit <- itnmax[i]
                }
            }
            if (ctrl$follow.on && (ctrl$trace > 0)) 
                cat("Do ", ctrl$maxit, " steps of ")
        }
        if (ctrl$trace > 0) 
            cat("Method: ", meth, "\n")
        mcontrol <- ctrl
        mcontrol$follow.on <- NULL
        mcontrol$usenumDeriv <- NULL
        mcontrol$save.failures <- NULL
        mcontrol$kkt <- NULL
        mcontrol$starttests <- NULL
        mcontrol$all.methods <- NULL
        mcontrol$dowarn <- NULL
        mcontrol$kkttol <- NULL
        mcontrol$kkt2tol <- NULL
        mcontrol$maximize <- NULL
        mcontrol$badval <- NULL
        mcontrol$scaletol <- NULL
        ans.ret[i, "value"] <- .Machine$double.xmax
        if (meth == "Nelder-Mead" || meth == "BFGS" || meth == 
            "L-BFGS-B" || meth == "CG" || meth == "SANN") {
            if (have.bounds) {
                if (meth != "L-BFGS-B") 
                  stop("Bounds constraints for optim() require L-BFGS-B")
                else {
                  time <- system.time(ans <- try(optim(par = par, 
                    fn = ufn, gr = ugr, lower = lower, upper = upper, 
                    method = meth, control = mcontrol, ...), 
                    silent = TRUE))[1]
                }
            }
            else {
                time <- system.time(ans <- try(optim(par = par, 
                  fn = ufn, gr = ugr, method = meth, control = mcontrol, 
                  ...), silent = TRUE))[1]
            }
            if (class(ans)[1] != "try-error") {
                ans$convcode <- ans$convergence
                ans$convergence <- NULL
                ans$fevals <- ans$counts[1]
                ans$gevals <- ans$counts[2]
                ans$counts <- NULL
            }
            else {
                ans <- list(fevals = NA)
                ans$convcode <- 9999
                if (ctrl$trace > 0) 
                  cat("optim function evaluation failure\n")
                ans$value = ctrl$badval
                ans$par <- rep(NA, npar)
                ans$fevals <- NA
                ans$gevals <- NA
            }
            ans$nitns <- NA
        }
        else if (meth == "nlminb") {
            mcontrol$iter.max <- mcontrol$maxit
            mcontrol$maxit <- NULL
            mcontrol$abs.tol <- 0
            if (is.null(mcontrol$trace) || is.na(mcontrol$trace) || 
                mcontrol$trace == 0) {
                mcontrol$trace = 0
            }
            else {
                mcontrol$trace = 1
            }
            time <- system.time(ans <- try(nlminb(start = par, 
                objective = ufn, gradient = ugr, lower = lower, 
                upper = upper, control = mcontrol, ...), silent = TRUE))[1]
            if (class(ans)[1] != "try-error") {
                ans$convcode <- ans$convergence
                ans$value <- ans$objective
                ans$objective <- NULL
                ans$fevals <- ans$evaluations[1]
                ans$gevals <- ans$evaluations[2]
                ans$evaluations <- NULL
                ans$nitns <- ans$iterations
                ans$iterations <- NULL
            }
            else {
                ans <- list(fevals = NA)
                ans$convcode <- 9999
                if (ctrl$trace > 0) 
                  cat("nlminb function evaluation failure\n")
                ans$value = ctrl$badval
                ans$objective <- NULL
                ans$par <- rep(NA, npar)
                ans$nitns <- NA
                ans$gevals <- NA
                ans$gevals <- NA
                ans$objective <- NULL
                ans$evaluations <- NULL
                ans$iterations <- NULL
                ans$message <- "nlminb failure"
            }
            ans$convergence <- NULL
        }
        else if (meth == "nlm") {
            if (!is.null(ugr)) {
                tufn <- function(x, ...) {
                  res <- ufn(x, ...)
                  attr(res, "gradient") <- ugr(x, ...)
                  return(res)
                }
            }
            else {
                tufn <- ufn
            }
            if (!is.null(mcontrol$maxit)) {
                iterlim <- mcontrol$maxit
                mcontrol$maxit <- NULL
            }
            else {
                iterlim = 100
            }
            if (is.null(mcontrol$trace)) {
                print.level <- 0
            }
            else {
                print.level <- mcontrol$trace
                mcontrol$trace <- NULL
            }
            time <- system.time(ans <- try(nlm(f = tufn, p = par, 
                ..., iterlim = iterlim, print.level = print.level), 
                silent = TRUE))[1]
            if (class(ans)[1] != "try-error") {
                if (ctrl$trace > 1) {
                  cat("nlm output ans:\n")
                  print(ans)
                }
                ans$convcode <- ans$code
                if (ans$convcode == 1 || ans$convcode == 2 || 
                  ans$convcode == 3) 
                  ans$convcode <- 0
                if (ans$convcode == 4) 
                  ans$convcode <- 1
                ans$value <- ans$minimum
                ans$par <- ans$estimate
                ans$estimate <- NULL
                ans$minimum <- NULL
                ans$fevals <- NA
                ans$gevals <- NA
                ans$nitns <- ans$iterations
                ans$iterations <- NULL
            }
            else {
                if (ctrl$trace > 0) 
                  cat("nlm failed for this problem\n")
                ans <- list(fevals = NA)
                ans$value = ctrl$badval
                ans$par <- rep(NA, npar)
                ans$convcode <- 9999
                ans$gevals <- NA
                ans$nitns <- NA
            }
        }
        else if (meth == "spg") {
            mcontrol$maximize <- NULL
            time <- system.time(ans <- try(BB::spg(par = par, 
                fn = ufn, gr = ugr, lower = lower, upper = upper, 
                control = mcontrol, ...), silent = TRUE))[1]
            if (class(ans)[1] != "try-error") {
                ans$convcode <- ans$convergence
                ans$fevals <- ans$feval
                ans$feval <- NULL
                ans$gevals <- NA
                ans$nitns <- ans$iter
                ans$iter <- NULL
            }
            else {
                if (ctrl$trace > 0) 
                  cat("spg failed for this problem\n")
                ans <- list(fevals = NA)
                ans$value = ctrl$badval
                ans$par <- rep(NA, npar)
                ans$convcode <- 9999
                ans$gevals <- NA
                ans$nitns <- NA
            }
            ans$convergence <- NULL
        }
        else if (meth == "ucminf") {
            if (is.null(ctrl$maxit)) 
                mcontrol$maxit <- 500
            mcontrol$maxeval <- mcontrol$maxit
            mcontrol$maxit <- NULL
            time <- system.time(ans <- try(ucminf::ucminf(par = par, 
                fn = ufn, gr = ugr, control = mcontrol, ...), 
                silent = TRUE))[1]
            if (class(ans)[1] != "try-error") {
                ans$convcode <- ans$convergence
                if (ans$convcode == 1 || ans$convcode == 2 || 
                  ans$convcode == 4) {
                  ans$convcode <- 0
                }
                else {
                  ans$convcode <- ans$convergence
                }
                ans$fevals <- ans$info[4]
                ans$gevals <- ans$info[4]
                ans$info <- NULL
                ans$nitns <- NA
                if (ctrl$trace > 0) 
                  cat("ucminf message:", ans$message, "\n")
            }
            else {
                if (ctrl$trace > 0) 
                  cat("ucminf failed for this problem\n")
                ans <- list(fevals = NA)
                ans$value = ctrl$badval
                ans$par <- rep(NA, npar)
                ans$convcode <- 9999
                ans$gevals <- NA
                ans$nitns <- NA
            }
            ans$convergence <- NULL
        }
        else if (meth == "Rcgmin") {
            bdmsk <- rep(1, npar)
            mcontrol$trace <- NULL
            if (ctrl$trace > 0) 
                mcontrol$trace <- 1
            tugr <- ugr
            if (is.null(ugr)) {
                tugr <- "grfwd"
                if (ctrl$trace > 0) 
                  cat("Rcgmin using grfwd\n")
            }
            if (have.bounds) {
                time <- system.time(ans <- try(Rcgminb(par = par, 
                  fn = ufn, gr = tugr, lower = lower, upper = upper, 
                  bdmsk = bdmsk, control = mcontrol, ...), silent = TRUE))[1]
            }
            else {
                time <- system.time(ans <- try(Rcgminu(par = par, 
                  fn = ufn, gr = tugr, control = mcontrol, ...), 
                  silent = TRUE))[1]
            }
            if (class(ans)[1] != "try-error") {
                ans$convcode <- ans$convergence
                ans$fevals <- ans$counts[1]
                ans$gevals <- ans$counts[2]
                ans$counts <- NULL
            }
            else {
                if (ctrl$trace > 0) 
                  cat("Rcgmin failed for current problem \n")
                ans <- list(fevals = NA)
                ans$value = ctrl$badval
                ans$par <- rep(NA, npar)
                ans$convcode <- 9999
                ans$fevals <- NA
                ans$gevals <- NA
            }
            ans$nitns <- NA
            ans$convergence <- NULL
        }
        else if (meth == "Rvmmin") {
            bdmsk <- rep(1, npar)
            mcontrol$trace <- NULL
            if (ctrl$trace > 0) 
                mcontrol$trace <- ctrl$trace
            tugr <- ugr
            if (is.null(ugr)) {
                tugr <- "grfwd"
                if (ctrl$trace > 0) 
                  cat("Rvmmin using grfwd\n")
            }
            if (have.bounds) {
                time <- system.time(ans <- try(Rvmminb(par = par, 
                  fn = ufn, gr = tugr, lower = lower, upper = upper, 
                  bdmsk = bdmsk, control = mcontrol, ...), silent = TRUE))[1]
            }
            else {
                time <- system.time(ans <- try(Rvmminu(par = par, 
                  fn = ufn, gr = tugr, control = mcontrol, ...), 
                  silent = TRUE))[1]
            }
            if (class(ans)[1] != "try-error") {
                ans$convcode <- ans$convergence
                ans$fevals <- ans$counts[1]
                ans$gevals <- ans$counts[2]
            }
            else {
                if (ctrl$trace > 0) 
                  cat("Rvmmin failed for current problem \n")
                ans <- list(fevals = NA)
                ans$value = ctrl$badval
                ans$par <- rep(NA, npar)
                ans$convcode <- 9999
                ans$gevals <- NA
            }
            ans$nitns <- NA
            ans$convergence <- NULL
        }
        else if (meth == "lbfgsb3") {
            mcontrol$maxit <- NULL
            mcontrol$maxfeval <- NULL
            mcontrol$trace <- NULL
            mcontrol$iprint <- -1L
            if (ctrl$trace > 0) {
                mcontrol$trace <- 1
                mcontrol$iprint <- 1
            }
            time <- system.time(ans <- try(lbfgsb3::lbfgsb3(prm = par, 
                fn = ufn, gr = ugr, lower = lower, upper = upper, 
                control = mcontrol, ...), silent = TRUE))[1]
            if ((class(ans)[1] != "try-error")) {
                ans$convcode <- 0
                ans$fevals <- ans$info$isave[34]
                ans$gevals <- ans$fevals
                ans$value <- ans$f
                ans$par <- ans$prm
                ans$prm <- NULL
                ans$f <- NULL
                ans$info <- NULL
            }
            else {
                if (ctrl$trace > 0) 
                  cat("lbfgsb3 failed for current problem \n")
                ans <- list(fevals = NA)
                ans$value = ctrl$badval
                ans$par <- rep(NA, npar)
                ans$convcode <- 9999
                ans$gevals <- NA
                ans$fevals <- NA
            }
            ans$nitns <- NA
            ans$convergence <- NULL
        }
        else if (meth == "bobyqa") {
            if (!is.null(mcontrol$maxit)) {
                mcontrol$maxfun <- mcontrol$maxit
            }
            else {
                mcontrol$maxfun <- 5000 * round(sqrt(npar + 1))
            }
            mcontrol$iprint <- 0
            if (mcontrol$trace) 
                mcontrol$iprint <- 1
            mcontrol$trace <- NULL
            time <- system.time(ans <- try(minqa::bobyqa(par = par, 
                fn = ufn, lower = lower, upper = upper, control = mcontrol, 
                ...), silent = TRUE))[1]
            if (class(ans)[1] != "try-error") {
                ans$convcode <- 0
                if (ans$feval > mcontrol$maxfun) {
                  ans$convcode <- 1
                }
                ans$fevals <- ans$feval
                ans$gevals <- NA
                ans$value <- ans$fval
                ans$nitns <- NA
            }
            else {
                if (ctrl$trace > 0) 
                  cat("bobyqa failed for current problem \n")
                ans <- list(fevals = NA)
                ans$value = ctrl$badval
                ans$par <- rep(NA, npar)
                ans$convcode <- 9999
                ans$gevals <- NA
                ans$nitns <- NA
            }
        }
        else if (meth == "uobyqa") {
            if (!is.null(mcontrol$maxit)) {
                mcontrol$maxfun <- mcontrol$maxit
            }
            else {
                mcontrol$maxfun <- 5000 * round(sqrt(npar + 1))
            }
            mcontrol$iprint <- 0
            if (mcontrol$trace) 
                mcontrol$iprint <- 1
            mcontrol$trace <- NULL
            time <- system.time(ans <- try(minqa::uobyqa(par = par, 
                fn = ufn, control = mcontrol, ...), silent = TRUE))[1]
            if (class(ans)[1] != "try-error") {
                ans$convcode <- 0
                if (ans$feval > mcontrol$maxfun) {
                  ans$convcode <- 1
                }
                ans$fevals <- ans$feval
                ans$gevals <- NA
                ans$value <- ans$fval
                ans$nitns <- NA
            }
            else {
                if (ctrl$trace > 0) 
                  cat("uobyqa failed for current problem \n")
                ans <- list(fevals = NA)
                ans$value = ctrl$badval
                ans$par <- rep(NA, npar)
                ans$convcode <- 9999
                ans$gevals <- NA
                ans$nitns <- NA
            }
        }
        else if (meth == "newuoa") {
            if (!is.null(mcontrol$maxit)) {
                mcontrol$maxfun <- mcontrol$maxit
            }
            else {
                mcontrol$maxfun <- 5000 * round(sqrt(npar + 1))
            }
            mcontrol$iprint <- 0
            if (mcontrol$trace) 
                mcontrol$iprint <- 1
            mcontrol$trace <- NULL
            time <- system.time(ans <- try(minqa::newuoa(par = par, 
                fn = ufn, control = mcontrol, ...), silent = TRUE))[1]
            if (class(ans)[1] != "try-error") {
                ans$convcode <- 0
                if (ans$feval > mcontrol$maxfun) {
                  ans$convcode <- 1
                }
                ans$fevals <- ans$feval
                ans$gevals <- NA
                ans$value <- ans$fval
                ans$nitns <- NA
            }
            else {
                if (ctrl$trace > 0) 
                  cat("newuoa failed for current problem \n")
                ans <- list(fevals = NA)
                ans$value = ctrl$badval
                ans$par <- rep(NA, npar)
                ans$convcode <- 9999
                ans$gevals <- NA
                ans$nitns <- NA
            }
        }
        else if (meth == "nmkb") {
            if (any(par == lower) || any(par == upper)) {
                if (ctrl$trace > 0) 
                  cat("nmkb cannot start if on any bound \n")
                warning("nmkb() cannot be started if any parameter on a bound")
                ans <- list(fevals = NA)
                ans$value = ctrl$badval
                ans$par <- rep(NA, npar)
                ans$convcode <- 9999
                ans$fevals <- NA
                ans$gevals <- NA
                ans$nitns <- NA
            }
            else {
                if (!is.null(mcontrol$maxit)) {
                  mcontrol$maxfeval <- mcontrol$maxit
                }
                else {
                  mcontrol$maxfeval <- 5000 * round(sqrt(npar + 
                    1))
                }
                mcontrol$maxit <- NULL
                if (mcontrol$trace > 0) {
                  mcontrol$trace <- TRUE
                }
                else {
                  mcontrol$trace <- FALSE
                }
                mcontrol$usenumDeriv <- NULL
                mcontrol$maximize <- NULL
                mcontrol$parscale <- NULL
                mcontrol$fnscale <- NULL
                if (have.bounds) {
                  time <- system.time(ans <- try(dfoptim::nmkb(par = par, 
                    fn = ufn, lower = lower, upper = upper, control = mcontrol, 
                    ...), silent = TRUE))[1]
                }
                else {
                  time <- system.time(ans <- try(dfoptim::nmk(par = par, 
                    fn = ufn, control = mcontrol, ...), silent = TRUE))[1]
                }
                if (class(ans)[1] != "try-error") {
                  ans$convcode <- ans$convergence
                  ans$convergence <- NULL
                  ans$value <- as.numeric(ans$value)
                  ans$fevals <- ans$feval
                  ans$feval <- NULL
                  ans$gevals <- NA
                  if (ans$fevals > mcontrol$maxfeval) {
                    ans$convcode <- 1
                  }
                  ans$nitns <- NA
                  ans$message <- NULL
                  ans$restarts <- NULL
                }
                else {
                  if (ctrl$trace > 0) 
                    cat("nmkb failed for current problem \n")
                  ans <- list(fevals = NA)
                  ans$value = ctrl$badval
                  ans$par <- rep(NA, npar)
                  ans$convcode <- 9999
                  ans$fevals <- NA
                  ans$gevals <- NA
                  ans$nitns <- NA
                }
            }
        }
        else if (meth == "hjkb") {
            if (!is.null(mcontrol$maxit)) {
                mcontrol$maxfeval <- mcontrol$maxit
            }
            else {
                mcontrol$maxfeval <- 5000 * round(sqrt(npar + 
                  1))
            }
            mcontrol$info <- FALSE
            if (mcontrol$trace > 0) {
                mcontrol$info <- TRUE
            }
            else {
                mcontrol$info <- FALSE
            }
            mcontrol$trace = NULL
            mcontrol$usenumDeriv <- NULL
            mcontrol$maximize <- NULL
            mcontrol$parscale <- NULL
            mcontrol$fnscale <- NULL
            if (!is.null(mcontrol$maxit)) {
                mcontrol$maxfeval <- mcontrol$maxit
            }
            else {
                mcontrol$maxfeval <- 5000 * round(sqrt(npar + 
                  1))
            }
            mcontrol$maxit <- NULL
            if (have.bounds) {
                time <- system.time(ans <- try(dfoptim::hjkb(par = par, 
                  fn = ufn, lower = lower, upper = upper, control = mcontrol, 
                  ...), silent = TRUE))[1]
            }
            else {
                time <- system.time(ans <- try(dfoptim::hjk(par = par, 
                  fn = ufn, control = mcontrol, ...), silent = TRUE))[1]
            }
            if (class(ans)[1] != "try-error") {
                ans$convcode <- ans$convergence
                if (ans$convcode == 1) 
                  ans$convcode = 9999
                ans$convergence <- NULL
                ans$value <- as.numeric(ans$value)
                ans$fevals <- ans$feval
                ans$feval <- NULL
                if (ans$fevals > mcontrol$maxfeval) {
                  ans$convcode <- 1
                }
                ans$gevals <- NA
                ans$nitns <- ans$niter
                ans$niter <- NULL
            }
            else {
                if (ctrl$trace > 0) 
                  cat("hjkb failed for current problem \n")
                ans <- list(fevals = NA)
                ans$value = ctrl$badval
                ans$par <- rep(NA, npar)
                ans$convcode <- 9999
                ans$gevals <- NA
                ans$nitns <- NA
            }
        }
        else {
            errmsg <- paste("UNDEFINED METHOD: ", meth, sep = "")
            stop(errmsg, call. = FALSE)
        }
        if (ctrl$trace > 0) {
            cat("Post processing for method ", meth, "\n")
        }
        if (exists("ans$message")) {
            amsg <- ans$message
            ans$message <- NULL
        }
        else {
            amsg <- "none"
        }
        ngatend <- NA
        nhatend <- NA
        hev <- NA
        if (ctrl$save.failures || (ans$convcode < 1)) {
            if (ctrl$trace && ans$convcode == 0) 
                cat("Successful convergence! \n")
            hessOK <- FALSE
            gradOK <- FALSE
            if ((ctrl$kkt || hessian) && (ans$convcode != 9999)) {
                if (ctrl$trace > 0) 
                  cat("Compute Hessian approximation at finish of ", 
                    method[i], "\n")
                if (!is.null(uhess)) {
                  nhatend <- try(uhess(ans$par, ...), silent = TRUE)
                  if (class(nhatend) != "try-error") {
                    hessOK <- TRUE
                  }
                }
                else {
                  if (is.null(ugr)) {
                    nhatend <- try(hessian(ufn, ans$par, ...), 
                      silent = TRUE)
                  }
                  else {
                    nhatend <- try(jacobian(ugr, ans$par, ...), 
                      silent = TRUE)
                  }
                  if (class(nhatend) != "try-error") {
                    hessOK <- TRUE
                  }
                }
            }
            ans$kkt1 <- NA
            ans$kkt2 <- NA
            if ((hessian || ctrl$kkt) && (ans$convcode != 9999)) {
                if (ctrl$trace > 0) 
                  cat("Compute gradient approximation at finish of ", 
                    method[i], "\n")
                if (is.null(ugr)) {
                  ngatend <- try(grad(ufn, ans$par, ...), silent = TRUE)
                }
                else {
                  ngatend <- try(ugr(ans$par, ...), silent = TRUE)
                }
                if (class(ngatend) != "try-error") 
                  gradOK <- TRUE
                if ((!gradOK) && (ctrl$trace > 0)) 
                  cat("Gradient computation failure!\n")
                if (gradOK) {
                  ans$kkt1 <- (max(abs(ngatend)) <= ctrl$kkttol * 
                    (1 + abs(ans$value)))
                  if (hessOK) {
                    bset <- sort(unique(c(which(ans$par <= lower), 
                      which(ans$par >= upper))))
                    nbds <- length(bset)
                    ngatend[bset] <- 0
                    nhatend[bset, ] <- 0
                    nhatend[, bset] <- 0
                    if (!isSymmetric(nhatend, tol = sqrt(.Machine$double.eps))) {
                      asym <- sum(abs(t(nhatend) - nhatend))/sum(abs(nhatend))
                      asw <- paste("Hessian is reported non-symmetric with asymmetry ratio ", 
                        asym, sep = "")
                      if (ctrl$trace > 1) 
                        cat(asw, "\n")
                      if (ctrl$dowarn) 
                        warning(asw)
                      if (ctrl$trace > 1) 
                        cat("Force Hessian symmetric\n")
                      if (ctrl$dowarn) 
                        warning("Hessian forced symmetric", call. = FALSE)
                      nhatend <- 0.5 * (t(nhatend) + nhatend)
                    }
                    hev <- try(eigen(nhatend)$values, silent = TRUE)
                    if (ctrl$kkt) {
                      if (class(hev) != "try-error") {
                        if (any(is.complex(hev))) {
                          hessOK <- FALSE
                          cat("Complex eigenvalues found for method =", 
                            meth, "\n")
                          cat("coefficients for function value", 
                            ans$value, " :\n")
                          print(ans$par)
                          dput(nhatend, file = "badhess.txt")
                          warning("Complex eigenvalues found for method =", 
                            meth)
                        }
                        if (hessOK) {
                          negeig <- (hev[npar] <= (-1) * ctrl$kkt2tol * 
                            (1 + abs(ans$value)))
                          evratio <- hev[npar - nbds]/hev[1]
                          ans$kkt2 <- (evratio > ctrl$kkt2tol) && 
                            (!negeig)
                        }
                      }
                      else {
                        warnstr <- paste("Eigenvalue failure after method ", 
                          method[i], sep = "")
                        if (ctrl$dowarn) 
                          warning(warnstr)
                        if (ctrl$trace > 0) {
                          cat("Hessian eigenvalue calculation failure!\n")
                          print(nhatend)
                        }
                      }
                    }
                  }
                  else {
                    warnstr <- paste("Hessian not computable after method ", 
                      method[i], sep = "")
                    if (ctrl$dowarn) 
                      warning(warnstr)
                    if (ctrl$trace > 0) 
                      cat(warnstr, "\n")
                  }
                }
                else {
                  warnstr <- paste("Gradient not computable after method ", 
                    method[i], sep = "")
                  if (ctrl$dowarn) 
                    warning(warnstr)
                  if (ctrl$trace > 0) 
                    cat(warnstr, "\n")
                }
            }
            ans$xtimes <- time
            if (ctrl$trace > 0) {
                cat("Save results from method ", meth, "\n")
                print(ans)
            }
            if (ctrl$trace > 0) {
                cat("Assemble the answers\n")
            }
            ans.ret[meth, ] <- c(ans$par, ans$value, ans$fevals, 
                ans$gevals, ans$nitns, ans$convcode, ans$kkt1, 
                ans$kkt2, ans$xtimes)
            if (!gradOK) 
                ngatend <- NA
            if (!hessOK) {
                nhatend <- NA
                hev <- NA
            }
        }
        ans.details <- rbind(ans.details, list(method = meth, 
            ngatend = ngatend, nhatend = nhatend, hev = hev, 
            message = amsg))
        row.names(ans.details)[[i]] >= meth
        if (ctrl$follow.on) {
            par <- ans$par
            if (i < nmeth && (ctrl$trace > 0)) 
                cat("FOLLOW ON!\n")
        }
    }
    ansout <- NULL
    if (length(ans$par) > 0) {
        ansout <- data.frame(ans.ret)
        attr(ansout, "details") <- ans.details
    }
    ansout
}
<bytecode: 0x556e81d2c210>
<environment: namespace:optimx>
 --- function search by body ---
Function optimx.run in namespace optimx has this body.
 ----------- END OF FAILURE REPORT -------------- 
Fatal error: the condition has length > 1