From 13fedf8b64658ec7e2ea87521bf0caad2c8a25b8 Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Fri, 2 Aug 2024 17:59:32 -0400 Subject: [PATCH] Add tests --- tests/testthat/_snaps/tm_g_forest_rsp.md | 47 +++++++++++++++++++++- tests/testthat/_snaps/tm_g_forest_tte.md | 51 +++++++++++++++++++++++- tests/testthat/test-tm_g_forest_rsp.R | 20 ++++++++++ tests/testthat/test-tm_g_forest_tte.R | 18 +++++++++ 4 files changed, 133 insertions(+), 3 deletions(-) diff --git a/tests/testthat/_snaps/tm_g_forest_rsp.md b/tests/testthat/_snaps/tm_g_forest_rsp.md index efd531cae1..5a9daf5d7d 100644 --- 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 index bd2d6989a0..f7bcf257a5 100644 --- 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 index da4aaafe39..65c75254ab 100644 --- 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 index 0f251fd781..fe5e848838 100644 --- 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) +})