tests/testthat/test-helper_app.R

In basksim: Simulation-Based Calculation of Basket Trial Operating Characteristics

test_that("get_alpha_0_app works", {
  set.seed(20230319)
  design <- setup_app(k = 3, p0 = 0.2)

  expect_equal(get_alpha_0_app(design = design, n = c(5,10,15)),
               matrix(data = c(1,5/10, 5/15, 1, 1, 10/15, 1, 1, 1),
                      ncol = 3, byrow = TRUE))

  expect_equal(get_alpha_0_app(design = design, n = 10),
               matrix(data = c(rep(1,9)), ncol = 3, byrow = TRUE))


})

test_that("get_gamma works", {

  validate_gamma <- function(n, r) {
    l1 <- function(x) stats::dbinom(x = r[1], size = n[1], prob = x)^
      min(1, n[2] / n[1])
    l2 <- function(x) stats::dbinom(x = r[2], size = n[2], prob = x)^
      min(1, n[1] / n[2])
    l1_int <- integrate(l1, 0, 1)$value
    l2_int <- integrate(l2, 0, 1)$value
    l_all <- function(x) (sqrt(l1(x) / l1_int) - sqrt(l2(x) / l2_int))^2
    l_all_int <- integrate(l_all, 0, 1)$value
    sqrt(1 / 2 * l_all_int)
  }


  expect_equal(get_gamma(n_gamma = c(10,15), r_gamma = c(8,10)),
               validate_gamma(n = c(10,15), r = c(8,10)))


})


test_that("beta_borrow_app works", {
  # compare with CPP (w = 1, alpha_0 = 1, gamma = 0)
  design_app <- setup_app(k = 3, p0 = 0.2)
  design_cpp <- setup_cpp(k = 3, p0 = 0.2)

  n <- 15
  r <- rep(10,3)

  weights <- get_weights_cpp(n = n, tune_a = 1, tune_b = 1)
  alpha_0 <- get_alpha_0_app(design = design_app, n = n)

  expect_equal(beta_borrow_app(design = design_app, n = n, r = r, alpha_0 = alpha_0),
               beta_borrow_pp(design = design_cpp, n = n, r = r, weights = weights))


})

test_that("ana_app works", {
  # compare with CPP (w = 1, alpha_0 = 1, gamma = 0)
  design_app <- setup_app(k = 3, p0 = 0.2)
  design_cpp <- setup_cpp(k = 3, p0 = 0.2)

  n <- 15
  r <- rep(10,3)
  lambda <- 0.987

  weights <- get_weights_cpp(n = n, tune_a = 1, tune_b = 1)
  alpha_0 <- get_alpha_0_app(design = design_app, n = n)

  expect_equal(ana_app(design = design_app, n = n, r = r, lambda = lambda,
                       alpha_0 = alpha_0),
               ana_pp(design = design_cpp, n = n, r = r, lambda = lambda,
                       weights = weights))


})