Fix pct bug in tabulate_rsp_subgroups when risk difference column…

… is added (#1387)

Fixes #1386

NEWS.md

@@ -2,6 +2,7 @@
 
 ### Bug Fixes
 * Fixed bug in `a_count_patients_with_flags()` preventing select custom label and indentation specification formats from being applied.
+* Fixed bug in `tabulate_rsp_subgroups` and `tabulate_survival_subgroups` preventing the `pct` option from having an effect when adding a risk difference column.
 
 ### Miscellaneous
 * Removed internal function `ungroup_stats()` and replaced its usage with the `get_*_from_stats()` functions.

R/response_subgroups.R

@@ -276,7 +276,8 @@ tabulate_rsp_subgroups <- function(lyt,
           x = as.list(.data[[arm_cols[1]]]),
           y = as.list(.data[[arm_cols[2]]]),
           N_x = .data[[arm_cols[3]]],
-          N_y = .data[[arm_cols[4]]]
+          N_y = .data[[arm_cols[4]]],
+          pct = riskdiff$pct
         )
       ) %>%
       dplyr::select(-dplyr::all_of(arm_cols))

R/survival_duration_subgroups.R

@@ -284,7 +284,8 @@ tabulate_survival_subgroups <- function(lyt,
           x = as.list(.data[[arm_cols[1]]]),
           y = as.list(.data[[arm_cols[2]]]),
           N_x = .data[[arm_cols[3]]],
-          N_y = .data[[arm_cols[4]]]
+          N_y = .data[[arm_cols[4]]],
+          pct = riskdiff$pct
         )
       ) %>%
       dplyr::select(-dplyr::all_of(arm_cols))

tests/testthat/test-response_subgroups.R

@@ -306,6 +306,23 @@ testthat::test_that("tabulate_rsp_subgroups riskdiff argument works as expected"
 
   res <- testthat::expect_silent(result)
   testthat::expect_snapshot(res)
+
+  # pct works
+  result2 <- basic_table() %>%
+    tabulate_rsp_subgroups(
+      df = df,
+      vars = c("n", "prop", "n_tot", "or", "ci", "pval"),
+      riskdiff = control_riskdiff(
+        arm_x = levels(df$prop$arm)[1],
+        arm_y = levels(df$prop$arm)[2],
+        pct = FALSE
+      )
+    )
+
+  testthat::expect_equal(
+    cell_values(result2)[[1]][[9]],
+    cell_values(result)[[1]][[9]] / 100
+  )
 })
 
 testthat::test_that("tabulate_rsp_subgroups pval statistic warning works as expected", {

tests/testthat/test-survival_duration_subgroups.R

@@ -286,4 +286,17 @@ testthat::test_that("tabulate_survival_subgroups riskdiff argument works as expe
 
   res <- testthat::expect_silent(result)
   testthat::expect_snapshot(res)
+
+  # pct works
+  result2 <- basic_table() %>%
+    tabulate_survival_subgroups(
+      df,
+      time_unit = adtte$AVALU[1],
+      riskdiff = control_riskdiff(pct = FALSE)
+    )
+
+  testthat::expect_equal(
+    cell_values(result2)[[1]][[8]],
+    cell_values(result)[[1]][[8]] / 100
+  )
 })