tests/testthat/test-opt_design.R

In baskexact: Analytical Calculation of Basket Trial Operating Characteristics

test_that("opt_design works", {
  # Single-stage design
  design <- setupOneStageBasket(k = 3, p0 = 0.2)
  optres1 <- opt_design(design = design, n = 15, alpha = 0.05,
    weight_fun = weights_fujikawa, weight_params = list(epsilon = c(1, 2),
    tau = c(0)), globalweight_fun = globalweights_diff, globalweight_params =
      list(eps_global = c(1, 2)), scenarios = get_scenarios(design, 0.5),
    prec_digits = 4)

  lambdres1 <- adjust_lambda(design = design, alpha = 0.05, n = 15,
    weight_fun = weights_fujikawa, weight_params = list(epsilon =
        optres1[1, ]$epsilon, tau = optres1[1, ]$tau),
    globalweight_fun = globalweights_diff, globalweight_params =
      list(eps_global = optres1[1, ]$eps_global), prec_digits = 4)
  ecdres11 <- ecd(design = design, n = 15, weight_fun = weights_fujikawa,
    lambda = lambdres1$lambda, weight_params = list(epsilon =
        optres1[1, ]$epsilon, tau = optres1[1, ]$tau), globalweight_fun =
      globalweights_diff, globalweight_params = list(eps_global =
          optres1[1, ]$eps_global))
  ecdres21 <- ecd(design = design, n = 15, p1 = c(0.2, 0.2, 0.5),
    lambda = lambdres1$lambda, weight_fun = weights_fujikawa,
    weight_params = list(epsilon = optres1[1, ]$epsilon,
      tau = optres1[1, ]$tau), globalweight_fun = globalweights_diff,
    globalweight_params = list(eps_global = optres1[1, ]$eps_global))
  ecdres31 <- ecd(design = design, n = 15, p1 = c(0.2, 0.5, 0.5),
    lambda = lambdres1$lambda, weight_fun = weights_fujikawa,
    weight_params = list(epsilon = optres1[1, ]$epsilon,
      tau = optres1[1, ]$tau), globalweight_fun = globalweights_diff,
    globalweight_params = list(eps_global = optres1[1, ]$eps_global))
  ecdres41 <- ecd(design = design, n = 15, p1 = c(0.5, 0.5, 0.5),
    lambda = lambdres1$lambda, weight_fun = weights_fujikawa,
    weight_params = list(epsilon = optres1[1, ]$epsilon,
      tau = optres1[1, ]$tau), globalweight_fun = globalweights_diff,
    globalweight_params = list(eps_global = optres1[1, ]$eps_global))

  expect_equal(optres1[1, 4], lambdres1$lambda)
  expect_equal(optres1[1, 5], ecdres11)
  expect_equal(optres1[1, 6], ecdres21)
  expect_equal(optres1[1, 7], ecdres31)
  expect_equal(optres1[1, 8], ecdres41)
  expect_equal(optres1[1, 9], mean(c(ecdres11, ecdres21, ecdres31, ecdres41)))

  # Border case with no tuning parameter values
  optres2 <- opt_design(design = design, n = 15, alpha = 0.05,
    weight_fun = weights_fujikawa, globalweight_fun = globalweights_diff,
    scenarios = get_scenarios(design, 0.5), prec_digits = 4)

  lambdres2 <- adjust_lambda(design = design, alpha = 0.05, n = 15,
    weight_fun = weights_fujikawa, globalweight_fun = globalweights_diff,
    prec_digits = 4)
  ecdres12 <- ecd(design = design, n = 15, weight_fun = weights_fujikawa,
    lambda = lambdres2$lambda, globalweight_fun = globalweights_diff)
  ecdres22 <- ecd(design = design, n = 15, p1 = c(0.2, 0.2, 0.5),
    lambda = lambdres2$lambda, weight_fun = weights_fujikawa,
    globalweight_fun = globalweights_diff)
  ecdres32 <- ecd(design = design, n = 15, p1 = c(0.2, 0.5, 0.5),
    lambda = lambdres2$lambda, weight_fun = weights_fujikawa,
    globalweight_fun = globalweights_diff)
  ecdres42 <- ecd(design = design, n = 15, p1 = c(0.5, 0.5, 0.5),
    lambda = lambdres2$lambda, weight_fun = weights_fujikawa,
    globalweight_fun = globalweights_diff)

  expect_equal(as.numeric(optres2[1]), lambdres2$lambda)
  expect_equal(as.numeric(optres2[2]), ecdres12)
  expect_equal(as.numeric(optres2[3]), ecdres22)
  expect_equal(as.numeric(optres2[4]), ecdres32)
  expect_equal(as.numeric(optres2[5]), ecdres42)
  expect_equal(as.numeric(optres2[6]), mean(c(ecdres12, ecdres22, ecdres32, ecdres42)))

  # Two-stage design
  design2 <- setupTwoStageBasket(k = 3, p0 = 0.2)
  optres_2stage <- opt_design(
    design = design2,
    n = 7,
    n1 = 3,
    alpha = 0.1,
    interim_fun = interim_posterior,
    interim_params = list(prob_futstop = c(0.1, 0.2), prob_effstop = 0.99),
    weight_fun = weights_cpp,
    weight_params = list(a = c(1, 2), b = 1),
    scenarios = get_scenarios(design2, 0.5),
    prec_digits = 3
  )

  lambdres_2stage <- adjust_lambda(design = design2, alpha = 0.1, n = 7, n1 = 3,
    interim_fun = interim_posterior,
    interim_params = list(prob_futstop = optres_2stage[1, "prob_futstop"],
      prob_effstop = optres_2stage[1, "prob_effstop"]),
    weight_fun = weights_cpp,
    weight_params = list(a = optres_2stage[1, "a"], b = optres_2stage[1, "b"]),
    prec_digits = 3)
  ecdres1_2stage <- ecd(design = design2, n = 7, n1 = 3,
    lambda = lambdres_2stage$lambda, interim_fun = interim_posterior,
    interim_params = list(prob_futstop = optres_2stage[1, "prob_futstop"],
      prob_effstop = optres_2stage[1, "prob_effstop"]),
    weight_fun = weights_cpp,
    weight_params = list(a = optres_2stage[1, "a"], b = optres_2stage[1, "b"]))
  ecdres2_2stage <- ecd(design = design2, n = 7, n1 = 3, p1 = c(0.2, 0.2, 0.5),
    lambda = lambdres_2stage$lambda, interim_fun = interim_posterior,
    interim_params = list(prob_futstop = optres_2stage[1, "prob_futstop"],
      prob_effstop = optres_2stage[1, "prob_effstop"]),
    weight_fun = weights_cpp,
    weight_params = list(a = optres_2stage[1, "a"], b = optres_2stage[1, "b"]))
  ecdres3_2stage <- ecd(design = design2, n = 7, n1 = 3, p1 = c(0.2, 0.5, 0.5),
    lambda = lambdres_2stage$lambda, interim_fun = interim_posterior,
    interim_params = list(prob_futstop = optres_2stage[1, "prob_futstop"],
      prob_effstop = optres_2stage[1, "prob_effstop"]),
    weight_fun = weights_cpp,
    weight_params = list(a = optres_2stage[1, "a"], b = optres_2stage[1, "b"]))
  ecdres4_2stage <- ecd(design = design2, n = 7, n1 = 3, p1 = c(0.5, 0.5, 0.5),
    lambda = lambdres_2stage$lambda, interim_fun = interim_posterior,
    interim_params = list(prob_futstop = optres_2stage[1, "prob_futstop"],
      prob_effstop = optres_2stage[1, "prob_effstop"]),
    weight_fun = weights_cpp,
    weight_params = list(a = optres_2stage[1, "a"], b = optres_2stage[1, "b"]))
  meanecd_2stage <- mean(c(ecdres1_2stage, ecdres2_2stage, ecdres3_2stage,
    ecdres4_2stage))

  expect_equal(optres_2stage[1, 5], lambdres_2stage$lambda)
  expect_equal(optres_2stage[1, 6], ecdres1_2stage)
  expect_equal(optres_2stage[1, 7], ecdres2_2stage)
  expect_equal(optres_2stage[1, 8], ecdres3_2stage)
  expect_equal(optres_2stage[1, 9], ecdres4_2stage)
  expect_equal(optres_2stage[1, 10], meanecd_2stage)

  optres_2stage2 <- opt_design(
    design = design2,
    n = 7,
    n1 = 3,
    alpha = 0.3,
    interim_fun = interim_posterior,
    weight_fun = weights_cpp,
    globalweight_fun = globalweights_fix,
    globalweight_params = list(w = c(0.5, 0.1)),
    scenarios = get_scenarios(design2, 0.5),
    prec_digits = 3
  )

  expect_true(nrow(optres_2stage2) == 2)

  optres_2stage3 <- opt_design(
    design = design2,
    n = 7,
    n1 = 3,
    alpha = 0.3,
    interim_fun = interim_posterior,
    weight_fun = weights_cpp,
    scenarios = get_scenarios(design2, 0.5),
    prec_digits = 3
  )

  expect_true(nrow(optres_2stage3) == 1)
})