Error(s) in re-building vignettes:
  ...
--- re-building ‘rust-a-vignette.Rmd’ using rmarkdown
 ----------- FAILURE REPORT -------------- 
 --- failure: the condition has length > 1 ---
 --- srcref --- 
: 
 --- package (from environment) --- 
rust
 --- call from context --- 
ru(logf = gpd_logpost, ss = ss, d = 2, n = n, init = init, lower = c(0, 
    -Inf), rotate = FALSE)
 --- 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 = gpd_logpost, ss = ss, d = 2, n = n, init = init, lower = c(0, 
    -Inf), rotate = FALSE)
where 2: eval(expr, envir, enclos)
where 3: eval(expr, envir, enclos)
where 4: withVisible(eval(expr, envir, enclos))
where 5: withCallingHandlers(withVisible(eval(expr, envir, enclos)), warning = wHandler, 
    error = eHandler, message = mHandler)
where 6: handle(ev <- withCallingHandlers(withVisible(eval(expr, envir, 
    enclos)), warning = wHandler, error = eHandler, message = mHandler))
where 7: timing_fn(handle(ev <- withCallingHandlers(withVisible(eval(expr, 
    envir, enclos)), warning = wHandler, error = eHandler, message = mHandler)))
where 8: evaluate_call(expr, parsed$src[[i]], envir = envir, enclos = enclos, 
    debug = debug, last = i == length(out), use_try = stop_on_error != 
        2L, keep_warning = keep_warning, keep_message = keep_message, 
    output_handler = output_handler, include_timing = include_timing)
where 9: evaluate::evaluate(...)
where 10: evaluate(code, envir = env, new_device = FALSE, keep_warning = !isFALSE(options$warning), 
    keep_message = !isFALSE(options$message), stop_on_error = if (options$error && 
        options$include) 0L else 2L, output_handler = knit_handlers(options$render, 
        options))
where 11: in_dir(input_dir(), evaluate(code, envir = env, new_device = FALSE, 
    keep_warning = !isFALSE(options$warning), keep_message = !isFALSE(options$message), 
    stop_on_error = if (options$error && options$include) 0L else 2L, 
    output_handler = knit_handlers(options$render, options)))
where 12: block_exec(params)
where 13: call_block(x)
where 14: process_group.block(group)
where 15: process_group(group)
where 16: withCallingHandlers(if (tangle) process_tangle(group) else process_group(group), 
    error = function(e) {
        setwd(wd)
        cat(res, sep = "\n", file = output %n% "")
        message("Quitting from lines ", paste(current_lines(i), 
            collapse = "-"), " (", knit_concord$get("infile"), 
            ") ")
    })
where 17: process_file(text, output)
where 18: knitr::knit(knit_input, knit_output, envir = envir, quiet = quiet, 
    encoding = encoding)
where 19: rmarkdown::render(file, encoding = encoding, quiet = quiet, envir = globalenv(), 
    ...)
where 20: vweave_rmarkdown(...)
where 21: engine$weave(file, quiet = quiet, encoding = enc)
where 22: doTryCatch(return(expr), name, parentenv, handler)
where 23: tryCatchOne(expr, names, parentenv, handlers[[1L]])
where 24: tryCatchList(expr, classes, parentenv, handlers)
where 25: tryCatch({
    engine$weave(file, quiet = quiet, encoding = enc)
    setwd(startdir)
    output <- find_vignette_product(name, by = "weave", engine = engine)
    if (!have.makefile && vignette_is_tex(output)) {
        texi2pdf(file = output, clean = FALSE, quiet = quiet)
        output <- find_vignette_product(name, by = "texi2pdf", 
            engine = engine)
    }
}, error = function(e) {
    OK <<- FALSE
    message(gettextf("Error: processing vignette '%s' failed with diagnostics:\n%s", 
        file, conditionMessage(e)))
})
where 26: tools:::.buildOneVignette("rust-a-vignette.Rmd", "/home/hornik/tmp/R.check/r-devel-gcc/Work/PKGS/rust.Rcheck/vign_test/rust", 
    TRUE, FALSE, "rust-a-vignette", "UTF-8", "/home/hornik/tmp/scratch/RtmpBtDJSK/file1bda2d246a8e.rds")

 --- 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: 0x55622f1333a0>
<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
--- re-building ‘rust-b-when-to-use-vignette.Rmd’ using rmarkdown
 ----------- FAILURE REPORT -------------- 
 --- failure: the condition has length > 1 ---
 --- srcref --- 
: 
 --- package (from environment) --- 
rust
 --- call from context --- 
ru_rcpp(logf = ptr_gam, alpha = alpha, 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_rcpp(logf = ptr_gam, alpha = alpha, d = 1, n = 1000, trans = "BC", 
    lambda = lambda)
where 2: eval(expr, envir, enclos)
where 3: eval(expr, envir, enclos)
where 4: withVisible(eval(expr, envir, enclos))
where 5: withCallingHandlers(withVisible(eval(expr, envir, enclos)), warning = wHandler, 
    error = eHandler, message = mHandler)
where 6: handle(ev <- withCallingHandlers(withVisible(eval(expr, envir, 
    enclos)), warning = wHandler, error = eHandler, message = mHandler))
where 7: timing_fn(handle(ev <- withCallingHandlers(withVisible(eval(expr, 
    envir, enclos)), warning = wHandler, error = eHandler, message = mHandler)))
where 8: evaluate_call(expr, parsed$src[[i]], envir = envir, enclos = enclos, 
    debug = debug, last = i == length(out), use_try = stop_on_error != 
        2L, keep_warning = keep_warning, keep_message = keep_message, 
    output_handler = output_handler, include_timing = include_timing)
where 9: evaluate::evaluate(...)
where 10: evaluate(code, envir = env, new_device = FALSE, keep_warning = !isFALSE(options$warning), 
    keep_message = !isFALSE(options$message), stop_on_error = if (options$error && 
        options$include) 0L else 2L, output_handler = knit_handlers(options$render, 
        options))
where 11: in_dir(input_dir(), evaluate(code, envir = env, new_device = FALSE, 
    keep_warning = !isFALSE(options$warning), keep_message = !isFALSE(options$message), 
    stop_on_error = if (options$error && options$include) 0L else 2L, 
    output_handler = knit_handlers(options$render, options)))
where 12: block_exec(params)
where 13: call_block(x)
where 14: process_group.block(group)
where 15: process_group(group)
where 16: withCallingHandlers(if (tangle) process_tangle(group) else process_group(group), 
    error = function(e) {
        setwd(wd)
        cat(res, sep = "\n", file = output %n% "")
        message("Quitting from lines ", paste(current_lines(i), 
            collapse = "-"), " (", knit_concord$get("infile"), 
            ") ")
    })
where 17: process_file(text, output)
where 18: knitr::knit(knit_input, knit_output, envir = envir, quiet = quiet, 
    encoding = encoding)
where 19: rmarkdown::render(file, encoding = encoding, quiet = quiet, envir = globalenv(), 
    ...)
where 20: vweave_rmarkdown(...)
where 21: engine$weave(file, quiet = quiet, encoding = enc)
where 22: doTryCatch(return(expr), name, parentenv, handler)
where 23: tryCatchOne(expr, names, parentenv, handlers[[1L]])
where 24: tryCatchList(expr, classes, parentenv, handlers)
where 25: tryCatch({
    engine$weave(file, quiet = quiet, encoding = enc)
    setwd(startdir)
    output <- find_vignette_product(name, by = "weave", engine = engine)
    if (!have.makefile && vignette_is_tex(output)) {
        texi2pdf(file = output, clean = FALSE, quiet = quiet)
        output <- find_vignette_product(name, by = "texi2pdf", 
            engine = engine)
    }
}, error = function(e) {
    OK <<- FALSE
    message(gettextf("Error: processing vignette '%s' failed with diagnostics:\n%s", 
        file, conditionMessage(e)))
})
where 26: tools:::.buildOneVignette("rust-b-when-to-use-vignette.Rmd", 
    "/home/hornik/tmp/R.check/r-devel-gcc/Work/PKGS/rust.Rcheck/vign_test/rust", 
    TRUE, FALSE, "rust-b-when-to-use-vignette", "UTF-8", "/home/hornik/tmp/scratch/RtmpBtDJSK/file1bda78aaf8a5.rds")

 --- 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) 
{
    is_pointer <- (class(logf) == "externalptr")
    if (!is_pointer) {
        stop("logf must be an external pointer to a function")
    }
    pars <- list(...)
    list_depth <- function(x) {
        ifelse(is.list(x), 1L + max(sapply(x, list_depth)), 0L)
    }
    if (length(pars) > 0) {
        pars_depth <- list_depth(pars)
    }
    else {
        pars_depth <- 0
    }
    if (pars_depth > 1) {
        par_names <- names(pars)
        pars <- unlist(pars, recursive = FALSE)
        if (!is.null(par_names)) {
            keep_name <- nchar(par_names) + 2
            names(pars) <- substring(names(pars), keep_name)
        }
    }
    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
            }
            if (!is.null(lambda$user_args)) {
                user_args <- lambda$user_args
            }
            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)
    is_pointer <- (class(phi_to_theta) == "externalptr")
    if (trans == "none" & is_pointer) {
        warning("phi_to_theta() not used when trans = ``none'': identity fn used")
    }
    if (!is_pointer & !is.null(phi_to_theta)) {
        stop("phi_to_theta must be an external pointer to a function or NULL")
    }
    if (trans == "user" & is.null(phi_to_theta)) {
        stop("When trans = ``user'' phi_to_theta must be supplied")
    }
    is_pointer <- (class(log_j) == "externalptr")
    if (!is_pointer & !is.null(log_j)) {
        stop("log_j must be an external pointer to a function or NULL")
    }
    rot_mat <- diag(d)
    init_psi <- init
    if (trans == "none") {
        logf_fun <- cpp_logf_rho
        a_obj_fun <- cpp_a_obj
        lower_box_fun <- cpp_lower_box
        upper_box_fun <- cpp_upper_box
        ru_fun <- ru_cpp
        logf_args <- list(psi_mode = rep(0, d), rot_mat = diag(d), 
            hscale = 0, logf = logf, pars = pars)
        ru_args <- list(d = d, r = r)
    }
    else if (trans == "BC" & is.null(phi_to_theta)) {
        logf_fun <- cpp_logf_rho_2
        a_obj_fun <- cpp_a_obj_2
        lower_box_fun <- cpp_lower_box_2
        upper_box_fun <- cpp_upper_box_2
        ru_fun <- ru_cpp_2
        con <- lambda * gm^(lambda - 1)
        tpars <- list(which_lam = which_lam - 1, lambda = lambda, 
            gm = gm, con = con)
        tfun <- create_trans_xptr("case_2")
        if (all(lambda != 0)) {
            ptpfun <- create_psi_to_phi_xptr("no_zero")
        }
        else {
            ptpfun <- create_psi_to_phi_xptr("has_zero")
        }
        phi_to_theta <- null_phi_to_theta_xptr("no_trans")
        log_j <- create_log_jac_xptr("log_none_jac")
        logf_args <- list(psi_mode = rep(0, d), rot_mat = diag(d), 
            hscale = 0, logf = logf, pars = pars, tpars = tpars, 
            ptpfun = ptpfun, phi_to_theta = phi_to_theta, log_j = log_j, 
            user_args = user_args)
        ru_args <- list(d = d, r = r, tfun = tfun)
    }
    else if (trans == "BC" & !is.null(phi_to_theta)) {
        logf_fun <- cpp_logf_rho_3
        a_obj_fun <- cpp_a_obj_2
        lower_box_fun <- cpp_lower_box_2
        upper_box_fun <- cpp_upper_box_2
        ru_fun <- ru_cpp_3
        con <- lambda * gm^(lambda - 1)
        tpars <- list(which_lam = which_lam - 1, lambda = lambda, 
            gm = gm, con = con)
        tfun <- create_trans_xptr("case_3")
        if (all(lambda != 0)) {
            ptpfun <- create_psi_to_phi_xptr("no_zero")
        }
        else {
            ptpfun <- create_psi_to_phi_xptr("has_zero")
        }
        if (is.null(log_j)) {
            log_j <- create_log_jac_xptr("case_3")
        }
        logf_args <- list(psi_mode = rep(0, d), rot_mat = diag(d), 
            hscale = 0, logf = logf, pars = pars, tpars = tpars, 
            ptpfun = ptpfun, phi_to_theta = phi_to_theta, log_j = log_j, 
            user_args = user_args)
        ru_args <- list(d = d, r = r, tfun = tfun)
    }
    else {
        logf_fun <- cpp_logf_rho_4
        a_obj_fun <- cpp_a_obj_2
        lower_box_fun <- cpp_lower_box_2
        upper_box_fun <- cpp_upper_box_2
        ru_fun <- ru_cpp_4
        tpars <- list()
        tfun <- create_trans_xptr("case_4")
        ptpfun <- create_psi_to_phi_xptr("no_trans")
        if (is.null(log_j)) {
            log_j <- create_log_jac_xptr("case_4")
        }
        logf_args <- list(psi_mode = rep(0, d), rot_mat = diag(d), 
            hscale = 0, logf = logf, pars = pars, tpars = tpars, 
            ptpfun = ptpfun, phi_to_theta = phi_to_theta, log_j = log_j, 
            user_args = user_args)
        ru_args <- list(d = d, r = r, tfun = tfun)
    }
    logf_args$hscale <- do.call(logf_fun, c(list(rho = init_psi), 
        logf_args))
    if (is.infinite(logf_args$hscale)) {
        stop("The target density is zero at initial parameter values")
    }
    ru_args <- c(ru_args, logf_args)
    for_find_a <- list(init_psi = init_psi, lower = lower, upper = upper, 
        algor = a_algor, method = a_method, control = a_control, 
        a_obj_fun = a_obj_fun, ru_args = ru_args)
    temp <- do.call("cpp_find_a", for_find_a)
    check_finite <- do.call(logf_fun, c(list(rho = temp$par), 
        logf_args))
    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 = ""))
    }
    ru_args$hscale <- check_finite + logf_args$hscale
    logf_args$hscale <- ru_args$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)
    }
    ru_args$rot_mat <- t(rot_mat)
    ru_args$psi_mode <- f_mode
    logf_args$rot_mat <- t(rot_mat)
    logf_args$psi_mode <- f_mode
    if (rotate) {
        lower <- rep(-Inf, d)
        upper <- rep(Inf, d)
    }
    for_find_bs <- list(lower = lower, upper = upper, ep = ep, 
        vals = vals, conv = conv, algor = b_algor, method = b_method, 
        control = b_control, lower_box_fun = lower_box_fun, upper_box_fun = upper_box_fun, 
        ru_args = ru_args)
    temp <- do.call("cpp_find_bs", for_find_bs)
    vals <- temp$vals
    conv <- temp$conv
    l_box <- temp$l_box
    u_box <- temp$u_box
    box_args <- list(n = n, a_box = a_box, l_box = l_box, u_box = u_box)
    ru_args <- c(box_args, ru_args)
    ru_args$tfun <- NULL
    res <- do.call(ru_fun, ru_args)
    res$pa <- n/res$ntry
    res$ntry <- NULL
    colnames(res$sim_vals) <- var_names
    colnames(res$sim_vals_rho) <- paste("rho[", 1:d, "]", sep = "")
    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)
    if (any(conv != 0)) {
        warning("One or more convergence indicators are non-zero.", 
            immediate. = TRUE)
        print(res$box)
    }
    res$d <- d
    pars$hscale <- logf_args$hscale
    res$logf <- cpp_logf_scaled
    res$logf_args <- list(logf = logf, pars = pars)
    res$logf_rho <- logf_fun
    res$logf_rho_args <- logf_args
    res$f_mode <- f_mode
    class(res) <- "ru"
    return(res)
}
<bytecode: 0x55a2b55307a0>
<environment: namespace:rust>
 --- function search by body ---
Function ru_rcpp in namespace rust has this body.
 ----------- END OF FAILURE REPORT -------------- 
Fatal error: the condition has length > 1
--- re-building ‘rust-c-using-rcpp-vignette.Rmd’ using rmarkdown
 ----------- FAILURE REPORT -------------- 
 --- failure: the condition has length > 1 ---
 --- srcref --- 
: 
 --- package (from environment) --- 
rust
 --- call from context --- 
ru(logf = function(x) -x^2/2, d = 1, n = n, init = 0.1)
 --- 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 = function(x) -x^2/2, d = 1, n = n, init = 0.1)
where 2: eval(expr, envir, enclos)
where 3: eval(expr, envir, enclos)
where 4: withVisible(eval(expr, envir, enclos))
where 5: withCallingHandlers(withVisible(eval(expr, envir, enclos)), warning = wHandler, 
    error = eHandler, message = mHandler)
where 6: handle(ev <- withCallingHandlers(withVisible(eval(expr, envir, 
    enclos)), warning = wHandler, error = eHandler, message = mHandler))
where 7: timing_fn(handle(ev <- withCallingHandlers(withVisible(eval(expr, 
    envir, enclos)), warning = wHandler, error = eHandler, message = mHandler)))
where 8: evaluate_call(expr, parsed$src[[i]], envir = envir, enclos = enclos, 
    debug = debug, last = i == length(out), use_try = stop_on_error != 
        2L, keep_warning = keep_warning, keep_message = keep_message, 
    output_handler = output_handler, include_timing = include_timing)
where 9: evaluate::evaluate(...)
where 10: evaluate(code, envir = env, new_device = FALSE, keep_warning = !isFALSE(options$warning), 
    keep_message = !isFALSE(options$message), stop_on_error = if (options$error && 
        options$include) 0L else 2L, output_handler = knit_handlers(options$render, 
        options))
where 11: in_dir(input_dir(), evaluate(code, envir = env, new_device = FALSE, 
    keep_warning = !isFALSE(options$warning), keep_message = !isFALSE(options$message), 
    stop_on_error = if (options$error && options$include) 0L else 2L, 
    output_handler = knit_handlers(options$render, options)))
where 12: block_exec(params)
where 13: call_block(x)
where 14: process_group.block(group)
where 15: process_group(group)
where 16: withCallingHandlers(if (tangle) process_tangle(group) else process_group(group), 
    error = function(e) {
        setwd(wd)
        cat(res, sep = "\n", file = output %n% "")
        message("Quitting from lines ", paste(current_lines(i), 
            collapse = "-"), " (", knit_concord$get("infile"), 
            ") ")
    })
where 17: process_file(text, output)
where 18: knitr::knit(knit_input, knit_output, envir = envir, quiet = quiet, 
    encoding = encoding)
where 19: rmarkdown::render(file, encoding = encoding, quiet = quiet, envir = globalenv(), 
    ...)
where 20: vweave_rmarkdown(...)
where 21: engine$weave(file, quiet = quiet, encoding = enc)
where 22: doTryCatch(return(expr), name, parentenv, handler)
where 23: tryCatchOne(expr, names, parentenv, handlers[[1L]])
where 24: tryCatchList(expr, classes, parentenv, handlers)
where 25: tryCatch({
    engine$weave(file, quiet = quiet, encoding = enc)
    setwd(startdir)
    output <- find_vignette_product(name, by = "weave", engine = engine)
    if (!have.makefile && vignette_is_tex(output)) {
        texi2pdf(file = output, clean = FALSE, quiet = quiet)
        output <- find_vignette_product(name, by = "texi2pdf", 
            engine = engine)
    }
}, error = function(e) {
    OK <<- FALSE
    message(gettextf("Error: processing vignette '%s' failed with diagnostics:\n%s", 
        file, conditionMessage(e)))
})
where 26: tools:::.buildOneVignette("rust-c-using-rcpp-vignette.Rmd", "/home/hornik/tmp/R.check/r-devel-gcc/Work/PKGS/rust.Rcheck/vign_test/rust", 
    TRUE, FALSE, "rust-c-using-rcpp-vignette", "UTF-8", "/home/hornik/tmp/scratch/RtmpBtDJSK/file1bda475d6104.rds")

 --- 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: 0x56038dd3c0a0>
<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
SUMMARY: processing the following files failed:
  ‘rust-a-vignette.Rmd’ ‘rust-b-when-to-use-vignette.Rmd’
  ‘rust-c-using-rcpp-vignette.Rmd’

Error: Vignette re-building failed.
Execution halted