Running ‘testthat.R’ [4s/19s]
Running the tests in ‘tests/testthat.R’ failed.
Complete output:
  > library(testthat)
  > library(revdbayes)
  > 
  > test_check("revdbayes")
  
   *** caught segfault ***
  address b, cause 'memory not mapped'
  
  Traceback:
   1: (function (rho, psi_mode, rot_mat, hscale, logf, pars) {    .Call(`_rust_cpp_logf_rho`, rho, psi_mode, rot_mat, hscale,         logf, pars)})(rho = c(3.87474732869604, 0.198044154255893, -0.0501159884173341), psi_mode = c(0, 0, 0), rot_mat = c(1, 0, 0, 0, 1, 0, 0, 0, 1), hscale = 0, logf = <pointer: 91224c0>, pars = list(data = c(4.03, 3.83, 3.65, 3.88, 4.01, 4.08, 4.18, 3.8, 4.36, 3.96, 3.98, 4.69, 3.85, 3.96, 3.85, 3.93, 3.75, 3.63, 3.57, 4.25, 3.97, 4.05, 4.24, 4.22, 3.73, 4.37, 4.06, 3.71, 3.96, 4.06, 4.55, 3.79, 3.89, 4.11, 3.85, 3.86, 3.86, 4.21, 4.01, 4.11, 4.24, 3.96, 4.21, 3.74, 3.85, 3.88, 3.66, 4.11, 3.71, 4.18, 3.9, 3.78, 3.91, 3.72, 4, 3.66, 3.62, 4.33, 4.55, 3.75, 4.08, 3.9, 3.88, 3.94, 4.33), m = 65L,     x1 = 3.57, xm = 4.69, sum_gev = 258.74, prior = "gev_norm",     mean = c(0, 0, 0), min_xi = -Inf, max_xi = Inf, icov = c(1e-04,     0, 0, 1e-04, 0, 0.01), trendsd = 0))
   2: do.call(logf_fun, c(list(rho = init_psi), logf_args))
   3: (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, shoof = 0.2) {    Call <- match.call(expand.dots = TRUE)    if (shoof < 0 || shoof > 1) {        stop("''shoof'' must be in [0, 1]")    }    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, shoof = shoof)    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 (inherits(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, shoof = shoof)    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    res$call <- Call    class(res) <- "ru"    return(res)})(logf = <pointer: 91224c0>, pars = list(data = c(4.03, 3.83, 3.65, 3.88, 4.01, 4.08, 4.18, 3.8, 4.36, 3.96, 3.98, 4.69, 3.85, 3.96, 3.85, 3.93, 3.75, 3.63, 3.57, 4.25, 3.97, 4.05, 4.24, 4.22, 3.73, 4.37, 4.06, 3.71, 3.96, 4.06, 4.55, 3.79, 3.89, 4.11, 3.85, 3.86, 3.86, 4.21, 4.01, 4.11, 4.24, 3.96, 4.21, 3.74, 3.85, 3.88, 3.66, 4.11, 3.71, 4.18, 3.9, 3.78, 3.91, 3.72, 4, 3.66, 3.62, 4.33, 4.55, 3.75, 4.08, 3.9, 3.88, 3.94, 4.33), m = 65L, x1 = 3.57,     xm = 4.69, sum_gev = 258.74, prior = "gev_norm", mean = c(0,     0, 0), min_xi = -Inf, max_xi = Inf, icov = c(1e-04, 0, 0,     1e-04, 0, 0.01), trendsd = 0), d = 3L, lower = c(-Inf, 0, -Inf), upper = c(Inf, Inf, Inf), var_names = c("mu", "sigma", "xi"), init = c(3.87474732869604, 0.198044154255893, -0.0501159884173341), n = 1000, trans = "none", rotate = TRUE, a_control = list(    parscale = c(0.0279322160982677, 0.0202469866504748, 0.0982511148314855    )))
   4: do.call(rust::ru_rcpp, for_ru_rcpp)
   5: rpost_rcpp(n = 1000, model = "gev", prior = pn, data = portpirie)
   6: eval(code, test_env)
   7: eval(code, test_env)
   8: withCallingHandlers({    eval(code, test_env)    if (!handled && !is.null(test)) {        skip_empty()    }}, expectation = handle_expectation, skip = handle_skip, warning = handle_warning,     message = handle_message, error = handle_error)
   9: doTryCatch(return(expr), name, parentenv, handler)
  10: tryCatchOne(expr, names, parentenv, handlers[[1L]])
  11: tryCatchList(expr, names[-nh], parentenv, handlers[-nh])
  12: doTryCatch(return(expr), name, parentenv, handler)
  13: tryCatchOne(tryCatchList(expr, names[-nh], parentenv, handlers[-nh]),     names[nh], parentenv, handlers[[nh]])
  14: tryCatchList(expr, classes, parentenv, handlers)
  15: tryCatch(withCallingHandlers({    eval(code, test_env)    if (!handled && !is.null(test)) {        skip_empty()    }}, expectation = handle_expectation, skip = handle_skip, warning = handle_warning,     message = handle_message, error = handle_error), error = handle_fatal,     skip = function(e) {    })
  16: test_code(NULL, exprs, env)
  17: source_file(path, child_env(env), wrap = wrap)
  18: FUN(X[[i]], ...)
  19: lapply(test_paths, test_one_file, env = env, wrap = wrap)
  20: force(code)
  21: doWithOneRestart(return(expr), restart)
  22: withOneRestart(expr, restarts[[1L]])
  23: withRestarts(testthat_abort_reporter = function() NULL, force(code))
  24: with_reporter(reporters$multi, lapply(test_paths, test_one_file,     env = env, wrap = wrap))
  25: test_files(test_dir = test_dir, test_package = test_package,     test_paths = test_paths, load_helpers = load_helpers, reporter = reporter,     env = env, stop_on_failure = stop_on_failure, stop_on_warning = stop_on_warning,     wrap = wrap, load_package = load_package)
  26: test_files(test_dir = path, test_paths = test_paths, test_package = package,     reporter = reporter, load_helpers = load_helpers, env = env,     stop_on_failure = stop_on_failure, stop_on_warning = stop_on_warning,     wrap = wrap, load_package = load_package, parallel = parallel)
  27: test_dir("testthat", package = package, reporter = reporter,     ..., load_package = "installed")
  28: test_check("revdbayes")
  An irrecoverable exception occurred. R is aborting now ...