Update analyze_vars _in_cols to allow non-numeric nominal timepoint…

… variable (#1095) Fixes #1094
insightsengineering · Oct 18, 2023 · 554a3dd · 554a3dd
1 parent 15c4783
commit 554a3dd
Show file tree

Hide file tree

Showing 3 changed files with 33 additions and 18 deletions.
diff --git a/NEWS.md b/NEWS.md
@@ -6,6 +6,7 @@
 ### Enhancements
 * Added formatting function `format_count_fraction_lt10` for formatting `count_fraction` with special consideration when count is less than 10.
 * Updated `s_summary.logical` output for `count_fraction` when denominator is zero to display as `NA` instead of `0` in tables.
+* Updated `analyze_vars_in_cols` to allow character input to indicate whether nominal time point is post-dose or pre-dose when applying the 1/3 imputation rule.
 
 ### Bug Fixes
 * Fixed bug in `g_km` causing an error when converting certain annotation width units.

diff --git a/R/analyze_vars_in_cols.R b/R/analyze_vars_in_cols.R
@@ -245,9 +245,12 @@ analyze_vars_in_cols <- function(lyt,
           if (is.null(imp_rule) || !stat %in% c("mean", "sd", "cv", "geom_mean", "geom_cv", "median", "min", "max")) {
             res <- x_stats[[stat]]
           } else {
+            timept <- as.numeric(gsub(".*?([0-9\\.]+).*", "\\1", tail(.spl_context$value, 1)))
             res_imp <- imputation_rule(
               .df_row, x_stats, stat,
-              imp_rule = imp_rule, post = as.numeric(tail(.spl_context$value, 1)) > 0, avalcat_var = avalcat_var
+              imp_rule = imp_rule,
+              post = grepl("Predose", tail(.spl_context$value, 1)) || timept > 0,
+              avalcat_var = avalcat_var
             )
             res <- res_imp[["val"]]
             na_str <- res_imp[["na_str"]]
@@ -313,9 +316,12 @@ analyze_vars_in_cols <- function(lyt,
           if (is.null(imp_rule) || !stat %in% c("mean", "sd", "cv", "geom_mean", "geom_cv", "median", "min", "max")) {
             res <- x_stats[[stat]]
           } else {
+            timept <- as.numeric(gsub(".*?([0-9\\.]+).*", "\\1", tail(.spl_context$value, 1)))
             res_imp <- imputation_rule(
               .df_row, x_stats, stat,
-              imp_rule = imp_rule, post = as.numeric(tail(.spl_context$value, 1)) > 0, avalcat_var = avalcat_var
+              imp_rule = imp_rule,
+              post = grepl("Predose", tail(.spl_context$value, 1)) || timept > 0,
+              avalcat_var = avalcat_var
             )
             res <- res_imp[["val"]]
             na_str <- res_imp[["na_str"]]

diff --git a/tests/testthat/test-analyze_vars_in_cols.R b/tests/testthat/test-analyze_vars_in_cols.R
@@ -11,18 +11,22 @@ testthat::test_that("analyze_vars_in_cols works correctly", {
   testthat::expect_snapshot(res)
 
   # It fails if called multiple times with identical col split
-  testthat::expect_error(basic_table() %>%
-    split_rows_by(var = "ARM", label_pos = "topleft") %>%
-    split_rows_by(var = "SEX", label_pos = "topleft") %>%
-    analyze_vars_in_cols(vars = "AGE", .stats = c("n", "mean", "se")) %>%
-    analyze_vars_in_cols(vars = "AGE", .stats = c("n", "mean", "se")))
+  testthat::expect_error(
+    basic_table() %>%
+      split_rows_by(var = "ARM", label_pos = "topleft") %>%
+      split_rows_by(var = "SEX", label_pos = "topleft") %>%
+      analyze_vars_in_cols(vars = "AGE", .stats = c("n", "mean", "se")) %>%
+      analyze_vars_in_cols(vars = "AGE", .stats = c("n", "mean", "se"))
+  )
 
   # It fails if called multiple times with identical col split on different lines
-  testthat::expect_error(basic_table() %>%
-    split_rows_by(var = "ARM", label_pos = "topleft") %>%
-    analyze_vars_in_cols(vars = "AGE", .stats = c("n", "mean", "se")) %>%
-    split_rows_by(var = "SEX", label_pos = "topleft") %>%
-    analyze_vars_in_cols(vars = "AGE", .stats = c("n", "mean", "se")))
+  testthat::expect_error(
+    basic_table() %>%
+      split_rows_by(var = "ARM", label_pos = "topleft") %>%
+      analyze_vars_in_cols(vars = "AGE", .stats = c("n", "mean", "se")) %>%
+      split_rows_by(var = "SEX", label_pos = "topleft") %>%
+      analyze_vars_in_cols(vars = "AGE", .stats = c("n", "mean", "se"))
+  )
 })
 
 testthat::test_that("analyze_vars_in_cols throws error when vars and .stats lengths differ in len", {
@@ -263,12 +267,14 @@ testthat::test_that("analyze_vars_in_cols works well with categorical data", {
     in_rows(.list = ret_list, .formats = aform)
   }
 
-  testthat::expect_snapshot(basic_table(show_colcounts = TRUE) %>%
-    split_rows_by(var = "STRATA1", label_pos = "topleft") %>%
-    split_cols_by("ARM") %>%
-    analyze(vars = "SEX", afun = count_fraction) %>%
-    append_topleft("  SEX") %>%
-    build_table(adpp))
+  testthat::expect_snapshot(
+    basic_table(show_colcounts = TRUE) %>%
+      split_rows_by(var = "STRATA1", label_pos = "topleft") %>%
+      split_cols_by("ARM") %>%
+      analyze(vars = "SEX", afun = count_fraction) %>%
+      append_topleft("  SEX") %>%
+      build_table(adpp)
+  )
 })
 
 testthat::test_that("analyze_vars_in_cols works with imputation rule", {
@@ -312,6 +318,8 @@ testthat::test_that("analyze_vars_in_cols works with imputation rule", {
   res <- testthat::expect_silent(result)
   testthat::expect_snapshot(res)
 
+  df$NFRLT <- as.character(df$NFRLT)
+
   # 1/3 imputation rule, custom avalcat_var
   lyt <- basic_table() %>%
     split_rows_by(