feat: #2142 get checks appropriately running

pharmaverse · Nov 3, 2023 · 53bdf63 · 53bdf63
1 parent 19ced77
commit 53bdf63
Show file tree

Hide file tree

Showing 7 changed files with 21 additions and 9 deletions.
diff --git a/R/derive_param_exposure.R b/R/derive_param_exposure.R
@@ -126,6 +126,7 @@
 #'   ) %>%
 #'   select(-ASTDTM, -AENDTM)
 derive_param_exposure <- function(dataset,
+                                  dataset_add,
                                   by_vars,
                                   input_code,
                                   analysis_var,
@@ -159,6 +160,8 @@ derive_param_exposure <- function(dataset,
   assert_data_frame(dataset,
     required_vars = expr_c(by_vars, analysis_var, exprs(PARAMCD), dates)
   )
+  assert_data_frame(dataset_add, required_vars = by_vars)
+
   if (!missing(filter)) {
     deprecate_warn(
       "1.0.0",
@@ -181,6 +184,7 @@ derive_param_exposure <- function(dataset,
 
   derive_summary_records(
     dataset,
+    dataset_add,
     by_vars = by_vars,
     filter_add = PARAMCD == !!input_code & !!filter,
     set_values_to = exprs(

diff --git a/R/derive_summary_records.R b/R/derive_summary_records.R
@@ -164,8 +164,8 @@
 #'   )
 #' ) %>%
 #'   arrange(USUBJID, AVISIT)
-derive_summary_records <- function(dataset = NULL,
-                                   dataset_add = NULL,
+derive_summary_records <- function(dataset,
+                                   dataset_add,
                                    dataset_ref = NULL,
                                    by_vars,
                                    filter = NULL,
@@ -182,7 +182,6 @@ derive_summary_records <- function(dataset = NULL,
   assert_data_frame(
     dataset_add,
     required_vars = expr_c(by_vars),
-    optional = TRUE
   )
   assert_data_frame(
     dataset_ref,
@@ -214,10 +213,6 @@ derive_summary_records <- function(dataset = NULL,
   }
   filter <- assert_filter_cond(enexpr(filter_add), optional = TRUE)
 
-  if (is.null(dataset_add)) {
-    dataset_add <- dataset
-  }
-
   summary_records <- dataset_add %>%
     group_by(!!!by_vars) %>%
     filter_if(filter) %>%

diff --git a/man/derive_param_exposure.Rd b/man/derive_param_exposure.Rd
diff --git a/man/derive_summary_records.Rd b/man/derive_summary_records.Rd
diff --git a/tests/testthat/test-call_derivation.R b/tests/testthat/test-call_derivation.R
@@ -5,6 +5,7 @@ test_that("call_derivation Test 1:  Test that call_derivation generates expected
 
   expected_output <- input %>%
     derive_summary_records(
+      dataset_add = input,
       by_vars = exprs(USUBJID, VSTESTCD),
       set_values_to = exprs(
         VSSTRESN = mean(VSSTRESN, na.rm = TRUE),
@@ -13,6 +14,7 @@ test_that("call_derivation Test 1:  Test that call_derivation generates expected
       filter_add = dplyr::n() >= 2L
     ) %>%
     derive_summary_records(
+      dataset_add = input,
       by_vars = exprs(USUBJID, VSTESTCD),
       set_values_to = exprs(
         VSSTRESN = max(VSSTRESN, na.rm = TRUE),
@@ -21,6 +23,7 @@ test_that("call_derivation Test 1:  Test that call_derivation generates expected
       filter_add = dplyr::n() >= 2L
     ) %>%
     derive_summary_records(
+      dataset_add = input,
       by_vars = exprs(USUBJID, VSTESTCD),
       set_values_to = exprs(
         VSSTRESN = min(VSSTRESN, na.rm = TRUE),
@@ -31,6 +34,7 @@ test_that("call_derivation Test 1:  Test that call_derivation generates expected
 
   actual_output <- call_derivation(
     dataset = input,
+    dataset_add = input,
     derivation = derive_summary_records,
     variable_params = list(
       params(

diff --git a/tests/testthat/test-derive_param_exposure.R b/tests/testthat/test-derive_param_exposure.R
@@ -61,20 +61,23 @@ test_that("derive_param_exposure Test 1: works with DTM variables", {
 
   actual_output <- input %>%
     derive_param_exposure(
+      dataset_add = input,
       by_vars = exprs(USUBJID),
       input_code = "DOSE",
       analysis_var = AVAL,
       summary_fun = function(x) sum(x, na.rm = TRUE),
       set_values_to = exprs(PARAMCD = "TDOSE", PARCAT1 = "OVERALL")
     ) %>%
     derive_param_exposure(
+      dataset_add = input,
       by_vars = exprs(USUBJID),
       input_code = "DOSE",
       analysis_var = AVAL,
       summary_fun = function(x) mean(x, na.rm = TRUE),
       set_values_to = exprs(PARAMCD = "AVDOSE", PARCAT1 = "OVERALL")
     ) %>%
     derive_param_exposure(
+      dataset_add = input,
       by_vars = exprs(USUBJID),
       input_code = "ADJ",
       analysis_var = AVALC,

diff --git a/tests/testthat/test-derive_summary_records.R b/tests/testthat/test-derive_summary_records.R
@@ -11,6 +11,7 @@ test_that("derive_summary_records Test 1: creates new record per group and group
 
   actual_output <- input %>%
     derive_summary_records(
+      dataset_add = input,
       by_vars = exprs(subj, visit),
       set_values_to = exprs(
         val = mean(val),
@@ -50,6 +51,7 @@ test_that("derive_summary_records Test 2: Filter record within `by_vars`", {
 
   actual_output <- input %>%
     derive_summary_records(
+      dataset_add = input,
       by_vars = exprs(subj, visit),
       filter_add = n() > 2,
       set_values_to = exprs(
@@ -129,6 +131,7 @@ test_that("derive_summary_records Test 4: deprecation warning for analysis_var a
   expect_warning(
     actual_output <- input %>%
       derive_summary_records(
+        dataset_add = input,
         by_vars = exprs(subj, visit),
         analysis_var = val,
         summary_fun = mean,
@@ -207,6 +210,7 @@ test_that("derive_summary_records Test 6: test missing values", {
 
   actual_output <- input %>%
     derive_summary_records(
+      dataset_add = input,
       by_vars = exprs(subj, visit),
       set_values_to = exprs(
         aval = mean(val, na.rm = TRUE),
@@ -257,6 +261,7 @@ test_that("derive_summary_records Test 7: make sure dataset_ref works", {
 
   actual_output <- input %>%
     derive_summary_records(
+      dataset_add = input,
       dataset_ref = input_ref,
       by_vars = exprs(subj, visit),
       set_values_to = exprs(