Add tests

insightsengineering · Aug 2, 2024 · 13fedf8 · 13fedf8
1 parent 86d041c
commit 13fedf8
Show file tree

Hide file tree

Showing 4 changed files with 133 additions and 3 deletions.
diff --git a/tests/testthat/_snaps/tm_g_forest_rsp.md b/tests/testthat/_snaps/tm_g_forest_rsp.md
@@ -27,7 +27,52 @@
       
       $table
       result <- rtables::basic_table() %>% tabulate_rsp_subgroups(df, 
-          vars = c("n_tot", "n", "n_rsp", "prop", "or", "ci"))
+          vars = c("n_tot", "n", "n_rsp", "prop", "or", "ci"), riskdiff = NULL)
+      
+      $plot
+      $plot[[1]]
+      f <- g_forest(tbl = result, col_symbol_size = NULL, font_size = 15, 
+          as_list = TRUE)
+      
+      $plot[[2]]
+      p <- cowplot::plot_grid(f[["table"]] + ggplot2::labs(title = "Forest Plot of Best Overall Response for "), 
+          f[["plot"]] + ggplot2::labs(caption = ""), align = "h", axis = "tblr", 
+          rel_widths = c(1 - 0.25, 0.25))
+      
+      
+
+# template_forest_rsp works with risk difference column added
+
+    Code
+      res
+    Output
+      $data
+      {
+          adrs <- adrs %>% dplyr::filter(ARMCD %in% c("ARM A", "ARM B", 
+              "ARM C")) %>% dplyr::mutate(ARMCD = stats::relevel(ARMCD, 
+              ref = "ARM A")) %>% dplyr::mutate(ARMCD = droplevels(ARMCD)) %>% 
+              dplyr::mutate(is_rsp = AVALC %in% c("CR", "PR")) %>% 
+              dplyr::mutate(ARMCD = combine_levels(ARMCD, levels = c("ARM B", 
+                  "ARM C")))
+          parent <- adsl %>% dplyr::filter(ARMCD %in% c("ARM A", "ARM B", 
+              "ARM C")) %>% dplyr::mutate(ARMCD = stats::relevel(ARMCD, 
+              ref = "ARM A")) %>% dplyr::mutate(ARMCD = droplevels(ARMCD)) %>% 
+              dplyr::mutate(ARMCD = combine_levels(ARMCD, levels = c("ARM B", 
+                  "ARM C")))
+      }
+      
+      $summary
+      {
+          df <- extract_rsp_subgroups(variables = list(rsp = "is_rsp", 
+              arm = "ARMCD", subgroups = c("SEX", "STRATA2"), strata = NULL), 
+              data = adrs, conf_level = 0.95)
+      }
+      
+      $table
+      result <- rtables::basic_table() %>% tabulate_rsp_subgroups(df, 
+          vars = c("n_tot", "or", "ci"), riskdiff = list(arm_x = NULL, 
+              arm_y = NULL, format = "xx.x (xx.x - xx.x)", col_label = "Prop. Diff", 
+              pct = TRUE))
       
       $plot
       $plot[[1]]

diff --git a/tests/testthat/_snaps/tm_g_forest_tte.md b/tests/testthat/_snaps/tm_g_forest_tte.md
@@ -28,8 +28,55 @@
       $table
       {
           result <- rtables::basic_table() %>% tabulate_survival_subgroups(df, 
-              vars = c("n_tot", "n_tot_events", "n", "n_events", "median", 
-                  "hr", "ci"), time_unit = as.character(anl$AVALU[1]))
+              vars = c("n_tot_events", "n_events", "median", "hr", 
+              "ci"), time_unit = as.character(anl$AVALU[1]), riskdiff = NULL)
+      }
+      
+      $plot
+      $plot[[1]]
+      f <- g_forest(tbl = result, col_symbol_size = NULL, font_size = 15, 
+          as_list = TRUE)
+      
+      $plot[[2]]
+      p <- cowplot::plot_grid(f[["table"]] + ggplot2::labs(title = "Forest Plot of Survival Duration for \nStratified by STRATA2", 
+          subtitle = NULL), f[["plot"]] + ggplot2::labs(caption = ""), 
+          align = "h", axis = "tblr", rel_widths = c(1 - 0.25, 0.25))
+      
+      
+
+# template_forest_tte works with risk difference column added
+
+    Code
+      res
+    Output
+      $data
+      {
+          anl <- adtte %>% dplyr::filter(ARMCD %in% c("ARM A", "ARM B", 
+              "ARM C")) %>% dplyr::mutate(ARMCD = stats::relevel(ARMCD, 
+              ref = "ARM A")) %>% dplyr::mutate(ARMCD = droplevels(ARMCD)) %>% 
+              dplyr::mutate(ARMCD = combine_levels(ARMCD, c("ARM B", 
+                  "ARM C"))) %>% dplyr::mutate(is_event = CNSR == 0)
+          parent <- ANL_ADSL %>% dplyr::filter(ARMCD %in% c("ARM A", 
+              "ARM B", "ARM C")) %>% dplyr::mutate(ARMCD = stats::relevel(ARMCD, 
+              ref = "ARM A")) %>% dplyr::mutate(ARMCD = droplevels(ARMCD)) %>% 
+              dplyr::mutate(ARMCD = combine_levels(ARMCD, c("ARM B", 
+                  "ARM C")))
+      }
+      
+      $summary
+      {
+          df <- extract_survival_subgroups(variables = list(tte = "AVAL", 
+              is_event = "is_event", arm = "ARMCD", subgroups = c("SEX", 
+                  "BMRKR2"), strata = "STRATA2"), control = control_coxph(conf_level = 0.9), 
+              data = anl)
+      }
+      
+      $table
+      {
+          result <- rtables::basic_table() %>% tabulate_survival_subgroups(df, 
+              vars = c("n_tot", "hr", "ci"), time_unit = as.character(anl$AVALU[1]), 
+              riskdiff = list(arm_x = NULL, arm_y = NULL, format = "xx.x (xx.x - xx.x)", 
+                  col_label = "Prop. Diff", pct = TRUE))
       }
       
       $plot

diff --git a/tests/testthat/test-tm_g_forest_rsp.R b/tests/testthat/test-tm_g_forest_rsp.R
@@ -15,3 +15,23 @@ testthat::test_that("template_forest_rsp generates correct expressions", {
   res <- testthat::expect_silent(result)
   testthat::expect_snapshot(res)
 })
+
+testthat::test_that("template_forest_rsp works with risk difference column added", {
+  result <- template_forest_rsp(
+    dataname = "adrs",
+    parentname = "adsl",
+    arm_var = "ARMCD",
+    ref_arm = "ARM A",
+    comp_arm = c("ARM B", "ARM C"),
+    aval_var = "AVALC",
+    responders = c("CR", "PR"),
+    subgroup_var = c("SEX", "STRATA2"),
+    strata_var = NULL,
+    stats = c("n_tot", "or", "ci"),
+    riskdiff = control_riskdiff(col_label = "Prop. Diff"),
+    conf_level = 0.95
+  )
+
+  res <- testthat::expect_silent(result)
+  testthat::expect_snapshot(res)
+})
diff --git a/tests/testthat/test-tm_g_forest_tte.R b/tests/testthat/test-tm_g_forest_tte.R
@@ -13,3 +13,21 @@ testthat::test_that("template_forest_tte generates correct expressions", {
   res <- testthat::expect_silent(result)
   testthat::expect_snapshot(res)
 })
+
+testthat::test_that("template_forest_tte works with risk difference column added", {
+  result <- template_forest_tte(
+    dataname = "adtte",
+    arm_var = "ARMCD",
+    ref_arm = "ARM A",
+    comp_arm = c("ARM B", "ARM C"),
+    subgroup_var = c("SEX", "BMRKR2"),
+    strata_var = "STRATA2",
+    stats = c("n_tot", "hr", "ci"),
+    riskdiff = control_riskdiff(col_label = "Prop. Diff"),
+    conf_level = 0.90,
+    col_symbol_size = NULL
+  )
+
+  res <- testthat::expect_silent(result)
+  testthat::expect_snapshot(res)
+})