tests/testit/test-independent-gs_design_combo.R

params_gs_design_combo <- test_gs_design_combo()

assert("calculate analysis number as planned", {
  res <- params_gs_design_combo
  fh_test <- res$fh_test
  gs_design_combo_test2 <- res$gs_design_combo_test2

  (all.equal(max(fh_test$analysis), max(gs_design_combo_test2$analysis$analysis)))
})

assert("calculate analysisTimes as planned", {
  res <- params_gs_design_combo
  fh_test <- res$fh_test
  gs_design_combo_test2 <- res$gs_design_combo_test2

  (unique(fh_test$analysis_time) %==% unique(gs_design_combo_test2$analysis$time))
})

assert("calculate N and each analysis Events N as planned", {
  res <- params_gs_design_combo
  fh_test <- res$fh_test
  enroll_rate <- res$enroll_rate
  fail_rate <- res$fail_rate
  gs_design_combo_test2 <- res$gs_design_combo_test2

  enrollsum <- enroll_rate$duration * enroll_rate$rate
  N <- max(gs_design_combo_test2$analysis$n)
  res <- vapply(1:max(fh_test$analysis), function(i) {
    test_event(
      enroll_rate = enroll_rate,
      fail_rate = fail_rate,
      td = unique(fh_test$analysis_time)[i]
    ) * N / enrollsum
  }, numeric(1))
  expected <- unique(gs_design_combo_test2$analysis$event)
  (all.equal(res, expected, tolerance = 0.01))
})

assert("calculate probability under alternative", {
  res <- params_gs_design_combo
  beta <- res$beta
  gs_design_combo_test2 <- res$gs_design_combo_test2

  res <- 1 - beta
  expected <- max((gs_design_combo_test2$bounds |>
    dplyr::filter(bound == "upper"))$probability)
  (all.equal(res, expected, tolerance = 0.0001))
})

assert("calculate probability under null", {
  res <- params_gs_design_combo
  alpha <- res$alpha
  gs_design_combo_test2 <- res$gs_design_combo_test2

  res <- alpha
  expected <- max((gs_design_combo_test2$bounds |>
    dplyr::filter(bound == "upper"))$probability0)
  (all.equal(res, expected, tolerance = 0.005, scale = 1))
})

assert("arguments are passed via ... to mvtnorm::pmvnorm()", {
  with_seed <- function(seed, code) {
    code <- substitute(code)
    original_seed <- .Random.seed
    on.exit(.Random.seed <<- original_seed)
    set.seed(seed)
    eval.parent(code)
  }

  x1 <- gs_design_combo(seed = 1)
  x2 <- gs_design_combo(seed = 1)
  x3 <- gs_design_combo(seed = 2)
  (x1 %==% x2)
  (!(identical(x1, x3)))
})

Try the gsDesign2 package in your browser

Any scripts or data that you put into this service are public.

gsDesign2 documentation built on July 1, 2026, 1:08 a.m.