Last updated on 2026-10-24 01:52:03 CEST.
| Package | OK | ERROR |
|---|---|---|
| adaptDiag | 13 | |
| bayesDP | 13 | |
| goldilocks | 12 | 1 |
| joineR | 13 | |
| joineRML | 12 | 1 |
Current CRAN status: OK: 13
Current CRAN status: OK: 13
Current CRAN status: OK: 12, ERROR: 1
Version: 1.0.0
Check: re-building of vignette outputs
Result: ERROR
Error(s) in re-building vignettes:
--- re-building ‘advent.Rmd’ using rmarkdown
*** caught segfault ***
address 0x110, cause 'invalid permissions'
Traceback:
1: impute_predictive_arm(time = rep.int(0, length(future_treatment)), hazards = treatment_hazards, random_input = random_inputs$future_treatment, end_of_study = end_of_study, cutpoints = cutpoints, binary_imputation = binary_imputation)
2: fill_predictive_imputations(imputations = future, rows = future_treatment, values = impute_predictive_arm(time = rep.int(0, length(future_treatment)), hazards = treatment_hazards, random_input = random_inputs$future_treatment, end_of_study = end_of_study, cutpoints = cutpoints, binary_imputation = binary_imputation))
3: impute_predictive_draws(data_in = data_interim, hazards = post_lambda, end_of_study = end_of_study, cutpoints = cutpoints, single_arm = single_arm, binary_imputation = predictive_binary_imputation, check_futility = check_futility)
4: evaluate_interim_decision(data_interim = data_interim, look = i, planned_N = analysis_at_enrollnumber[i], calendar_time = look_time, active_followup = active_followup_at(data_total, look_time), end_of_study = end_of_study, rmst_tau = rmst_tau, cutpoints = cutpoints, single_arm = single_arm, prior_surv = prior_surv, prior_surv_final = prior_surv_final, prior_bin = prior_bin, bin_method = bin_method, alternative = alternative, h0 = h0, Fn = Fn[i], Sn = Sn[i], prob_ha = prob_ha, N_impute = N_impute, N_mcmc = N_mcmc, mc_conf_level = mc_conf_level, empty_interval = empty_interval, method = method, binary_imputation = binary_imputation, check_futility = check_futility, Qn = Qn[i])
5: survival_adapt_fn(hazard_treatment = hazard_treatment, hazard_control = hazard_control, cutpoints = cutpoints, N_total = N_total, lambda = lambda, lambda_time = lambda_time, interim_look = interim_look, end_of_study = end_of_study, prior_surv = prior_surv, prior_bin = prior_bin, bin_method = bin_method, binary_imputation = binary_imputation, block = block, rand_ratio = rand_ratio, prop_loss = prop_loss, alternative = alternative, h0 = h0, Fn = Fn, Sn = Sn, Qn = Qn, prob_ha = prob_ha, N_impute = N_impute, N_mcmc = N_mcmc, mc_conf_level = mc_conf_level, method = method, imputed_final = imputed_final, empty_interval = empty_interval, return_trace = return_trace, prior_surv_final = prior_surv_final, generation_cutpoints = generation_cutpoints, rmst_tau = rmst_tau)
6: doTryCatch(return(expr), name, parentenv, handler)
7: tryCatchOne(expr, names, parentenv, handlers[[1L]])
8: tryCatchList(expr, classes, parentenv, handlers)
9: tryCatch({ if (!is.null(trial_streams)) { assign(".Random.seed", trial_streams[[x]], envir = .GlobalEnv) } result <- survival_adapt_fn(hazard_treatment = hazard_treatment, hazard_control = hazard_control, cutpoints = cutpoints, N_total = N_total, lambda = lambda, lambda_time = lambda_time, interim_look = interim_look, end_of_study = end_of_study, prior_surv = prior_surv, prior_bin = prior_bin, bin_method = bin_method, binary_imputation = binary_imputation, block = block, rand_ratio = rand_ratio, prop_loss = prop_loss, alternative = alternative, h0 = h0, Fn = Fn, Sn = Sn, Qn = Qn, prob_ha = prob_ha, N_impute = N_impute, N_mcmc = N_mcmc, mc_conf_level = mc_conf_level, method = method, imputed_final = imputed_final, empty_interval = empty_interval, return_trace = return_trace, prior_surv_final = prior_surv_final, generation_cutpoints = generation_cutpoints, rmst_tau = rmst_tau) attr(result, "arguments") <- NULL if (inherits(result, "goldilocks_trial")) { attr(result$summary, "arguments") <- NULL } list(trial = as.integer(x), result = result)}, error = function(error) { list(trial = as.integer(x), result = NULL, error_class = class(error)[1L], message = conditionMessage(error))})
10: FUN(X[[i]], ...)
11: lapply(X = S, FUN = FUN, ...)
12: doTryCatch(return(expr), name, parentenv, handler)
13: tryCatchOne(expr, names, parentenv, handlers[[1L]])
14: tryCatchList(expr, classes, parentenv, handlers)
15: tryCatch(expr, error = function(e) { call <- conditionCall(e) if (!is.null(call)) { if (identical(call[[1L]], quote(doTryCatch))) call <- sys.call(-4L) dcall <- deparse(call, nlines = 1L) prefix <- paste("Error in", dcall, ": ") LONG <- 75L sm <- strsplit(conditionMessage(e), "\n")[[1L]] w <- 14L + nchar(dcall, type = "w") + nchar(sm[1L], type = "w") if (is.na(w)) w <- 14L + nchar(dcall, type = "b") + nchar(sm[1L], type = "b") if (w > LONG) prefix <- paste0(prefix, "\n ") } else prefix <- "Error : " msg <- paste0(prefix, conditionMessage(e), "\n") .Internal(seterrmessage(msg[1L])) if (!silent && isTRUE(getOption("show.error.messages"))) { cat(msg, file = outFile) .Internal(printDeferredWarnings()) } invisible(structure(msg, class = "try-error", condition = e))})
16: try(lapply(X = S, FUN = FUN, ...), silent = TRUE)
17: sendMaster(try(lapply(X = S, FUN = FUN, ...), silent = TRUE))
18: FUN(X[[i]], ...)
19: lapply(seq_len(cores), inner.do)
20: mclapply(X, FUN, ..., mc.cores = mc.cores, mc.preschedule = mc.preschedule, mc.set.seed = mc.set.seed, mc.cleanup = mc.cleanup, mc.allow.recursive = mc.allow.recursive)
21: pbmclapply(trial_index, survival_adapt_wrapper, mc.cores = workers)
22: (function (hazard_treatment, hazard_control = NULL, cutpoints = NULL, N_total, lambda = 0.3, lambda_time = NULL, interim_look = NULL, end_of_study, prior_surv = c(0.1, 0.1), prior_bin = c(1, 1), bin_method = "mc", block = 2, rand_ratio = c(control = 1, treatment = 1), prop_loss = 0, alternative = "greater", h0 = 0, Fn = 0.05, Sn = 0.9, prob_ha = 0.95, N_impute = 500, N_mcmc = 1000, mc_conf_level = 0.95, N_trials = 10, method = "logrank", imputed_final = FALSE, empty_interval = c("prior", "propagate", "error"), return_trace = FALSE, ncores = 1L, backend = c("auto", "fork", "psock", "sequential"), seed = NULL, binary_imputation = c("event-time", "bernoulli"), prior_surv_final = prior_surv, generation_cutpoints = cutpoints, Qn = 1, rmst_tau = end_of_study) { Call <- match.call() Arguments <- capture_arguments(sim_trials, environment()) method <- normalize_analysis_method(method) Arguments$method <- method empty_interval <- match.arg(empty_interval) binary_imputation <- match.arg(binary_imputation) backend <- match.arg(backend) Arguments$empty_interval <- empty_interval Arguments$binary_imputation <- binary_imputation Arguments$backend <- backend requested_backend <- backend caller_rng_kind <- RNGkind() validate_positive_integer_scalar(N_trials, "N_trials") single_arm <- is.null(hazard_control) if (!single_arm) { rand_ratio <- validate_randomization_args(N_total, block, rand_ratio, allocation_name = "rand_ratio") Arguments$rand_ratio <- rand_ratio } prop_loss <- normalize_prop_loss(prop_loss, single_arm = single_arm) Arguments$prop_loss <- prop_loss validate_logical_scalar(return_trace, "return_trace") validate_positive_integer_scalar(N_impute, "N_impute") validate_positive_integer_scalar(N_mcmc, "N_mcmc") validate_single_probability(mc_conf_level, "mc_conf_level", upper_open = TRUE) if (mc_conf_level <= 0.5) { stop("'mc_conf_level' must be greater than 0.5 and less than 1") } validate_final_imputation(method, imputed_final, has_missing_outcomes = any(prop_loss > 0), N_impute = N_impute) if (identical(method, "rmst")) { validate_endpoint_time(end_of_study, cutpoints, "end_of_study") validate_rmst_args(rmst_tau, end_of_study, h0) validate_analysis_configuration(method, alternative, is.null(hazard_control), imputed_final) } validate_positive_integer_scalar(ncores, "ncores") execution <- resolve_sim_execution(backend = backend, ncores = ncores, N_trials = N_trials) backend <- execution$backend workers <- execution$workers stream_seed <- NULL if (!is.null(seed)) { if (length(seed) != 1 || !is.numeric(seed) || is.na(seed) || !is.finite(seed) || seed != floor(seed)) { stop("'seed' must be NULL or a single integer value") } old_kind <- RNGkind() old_seed_exists <- exists(".Random.seed", envir = .GlobalEnv, inherits = FALSE) if (old_seed_exists) { old_seed <- get(".Random.seed", envir = .GlobalEnv, inherits = FALSE) } on.exit({ do.call(RNGkind, as.list(old_kind)) if (old_seed_exists) { assign(".Random.seed", old_seed, envir = .GlobalEnv) } else if (exists(".Random.seed", envir = .GlobalEnv, inherits = FALSE)) { rm(".Random.seed", envir = .GlobalEnv) } }, add = TRUE) stream_seed <- seed trial_streams <- make_rng_streams(stream_seed, N_trials) } else if (backend == "psock") { stream_seed <- sample.int(.Machine$integer.max - 1L, size = 1L) trial_streams <- make_rng_streams(stream_seed, N_trials) } else { trial_streams <- NULL } rng_metadata <- list(caller_kind = caller_rng_kind, stream_kind = if (is.null(trial_streams)) { caller_rng_kind[1] } else { "L'Ecuyer-CMRG" }, seed_policy = if (!is.null(seed)) { "explicit_preserve_caller" } else if (backend == "psock") { "caller_derived_psock" } else { "caller_state" }, backend = backend, ncores = as.integer(workers), requested_ncores = as.integer(ncores), stream_seed = stream_seed) survival_adapt_fn <- if (backend == "psock") { make_psock_callable("survival_adapt") } else { survival_adapt } survival_adapt_wrapper <- function(x) { tryCatch({ if (!is.null(trial_streams)) { assign(".Random.seed", trial_streams[[x]], envir = .GlobalEnv) } result <- survival_adapt_fn(hazard_treatment = hazard_treatment, hazard_control = hazard_control, cutpoints = cutpoints, N_total = N_total, lambda = lambda, lambda_time = lambda_time, interim_look = interim_look, end_of_study = end_of_study, prior_surv = prior_surv, prior_bin = prior_bin, bin_method = bin_method, binary_imputation = binary_imputation, block = block, rand_ratio = rand_ratio, prop_loss = prop_loss, alternative = alternative, h0 = h0, Fn = Fn, Sn = Sn, Qn = Qn, prob_ha = prob_ha, N_impute = N_impute, N_mcmc = N_mcmc, mc_conf_level = mc_conf_level, method = method, imputed_final = imputed_final, empty_interval = empty_interval, return_trace = return_trace, prior_surv_final = prior_surv_final, generation_cutpoints = generation_cutpoints, rmst_tau = rmst_tau) attr(result, "arguments") <- NULL if (inherits(result, "goldilocks_trial")) { attr(result$summary, "arguments") <- NULL } list(trial = as.integer(x), result = result) }, error = function(error) { list(trial = as.integer(x), result = NULL, error_class = class(error)[1L], message = conditionMessage(error)) }) } trial_index <- seq_len(N_trials) trial_results <- switch(backend, sequential = lapply(trial_index, survival_adapt_wrapper), fork = pbmclapply(trial_index, survival_adapt_wrapper, mc.cores = workers), psock = { active_cluster <- make_sim_cluster(workers) on.exit(stop_sim_cluster(active_cluster), add = TRUE) initialize_sim_cluster(active_cluster) run_sim_cluster(active_cluster, trial_index, survival_adapt_wrapper) }) failed <- vapply(trial_results, function(x) is.null(x$result), logical(1)) failed_results <- trial_results[failed] failures <- data.frame(trial = vapply(failed_results, `[[`, integer(1), "trial"), error_class = vapply(failed_results, `[[`, character(1), "error_class"), message = vapply(failed_results, `[[`, character(1), "message"), stringsAsFactors = FALSE) if (all(failed)) { error <- simpleError(paste0("All ", N_trials, " simulated trials failed. First error: ", failures$message[1L])) error$failures <- failures class(error) <- c("goldilocks_all_trials_failed", class(error)) stop(error) } successful_trials <- trial_results[!failed] successful_results <- lapply(successful_trials, `[[`, "result") if (return_trace) { sims <- bind_rows(lapply(successful_results, function(x) x$summary)) traces <- bind_rows(lapply(seq_along(successful_results), function(i) { trace <- successful_results[[i]]$trace trial <- successful_trials[[i]]$trial trace$trial <- rep.int(trial, nrow(trace)) trace[c("trial", setdiff(names(trace), "trial"))] })) out <- list(sims = sims, traces = traces, failures = failures, call = Call) } else { sims <- bind_rows(successful_results) out <- list(sims = sims, failures = failures, call = Call) } attr(out$sims, "arguments") <- NULL attr(out, "enrollment_design") <- new_enrollment_design(lambda = lambda, N_total = N_total, lambda_time = lambda_time, interim_look = interim_look, end_of_study = end_of_study) attr(out, "decision_design") <- attr(successful_results[[1]], "decision_design", exact = TRUE) attr(out, "prior_design") <- attr(successful_results[[1]], "prior_design", exact = TRUE) attr(out, "rng_metadata") <- rng_metadata attr(out, "arguments") <- Arguments attr(out, "parallel_metadata") <- list(requested_backend = requested_backend, backend = backend, selection_reason = execution$reason, requested_ncores = as.integer(ncores), workers = as.integer(workers), tasks = as.integer(N_trials)) if (nrow(failures) > 0L) { warning(nrow(failures), " of ", N_trials, " simulated trials failed and were excluded. See `result$failures` ", "for details.", call. = FALSE) } return(out)})(N_total = 750, lambda = c(0.0666666666666667, 0.166666666666667, 0.333333333333333, 0.5, 0.666666666666667, 0.833333333333333, 1, 1.1), lambda_time = c(30L, 60L, 90L, 120L, 150L, 180L, 210L), interim_look = c(350, 450, 550, 650), end_of_study = 360L, prior_surv = c(0.5, 0.001, 0.5, 0.001, 0.5, 0.001, 0.5, 0.001, 5, 10000), prior_surv_final = c(shape = 0.5, rate = 0.001 ), prior_bin = c(0.5, 0.5), bin_method = "quadrature", block = 2, rand_ratio = c(control = 1, treatment = 1), alternative = "less", Fn = c(0.05, 0.1, 0.1, 0.1), Sn = c(0.95, 0.9, 0.85, 0.8), N_impute = 30, empty_interval = "prior", method = "bayes-bin", imputed_final = TRUE, ncores = 2, cutpoints = c(90, 104, 150, 210), prop_loss = 0.075, N_trials = 500, hazard_treatment = c(0.00011167, 0.002197976, 0.003163208, 0.002839089, 0.000494053), hazard_control = c(0.00011167, 0.002197976, 0.003163208, 0.002839089, 0.000494053), h0 = 0.15, prob_ha = 0.956, return_trace = TRUE, seed = 4610)
23: do.call(sim_trials, c(advent_effectiveness_args, list(N_trials = 500, hazard_treatment = eff_hazard_per_day, hazard_control = eff_hazard_per_day, h0 = 0.15, prob_ha = 0.956, return_trace = TRUE, seed = 4610)))
24: eval(expr, envir)
25: eval(expr, envir)
26: withVisible(eval(expr, envir))
27: withCallingHandlers(code, error = function (e) rlang::entrace(e), message = function (cnd) { watcher$capture_plot_and_output() if (on_message$capture) { watcher$push(cnd) } if (on_message$silence) { invokeRestart("muffleMessage") }}, warning = function (cnd) { if (getOption("warn") >= 2 || getOption("warn") < 0) { return() } watcher$capture_plot_and_output() if (on_warning$capture) { cnd <- sanitize_call(cnd) watcher$push(cnd) } if (on_warning$silence) { invokeRestart("muffleWarning") }}, error = function (cnd) { watcher$capture_plot_and_output() cnd <- sanitize_call(cnd) watcher$push(cnd) switch(on_error, continue = invokeRestart("eval_continue"), stop = invokeRestart("eval_stop"), error = NULL)})
28: eval(call)
29: eval(call)
30: with_handlers({ for (expr in tle$exprs) { ev <- withVisible(eval(expr, envir)) watcher$capture_plot_and_output() watcher$print_value(ev$value, ev$visible, envir) } TRUE}, handlers)
31: doWithOneRestart(return(expr), restart)
32: withOneRestart(expr, restarts[[1L]])
33: withRestartList(expr, restarts[-nr])
34: doWithOneRestart(return(expr), restart)
35: withOneRestart(withRestartList(expr, restarts[-nr]), restarts[[nr]])
36: withRestartList(expr, restarts)
37: withRestarts(with_handlers({ for (expr in tle$exprs) { ev <- withVisible(eval(expr, envir)) watcher$capture_plot_and_output() watcher$print_value(ev$value, ev$visible, envir) } TRUE}, handlers), eval_continue = function() TRUE, eval_stop = function() FALSE)
38: evaluate::evaluate(...)
39: evaluate(code, envir = env, new_device = FALSE, keep_warning = if (is.numeric(options$warning)) TRUE else options$warning, keep_message = if (is.numeric(options$message)) TRUE else options$message, stop_on_error = if (is.numeric(options$error)) options$error else { if (options$error && options$include) 0L else 2L }, output_handler = knit_handlers(options$render, options))
40: in_dir(input_dir(), expr)
41: in_input_dir(evaluate(code, envir = env, new_device = FALSE, keep_warning = if (is.numeric(options$warning)) TRUE else options$warning, keep_message = if (is.numeric(options$message)) TRUE else options$message, stop_on_error = if (is.numeric(options$error)) options$error else { if (options$error && options$include) 0L else 2L }, output_handler = knit_handlers(options$render, options)))
42: eng_r(options)
43: block_exec(params)
44: call_block(x)
45: process_group(group)
46: withCallingHandlers(if (tangle) process_tangle(group) else process_group(group), error = function(e) { if (progress && is.function(pb$interrupt)) pb$interrupt() if (is_R_CMD_build() || is_R_CMD_check()) error <<- format(e) })
47: with_options(withCallingHandlers(if (tangle) process_tangle(group) else process_group(group), error = function(e) { if (progress && is.function(pb$interrupt)) pb$interrupt() if (is_R_CMD_build() || is_R_CMD_check()) error <<- format(e) }), list(rlang_trace_top_env = knit_global()))
48: xfun:::handle_error(with_options(withCallingHandlers(if (tangle) process_tangle(group) else process_group(group), error = function(e) { if (progress && is.function(pb$interrupt)) pb$interrupt() if (is_R_CMD_build() || is_R_CMD_check()) error <<- format(e) }), list(rlang_trace_top_env = knit_global())), function(loc) { setwd(wd) write_utf8(res, output %n% stdout()) paste0("\nQuitting from ", loc, if (!is.null(error)) paste0("\n", rule(), error, "\n", rule()))}, if (labels[i] != "") sprintf(" [%s]", labels[i]), get_loc)
49: process_file(text, output)
50: knitr::knit(knit_input, knit_output, envir = envir, quiet = quiet)
51: rmarkdown::render(file, encoding = encoding, quiet = quiet, envir = globalenv(), output_dir = getwd(), ...)
52: vweave_rmarkdown(...)
53: engine$weave(file, quiet = quiet, encoding = enc)
54: doTryCatch(return(expr), name, parentenv, handler)
55: tryCatchOne(expr, names, parentenv, handlers[[1L]])
56: tryCatchList(expr, classes, parentenv, handlers)
57: 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)))})
58: tools:::.buildOneVignette("advent.Rmd", "/Volumes/Builds/packages/big-sur-arm64/results/4.5/goldilocks.Rcheck/vign_test/goldilocks", TRUE, TRUE, "advent", "UTF-8", "/Volumes/Temp/tmp/RtmpdfuMxk/file46cb7305411c.rds")
An irrecoverable exception occurred. R is aborting now ...
*** caught segfault ***
address 0x110, cause 'invalid permissions'
Traceback:
1: impute_predictive_arm(time = rep.int(0, length(future_treatment)), hazards = treatment_hazards, random_input = random_inputs$future_treatment, end_of_study = end_of_study, cutpoints = cutpoints, binary_imputation = binary_imputation)
2: fill_predictive_imputations(imputations = future, rows = future_treatment, values = impute_predictive_arm(time = rep.int(0, length(future_treatment)), hazards = treatment_hazards, random_input = random_inputs$future_treatment, end_of_study = end_of_study, cutpoints = cutpoints, binary_imputation = binary_imputation))
3: impute_predictive_draws(data_in = data_interim, hazards = post_lambda, end_of_study = end_of_study, cutpoints = cutpoints, single_arm = single_arm, binary_imputation = predictive_binary_imputation, check_futility = check_futility)
4: evaluate_interim_decision(data_interim = data_interim, look = i, planned_N = analysis_at_enrollnumber[i], calendar_time = look_time, active_followup = active_followup_at(data_total, look_time), end_of_study = end_of_study, rmst_tau = rmst_tau, cutpoints = cutpoints, single_arm = single_arm, prior_surv = prior_surv, prior_surv_final = prior_surv_final, prior_bin = prior_bin, bin_method = bin_method, alternative = alternative, h0 = h0, Fn = Fn[i], Sn = Sn[i], prob_ha = prob_ha, N_impute = N_impute, N_mcmc = N_mcmc, mc_conf_level = mc_conf_level, empty_interval = empty_interval, method = method, binary_imputation = binary_imputation, check_futility = check_futility, Qn = Qn[i])
5: survival_adapt_fn(hazard_treatment = hazard_treatment, hazard_control = hazard_control, cutpoints = cutpoints, N_total = N_total, lambda = lambda, lambda_time = lambda_time, interim_look = interim_look, end_of_study = end_of_study, prior_surv = prior_surv, prior_bin = prior_bin, bin_method = bin_method, binary_imputation = binary_imputation, block = block, rand_ratio = rand_ratio, prop_loss = prop_loss, alternative = alternative, h0 = h0, Fn = Fn, Sn = Sn, Qn = Qn, prob_ha = prob_ha, N_impute = N_impute, N_mcmc = N_mcmc, mc_conf_level = mc_conf_level, method = method, imputed_final = imputed_final, empty_interval = empty_interval, return_trace = return_trace, prior_surv_final = prior_surv_final, generation_cutpoints = generation_cutpoints, rmst_tau = rmst_tau)
6: doTryCatch(return(expr), name, parentenv, handler)
7: tryCatchOne(expr, names, parentenv, handlers[[1L]])
8: tryCatchList(expr, classes, parentenv, handlers)
9: tryCatch({ if (!is.null(trial_streams)) { assign(".Random.seed", trial_streams[[x]], envir = .GlobalEnv) } result <- survival_adapt_fn(hazard_treatment = hazard_treatment, hazard_control = hazard_control, cutpoints = cutpoints, N_total = N_total, lambda = lambda, lambda_time = lambda_time, interim_look = interim_look, end_of_study = end_of_study, prior_surv = prior_surv, prior_bin = prior_bin, bin_method = bin_method, binary_imputation = binary_imputation, block = block, rand_ratio = rand_ratio, prop_loss = prop_loss, alternative = alternative, h0 = h0, Fn = Fn, Sn = Sn, Qn = Qn, prob_ha = prob_ha, N_impute = N_impute, N_mcmc = N_mcmc, mc_conf_level = mc_conf_level, method = method, imputed_final = imputed_final, empty_interval = empty_interval, return_trace = return_trace, prior_surv_final = prior_surv_final, generation_cutpoints = generation_cutpoints, rmst_tau = rmst_tau) attr(result, "arguments") <- NULL if (inherits(result, "goldilocks_trial")) { attr(result$summary, "arguments") <- NULL } list(trial = as.integer(x), result = result)}, error = function(error) { list(trial = as.integer(x), result = NULL, error_class = class(error)[1L], message = conditionMessage(error))})
10: FUN(X[[i]], ...)
11: lapply(X = S, FUN = FUN, ...)
12: doTryCatch(return(expr), name, parentenv, handler)
13: tryCatchOne(expr, names, parentenv, handlers[[1L]])
14: tryCatchList(expr, classes, parentenv, handlers)
15: tryCatch(expr, error = function(e) { call <- conditionCall(e) if (!is.null(call)) { if (identical(call[[1L]], quote(doTryCatch))) call <- sys.call(-4L) dcall <- deparse(call, nlines = 1L) prefix <- paste("Error in", dcall, ": ") LONG <- 75L sm <- strsplit(conditionMessage(e), "\n")[[1L]] w <- 14L + nchar(dcall, type = "w") + nchar(sm[1L], type = "w") if (is.na(w)) w <- 14L + nchar(dcall, type = "b") + nchar(sm[1L], type = "b") if (w > LONG) prefix <- paste0(prefix, "\n ") } else prefix <- "Error : " msg <- paste0(prefix, conditionMessage(e), "\n") .Internal(seterrmessage(msg[1L])) if (!silent && isTRUE(getOption("show.error.messages"))) { cat(msg, file = outFile) .Internal(printDeferredWarnings()) } invisible(structure(msg, class = "try-error", condition = e))})
16: try(lapply(X = S, FUN = FUN, ...), silent = TRUE)
17: sendMaster(try(lapply(X = S, FUN = FUN, ...), silent = TRUE))
18: FUN(X[[i]], ...)
19: lapply(seq_len(cores), inner.do)
20: mclapply(X, FUN, ..., mc.cores = mc.cores, mc.preschedule = mc.preschedule, mc.set.seed = mc.set.seed, mc.cleanup = mc.cleanup, mc.allow.recursive = mc.allow.recursive)
21: pbmclapply(trial_index, survival_adapt_wrapper, mc.cores = workers)
22: (function (hazard_treatment, hazard_control = NULL, cutpoints = NULL, N_total, lambda = 0.3, lambda_time = NULL, interim_look = NULL, end_of_study, prior_surv = c(0.1, 0.1), prior_bin = c(1, 1), bin_method = "mc", block = 2, rand_ratio = c(control = 1, treatment = 1), prop_loss = 0, alternative = "greater", h0 = 0, Fn = 0.05, Sn = 0.9, prob_ha = 0.95, N_impute = 500, N_mcmc = 1000, mc_conf_level = 0.95, N_trials = 10, method = "logrank", imputed_final = FALSE, empty_interval = c("prior", "propagate", "error"), return_trace = FALSE, ncores = 1L, backend = c("auto", "fork", "psock", "sequential"), seed = NULL, binary_imputation = c("event-time", "bernoulli"), prior_surv_final = prior_surv, generation_cutpoints = cutpoints, Qn = 1, rmst_tau = end_of_study) { Call <- match.call() Arguments <- capture_arguments(sim_trials, environment()) method <- normalize_analysis_method(method) Arguments$method <- method empty_interval <- match.arg(empty_interval) binary_imputation <- match.arg(binary_imputation) backend <- match.arg(backend) Arguments$empty_interval <- empty_interval Arguments$binary_imputation <- binary_imputation Arguments$backend <- backend requested_backend <- backend caller_rng_kind <- RNGkind() validate_positive_integer_scalar(N_trials, "N_trials") single_arm <- is.null(hazard_control) if (!single_arm) { rand_ratio <- validate_randomization_args(N_total, block, rand_ratio, allocation_name = "rand_ratio") Arguments$rand_ratio <- rand_ratio } prop_loss <- normalize_prop_loss(prop_loss, single_arm = single_arm) Arguments$prop_loss <- prop_loss validate_logical_scalar(return_trace, "return_trace") validate_positive_integer_scalar(N_impute, "N_impute") validate_positive_integer_scalar(N_mcmc, "N_mcmc") validate_single_probability(mc_conf_level, "mc_conf_level", upper_open = TRUE) if (mc_conf_level <= 0.5) { stop("'mc_conf_level' must be greater than 0.5 and less than 1") } validate_final_imputation(method, imputed_final, has_missing_outcomes = any(prop_loss > 0), N_impute = N_impute) if (identical(method, "rmst")) { validate_endpoint_time(end_of_study, cutpoints, "end_of_study") validate_rmst_args(rmst_tau, end_of_study, h0) validate_analysis_configuration(method, alternative, is.null(hazard_control), imputed_final) } validate_positive_integer_scalar(ncores, "ncores") execution <- resolve_sim_execution(backend = backend, ncores = ncores, N_trials = N_trials) backend <- execution$backend workers <- execution$workers stream_seed <- NULL if (!is.null(seed)) { if (length(seed) != 1 || !is.numeric(seed) || is.na(seed) || !is.finite(seed) || seed != floor(seed)) { stop("'seed' must be NULL or a single integer value") } old_kind <- RNGkind() old_seed_exists <- exists(".Random.seed", envir = .GlobalEnv, inherits = FALSE) if (old_seed_exists) { old_seed <- get(".Random.seed", envir = .GlobalEnv, inherits = FALSE) } on.exit({ do.call(RNGkind, as.list(old_kind)) if (old_seed_exists) { assign(".Random.seed", old_seed, envir = .GlobalEnv) } else if (exists(".Random.seed", envir = .GlobalEnv, inherits = FALSE)) { rm(".Random.seed", envir = .GlobalEnv) } }, add = TRUE) stream_seed <- seed trial_streams <- make_rng_streams(stream_seed, N_trials) } else if (backend == "psock") { stream_seed <- sample.int(.Machine$integer.max - 1L, size = 1L) trial_streams <- make_rng_streams(stream_seed, N_trials) } else { trial_streams <- NULL } rng_metadata <- list(caller_kind = caller_rng_kind, stream_kind = if (is.null(trial_streams)) { caller_rng_kind[1] } else { "L'Ecuyer-CMRG" }, seed_policy = if (!is.null(seed)) { "explicit_preserve_caller" } else if (backend == "psock") { "caller_derived_psock" } else { "caller_state" }, backend = backend, ncores = as.integer(workers), requested_ncores = as.integer(ncores), stream_seed = stream_seed) survival_adapt_fn <- if (backend == "psock") { make_psock_callable("survival_adapt") } else { survival_adapt } survival_adapt_wrapper <- function(x) { tryCatch({ if (!is.null(trial_streams)) { assign(".Random.seed", trial_streams[[x]], envir = .GlobalEnv) } result <- survival_adapt_fn(hazard_treatment = hazard_treatment, hazard_control = hazard_control, cutpoints = cutpoints, N_total = N_total, lambda = lambda, lambda_time = lambda_time, interim_look = interim_look, end_of_study = end_of_study, prior_surv = prior_surv, prior_bin = prior_bin, bin_method = bin_method, binary_imputation = binary_imputation, block = block, rand_ratio = rand_ratio, prop_loss = prop_loss, alternative = alternative, h0 = h0, Fn = Fn, Sn = Sn, Qn = Qn, prob_ha = prob_ha, N_impute = N_impute, N_mcmc = N_mcmc, mc_conf_level = mc_conf_level, method = method, imputed_final = imputed_final, empty_interval = empty_interval, return_trace = return_trace, prior_surv_final = prior_surv_final, generation_cutpoints = generation_cutpoints, rmst_tau = rmst_tau) attr(result, "arguments") <- NULL if (inherits(result, "goldilocks_trial")) { attr(result$summary, "arguments") <- NULL } list(trial = as.integer(x), result = result) }, error = function(error) { list(trial = as.integer(x), result = NULL, error_class = class(error)[1L], message = conditionMessage(error)) }) } trial_index <- seq_len(N_trials) trial_results <- switch(backend, sequential = lapply(trial_index, survival_adapt_wrapper), fork = pbmclapply(trial_index, survival_adapt_wrapper, mc.cores = workers), psock = { active_cluster <- make_sim_cluster(workers) on.exit(stop_sim_cluster(active_cluster), add = TRUE) initialize_sim_cluster(active_cluster) run_sim_cluster(active_cluster, trial_index, survival_adapt_wrapper) }) failed <- vapply(trial_results, function(x) is.null(x$result), logical(1)) failed_results <- trial_results[failed] failures <- data.frame(trial = vapply(failed_results, `[[`, integer(1), "trial"), error_class = vapply(failed_results, `[[`, character(1), "error_class"), message = vapply(failed_results, `[[`, character(1), "message"), stringsAsFactors = FALSE) if (all(failed)) { error <- simpleError(paste0("All ", N_trials, " simulated trials failed. First error: ", failures$message[1L])) error$failures <- failures class(error) <- c("goldilocks_all_trials_failed", class(error)) stop(error) } successful_trials <- trial_results[!failed] successful_results <- lapply(successful_trials, `[[`, "result") if (return_trace) { sims <- bind_rows(lapply(successful_results, function(x) x$summary)) traces <- bind_rows(lapply(seq_along(successful_results), function(i) { trace <- successful_results[[i]]$trace trial <- successful_trials[[i]]$trial trace$trial <- rep.int(trial, nrow(trace)) trace[c("trial", setdiff(names(trace), "trial"))] })) out <- list(sims = sims, traces = traces, failures = failures, call = Call) } else { sims <- bind_rows(successful_results) out <- list(sims = sims, failures = failures, call = Call) } attr(out$sims, "arguments") <- NULL attr(out, "enrollment_design") <- new_enrollment_design(lambda = lambda, N_total = N_total, lambda_time = lambda_time, interim_look = interim_look, end_of_study = end_of_study) attr(out, "decision_design") <- attr(successful_results[[1]], "decision_design", exact = TRUE) attr(out, "prior_design") <- attr(successful_results[[1]], "prior_design", exact = TRUE) attr(out, "rng_metadata") <- rng_metadata attr(out, "arguments") <- Arguments attr(out, "parallel_metadata") <- list(requested_backend = requested_backend, backend = backend, selection_reason = execution$reason, requested_ncores = as.integer(ncores), workers = as.integer(workers), tasks = as.integer(N_trials)) if (nrow(failures) > 0L) { warning(nrow(failures), " of ", N_trials, " simulated trials failed and were excluded. See `result$failures` ", "for details.", call. = FALSE) } return(out)})(N_total = 750, lambda = c(0.0666666666666667, 0.166666666666667, 0.333333333333333, 0.5, 0.666666666666667, 0.833333333333333, 1, 1.1), lambda_time = c(30L, 60L, 90L, 120L, 150L, 180L, 210L), interim_look = c(350, 450, 550, 650), end_of_study = 360L, prior_surv = c(0.5, 0.001, 0.5, 0.001, 0.5, 0.001, 0.5, 0.001, 5, 10000), prior_surv_final = c(shape = 0.5, rate = 0.001 ), prior_bin = c(0.5, 0.5), bin_method = "quadrature", block = 2, rand_ratio = c(control = 1, treatment = 1), alternative = "less", Fn = c(0.05, 0.1, 0.1, 0.1), Sn = c(0.95, 0.9, 0.85, 0.8), N_impute = 30, empty_interval = "prior", method = "bayes-bin", imputed_final = TRUE, ncores = 2, cutpoints = c(90, 104, 150, 210), prop_loss = 0.075, N_trials = 500, hazard_treatment = c(0.00011167, 0.002197976, 0.003163208, 0.002839089, 0.000494053), hazard_control = c(0.00011167, 0.002197976, 0.003163208, 0.002839089, 0.000494053), h0 = 0.15, prob_ha = 0.956, return_trace = TRUE, seed = 4610)
23: do.call(sim_trials, c(advent_effectiveness_args, list(N_trials = 500, hazard_treatment = eff_hazard_per_day, hazard_control = eff_hazard_per_day, h0 = 0.15, prob_ha = 0.956, return_trace = TRUE, seed = 4610)))
24: eval(expr, envir)
25: eval(expr, envir)
26: withVisible(eval(expr, envir))
27: withCallingHandlers(code, error = function (e) rlang::entrace(e), message = function (cnd) { watcher$capture_plot_and_output() if (on_message$capture) { watcher$push(cnd) } if (on_message$silence) { invokeRestart("muffleMessage") }}, warning = function (cnd) { if (getOption("warn") >= 2 || getOption("warn") < 0) { return() } watcher$capture_plot_and_output() if (on_warning$capture) { cnd <- sanitize_call(cnd) watcher$push(cnd) } if (on_warning$silence) { invokeRestart("muffleWarning") }}, error = function (cnd) { watcher$capture_plot_and_output() cnd <- sanitize_call(cnd) watcher$push(cnd) switch(on_error, continue = invokeRestart("eval_continue"), stop = invokeRestart("eval_stop"), error = NULL)})
28: eval(call)
29: eval(call)
30: with_handlers({ for (expr in tle$exprs) { ev <- withVisible(eval(expr, envir)) watcher$capture_plot_and_output() watcher$print_value(ev$value, ev$visible, envir) } TRUE}, handlers)
31: doWithOneRestart(return(expr), restart)
32: withOneRestart(expr, restarts[[1L]])
33: withRestartList(expr, restarts[-nr])
34: doWithOneRestart(return(expr), restart)
35: withOneRestart(withRestartList(expr, restarts[-nr]), restarts[[nr]])
36: withRestartList(expr, restarts)
37: withRestarts(with_handlers({ for (expr in tle$exprs) { ev <- withVisible(eval(expr, envir)) watcher$capture_plot_and_output() watcher$print_value(ev$value, ev$visible, envir) } TRUE}, handlers), eval_continue = function() TRUE, eval_stop = function() FALSE)
38: evaluate::evaluate(...)
39: evaluate(code, envir = env, new_device = FALSE, keep_warning = if (is.numeric(options$warning)) TRUE else options$warning, keep_message = if (is.numeric(options$message)) TRUE else options$message, stop_on_error = if (is.numeric(options$error)) options$error else { if (options$error && options$include) 0L else 2L }, output_handler = knit_handlers(options$render, options))
40: in_dir(input_dir(), expr)
41: in_input_dir(evaluate(code, envir = env, new_device = FALSE, keep_warning = if (is.numeric(options$warning)) TRUE else options$warning, keep_message = if (is.numeric(options$message)) TRUE else options$message, stop_on_error = if (is.numeric(options$error)) options$error else { if (options$error && options$include) 0L else 2L }, output_handler = knit_handlers(options$render, options)))
42: eng_r(options)
43: block_exec(params)
44: call_block(x)
45: process_group(group)
46: withCallingHandlers(if (tangle) process_tangle(group) else process_group(group), error = function(e) { if (progress && is.function(pb$interrupt)) pb$interrupt() if (is_R_CMD_build() || is_R_CMD_check()) error <<- format(e) })
47: with_options(withCallingHandlers(if (tangle) process_tangle(group) else process_group(group), error = function(e) { if (progress && is.function(pb$interrupt)) pb$interrupt() if (is_R_CMD_build() || is_R_CMD_check()) error <<- format(e) }), list(rlang_trace_top_env = knit_global()))
48: xfun:::handle_error(with_options(withCallingHandlers(if (tangle) process_tangle(group) else process_group(group), error = function(e) { if (progress && is.function(pb$interrupt)) pb$interrupt() if (is_R_CMD_build() || is_R_CMD_check()) error <<- format(e) }), list(rlang_trace_top_env = knit_global())), function(loc) { setwd(wd) write_utf8(res, output %n% stdout()) paste0("\nQuitting from ", loc, if (!is.null(error)) paste0("\n", rule(), error, "\n", rule()))}, if (labels[i] != "") sprintf(" [%s]", labels[i]), get_loc)
49: process_file(text, output)
50: knitr::knit(knit_input, knit_output, envir = envir, quiet = quiet)
51: rmarkdown::render(file, encoding = encoding, quiet = quiet, envir = globalenv(), output_dir = getwd(), ...)
52: vweave_rmarkdown(...)
53: engine$weave(file, quiet = quiet, encoding = enc)
54: doTryCatch(return(expr), name, parentenv, handler)
55: tryCatchOne(expr, names, parentenv, handlers[[1L]])
56: tryCatchList(expr, classes, parentenv, handlers)
57: 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)))})
58: tools:::.buildOneVignette("advent.Rmd", "/Volumes/Builds/packages/big-sur-arm64/results/4.5/goldilocks.Rcheck/vign_test/goldilocks", TRUE, TRUE, "advent", "UTF-8", "/Volumes/Temp/tmp/RtmpdfuMxk/file46cb7305411c.rds")
An irrecoverable exception occurred. R is aborting now ...
Quitting from advent.Rmd:577-621 [oc-small]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
<error/rlang_error>
Error in `vapply()`:
! values must be length 1,
but FUN(X[[1]]) result is length 0
---
Backtrace:
▆
1. ├─base::do.call(...)
2. └─goldilocks (local) `<fn>`(...)
3. ├─base::data.frame(...)
4. └─base::vapply(failed_results, `[[`, integer(1), "trial")
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Error: processing vignette 'advent.Rmd' failed with diagnostics:
values must be length 1,
but FUN(X[[1]]) result is length 0
--- failed re-building ‘advent.Rmd’
--- re-building ‘anthem-hfref.Rmd’ using rmarkdown
2026-10-24 07:40:15.441 R[19490:333060] XType: Using static font registry.
*** caught segfault ***
address 0x110, cause 'invalid permissions'
*** caught segfault ***
address 0x110, cause 'invalid permissions'
Traceback:
1: impute_predictive_arm(time = data_in$time[current_treatment], hazards = treatment_hazards, random_input = random_inputs$current_treatment, end_of_study = end_of_study, cutpoints = cutpoints, binary_imputation = binary_imputation)
2: fill_predictive_imputations(imputations = current, rows = current_treatment, values = impute_predictive_arm(time = data_in$time[current_treatment], hazards = treatment_hazards, random_input = random_inputs$current_treatment, end_of_study = end_of_study, cutpoints = cutpoints, binary_imputation = binary_imputation))
3: impute_predictive_draws(data_in = data_interim, hazards = post_lambda, end_of_study = end_of_study, cutpoints = cutpoints, single_arm = single_arm, binary_imputation = predictive_binary_imputation, check_futility = check_futility)
4: evaluate_interim_decision(data_interim = data_interim, look = i, planned_N = analysis_at_enrollnumber[i], calendar_time = look_time, active_followup = active_followup_at(data_total, look_time), end_of_study = end_of_study, rmst_tau = rmst_tau, cutpoints = cutpoints, single_arm = single_arm, prior_surv = prior_surv, prior_surv_final = prior_surv_final, prior_bin = prior_bin, bin_method = bin_method, alternative = alternative, h0 = h0, Fn = Fn[i], Sn = Sn[i], prob_ha = prob_ha, N_impute = N_impute, N_mcmc = N_mcmc, mc_conf_level = mc_conf_level, empty_interval = empty_interval, method = method, binary_imputation = binary_imputation, check_futility = check_futility, Qn = Qn[i])
5: survival_adapt_fn(hazard_treatment = hazard_treatment, hazard_control = hazard_control, cutpoints = cutpoints, N_total = N_total, lambda = lambda, lambda_time = lambda_time, interim_look = interim_look, end_of_study = end_of_study, prior_surv = prior_surv, prior_bin = prior_bin, bin_method = bin_method, binary_imputation = binary_imputation, block = block, rand_ratio = rand_ratio, prop_loss = prop_loss, alternative = alternative, h0 = h0, Fn = Fn, Sn = Sn, Qn = Qn, prob_ha = prob_ha, N_impute = N_impute, N_mcmc = N_mcmc, mc_conf_level = mc_conf_level, method = method, imputed_final = imputed_final, empty_interval = empty_interval, return_trace = return_trace, prior_surv_final = prior_surv_final, generation_cutpoints = generation_cutpoints, rmst_tau = rmst_tau)
6: doTryCatch(return(expr), name, parentenv, handler)
7: tryCatchOne(expr, names, parentenv, handlers[[1L]])
8: tryCatchList(expr, classes, parentenv, handlers)
9: tryCatch({ if (!is.null(trial_streams)) { assign(".Random.seed", trial_streams[[x]], envir = .GlobalEnv) } result <- survival_adapt_fn(hazard_treatment = hazard_treatment, hazard_control = hazard_control, cutpoints = cutpoints, N_total = N_total, lambda = lambda, lambda_time = lambda_time, interim_look = interim_look, end_of_study = end_of_study, prior_surv = prior_surv, prior_bin = prior_bin, bin_method = bin_method, binary_imputation = binary_imputation, block = block, rand_ratio = rand_ratio, prop_loss = prop_loss, alternative = alternative, h0 = h0, Fn = Fn, Sn = Sn, Qn = Qn, prob_ha = prob_ha, N_impute = N_impute, N_mcmc = N_mcmc, mc_conf_level = mc_conf_level, method = method, imputed_final = imputed_final, empty_interval = empty_interval, return_trace = return_trace, prior_surv_final = prior_surv_final, generation_cutpoints = generation_cutpoints, rmst_tau = rmst_tau) attr(result, "arguments") <- NULL if (inherits(result, "goldilocks_trial")) { attr(result$summary, "arguments") <- NULL } list(trial = as.integer(x), result = result)}, error = function(error) { list(trial = as.integer(x), result = NULL, error_class = class(error)[1L], message = conditionMessage(error))})
10: FUN(X[[i]], ...)
11: lapply(X = S, FUN = FUN, ...)
12: doTryCatch(return(expr), name, parentenv, handler)
13: tryCatchOne(expr, names, parentenv, handlers[[1L]])
14: tryCatchList(expr, classes, parentenv, handlers)
15: tryCatch(expr, error = function(e) { call <- conditionCall(e) if (!is.null(call)) { if (identical(call[[1L]], quote(doTryCatch))) call <- sys.call(-4L) dcall <- deparse(call, nlines = 1L) prefix <- paste("Error in", dcall, ": ") LONG <- 75L sm <- strsplit(conditionMessage(e), "\n")[[1L]] w <- 14L + nchar(dcall, type = "w") + nchar(sm[1L], type = "w") if (is.na(w)) w <- 14L + nchar(dcall, type = "b") + nchar(sm[1L], type = "b") if (w > LONG) prefix <- paste0(prefix, "\n ") } else prefix <- "Error : " msg <- paste0(prefix, conditionMessage(e), "\n") .Internal(seterrmessage(msg[1L])) if (!silent && isTRUE(getOption("show.error.messages"))) { cat(msg, file = outFile) .Internal(printDeferredWarnings()) } invisible(structure(msg, class = "try-error", condition = e))})
16: try(lapply(X = S, FUN = FUN, ...), silent = TRUE)
17: sendMaster(try(lapply(X = S, FUN = FUN, ...), silent = TRUE))
18: FUN(X[[i]], ...)
19: lapply(seq_len(cores), inner.do)
20: mclapply(X, FUN, ..., mc.cores = mc.cores, mc.preschedule = mc.preschedule, mc.set.seed = mc.set.seed, mc.cleanup = mc.cleanup, mc.allow.recursive = mc.allow.recursive)
21: pbmclapply(trial_index, survival_adapt_wrapper, mc.cores = workers)
22: (function (hazard_treatment, hazard_control = NULL, cutpoints = NULL, N_total, lambda = 0.3, lambda_time = NULL, interim_look = NULL, end_of_study, prior_surv = c(0.1, 0.1), prior_bin = c(1, 1), bin_method = "mc", block = 2, rand_ratio = c(control = 1, treatment = 1), prop_loss = 0, alternative = "greater", h0 = 0, Fn = 0.05, Sn = 0.9, prob_ha = 0.95, N_impute = 500, N_mcmc = 1000, mc_conf_level = 0.95, N_trials = 10, method = "logrank", imputed_final = FALSE, empty_interval = c("prior", "propagate", "error"), return_trace = FALSE, ncores = 1L, backend = c("auto", "fork", "psock", "sequential"), seed = NULL, binary_imputation = c("event-time", "bernoulli"), prior_surv_final = prior_surv, generation_cutpoints = cutpoints, Qn = 1, rmst_tau = end_of_study)
Traceback:
1: impute_predictive_arm(time = data_in$time[current_treatment], { Call <- match.call() hazards = treatment_hazards, random_input = random_inputs$current_treatment, Arguments <- capture_arguments(sim_trials, environment()) end_of_study = end_of_study, cutpoints = cutpoints, binary_imputation = binary_imputation)
method <- normalize_analysis_method(method) Arguments$method <- method 2: empty_interval <- match.arg(empty_interval)fill_predictive_imputations(imputations = current, rows = current_treatment, values = impute_predictive_arm(time = data_in$time[current_treatment], binary_imputation <- match.arg(binary_imputation) hazards = treatment_hazards, random_input = random_inputs$current_treatment, backend <- match.arg(backend) Arguments$empty_interval <- empty_interval end_of_study = end_of_study, cutpoints = cutpoints, binary_imputation = binary_imputation))
Arguments$binary_imputation <- binary_imputation 3: Arguments$backend <- backendimpute_predictive_draws(data_in = data_interim, hazards = post_lambda, requested_backend <- backend end_of_study = end_of_study, cutpoints = cutpoints, single_arm = single_arm, caller_rng_kind <- RNGkind() binary_imputation = predictive_binary_imputation, check_futility = check_futility) validate_positive_integer_scalar(N_trials, "N_trials")
4: single_arm <- is.null(hazard_control)evaluate_interim_decision(data_interim = data_interim, look = i, planned_N = analysis_at_enrollnumber[i], calendar_time = look_time, if (!single_arm) { active_followup = active_followup_at(data_total, look_time), end_of_study = end_of_study, rmst_tau = rmst_tau, cutpoints = cutpoints, rand_ratio <- validate_randomization_args(N_total, block, single_arm = single_arm, prior_surv = prior_surv, prior_surv_final = prior_surv_final, prior_bin = prior_bin, bin_method = bin_method, alternative = alternative, rand_ratio, allocation_name = "rand_ratio") Arguments$rand_ratio <- rand_ratio h0 = h0, Fn = Fn[i], Sn = Sn[i], prob_ha = prob_ha, N_impute = N_impute, N_mcmc = N_mcmc, mc_conf_level = mc_conf_level, empty_interval = empty_interval, } prop_loss <- normalize_prop_loss(prop_loss, single_arm = single_arm) method = method, binary_imputation = binary_imputation, check_futility = check_futility, Qn = Qn[i])
Arguments$prop_loss <- prop_loss validate_logical_scalar(return_trace, "return_trace") 5: survival_adapt_fn(hazard_treatment = hazard_treatment, hazard_control = hazard_control, validate_positive_integer_scalar(N_impute, "N_impute") validate_positive_integer_scalar(N_mcmc, "N_mcmc") cutpoints = cutpoints, N_total = N_total, lambda = lambda, lambda_time = lambda_time, interim_look = interim_look, end_of_study = end_of_study, validate_single_probability(mc_conf_level, "mc_conf_level", prior_surv = prior_surv, prior_bin = prior_bin, bin_method = bin_method, binary_imputation = binary_imputation, block = block, rand_ratio = rand_ratio, upper_open = TRUE) prop_loss = prop_loss, alternative = alternative, h0 = h0, if (mc_conf_level <= 0.5) { Fn = Fn, Sn = Sn, Qn = Qn, prob_ha = prob_ha, N_impute = N_impute, stop("'mc_conf_level' must be greater than 0.5 and less than 1") N_mcmc = N_mcmc, mc_conf_level = mc_conf_level, method = method, } imputed_final = imputed_final, empty_interval = empty_interval, validate_final_imputation(method, imputed_final, has_missing_outcomes = any(prop_loss > return_trace = return_trace, prior_surv_final = prior_surv_final, 0), N_impute = N_impute) generation_cutpoints = generation_cutpoints, rmst_tau = rmst_tau) if (identical(method, "rmst")) {
validate_endpoint_time(end_of_study, cutpoints, "end_of_study") 6: validate_rmst_args(rmst_tau, end_of_study, h0)doTryCatch(return(expr), name, parentenv, handler)
validate_analysis_configuration(method, alternative, 7: tryCatchOne(expr, names, parentenv, handlers[[1L]]) is.null(hazard_control), imputed_final) }
8: validate_positive_integer_scalar(ncores, "ncores") execution <- resolve_sim_execution(backend = backend, ncores = ncores, tryCatchList(expr, classes, parentenv, handlers) N_trials = N_trials)
backend <- execution$backend 9: workers <- execution$workerstryCatch({ if (!is.null(trial_streams)) { stream_seed <- NULL if (!is.null(seed)) { assign(".Random.seed", trial_streams[[x]], envir = .GlobalEnv) if (length(seed) != 1 || !is.numeric(seed) || is.na(seed) || } !is.finite(seed) || seed != floor(seed)) { result <- survival_adapt_fn(hazard_treatment = hazard_treatment, hazard_control = hazard_control, cutpoints = cutpoints, stop("'seed' must be NULL or a single integer value") N_total = N_total, lambda = lambda, lambda_time = lambda_time, } interim_look = interim_look, end_of_study = end_of_study, prior_surv = prior_surv, prior_bin = prior_bin, bin_method = bin_method, old_kind <- RNGkind() binary_imputation = binary_imputation, block = block, old_seed_exists <- exists(".Random.seed", envir = .GlobalEnv, rand_ratio = rand_ratio, prop_loss = prop_loss, alternative = alternative, h0 = h0, Fn = Fn, Sn = Sn, Qn = Qn, prob_ha = prob_ha, inherits = FALSE) if (old_seed_exists) { N_impute = N_impute, N_mcmc = N_mcmc, mc_conf_level = mc_conf_level, old_seed <- get(".Random.seed", envir = .GlobalEnv, method = method, imputed_final = imputed_final, empty_interval = empty_interval, inherits = FALSE) } return_trace = return_trace, prior_surv_final = prior_surv_final, on.exit({ generation_cutpoints = generation_cutpoints, rmst_tau = rmst_tau) attr(result, "arguments") <- NULL do.call(RNGkind, as.list(old_kind)) if (inherits(result, "goldilocks_trial")) { attr(result$summary, "arguments") <- NULL if (old_seed_exists) { } list(trial = as.integer(x), result = result) assign(".Random.seed", old_seed, envir = .GlobalEnv)}, error = function(error) { } else if (exists(".Random.seed", envir = .GlobalEnv, list(trial = as.integer(x), result = NULL, error_class = class(error)[1L], inherits = FALSE)) { message = conditionMessage(error)) rm(".Random.seed", envir = .GlobalEnv)})
}10: FUN(X[[i]], ...) }, add = TRUE)
stream_seed <- seed11: trial_streams <- make_rng_streams(stream_seed, N_trials)lapply(X = S, FUN = FUN, ...) } else if (backend == "psock") {
12: stream_seed <- sample.int(.Machine$integer.max - 1L, doTryCatch(return(expr), name, parentenv, handler)
size = 1L) trial_streams <- make_rng_streams(stream_seed, N_trials)13: tryCatchOne(expr, names, parentenv, handlers[[1L]]) }
14: else {tryCatchList(expr, classes, parentenv, handlers) trial_streams <- NULL
}15: rng_metadata <- list(caller_kind = caller_rng_kind, stream_kind = if (is.null(trial_streams)) {tryCatch(expr, error = function(e) { caller_rng_kind[1] call <- conditionCall(e) } else { if (!is.null(call)) { if (identical(call[[1L]], quote(doTryCatch))) call <- sys.call(-4L) "L'Ecuyer-CMRG" }, seed_policy = if (!is.null(seed)) { dcall <- deparse(call, nlines = 1L) prefix <- paste("Error in", dcall, ": ") "explicit_preserve_caller" } else if (backend == "psock") { LONG <- 75L sm <- strsplit(conditionMessage(e), "\n")[[1L]] "caller_derived_psock" w <- 14L + nchar(dcall, type = "w") + nchar(sm[1L], type = "w") } else { if (is.na(w)) "caller_state" w <- 14L + nchar(dcall, type = "b") + nchar(sm[1L], }, backend = backend, ncores = as.integer(workers), requested_ncores = as.integer(ncores), type = "b") if (w > LONG) stream_seed = stream_seed) survival_adapt_fn <- if (backend == "psock") { prefix <- paste0(prefix, "\n ") } make_psock_callable("survival_adapt") else prefix <- "Error : " } msg <- paste0(prefix, conditionMessage(e), "\n") else { .Internal(seterrmessage(msg[1L])) if (!silent && isTRUE(getOption("show.error.messages"))) { survival_adapt cat(msg, file = outFile) } .Internal(printDeferredWarnings()) } survival_adapt_wrapper <- function(x) { tryCatch({ invisible(structure(msg, class = "try-error", condition = e))}) if (!is.null(trial_streams)) {
assign(".Random.seed", trial_streams[[x]], envir = .GlobalEnv) }16: result <- survival_adapt_fn(hazard_treatment = hazard_treatment, try(lapply(X = S, FUN = FUN, ...), silent = TRUE) hazard_control = hazard_control, cutpoints = cutpoints,
17: N_total = N_total, lambda = lambda, lambda_time = lambda_time, sendMaster(try(lapply(X = S, FUN = FUN, ...), silent = TRUE))
interim_look = interim_look, end_of_study = end_of_study, 18: prior_surv = prior_surv, prior_bin = prior_bin, FUN(X[[i]], ...)
bin_method = bin_method, binary_imputation = binary_imputation, block = block, rand_ratio = rand_ratio, prop_loss = prop_loss, 19: lapply(seq_len(cores), inner.do) alternative = alternative, h0 = h0, Fn = Fn, Sn = Sn, Qn = Qn, prob_ha = prob_ha, N_impute = N_impute,
N_mcmc = N_mcmc, mc_conf_level = mc_conf_level, 20: method = method, imputed_final = imputed_final, empty_interval = empty_interval, return_trace = return_trace, prior_surv_final = prior_surv_final, generation_cutpoints = generation_cutpoints, mclapply(X, FUN, ..., mc.cores = mc.cores, mc.preschedule = mc.preschedule, mc.set.seed = mc.set.seed, mc.cleanup = mc.cleanup, mc.allow.recursive = mc.allow.recursive) rmst_tau = rmst_tau)
21: attr(result, "arguments") <- NULL if (inherits(result, "goldilocks_trial")) {pbmclapply(trial_index, survival_adapt_wrapper, mc.cores = workers)
attr(result$summary, "arguments") <- NULL22: (function (hazard_treatment, hazard_control = NULL, cutpoints = NULL, } list(trial = as.integer(x), result = result) N_total, lambda = 0.3, lambda_time = NULL, interim_look = NULL, end_of_study, prior_surv = c(0.1, 0.1), prior_bin = c(1, }, error = function(error) { list(trial = as.integer(x), result = NULL, error_class = class(error)[1L], 1), bin_method = "mc", block = 2, rand_ratio = c(control = 1, treatment = 1), prop_loss = 0, alternative = "greater", message = conditionMessage(error)) }) h0 = 0, Fn = 0.05, Sn = 0.9, prob_ha = 0.95, N_impute = 500, N_mcmc = 1000, mc_conf_level = 0.95, N_trials = 10, method = "logrank", } imputed_final = FALSE, empty_interval = c("prior", "propagate", "error"), return_trace = FALSE, ncores = 1L, backend = c("auto", trial_index <- seq_len(N_trials) "fork", "psock", "sequential"), seed = NULL, binary_imputation = c("event-time", trial_results <- switch(backend, sequential = lapply(trial_index, "bernoulli"), prior_surv_final = prior_surv, generation_cutpoints = cutpoints, survival_adapt_wrapper), fork = pbmclapply(trial_index, Qn = 1, rmst_tau = end_of_study) survival_adapt_wrapper, mc.cores = workers), psock = {{ Call <- match.call() active_cluster <- make_sim_cluster(workers) on.exit(stop_sim_cluster(active_cluster), add = TRUE) Arguments <- capture_arguments(sim_trials, environment()) method <- normalize_analysis_method(method) initialize_sim_cluster(active_cluster) run_sim_cluster(active_cluster, trial_index, survival_adapt_wrapper) Arguments$method <- method empty_interval <- match.arg(empty_interval) }) failed <- vapply(trial_results, function(x) is.null(x$result), binary_imputation <- match.arg(binary_imputation) backend <- match.arg(backend) logical(1)) failed_results <- trial_results[failed] failures <- data.frame(trial = vapply(failed_results, `[[`, Arguments$empty_interval <- empty_interval Arguments$binary_imputation <- binary_imputation integer(1), "trial"), error_class = vapply(failed_results, Arguments$backend <- backend `[[`, character(1), "error_class"), message = vapply(failed_results, requested_backend <- backend `[[`, character(1), "message"), stringsAsFactors = FALSE) if (all(failed)) { caller_rng_kind <- RNGkind() validate_positive_integer_scalar(N_trials, "N_trials") error <- simpleError(paste0("All ", N_trials, " simulated trials failed. First error: ", failures$message[1L])) single_arm <- is.null(hazard_control) if (!single_arm) { error$failures <- failures class(error) <- c("goldilocks_all_trials_failed", class(error)) stop(error) rand_ratio <- validate_randomization_args(N_total, block, rand_ratio, allocation_name = "rand_ratio") } successful_trials <- trial_results[!failed] Arguments$rand_ratio <- rand_ratio } successful_results <- lapply(successful_trials, `[[`, "result") prop_loss <- normalize_prop_loss(prop_loss, single_arm = single_arm) if (return_trace) { Arguments$prop_loss <- prop_loss sims <- bind_rows(lapply(successful_results, function(x) x$summary)) validate_logical_scalar(return_trace, "return_trace") traces <- bind_rows(lapply(seq_along(successful_results), function(i) { validate_positive_integer_scalar(N_impute, "N_impute") trace <- successful_results[[i]]$trace validate_positive_integer_scalar(N_mcmc, "N_mcmc") validate_single_probability(mc_conf_level, "mc_conf_level", trial <- successful_trials[[i]]$trial trace$trial <- rep.int(trial, nrow(trace)) upper_open = TRUE) trace[c("trial", setdiff(names(trace), "trial"))] if (mc_conf_level <= 0.5) { })) stop("'mc_conf_level' must be greater than 0.5 and less than 1") } out <- list(sims = sims, traces = traces, failures = failures, validate_final_imputation(method, imputed_final, has_missing_outcomes = any(prop_loss > call = Call) } 0), N_impute = N_impute) else { if (identical(method, "rmst")) { sims <- bind_rows(successful_results) validate_endpoint_time(end_of_study, cutpoints, "end_of_study") validate_rmst_args(rmst_tau, end_of_study, h0) out <- list(sims = sims, failures = failures, call = Call) validate_analysis_configuration(method, alternative, is.null(hazard_control), imputed_final) } } attr(out$sims, "arguments") <- NULL validate_positive_integer_scalar(ncores, "ncores") attr(out, "enrollment_design") <- new_enrollment_design(lambda = lambda, N_total = N_total, lambda_time = lambda_time, interim_look = interim_look, execution <- resolve_sim_execution(backend = backend, ncores = ncores, end_of_study = end_of_study) N_trials = N_trials) attr(out, "decision_design") <- attr(successful_results[[1]], backend <- execution$backend "decision_design", exact = TRUE) workers <- execution$workers attr(out, "prior_design") <- attr(successful_results[[1]], stream_seed <- NULL if (!is.null(seed)) { "prior_design", exact = TRUE) if (length(seed) != 1 || !is.numeric(seed) || is.na(seed) || attr(out, "rng_metadata") <- rng_metadata !is.finite(seed) || seed != floor(seed)) { stop("'seed' must be NULL or a single integer value") attr(out, "arguments") <- Arguments attr(out, "parallel_metadata") <- list(requested_backend = requested_backend, } backend = backend, selection_reason = execution$reason, old_kind <- RNGkind() requested_ncores = as.integer(ncores), workers = as.integer(workers), tasks = as.integer(N_trials)) old_seed_exists <- exists(".Random.seed", envir = .GlobalEnv, if (nrow(failures) > 0L) { inherits = FALSE) if (old_seed_exists) { warning(nrow(failures), " of ", N_trials, " simulated trials failed and were excluded. See `result$failures` ", old_seed <- get(".Random.seed", envir = .GlobalEnv, "for details.", call. = FALSE) inherits = FALSE) } } return(out) on.exit({})(cutpoints = c(26, 52), generation_cutpoints = 52, N_total = 1000, do.call(RNGkind, as.list(old_kind)) lambda = c(0.5, 1.5, 2.5, 3.5, 4.5, 5.5, 6), lambda_time = c(4.33333333333333, if (old_seed_exists) { 8.66666666666667, 13, 17.3333333333333, 21.6666666666667, assign(".Random.seed", old_seed, envir = .GlobalEnv) } else if (exists(".Random.seed", envir = .GlobalEnv, 26), interim_look = c(400, 500, 600, 700, 800, 900), end_of_study = 69.3333333333333, inherits = FALSE)) { prior_surv = c(1, 144.927536231884, 1, 144.927536231884, rm(".Random.seed", envir = .GlobalEnv) 1, 285.714285714286), block = 3, rand_ratio = c(control = 1, } treatment = 2), prop_loss = 0.1, alternative = "less", h0 = 0, }, add = TRUE) Fn = c(0.01, 0.01, 0.01, 0.01, 0.01, 0.01), Sn = c(1, 0.95, 0.95, 0.95, 0.95, 0.95), prob_ha = 0.981, N_impute = 300, stream_seed <- seed trial_streams <- make_rng_streams(stream_seed, N_trials) mc_conf_level = 0.95, empty_interval = "prior", method = "logrank", imputed_final = FALSE, hazard_treatment = c(0.005796, 0.00168 } else if (backend == "psock") { ), hazard_control = c(0.00828, 0.0024), N_trials = 20, ncores = 2, seed = 3425430) stream_seed <- sample.int(.Machine$integer.max - 1L,
23: size = 1L) trial_streams <- make_rng_streams(stream_seed, N_trials)do.call(sim_trials, c(anthem_common, list(hazard_treatment = hazard_treatment_target_week, hazard_control = hazard_control_week, N_trials = 20, ncores = 2, } else { seed = 3425430))) trial_streams <- NULL }
24: rng_metadata <- list(caller_kind = caller_rng_kind, stream_kind = if (is.null(trial_streams)) { caller_rng_kind[1]eval(expr, envir) } else { "L'Ecuyer-CMRG"
}, seed_policy = if (!is.null(seed)) {25: "explicit_preserve_caller"eval(expr, envir) } else if (backend == "psock") {
"caller_derived_psock"26: } else { "caller_state"withVisible(eval(expr, envir)) }, backend = backend, ncores = as.integer(workers), requested_ncores = as.integer(ncores),
stream_seed = stream_seed)27: survival_adapt_fn <- if (backend == "psock") {withCallingHandlers(code, error = function (e) rlang::entrace(e), message = function (cnd) make_psock_callable("survival_adapt") }{ watcher$capture_plot_and_output() else { survival_adapt if (on_message$capture) { watcher$push(cnd) } survival_adapt_wrapper <- function(x) { } if (on_message$silence) { tryCatch({ if (!is.null(trial_streams)) { invokeRestart("muffleMessage") assign(".Random.seed", trial_streams[[x]], envir = .GlobalEnv) } }}, warning = function (cnd) result <- survival_adapt_fn(hazard_treatment = hazard_treatment, { hazard_control = hazard_control, cutpoints = cutpoints, if (getOption("warn") >= 2 || getOption("warn") < 0) { N_total = N_total, lambda = lambda, lambda_time = lambda_time, return() interim_look = interim_look, end_of_study = end_of_study, } prior_surv = prior_surv, prior_bin = prior_bin, watcher$capture_plot_and_output() bin_method = bin_method, binary_imputation = binary_imputation, if (on_warning$capture) { cnd <- sanitize_call(cnd) block = block, rand_ratio = rand_ratio, prop_loss = prop_loss, alternative = alternative, h0 = h0, Fn = Fn, watcher$push(cnd) } if (on_warning$silence) { invokeRestart("muffleWarning") }}, error = function (cnd) Sn = Sn, Qn = Qn, prob_ha = prob_ha, N_impute = N_impute, N_mcmc = N_mcmc, mc_conf_level = mc_conf_level, { method = method, imputed_final = imputed_final, watcher$capture_plot_and_output() empty_interval = empty_interval, return_trace = return_trace, cnd <- sanitize_call(cnd) prior_surv_final = prior_surv_final, generation_cutpoints = generation_cutpoints, rmst_tau = rmst_tau) attr(result, "arguments") <- NULL watcher$push(cnd) if (inherits(result, "goldilocks_trial")) { switch(on_error, continue = invokeRestart("eval_continue"), attr(result$summary, "arguments") <- NULL stop = invokeRestart("eval_stop"), error = NULL)})
28: } list(trial = as.integer(x), result = result)eval(call)
}, error = function(error) {29: eval(call) list(trial = as.integer(x), result = NULL, error_class = class(error)[1L], message = conditionMessage(error))
30: }) }with_handlers({ for (expr in tle$exprs) { trial_index <- seq_len(N_trials) ev <- withVisible(eval(expr, envir)) trial_results <- switch(backend, sequential = lapply(trial_index, watcher$capture_plot_and_output() survival_adapt_wrapper), fork = pbmclapply(trial_index, survival_adapt_wrapper, mc.cores = workers), psock = { watcher$print_value(ev$value, ev$visible, envir) } active_cluster <- make_sim_cluster(workers) TRUE}, handlers) on.exit(stop_sim_cluster(active_cluster), add = TRUE)
31: initialize_sim_cluster(active_cluster) run_sim_cluster(active_cluster, trial_index, survival_adapt_wrapper)doWithOneRestart(return(expr), restart)
})32: withOneRestart(expr, restarts[[1L]]) failed <- vapply(trial_results, function(x) is.null(x$result), logical(1)) failed_results <- trial_results[failed]
33: failures <- data.frame(trial = vapply(failed_results, `[[`, integer(1), "trial"), error_class = vapply(failed_results, withRestartList(expr, restarts[-nr])
`[[`, character(1), "error_class"), message = vapply(failed_results, `[[`, character(1), "message"), stringsAsFactors = FALSE)34: doWithOneRestart(return(expr), restart) if (all(failed)) {
35: error <- simpleError(paste0("All ", N_trials, " simulated trials failed. First error: ", withOneRestart(withRestartList(expr, restarts[-nr]), restarts[[nr]]) failures$message[1L])) error$failures <- failures
class(error) <- c("goldilocks_all_trials_failed", class(error))36: withRestartList(expr, restarts) stop(error)
}37: withRestarts(with_handlers({ successful_trials <- trial_results[!failed] for (expr in tle$exprs) { ev <- withVisible(eval(expr, envir)) successful_results <- lapply(successful_trials, `[[`, "result") watcher$capture_plot_and_output() watcher$print_value(ev$value, ev$visible, envir) if (return_trace) { sims <- bind_rows(lapply(successful_results, function(x) x$summary)) } TRUE traces <- bind_rows(lapply(seq_along(successful_results), function(i) {}, handlers), eval_continue = function() TRUE, eval_stop = function() FALSE)
trace <- successful_results[[i]]$trace trial <- successful_trials[[i]]$trial38: trace$trial <- rep.int(trial, nrow(trace)) trace[c("trial", setdiff(names(trace), "trial"))]evaluate::evaluate(...)
}))39: out <- list(sims = sims, traces = traces, failures = failures, evaluate(code, envir = env, new_device = FALSE, keep_warning = if (is.numeric(options$warning)) TRUE else options$warning, call = Call) keep_message = if (is.numeric(options$message)) TRUE else options$message, } stop_on_error = if (is.numeric(options$error)) options$error else { else { sims <- bind_rows(successful_results) if (options$error && options$include) out <- list(sims = sims, failures = failures, call = Call) } 0L else 2L attr(out$sims, "arguments") <- NULL attr(out, "enrollment_design") <- new_enrollment_design(lambda = lambda, }, output_handler = knit_handlers(options$render, options))
N_total = N_total, lambda_time = lambda_time, interim_look = interim_look, end_of_study = end_of_study)40: in_dir(input_dir(), expr) attr(out, "decision_design") <- attr(successful_results[[1]],
"decision_design", exact = TRUE)41: in_input_dir(evaluate(code, envir = env, new_device = FALSE, attr(out, "prior_design") <- attr(successful_results[[1]], "prior_design", exact = TRUE) keep_warning = if (is.numeric(options$warning)) TRUE else options$warning, keep_message = if (is.numeric(options$message)) TRUE else options$message, attr(out, "rng_metadata") <- rng_metadata attr(out, "arguments") <- Arguments stop_on_error = if (is.numeric(options$error)) options$error else { attr(out, "parallel_metadata") <- list(requested_backend = requested_backend, backend = backend, selection_reason = execution$reason, if (options$error && options$include) 0L requested_ncores = as.integer(ncores), workers = as.integer(workers), else 2L }, output_handler = knit_handlers(options$render, options))) tasks = as.integer(N_trials))
if (nrow(failures) > 0L) { warning(nrow(failures), " of ", N_trials, " simulated trials failed and were excluded. See `result$failures` ", "for details.", call. = FALSE)42: eng_r(options) }
43: return(out)})(cutpoints = c(26, 52), generation_cutpoints = 52, N_total = 1000, block_exec(params)
lambda = c(0.5, 1.5, 2.5, 3.5, 4.5, 5.5, 6), lambda_time = c(4.33333333333333, 8.66666666666667, 13, 17.3333333333333, 21.6666666666667, 44: 26), interim_look = c(400, 500, 600, 700, 800, 900), end_of_study = 69.3333333333333, prior_surv = c(1, 144.927536231884, 1, 144.927536231884, call_block(x) 1, 285.714285714286), block = 3, rand_ratio = c(control = 1,
treatment = 2), prop_loss = 0.1, alternative = "less", h0 = 0, 45: Fn = c(0.01, 0.01, 0.01, 0.01, 0.01, 0.01), Sn = c(1, 0.95, process_group(group) 0.95, 0.95, 0.95, 0.95), prob_ha = 0.981, N_impute = 300,
46: mc_conf_level = 0.95, empty_interval = "prior", method = "logrank", withCallingHandlers(if (tangle) process_tangle(group) else process_group(group), imputed_final = FALSE, hazard_treatment = c(0.005796, 0.00168 error = function(e) { ), hazard_control = c(0.00828, 0.0024), N_trials = 20, ncores = 2, seed = 3425430) if (progress && is.function(pb$interrupt))
pb$interrupt()23: if (is_R_CMD_build() || is_R_CMD_check()) do.call(sim_trials, c(anthem_common, list(hazard_treatment = hazard_treatment_target_week, error <<- format(e) hazard_control = hazard_control_week, N_trials = 20, ncores = 2, }) seed = 3425430)))
47: with_options(withCallingHandlers(if (tangle) process_tangle(group) else process_group(group), 24: eval(expr, envir) error = function(e) {
if (progress && is.function(pb$interrupt)) 25: eval(expr, envir) pb$interrupt()
26: if (is_R_CMD_build() || is_R_CMD_check()) withVisible(eval(expr, envir)) error <<- format(e)
}), list(rlang_trace_top_env = knit_global()))27:
withCallingHandlers(code, error = function (e) rlang::entrace(e), message = function (cnd) 48: {xfun:::handle_error(with_options(withCallingHandlers(if (tangle) process_tangle(group) else process_group(group), watcher$capture_plot_and_output() error = function(e) { if (on_message$capture) { if (progress && is.function(pb$interrupt)) watcher$push(cnd) pb$interrupt() } if (is_R_CMD_build() || is_R_CMD_check()) if (on_message$silence) { error <<- format(e) invokeRestart("muffleMessage") } }), list(rlang_trace_top_env = knit_global())), function(loc) {}, warning = function (cnd) { setwd(wd) if (getOption("warn") >= 2 || getOption("warn") < 0) { write_utf8(res, output %n% stdout()) return() paste0("\nQuitting from ", loc, if (!is.null(error)) } watcher$capture_plot_and_output() paste0("\n", rule(), error, "\n", rule())) if (on_warning$capture) { cnd <- sanitize_call(cnd)}, if (labels[i] != "") sprintf(" [%s]", labels[i]), get_loc)
watcher$push(cnd) }49: process_file(text, output) if (on_warning$silence) { invokeRestart("muffleWarning")
50: }}, error = function (cnd) knitr::knit(knit_input, knit_output, envir = envir, quiet = quiet)
{51: rmarkdown::render(file, encoding = encoding, quiet = quiet, envir = globalenv(), watcher$capture_plot_and_output() output_dir = getwd(), ...) cnd <- sanitize_call(cnd)
52: watcher$push(cnd)vweave_rmarkdown(...) switch(on_error, continue = invokeRestart("eval_continue"),
stop = invokeRestart("eval_stop"), error = NULL)53: })
engine$weave(file, quiet = quiet, encoding = enc)28: eval(call)
54: 29: doTryCatch(return(expr), name, parentenv, handler)eval(call)
55: 30: tryCatchOne(expr, names, parentenv, handlers[[1L]])with_handlers({
for (expr in tle$exprs) {56: ev <- withVisible(eval(expr, envir))tryCatchList(expr, classes, parentenv, handlers) watcher$capture_plot_and_output()
watcher$print_value(ev$value, ev$visible, envir)57: }tryCatch({ TRUE engine$weave(file, quiet = quiet, encoding = enc)}, handlers) setwd(startdir)
output <- find_vignette_product(name, by = "weave", engine = engine)31: if (!have.makefile && vignette_is_tex(output)) {doWithOneRestart(return(expr), restart) texi2pdf(file = output, clean = FALSE, quiet = quiet)
output <- find_vignette_product(name, by = "texi2pdf", 32: engine = engine)withOneRestart(expr, restarts[[1L]]) }
}, error = function(e) {33: OK <<- FALSEwithRestartList(expr, restarts[-nr]) message(gettextf("Error: processing vignette '%s' failed with diagnostics:\n%s",
file, conditionMessage(e)))34: })doWithOneRestart(return(expr), restart)
58: 35: tools:::.buildOneVignette("anthem-hfref.Rmd", "/Volumes/Builds/packages/big-sur-arm64/results/4.5/goldilocks.Rcheck/vign_test/goldilocks", withOneRestart(withRestartList(expr, restarts[-nr]), restarts[[nr]]) TRUE, TRUE, "anthem-hfref", "UTF-8", "/Volumes/Temp/tmp/RtmpdfuMxk/file46cb691ffe66.rds")
36: An irrecoverable exception occurred. R is aborting now ...
withRestartList(expr, restarts)
37: withRestarts(with_handlers({ for (expr in tle$exprs) { ev <- withVisible(eval(expr, envir)) watcher$capture_plot_and_output() watcher$print_value(ev$value, ev$visible, envir) } TRUE}, handlers), eval_continue = function() TRUE, eval_stop = function() FALSE)
38: evaluate::evaluate(...)
39: evaluate(code, envir = env, new_device = FALSE, keep_warning = if (is.numeric(options$warning)) TRUE else options$warning, keep_message = if (is.numeric(options$message)) TRUE else options$message, stop_on_error = if (is.numeric(options$error)) options$error else { if (options$error && options$include) 0L else 2L }, output_handler = knit_handlers(options$render, options))
40: in_dir(input_dir(), expr)
41: in_input_dir(evaluate(code, envir = env, new_device = FALSE, keep_warning = if (is.numeric(options$warning)) TRUE else options$warning, keep_message = if (is.numeric(options$message)) TRUE else options$message, stop_on_error = if (is.numeric(options$error)) options$error else { if (options$error && options$include) 0L else 2L }, output_handler = knit_handlers(options$render, options)))
42: eng_r(options)
43: block_exec(params)
44: call_block(x)
45: process_group(group)
46: withCallingHandlers(if (tangle) process_tangle(group) else process_group(group), error = function(e) { if (progress && is.function(pb$interrupt)) pb$interrupt() if (is_R_CMD_build() || is_R_CMD_check()) error <<- format(e) })
47: with_options(withCallingHandlers(if (tangle) process_tangle(group) else process_group(group), error = function(e) { if (progress && is.function(pb$interrupt)) pb$interrupt() if (is_R_CMD_build() || is_R_CMD_check()) error <<- format(e) }), list(rlang_trace_top_env = knit_global()))
48: xfun:::handle_error(with_options(withCallingHandlers(if (tangle) process_tangle(group) else process_group(group), error = function(e) { if (progress && is.function(pb$interrupt)) pb$interrupt() if (is_R_CMD_build() || is_R_CMD_check()) error <<- format(e) }), list(rlang_trace_top_env = knit_global())), function(loc) { setwd(wd) write_utf8(res, output %n% stdout()) paste0("\nQuitting from ", loc, if (!is.null(error)) paste0("\n", rule(), error, "\n", rule()))}, if (labels[i] != "") sprintf(" [%s]", labels[i]), get_loc)
49: process_file(text, output)
50: knitr::knit(knit_input, knit_output, envir = envir, quiet = quiet)
51: rmarkdown::render(file, encoding = encoding, quiet = quiet, envir = globalenv(), output_dir = getwd(), ...)
52: vweave_rmarkdown(...)
53: engine$weave(file, quiet = quiet, encoding = enc)
54: doTryCatch(return(expr), name, parentenv, handler)
55: tryCatchOne(expr, names, parentenv, handlers[[1L]])
56: tryCatchList(expr, classes, parentenv, handlers)
57: 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)))})
58: tools:::.buildOneVignette("anthem-hfref.Rmd", "/Volumes/Builds/packages/big-sur-arm64/results/4.5/goldilocks.Rcheck/vign_test/goldilocks", TRUE, TRUE, "anthem-hfref", "UTF-8", "/Volumes/Temp/tmp/RtmpdfuMxk/file46cb691ffe66.rds")
An irrecoverable exception occurred. R is aborting now ...
Quitting from anthem-hfref.Rmd:432-482 [small-operating-characteristics]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
<error/rlang_error>
Error in `vapply()`:
! values must be length 1,
but FUN(X[[1]]) result is length 0
---
Backtrace:
▆
1. ├─base::do.call(...)
2. └─goldilocks (local) `<fn>`(...)
3. ├─base::data.frame(...)
4. └─base::vapply(failed_results, `[[`, integer(1), "trial")
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Error: processing vignette 'anthem-hfref.Rmd' failed with diagnostics:
values must be length 1,
but FUN(X[[1]]) result is length 0
--- failed re-building ‘anthem-hfref.Rmd’
--- re-building ‘architecture.Rmd’ using rmarkdown
--- finished re-building ‘architecture.Rmd’
--- re-building ‘bayes-piecewise.Rmd’ using rmarkdown
--- finished re-building ‘bayes-piecewise.Rmd’
--- re-building ‘bayesian-binary.Rmd’ using rmarkdown
--- finished re-building ‘bayesian-binary.Rmd’
--- re-building ‘calibrating-prob-ha.Rmd’ using rmarkdown
2026-10-24 07:40:21.503 R[19841:334013] XType: Using static font registry.
--- finished re-building ‘calibrating-prob-ha.Rmd’
--- re-building ‘decision-traces.Rmd’ using rmarkdown
2026-10-24 07:40:23.188 R[19946:334287] XType: Using static font registry.
--- finished re-building ‘decision-traces.Rmd’
--- re-building ‘frequentist-binary.Rmd’ using rmarkdown
--- finished re-building ‘frequentist-binary.Rmd’
--- re-building ‘interim-data.Rmd’ using rmarkdown
--- finished re-building ‘interim-data.Rmd’
--- re-building ‘rmst.Rmd’ using rmarkdown
--- finished re-building ‘rmst.Rmd’
--- re-building ‘single-arm.Rmd’ using rmarkdown
--- finished re-building ‘single-arm.Rmd’
--- re-building ‘technical-methods.Rmd’ using rmarkdown
--- finished re-building ‘technical-methods.Rmd’
--- re-building ‘thermocool-af.Rmd’ using rmarkdown
2026-10-24 07:40:35.263 R[20243:335175] XType: Using static font registry.
--- finished re-building ‘thermocool-af.Rmd’
--- re-building ‘two-arm.Rmd’ using rmarkdown
2026-10-24 07:40:37.091 R[20402:335584] XType: Using static font registry.
--- finished re-building ‘two-arm.Rmd’
SUMMARY: processing the following files failed:
‘advent.Rmd’ ‘anthem-hfref.Rmd’
Error: Vignette re-building failed.
Execution halted
Flavor: r-oldrel-macos-arm64
Current CRAN status: OK: 13
Current CRAN status: OK: 12, ERROR: 1
Version: 0.4.8
Flags: --no-tests
Check: re-building of vignette outputs
Result: ERROR
Error(s) in re-building vignettes:
...
--- re-building ‘joineRML-tidy.Rmd’ using rmarkdown
Quitting from joineRML-tidy.Rmd:67-82 [hvd_model_fit]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
<error/rlang_error>
Error in `a$specials[[i]]`:
! subscript out of bounds
---
Backtrace:
▆
1. └─joineRML::mjoint(...)
2. └─joineRML:::initsSurv(...)
3. └─joineRML:::initsSurv_balanced(...)
4. └─survival::coxph.detail(fitAG)
5. └─survival:::coxph.getdata(object, offset = TRUE)
6. ├─stats::model.matrix(fit, data = mf)
7. └─survival:::model.matrix.coxph(fit, data = mf)
8. └─stats::delete.response(object$terms)
9. └─stats (local) off(a$specials[[i]])
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Error: processing vignette 'joineRML-tidy.Rmd' failed with diagnostics:
subscript out of bounds
--- failed re-building ‘joineRML-tidy.Rmd’
--- re-building ‘joineRML.Rmd’ using rmarkdown
Quitting from joineRML.Rmd:205-214 [joineRML]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
<error/rlang_error>
Error in `a$specials[[i]]`:
! subscript out of bounds
---
Backtrace:
▆
1. └─joineRML::mjoint(...)
2. └─joineRML:::initsSurv(...)
3. └─joineRML:::initsSurv_balanced(...)
4. └─survival::coxph.detail(fitAG)
5. └─survival:::coxph.getdata(object, offset = TRUE)
6. ├─stats::model.matrix(fit, data = mf)
7. └─survival:::model.matrix.coxph(fit, data = mf)
8. └─stats::delete.response(object$terms)
9. └─stats (local) off(a$specials[[i]])
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Error: processing vignette 'joineRML.Rmd' failed with diagnostics:
subscript out of bounds
--- failed re-building ‘joineRML.Rmd’
--- re-building ‘technical.Rnw’ using Sweave
--- finished re-building ‘technical.Rnw’
SUMMARY: processing the following files failed:
‘joineRML-tidy.Rmd’ ‘joineRML.Rmd’
Error: Vignette re-building failed.
Execution halted
Flavor: r-devel-linux-x86_64-debian-gcc