diff --git a/tests/testthat/test-Design-methods.R b/tests/testthat/test-Design-methods.R index 864eb7007..75fac78c5 100644 --- a/tests/testthat/test-Design-methods.R +++ b/tests/testthat/test-Design-methods.R @@ -43,6 +43,130 @@ test_that("simulate produces consistent results with sentinel patients", { expect_snapshot(result) }) +test_that("simulate for the class design returns correct objects", { + design <- h_get_design_data() + myTruth <- probFunction(design@model, alpha0 = 7, alpha1 = 8) + options <- h_get_mcmc_options() + + mySims <- simulate( + design, + args = NULL, + truth = myTruth, + nsim = 1, + seed = 819, + mcmcOptions = options, + parallel = FALSE, + derive = list( + max_mtd = max, + mean_mtd = mean, + median_mtd = median + ) + ) + + expect_class(mySims, "Simulations") # check for correct class of returned object + + expect_equal(any(sapply(mySims@fit[[1]], is.numeric)), TRUE) # check if all elements in mySims@fit are numeric + + expect_equal(length(mySims@stop_report), 5) # check for length + + expect_logical(mySims@stop_report) # check for stop_report to be logical vector + + expect_list(mySims@data) + + expect_class(mySims@data[[1]], "Data") # check for data object has correct class + + expect_list(mySims@additional_stats) + + expect_list(mySims@additional_stats[[1]]) + + expect_length(mySims@additional_stats[[1]], 3) + + expect_equal(mySims@doses, 1) +}) + +test_that("simulate for the class design with placebo returns correct objects", { + design <- h_get_design_data(TRUE) + myTruth <- probFunction(design@model, alpha0 = 7, alpha1 = 8) + options <- h_get_mcmc_options() + + mySims <- simulate( + design, + args = NULL, + truth = myTruth, + nsim = 1, + seed = 819, + mcmcOptions = options, + parallel = FALSE, + derive = list( + max_mtd = max, + mean_mtd = mean, + median_mtd = median + ) + ) + + expect_class(mySims, "Simulations") # check for correct class of returned object + + expect_equal(any(sapply(mySims@fit[[1]], is.numeric)), TRUE) # check if all elements in mySims@fit are numeric + + expect_equal(length(mySims@stop_report), 5) # check for length + + expect_logical(mySims@stop_report) # check for stop_report to be logical vector + + expect_list(mySims@data) + + expect_class(mySims@data[[1]], "Data") # check for data object has correct class + + expect_list(mySims@additional_stats) + + expect_list(mySims@additional_stats[[1]]) + + expect_length(mySims@additional_stats[[1]], 3) + + expect_equal(mySims@doses, 1) +}) + +test_that("simulate for the class design with placebo and sentinel patients returns correct objects", { + design <- h_get_design_data(TRUE) + myTruth <- probFunction(design@model, alpha0 = 7, alpha1 = 8) + options <- h_get_mcmc_options() + + mySims <- simulate( + design, + args = NULL, + truth = myTruth, + nsim = 1, + seed = 819, + mcmcOptions = options, + parallel = FALSE, + firstSeparate = TRUE, + derive = list( + max_mtd = max, + mean_mtd = mean, + median_mtd = median + ) + ) + + expect_class(mySims, "Simulations") # check for correct class of returned object + + expect_equal(any(sapply(mySims@fit[[1]], is.numeric)), TRUE) # check if all elements in mySims@fit are numeric + + expect_equal(length(mySims@stop_report), 5) # check for length + + expect_logical(mySims@stop_report) # check for stop_report to be logical vector + + expect_list(mySims@data) + + expect_class(mySims@data[[1]], "Data") # check for data object has correct class + + expect_list(mySims@additional_stats) + + expect_list(mySims@additional_stats[[1]]) + + expect_length(mySims@additional_stats[[1]], 3) + + expect_equal(mySims@doses, 1) +}) + ## RuleDesign ---- test_that("simulate-RuleDesign produces consistent results", { @@ -106,6 +230,115 @@ test_that("simulate-DualDesign produces consistent results", { expect_snapshot(result) }) +test_that("simulate-DualDesign produces consistent results with sentinel patients", { + design <- h_get_design_dualdata() + + # define scenarios for the TRUE toxicity and efficacy profiles + betaMod <- function(dose, e0, eMax, delta1, delta2, scal) { + maxDens <- (delta1^delta1) * (delta2^delta2) / ((delta1 + delta2)^(delta1 + delta2)) + dose <- dose / scal + e0 + eMax / maxDens * (dose^delta1) * (1 - dose)^delta2 + } + + trueBiomarker <- function(dose) { + betaMod(dose, e0 = 0.2, eMax = 0.6, delta1 = 5, delta2 = 5 * 0.5 / 0.5, scal = 100) + } + + trueTox <- function(dose) { + pnorm((dose - 60) / 10) + } + + result <- simulate( + design, + trueTox = trueTox, + trueBiomarker = trueBiomarker, + sigma2W = 0.01, + rho = 0, + nsim = 1, + parallel = FALSE, + seed = 3, + startingDose = 6, + firstSeparate = TRUE, + mcmcOptions = McmcOptions( + burnin = 100, + step = 1, + samples = 300, + rng_kind = "Mersenne-Twister", + rng_seed = 1234 + ) + ) + + expect_equal(result@rho_est, 0.07991541, tolerance = 1e-7) # printed result + + expect_equal(result@rho_est, 0.079915412) # actual result + + expect_equal(result@sigma2w_est, 0.03177778, tolerance = 1e-7) # printed result + + expect_equal(result@sigma2w_est, 0.031777778) # actual result + + expect_equal(any(sapply(result@fit_biomarker[[1]], is.numeric)), TRUE) # all elements of fit are numeric + + expect_equal(dim(result@fit_biomarker[[1]])[1], 11) + + expect_equal(dim(result@fit_biomarker[[1]])[2], 3) + + expect_equal(length(result@stop_report), 3) # check for length + + expect_logical(result@stop_report) # check for stop_report to be logical vector + + expect_list(result@data) + + expect_class(result@data[[1]], "Data") # check for data object has correct class + + expect_list(result@additional_stats) + + expect_list(result@additional_stats[[1]]) + + expect_length(result@additional_stats[[1]], 0) + + expect_equal(result@doses, 1) +}) + +test_that("simulate-DualDesign produces consistent results", { + design <- h_get_design_dualdata(TRUE) + + # define scenarios for the TRUE toxicity and efficacy profiles + betaMod <- function(dose, e0, eMax, delta1, delta2, scal) { + maxDens <- (delta1^delta1) * (delta2^delta2) / ((delta1 + delta2)^(delta1 + delta2)) + dose <- dose / scal + e0 + eMax / maxDens * (dose^delta1) * (1 - dose)^delta2 + } + + trueBiomarker <- function(dose) { + betaMod(dose, e0 = 0.2, eMax = 0.6, delta1 = 5, delta2 = 5 * 0.5 / 0.5, scal = 100) + } + + trueTox <- function(dose) { + pnorm((dose - 60) / 10) + } + + result <- simulate( + design, + trueTox = trueTox, + trueBiomarker = trueBiomarker, + sigma2W = 0.01, + rho = 0, + nsim = 1, + parallel = FALSE, + seed = 3, + startingDose = 6, + mcmcOptions = McmcOptions( + burnin = 100, + step = 1, + samples = 300, + rng_kind = "Mersenne-Twister", + rng_seed = 1234 + ) + ) + + expect_snapshot(result) +}) + test_that("simulate-TDSamplesDesign produces consistent results", { data <- Data(doseGrid = seq(25, 300, 25))