Merge pull request Merck#245 from Merck/no-suggests

Run code conditionally to pass `noSuggests` check
jdblischak · May 3, 2024 · fbd58a1 · fbd58a1
2 parents d901750 + d13212f
commit fbd58a1
Show file tree

Hide file tree

Showing 36 changed files with 123 additions and 18 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,7 +1,7 @@
 Package: simtrial
 Type: Package
 Title: Clinical Trial Simulation
-Version: 0.4.0
+Version: 0.4.1
 Authors@R: c(
     person("Keaven", "Anderson", email = "[email protected]", role = c("aut")),
     person("Yujie", "Zhao", email = "[email protected]", role =  c("ctb","cre")),
@@ -44,6 +44,7 @@ Imports:
     future,
     methods,
     mvtnorm,
+    rlang,
     stats,
     survival,
     utils

diff --git a/NAMESPACE b/NAMESPACE
@@ -42,6 +42,7 @@ importFrom(future,plan)
 importFrom(methods,is)
 importFrom(mvtnorm,GenzBretz)
 importFrom(mvtnorm,pmvnorm)
+importFrom(rlang,is_installed)
 importFrom(survival,Surv)
 importFrom(survival,is.Surv)
 importFrom(survival,survfit)

diff --git a/NEWS.md b/NEWS.md
@@ -1,3 +1,10 @@
+# simtrial 0.4.1
+
+## Improvements
+
+- Pass `noSuggests` checks by running code examples, tests, and vignettes
+  conditionally if the `Suggests` dependencies are not installed (#243).
+
 # simtrial 0.4.0
 
 ## New features
@@ -56,8 +63,7 @@ performance substantially, and adds new features and documentation.
 - Complete overhaul of the API. Function and argument names now use
   snake case for consistency and readability. See the
   [function reference](https://merck.github.io/simtrial/reference/)
-  for the updated naming scheme. Detailed change history is available in the
-  [merged pull requests](https://github.com/Merck/simtrial/pulls?q=is%3Apr+is%3Aclosed)
+  for the updated naming scheme. Detailed change history is available in the merged pull requests
   (thanks, @LittleBeannie, @lili-ling-msd, and @XintongLi2023).
 - Dataset names updated to snake case (thanks, @nanxstats, #164).
 - The base pipe operator is now used throughout the package.

diff --git a/R/get_analysis_date.R b/R/get_analysis_date.R
@@ -69,9 +69,8 @@
 #'
 #' @export
 #'
-#' @examples
+#' @examplesIf rlang::is_installed("gsDesign2")
 #' library(gsDesign2)
-#' library(simtrial)
 #'
 #' alpha <- 0.025
 #' ratio <- 3

diff --git a/R/get_cut_date_by_event.R b/R/get_cut_date_by_event.R
@@ -29,7 +29,7 @@
 #'
 #' @export
 #'
-#' @examples
+#' @examplesIf rlang::is_installed("dplyr")
 #' library(dplyr)
 #'
 #' # Use default enrollment and calendar cut date

diff --git a/R/mb_delayed_effect.R b/R/mb_delayed_effect.R
@@ -38,7 +38,6 @@
 #'
 #' @examples
 #' library(survival)
-#' library(dplyr)
 #'
 #' fit <- survfit(Surv(tte, event) ~ treatment, data = mb_delayed_effect)
 #'

diff --git a/R/randomize_by_fixed_block.R b/R/randomize_by_fixed_block.R
@@ -32,7 +32,7 @@
 #'
 #' @export
 #'
-#' @examples
+#' @examplesIf rlang::is_installed("dplyr")
 #' library(dplyr)
 #'
 #' # Example 1

diff --git a/R/sim_fixed_n.R b/R/sim_fixed_n.R
@@ -73,7 +73,7 @@
 #'
 #' @export
 #'
-#' @examples
+#' @examplesIf rlang::is_installed("dplyr")
 #' library(dplyr)
 #' library(future)
 #'

diff --git a/R/sim_gs_n.R b/R/sim_gs_n.R
@@ -42,7 +42,7 @@
 #'
 #' @export
 #'
-#' @examples
+#' @examplesIf rlang::is_installed("gsDesign2")
 #' library(gsDesign2)
 #'
 #' # Parameters for enrollment

diff --git a/R/sim_pw_surv.R b/R/sim_pw_surv.R
@@ -60,7 +60,7 @@
 #'
 #' @export
 #'
-#' @examples
+#' @examplesIf rlang::is_installed("dplyr")
 #' library(dplyr)
 #'
 #' # Example 1

diff --git a/R/simtrial-package.R b/R/simtrial-package.R
@@ -24,3 +24,7 @@ NULL
 
 #' @importFrom Rcpp sourceCpp
 NULL
+
+# For safeguarding code examples and tests
+#' @importFrom rlang is_installed
+NULL
diff --git a/R/wlr_weight.R b/R/wlr_weight.R
@@ -93,8 +93,7 @@ mb <- function(delay = 4, w_max = Inf) {
 #' "Designing therapeutic cancer vaccine trials with delayed treatment effect."
 #' @export
 #'
-#' @examples
-#' library(dplyr)
+#' @examplesIf rlang::is_installed("gsDesign2")
 #' library(gsDesign2)
 #'
 #' # Example 1: Unstratified ----
@@ -136,7 +135,7 @@ mb <- function(delay = 4, w_max = Inf) {
 #' sim_pw_surv(
 #'   n = n, # Sample size
 #'   # Stratified design with prevalence ratio of 6:4
-#'   stratum = tibble(stratum = stratum, p = prevalence_ratio),
+#'   stratum = data.frame(stratum = stratum, p = prevalence_ratio),
 #'   # Randomization ratio
 #'   block = c("control", "control", "experimental", "experimental"),
 #'   enroll_rate = enroll_rate, # Enrollment rate

diff --git a/man/early_zero.Rd b/man/early_zero.Rd
diff --git a/man/get_analysis_date.Rd b/man/get_analysis_date.Rd
diff --git a/man/get_cut_date_by_event.Rd b/man/get_cut_date_by_event.Rd
diff --git a/man/mb_delayed_effect.Rd b/man/mb_delayed_effect.Rd
diff --git a/man/randomize_by_fixed_block.Rd b/man/randomize_by_fixed_block.Rd
diff --git a/man/sim_fixed_n.Rd b/man/sim_fixed_n.Rd
diff --git a/man/sim_gs_n.Rd b/man/sim_gs_n.Rd
diff --git a/man/sim_pw_surv.Rd b/man/sim_pw_surv.Rd
diff --git a/tests/testthat/test-double_programming_sim_fixed_n.R b/tests/testthat/test-double_programming_sim_fixed_n.R
@@ -1,16 +1,22 @@
 test_that("test for sim_fixed_n power comparing to gsDesign results with fixed duration in timing_type=1", {
+  skip_if_not_installed("gsDesign")
+
   test2 <- test_simfix()$test2
   tt1test <- subset(test2, test2$cut == "Planned duration", select = c(event, ln_hr, z, duration, sim))
   expect_equal(object = sum(as.integer(tt1test$z < (-1.96))) / 100, expected = 0.94, tolerance = 0.02)
 })
 
 test_that("test for sim_fixed_n power comparing to gsDesign results with target events in timing_type=2", {
+  skip_if_not_installed("gsDesign")
+
   test2 <- test_simfix()$test2
   tt2test <- subset(test2, test2$cut == "Targeted events", select = c(event, ln_hr, z, duration, sim))
   expect_equal(object = sum(as.integer(tt2test$z < (-1.96))) / 100, expected = 0.93, tolerance = 0.02)
 })
 
 test_that("test for events in the correct directions in timing_type=3 comparing to timing_type=2", {
+  skip_if_not_installed("gsDesign")
+
   test2 <- test_simfix()$test2
 
   tt2test <- subset(test2, test2$cut == "Targeted events", select = c(event, ln_hr, z, duration, sim))
@@ -30,6 +36,8 @@ test_that("test for events in the correct directions in timing_type=3 comparing
 })
 
 test_that("test for timing_type=4 outputs using timing_type 1 and 2 output", {
+  skip_if_not_installed("gsDesign")
+
   test2 <- test_simfix()$test2
 
   tt1test <- subset(test2, test2$cut == "Planned duration", select = c(event, ln_hr, z, duration, sim))
@@ -48,6 +56,8 @@ test_that("test for timing_type=4 outputs using timing_type 1 and 2 output", {
 })
 
 test_that("test for timing_type=5 outputs using timing_type 2 and 3 output", {
+  skip_if_not_installed("gsDesign")
+
   test2 <- test_simfix()$test2
 
   tt2test <- subset(test2, test2$cut == "Targeted events", select = c(event, ln_hr, z, duration, sim))

diff --git a/tests/testthat/test-double_programming_sim_pw_surv.R b/tests/testthat/test-double_programming_sim_pw_surv.R
@@ -1,5 +1,7 @@
 test_that("stratum percentage calculated from simulated dataset must be within
           the tolerance=0.002 of stratum in setup (0.4,0.6)", {
+  skip_if_not_installed("dplyr")
+
   res <- test_sim_pw_surv()
   expect_equal(
     object = c(
@@ -12,19 +14,25 @@ test_that("stratum percentage calculated from simulated dataset must be within
 
 test_that("block calculated from simulated dataset equals size of 4 with 1:1
           randomization, which is 2 for each arm", {
+  skip_if_not_installed("dplyr")
+
   res <- test_sim_pw_surv()
   expect_equal(object = res$bktest1, expected = rep(2, length(res$bktest1)))
   expect_equal(object = res$bktest2, expected = rep(2, length(res$bktest2)))
 })
 
 test_that("fail_rate calculated from simulated dataset must be within the
           tolerance=0.1 of fail_rate in setting", {
+  skip_if_not_installed("dplyr")
+
   res <- test_sim_pw_surv()
   expect_equal(object = res$ratetest, expected = res$fail_rate$rate, tolerance = 0.1)
 })
 
 test_that("dropout_rate calculated from simulated dataset must be within
           the tolerance=0.0005 of dropout_rate=0.001 in setup", {
+  skip_if_not_installed("dplyr")
+
   res <- test_sim_pw_surv()
   duration <- 300
   drtest <- 0
@@ -36,6 +44,8 @@ test_that("dropout_rate calculated from simulated dataset must be within
 
 test_that("enroll_rate calculated from simulated dataset must be within
           the relative tolerance=0.05 of enroll_rate in setup", {
+  skip_if_not_installed("dplyr")
+
   res <- test_sim_pw_surv()
   duration <- 300
   entest <- 0
@@ -49,6 +59,8 @@ test_that("enroll_rate calculated from simulated dataset must be within
 })
 
 test_that("The actual number of events changes by changing total sample size", {
+  skip_if_not_installed("dplyr")
+
   res1 <- test_sim_pw_surv()
   res2 <- test_sim_pw_surv_2()
   expect_false(unique(res1$xevent$event == res2$zevent$event))

diff --git a/tests/testthat/test-independent_test_counting_process.R b/tests/testthat/test-independent_test_counting_process.R
@@ -1,4 +1,6 @@
 test_that("Counting Process Format without ties", {
+  skip_if_not_installed("dplyr")
+
   x <- data.frame(
     stratum = c(rep(1, 10), rep(2, 6)),
     treatment = rep(c(1, 1, 0, 0), 4),
@@ -18,6 +20,8 @@ test_that("Counting Process Format without ties", {
 })
 
 test_that("Counting Process Format with ties", {
+  skip_if_not_installed("dplyr")
+
   x <- data.frame(
     stratum = c(rep(1, 10), rep(2, 6)),
     treatment = rep(c(1, 1, 0, 0), 4),

diff --git a/tests/testthat/test-independent_test_cut_data_by_date.R b/tests/testthat/test-independent_test_cut_data_by_date.R
@@ -11,6 +11,8 @@ test_that("x is a time-to-event data set", {
 })
 
 test_that("only patients recorded by cut_data_by_date are included", {
+  skip_if_not_installed("dplyr")
+
   x <- sim_pw_surv(n = 200)
   cut_date <- 10
   xcut <- cut_data_by_date(x, cut_date)
@@ -30,6 +32,8 @@ test_that("Time-to-event (TTE) is cut off at the cut_date", {
 })
 
 test_that("the event variable is calculated correctly", {
+  skip_if_not_installed("dplyr")
+
   x <- sim_pw_surv(n = 200)
   cut_date <- 10
   xcut <- cut_data_by_date(x, cut_date)