tests/testthat/test_simulate_trials.R

test_that('Simulations ', {

  true_prob_tox <- c(0.12, 0.27, 0.44, 0.53, 0.57)
  num_sims <- 10

  # Scenario 1 - 3+3 simulations
  sims <- get_three_plus_three(num_doses = 5) %>%
    simulate_trials(num_sims = num_sims, true_prob_tox = true_prob_tox)

  expect_is(sims, "simulations")
  expect_equal(length(sims$fits), num_sims)
  # Expect one model fit each iteration
  expect_true(all(sapply(sims$fit, length) == 1))
  # Probability of recommendation should be 1
  expect_true(abs(sum(prob_recommend(sims)) - 1) < 0.01)



  # Scenario 2 - CRM simulations

  # Scenario 2a - plain vailla
  skeleton <- c(0.05, 0.1, 0.25, 0.4, 0.6)
  target <- 0.25
  sims <- get_dfcrm(skeleton = skeleton, target = target) %>%
    stop_at_n(n = 12) %>%
    simulate_trials(num_sims = 10, true_prob_tox = true_prob_tox)
  expect_is(sims, "simulations")
  expect_equal(length(sims$fits), num_sims)
  # Expect one model fit each iteration
  expect_true(all(sapply(sims$fit, length) == 1))
  # Probability of recommendation should be 1
  expect_true(abs(sum(prob_recommend(sims)) - 1) < 0.01)


  # Scenario 2b - use previous outcomes
  sims <- get_dfcrm(skeleton = skeleton, target = target) %>%
    stop_at_n(n = 12) %>%
    simulate_trials(num_sims = 10, true_prob_tox = true_prob_tox,
                    previous_outcomes = '5TTT')
  expect_is(sims, "simulations")
  expect_equal(length(sims$fits), num_sims)
  # Expect one model fit each iteration
  expect_true(all(sapply(sims$fit, length) == 1))
  # Probability of recommendation should be 1
  expect_true(abs(sum(prob_recommend(sims)) - 1) < 0.01)
  # Every simulation should have treated at least 3 patients at dose 5
  expect_true(all(n_at_dose(sims)['5'] >= 3))
  # Every simulation should have seen at least 3 toxes at dose 5
  expect_true(all(tox_at_dose(sims)['5'] >= 3))


  # Scenario 2c - use previous outcomes
  sims <- get_dfcrm(skeleton = skeleton, target = target) %>%
    stop_at_n(n = 12) %>%
    simulate_trials(num_sims = 10, true_prob_tox = true_prob_tox,
                    next_dose = 5)
  expect_is(sims, "simulations")
  expect_equal(length(sims$fits), num_sims)
  # Expect one model fit each iteration
  expect_true(all(sapply(sims$fit, length) == 1))
  # Probability of recommendation should be 1
  expect_true(abs(sum(prob_recommend(sims)) - 1) < 0.01)
  # Every simulation should have treated at least 3 patients at dose 5
  expect_true(all(n_at_dose(sims)['5'] >= 3))


  # Scenario 2d - breach the limit of 30 model invocations
  # Expect this to warn - the simulation was forcibly ended.
  expect_warning(sims <- get_dfcrm(skeleton = skeleton, target = target) %>%
                   stop_at_n(n = 99) %>%
                   simulate_trials(num_sims = 1, true_prob_tox = true_prob_tox)
  )
  # Nevertheless, it should have succeeded and contain sensible results:
  expect_is(sims, "simulations")
  expect_equal(length(sims$fits), 1)
  # Expect one model fit each iteration
  expect_true(all(sapply(sims$fit, length) == 1))
  # Probability of recommendation should be 1
  expect_true(abs(sum(prob_recommend(sims)) - 1) < 0.01)
  # In this scenario, each iteration will have treated 87 patients:
  expect_true(all(num_patients(sims) == 87))


  # Scenario 2e - intentionally breach the limit of 30 model invocations
  # In contrast to 2d, expect this not to warn.
  sims <- get_dfcrm(skeleton = skeleton, target = target) %>%
    stop_at_n(n = 99) %>%
    simulate_trials(num_sims = 1, true_prob_tox = true_prob_tox,
                    i_like_big_trials = TRUE)
  # Expect one model fit each iteration
  expect_true(all(sapply(sims$fit, length) == 1))
  # Probability of recommendation should be 1
  expect_true(abs(sum(prob_recommend(sims)) - 1) < 0.01)
  # Expect no warning
  expect_true(all(num_patients(sims) == 99))


  # Scenario 2f - return all model fits
  sims <- get_three_plus_three(num_doses = 5) %>%
    simulate_trials(num_sims = num_sims, true_prob_tox = true_prob_tox,
                    return_all_fits = TRUE)
  # Expect many model fits per iteration
  expect_true(all(sapply(sims$fit, length) >= 1))
  expect_true(any(sapply(sims$fit, length) > 1))
  # Probability of recommendation should be 1
  expect_true(abs(sum(prob_recommend(sims)) - 1) < 0.01)

})

Try the escalation package in your browser

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

escalation documentation built on May 31, 2023, 6:32 p.m.