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

> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: find_lambda
> ### Title: Selecting Box-Cox parameter lambda for general d.
> ### Aliases: find_lambda
> 
> ### ** Examples
> 
> # Log-normal density ===================
> # Note: the default value max_phi = 10 is OK here but this will not always
> # be the case
> lambda <- find_lambda(logf = dlnorm, log = TRUE)
> lambda
$lambda
[1] 0.05408854

$gm
[1] 0.971952

$init_psi
[1] -0.05181524

$sd_psi
     Var1 
0.8614544 

> x <- ru(logf = dlnorm, log = TRUE, d = 1, n = 1000, trans = "BC",
+         lambda = lambda)
 ----------- FAILURE REPORT -------------- 
 --- failure: the condition has length > 1 ---
 --- srcref --- 
: 
 --- package (from environment) --- 
rust
 --- call from context --- 
ru(logf = dlnorm, log = TRUE, d = 1, n = 1000, trans = "BC", 
    lambda = lambda)
 --- call from argument --- 
if (class(temp$hessian) == "try-error") {
    pos_def <- FALSE
} else {
    hess_mat <- temp$hessian
    e_vals <- eigen(hess_mat, symmetric = TRUE, only.values = TRUE)$values
    if (any(e_vals < 1e-06)) {
        pos_def <- FALSE
    }
}
 --- R stacktrace ---
where 1: ru(logf = dlnorm, log = TRUE, d = 1, n = 1000, trans = "BC", 
    lambda = lambda)

 --- value of length: 2 type: logical ---
[1] FALSE FALSE
 --- function from context --- 
function (logf, ..., n = 1, d = 1, init = NULL, trans = c("none", 
    "BC", "user"), phi_to_theta = NULL, log_j = NULL, user_args = list(), 
    lambda = rep(1L, d), lambda_tol = 1e-06, gm = NULL, rotate = ifelse(d == 
        1, FALSE, TRUE), lower = rep(-Inf, d), upper = rep(Inf, 
        d), r = 1/2, ep = 0L, a_algor = if (d == 1) "nlminb" else "optim", 
    b_algor = c("nlminb", "optim"), a_method = c("Nelder-Mead", 
        "BFGS", "CG", "L-BFGS-B", "SANN", "Brent"), b_method = c("Nelder-Mead", 
        "BFGS", "CG", "L-BFGS-B", "SANN", "Brent"), a_control = list(), 
    b_control = list(), var_names = NULL) 
{
    if (r < 0) {
        stop("r must be non-negative")
    }
    a_algor <- match.arg(a_algor, c("optim", "nlminb"))
    a_method <- match.arg(a_method)
    b_algor <- match.arg(b_algor)
    b_method <- match.arg(b_method)
    if (any(upper <= lower)) {
        stop("upper must be greater than lower, componentwise.")
    }
    trans <- match.arg(trans)
    if (is.null(gm)) {
        gm <- rep(1, d)
    }
    if (trans == "BC") {
        lambda_type <- "numeric"
        if (is.list(lambda)) {
            lambda_type <- "list"
            if (is.null(lambda$lambda)) {
                stop("The list lambda must contain the object lambda$lambda")
            }
            if (!is.null(lambda$gm)) {
                gm <- lambda$gm
            }
            if (!is.null(lambda$init_psi)) {
                init <- lambda$init_psi
            }
            if (a_algor == "optim" & is.null(a_control$parscale)) {
                a_control <- c(a_control, list(parscale = lambda$sd_psi))
            }
            if (!is.null(lambda$phi_to_theta)) {
                phi_to_theta <- lambda$phi_to_theta
            }
            if (!is.null(lambda$log_j)) {
                log_j <- lambda$log_j
            }
            lambda <- lambda$lambda
        }
        lambda <- ifelse(abs(lambda) < lambda_tol, 0L, lambda)
        if (!is.vector(lambda)) {
            stop("lambda must be a numeric vector")
        }
        if (!(length(lambda) %in% c(1, d))) {
            if (lambda_type == "numeric") {
                stop("lambda must be a numeric vector of length d")
            }
            if (lambda_type == "list") {
                stop("lambda$lambda must be a numeric vector of length d")
            }
        }
        if (length(lambda) == 1) {
            lambda <- rep(lambda, d)
        }
        if (any(upper <= 0)) {
            stop("when trans = ``BC'' all elements of upper must be positive")
        }
        lower <- pmax(0, lower)
        lower <- ifelse(lambda == 0, gm * log(lower), (lower^lambda - 
            1)/(lambda * gm^(lambda - 1)))
        upper <- ifelse(lambda == 0, gm * log(upper), (upper^lambda - 
            1)/(lambda * gm^(lambda - 1)))
    }
    if (d == 1 & a_algor == "optim" & any(is.infinite(c(lower, 
        upper)))) {
        a_algor = "nlminb"
        warning("For d = 1 finite lower and upper bounds must be supplied when\n            using a_algor = `optim'.  a_algor has been changed to `nlminb'")
    }
    if (d == 1 & b_algor == "optim" & any(is.infinite(c(lower, 
        upper)))) {
        b_algor = "nlminb"
        warning("For d = 1 finite lower and upper bounds must be supplied when\n            using b_algor = `optim'.  b_algor has been changed to `nlminb'")
    }
    if (b_algor == "optim") {
        if (b_method == "BFGS" | b_method == "CG") {
            warning("Using optim with b_method==`BFGS' or `CG' can produce the error\n              message `non-finite finite-difference value'.  If you really want\n              to use BFGS or CG try setting ep to be positive but small, e.g.\n              ep=0.001.", 
                immediate. = TRUE, noBreaks. = TRUE)
        }
    }
    if (d == 1) {
        a_method <- "Brent"
        b_method <- "Brent"
    }
    if (d == 1) {
        which_lam <- 1L
    }
    else {
        which_lam <- which(lambda != 1L)
    }
    if (is.null(init)) {
        init <- rep(1, d)
        warning("No initial estimate of the mode given: a vector of ones has\n            been used", 
            noBreaks. = TRUE)
    }
    len_init <- length(init)
    if (len_init == 1 & d > 1) {
        init <- rep(init, length.out = d)
        warning("d > 1 but init has length 1: a d-vector of inits has been used")
    }
    if (len_init != d & len_init != 1) {
        stop("the length of init is incompatible with d")
    }
    if (d == 1 & rotate) {
        rotate <- FALSE
        warning("rotation is not relevant when d=1: no rotation is used")
    }
    ep <- abs(ep)
    vals <- matrix(NA, ncol = d, nrow = 2 * d + 1)
    colnames(vals) <- paste("vals", 1:d, sep = "")
    conv <- rep(NA, 2 * d + 1)
    big_val <- Inf
    hscale <- 0
    psi_mode <- rep(0, d)
    if (trans == "none" & is.function(phi_to_theta)) {
        warning("phi_to_theta() not used when trans = ``none'': identity fn used")
    }
    if (!is.function(phi_to_theta) & !is.null(phi_to_theta)) {
        stop("phi_to_theta must be a function or NULL")
    }
    if (trans == "user" & is.null(phi_to_theta)) {
        stop("When trans = ``user'' phi_to_theta must be supplied")
    }
    if (is.function(phi_to_theta) & is.null(log_j)) {
        log_j <- function(x) 0
        warning("No Jacobian for phi_to_theta(): constant Jacobian has been used")
    }
    if (is.null(phi_to_theta)) {
        phi_to_theta <- identity
        log_j <- function(x) 0
    }
    rot_mat <- diag(1, d)
    if (rotate) {
        rho_to_psi <- function(rho) psi_mode + rho %*% rot_mat
    }
    else {
        rho_to_psi <- function(rho) psi_mode + rho
    }
    if (trans == "BC") {
        const <- lambda * gm^(lambda - 1)
        if (any(lambda == 0L)) {
            psi_to_phi <- function(psi) {
                ifelse(lambda == 0, exp(psi/gm), (psi * const + 
                  1)^(1/lambda))
            }
        }
        else {
            psi_to_phi <- function(psi) (psi * const + 1)^(1/lambda)
        }
    }
    init_psi <- init
    if (trans == "none") {
        logf_rho <- function(._rho, ...) {
            theta <- rho_to_psi(._rho)
            val <- logf(theta, ...) - hscale
            structure(val, theta = theta)
        }
    }
    if (trans == "BC") {
        logf_rho <- function(._rho, ...) {
            psi <- rho_to_psi(._rho)
            test <- (psi * const + 1)[which_lam]
            if (any(test <= 0)) 
                return(-Inf)
            phi <- psi_to_phi(psi)
            theta <- phi_to_theta(phi)
            log_bc_jac <- sum((lambda - 1)[which_lam] * log(phi[which_lam]))
            val <- logf(theta, ...) - log_bc_jac - log_j(theta) - 
                hscale
            structure(val, theta = theta)
        }
    }
    if (trans == "user") {
        logf_rho <- function(._rho, ...) {
            phi <- rho_to_psi(._rho)
            theta <- do.call(phi_to_theta, c(list(phi), user_args))
            if (any(!is.finite(theta))) 
                return(-Inf)
            logj <- do.call(log_j, c(list(theta), user_args))
            val <- logf(theta, ...) - logj - hscale
            structure(val, theta = theta)
        }
    }
    neg_logf_rho <- function(._rho, ...) -logf_rho(._rho, ...)
    f_rho <- function(._rho, ...) exp(logf_rho(._rho, ...))
    hscale <- logf_rho(init_psi, ...)
    if (is.infinite(hscale)) {
        stop("The target density is zero at initial parameter values")
    }
    for_find_a <- list(neg_logf_rho = neg_logf_rho, init_psi = init_psi, 
        d = d, r = r, lower = lower, upper = upper, algor = a_algor, 
        method = a_method, control = a_control, ...)
    temp <- do.call("find_a", for_find_a)
    check_finite <- logf_rho(temp$par, ...)
    if (!is.finite(check_finite)) {
        stop(paste("The target log-density is not finite at its mode: mode = ", 
            paste(temp$par, collapse = ","), ",\n               function value = ", 
            check_finite, ".", sep = ""))
    }
    hscale <- check_finite + hscale
    a_box <- 1
    f_mode <- temp$par
    vals[1, ] <- rep(0, d)
    conv[1] <- temp$convergence
    pos_def <- TRUE
    if (class(temp$hessian) == "try-error") {
        pos_def <- FALSE
    }
    else {
        hess_mat <- temp$hessian
        e_vals <- eigen(hess_mat, symmetric = TRUE, only.values = TRUE)$values
        if (any(e_vals < 1e-06)) {
            pos_def <- FALSE
        }
    }
    if (!pos_def) {
        warning("The Hessian of the target log-density at its mode is not positive\n            definite. This may not be a problem, but it may be that a mode\n            at/near a parameter boundary has been found and/or that the target\n            function is unbounded.", 
            immediate. = TRUE, noBreaks. = TRUE)
        if (trans != "BC") {
            cat("  It might be worth using the option trans = ``BC''.", 
                "\n")
        }
        if (rotate) {
            rotate <- FALSE
            warning("rotate has been changed to FALSE.", immediate. = TRUE)
        }
    }
    if (rotate) {
        rot_mat <- solve(t(chol(hess_mat)))
        rot_mat <- rot_mat/exp(-mean(log(e_vals))/2)
    }
    psi_mode <- f_mode
    if (rotate) {
        lower <- rep(-Inf, d)
        upper <- rep(Inf, d)
    }
    for_find_bs <- list(f_rho = f_rho, d = d, r = r, lower = lower, 
        upper = upper, f_mode = f_mode, ep = ep, vals = vals, 
        conv = conv, algor = b_algor, method = b_method, control = b_control, 
        ...)
    temp <- do.call("find_bs", for_find_bs)
    vals <- temp$vals
    conv <- temp$conv
    l_box <- temp$l_box
    u_box <- temp$u_box
    n_try <- n_acc <- 0L
    res <- list()
    res$sim_vals <- matrix(NA, ncol = d, nrow = n)
    res$sim_vals_rho <- matrix(NA, ncol = d, nrow = n)
    colnames(res$sim_vals) <- var_names
    colnames(res$sim_vals_rho) <- paste("rho[", 1:d, "]", sep = "")
    d_box <- u_box - l_box
    d_r <- d * r + 1
    while (n_acc < n) {
        u <- runif(1, 0, a_box)
        vs <- d_box * runif(d) + l_box
        rho <- vs/u^r
        rhs <- logf_rho(rho, ...)
        n_try <- n_try + 1L
        if (d_r * log(u) < rhs) {
            n_acc <- n_acc + 1L
            res$sim_vals[n_acc, ] <- attr(rhs, "theta")
            res$sim_vals_rho[n_acc, ] <- rho
        }
    }
    box <- c(a_box, l_box, u_box)
    res$box <- cbind(box, vals, conv)
    bs <- paste(paste("b", 1:d, sep = ""), rep(c("minus", "plus"), 
        each = d), sep = "")
    rownames(res$box) <- c("a", bs)
    res$pa <- n_acc/n_try
    if (any(conv != 0)) {
        warning("One or more convergence indicators are non-zero.", 
            immediate. = TRUE)
        print(res$box)
    }
    res$d <- d
    logf_scaled <- function(theta, ...) {
        return(logf(theta, ...) - hscale)
    }
    res$logf <- logf_scaled
    res$logf_args <- list(...)
    res$logf_rho <- logf_rho
    res$f_mode <- f_mode
    class(res) <- "ru"
    return(res)
}
<bytecode: 0x55b5fcb5be08>
<environment: namespace:rust>
 --- function search by body ---
Function ru in namespace rust has this body.
 ----------- END OF FAILURE REPORT -------------- 
Fatal error: the condition has length > 1