Running 'testthat.R' [10s/12s]
Running the tests in 'tests/testthat.R' failed.
Complete output:
  > library(testthat)
  > test_check("bayesCT")
  Loading required package: bayesCT
  
  Attaching package: 'bayesCT'
  
  The following object is masked from 'package:stats':
  
      simulate
  
  
   *** caught segfault ***
  address 0x200000069, cause 'memory not mapped'
  
  Traceback:
   1: regroup(attr(out, "groups"), environment())
   2: filter.tbl_df(., subject_enrolled)
   3: filter(., subject_enrolled)
   4: function_list[[i]](value)
   5: freduce(value, `_function_list`)
   6: `_fseq`(`_lhs`)
   7: eval(quote(`_fseq`(`_lhs`)), env, env)
   8: eval(quote(`_fseq`(`_lhs`)), env, env)
   9: withVisible(eval(quote(`_fseq`(`_lhs`)), env, env))
  10: data_success_impute %>% filter(subject_enrolled) %>% ungroup() %>%     select(time, event, treatment)
  11: (function (hazard_treatment, cutpoint = NULL, hazard_control = NULL,     N_total, breaks = NULL, time0 = NULL, treatment0 = NULL,     event0 = NULL, lambda = 0.3, lambda_time = NULL, interim_look = NULL,     EndofStudy, prior = c(0.1, 0.1), block = 2, rand_ratio = c(1,         1), prop_loss_to_followup = 0.1, alternative = "greater",     h0 = 0, futility_prob = 0.05, expected_success_prob = 0.9,     prob_ha = 0.95, N_impute = 10, number_mcmc = 10000, discount_function = "identity",     alpha_max = 1, fix_alpha = FALSE, weibull_scale = 0.135,     weibull_shape = 3, method = "fixed") {    if (!is.null(interim_look)) {        stopifnot(all(N_total > interim_look))    }    if (!is.null(time0)) {        data0 <- data.frame(cbind(time = time0, event = event0,             treatment = treatment0))    }    else {        data0 <- NULL    }    if (alternative != "two-sided" & alternative != "greater" &         alternative != "less") {        stop("The input for alternative is wrong!")    }    if (!is.null(cutpoint)) {        breaks <- cutpoint    }    if (!is.null(breaks)) {        stopifnot(any(breaks < EndofStudy))    }    if (is.null(hazard_control) & h0 == 0) {        h0 <- 0.5    }    analysis_at_enrollnumber <- c(interim_look, N_total)    enrollment <- enrollment(param = lambda, N_total = N_total,         time = lambda_time)    if (!is.null(hazard_control)) {        group <- randomization(N_total = N_total, block = block,             allocation = rand_ratio)    }    else {        group <- rep(1, N_total)    }    time <- rep(NA, length = N_total)    event <- rep(NA, length = N_total)    if (!is.null(hazard_control)) {        sim_control <- pw_exp_sim(hazard = hazard_control, n = sum(!group),             maxtime = EndofStudy, cutpoint = cutpoint)        time[which(!group)] <- sim_control$time        event[which(!group)] <- sim_control$event    }    sim_treatment <- pw_exp_sim(hazard = hazard_treatment, n = sum(group),         maxtime = EndofStudy, cutpoint = cutpoint)    time[which(!!group)] <- sim_treatment$time    event[which(!!group)] <- sim_treatment$event    if (is.null(breaks)) {        breaks <- mean(time)    }    n_loss_to_fu <- ceiling(prop_loss_to_followup * N_total)    loss_to_fu <- rep(FALSE, N_total)    loss_to_fu[sample(1:N_total, n_loss_to_fu)] <- TRUE    data_total <- data.frame(time = time, treatment = group,         event = event, enrollment = enrollment, id = 1:N_total,         loss_to_fu = loss_to_fu)    data_total$time[data_total$loss_to_fu] <- runif(n_loss_to_fu,         0, data_total$time[data_total$loss_to_fu])    data_total$event[data_total$loss_to_fu] <- rep(0, n_loss_to_fu)    stop_futility <- 0    stop_expected_success <- 0    if (length(analysis_at_enrollnumber) > 1) {        for (i in 1:(length(analysis_at_enrollnumber) - 1)) {            data_interim <- data_total %>% mutate(subject_enrolled = id <=                 analysis_at_enrollnumber[i], subject_impute_futility = !subject_enrolled) %>%                 group_by(subject_enrolled) %>% mutate(subject_impute_success = event *                 (enrollment[analysis_at_enrollnumber[i]] - enrollment <=                   EndofStudy & subject_enrolled) | (1 - event) *                 (enrollment[analysis_at_enrollnumber[i]] - enrollment <=                   time & subject_enrolled) | (subject_enrolled &                 loss_to_fu)) %>% mutate(real_time = ifelse(event *                 (enrollment[analysis_at_enrollnumber[i]] - enrollment <=                   EndofStudy & subject_enrolled) | (1 - event) *                 (enrollment[analysis_at_enrollnumber[i]] - enrollment <=                   time & subject_enrolled), enrollment[analysis_at_enrollnumber[i]] -                 enrollment + sd(time)/10000, time)) %>% mutate(real_event = ifelse(event *                 (enrollment[analysis_at_enrollnumber[i]] - enrollment <=                   EndofStudy & subject_enrolled) | (1 - event) *                 (enrollment[analysis_at_enrollnumber[i]] - enrollment <=                   time & subject_enrolled), 0, event))            data_interim <- data_interim %>% mutate(time = real_time,                 event = real_event) %>% select(-c(real_time,                 real_event))            data <- data_interim %>% filter(subject_enrolled) %>%                 ungroup() %>% select(time, event, treatment)            post <- suppressWarnings(bdpsurvival(formula = Surv(time,                 event) ~ treatment, data = data, data0 = data0,                 breaks = breaks, a0 = prior[1], b0 = prior[2],                 surv_time = EndofStudy, discount_function = discount_function,                 alpha_max = alpha_max, fix_alpha = fix_alpha,                 number_mcmc = number_mcmc, weibull_scale = weibull_scale,                 weibull_shape = weibull_shape, method = method))            futility_test <- 0            expected_success_test <- 0            for (j in 1:N_impute) {                if (!is.null(hazard_control)) {                  control_impute <- data_interim %>% filter(treatment ==                     0 & subject_impute_success)                  impute_control <- pw_exp_impute(time = control_impute$time,                     hazard = post$posterior_control$posterior_flat_hazard[i,                       ], maxtime = EndofStudy, cutpoint = post$args1$breaks)                  data_control_success_impute <- data_interim %>%                     filter(treatment == 0 & subject_impute_success) %>%                     bind_cols(time_impute = impute_control$time,                       event_impute = impute_control$event)                }                else {                  data_control_success_impute <- NULL                }                treatment_impute <- data_interim %>% filter(treatment ==                   1 & subject_impute_success)                impute_treatment <- pw_exp_impute(time = treatment_impute$time,                   hazard = post$posterior_treatment$posterior_flat_hazard[i,                     ], maxtime = EndofStudy, cutpoint = post$args1$breaks)                data_treatment_success_impute <- data_interim %>%                   filter(treatment == 1 & subject_impute_success) %>%                   bind_cols(time_impute = impute_treatment$time,                     event_impute = impute_treatment$event)                data_noimpute <- data_interim %>% filter(!subject_impute_success) %>%                   mutate(time_impute = time, event_impute = event)                data_success_impute <- bind_rows(data_control_success_impute,                   data_treatment_success_impute, data_noimpute) %>%                   mutate(time = time_impute, event = event_impute) %>%                   select(-c(time_impute, event_impute))                data <- data_success_impute %>% filter(subject_enrolled) %>%                   ungroup() %>% select(time, event, treatment)                post_imp <- suppressWarnings(bdpsurvival(formula = Surv(time,                   event) ~ treatment, data = data, data0 = data0,                   breaks = breaks, a0 = prior[1], b0 = prior[2],                   surv_time = EndofStudy, discount_function = discount_function,                   alpha_max = alpha_max, fix_alpha = fix_alpha,                   number_mcmc = number_mcmc, weibull_scale = weibull_scale,                   weibull_shape = weibull_shape, method = method))                if (sum(data$treatment == 0) != 0) {                  effect_imp <- post_imp$final$posterior_loghazard                  if (alternative == "two-sided") {                    success <- max(c(mean(effect_imp > h0), mean(-effect_imp >                       h0)))                  }                  else if (alternative == "greater") {                    success <- mean(effect_imp > h0)                  }                  else {                    success <- mean(-effect_imp > h0)                  }                }                else {                  effect_imp <- post_imp$final$posterior_survival                  if (alternative == "two-sided") {                    success <- max(c(mean(effect_imp > h0), mean(effect_imp <                       h0)))                  }                  else if (alternative == "greater") {                    success <- mean(effect_imp > h0)                  }                  else {                    success <- mean(effect_imp < h0)                  }                }                if (success > prob_ha) {                  expected_success_test <- expected_success_test +                     1                }                if (!is.null(hazard_control)) {                  control_impute <- data_success_impute %>% filter(treatment ==                     0 & subject_impute_futility)                  impute_control <- pw_exp_sim(hazard = post$posterior_control$posterior_flat_hazard[i,                     ], n = nrow(control_impute), maxtime = EndofStudy,                     cutpoint = post$args1$breaks)                  data_control_futility_impute <- data_success_impute %>%                     filter(treatment == 0 & subject_impute_futility) %>%                     bind_cols(time_impute = impute_control$time,                       event_impute = impute_control$event)                }                else {                  data_control_futility_impute <- NULL                }                treatment_impute <- data_success_impute %>% filter(treatment ==                   1 & subject_impute_futility)                impute_treatment <- pw_exp_sim(hazard = post$posterior_treatment$posterior_flat_hazard[i,                   ], n = nrow(treatment_impute), maxtime = EndofStudy,                   cutpoint = post$args1$breaks)                data_treatment_futility_impute <- data_success_impute %>%                   filter(treatment == 1 & subject_impute_futility) %>%                   bind_cols(time_impute = impute_treatment$time,                     event_impute = impute_treatment$event)                data_noimpute_futility <- data_success_impute %>%                   filter(!subject_impute_futility) %>% mutate(time_impute = time,                   event_impute = event)                data_futility_impute <- bind_rows(data_control_futility_impute,                   data_treatment_futility_impute, data_noimpute_futility) %>%                   mutate(time = time_impute, event = event_impute) %>%                   select(-c(time_impute, event_impute))                data <- data_futility_impute %>% ungroup() %>%                   select(time, event, treatment)                post_imp <- suppressWarnings(bdpsurvival(formula = Surv(time,                   event) ~ treatment, data = data, data0 = data0,                   breaks = breaks, a0 = prior[1], b0 = prior[2],                   surv_time = EndofStudy, discount_function = discount_function,                   alpha_max = alpha_max, fix_alpha = fix_alpha,                   number_mcmc = number_mcmc, weibull_scale = weibull_scale,                   weibull_shape = weibull_shape, method = method))                if (sum(data$treatment == 0) != 0) {                  effect_imp <- post_imp$final$posterior_loghazard                  if (alternative == "two-sided") {                    success <- max(c(mean(effect_imp > h0), mean(-effect_imp >                       h0)))                  }                  else if (alternative == "greater") {                    success <- mean(effect_imp > h0)                  }                  else {                    success <- mean(-effect_imp > h0)                  }                }                else {                  effect_imp <- post_imp$final$posterior_survival                  if (alternative == "two-sided") {                    success <- max(c(mean(effect_imp > h0), mean(effect_imp <                       h0)))                  }                  else if (alternative == "greater") {                    success <- mean(effect_imp > h0)                  }                  else {                    success <- mean(effect_imp < h0)                  }                }                if (success > prob_ha) {                  futility_test <- futility_test + 1                }            }            if (expected_success_test/N_impute > expected_success_prob) {                stop_expected_success <- 1                stage_trial_stopped <- analysis_at_enrollnumber[i]                break            }            if (futility_test/N_impute < futility_prob) {                stop_futility <- 1                stage_trial_stopped <- analysis_at_enrollnumber[i]                break            }            if (analysis_at_enrollnumber[i + 1] == N_total) {                stage_trial_stopped <- analysis_at_enrollnumber[i +                   1]                break            }        }        if (sum(data$treatment == 0) != 0) {            if (alternative == "two-sided") {                effect_int <- post$final$posterior_loghazard            }            else if (alternative == "greater") {                effect_int <- post$final$posterior_loghazard            }            else {                effect_int <- post$final$posterior_loghazard            }        }        else {            effect_int <- post_imp$posterior_treatment$posterior_survival        }        N_enrolled <- nrow(data_interim[data_interim$id <= stage_trial_stopped,             ])    }    else {        N_enrolled <- N_total        stage_trial_stopped <- N_total        stop_futility <- 0        stop_expected_success <- 0    }    data_final <- data_total %>% filter(id <= stage_trial_stopped) %>%         ungroup() %>% select(time, event, treatment)    post_final <- suppressWarnings(bdpsurvival(formula = Surv(time,         event) ~ treatment, data = data_final, data0 = data0,         breaks = breaks, a0 = prior[1], b0 = prior[2], surv_time = EndofStudy,         discount_function = discount_function, alpha_max = alpha_max,         fix_alpha = fix_alpha, number_mcmc = number_mcmc, weibull_scale = weibull_scale,         weibull_shape = weibull_shape, method = method))    data_final <- data_total %>% filter(id <= stage_trial_stopped)    if (sum(data_final$treatment == 0) != 0) {        effect <- post_final$final$posterior_loghazard        if (alternative == "two-sided") {            post_paa <- max(c(mean(effect > h0), mean(-effect >                 h0)))        }        else if (alternative == "greater") {            post_paa <- mean(effect > h0)        }        else {            post_paa <- mean(-effect > h0)        }    }    else {        effect <- post_final$final$posterior_survival        if (alternative == "two-sided") {            post_paa <- max(c(mean(effect > h0), mean(effect >                 h0)))        }        else if (alternative == "greater") {            post_paa <- mean(effect > h0)        }        else {            post_paa <- mean(effect < h0)        }    }    N_treatment <- sum(!!data_final$treatment)    N_control <- sum(!data_final$treatment)    results_list <- list(hazard_treatment = hazard_treatment,         hazard_control = hazard_control, cutpoint = cutpoint,         prob_of_accepting_alternative = prob_ha, margin = h0,         alternative = alternative, interim_look = interim_look,         N_treatment = N_treatment, N_control = N_control, N_enrolled = N_treatment +             N_control, N_max = N_total, post_prob_accept_alternative = post_paa,         est_final = mean(effect), stop_futility = stop_futility,         stop_expected_success = stop_expected_success)    if (length(analysis_at_enrollnumber) > 1) {        results_list <- c(results_list, est_interim = mean(effect_int))    }    results_list})(hazard_treatment = c(0.01, 0.02), cutpoint = 25, EndofStudy = 50,     N_impute = 10, N_total = 300, lambda = c(0.3, 1), lambda_time = 25,     interim_look = c(220, 270), alternative = "less")
  12: do.call(survivalBACT, input2)
  13: eval_bare(expr, quo_get_env(quo))
  14: quasi_label(enquo(object), label, arg = "object")
  15: expect_equal(do.call(survivalBACT, input2)$prob_of_accepting_alternative,     0.95)
  16: eval(code, test_env)
  17: eval(code, test_env)
  18: 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)
  19: doTryCatch(return(expr), name, parentenv, handler)
  20: tryCatchOne(expr, names, parentenv, handlers[[1L]])
  21: tryCatchList(expr, names[-nh], parentenv, handlers[-nh])
  22: doTryCatch(return(expr), name, parentenv, handler)
  23: tryCatchOne(tryCatchList(expr, names[-nh], parentenv, handlers[-nh]),     names[nh], parentenv, handlers[[nh]])
  24: tryCatchList(expr, classes, parentenv, handlers)
  25: 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) {    })
  26: test_code(desc, code, env = parent.frame())
  27: test_that("The binomial bayesCT is ", {    suppressWarnings(RNGversion("3.5.0"))    expect_equal(do.call(survivalBACT, input1)$hazard_treatment,         0.01)    expect_equal(do.call(survivalBACT, input2)$margin, 0.5)    expect_equal(do.call(survivalBACT, input2)$prob_of_accepting_alternative,         0.95)    input1$alternative <- "lessthan"    expect_error(do.call(binomialBACT, input1))})
  28: eval(code, test_env)
  29: eval(code, test_env)
  30: 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)
  31: doTryCatch(return(expr), name, parentenv, handler)
  32: tryCatchOne(expr, names, parentenv, handlers[[1L]])
  33: tryCatchList(expr, names[-nh], parentenv, handlers[-nh])
  34: doTryCatch(return(expr), name, parentenv, handler)
  35: tryCatchOne(tryCatchList(expr, names[-nh], parentenv, handlers[-nh]),     names[nh], parentenv, handlers[[nh]])
  36: tryCatchList(expr, classes, parentenv, handlers)
  37: 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) {    })
  38: test_code(NULL, exprs, env)
  39: source_file(path, new.env(parent = env), chdir = TRUE, wrap = wrap)
  40: force(code)
  41: doWithOneRestart(return(expr), restart)
  42: withOneRestart(expr, restarts[[1L]])
  43: withRestarts(testthat_abort_reporter = function() NULL, force(code))
  44: with_reporter(reporter = reporter, start_end_reporter = start_end_reporter,     {        reporter$start_file(basename(path))        lister$start_file(basename(path))        source_file(path, new.env(parent = env), chdir = TRUE,             wrap = wrap)        reporter$.end_context()        reporter$end_file()    })
  45: FUN(X[[i]], ...)
  46: lapply(paths, test_file, env = env, reporter = current_reporter,     start_end_reporter = FALSE, load_helpers = FALSE, wrap = wrap)
  47: force(code)
  48: doWithOneRestart(return(expr), restart)
  49: withOneRestart(expr, restarts[[1L]])
  50: withRestarts(testthat_abort_reporter = function() NULL, force(code))
  51: with_reporter(reporter = current_reporter, results <- lapply(paths,     test_file, env = env, reporter = current_reporter, start_end_reporter = FALSE,     load_helpers = FALSE, wrap = wrap))
  52: test_files(paths, reporter = reporter, env = env, stop_on_failure = stop_on_failure,     stop_on_warning = stop_on_warning, wrap = wrap)
  53: test_dir(path = test_path, reporter = reporter, env = env, filter = filter,     ..., stop_on_failure = stop_on_failure, stop_on_warning = stop_on_warning,     wrap = wrap)
  54: test_package_dir(package = package, test_path = test_path, filter = filter,     reporter = reporter, ..., stop_on_failure = stop_on_failure,     stop_on_warning = stop_on_warning, wrap = wrap)
  55: test_check("bayesCT")
  An irrecoverable exception occurred. R is aborting now ...
  Segmentation fault