diff --git a/DESCRIPTION b/DESCRIPTION index da451ec1..11e6cc6f 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: junco Title: Create Common Tables and Listings Used in Clinical Trials -Version: 0.1.6.9000 +Version: 0.1.6.9001 Date: 2026-05-22 Authors@R: c( person("Gabriel", "Becker", , "gabembecker@gmail.com", role = c("cre", "aut"), diff --git a/NAMESPACE b/NAMESPACE index e59dcb6f..b582ad51 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -66,7 +66,6 @@ export(get_visit_levels) export(grouped_cols_w_diffs) export(h_extract_coxreg_multivar) export(h_get_design_mat) -export(h_get_trtvar_refpath) export(h_tidy_pool) export(in_column) export(inches_to_spaces) diff --git a/NEWS.md b/NEWS.md index a0c520e8..afef8f99 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,4 +1,4 @@ -# junco 0.1.6.9000 +# junco 0.1.6.9001 ### Fixed - Fixed `get_ref_info()` to accept ref_path = NULL (#359). @@ -9,11 +9,14 @@ ### Changed +- Updated several analysis functions to use `h_get_cur_trt_grp()` (#295). +- Replaced `h_get_trtvar_refpath()` with `h_get_cur_trt_grp()` (#295). +- Updated `get_ref_info()` for matching column split paths (#295). - Added the new helper function `factor_by_order()` (#425). - Renamed `in_ref_col()` to `in_column()` and renamed its `ref_path` argument to `col_path`. - Updated `in_ref_col()` to accept `ref_path = NULL` (#404). -- Added the new helper functions `cur_col_split_path()` and `in_ref_col()` to +- Added the new helper functions `cur_col_split_path()` and `in_column()` to support custom analysis functions that depend on the current column split context (#404). - Added a default value for the `label` argument in `c_summary_subset_label()`. @@ -42,6 +45,7 @@ - Add extra statistics to `a_eair100_j` and introduce scaling factor `num_p_year` (default = 100) (#361) ### Added +- Added `strict_match()` for uniquely matching a value in the odd or even positions of a character vector. - Added `categorize_pval()` for assigning p-values to validated, user-defined categories. - Added `pool_rubin_scalar()` and `pool_z_stat()` for pooling scalar estimates and z statistics across imputations. - Added `resp_multiple_imputation()` to impute missing binary responses across scenarios and pool CMH risk-difference and p-value results. diff --git a/R/a_freq_j.R b/R/a_freq_j.R index b4ca1c9a..8bfa70fc 100644 --- a/R/a_freq_j.R +++ b/R/a_freq_j.R @@ -801,6 +801,9 @@ a_freq_j <- function( colgroup = NULL, countsource = c("df", "altdf", "altdf_subset") ) { + checkmate::check_character(ref_path, min.len = 2L) + checkmate::assert_true(length(ref_path) %% 2L == 0L) + denom <- match.arg(denom) method <- match.arg(method) @@ -913,7 +916,6 @@ a_freq_j <- function( if (riskdiff && is.null(ref_path)) { stop("argument ref_path cannot be NULL.") } - ### denom N_colgroup should not be used in layout with risk diff columns if (denom == "N_colgroup") { stop( "denom N_colgroup cannot be used in a layout with risk diff columns." @@ -923,28 +925,11 @@ a_freq_j <- function( trt_var <- NULL ctrl_grp <- NULL cur_trt_grp <- NULL - } - - if (riskdiff) { - trt_var_refpath <- h_get_trtvar_refpath( - ref_path, - .spl_context, - df - ) - # trt_var_refpath is list with elements - # trt_var trt_var_refspec cur_trt_grp ctrl_grp - # make these elements available in current environment - trt_var <- trt_var_refpath$trt_var - trt_var_refspec <- trt_var_refpath$trt_var_refspec - cur_trt_grp <- trt_var_refpath$cur_trt_grp - ctrl_grp <- trt_var_refpath$ctrl_grp - # for combined facet, denom_df value for the treatment group needs update - new_denomdf <- upd_denom_df_combo( - new_denomdf, - trt_var, - cur_trt_grp, - .spl_context - ) + } else { + trt_var <- ref_path[length(ref_path) - 1L] + ctrl_grp <- ref_path[length(ref_path)] + stopifnot(ctrl_grp %in% levels(df[[trt_var]])) + cur_trt_grp <- h_get_cur_trt_grp(trt_var, .spl_context) if (!is.null(colgroup) && trt_var == colgroup) { stop( @@ -953,6 +938,13 @@ a_freq_j <- function( Either remove risk difference columns from layout, set riskdiff = FALSE, or update colgroup." ) } + + new_denomdf <- upd_denom_df_combo( + new_denomdf, + trt_var, + cur_trt_grp, + .spl_context + ) } x_stats <- s_rel_risk_val_j( diff --git a/R/a_freq_resp_var_j.R b/R/a_freq_resp_var_j.R index 1b4f896a..34902365 100644 --- a/R/a_freq_resp_var_j.R +++ b/R/a_freq_resp_var_j.R @@ -46,34 +46,38 @@ #' #' result a_freq_resp_var_j <- function( - df, - .var, - .df_row, - .N_col, - .spl_context, - resp_var = NULL, - id = "USUBJID", - drop_levels = FALSE, - riskdiff = TRUE, - ref_path = NULL, - variables = formals(s_proportion_diff)$variables, - conf_level = formals(s_proportion_diff)$conf_level, - method = c( - "wald", - "waldcc", - "cmh", - "ha", - "newcombe", - "newcombecc", - "strat_newcombe", - "strat_newcombecc", - "cmh_sato", - "cmh_mn", - "uncond_exact_diff" - ), - weights_method = formals(s_proportion_diff)$weights_method, - .formats = NULL, - na_str = rep("NA", 3)) { + df, + .var, + .df_row, + .N_col, + .spl_context, + resp_var = NULL, + id = "USUBJID", + drop_levels = FALSE, + riskdiff = TRUE, + ref_path = NULL, + variables = formals(s_proportion_diff)$variables, + conf_level = formals(s_proportion_diff)$conf_level, + method = c( + "wald", + "waldcc", + "cmh", + "ha", + "newcombe", + "newcombecc", + "strat_newcombe", + "strat_newcombecc", + "cmh_sato", + "cmh_mn", + "uncond_exact_diff" + ), + weights_method = formals(s_proportion_diff)$weights_method, + .formats = NULL, + na_str = rep("NA", 3) +) { + checkmate::check_character(ref_path, min.len = 2L) + checkmate::assert_true(length(ref_path) %% 2L == 0L) + # ---- Derive statistics: xx / xx (xx.x%) if (is.null(resp_var)) { @@ -137,18 +141,9 @@ a_freq_resp_var_j <- function( inriskdiffcol <- grepl("difference", tolower(colid), fixed = TRUE) if (riskdiff) { - trt_var_refpath <- h_get_trtvar_refpath( - ref_path, - .spl_context, - df - ) - # trt_var_refpath is list with elements - # trt_var trt_var_refspec cur_trt_grp ctrl_grp - # make these elements available in current environment - trt_var <- trt_var_refpath$trt_var - trt_var_refspec <- trt_var_refpath$trt_var_refspec - cur_trt_grp <- trt_var_refpath$cur_trt_grp - ctrl_grp <- trt_var_refpath$ctrl_grp + trt_var <- ref_path[length(ref_path) - 1L] + ctrl_grp <- ref_path[length(ref_path)] + cur_trt_grp <- h_get_cur_trt_grp(trt_var, .spl_context) } fn <- function(levii) { diff --git a/R/a_summarize_aval_chg_diff.R b/R/a_summarize_aval_chg_diff.R index c3d892f3..89820392 100644 --- a/R/a_summarize_aval_chg_diff.R +++ b/R/a_summarize_aval_chg_diff.R @@ -66,23 +66,24 @@ s_aval_chg_col1 <- function(df, .var, denom, .N_col, id, indatavar) { } s_aval_chg_col23_diff <- function( - df, - .var, - .df_row, - .ref_group, - .in_ref_col, - ancova, - interaction_y, - interaction_item, - conf_level, - variables, - trt_var, - ctrl_grp, - cur_param, - cur_lvl, - weights_emmeans, - method_combo, - weights_combo) { + df, + .var, + .df_row, + .ref_group, + .in_ref_col, + ancova, + interaction_y, + interaction_item, + conf_level, + variables, + trt_var, + ctrl_grp, + cur_param, + cur_lvl, + weights_emmeans, + method_combo, + weights_combo +) { .df_row <- subset(.df_row, !is.na(.df_row[[.var]])) df <- subset(df, !is.na(df[[.var]])) .ref_group <- subset(.ref_group, !is.na(.ref_group[[.var]])) @@ -374,29 +375,33 @@ format_xxd <- function(str, d = 0, .df_row, formatting_fun = NULL) { #' result #' @family Inclusion of ANCOVA Functions a_summarize_aval_chg_diff_j <- function( - df, - .df_row, - .spl_context, - ancova = FALSE, - comp_btw_group = TRUE, - ref_path = NULL, - .N_col, - denom = c("N", ".N_col"), - indatavar = NULL, - d = 0, - id = "USUBJID", - interaction_y = FALSE, - interaction_item = NULL, - conf_level = 0.95, - variables = list(arm = "TRT01A", covariates = NULL), - format_na_str = "", - .stats = list(col1 = "count_denom_frac", col23 = "mean_ci_3d", coldiff = "meandiff_ci_3d"), - .formats = list(col1 = NULL, col23 = "xx.dx (xx.dx, xx.dx)", coldiff = "xx.dx (xx.dx, xx.dx)"), - .formats_fun = list(col1 = jjcsformat_count_denom_fraction, col23 = jjcsformat_xx, coldiff = jjcsformat_xx), - multivars = c("AVAL", "AVAL", "CHG"), - weights_emmeans = NULL, - method_combo = c("contrasts", "collapse"), - weights_combo = NULL) { + df, + .df_row, + .spl_context, + ancova = FALSE, + comp_btw_group = TRUE, + ref_path = NULL, + .N_col, + denom = c("N", ".N_col"), + indatavar = NULL, + d = 0, + id = "USUBJID", + interaction_y = FALSE, + interaction_item = NULL, + conf_level = 0.95, + variables = list(arm = "TRT01A", covariates = NULL), + format_na_str = "", + .stats = list(col1 = "count_denom_frac", col23 = "mean_ci_3d", coldiff = "meandiff_ci_3d"), + .formats = list(col1 = NULL, col23 = "xx.dx (xx.dx, xx.dx)", coldiff = "xx.dx (xx.dx, xx.dx)"), + .formats_fun = list(col1 = jjcsformat_count_denom_fraction, col23 = jjcsformat_xx, coldiff = jjcsformat_xx), + multivars = c("AVAL", "AVAL", "CHG"), + weights_emmeans = NULL, + method_combo = c("contrasts", "collapse"), + weights_combo = NULL +) { + checkmate::check_character(ref_path, min.len = 2L) + checkmate::assert_true(length(ref_path) %% 2L == 0L) + denom <- match.arg(denom) method_combo <- match.arg(method_combo) @@ -474,22 +479,11 @@ a_summarize_aval_chg_diff_j <- function( .in_ref_col <- FALSE .ref_group <- NULL + ctrl_grp <- NULL if (comp_btw_group) { - trt_var_refspec <- utils::tail(ref_path, n = 2)[1] - checkmate::assert_true(identical(trt_var, trt_var_refspec)) - # ctrl_grp - ctrl_grp <- utils::tail(ref_path, n = 1) - - ### check that ctrl_grp is a level of the treatment variable, in case riskdiff is requested - if (!ctrl_grp %in% levels(df[[trt_var]])) { - stop(paste0( - "control group specification in ref_path argument (", - ctrl_grp, - ") is not a level of your treatment group variable (", - trt_var, - ")." - )) - } + checkmate::assert_true(identical(trt_var, ref_path[length(ref_path) - 1L])) + ctrl_grp <- ref_path[length(ref_path)] + stopifnot(ctrl_grp %in% levels(df[[trt_var]])) if (trt_val == ctrl_grp) .in_ref_col <- TRUE diff --git a/R/a_summarize_ex_j.R b/R/a_summarize_ex_j.R index c82ef2eb..e877fa1e 100644 --- a/R/a_summarize_ex_j.R +++ b/R/a_summarize_ex_j.R @@ -9,7 +9,6 @@ #' @name a_summarize_ex_j NULL - #' @inheritParams proposal_argument_convention #' @describeIn a_summarize_ex_j Statistics function needed for the exposure tables. #' @@ -31,18 +30,19 @@ NULL #' * covariates (character)\cr #' a vector that can contain single variable names (such as 'X1'), and/or interaction terms indicated by 'X1 * X2'. s_summarize_ex_j <- function( - df, - .var, - .df_row, - .spl_context, - comp_btw_group = TRUE, - ref_path = NULL, - ancova = FALSE, - interaction_y, - interaction_item, - conf_level, - daysconv, - variables) { + df, + .var, + .df_row, + .spl_context, + comp_btw_group = TRUE, + ref_path = NULL, + ancova = FALSE, + interaction_y, + interaction_item, + conf_level, + daysconv, + variables +) { control <- control_analyze_vars() control$conf_level <- conf_level x_stats <- s_summary(df[[.var]], na.rm = TRUE, .var, control = control) @@ -66,16 +66,12 @@ s_summarize_ex_j <- function( ) # diff between group will be updated in mean_sd stat if (comp_btw_group) { - trt_var_refpath <- h_get_trtvar_refpath(ref_path, .spl_context, df) - # trt_var_refpath is list with elements trt_var trt_var_refspec cur_trt_grp ctrl_grp make these elements - # available in current environment - trt_var <- trt_var_refpath$trt_var - trt_var_refspec <- trt_var_refpath$trt_var_refspec - cur_trt_grp <- trt_var_refpath$cur_trt_grp - ctrl_grp <- trt_var_refpath$ctrl_grp + trt_var <- ref_path[length(ref_path) - 1L] + ctrl_grp <- ref_path[length(ref_path)] + cur_trt_grp <- h_get_cur_trt_grp(trt_var, .spl_context) .in_ref_col <- FALSE - if (trt_var == ctrl_grp) .in_ref_col <- TRUE + if (cur_trt_grp == ctrl_grp) .in_ref_col <- TRUE .ref_group <- .df_row[.df_row[[trt_var]] == ctrl_grp, ] @@ -187,23 +183,27 @@ s_summarize_ex_j <- function( #' result #' @export a_summarize_ex_j <- function( - df, - .var, - .df_row, - .spl_context, - comp_btw_group = TRUE, - ref_path = NULL, - ancova = FALSE, - interaction_y = FALSE, - interaction_item = NULL, - conf_level = 0.95, - variables, - .stats = c("mean_sd", "median", "range", "quantiles", "total_subject_years"), - .formats = c(diff_mean_est_ci = jjcsformat_xx("xx.xx (xx.xx, xx.xx)")), - .labels = c(quantiles = "Interquartile range"), - .indent_mods = NULL, - na_str = rep("NA", 3), - daysconv = 1) { + df, + .var, + .df_row, + .spl_context, + comp_btw_group = TRUE, + ref_path = NULL, + ancova = FALSE, + interaction_y = FALSE, + interaction_item = NULL, + conf_level = 0.95, + variables, + .stats = c("mean_sd", "median", "range", "quantiles", "total_subject_years"), + .formats = c(diff_mean_est_ci = jjcsformat_xx("xx.xx (xx.xx, xx.xx)")), + .labels = c(quantiles = "Interquartile range"), + .indent_mods = NULL, + na_str = rep("NA", 3), + daysconv = 1 +) { + checkmate::check_character(ref_path, min.len = 2L) + checkmate::assert_true(length(ref_path) %% 2L == 0L) + if (!is.numeric(df[[.var]])) { stop("a_summarize_ex_j issue: input variable must be numeric.") } diff --git a/R/cur_col_split_path_utils.R b/R/cur_col_split_path_utils.R index 9c445671..00529d55 100644 --- a/R/cur_col_split_path_utils.R +++ b/R/cur_col_split_path_utils.R @@ -47,7 +47,7 @@ cur_col_split_path <- function(.spl_context) { checkmate::assert_list(.spl_context[nrow(.spl_context), "cur_col_split"], min.len = 1L) checkmate::assert_list(.spl_context[nrow(.spl_context), "cur_col_split_val"], min.len = 1L) checkmate::assert_character(.spl_context[nrow(.spl_context), "cur_col_split"][[1]], names = "unnamed") - checkmate::assert_character(.spl_context[nrow(.spl_context), "cur_col_split_val"][[1]], names = "unnamed") + checkmate::assert_character(.spl_context[nrow(.spl_context), "cur_col_split_val"][[1]]) checkmate::assert_true( length(.spl_context[nrow(.spl_context), "cur_col_split"][[1]]) == length(.spl_context[nrow(.spl_context), "cur_col_split_val"][[1]]) diff --git a/R/get_ref_info.R b/R/get_ref_info.R index a250d258..0afb02af 100644 --- a/R/get_ref_info.R +++ b/R/get_ref_info.R @@ -1,29 +1,41 @@ -#' @title Obtain Reference Information for a Global Reference Group +#' @title Obtain reference group information from split context. #' #' @description `r lifecycle::badge("stable")` #' -#' This helper function can be used in custom analysis functions, by passing -#' an extra argument `ref_path` which defines a global reference group by -#' the corresponding column split hierarchy levels. +#' `get_ref_info()` identifies a reference group defined by a column-split +#' path and returns both the reference-group data and an indicator of whether +#' the current column is the reference column. It is intended for use inside +#' custom `rtables` analysis functions. #' -#' @param ref_path (`character`)\cr reference group specification as an `rtables` -#' `colpath`, see details. -#' @param .spl_context (`data.frame`)\cr see [rtables::spl_context]. -#' @param .var (`character`)\cr the variable being analyzed, -#' see [rtables::additional_fun_params]. +#' The reference group is specified using `ref_path`, which consists of +#' alternating column-split variable names and its corresponding levels. +#' For example, `c("SEX", "F", "ARM", "Placebo")` specifies the column-split +#' path where `SEX` is `"F"` and `ARM` is `"Placebo"`. #' -#' @return A list with `ref_group` and `in_ref_col`, which can be used as -#' `.ref_group` and `.in_ref_col` as if being directly passed to an analysis -#' function by `rtables`, see [rtables::additional_fun_params]. +#' @param ref_path (`character`) \cr +#' Reference group specification as an `rtables` `colpath`; see Details. +#' @param .spl_context (`data.frame`) \cr +#' Ancestor split-state information passed by `rtables`. +#' @param .var (`character(1)`) \cr +#' The variable being analyzed; see [rtables::additional_fun_params]. +#' If supplied, the corresponding column is extracted from the reference-group +#' data. If `NULL`, the complete reference-group data frame is returned. #' -#' @details -#' The reference group is specified in `colpath` hierarchical fashion in -#' `ref_path`: the first column split variable is the first element, and the -#' level to use is the second element. It continues until the last column split -#' variable with last level to use. -#' Note that depending on `.var`, either a `data.frame` (if `.var` is `NULL`) -#' or a vector (otherwise) is returned. This allows usage for analysis -#' functions with `df` and `x` arguments, respectively. +#' @return +#' A list with the following elements: +#' \itemize{ +#' \item `in_ref_col` (`logical(1)` or `NULL`) indicates whether the +#' current column matches the reference path. +#' This corresponds to `.in_ref_col` in [rtables::additional_fun_params]. +#' \item `ref_group` (`data.frame`, vector, or `NULL`) contains the +#' observations belonging to the reference group. If `.var` is `NULL`, +#' the complete data frame is returned; otherwise, the column specified +#' by `.var` is returned. +#' This corresponds to `.ref_group` in [rtables::additional_fun_params]. +#' } +#' +#' If the reference path is not present in the current column-split +#' hierarchy, both elements are `NULL`. #' #' @export #' @@ -73,34 +85,33 @@ #' build_table(lyt, dm) get_ref_info <- function(ref_path, .spl_context, .var = NULL) { if (is.null(ref_path)) { - return(list(ref_group = NULL, in_ref_col = NULL)) + return(NULL) } checkmate::assert_character(ref_path, min.len = 2L, names = "unnamed") - checkmate::assert_true(length(ref_path) %% 2 == 0) + checkmate::assert_true(length(ref_path) %% 2L == 0L) checkmate::assert_data_frame(.spl_context) + checkmate::assert_subset("full_parent_df", colnames(.spl_context)) + checkmate::assert_string(.var, min.chars = 1L, null.ok = TRUE) - leaf_sc <- .spl_context[nrow(.spl_context), ] - vars_indices <- seq(from = 1L, to = length(ref_path) - 1L, by = 2L) - level_indices <- seq(from = 2L, to = length(ref_path), by = 2L) - ref_path_levels <- paste(ref_path[level_indices], collapse = ".") - - # If ref_path variables are outside of the current column split variable. - is_ref_in_colvars <- identical(leaf_sc$cur_col_split[[1]], ref_path[vars_indices]) - if (!is_ref_in_colvars) { - return(list(ref_group = NULL, in_ref_col = NULL)) + # Compare column split names while ignoring split values. + ref_path_val_pos <- seq(2L, length(ref_path), by = 2L) + ref_path_any_val <- replace(ref_path, ref_path_val_pos, "*") + if (!in_column(ref_path_any_val, .spl_context)) { + return(list(in_ref_col = NULL, ref_group = NULL)) } - # Prepare in_ref_col. - in_ref_col <- identical(leaf_sc$cur_col_split_val[[1]], ref_path[level_indices]) - - # Prepare ref_group. - full_df <- leaf_sc$full_parent_df[[1]] - row_in_ref_group <- leaf_sc[[ref_path_levels]][[1]] - ref_group <- full_df[row_in_ref_group, ] + leaf_sc <- .spl_context[nrow(.spl_context), ] + full_df <- leaf_sc$full_parent_df[[1L]] + ref_path_vals <- paste(ref_path[ref_path_val_pos], collapse = ".") + ref_group_rows <- leaf_sc[[ref_path_vals]][[1L]] + ref_group <- full_df[ref_group_rows, ] if (!is.null(.var)) { ref_group <- ref_group[[.var]] } - list(ref_group = ref_group, in_ref_col = in_ref_col) + list( + in_ref_col = in_column(ref_path, .spl_context), + ref_group = ref_group + ) } diff --git a/R/h_freq_funs.R b/R/h_freq_funs.R index a56977da..05ddec6d 100644 --- a/R/h_freq_funs.R +++ b/R/h_freq_funs.R @@ -281,40 +281,40 @@ h_df_add_newlevels <- function(df, .var, new_levels, addstr2levs = NULL, new_lev return(df) } - -#' Get Treatment Variable Reference Path +#' @title Get Current Treatment Group #' -#' Retrieves the treatment variable reference path from the provided context. +#' @description `r lifecycle::badge("stable")` #' -#' @param ref_path (`character`)\cr Reference path for treatment variable. -#' @param .spl_context (`data.frame`)\cr Current split context. -#' @param df (`data.frame`)\cr Data frame. -#' @return List containing treatment variable details. -#' @export -h_get_trtvar_refpath <- function(ref_path, .spl_context, df) { - checkmate::check_character(ref_path, min.len = 2L, names = "unnamed") - checkmate::assert_true(length(ref_path) %% 2 == 0) # Even number of elements in ref_path. - - trt_var <- utils::tail(.spl_context$cur_col_split[[length(.spl_context$cur_col_split)]], n = 1) - trt_var_refspec <- utils::tail(ref_path, n = 2)[1] - - checkmate::assert_true(identical(trt_var, trt_var_refspec)) - - # current group and ctrl_grp - cur_trt_grp <- utils::tail(.spl_context$cur_col_split_val[[length(.spl_context$cur_col_split_val)]], n = 1) - ctrl_grp <- utils::tail(ref_path, n = 1) - - ### check that ctrl_grp is a level of the treatment variable, in case riskdiff is requested - if (!ctrl_grp %in% levels(df[[trt_var]])) { - stop(paste0( - "control group specification in ref_path argument (", - ctrl_grp, - ") is not a level of your treatment group variable (", - trt_var, - ")." - )) - } - return(list(trt_var = trt_var, trt_var_refspec = trt_var_refspec, cur_trt_grp = cur_trt_grp, ctrl_grp = ctrl_grp)) +#' Retrieves the current treatment group from the current column split-path, +#' given the treatment variable name. +#' +#' @param trt_var (`character(1)`)\cr The treatment variable name. +#' @param .spl_context (`data.frame`)\cr The current split context. +#' @return A character string containing the treatment group name. +#' +#' @keywords internal +#' @author WW +#' @seealso [cur_col_split_path()] +#' @examples +#' \dontrun{ +#' .spl_context <- data.frame( +#' cur_col_split = I(list(c("ARM"))), +#' cur_col_split_val = I(list(c("Placebo"))) +#' ) +#' +#' h_get_cur_trt_grp("ARM", .spl_context) +#' h_get_cur_trt_grp("TRT", .spl_context) # errors: TRT not found +#' } +#' +h_get_cur_trt_grp <- function(trt_var, .spl_context) { + checkmate::assert_string(trt_var) + checkmate::assert_data_frame(.spl_context) + + cur_col_path <- cur_col_split_path(.spl_context) + checkmate::assert_true(length(cur_col_path) %% 2L == 0L) + + trt_var_pos <- strict_match(trt_var, cur_col_path, odd = TRUE) + cur_col_path[trt_var_pos + 1L] } # helper function to define expression for retrieving ref_group type of datasets diff --git a/R/utils.R b/R/utils.R index 40105812..ebbb45c9 100644 --- a/R/utils.R +++ b/R/utils.R @@ -514,3 +514,68 @@ factor_by_order <- function(x, y, ordered = FALSE) { # Preserve non-factor attributes of `x`. copy_attributes(source = x, target = f) } + +#' @title Strictly Match a Value in a Character Vector +#' +#' @description +#' Finds a unique match of a value in either the odd or even positions of a +#' character vector. An error is raised if no match or more than one match is +#' found in the selected positions. +#' +#' @param x (`character(1)`)\cr +#' The value to match. +#' @param y (`character`)\cr +#' The character vector in which to search for `x`. +#' @param odd (`flag`)\cr +#' Whether to restrict the match to odd positions. Defaults to `TRUE`. +#' If `FALSE`, only even positions are considered. +#' +#' @return An integer containing the unique position of `x` in `y`. +#' +#' @keywords internal +#' @author WW +#' +#' @examples +#' \dontrun{ +#' strict_match("A", c("A", "Placebo")) +#' +#' strict_match("SEX", c("SomeVar", "SomeVal", "SEX", "Male")) +#' +#' strict_match("ARM", c("SEX", "Male")) +#' strict_match("Male", c("SEX", "Male")) +#' strict_match("ARM", c("ARM", "Placebo", "ARM", "Active")) +#' } +#' +strict_match <- function(x, y, odd = TRUE) { + checkmate::assert_string(x) + checkmate::assert_character(y, any.missing = FALSE) + checkmate::assert_flag(odd) + + pos <- which(x == y) + + # odd = TRUE -> use 1L -> keep odd positions + # odd = FALSE -> use 0L -> keep even positions + pos <- if (odd) { + pos[pos %% 2L != 0L] + } else { + pos[pos %% 2L == 0L] + } + + if (length(pos) == 0L) { + stop(paste0( + "Value ('", x, + "') not found in the ", ifelse(odd, "odd", "even"), + " positions of ('", paste(y, collapse = "."), "')." + )) + } + + if (length(pos) > 1L) { + stop(paste0( + "Value ('", x, + "') must be unique in the ", ifelse(odd, "odd", "even"), + " positions of ('", paste(y, collapse = "."), "')." + )) + } + + pos +} diff --git a/_pkgdown.yml b/_pkgdown.yml index 0bb95c8f..2f472180 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -24,6 +24,7 @@ articles: - table_and_listing_customizations - ancova_combined - standard_column_structures + - get_ref_info reference: - title: junco Analysis Functions desc: The following functions are the Analysis functions used used to create common table layouts. @@ -81,7 +82,6 @@ reference: - summarize_lsmeans_wide - summarize_mmrm - summarize_row_counts - - h_get_trtvar_refpath - rbmi_mmrm_single_info - rbmi_pool - s_cmhrms_j diff --git a/man/get_ref_info.Rd b/man/get_ref_info.Rd index d55f23aa..2d0f00b0 100644 --- a/man/get_ref_info.Rd +++ b/man/get_ref_info.Rd @@ -2,39 +2,50 @@ % Please edit documentation in R/get_ref_info.R \name{get_ref_info} \alias{get_ref_info} -\title{Obtain Reference Information for a Global Reference Group} +\title{Obtain reference group information from split context.} \usage{ get_ref_info(ref_path, .spl_context, .var = NULL) } \arguments{ -\item{ref_path}{(\code{character})\cr reference group specification as an \code{rtables} -\code{colpath}, see details.} +\item{ref_path}{(\code{character}) \cr +Reference group specification as an \code{rtables} \code{colpath}; see Details.} -\item{.spl_context}{(\code{data.frame})\cr see \link[rtables:spl_context]{rtables::spl_context}.} +\item{.spl_context}{(\code{data.frame}) \cr +Ancestor split-state information passed by \code{rtables}.} -\item{.var}{(\code{character})\cr the variable being analyzed, -see \link[rtables:additional_fun_params]{rtables::additional_fun_params}.} +\item{.var}{(\code{character(1)}) \cr +The variable being analyzed; see \link[rtables:additional_fun_params]{rtables::additional_fun_params}. +If supplied, the corresponding column is extracted from the reference-group +data. If \code{NULL}, the complete reference-group data frame is returned.} } \value{ -A list with \code{ref_group} and \code{in_ref_col}, which can be used as -\code{.ref_group} and \code{.in_ref_col} as if being directly passed to an analysis -function by \code{rtables}, see \link[rtables:additional_fun_params]{rtables::additional_fun_params}. +A list with the following elements: +\itemize{ +\item \code{in_ref_col} (\code{logical(1)} or \code{NULL}) indicates whether the +current column matches the reference path. +This corresponds to \code{.in_ref_col} in \link[rtables:additional_fun_params]{rtables::additional_fun_params}. +\item \code{ref_group} (\code{data.frame}, vector, or \code{NULL}) contains the +observations belonging to the reference group. If \code{.var} is \code{NULL}, +the complete data frame is returned; otherwise, the column specified +by \code{.var} is returned. +This corresponds to \code{.ref_group} in \link[rtables:additional_fun_params]{rtables::additional_fun_params}. +} + +If the reference path is not present in the current column-split +hierarchy, both elements are \code{NULL}. } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} -This helper function can be used in custom analysis functions, by passing -an extra argument \code{ref_path} which defines a global reference group by -the corresponding column split hierarchy levels. -} -\details{ -The reference group is specified in \code{colpath} hierarchical fashion in -\code{ref_path}: the first column split variable is the first element, and the -level to use is the second element. It continues until the last column split -variable with last level to use. -Note that depending on \code{.var}, either a \code{data.frame} (if \code{.var} is \code{NULL}) -or a vector (otherwise) is returned. This allows usage for analysis -functions with \code{df} and \code{x} arguments, respectively. +\code{get_ref_info()} identifies a reference group defined by a column-split +path and returns both the reference-group data and an indicator of whether +the current column is the reference column. It is intended for use inside +custom \code{rtables} analysis functions. + +The reference group is specified using \code{ref_path}, which consists of +alternating column-split variable names and its corresponding levels. +For example, \code{c("SEX", "F", "ARM", "Placebo")} specifies the column-split +path where \code{SEX} is \code{"F"} and \code{ARM} is \code{"Placebo"}. } \examples{ dm <- DM diff --git a/man/h_get_cur_trt_grp.Rd b/man/h_get_cur_trt_grp.Rd new file mode 100644 index 00000000..b674cb90 --- /dev/null +++ b/man/h_get_cur_trt_grp.Rd @@ -0,0 +1,41 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/h_freq_funs.R +\name{h_get_cur_trt_grp} +\alias{h_get_cur_trt_grp} +\title{Get Current Treatment Group} +\usage{ +h_get_cur_trt_grp(trt_var, .spl_context) +} +\arguments{ +\item{trt_var}{(\code{character(1)})\cr The treatment variable name.} + +\item{.spl_context}{(\code{data.frame})\cr The current split context.} +} +\value{ +A character string containing the treatment group name. +} +\description{ +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} + +Retrieves the current treatment group from the current column split-path, +given the treatment variable name. +} +\examples{ +\dontrun{ +.spl_context <- data.frame( + cur_col_split = I(list(c("ARM"))), + cur_col_split_val = I(list(c("Placebo"))) +) + +h_get_cur_trt_grp("ARM", .spl_context) +h_get_cur_trt_grp("TRT", .spl_context) # errors: TRT not found +} + +} +\seealso{ +\code{\link[=cur_col_split_path]{cur_col_split_path()}} +} +\author{ +WW +} +\keyword{internal} diff --git a/man/h_get_trtvar_refpath.Rd b/man/h_get_trtvar_refpath.Rd deleted file mode 100644 index 0d09cc18..00000000 --- a/man/h_get_trtvar_refpath.Rd +++ /dev/null @@ -1,21 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/h_freq_funs.R -\name{h_get_trtvar_refpath} -\alias{h_get_trtvar_refpath} -\title{Get Treatment Variable Reference Path} -\usage{ -h_get_trtvar_refpath(ref_path, .spl_context, df) -} -\arguments{ -\item{ref_path}{(\code{character})\cr Reference path for treatment variable.} - -\item{.spl_context}{(\code{data.frame})\cr Current split context.} - -\item{df}{(\code{data.frame})\cr Data frame.} -} -\value{ -List containing treatment variable details. -} -\description{ -Retrieves the treatment variable reference path from the provided context. -} diff --git a/man/response_by_var.Rd b/man/response_by_var.Rd index 09662103..fe7b5bd1 100644 --- a/man/response_by_var.Rd +++ b/man/response_by_var.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/count_denom_fraction.R +% Please edit documentation in R/response_by_var.R \name{response_by_var} \alias{response_by_var} \title{Count denom fraction statistic} diff --git a/man/strict_match.Rd b/man/strict_match.Rd new file mode 100644 index 00000000..88118e4c --- /dev/null +++ b/man/strict_match.Rd @@ -0,0 +1,43 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utils.R +\name{strict_match} +\alias{strict_match} +\title{Strictly Match a Value in a Character Vector} +\usage{ +strict_match(x, y, odd = TRUE) +} +\arguments{ +\item{x}{(\code{character(1)})\cr +The value to match.} + +\item{y}{(\code{character})\cr +The character vector in which to search for \code{x}.} + +\item{odd}{(\code{flag})\cr +Whether to restrict the match to odd positions. Defaults to \code{TRUE}. +If \code{FALSE}, only even positions are considered.} +} +\value{ +An integer containing the unique position of \code{x} in \code{y}. +} +\description{ +Finds a unique match of a value in either the odd or even positions of a +character vector. An error is raised if no match or more than one match is +found in the selected positions. +} +\examples{ +\dontrun{ +strict_match("A", c("A", "Placebo")) + +strict_match("SEX", c("SomeVar", "SomeVal", "SEX", "Male")) + +strict_match("ARM", c("SEX", "Male")) +strict_match("Male", c("SEX", "Male")) +strict_match("ARM", c("ARM", "Placebo", "ARM", "Active")) +} + +} +\author{ +WW +} +\keyword{internal} diff --git a/tests/testthat/_snaps/get_ref_info.md b/tests/testthat/_snaps/get_ref_info.md index 4da8fcb0..690844f9 100644 --- a/tests/testthat/_snaps/get_ref_info.md +++ b/tests/testthat/_snaps/get_ref_info.md @@ -63,3 +63,14 @@ Mean 34.91 33.02 34.57 34.22 Difference in Means vs Placebo 1.89 1.55 +# get_ref_info returns reference information for matching column splits + + Code + cat(sub("[[:space:]]+$", "", capture.output(result)), sep = "\n") + Output + Active Study Agent + A: Drug X C: Combination B: Placebo + —————————————————————————————————————————————————————————————— + Reference Group Size 106 106 106 + In Reference Column FALSE FALSE TRUE + diff --git a/tests/testthat/test-cur_col_split_path.R b/tests/testthat/test-cur_col_split_path.R index e540b5f5..afe384e8 100644 --- a/tests/testthat/test-cur_col_split_path.R +++ b/tests/testthat/test-cur_col_split_path.R @@ -10,6 +10,18 @@ test_that("cur_col_split_path() works for a single-level split", { expect_identical(res, exp) }) +test_that("cur_col_split_path() accepts named split values", { + spl_context <- data.frame( + cur_col_split = I(list("ARM")), + cur_col_split_val = I(list(c(ARM = "Placebo"))) + ) + + res <- cur_col_split_path(spl_context) + exp <- c("ARM", "Placebo") + + expect_identical(unname(res), exp) +}) + test_that("cur_col_split_path() uses the leaf row split for a single-level split", { spl_context <- data.frame( cur_col_split = I(list("ARM_0", "ARM")), diff --git a/tests/testthat/test-get_ref_info.R b/tests/testthat/test-get_ref_info.R index d764e8a9..1b4bc3f8 100644 --- a/tests/testthat/test-get_ref_info.R +++ b/tests/testthat/test-get_ref_info.R @@ -204,7 +204,150 @@ test_that("get_ref_info works with a df in the presence of the overall column", test_that("get_ref_info returns NULL values when ref_path is NULL", { res <- get_ref_info(NULL, .spl_context = data.frame()) - exp <- list(ref_group = NULL, in_ref_col = NULL) - expect_identical(res, exp) + expect_null(res) +}) + +test_that("get_ref_info returns reference information for matching column splits", { + dm <- formatters::DM + dm$colspan_trt <- factor( + ifelse(dm$ARM == "B: Placebo", " ", "Active Study Agent"), + levels = c("Active Study Agent", " ") + ) + colspan_trt_map <- create_colspan_map( + dm, + non_active_grp = "B: Placebo", + non_active_grp_span_lbl = " ", + active_grp_span_lbl = "Active Study Agent", + colspan_var = "colspan_trt", + trt_var = "ARM" + ) + + ref_path <- c("colspan_trt", " ", "ARM", "B: Placebo") + + introspect_ref_info <- function(df, ref_path, .spl_context) { + ref_info <- get_ref_info(ref_path, .spl_context) + in_rows( + "Reference Group Size" = rcell(nrow(ref_info$ref_group)), + "In Reference Column" = rcell(ref_info$in_ref_col) + ) + } + + lyt <- basic_table() |> + split_cols_by("colspan_trt", split_fun = trim_levels_to_map(map = colspan_trt_map)) |> + split_cols_by("ARM") |> + analyze("AGE", afun = introspect_ref_info, extra_args = list(ref_path = ref_path)) + + result <- build_table(lyt, dm) + + expect_snapshot( + cran = TRUE, + cat(sub("[[:space:]]+$", "", capture.output(result)), sep = "\n") + ) +}) + +test_that("get_ref_info returns NULL reference information in risk-diff columns", { + dm <- formatters::DM + dm$colspan_trt <- factor( + ifelse(dm$ARM == "B: Placebo", " ", "Active Study Agent"), + levels = c("Active Study Agent", " ") + ) + dm$rrisk_header <- "Risk Difference (95% CI)" + dm$rrisk_label <- paste(dm$ARM, "vs B: Placebo") + + colspan_trt_map <- create_colspan_map( + dm, + non_active_grp = "B: Placebo", + non_active_grp_span_lbl = " ", + active_grp_span_lbl = "Active Study Agent", + colspan_var = "colspan_trt", + trt_var = "ARM" + ) + + ref_path <- c("colspan_trt", " ", "ARM", "B: Placebo") + + captured <- list() + spy_afun <- function(df, ref_path, .spl_context) { + colid <- .spl_context$cur_col_id[[1L]] + if (grepl("difference", tolower(colid), fixed = TRUE)) { + captured[[length(captured) + 1L]] <<- get_ref_info(ref_path, .spl_context) + } + in_rows("x" = rcell(1, format = "xx")) + } + + lyt <- basic_table() |> + split_cols_by("colspan_trt", split_fun = trim_levels_to_map(map = colspan_trt_map)) |> + split_cols_by("ARM") |> + split_cols_by("rrisk_header", nested = FALSE) |> + split_cols_by("ARM", + labels_var = "rrisk_label", + split_fun = remove_split_levels("B: Placebo") + ) |> + analyze("AGE", afun = spy_afun, extra_args = list(ref_path = ref_path)) + + build_table(lyt, dm) + + expect_length(captured, 2L) + for (res in captured) { + expect_null(res$ref_group) + expect_null(res$in_ref_col) + } +}) + +test_that("h_get_cur_trt_grp returns the current treatment group in a risk-diff column", { + dm <- formatters::DM + dm$colspan_trt <- factor( + ifelse(dm$ARM == "B: Placebo", " ", "Active Study Agent"), + levels = c("Active Study Agent", " ") + ) + dm$rrisk_header <- "Risk Difference (95% CI)" + dm$rrisk_label <- paste(dm$ARM, "vs B: Placebo") + + colspan_trt_map <- create_colspan_map( + dm, + non_active_grp = "B: Placebo", + non_active_grp_span_lbl = " ", + active_grp_span_lbl = "Active Study Agent", + colspan_var = "colspan_trt", + trt_var = "ARM" + ) + + ref_path <- c("colspan_trt", " ", "ARM", "B: Placebo") + + captured <- list() + spy_afun <- function(df, ref_path, .spl_context) { + colid <- .spl_context$cur_col_id[[1L]] + if (grepl("difference", tolower(colid), fixed = TRUE)) { + res <- h_get_cur_trt_grp("ARM", .spl_context) + captured[[length(captured) + 1L]] <<- res + } + in_rows("x" = rcell(1, format = "xx")) + } + + lyt <- basic_table() |> + split_cols_by("colspan_trt", split_fun = trim_levels_to_map(map = colspan_trt_map)) |> + split_cols_by("ARM") |> + split_cols_by("rrisk_header", nested = FALSE) |> + split_cols_by("ARM", + labels_var = "rrisk_label", + split_fun = remove_split_levels("B: Placebo") + ) |> + analyze("AGE", afun = spy_afun, extra_args = list(ref_path = ref_path)) + + build_table(lyt, dm) + + expect_length(captured, 2L) + for (res in captured) { + expect_true(res %in% levels(dm$ARM)) + expect_false(res == "B: Placebo") + } +}) + +test_that("h_get_cur_trt_grp errors when trt_var not in split context", { + spl_context <- data.frame( + cur_col_split = I(list(c("SEX"))), + cur_col_split_val = I(list(c("Male"))) + ) + + expect_error(h_get_cur_trt_grp("ARM", spl_context), "not found") }) diff --git a/tests/testthat/test-utils-strict_match.R b/tests/testthat/test-utils-strict_match.R new file mode 100644 index 00000000..fafbb9ea --- /dev/null +++ b/tests/testthat/test-utils-strict_match.R @@ -0,0 +1,22 @@ +test_that("strict_match works at odd positions", { + expect_equal(strict_match("A", c("A", "Placebo")), 1) + expect_equal(strict_match("SEX", c("SomeVar", "SomeVal", "SEX", "Male")), 3) + expect_equal(strict_match("ARM", c("SEX", "M", "ARM", "Placebo", "multivars", "AVAL")), 3) +}) + +test_that("strict_match works at even positions", { + expect_equal(strict_match("Placebo", c("ARM", "Placebo"), odd = FALSE), 2) + expect_equal(strict_match("Male", c("SomeVar", "SomeVal", "SEX", "Male"), odd = FALSE), 4) +}) + +test_that("strict_match errors at value not found", { + expect_error(strict_match("ARM", c("SEX", "Male")), "not found") +}) + +test_that("strict_match errors at value is at wrong parity position", { + expect_error(strict_match("Male", c("SEX", "Male")), "not found") +}) + +test_that("strict_match errors on duplicate matches", { + expect_error(strict_match("ARM", c("ARM", "Placebo", "ARM", "Active")), "must be unique") +}) diff --git a/vignettes/get_ref_info.Rmd b/vignettes/get_ref_info.Rmd new file mode 100644 index 00000000..d7fb6486 --- /dev/null +++ b/vignettes/get_ref_info.Rmd @@ -0,0 +1,240 @@ +--- +title: "Reference Group Handling with get_ref_info" +date: "`r Sys.Date()`" +output: + rmarkdown::html_document: + theme: "spacelab" + highlight: "kate" + toc: true + toc_float: true +vignette: > + %\VignetteIndexEntry{Reference Group Handling with get_ref_info} + %\VignetteEngine{knitr::rmarkdown} + %\VignetteEncoding{UTF-8} +editor_options: + markdown: + wrap: 72 +--- + +```{r setup, include = FALSE} +knitr::opts_chunk$set( + echo = TRUE, + collapse = TRUE, + comment = "#>" +) +``` + +## Overview + +Many clinical tables require statistics computed relative to a reference +(control) group — for example, a risk difference versus placebo. In +`rtables`, the reference group can be injected automatically via +`.ref_group` and `.in_ref_col`, but this breaks down when: + +- the reference column is nested under a spanning header, +- a `split_cols_by_multivar` is present, or +- an `add_overall_col` is used alongside treatment splits. + +`get_ref_info()` solves this by letting the analysis function look up +the reference group itself, using an explicit column path (`ref_path`). + +```{r load_packages, message=FALSE} +library(rtables) +library(junco) +library(dplyr) +``` + +## The `ref_path` Convention + +`ref_path` is a character vector of alternating split-variable names and +their values, following the same convention as `rtables::col_paths()`: + +``` +c("var1", "level1", "var2", "level2", ...) +``` + +For a simple layout with `split_cols_by("ARM")`, the placebo reference +path is: + +```r +ref_path <- c("ARM", "B: Placebo") +``` + +For a layout with a spanning header variable `colspan_trt` above `ARM`, +the path must include both levels: + +```r +ref_path <- c("colspan_trt", " ", "ARM", "B: Placebo") +``` + +The path must exactly match the column-split hierarchy in the layout. +Use `col_paths(build_table(lyt, df))` to inspect the available paths. + +## Basic Usage + +`get_ref_info()` returns a list with two elements: + +- `in_ref_col`: `TRUE` if the current column matches `ref_path`, + `FALSE` otherwise, `NULL` if the reference split variable is not + present in the current column hierarchy. +- `ref_group`: the subset of the row data belonging to the reference + group (a data frame, or a vector if `.var` is supplied). + +## Working Example: AE Table with Risk Difference Columns + +This example demonstrates the standard pattern for a table with +spanning headers and risk difference columns — the primary use case +for `get_ref_info()`. + +```{r data_prep} +trtvar <- "TRT01A" +ctrl_grp <- "Placebo" + +adsl <- pharmaverseadamjnj::adsl |> + filter(SAFFL == "Y") |> + select(STUDYID, USUBJID, all_of(trtvar), SAFFL) |> + mutate(!!trtvar := factor( + .data[[trtvar]], + levels = c("Xanomeline Low Dose", "Xanomeline High Dose", "Placebo") + )) + +adae <- pharmaverseadamjnj::adae |> + filter(TRTEMFL == "Y") |> + select(USUBJID, TRTEMFL, AEBODSYS, AEDECOD) + +# Add spanning header and risk difference variables +adsl$colspan_trt <- factor( + ifelse(adsl[[trtvar]] == ctrl_grp, " ", "Active Study Agent"), + levels = c("Active Study Agent", " ") +) +adsl$rrisk_header <- "Risk Difference (%) (95% CI)" +adsl$rrisk_label <- paste(adsl[[trtvar]], "vs", ctrl_grp) + +ae <- adae |> right_join(adsl, by = "USUBJID") +``` + +The `ref_path` must trace the full column-split hierarchy down to the +reference group: + +```{r ref_path} +colspan_trt_map <- create_colspan_map( + adsl, + non_active_grp = ctrl_grp, + non_active_grp_span_lbl = " ", + active_grp_span_lbl = "Active Study Agent", + colspan_var = "colspan_trt", + trt_var = trtvar +) + +ref_path <- c("colspan_trt", " ", trtvar, ctrl_grp) +``` + +Now build the layout. The key point: `a_freq_j` uses `get_ref_info()` +internally to identify the reference group and compute risk differences +in the dedicated difference columns: + +```{r layout_and_table} +extra_args <- list( + denom = "n_altdf", + riskdiff = TRUE, + ref_path = ref_path, + method = "wald", + .stats = "count_unique_fraction", + .formats = c(rr_ci_3d = jjcsformat_xx("xx.x (xx.x, xx.x)")) +) + +lyt <- basic_table(show_colcounts = TRUE, colcount_format = "N=xx") |> + split_cols_by("colspan_trt", + split_fun = trim_levels_to_map(map = colspan_trt_map) + ) |> + split_cols_by(trtvar) |> + split_cols_by("rrisk_header", nested = FALSE) |> + split_cols_by(trtvar, + labels_var = "rrisk_label", + split_fun = remove_split_levels(ctrl_grp) + ) |> + analyze("TRTEMFL", + afun = a_freq_j, + extra_args = append(extra_args, list(val = "Y", label = "Subjects with >=1 AE")) + ) |> + split_rows_by("AEBODSYS", + split_label = "System Organ Class", + split_fun = trim_levels_in_group("AEDECOD"), + label_pos = "topleft", + section_div = " ", + nested = FALSE + ) |> + summarize_row_groups("AEBODSYS", cfun = a_freq_j, extra_args = extra_args) |> + analyze("AEDECOD", afun = a_freq_j, extra_args = extra_args) |> + append_topleft(" Preferred Term, n (%)") + +result <- build_table(lyt, ae, alt_counts_df = adsl) +head(result, 10) +``` + +## How `get_ref_info` Works Internally + +When `a_freq_j` (or any analysis function) calls +`get_ref_info(ref_path, .spl_context)`: + +1. It checks whether the split variables in `ref_path` are present in + the current column hierarchy (using `in_column()` with wildcards). +2. If present, it subsets the row data to the reference group using the + pre-computed column facet indices stored in `.spl_context`. +3. It returns `in_ref_col = TRUE/FALSE` indicating whether the current + column IS the reference column (so the function can skip computing + a difference against itself). + +When the reference split is absent from the current column hierarchy +(e.g. in an `add_overall_col("Total")` column), both `in_ref_col` and +`ref_group` are `NULL`. + +## Wildcard Matching with `in_column()` + +`in_column()` — the underlying helper used by `get_ref_info()` — +supports `"*"` as a wildcard for any single split variable name or +value: + +```{r wildcard} +# Simulate a split context for ARM == "B: Placebo" under colspan_trt == " " +spl_ctx <- data.frame( + cur_col_split = I(list(c("colspan_trt", "ARM"))), + cur_col_split_val = I(list(c(" ", "B: Placebo"))) +) + +# Exact match +in_column(c("colspan_trt", " ", "ARM", "B: Placebo"), spl_ctx) + +# Wildcard on spanning header — still TRUE +in_column(c("*", "*", "ARM", "B: Placebo"), spl_ctx) + +# Different ARM level — FALSE +in_column(c("*", "*", "ARM", "A: Drug X"), spl_ctx) +``` + +## Relationship to `h_get_cur_trt_grp` + +`get_ref_info()` and `h_get_cur_trt_grp()` serve different purposes: + +| | `get_ref_info()` | `h_get_cur_trt_grp()` | +|---|---|---| +| **Returns** | reference-group data + `in_ref_col` flag | current treatment group value (single string) | +| **Used for** | obtaining `.ref_group` / `.in_ref_col` for statistics | identifying which treatment group the current column belongs to | +| **Typical callers** | `a_freq_j`, `a_eair_j`, `s_ancova_j` | `a_summarize_aval_chg_diff_j`, `a_freq_j`, `a_freq_resp_var_j` | + +In layouts that combine `split_cols_by_multivar` with difference +columns, `h_get_cur_trt_grp()` resolves the current treatment group +from the interleaved column path, and `get_ref_info()` obtains the +reference-group data. + +## Inspecting Column Paths + +When constructing `ref_path`, inspect the column paths of a built table: + +```{r col_paths} +col_paths(result) +``` + +Each path corresponds to a leaf column. The `ref_path` should match one +of these paths exactly (or a prefix thereof when the reference column +has further nested splits below it).