Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Add option to tm_t_summary to include arm_var labels in table header #1205

Merged
merged 8 commits into from
Aug 2, 2024
Merged
Show file tree
Hide file tree
Changes from 7 commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 2 additions & 0 deletions NEWS.md
Original file line number Diff line number Diff line change
Expand Up @@ -4,10 +4,12 @@
* Added `teal.logger` functionality for logging changes in shiny inputs in all modules.
* Introduced `ylim` parameter for `tm_g_km` module that controls width of y-axis.
* Added functionality to `tm_t_events_patyear` to split columns by multiple (nested) variables via the `arm_var` argument.
* Added arguments `arm_var_labels` to `template_summary` and `show_arm_var_labels` to `tm_t_summary` to allow user to display arm variable (`arm_var`) labels in table header.

### Miscellaneous
* Removed `Show Warnings` modals from modules.
* Clarified the documentation specifying whether multiple values can be selected in the `arm_var` argument for each module.
* Began deprecation cycle for the `show_labels` argument of `template_summary` which has no effect on the `tm_t_summary` module.

# teal.modules.clinical 0.9.1

Expand Down
55 changes: 43 additions & 12 deletions R/tm_t_summary.R
Original file line number Diff line number Diff line change
Expand Up @@ -3,8 +3,9 @@
#' Creates a valid expression to generate a table to summarize variables.
#'
#' @inheritParams template_arguments
#' @param show_labels (`character`)\cr defines whether variable labels should be displayed. Options are
#' `"default"`, `"visible"`, and `"hidden"`.
#' @param show_labels `r lifecycle::badge("deprecated")`
#' @param arm_var_labels (`character` or `NULL`)\cr vector of column variable labels to display, of the same length as
#' `arm_var`. If `NULL`, no labels will be displayed.
#'
#' @inherit template_arguments return
#'
Expand All @@ -15,10 +16,11 @@ template_summary <- function(dataname,
parentname,
arm_var,
sum_vars,
show_labels = c("default", "visible", "hidden"),
show_labels = lifecycle::deprecated(),
add_total = TRUE,
total_label = default_total_label(),
var_labels = character(),
arm_var_labels = NULL,
na.rm = FALSE, # nolint: object_name.
na_level = default_na_str(),
numeric_stats = c(
Expand All @@ -27,24 +29,32 @@ template_summary <- function(dataname,
denominator = c("N", "n", "omit"),
drop_arm_levels = TRUE,
basic_table_args = teal.widgets::basic_table_args()) {
if (lifecycle::is_present(show_labels)) {
warning(
"The `show_labels` argument of `template_summary` is deprecated as of teal.modules.clinical 0.9.1.9013 ",
"as it is has no effect on the module.",
call. = FALSE
)
}

checkmate::assert_string(dataname)
checkmate::assert_string(parentname)
checkmate::assert_character(arm_var, min.len = 1, max.len = 2)
checkmate::assert_character(sum_vars)
checkmate::assert_flag(add_total)
checkmate::assert_string(total_label)
checkmate::assert_character(var_labels)
checkmate::assert_character(arm_var_labels, len = length(arm_var), null.ok = TRUE)
checkmate::assert_flag(na.rm)
checkmate::assert_string(na_level)
checkmate::assert_flag(drop_arm_levels)
checkmate::assert_character(arm_var, min.len = 1, max.len = 2)
checkmate::assert_character(numeric_stats, min.len = 1)
checkmate::assert_subset(
numeric_stats,
c("n", "mean_sd", "mean_ci", "median", "median_ci", "quantiles", "range", "geom_mean")
)

denominator <- match.arg(denominator)
show_labels <- match.arg(show_labels)

y <- list()

Expand Down Expand Up @@ -136,7 +146,6 @@ template_summary <- function(dataname,
env_sum_vars <- list(
sum_vars = sum_vars,
sum_var_labels = var_labels[sum_vars],
show_labels = show_labels,
na.rm = na.rm,
na_level = na_level,
denom = ifelse(denominator == "n", "n", "N_col"),
Expand All @@ -153,7 +162,7 @@ template_summary <- function(dataname,
expr = analyze_vars(
vars = sum_vars,
var_labels = sum_var_labels,
show_labels = show_labels,
show_labels = "visible",
na.rm = na.rm,
na_str = na_level,
denom = denom,
Expand All @@ -165,7 +174,7 @@ template_summary <- function(dataname,
substitute(
expr = analyze_vars(
vars = sum_vars,
show_labels = show_labels,
show_labels = "visible",
na.rm = na.rm,
na_str = na_level,
denom = denom,
Expand All @@ -176,6 +185,16 @@ template_summary <- function(dataname,
}
)

if (!is.null(arm_var_labels)) {
layout_list <- add_expr(
layout_list,
substitute(
expr = append_topleft(arm_var_labels),
env = list(arm_var_labels = c(arm_var_labels, ""))
)
)
}

y$layout <- substitute(
expr = lyt <- layout_pipe,
env = list(layout_pipe = pipe_expr(layout_list))
Expand Down Expand Up @@ -203,6 +222,7 @@ template_summary <- function(dataname,
#' It defines the grouping variable(s) in the results table.
#' If there are two elements selected for `arm_var`,
#' second variable will be nested under the first variable.
#' @param show_arm_var_labels (`flag`)\cr whether arm variable label(s) should be displayed. Defaults to `TRUE`.
#'
#' @inherit module_arguments return seealso
#'
Expand Down Expand Up @@ -249,6 +269,7 @@ tm_t_summary <- function(label,
summarize_vars,
add_total = TRUE,
total_label = default_total_label(),
show_arm_var_labels = TRUE,
useNA = c("ifany", "no"), # nolint: object_name.
na_level = default_na_str(),
numeric_stats = c(
Expand All @@ -267,15 +288,16 @@ tm_t_summary <- function(label,
checkmate::assert_class(summarize_vars, "choices_selected")
checkmate::assert_string(na_level)
checkmate::assert_character(numeric_stats, min.len = 1)
useNA <- match.arg(useNA) # nolint: object_name.
denominator <- match.arg(denominator)
checkmate::assert_flag(drop_arm_levels)
checkmate::assert_class(pre_output, classes = "shiny.tag", null.ok = TRUE)
checkmate::assert_class(post_output, classes = "shiny.tag", null.ok = TRUE)
checkmate::assert_class(basic_table_args, "basic_table_args")
checkmate::assertFlag(add_total)
checkmate::assert_flag(add_total)
checkmate::assert_flag(show_arm_var_labels)
checkmate::assert_string(total_label)

useNA <- match.arg(useNA) # nolint: object_name.
denominator <- match.arg(denominator)
numeric_stats <- match.arg(numeric_stats, several.ok = TRUE)

args <- as.list(environment())
Expand All @@ -296,6 +318,7 @@ tm_t_summary <- function(label,
dataname = dataname,
parentname = parentname,
label = label,
show_arm_var_labels = show_arm_var_labels,
total_label = total_label,
na_level = na_level,
basic_table_args = basic_table_args
Expand Down Expand Up @@ -399,6 +422,7 @@ srv_summary <- function(id,
arm_var,
summarize_vars,
add_total,
show_arm_var_labels,
total_label,
na_level,
drop_arm_levels,
Expand Down Expand Up @@ -519,15 +543,22 @@ srv_summary <- function(id,

summarize_vars <- merged$anl_input_r()$columns_source$summarize_vars
var_labels <- teal.data::col_labels(data()[[dataname]][, summarize_vars, drop = FALSE])

arm_var_labels <- NULL
if (show_arm_var_labels) {
arm_vars <- merged$anl_input_r()$columns_source$arm_var
arm_var_labels <- teal.data::col_labels(data()[[dataname]][, arm_vars, drop = FALSE], fill = TRUE)
}

my_calls <- template_summary(
dataname = "ANL",
parentname = "ANL_ADSL",
arm_var = merged$anl_input_r()$columns_source$arm_var,
sum_vars = summarize_vars,
show_labels = "visible",
add_total = input$add_total,
total_label = total_label,
var_labels = var_labels,
arm_var_labels = arm_var_labels,
na.rm = ifelse(input$useNA == "ifany", FALSE, TRUE),
na_level = na_level,
numeric_stats = input$numeric_stats,
Expand Down
9 changes: 6 additions & 3 deletions man/template_summary.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

3 changes: 3 additions & 0 deletions man/tm_t_summary.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

38 changes: 38 additions & 0 deletions tests/testthat/_snaps/tm_t_summary.md
Original file line number Diff line number Diff line change
Expand Up @@ -170,3 +170,41 @@
}


# template_summary generates correct expressions when arm variable labels are added

Code
res
Output
$data
{
anl <- adrs %>% df_explicit_na(omit_columns = setdiff(names(adrs),
c(c("RACE", "COUNTRY", "AGE"))), na_level = "<Missing>")
anl <- anl %>% dplyr::mutate(ARM = droplevels(ARM))
arm_levels <- levels(anl[["ARM"]])
adsl <- adsl %>% dplyr::filter(ARM %in% arm_levels)
adsl <- adsl %>% dplyr::mutate(ARM = droplevels(ARM))
anl <- anl %>% dplyr::mutate(SEX = droplevels(SEX))
arm_levels <- levels(anl[["SEX"]])
adsl <- adsl %>% dplyr::filter(SEX %in% arm_levels)
adsl <- adsl %>% dplyr::mutate(SEX = droplevels(SEX))
adsl <- df_explicit_na(adsl, na_level = "<Missing>")
}

$layout
lyt <- rtables::basic_table(main_footer = "n represents the number of unique subject IDs such that the variable has non-NA values.") %>%
rtables::split_cols_by("ARM", split_fun = drop_split_levels) %>%
rtables::split_cols_by("SEX", split_fun = drop_split_levels) %>%
rtables::add_overall_col("All Patients") %>% rtables::add_colcounts() %>%
analyze_vars(vars = c("RACE", "COUNTRY", "AGE"), show_labels = "visible",
na.rm = FALSE, na_str = "<Missing>", denom = "N_col",
.stats = c("n", "mean_sd", "mean_ci", "median", "median_ci",
"quantiles", "range", "geom_mean", "count_fraction")) %>%
append_topleft(c("Arm", "Sex", ""))

$table
{
result <- rtables::build_table(lyt = lyt, df = anl, alt_counts_df = adsl)
result
}


18 changes: 13 additions & 5 deletions tests/testthat/test-tm_t_summary.R
Original file line number Diff line number Diff line change
Expand Up @@ -4,7 +4,6 @@ testthat::test_that("template_summary generates correct expressions", {
parentname = "adsl",
arm_var = "ARM",
sum_vars = c("RACE", "COUNTRY", "AGE"),
show_labels = "visible",
add_total = FALSE,
var_labels = character(),
na.rm = FALSE,
Expand All @@ -22,7 +21,6 @@ testthat::test_that("template_summary can generate customized table", {
parentname = "adsl",
arm_var = "ARMCD",
sum_vars = "RACE",
show_labels = "visible",
add_total = TRUE,
var_labels = c(RACE = "Race"),
na.rm = TRUE,
Expand All @@ -40,7 +38,6 @@ testthat::test_that("template_summary generates correct expressions for multiple
parentname = "adsl",
arm_var = c("ARM", "STRATA1"),
sum_vars = c("RACE", "COUNTRY", "AGE"),
show_labels = "visible",
add_total = FALSE,
var_labels = character(),
na.rm = FALSE,
Expand All @@ -60,7 +57,6 @@ testthat::test_that(
parentname = "adsl",
arm_var = c("ARM", "STRATA1"),
sum_vars = c("RACE", "COUNTRY", "AGE"),
show_labels = "visible",
add_total = TRUE,
var_labels = character(),
na.rm = FALSE,
Expand All @@ -79,7 +75,6 @@ testthat::test_that("template_summary generates correct expressions for customiz
parentname = "adsl",
arm_var = c("ARM", "STRATA1"),
sum_vars = c("RACE", "COUNTRY", "AGE"),
show_labels = "visible",
add_total = FALSE,
var_labels = character(),
na.rm = FALSE,
Expand All @@ -91,3 +86,16 @@ testthat::test_that("template_summary generates correct expressions for customiz
res <- testthat::expect_silent(result)
testthat::expect_snapshot(res)
})

testthat::test_that("template_summary generates correct expressions when arm variable labels are added", {
result <- template_summary(
dataname = "adrs",
parentname = "adsl",
arm_var = c("ARM", "SEX"),
sum_vars = c("RACE", "COUNTRY", "AGE"),
arm_var_labels = c("Arm", "Sex")
)

res <- testthat::expect_silent(result)
testthat::expect_snapshot(res)
})
Loading