From 5a6263ebe521520081ba1d7a5ca111217e8f4bf0 Mon Sep 17 00:00:00 2001
From: Zelos Zhu <zdz2101@github.com>
Date: Thu, 26 Oct 2023 21:23:33 +0000
Subject: [PATCH] feat: #2142 add appropriate test suite

---
 R/derive_summary_records.R                   | 26 +++---
 man/derive_param_extreme_record.Rd           |  4 +
 man/get_summary_records.Rd                   |  3 +
 tests/testthat/test-derive_summary_records.R | 92 +++++++++++++++++++-
 4 files changed, 111 insertions(+), 14 deletions(-)

diff --git a/R/derive_summary_records.R b/R/derive_summary_records.R
index 7df704f641..59dd1f8035 100644
--- a/R/derive_summary_records.R
+++ b/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)
 }
diff --git a/man/derive_param_extreme_record.Rd b/man/derive_param_extreme_record.Rd
index 3b68ae01d2..35739e25cf 100644
--- a/man/derive_param_extreme_record.Rd
+++ b/man/derive_param_extreme_record.Rd
@@ -141,5 +141,9 @@ derive_param_extreme_record(
   )
 )
 }
+\seealso{
+Other superseded: 
+\code{\link{get_summary_records}()}
+}
 \concept{superseded}
 \keyword{superseded}
diff --git a/man/get_summary_records.Rd b/man/get_summary_records.Rd
index beddbdf179..5fa6d1441e 100644
--- a/man/get_summary_records.Rd
+++ b/man/get_summary_records.Rd
@@ -169,6 +169,9 @@ get_summary_records(
 }
 \seealso{
 \code{\link[=derive_summary_records]{derive_summary_records()}}, \code{\link[=derive_var_merged_summary]{derive_var_merged_summary()}}
+
+Other superseded: 
+\code{\link{derive_param_extreme_record}()}
 }
 \concept{superseded}
 \keyword{internal}
diff --git a/tests/testthat/test-derive_summary_records.R b/tests/testthat/test-derive_summary_records.R
index 8bfcf00e71..18e47c4bef 100644
--- a/tests/testthat/test-derive_summary_records.R
+++ b/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")
+  )
+})