Update tests

Author: ewancarr

DESCRIPTION

@@ -50,7 +50,7 @@ Imports:
     ranger,
     pec
 Suggests:
-    testthat,
+    testthat (>= 3.0.0),
     covr,
     pmsampsize,
     rmarkdown,
@@ -62,3 +62,4 @@ LazyData: false
 Roxygen: list(markdown = TRUE)
 RoxygenNote: 7.3.3
 BuildVignettes: false
+Config/testthat/edition: 3

R/print.R

@@ -2,21 +2,21 @@
 #' @export
 print.pmsims <- function(x, ..., max_width = 80) {
   if (!inherits(x, "pmsims")) stop("Object is not of class 'pmsims'")
-  
+
   `%||%` <- function(a, b) if (!is.null(a)) a else b
-  
+
   has_cli    <- requireNamespace("cli", quietly = TRUE)
   has_crayon <- requireNamespace("crayon", quietly = TRUE)
   has_tools  <- requireNamespace("tools", quietly = TRUE)
-  
+
   bold   <- function(txt) if (has_crayon) crayon::bold(txt)   else txt
   cyan   <- function(txt) if (has_crayon) crayon::cyan(txt)   else txt
   blue   <- function(txt) if (has_crayon) crayon::blue(txt)   else txt
   dimc   <- function(txt) if (has_crayon) crayon::silver(txt) else txt
   italic <- function(txt) if (has_crayon) crayon::italic(txt) else txt
-  
+
   scr_width <- min(getOption("width", 80L), as.integer(max_width))
-  
+
   rule <- function(title = NULL) {
     if (has_cli) {
       if (is.null(title)) cli::cat_rule(width = scr_width)
@@ -26,10 +26,10 @@ print.pmsims <- function(x, ..., max_width = 80) {
       cat(strrep("-", scr_width), "\n", sep = "")
     }
   }
-  
+
   is_present <- function(v) !is.null(v) && !(length(v) == 1L && is.na(v))
   plural <- function(n, unit) sprintf("%d %s", n, if (n == 1) unit else paste0(unit, "s"))
-  
+
   fmt_duration <- function(simt) {
     secs <- if (inherits(simt, "difftime")) as.numeric(simt, units = "secs")
     else if (is.numeric(simt)) as.numeric(simt) else return("<NA>")
@@ -45,7 +45,7 @@ print.pmsims <- function(x, ..., max_width = 80) {
     if (s > 0 || length(parts) == 0) parts <- c(parts, plural(s, "second"))
     paste(parts, collapse = " ")
   }
-  
+
   fmt_num <- function(v, digits = 3) {
     if (!is_present(v)) return("<NA>")
     if (is.numeric(v) && length(v) == 1L) formatC(v, format = "f", digits = digits)
@@ -55,7 +55,7 @@ print.pmsims <- function(x, ..., max_width = 80) {
     if (!is_present(v)) return("<NA>")
     format(v, big.mark = ",", scientific = FALSE)
   }
-  
+
   pretty_metric <- function(metric) {
     if (!is_present(metric)) return(NULL)
     m <- tolower(metric)
@@ -70,7 +70,7 @@ print.pmsims <- function(x, ..., max_width = 80) {
     )
     paste0(nice, " ", dimc(sprintf("('%s')", metric)))
   }
-  
+
   moa        <- x$mean_or_assurance %||% "mean"
   model      <- x$model %||% NA_character_
   target     <- x$target_performance %||% x$minimum_acceptable_performance %||% NA_real_
@@ -80,7 +80,7 @@ print.pmsims <- function(x, ..., max_width = 80) {
   simtime    <- x$simulation_time %||% NA
   cstatistic <- x$cstatistic
   r2         <- x$r2
-  
+
   # --- Inputs table (non-null only)
   inputs <- list(
     "Outcome"                      = x$outcome,
@@ -101,7 +101,7 @@ print.pmsims <- function(x, ..., max_width = 80) {
   inputs[["Simulation reps"]] <- fmt_int(x$n_reps_total)
   keep_inputs <- vapply(inputs, is_present, logical(1))
   inputs <- inputs[keep_inputs]
-  
+
   # --- Results table
   results <- list(
     "Final minimum sample size"  = bold(fmt_int(min_n)),
@@ -114,7 +114,7 @@ print.pmsims <- function(x, ..., max_width = 80) {
   )
   keep_results <- vapply(results, is_present, logical(1))
   results <- results[keep_results]
-  
+
   # --- Header box
   if (has_cli) {
     cli::cat_boxx(
@@ -126,28 +126,28 @@ print.pmsims <- function(x, ..., max_width = 80) {
   } else {
     cat("\n", bold("pmsims: Sample size simulation summary"), "\n", sep = "")
   }
-  
+
   # --- Shared alignment width for BOTH tables
   shared_w <- max(nchar(c(names(inputs), names(results))), 25L)
-  
+
   # --- Inputs (aligned two-column, cyan labels)
   rule("Inputs")
   for (nm in names(inputs)) {
     label <- format(nm, width = shared_w, justify = "right")
     cat("  ", cyan(label), " : ", inputs[[nm]], "\n", sep = "")
   }
-  
+
   # --- Results (aligned two-column, blue labels)
   rule("Results")
   for (nm in names(results)) {
     label <- format(nm, width = shared_w, justify = "right")
     cat("  ", blue(label), " : ", results[[nm]], "\n", sep = "")
   }
-  
+
   cat("    ", dimc(if (tolower(moa) == "assurance")
     italic("Assurance mode ensures the target metric is met with high probability across repeated datasets.")
     else
-      "Mean mode ensures the target metric is met on average across datasets."), "\n", sep = "")
-  
+    italic("Mean mode ensures the target metric is met on average across datasets.")), "\n", sep = "")
+
   invisible(x)
-}
+}

pkgdown/about.md

@@ -7,8 +7,6 @@ title: "How pmsims works"
 **pmsims** estimates the minimum sample size needed for a prediction model to achieve adequate performance with high probability (“assurance”).
 It does this by simulating datasets, fitting models, evaluating performance, and tracing how performance improves as the sample size grows — a *learning curve*.
 
----
-
 # 1. Conceptual background
 
 Prediction models must be trained on enough data to generalise beyond the development sample.
@@ -18,8 +16,6 @@ Analytic formulae (e.g., *pmsampsize*) rely on assumptions that often fail for m
 
 **Simulation-based approaches**, like pmsims, overcome these limitations by explicitly generating data and empirically assessing model behaviour across different training sizes.
 
----
-
 # 2. The pmsims workflow
 
 The package operationalises the simulation-based framework in four modular steps:
@@ -56,8 +52,6 @@ The learning curve is used to identify the smallest `n` where the chosen quantil
 This gives the required training size for which the model is expected
 to achieve adequate performance in at least 80% of cases.
 
----
-
 # 3. Interpretation
 
 Two complementary criteria can be applied:

tests/testthat.R

@@ -1,3 +1,11 @@
+# This file is part of the standard setup for testthat.
+# It is recommended that you do not modify it.
+#
+# Where should you do additional test configuration?
+# Learn more about the roles of various files in:
+# * https://r-pkgs.org/testing-design.html#sec-tests-files-overview
+# * https://testthat.r-lib.org/articles/special-files.html
+
 library(testthat)
 library(pmsims)
 

tests/testthat/test-simulate_wrappers.R

@@ -3,15 +3,15 @@ test_that("simulate_binary returns a pmsims object", {
   set.seed(2024)
 
   result <- simulate_binary(
-    signal_parameters = 3,
-    noise_parameters = 2,
+    signal_parameters = 10,
+    noise_parameters = 0,
     predictor_type = "continuous",
     outcome_prevalence = 0.2,
     large_sample_cstatistic = 0.75,
     metric = "calibration_slope",
     minimum_acceptable_performance = 0.9,
-    n_reps_total = 60,
-    mean_or_assurance = "mean"
+    n_reps_total = 1000,
+    mean_or_assurance = "assurance"
   )
 
   expect_s3_class(result, "pmsims")
@@ -26,38 +26,38 @@ test_that("simulate_continuous returns a pmsims object", {
   set.seed(1111)
 
   result <- simulate_continuous(
-    signal_parameters = 4,
-    noise_parameters = 2,
+    signal_parameters = 10,
+    noise_parameters = 0,
     predictor_type = "continuous",
     large_sample_rsquared = 0.5,
     metric = "calibration_slope",
-    minimum_acceptable_performance = 1.0,
-    n_reps_total = 60,
-    mean_or_assurance = "mean"
+    minimum_acceptable_performance = 0.9,
+    n_reps_total = 1000,
+    mean_or_assurance = "assurance"
   )
 
   expect_s3_class(result, "pmsims")
   expect_equal(result$outcome, "continuous")
   expect_true(is.numeric(result$min_n))
   expect_gt(result$min_n, 0)
-  expect_equal(result$target_performance, 1.0)
+  expect_equal(result$target_performance, 0.9)
 })
 
 test_that("simulate_survival returns a pmsims object", {
   skip_on_cran()
   set.seed(765)
 
   result <- simulate_survival(
-    signal_parameters = 4,
-    noise_parameters = 2,
+    signal_parameters = 10,
+    noise_parameters = 0,
     predictor_type = "continuous",
     large_sample_cindex = 0.75,
     baseline_hazard = 0.01,
     censoring_rate = 0.3,
     metric = "calibration_slope",
     minimum_acceptable_performance = 0.9,
-    n_reps_total = 60,
-    mean_or_assurance = "mean"
+    n_reps_total = 1000,
+    mean_or_assurance = "assurance"
   )
 
   expect_s3_class(result, "pmsims")
@@ -70,47 +70,47 @@ test_that("simulate_survival returns a pmsims object", {
 test_that("wrapper calibration slope bounds are enforced", {
   expect_error(
     simulate_binary(
-      signal_parameters = 3,
-      noise_parameters = 1,
+      signal_parameters = 10,
+      noise_parameters = 0,
       predictor_type = "continuous",
       outcome_prevalence = 0.2,
       large_sample_cstatistic = 0.75,
       metric = "calibration_slope",
       minimum_acceptable_performance = 0.7,
-      n_reps_total = 40,
-      mean_or_assurance = "mean"
+      n_reps_total = 1000,
+      mean_or_assurance = "assurance"
     ),
     "Suggested calibration slope is too low",
     fixed = TRUE
   )
 
   expect_error(
     simulate_continuous(
-      signal_parameters = 3,
-      noise_parameters = 1,
+      signal_parameters = 10,
+      noise_parameters = 0,
       predictor_type = "continuous",
       large_sample_rsquared = 0.5,
       metric = "calibration_slope",
       minimum_acceptable_performance = 1.3,
-      n_reps_total = 40,
-      mean_or_assurance = "mean"
+      n_reps_total = 1000,
+      mean_or_assurance = "assurance"
     ),
     "Suggested calibration slope is too high",
     fixed = TRUE
   )
 
   expect_error(
     simulate_survival(
-      signal_parameters = 3,
-      noise_parameters = 1,
+      signal_parameters = 10,
+      noise_parameters = 0,
       predictor_type = "continuous",
       large_sample_cindex = 0.75,
       baseline_hazard = 0.01,
       censoring_rate = 0.3,
       metric = "calibration_slope",
       minimum_acceptable_performance = 0.7,
-      n_reps_total = 40,
-      mean_or_assurance = "mean"
+      n_reps_total = 1000,
+      mean_or_assurance = "assurance"
     ),
     "Suggested calibration slope is too low",
     fixed = TRUE
@@ -120,15 +120,15 @@ test_that("wrapper calibration slope bounds are enforced", {
 test_that("simulate_binary requires achievable AUC targets", {
   expect_error(
     simulate_binary(
-      signal_parameters = 3,
-      noise_parameters = 1,
+      signal_parameters = 10,
+      noise_parameters = 0
       predictor_type = "continuous",
       outcome_prevalence = 0.2,
-      large_sample_cstatistic = 0.82,
+      large_sample_cstatistic = 0.80,
       metric = "auc",
       minimum_acceptable_performance = 0.9,
-      n_reps_total = 40,
-      mean_or_assurance = "mean"
+      n_reps_total = 1000,
+      mean_or_assurance = "assurance"
     ),
     "Requested minimum acceptable AUC exceeds the expected large-sample performance",
     fixed = TRUE