feat: #2142 add appropriate test suite

R/derive_summary_records.R

@@ -152,7 +152,7 @@ derive_summary_records <- function(dataset,
   )
   assert_data_frame(
     dataset_ref,
-    required_vars = expr_c(by_vars),
+    required_vars = by_vars,
     optional = TRUE
   )
 
@@ -180,6 +180,17 @@ derive_summary_records <- function(dataset,
     summarise(!!!set_values_to) %>%
     ungroup()
 
+  if (!is.null(missing_values)) {
+    update_missings <- map2(
+      syms(names(missing_values)),
+      missing_values,
+      ~ expr(if_else(is.na(!!.x), !!.y, !!.x))
+    )
+    names(update_missings) <- names(missing_values)
+    summary_records <- summary_records %>%
+      mutate(!!!update_missings)
+  }
+
   df_return <- bind_rows(
     dataset,
     summary_records
@@ -191,7 +202,7 @@ derive_summary_records <- function(dataset,
 
     new_ref_obs <- anti_join(
       select(dataset_ref, intersect(add_vars, ref_vars)),
-      select(new_add_obs, !!!by_vars),
+      select(summary_records, !!!by_vars),
       by = map_chr(by_vars, as_name)
     )
 
@@ -201,16 +212,5 @@ derive_summary_records <- function(dataset,
     )
   }
 
-  if (!is.null(missing_values)) {
-    update_missings <- map2(
-      syms(names(missing_values)),
-      missing_values,
-      ~ expr(if_else(is.na(!!missing_var), !!.y, !!.x))
-    )
-    names(update_missings) <- names(missing_values)
-    df_return <- df_return %>%
-      mutate(!!!update_missings)
-  }
-
   return(df_return)
 }

tests/testthat/test-derive_summary_records.R

@@ -144,7 +144,8 @@ test_that("derive_summary_records Test 4: deprecation warning for analysis_var a
   )
 })
 
-test_that("make sure dataset_add works", {
+## Test 5: make sure dataset_add works ----
+test_that("derive_summary_records Test 5: make sure dataset_add works", {
   input <- tibble::tribble(
     ~subj, ~visit,       ~val, ~seq,
     "1",        1,         10,    1,
@@ -181,3 +182,92 @@ test_that("make sure dataset_add works", {
     keys = c("subj", "visit", "seq", "type")
   )
 })
+
+## Test 6: test missing values ----
+test_that("derive_summary_records Test 6: test missing values", {
+  input <- tibble::tribble(
+    ~subj, ~visit,       ~val, ~seq,
+    "1",        1,         10,    1,
+    "1",        1,         14,    2,
+    "1",        1,          9,    3,
+    "1",        2,         11,    4,
+    "2",        2,   NA_real_,    1
+  )
+
+  expected_output <- bind_rows(
+    input,
+    tibble::tribble(
+      ~subj, ~visit,       ~val,
+      "1",        1,         11,
+      "1",        2,         11,
+      "2",        2,     999999
+    ) %>%
+      mutate(type = "AVERAGE")
+  )
+
+  actual_output <- input %>%
+    derive_summary_records(
+      by_vars = exprs(subj, visit),
+      set_values_to = exprs(
+        mean_val = mean(val, na.rm = TRUE),
+        type = "AVERAGE"
+      ),
+      missing_values = exprs(mean_val = 999999)
+    )
+
+  expect_dfs_equal(
+    base = expected_output,
+    compare = actual_output,
+    keys = c("subj", "visit", "seq", "type")
+  )
+})
+
+## Test 7: make sure dataset_ref works ----
+test_that("derive_summary_records Test 7: make sure dataset_ref works", {
+  input <- tibble::tribble(
+    ~subj, ~visit,       ~val, ~seq,
+    "1",        1,         10,    1,
+    "1",        1,         14,    2,
+    "1",        1,          9,    3,
+    "1",        2,         11,    4,
+    "2",        2,   NA_real_,    1
+  )
+
+  input_ref <- tibble::tribble(
+    ~subj, ~visit,
+      "1",      1,
+      "1",      2,
+      "2",      1,
+      "2",      2,
+  )
+  expected_output <- bind_rows(
+    input,
+    tibble::tribble(
+      ~subj, ~visit,       ~val,
+      "1",        1,         11,
+      "1",        2,         11,
+      "2",        2,   NA_real_
+    ) %>%
+      mutate(type = "AVERAGE"),
+    tibble::tribble(
+      ~subj, ~visit,
+      "2",      1,
+    )
+  )
+
+  actual_output <- input %>%
+    derive_summary_records(
+      dataset_ref = input_ref,
+      by_vars = exprs(subj, visit),
+      set_values_to = exprs(
+        val = mean(val, na.rm = TRUE),
+        type = "AVERAGE"
+      )
+    )
+
+  expect_dfs_equal(
+    base = expected_output,
+    compare = actual_output,
+    keys = c("subj", "visit", "seq", "type")
+  )
+})