From 7edda8cbe8996364b32d88e3bcf8fee5ff2a9aac Mon Sep 17 00:00:00 2001 From: munoztd0 Date: Fri, 17 Jul 2026 12:13:31 +0200 Subject: [PATCH 01/38] new unified get_ref_info --- DESCRIPTION | 2 +- NEWS.md | 7 +- R/a_summarize_aval_chg_diff.R | 7 +- R/cur_col_split_path_utils.R | 123 ++++++++++++++++++++++ R/get_ref_info.R | 106 ------------------- R/h_freq_funs.R | 4 + man/get_ref_info.Rd | 13 ++- man/h_get_trtvar_refpath.Rd | 4 + tests/testthat/test-get_ref_info.R | 157 ++++++++++++++++++++++++++++- 9 files changed, 308 insertions(+), 115 deletions(-) delete mode 100644 R/get_ref_info.R diff --git a/DESCRIPTION b/DESCRIPTION index 9d23828c..db2e8300 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/NEWS.md b/NEWS.md index 65ee33a3..79b62545 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). @@ -38,6 +38,11 @@ - Update new exported calls from rtables.officer - update documentation to `roxygen2` 8.0.0 - Add extra statistics to `a_eair100_j` and introduce scaling factor `num_p_year` (default = 100) (#361) +- Unified `get_ref_info()` which now also returns `trt_var`, `ctrl_grp`, and `cur_col_val` (#295) +- `h_get_trtvar_refpath()` is marked as superseded +- `a_summarize_aval_chg_diff_j()` now uses `get_ref_info()` + + ### Added - Added `categorize_pval()` for assigning p-values to validated, user-defined categories. diff --git a/R/a_summarize_aval_chg_diff.R b/R/a_summarize_aval_chg_diff.R index c3d892f3..96ad3108 100644 --- a/R/a_summarize_aval_chg_diff.R +++ b/R/a_summarize_aval_chg_diff.R @@ -474,11 +474,12 @@ 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] + ref <- get_ref_info(ref_path, .spl_context) + trt_var_refspec <- ref$trt_var checkmate::assert_true(identical(trt_var, trt_var_refspec)) - # ctrl_grp - ctrl_grp <- utils::tail(ref_path, n = 1) + ctrl_grp <- ref$ctrl_grp ### check that ctrl_grp is a level of the treatment variable, in case riskdiff is requested if (!ctrl_grp %in% levels(df[[trt_var]])) { diff --git a/R/cur_col_split_path_utils.R b/R/cur_col_split_path_utils.R index 9c445671..72a32e87 100644 --- a/R/cur_col_split_path_utils.R +++ b/R/cur_col_split_path_utils.R @@ -138,3 +138,126 @@ in_column <- function(col_path, .spl_context) { FALSE } } + +#' @describeIn cur_col_split_path_utils +#' Obtain reference information for a global reference group. +#' +#' 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. +#' +#' @param ref_path (`character`) +#' Reference group specification as an `rtables` `colpath`; see Details. +#' @param .var (`character`) +#' The variable being analyzed; see [rtables::additional_fun_params]. +#' +#' @return +#' * `get_ref_info()` returns a list with: +#' * `ref_group`: the reference group data (a `data.frame` or vector depending +#' on `.var`), equivalent to `.ref_group` from [rtables::additional_fun_params]. +#' * `in_ref_col`: logical, whether the current column is the reference column, +#' equivalent to `.in_ref_col` from [rtables::additional_fun_params]. +#' * `trt_var`: the treatment variable name (last variable in `ref_path`). +#' * `ctrl_grp`: the reference group level (last level in `ref_path`). +#' * `cur_col_val`: the current column's value for `trt_var`. +#' +#' @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. +#' +#' @export +#' +#' @examples +#' dm <- 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" +#' ) +#' +#' # A standard analysis function which uses a reference group. +#' standard_afun <- function(x, .ref_group, .in_ref_col) { +#' diff_means <- if (isFALSE(.in_ref_col)) { +#' mean(x) - mean(.ref_group) +#' } else { +#' NULL +#' } +#' in_rows( +#' m = rcell(mean(x), label = "Mean"), +#' dm = rcell(diff_means, label = "Difference in Means vs Placebo"), +#' .formats = "xx.xx" +#' ) +#' } +#' +#' # The custom analysis function which can work with a global reference group. +#' result_afun <- function(x, ref_path, .spl_context, .var) { +#' ref <- get_ref_info(ref_path, .spl_context, .var) +#' standard_afun(x, .ref_group = ref$ref_group, .in_ref_col = ref$in_ref_col) +#' } +#' +#' ref_path <- c("colspan_trt", " ", "ARM", "B: Placebo") +#' +#' lyt <- basic_table() |> +#' split_cols_by("colspan_trt", split_fun = trim_levels_to_map(colspan_trt_map)) |> +#' split_cols_by("ARM") |> +#' add_overall_col("Total") |> +#' analyze("AGE", afun = result_afun, extra_args = list(ref_path = ref_path)) +#' +#' 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, trt_var = NULL, ctrl_grp = NULL, cur_col_val = NULL)) + } + + checkmate::assert_character(ref_path, min.len = 2L, names = "unnamed") + checkmate::assert_true(length(ref_path) %% 2 == 0) + checkmate::assert_data_frame(.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 = ".") + + trt_var <- ref_path[utils::tail(vars_indices, 1L)] + ctrl_grp <- ref_path[utils::tail(level_indices, 1L)] + + cur_colpath <- cur_col_split_path(.spl_context) + cur_col_vars <- cur_colpath[seq(from = 1L, to = length(cur_colpath), by = 2L)] + cur_col_vals <- cur_colpath[seq(from = 2L, to = length(cur_colpath), by = 2L)] + trt_var_pos <- match(trt_var, cur_col_vars) + cur_col_val <- if (!is.na(trt_var_pos)) cur_col_vals[trt_var_pos] else NULL + + # If ref_path variables are outside of the current column split variable. + ref_var_path <- ref_path + ref_var_path[level_indices] <- "*" + if (!in_column(ref_var_path, .spl_context)) { + return(list(ref_group = NULL, in_ref_col = NULL, trt_var = trt_var, ctrl_grp = ctrl_grp, cur_col_val = cur_col_val)) + } + + leaf_sc <- .spl_context[nrow(.spl_context), ] + 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, ] + if (!is.null(.var)) { + ref_group <- ref_group[[.var]] + } + + list( + ref_group = ref_group, + in_ref_col = in_column(ref_path, .spl_context), + trt_var = trt_var, + ctrl_grp = ctrl_grp, + cur_col_val = cur_col_val + ) +} diff --git a/R/get_ref_info.R b/R/get_ref_info.R deleted file mode 100644 index a250d258..00000000 --- a/R/get_ref_info.R +++ /dev/null @@ -1,106 +0,0 @@ -#' @title Obtain Reference Information for a Global Reference Group -#' -#' @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. -#' -#' @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]. -#' -#' @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]. -#' -#' @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. -#' -#' @export -#' -#' @examples -#' dm <- 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" -#' ) -#' -#' # A standard analysis function which uses a reference group. -#' standard_afun <- function(x, .ref_group, .in_ref_col) { -#' diff_means <- if (isFALSE(.in_ref_col)) { -#' mean(x) - mean(.ref_group) -#' } else { -#' NULL -#' } -#' in_rows( -#' m = rcell(mean(x), label = "Mean"), -#' dm = rcell(diff_means, label = "Difference in Means vs Placebo"), -#' .formats = "xx.xx" -#' ) -#' } -#' -#' # The custom analysis function which can work with a global reference group. -#' result_afun <- function(x, ref_path, .spl_context, .var) { -#' ref <- get_ref_info(ref_path, .spl_context, .var) -#' standard_afun(x, .ref_group = ref$ref_group, .in_ref_col = ref$in_ref_col) -#' } -#' -#' ref_path <- c("colspan_trt", " ", "ARM", "B: Placebo") -#' -#' lyt <- basic_table() |> -#' split_cols_by("colspan_trt", split_fun = trim_levels_to_map(colspan_trt_map)) |> -#' split_cols_by("ARM") |> -#' add_overall_col("Total") |> -#' analyze("AGE", afun = result_afun, extra_args = list(ref_path = ref_path)) -#' -#' 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)) - } - - checkmate::assert_character(ref_path, min.len = 2L, names = "unnamed") - checkmate::assert_true(length(ref_path) %% 2 == 0) - checkmate::assert_data_frame(.spl_context) - - 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)) - } - - # 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, ] - if (!is.null(.var)) { - ref_group <- ref_group[[.var]] - } - - list(ref_group = ref_group, in_ref_col = in_ref_col) -} diff --git a/R/h_freq_funs.R b/R/h_freq_funs.R index a56977da..b3af0995 100644 --- a/R/h_freq_funs.R +++ b/R/h_freq_funs.R @@ -284,7 +284,11 @@ h_df_add_newlevels <- function(df, .var, new_levels, addstr2levs = NULL, new_lev #' Get Treatment Variable Reference Path #' +#' @description `r lifecycle::badge("superseded")` +#' #' Retrieves the treatment variable reference path from the provided context. +#' Prefer [get_ref_info()] which now returns `trt_var`, `ctrl_grp`, and +#' `cur_col_val` in addition to `ref_group` and `in_ref_col`. #' #' @param ref_path (`character`)\cr Reference path for treatment variable. #' @param .spl_context (`data.frame`)\cr Current split context. diff --git a/man/get_ref_info.Rd b/man/get_ref_info.Rd index d55f23aa..87a26d34 100644 --- a/man/get_ref_info.Rd +++ b/man/get_ref_info.Rd @@ -16,9 +16,16 @@ get_ref_info(ref_path, .spl_context, .var = NULL) see \link[rtables:additional_fun_params]{rtables::additional_fun_params}.} } \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: +\itemize{ +\item \code{ref_group}: the reference group data (a \code{data.frame} or vector depending +on \code{.var}), equivalent to \code{.ref_group} from \link[rtables:additional_fun_params]{rtables::additional_fun_params}. +\item \code{in_ref_col}: logical, whether the current column is the reference column, +equivalent to \code{.in_ref_col} from \link[rtables:additional_fun_params]{rtables::additional_fun_params}. +\item \code{trt_var}: the treatment variable name (last variable in \code{ref_path}). +\item \code{ctrl_grp}: the reference group level (last level in \code{ref_path}). +\item \code{cur_col_val}: the current column's value for \code{trt_var}. +} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} diff --git a/man/h_get_trtvar_refpath.Rd b/man/h_get_trtvar_refpath.Rd index 0d09cc18..d961eb36 100644 --- a/man/h_get_trtvar_refpath.Rd +++ b/man/h_get_trtvar_refpath.Rd @@ -17,5 +17,9 @@ h_get_trtvar_refpath(ref_path, .spl_context, df) List containing treatment variable details. } \description{ +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#superseded}{\figure{lifecycle-superseded.svg}{options: alt='[Superseded]'}}}{\strong{[Superseded]}} + Retrieves the treatment variable reference path from the provided context. +Prefer \code{\link[=get_ref_info]{get_ref_info()}} which now returns \code{trt_var}, \code{ctrl_grp}, and +\code{cur_col_val} in addition to \code{ref_group} and \code{in_ref_col}. } diff --git a/tests/testthat/test-get_ref_info.R b/tests/testthat/test-get_ref_info.R index d764e8a9..5b61b27c 100644 --- a/tests/testthat/test-get_ref_info.R +++ b/tests/testthat/test-get_ref_info.R @@ -204,7 +204,162 @@ 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) + exp <- list(ref_group = NULL, in_ref_col = NULL, trt_var = NULL, ctrl_grp = NULL, cur_col_val = NULL) expect_identical(res, exp) }) + +test_that("get_ref_info returns trt_var, ctrl_grp, cur_col_val in the matched-colvars case", { + 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") + + captured <- list() + spy_afun <- function(df, ref_path, .spl_context) { + 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") |> + analyze("AGE", afun = spy_afun, extra_args = list(ref_path = ref_path)) + + build_table(lyt, dm) + + for (res in captured) { + expect_identical(res$trt_var, "ARM") + expect_identical(res$ctrl_grp, "B: Placebo") + } + + ref_col <- Filter(function(r) isTRUE(r$in_ref_col), captured) + expect_length(ref_col, 1L) + expect_identical(ref_col[[1L]]$cur_col_val, "B: Placebo") + + non_ref_cols <- Filter(function(r) isFALSE(r$in_ref_col), captured) + expect_true(length(non_ref_cols) >= 1L) + for (res in non_ref_cols) { + expect_false(res$cur_col_val == "B: Placebo") + } +}) + +test_that("get_ref_info returns trt_var and ctrl_grp even when ref_path is outside colvars (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) { + 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) + + outside_cols <- Filter(function(r) is.null(r$ref_group) && is.null(r$in_ref_col), captured) + expect_true(length(outside_cols) >= 1L) + for (res in outside_cols) { + expect_identical(res$trt_var, "ARM") + expect_identical(res$ctrl_grp, "B: Placebo") + expect_false(is.null(res$cur_col_val)) + } +}) + +test_that("h_get_trtvar_refpath returns the expected shape and values 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_trtvar_refpath(ref_path, .spl_context, df) + 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_true(length(captured) >= 1L) + for (res in captured) { + expect_identical(res$trt_var, "ARM") + expect_identical(res$ctrl_grp, "B: Placebo") + expect_identical(res$trt_var_refspec, "ARM") # trt_var_refspec == trt_var by definition + expect_false(is.null(res$cur_trt_grp)) # cur_trt_grp is the active arm value + } +}) + +test_that("get_ref_info identifies cur_col_val from split variables", { + spl_context <- data.frame( + cur_col_split = I(list(c("COLSPAN", "ARM"))), + cur_col_split_val = I(list(c("ARM", "A: Drug X"))) + ) + + result <- get_ref_info(c("ARM", "B: Placebo"), spl_context) + + expect_identical(result$cur_col_val, "A: Drug X") +}) From a4a59f388596205c62ea868e4516fa82cd6ac506 Mon Sep 17 00:00:00 2001 From: munoztd0 Date: Fri, 17 Jul 2026 10:24:38 +0000 Subject: [PATCH 02/38] new unified get_ref_info() --- R/get_ref_info.R | 121 +++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 121 insertions(+) create mode 100644 R/get_ref_info.R diff --git a/R/get_ref_info.R b/R/get_ref_info.R new file mode 100644 index 00000000..7d10695e --- /dev/null +++ b/R/get_ref_info.R @@ -0,0 +1,121 @@ +#' Obtain reference information for a global reference group. +#' +#' 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. +#' +#' @param ref_path (`character`) +#' Reference group specification as an `rtables` `colpath`; see Details. +#' @param .var (`character`) +#' The variable being analyzed; see [rtables::additional_fun_params]. +#' +#' @return +#' * `get_ref_info()` returns a list with: +#' * `ref_group`: the reference group data (a `data.frame` or vector depending +#' on `.var`), equivalent to `.ref_group` from [rtables::additional_fun_params]. +#' * `in_ref_col`: logical, whether the current column is the reference column, +#' equivalent to `.in_ref_col` from [rtables::additional_fun_params]. +#' * `trt_var`: the treatment variable name (last variable in `ref_path`). +#' * `ctrl_grp`: the reference group level (last level in `ref_path`). +#' * `cur_col_val`: the current column's value for `trt_var`. +#' +#' @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. +#' +#' @export +#' +#' @examples +#' dm <- 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" +#' ) +#' +#' # A standard analysis function which uses a reference group. +#' standard_afun <- function(x, .ref_group, .in_ref_col) { +#' diff_means <- if (isFALSE(.in_ref_col)) { +#' mean(x) - mean(.ref_group) +#' } else { +#' NULL +#' } +#' in_rows( +#' m = rcell(mean(x), label = "Mean"), +#' dm = rcell(diff_means, label = "Difference in Means vs Placebo"), +#' .formats = "xx.xx" +#' ) +#' } +#' +#' # The custom analysis function which can work with a global reference group. +#' result_afun <- function(x, ref_path, .spl_context, .var) { +#' ref <- get_ref_info(ref_path, .spl_context, .var) +#' standard_afun(x, .ref_group = ref$ref_group, .in_ref_col = ref$in_ref_col) +#' } +#' +#' ref_path <- c("colspan_trt", " ", "ARM", "B: Placebo") +#' +#' lyt <- basic_table() |> +#' split_cols_by("colspan_trt", split_fun = trim_levels_to_map(colspan_trt_map)) |> +#' split_cols_by("ARM") |> +#' add_overall_col("Total") |> +#' analyze("AGE", afun = result_afun, extra_args = list(ref_path = ref_path)) +#' +#' 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, trt_var = NULL, ctrl_grp = NULL, cur_col_val = NULL)) + } + + checkmate::assert_character(ref_path, min.len = 2L, names = "unnamed") + checkmate::assert_true(length(ref_path) %% 2 == 0) + checkmate::assert_data_frame(.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 = ".") + + trt_var <- ref_path[utils::tail(vars_indices, 1L)] + ctrl_grp <- ref_path[utils::tail(level_indices, 1L)] + + cur_colpath <- cur_col_split_path(.spl_context) + cur_col_vars <- cur_colpath[seq(from = 1L, to = length(cur_colpath), by = 2L)] + cur_col_vals <- cur_colpath[seq(from = 2L, to = length(cur_colpath), by = 2L)] + trt_var_pos <- match(trt_var, cur_col_vars) + cur_col_val <- if (!is.na(trt_var_pos)) cur_col_vals[trt_var_pos] else NULL + + # If ref_path variables are outside of the current column split variable. + ref_var_path <- ref_path + ref_var_path[level_indices] <- "*" + if (!in_column(ref_var_path, .spl_context)) { + return(list(ref_group = NULL, in_ref_col = NULL, trt_var = trt_var, ctrl_grp = ctrl_grp, cur_col_val = cur_col_val)) + } + + leaf_sc <- .spl_context[nrow(.spl_context), ] + 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, ] + if (!is.null(.var)) { + ref_group <- ref_group[[.var]] + } + + list( + ref_group = ref_group, + in_ref_col = in_column(ref_path, .spl_context), + trt_var = trt_var, + ctrl_grp = ctrl_grp, + cur_col_val = cur_col_val + ) +} From bba7576f90d2168159918303e2a2c4f5cc482d1f Mon Sep 17 00:00:00 2001 From: munoztd0 Date: Fri, 17 Jul 2026 14:38:33 +0200 Subject: [PATCH 03/38] fix: examples and redocument --- R/cur_col_split_path_utils.R | 2 +- man/cur_col_split_path_utils.Rd | 80 ++++++++++++++++++++++++ man/get_ref_info.Rd | 18 +++--- tests/testthat/test-cur_col_split_path.R | 12 ++++ 4 files changed, 101 insertions(+), 11 deletions(-) diff --git a/R/cur_col_split_path_utils.R b/R/cur_col_split_path_utils.R index 72a32e87..0b278051 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/man/cur_col_split_path_utils.Rd b/man/cur_col_split_path_utils.Rd index a5d609df..79520e79 100644 --- a/man/cur_col_split_path_utils.Rd +++ b/man/cur_col_split_path_utils.Rd @@ -4,11 +4,14 @@ \alias{cur_col_split_path_utils} \alias{cur_col_split_path} \alias{in_column} +\alias{get_ref_info} \title{Utilities for the Current Column Split Path} \usage{ cur_col_split_path(.spl_context) in_column(col_path, .spl_context) + +get_ref_info(ref_path, .spl_context, .var = NULL) } \arguments{ \item{.spl_context}{(\code{data.frame})\cr gives information about ancestor split states @@ -25,6 +28,12 @@ variable name or value. \code{NULL} can be used to indicate that no path is specified, in which case the function returns \code{FALSE}, regardless of \code{.spl_context}.} + +\item{ref_path}{(\code{character}) +Reference group specification as an \code{rtables} \code{colpath}; see Details.} + +\item{.var}{(\code{character}) +The variable being analyzed; see \link[rtables:additional_fun_params]{rtables::additional_fun_params}.} } \value{ \itemize{ @@ -37,6 +46,19 @@ column split path extracted from \code{.spl_context}, interleaved as \item \code{in_column()} returns a single logical value indicating whether the current column split matches the specified \code{col_path}. } + +\itemize{ +\item \code{get_ref_info()} returns a list with: +\itemize{ +\item \code{ref_group}: the reference group data (a \code{data.frame} or vector depending +on \code{.var}), equivalent to \code{.ref_group} from \link[rtables:additional_fun_params]{rtables::additional_fun_params}. +\item \code{in_ref_col}: logical, whether the current column is the reference column, +equivalent to \code{.in_ref_col} from \link[rtables:additional_fun_params]{rtables::additional_fun_params}. +\item \code{trt_var}: the treatment variable name (last variable in \code{ref_path}). +\item \code{ctrl_grp}: the reference group level (last level in \code{ref_path}). +\item \code{cur_col_val}: the current column's value for \code{trt_var}. +} +} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} @@ -44,12 +66,27 @@ current column split matches the specified \code{col_path}. These helper functions are intended for use in \link[rtables:rtables]{rtables} custom analysis functions that depend on the current column split context. } +\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. +} \section{Functions}{ \itemize{ \item \code{cur_col_split_path()}: Get the current column split path. \item \code{in_column()}: Determine whether a given column path matches the current column split path. +\item \code{get_ref_info()}: Obtain reference information for a global reference group. + +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. + }} \examples{ .spl_context_1 <- data.frame( @@ -106,6 +143,49 @@ lyt <- basic_table() |> tbl <- build_table(lyt, data) tbl +dm <- 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" +) + +# A standard analysis function which uses a reference group. +standard_afun <- function(x, .ref_group, .in_ref_col) { + diff_means <- if (isFALSE(.in_ref_col)) { + mean(x) - mean(.ref_group) + } else { + NULL + } + in_rows( + m = rcell(mean(x), label = "Mean"), + dm = rcell(diff_means, label = "Difference in Means vs Placebo"), + .formats = "xx.xx" + ) +} + +# The custom analysis function which can work with a global reference group. +result_afun <- function(x, ref_path, .spl_context, .var) { + ref <- get_ref_info(ref_path, .spl_context, .var) + standard_afun(x, .ref_group = ref$ref_group, .in_ref_col = ref$in_ref_col) +} + +ref_path <- c("colspan_trt", " ", "ARM", "B: Placebo") + +lyt <- basic_table() |> + split_cols_by("colspan_trt", split_fun = trim_levels_to_map(colspan_trt_map)) |> + split_cols_by("ARM") |> + add_overall_col("Total") |> + analyze("AGE", afun = result_afun, extra_args = list(ref_path = ref_path)) + +build_table(lyt, dm) } \seealso{ \itemize{ diff --git a/man/get_ref_info.Rd b/man/get_ref_info.Rd index 87a26d34..e42324a2 100644 --- a/man/get_ref_info.Rd +++ b/man/get_ref_info.Rd @@ -2,21 +2,20 @@ % 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 information for a global reference group.} \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}) +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{.var}{(\code{character})\cr the variable being analyzed, -see \link[rtables:additional_fun_params]{rtables::additional_fun_params}.} +\item{.var}{(\code{character}) +The variable being analyzed; see \link[rtables:additional_fun_params]{rtables::additional_fun_params}.} } \value{ -A list with: +\itemize{ +\item \code{get_ref_info()} returns a list with: \itemize{ \item \code{ref_group}: the reference group data (a \code{data.frame} or vector depending on \code{.var}), equivalent to \code{.ref_group} from \link[rtables:additional_fun_params]{rtables::additional_fun_params}. @@ -27,9 +26,8 @@ equivalent to \code{.in_ref_col} from \link[rtables:additional_fun_params]{rtabl \item \code{cur_col_val}: the current column's value for \code{trt_var}. } } +} \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. 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")), From 2ed9cd8f79e3bdd6d9c93423eb764453c1dead9f Mon Sep 17 00:00:00 2001 From: munoztd0 Date: Fri, 17 Jul 2026 14:57:17 +0200 Subject: [PATCH 04/38] fix: merge issues --- R/cur_col_split_path_utils.R | 122 -------------------------------- R/get_ref_info.R | 2 + man/cur_col_split_path_utils.Rd | 80 --------------------- man/get_ref_info.Rd | 3 + 4 files changed, 5 insertions(+), 202 deletions(-) diff --git a/R/cur_col_split_path_utils.R b/R/cur_col_split_path_utils.R index 0b278051..53760160 100644 --- a/R/cur_col_split_path_utils.R +++ b/R/cur_col_split_path_utils.R @@ -139,125 +139,3 @@ in_column <- function(col_path, .spl_context) { } } -#' @describeIn cur_col_split_path_utils -#' Obtain reference information for a global reference group. -#' -#' 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. -#' -#' @param ref_path (`character`) -#' Reference group specification as an `rtables` `colpath`; see Details. -#' @param .var (`character`) -#' The variable being analyzed; see [rtables::additional_fun_params]. -#' -#' @return -#' * `get_ref_info()` returns a list with: -#' * `ref_group`: the reference group data (a `data.frame` or vector depending -#' on `.var`), equivalent to `.ref_group` from [rtables::additional_fun_params]. -#' * `in_ref_col`: logical, whether the current column is the reference column, -#' equivalent to `.in_ref_col` from [rtables::additional_fun_params]. -#' * `trt_var`: the treatment variable name (last variable in `ref_path`). -#' * `ctrl_grp`: the reference group level (last level in `ref_path`). -#' * `cur_col_val`: the current column's value for `trt_var`. -#' -#' @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. -#' -#' @export -#' -#' @examples -#' dm <- 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" -#' ) -#' -#' # A standard analysis function which uses a reference group. -#' standard_afun <- function(x, .ref_group, .in_ref_col) { -#' diff_means <- if (isFALSE(.in_ref_col)) { -#' mean(x) - mean(.ref_group) -#' } else { -#' NULL -#' } -#' in_rows( -#' m = rcell(mean(x), label = "Mean"), -#' dm = rcell(diff_means, label = "Difference in Means vs Placebo"), -#' .formats = "xx.xx" -#' ) -#' } -#' -#' # The custom analysis function which can work with a global reference group. -#' result_afun <- function(x, ref_path, .spl_context, .var) { -#' ref <- get_ref_info(ref_path, .spl_context, .var) -#' standard_afun(x, .ref_group = ref$ref_group, .in_ref_col = ref$in_ref_col) -#' } -#' -#' ref_path <- c("colspan_trt", " ", "ARM", "B: Placebo") -#' -#' lyt <- basic_table() |> -#' split_cols_by("colspan_trt", split_fun = trim_levels_to_map(colspan_trt_map)) |> -#' split_cols_by("ARM") |> -#' add_overall_col("Total") |> -#' analyze("AGE", afun = result_afun, extra_args = list(ref_path = ref_path)) -#' -#' 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, trt_var = NULL, ctrl_grp = NULL, cur_col_val = NULL)) - } - - checkmate::assert_character(ref_path, min.len = 2L, names = "unnamed") - checkmate::assert_true(length(ref_path) %% 2 == 0) - checkmate::assert_data_frame(.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 = ".") - - trt_var <- ref_path[utils::tail(vars_indices, 1L)] - ctrl_grp <- ref_path[utils::tail(level_indices, 1L)] - - cur_colpath <- cur_col_split_path(.spl_context) - cur_col_vars <- cur_colpath[seq(from = 1L, to = length(cur_colpath), by = 2L)] - cur_col_vals <- cur_colpath[seq(from = 2L, to = length(cur_colpath), by = 2L)] - trt_var_pos <- match(trt_var, cur_col_vars) - cur_col_val <- if (!is.na(trt_var_pos)) cur_col_vals[trt_var_pos] else NULL - - # If ref_path variables are outside of the current column split variable. - ref_var_path <- ref_path - ref_var_path[level_indices] <- "*" - if (!in_column(ref_var_path, .spl_context)) { - return(list(ref_group = NULL, in_ref_col = NULL, trt_var = trt_var, ctrl_grp = ctrl_grp, cur_col_val = cur_col_val)) - } - - leaf_sc <- .spl_context[nrow(.spl_context), ] - 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, ] - if (!is.null(.var)) { - ref_group <- ref_group[[.var]] - } - - list( - ref_group = ref_group, - in_ref_col = in_column(ref_path, .spl_context), - trt_var = trt_var, - ctrl_grp = ctrl_grp, - cur_col_val = cur_col_val - ) -} diff --git a/R/get_ref_info.R b/R/get_ref_info.R index 7d10695e..18755263 100644 --- a/R/get_ref_info.R +++ b/R/get_ref_info.R @@ -6,6 +6,8 @@ #' #' @param ref_path (`character`) #' Reference group specification as an `rtables` `colpath`; see Details. +#' @param .spl_context (`data.frame`) +#' Ancestor split-state information passed by `rtables`. #' @param .var (`character`) #' The variable being analyzed; see [rtables::additional_fun_params]. #' diff --git a/man/cur_col_split_path_utils.Rd b/man/cur_col_split_path_utils.Rd index 79520e79..a5d609df 100644 --- a/man/cur_col_split_path_utils.Rd +++ b/man/cur_col_split_path_utils.Rd @@ -4,14 +4,11 @@ \alias{cur_col_split_path_utils} \alias{cur_col_split_path} \alias{in_column} -\alias{get_ref_info} \title{Utilities for the Current Column Split Path} \usage{ cur_col_split_path(.spl_context) in_column(col_path, .spl_context) - -get_ref_info(ref_path, .spl_context, .var = NULL) } \arguments{ \item{.spl_context}{(\code{data.frame})\cr gives information about ancestor split states @@ -28,12 +25,6 @@ variable name or value. \code{NULL} can be used to indicate that no path is specified, in which case the function returns \code{FALSE}, regardless of \code{.spl_context}.} - -\item{ref_path}{(\code{character}) -Reference group specification as an \code{rtables} \code{colpath}; see Details.} - -\item{.var}{(\code{character}) -The variable being analyzed; see \link[rtables:additional_fun_params]{rtables::additional_fun_params}.} } \value{ \itemize{ @@ -46,19 +37,6 @@ column split path extracted from \code{.spl_context}, interleaved as \item \code{in_column()} returns a single logical value indicating whether the current column split matches the specified \code{col_path}. } - -\itemize{ -\item \code{get_ref_info()} returns a list with: -\itemize{ -\item \code{ref_group}: the reference group data (a \code{data.frame} or vector depending -on \code{.var}), equivalent to \code{.ref_group} from \link[rtables:additional_fun_params]{rtables::additional_fun_params}. -\item \code{in_ref_col}: logical, whether the current column is the reference column, -equivalent to \code{.in_ref_col} from \link[rtables:additional_fun_params]{rtables::additional_fun_params}. -\item \code{trt_var}: the treatment variable name (last variable in \code{ref_path}). -\item \code{ctrl_grp}: the reference group level (last level in \code{ref_path}). -\item \code{cur_col_val}: the current column's value for \code{trt_var}. -} -} } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} @@ -66,27 +44,12 @@ equivalent to \code{.in_ref_col} from \link[rtables:additional_fun_params]{rtabl These helper functions are intended for use in \link[rtables:rtables]{rtables} custom analysis functions that depend on the current column split context. } -\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. -} \section{Functions}{ \itemize{ \item \code{cur_col_split_path()}: Get the current column split path. \item \code{in_column()}: Determine whether a given column path matches the current column split path. -\item \code{get_ref_info()}: Obtain reference information for a global reference group. - -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. - }} \examples{ .spl_context_1 <- data.frame( @@ -143,49 +106,6 @@ lyt <- basic_table() |> tbl <- build_table(lyt, data) tbl -dm <- 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" -) - -# A standard analysis function which uses a reference group. -standard_afun <- function(x, .ref_group, .in_ref_col) { - diff_means <- if (isFALSE(.in_ref_col)) { - mean(x) - mean(.ref_group) - } else { - NULL - } - in_rows( - m = rcell(mean(x), label = "Mean"), - dm = rcell(diff_means, label = "Difference in Means vs Placebo"), - .formats = "xx.xx" - ) -} - -# The custom analysis function which can work with a global reference group. -result_afun <- function(x, ref_path, .spl_context, .var) { - ref <- get_ref_info(ref_path, .spl_context, .var) - standard_afun(x, .ref_group = ref$ref_group, .in_ref_col = ref$in_ref_col) -} - -ref_path <- c("colspan_trt", " ", "ARM", "B: Placebo") - -lyt <- basic_table() |> - split_cols_by("colspan_trt", split_fun = trim_levels_to_map(colspan_trt_map)) |> - split_cols_by("ARM") |> - add_overall_col("Total") |> - analyze("AGE", afun = result_afun, extra_args = list(ref_path = ref_path)) - -build_table(lyt, dm) } \seealso{ \itemize{ diff --git a/man/get_ref_info.Rd b/man/get_ref_info.Rd index e42324a2..c62e9756 100644 --- a/man/get_ref_info.Rd +++ b/man/get_ref_info.Rd @@ -10,6 +10,9 @@ get_ref_info(ref_path, .spl_context, .var = NULL) \item{ref_path}{(\code{character}) Reference group specification as an \code{rtables} \code{colpath}; see Details.} +\item{.spl_context}{(\code{data.frame}) +Ancestor split-state information passed by \code{rtables}.} + \item{.var}{(\code{character}) The variable being analyzed; see \link[rtables:additional_fun_params]{rtables::additional_fun_params}.} } From 9f32e7ce5297e63099754f1d6f733c14780bce96 Mon Sep 17 00:00:00 2001 From: Wojtek Date: Fri, 17 Jul 2026 19:40:29 +0200 Subject: [PATCH 05/38] get_ref_info() update - refectored body proposal. --- R/get_ref_info.R | 55 +++++++++++++++++------------- tests/testthat/test-get_ref_info.R | 2 +- 2 files changed, 33 insertions(+), 24 deletions(-) diff --git a/R/get_ref_info.R b/R/get_ref_info.R index 18755263..f2a4d005 100644 --- a/R/get_ref_info.R +++ b/R/get_ref_info.R @@ -78,36 +78,45 @@ #' 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, trt_var = NULL, ctrl_grp = NULL, cur_col_val = NULL)) + return( + list(ref_group = NULL, in_ref_col = NULL, trt_var = NULL, ctrl_grp = NULL, cur_col_val = 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) - 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 = ".") - - trt_var <- ref_path[utils::tail(vars_indices, 1L)] - ctrl_grp <- ref_path[utils::tail(level_indices, 1L)] - - cur_colpath <- cur_col_split_path(.spl_context) - cur_col_vars <- cur_colpath[seq(from = 1L, to = length(cur_colpath), by = 2L)] - cur_col_vals <- cur_colpath[seq(from = 2L, to = length(cur_colpath), by = 2L)] - trt_var_pos <- match(trt_var, cur_col_vars) - cur_col_val <- if (!is.na(trt_var_pos)) cur_col_vals[trt_var_pos] else NULL + cur_col_path <- cur_col_split_path(.spl_context) + cur_col_vars <- cur_col_path[seq(1L, length(cur_col_path), by = 2L)] + ref_path_last <- utils::tail(ref_path, 2L) + last_var_pos <- match(ref_path_last[1L], cur_col_vars) + cur_col_last_val <- if (!is.na(last_var_pos)) { + cur_col_path[2L * last_var_pos] + } else { + NULL + } # If ref_path variables are outside of the current column split variable. - ref_var_path <- ref_path - ref_var_path[level_indices] <- "*" - if (!in_column(ref_var_path, .spl_context)) { - return(list(ref_group = NULL, in_ref_col = NULL, trt_var = trt_var, ctrl_grp = ctrl_grp, cur_col_val = cur_col_val)) + ref_path_val_pos <- seq(2L, length(ref_path), by = 2L) + ref_path_any_vals <- ref_path + ref_path_any_vals[ref_path_val_pos] <- "*" + if (!in_column(ref_path_any_vals, .spl_context)) { + return( + list( + ref_group = NULL, + in_ref_col = NULL, + trt_var = ref_path_last[1L], + ctrl_grp = ref_path_last[2L], + cur_col_val = cur_col_last_val + ) + ) } leaf_sc <- .spl_context[nrow(.spl_context), ] - full_df <- leaf_sc$full_parent_df[[1]] - row_in_ref_group <- leaf_sc[[ref_path_levels]][[1]] + full_df <- leaf_sc$full_parent_df[[1L]] + ref_path_levels <- paste(ref_path[ref_path_val_pos], collapse = ".") + row_in_ref_group <- leaf_sc[[ref_path_levels]][[1L]] ref_group <- full_df[row_in_ref_group, ] if (!is.null(.var)) { ref_group <- ref_group[[.var]] @@ -116,8 +125,8 @@ get_ref_info <- function(ref_path, .spl_context, .var = NULL) { list( ref_group = ref_group, in_ref_col = in_column(ref_path, .spl_context), - trt_var = trt_var, - ctrl_grp = ctrl_grp, - cur_col_val = cur_col_val + trt_var = ref_path_last[1L], + ctrl_grp = ref_path_last[2L], + cur_col_val = cur_col_last_val ) } diff --git a/tests/testthat/test-get_ref_info.R b/tests/testthat/test-get_ref_info.R index 5b61b27c..c544988d 100644 --- a/tests/testthat/test-get_ref_info.R +++ b/tests/testthat/test-get_ref_info.R @@ -349,7 +349,7 @@ test_that("h_get_trtvar_refpath returns the expected shape and values in a risk- expect_identical(res$trt_var, "ARM") expect_identical(res$ctrl_grp, "B: Placebo") expect_identical(res$trt_var_refspec, "ARM") # trt_var_refspec == trt_var by definition - expect_false(is.null(res$cur_trt_grp)) # cur_trt_grp is the active arm value + expect_false(is.null(res$cur_trt_grp)) # cur_trt_grp is the active arm value } }) From 35098b8f1bbb6cf0e276c0005b03f74f30a22d7a Mon Sep 17 00:00:00 2001 From: Wojtek Date: Fri, 17 Jul 2026 19:42:41 +0200 Subject: [PATCH 06/38] lintr update for cur_col_split_path_utils. --- R/cur_col_split_path_utils.R | 1 - 1 file changed, 1 deletion(-) diff --git a/R/cur_col_split_path_utils.R b/R/cur_col_split_path_utils.R index 53760160..00529d55 100644 --- a/R/cur_col_split_path_utils.R +++ b/R/cur_col_split_path_utils.R @@ -138,4 +138,3 @@ in_column <- function(col_path, .spl_context) { FALSE } } - From 25d050101244c5f2a315efd00ea5cc7b8f43f332 Mon Sep 17 00:00:00 2001 From: munoztd0 Date: Fri, 14 Aug 2026 15:24:16 +0200 Subject: [PATCH 07/38] refactor: trt_var / ctrl_grp -> split_var / ref_level --- NEWS.md | 2 +- R/a_summarize_aval_chg_diff.R | 6 +++--- R/get_ref_info.R | 16 ++++++++-------- R/h_freq_funs.R | 2 +- man/get_ref_info.Rd | 6 +++--- man/h_get_trtvar_refpath.Rd | 2 +- tests/testthat/test-get_ref_info.R | 14 +++++++------- 7 files changed, 24 insertions(+), 24 deletions(-) diff --git a/NEWS.md b/NEWS.md index 79b62545..b76a5bad 100644 --- a/NEWS.md +++ b/NEWS.md @@ -38,7 +38,7 @@ - Update new exported calls from rtables.officer - update documentation to `roxygen2` 8.0.0 - Add extra statistics to `a_eair100_j` and introduce scaling factor `num_p_year` (default = 100) (#361) -- Unified `get_ref_info()` which now also returns `trt_var`, `ctrl_grp`, and `cur_col_val` (#295) +- Unified `get_ref_info()` which now also returns `split_var`, `ref_level`, and `cur_col_val` (#295) - `h_get_trtvar_refpath()` is marked as superseded - `a_summarize_aval_chg_diff_j()` now uses `get_ref_info()` diff --git a/R/a_summarize_aval_chg_diff.R b/R/a_summarize_aval_chg_diff.R index 96ad3108..b6ad3fb7 100644 --- a/R/a_summarize_aval_chg_diff.R +++ b/R/a_summarize_aval_chg_diff.R @@ -477,9 +477,9 @@ a_summarize_aval_chg_diff_j <- function( ctrl_grp <- NULL if (comp_btw_group) { ref <- get_ref_info(ref_path, .spl_context) - trt_var_refspec <- ref$trt_var - checkmate::assert_true(identical(trt_var, trt_var_refspec)) - ctrl_grp <- ref$ctrl_grp + split_var_refspec <- ref$split_var + checkmate::assert_true(identical(trt_var, split_var_refspec)) + ctrl_grp <- ref$ref_level ### check that ctrl_grp is a level of the treatment variable, in case riskdiff is requested if (!ctrl_grp %in% levels(df[[trt_var]])) { diff --git a/R/get_ref_info.R b/R/get_ref_info.R index f2a4d005..c58eafa2 100644 --- a/R/get_ref_info.R +++ b/R/get_ref_info.R @@ -17,9 +17,9 @@ #' on `.var`), equivalent to `.ref_group` from [rtables::additional_fun_params]. #' * `in_ref_col`: logical, whether the current column is the reference column, #' equivalent to `.in_ref_col` from [rtables::additional_fun_params]. -#' * `trt_var`: the treatment variable name (last variable in `ref_path`). -#' * `ctrl_grp`: the reference group level (last level in `ref_path`). -#' * `cur_col_val`: the current column's value for `trt_var`. +#' * `split_var`: the split variable name (last variable in `ref_path`). +#' * `ref_level`: the reference level (last level in `ref_path`). +#' * `cur_col_val`: the current column's value for `split_var`. #' #' @details #' The reference group is specified in `colpath` hierarchical fashion in @@ -79,7 +79,7 @@ get_ref_info <- function(ref_path, .spl_context, .var = NULL) { if (is.null(ref_path)) { return( - list(ref_group = NULL, in_ref_col = NULL, trt_var = NULL, ctrl_grp = NULL, cur_col_val = NULL) + list(ref_group = NULL, in_ref_col = NULL, split_var = NULL, ref_level = NULL, cur_col_val = NULL) ) } @@ -106,8 +106,8 @@ get_ref_info <- function(ref_path, .spl_context, .var = NULL) { list( ref_group = NULL, in_ref_col = NULL, - trt_var = ref_path_last[1L], - ctrl_grp = ref_path_last[2L], + split_var = ref_path_last[1L], + ref_level = ref_path_last[2L], cur_col_val = cur_col_last_val ) ) @@ -125,8 +125,8 @@ get_ref_info <- function(ref_path, .spl_context, .var = NULL) { list( ref_group = ref_group, in_ref_col = in_column(ref_path, .spl_context), - trt_var = ref_path_last[1L], - ctrl_grp = ref_path_last[2L], + split_var = ref_path_last[1L], + ref_level = ref_path_last[2L], cur_col_val = cur_col_last_val ) } diff --git a/R/h_freq_funs.R b/R/h_freq_funs.R index b3af0995..ccdbcc1d 100644 --- a/R/h_freq_funs.R +++ b/R/h_freq_funs.R @@ -287,7 +287,7 @@ h_df_add_newlevels <- function(df, .var, new_levels, addstr2levs = NULL, new_lev #' @description `r lifecycle::badge("superseded")` #' #' Retrieves the treatment variable reference path from the provided context. -#' Prefer [get_ref_info()] which now returns `trt_var`, `ctrl_grp`, and +#' Prefer [get_ref_info()] which now returns `split_var`, `ref_level`, and #' `cur_col_val` in addition to `ref_group` and `in_ref_col`. #' #' @param ref_path (`character`)\cr Reference path for treatment variable. diff --git a/man/get_ref_info.Rd b/man/get_ref_info.Rd index c62e9756..a09f1ddb 100644 --- a/man/get_ref_info.Rd +++ b/man/get_ref_info.Rd @@ -24,9 +24,9 @@ The variable being analyzed; see \link[rtables:additional_fun_params]{rtables::a on \code{.var}), equivalent to \code{.ref_group} from \link[rtables:additional_fun_params]{rtables::additional_fun_params}. \item \code{in_ref_col}: logical, whether the current column is the reference column, equivalent to \code{.in_ref_col} from \link[rtables:additional_fun_params]{rtables::additional_fun_params}. -\item \code{trt_var}: the treatment variable name (last variable in \code{ref_path}). -\item \code{ctrl_grp}: the reference group level (last level in \code{ref_path}). -\item \code{cur_col_val}: the current column's value for \code{trt_var}. +\item \code{split_var}: the split variable name (last variable in \code{ref_path}). +\item \code{ref_level}: the reference level (last level in \code{ref_path}). +\item \code{cur_col_val}: the current column's value for \code{split_var}. } } } diff --git a/man/h_get_trtvar_refpath.Rd b/man/h_get_trtvar_refpath.Rd index d961eb36..a8ca9de9 100644 --- a/man/h_get_trtvar_refpath.Rd +++ b/man/h_get_trtvar_refpath.Rd @@ -20,6 +20,6 @@ List containing treatment variable details. \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#superseded}{\figure{lifecycle-superseded.svg}{options: alt='[Superseded]'}}}{\strong{[Superseded]}} Retrieves the treatment variable reference path from the provided context. -Prefer \code{\link[=get_ref_info]{get_ref_info()}} which now returns \code{trt_var}, \code{ctrl_grp}, and +Prefer \code{\link[=get_ref_info]{get_ref_info()}} which now returns \code{split_var}, \code{ref_level}, and \code{cur_col_val} in addition to \code{ref_group} and \code{in_ref_col}. } diff --git a/tests/testthat/test-get_ref_info.R b/tests/testthat/test-get_ref_info.R index c544988d..b2f0e372 100644 --- a/tests/testthat/test-get_ref_info.R +++ b/tests/testthat/test-get_ref_info.R @@ -204,12 +204,12 @@ 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, trt_var = NULL, ctrl_grp = NULL, cur_col_val = NULL) + exp <- list(ref_group = NULL, in_ref_col = NULL, split_var = NULL, ref_level = NULL, cur_col_val = NULL) expect_identical(res, exp) }) -test_that("get_ref_info returns trt_var, ctrl_grp, cur_col_val in the matched-colvars case", { +test_that("get_ref_info returns split_var, ref_level, cur_col_val in the matched-colvars case", { dm <- formatters::DM dm$colspan_trt <- factor( ifelse(dm$ARM == "B: Placebo", " ", "Active Study Agent"), @@ -240,8 +240,8 @@ test_that("get_ref_info returns trt_var, ctrl_grp, cur_col_val in the matched-co build_table(lyt, dm) for (res in captured) { - expect_identical(res$trt_var, "ARM") - expect_identical(res$ctrl_grp, "B: Placebo") + expect_identical(res$split_var, "ARM") + expect_identical(res$ref_level, "B: Placebo") } ref_col <- Filter(function(r) isTRUE(r$in_ref_col), captured) @@ -255,7 +255,7 @@ test_that("get_ref_info returns trt_var, ctrl_grp, cur_col_val in the matched-co } }) -test_that("get_ref_info returns trt_var and ctrl_grp even when ref_path is outside colvars (risk-diff column)", { +test_that("get_ref_info returns split_var and ref_level even when ref_path is outside colvars (risk-diff column)", { dm <- formatters::DM dm$colspan_trt <- factor( ifelse(dm$ARM == "B: Placebo", " ", "Active Study Agent"), @@ -296,8 +296,8 @@ test_that("get_ref_info returns trt_var and ctrl_grp even when ref_path is outsi outside_cols <- Filter(function(r) is.null(r$ref_group) && is.null(r$in_ref_col), captured) expect_true(length(outside_cols) >= 1L) for (res in outside_cols) { - expect_identical(res$trt_var, "ARM") - expect_identical(res$ctrl_grp, "B: Placebo") + expect_identical(res$split_var, "ARM") + expect_identical(res$ref_level, "B: Placebo") expect_false(is.null(res$cur_col_val)) } }) From aef5bc2abc499097df69782f44df8a59b5f4d30d Mon Sep 17 00:00:00 2001 From: munoztd0 Date: Fri, 14 Aug 2026 15:24:16 +0200 Subject: [PATCH 08/38] test: make get_ref_info tests more specific to the exact length --- NEWS.md | 2 +- R/a_summarize_aval_chg_diff.R | 6 +++--- R/get_ref_info.R | 16 ++++++++-------- R/h_freq_funs.R | 2 +- man/get_ref_info.Rd | 6 +++--- man/h_get_trtvar_refpath.Rd | 2 +- tests/testthat/test-get_ref_info.R | 28 ++++++++++++++++------------ 7 files changed, 33 insertions(+), 29 deletions(-) diff --git a/NEWS.md b/NEWS.md index 79b62545..b76a5bad 100644 --- a/NEWS.md +++ b/NEWS.md @@ -38,7 +38,7 @@ - Update new exported calls from rtables.officer - update documentation to `roxygen2` 8.0.0 - Add extra statistics to `a_eair100_j` and introduce scaling factor `num_p_year` (default = 100) (#361) -- Unified `get_ref_info()` which now also returns `trt_var`, `ctrl_grp`, and `cur_col_val` (#295) +- Unified `get_ref_info()` which now also returns `split_var`, `ref_level`, and `cur_col_val` (#295) - `h_get_trtvar_refpath()` is marked as superseded - `a_summarize_aval_chg_diff_j()` now uses `get_ref_info()` diff --git a/R/a_summarize_aval_chg_diff.R b/R/a_summarize_aval_chg_diff.R index 96ad3108..b6ad3fb7 100644 --- a/R/a_summarize_aval_chg_diff.R +++ b/R/a_summarize_aval_chg_diff.R @@ -477,9 +477,9 @@ a_summarize_aval_chg_diff_j <- function( ctrl_grp <- NULL if (comp_btw_group) { ref <- get_ref_info(ref_path, .spl_context) - trt_var_refspec <- ref$trt_var - checkmate::assert_true(identical(trt_var, trt_var_refspec)) - ctrl_grp <- ref$ctrl_grp + split_var_refspec <- ref$split_var + checkmate::assert_true(identical(trt_var, split_var_refspec)) + ctrl_grp <- ref$ref_level ### check that ctrl_grp is a level of the treatment variable, in case riskdiff is requested if (!ctrl_grp %in% levels(df[[trt_var]])) { diff --git a/R/get_ref_info.R b/R/get_ref_info.R index f2a4d005..c58eafa2 100644 --- a/R/get_ref_info.R +++ b/R/get_ref_info.R @@ -17,9 +17,9 @@ #' on `.var`), equivalent to `.ref_group` from [rtables::additional_fun_params]. #' * `in_ref_col`: logical, whether the current column is the reference column, #' equivalent to `.in_ref_col` from [rtables::additional_fun_params]. -#' * `trt_var`: the treatment variable name (last variable in `ref_path`). -#' * `ctrl_grp`: the reference group level (last level in `ref_path`). -#' * `cur_col_val`: the current column's value for `trt_var`. +#' * `split_var`: the split variable name (last variable in `ref_path`). +#' * `ref_level`: the reference level (last level in `ref_path`). +#' * `cur_col_val`: the current column's value for `split_var`. #' #' @details #' The reference group is specified in `colpath` hierarchical fashion in @@ -79,7 +79,7 @@ get_ref_info <- function(ref_path, .spl_context, .var = NULL) { if (is.null(ref_path)) { return( - list(ref_group = NULL, in_ref_col = NULL, trt_var = NULL, ctrl_grp = NULL, cur_col_val = NULL) + list(ref_group = NULL, in_ref_col = NULL, split_var = NULL, ref_level = NULL, cur_col_val = NULL) ) } @@ -106,8 +106,8 @@ get_ref_info <- function(ref_path, .spl_context, .var = NULL) { list( ref_group = NULL, in_ref_col = NULL, - trt_var = ref_path_last[1L], - ctrl_grp = ref_path_last[2L], + split_var = ref_path_last[1L], + ref_level = ref_path_last[2L], cur_col_val = cur_col_last_val ) ) @@ -125,8 +125,8 @@ get_ref_info <- function(ref_path, .spl_context, .var = NULL) { list( ref_group = ref_group, in_ref_col = in_column(ref_path, .spl_context), - trt_var = ref_path_last[1L], - ctrl_grp = ref_path_last[2L], + split_var = ref_path_last[1L], + ref_level = ref_path_last[2L], cur_col_val = cur_col_last_val ) } diff --git a/R/h_freq_funs.R b/R/h_freq_funs.R index b3af0995..ccdbcc1d 100644 --- a/R/h_freq_funs.R +++ b/R/h_freq_funs.R @@ -287,7 +287,7 @@ h_df_add_newlevels <- function(df, .var, new_levels, addstr2levs = NULL, new_lev #' @description `r lifecycle::badge("superseded")` #' #' Retrieves the treatment variable reference path from the provided context. -#' Prefer [get_ref_info()] which now returns `trt_var`, `ctrl_grp`, and +#' Prefer [get_ref_info()] which now returns `split_var`, `ref_level`, and #' `cur_col_val` in addition to `ref_group` and `in_ref_col`. #' #' @param ref_path (`character`)\cr Reference path for treatment variable. diff --git a/man/get_ref_info.Rd b/man/get_ref_info.Rd index c62e9756..a09f1ddb 100644 --- a/man/get_ref_info.Rd +++ b/man/get_ref_info.Rd @@ -24,9 +24,9 @@ The variable being analyzed; see \link[rtables:additional_fun_params]{rtables::a on \code{.var}), equivalent to \code{.ref_group} from \link[rtables:additional_fun_params]{rtables::additional_fun_params}. \item \code{in_ref_col}: logical, whether the current column is the reference column, equivalent to \code{.in_ref_col} from \link[rtables:additional_fun_params]{rtables::additional_fun_params}. -\item \code{trt_var}: the treatment variable name (last variable in \code{ref_path}). -\item \code{ctrl_grp}: the reference group level (last level in \code{ref_path}). -\item \code{cur_col_val}: the current column's value for \code{trt_var}. +\item \code{split_var}: the split variable name (last variable in \code{ref_path}). +\item \code{ref_level}: the reference level (last level in \code{ref_path}). +\item \code{cur_col_val}: the current column's value for \code{split_var}. } } } diff --git a/man/h_get_trtvar_refpath.Rd b/man/h_get_trtvar_refpath.Rd index d961eb36..a8ca9de9 100644 --- a/man/h_get_trtvar_refpath.Rd +++ b/man/h_get_trtvar_refpath.Rd @@ -20,6 +20,6 @@ List containing treatment variable details. \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#superseded}{\figure{lifecycle-superseded.svg}{options: alt='[Superseded]'}}}{\strong{[Superseded]}} Retrieves the treatment variable reference path from the provided context. -Prefer \code{\link[=get_ref_info]{get_ref_info()}} which now returns \code{trt_var}, \code{ctrl_grp}, and +Prefer \code{\link[=get_ref_info]{get_ref_info()}} which now returns \code{split_var}, \code{ref_level}, and \code{cur_col_val} in addition to \code{ref_group} and \code{in_ref_col}. } diff --git a/tests/testthat/test-get_ref_info.R b/tests/testthat/test-get_ref_info.R index c544988d..cb78cb5d 100644 --- a/tests/testthat/test-get_ref_info.R +++ b/tests/testthat/test-get_ref_info.R @@ -204,12 +204,12 @@ 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, trt_var = NULL, ctrl_grp = NULL, cur_col_val = NULL) + exp <- list(ref_group = NULL, in_ref_col = NULL, split_var = NULL, ref_level = NULL, cur_col_val = NULL) expect_identical(res, exp) }) -test_that("get_ref_info returns trt_var, ctrl_grp, cur_col_val in the matched-colvars case", { +test_that("get_ref_info returns split_var, ref_level, cur_col_val in the matched-colvars case", { dm <- formatters::DM dm$colspan_trt <- factor( ifelse(dm$ARM == "B: Placebo", " ", "Active Study Agent"), @@ -240,8 +240,8 @@ test_that("get_ref_info returns trt_var, ctrl_grp, cur_col_val in the matched-co build_table(lyt, dm) for (res in captured) { - expect_identical(res$trt_var, "ARM") - expect_identical(res$ctrl_grp, "B: Placebo") + expect_identical(res$split_var, "ARM") + expect_identical(res$ref_level, "B: Placebo") } ref_col <- Filter(function(r) isTRUE(r$in_ref_col), captured) @@ -255,7 +255,7 @@ test_that("get_ref_info returns trt_var, ctrl_grp, cur_col_val in the matched-co } }) -test_that("get_ref_info returns trt_var and ctrl_grp even when ref_path is outside colvars (risk-diff column)", { +test_that("get_ref_info returns split_var and ref_level even when ref_path is outside colvars (risk-diff column)", { dm <- formatters::DM dm$colspan_trt <- factor( ifelse(dm$ARM == "B: Placebo", " ", "Active Study Agent"), @@ -277,7 +277,10 @@ test_that("get_ref_info returns trt_var and ctrl_grp even when ref_path is outsi captured <- list() spy_afun <- function(df, ref_path, .spl_context) { - captured[[length(captured) + 1L]] <<- get_ref_info(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")) } @@ -293,11 +296,12 @@ test_that("get_ref_info returns trt_var and ctrl_grp even when ref_path is outsi build_table(lyt, dm) - outside_cols <- Filter(function(r) is.null(r$ref_group) && is.null(r$in_ref_col), captured) - expect_true(length(outside_cols) >= 1L) - for (res in outside_cols) { - expect_identical(res$trt_var, "ARM") - expect_identical(res$ctrl_grp, "B: Placebo") + expect_length(captured, 2L) + for (res in captured) { + expect_null(res$ref_group) + expect_null(res$in_ref_col) + expect_identical(res$split_var, "ARM") + expect_identical(res$ref_level, "B: Placebo") expect_false(is.null(res$cur_col_val)) } }) @@ -344,7 +348,7 @@ test_that("h_get_trtvar_refpath returns the expected shape and values in a risk- build_table(lyt, dm) - expect_true(length(captured) >= 1L) + expect_length(captured, 2L) for (res in captured) { expect_identical(res$trt_var, "ARM") expect_identical(res$ctrl_grp, "B: Placebo") From 8693deb1085c4a4bc389ab5adb0577a10d457510 Mon Sep 17 00:00:00 2001 From: munoztd0 Date: Fri, 14 Aug 2026 16:13:01 +0200 Subject: [PATCH 09/38] refactor: rename test --- tests/testthat/test-get_ref_info.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-get_ref_info.R b/tests/testthat/test-get_ref_info.R index cb78cb5d..d11d793b 100644 --- a/tests/testthat/test-get_ref_info.R +++ b/tests/testthat/test-get_ref_info.R @@ -209,7 +209,7 @@ test_that("get_ref_info returns NULL values when ref_path is NULL", { expect_identical(res, exp) }) -test_that("get_ref_info returns split_var, ref_level, cur_col_val in the matched-colvars case", { +test_that("get_ref_info returns split_var, ref_level, cur_col_val for matching column splits", { dm <- formatters::DM dm$colspan_trt <- factor( ifelse(dm$ARM == "B: Placebo", " ", "Active Study Agent"), From 19515d3b6e256547ae14e70d5dbd48f66b41efba Mon Sep 17 00:00:00 2001 From: munoztd0 Date: Fri, 14 Aug 2026 16:17:48 +0200 Subject: [PATCH 10/38] rename split_var split_name instead to reflect the changes --- NEWS.md | 2 +- R/a_summarize_aval_chg_diff.R | 4 ++-- R/get_ref_info.R | 10 +++++----- R/h_freq_funs.R | 2 +- man/get_ref_info.Rd | 4 ++-- man/h_get_trtvar_refpath.Rd | 2 +- tests/testthat/test-get_ref_info.R | 10 +++++----- 7 files changed, 17 insertions(+), 17 deletions(-) diff --git a/NEWS.md b/NEWS.md index b1c5de20..e023acfd 100644 --- a/NEWS.md +++ b/NEWS.md @@ -40,7 +40,7 @@ - Update new exported calls from rtables.officer - update documentation to `roxygen2` 8.0.0 - Add extra statistics to `a_eair100_j` and introduce scaling factor `num_p_year` (default = 100) (#361) -- Unified `get_ref_info()` which now also returns `split_var`, `ref_level`, and `cur_col_val` (#295) +- Unified `get_ref_info()` which now also returns `split_name`, `ref_level`, and `cur_col_val` (#295) - `h_get_trtvar_refpath()` is marked as superseded - `a_summarize_aval_chg_diff_j()` now uses `get_ref_info()` diff --git a/R/a_summarize_aval_chg_diff.R b/R/a_summarize_aval_chg_diff.R index b6ad3fb7..3b7cb3ce 100644 --- a/R/a_summarize_aval_chg_diff.R +++ b/R/a_summarize_aval_chg_diff.R @@ -477,8 +477,8 @@ a_summarize_aval_chg_diff_j <- function( ctrl_grp <- NULL if (comp_btw_group) { ref <- get_ref_info(ref_path, .spl_context) - split_var_refspec <- ref$split_var - checkmate::assert_true(identical(trt_var, split_var_refspec)) + split_name_refspec <- ref$split_name + checkmate::assert_true(identical(trt_var, split_name_refspec)) ctrl_grp <- ref$ref_level ### check that ctrl_grp is a level of the treatment variable, in case riskdiff is requested diff --git a/R/get_ref_info.R b/R/get_ref_info.R index c58eafa2..912679fd 100644 --- a/R/get_ref_info.R +++ b/R/get_ref_info.R @@ -17,9 +17,9 @@ #' on `.var`), equivalent to `.ref_group` from [rtables::additional_fun_params]. #' * `in_ref_col`: logical, whether the current column is the reference column, #' equivalent to `.in_ref_col` from [rtables::additional_fun_params]. -#' * `split_var`: the split variable name (last variable in `ref_path`). +#' * `split_name`: the most recent split name (last split in `ref_path`). #' * `ref_level`: the reference level (last level in `ref_path`). -#' * `cur_col_val`: the current column's value for `split_var`. +#' * `cur_col_val`: the current column's value for `split_name`. #' #' @details #' The reference group is specified in `colpath` hierarchical fashion in @@ -79,7 +79,7 @@ get_ref_info <- function(ref_path, .spl_context, .var = NULL) { if (is.null(ref_path)) { return( - list(ref_group = NULL, in_ref_col = NULL, split_var = NULL, ref_level = NULL, cur_col_val = NULL) + list(ref_group = NULL, in_ref_col = NULL, split_name = NULL, ref_level = NULL, cur_col_val = NULL) ) } @@ -106,7 +106,7 @@ get_ref_info <- function(ref_path, .spl_context, .var = NULL) { list( ref_group = NULL, in_ref_col = NULL, - split_var = ref_path_last[1L], + split_name = ref_path_last[1L], ref_level = ref_path_last[2L], cur_col_val = cur_col_last_val ) @@ -125,7 +125,7 @@ get_ref_info <- function(ref_path, .spl_context, .var = NULL) { list( ref_group = ref_group, in_ref_col = in_column(ref_path, .spl_context), - split_var = ref_path_last[1L], + split_name = ref_path_last[1L], ref_level = ref_path_last[2L], cur_col_val = cur_col_last_val ) diff --git a/R/h_freq_funs.R b/R/h_freq_funs.R index ccdbcc1d..71f78f87 100644 --- a/R/h_freq_funs.R +++ b/R/h_freq_funs.R @@ -287,7 +287,7 @@ h_df_add_newlevels <- function(df, .var, new_levels, addstr2levs = NULL, new_lev #' @description `r lifecycle::badge("superseded")` #' #' Retrieves the treatment variable reference path from the provided context. -#' Prefer [get_ref_info()] which now returns `split_var`, `ref_level`, and +#' Prefer [get_ref_info()] which now returns `split_name`, `ref_level`, and #' `cur_col_val` in addition to `ref_group` and `in_ref_col`. #' #' @param ref_path (`character`)\cr Reference path for treatment variable. diff --git a/man/get_ref_info.Rd b/man/get_ref_info.Rd index a09f1ddb..7f0c10db 100644 --- a/man/get_ref_info.Rd +++ b/man/get_ref_info.Rd @@ -24,9 +24,9 @@ The variable being analyzed; see \link[rtables:additional_fun_params]{rtables::a on \code{.var}), equivalent to \code{.ref_group} from \link[rtables:additional_fun_params]{rtables::additional_fun_params}. \item \code{in_ref_col}: logical, whether the current column is the reference column, equivalent to \code{.in_ref_col} from \link[rtables:additional_fun_params]{rtables::additional_fun_params}. -\item \code{split_var}: the split variable name (last variable in \code{ref_path}). +\item \code{split_name}: the most recent split name (last split in \code{ref_path}). \item \code{ref_level}: the reference level (last level in \code{ref_path}). -\item \code{cur_col_val}: the current column's value for \code{split_var}. +\item \code{cur_col_val}: the current column's value for \code{split_name}. } } } diff --git a/man/h_get_trtvar_refpath.Rd b/man/h_get_trtvar_refpath.Rd index a8ca9de9..c62b425c 100644 --- a/man/h_get_trtvar_refpath.Rd +++ b/man/h_get_trtvar_refpath.Rd @@ -20,6 +20,6 @@ List containing treatment variable details. \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#superseded}{\figure{lifecycle-superseded.svg}{options: alt='[Superseded]'}}}{\strong{[Superseded]}} Retrieves the treatment variable reference path from the provided context. -Prefer \code{\link[=get_ref_info]{get_ref_info()}} which now returns \code{split_var}, \code{ref_level}, and +Prefer \code{\link[=get_ref_info]{get_ref_info()}} which now returns \code{split_name}, \code{ref_level}, and \code{cur_col_val} in addition to \code{ref_group} and \code{in_ref_col}. } diff --git a/tests/testthat/test-get_ref_info.R b/tests/testthat/test-get_ref_info.R index d11d793b..72f7123d 100644 --- a/tests/testthat/test-get_ref_info.R +++ b/tests/testthat/test-get_ref_info.R @@ -204,12 +204,12 @@ 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, split_var = NULL, ref_level = NULL, cur_col_val = NULL) + exp <- list(ref_group = NULL, in_ref_col = NULL, split_name = NULL, ref_level = NULL, cur_col_val = NULL) expect_identical(res, exp) }) -test_that("get_ref_info returns split_var, ref_level, cur_col_val for matching column splits", { +test_that("get_ref_info returns split_name, ref_level, cur_col_val for matching column splits", { dm <- formatters::DM dm$colspan_trt <- factor( ifelse(dm$ARM == "B: Placebo", " ", "Active Study Agent"), @@ -240,7 +240,7 @@ test_that("get_ref_info returns split_var, ref_level, cur_col_val for matching c build_table(lyt, dm) for (res in captured) { - expect_identical(res$split_var, "ARM") + expect_identical(res$split_name, "ARM") expect_identical(res$ref_level, "B: Placebo") } @@ -255,7 +255,7 @@ test_that("get_ref_info returns split_var, ref_level, cur_col_val for matching c } }) -test_that("get_ref_info returns split_var and ref_level even when ref_path is outside colvars (risk-diff column)", { +test_that("get_ref_info returns split_name and ref_level even when ref_path is outside column splits (risk-diff column)", { dm <- formatters::DM dm$colspan_trt <- factor( ifelse(dm$ARM == "B: Placebo", " ", "Active Study Agent"), @@ -300,7 +300,7 @@ test_that("get_ref_info returns split_var and ref_level even when ref_path is ou for (res in captured) { expect_null(res$ref_group) expect_null(res$in_ref_col) - expect_identical(res$split_var, "ARM") + expect_identical(res$split_name, "ARM") expect_identical(res$ref_level, "B: Placebo") expect_false(is.null(res$cur_col_val)) } From ed49a652ba945fa9d55f73692ebaba59ffba08f3 Mon Sep 17 00:00:00 2001 From: munoztd0 Date: Fri, 14 Aug 2026 16:32:40 +0200 Subject: [PATCH 11/38] lintr --- R/a_summarize_aval_chg_diff.R | 6 ++++-- tests/testthat/test-get_ref_info.R | 3 ++- 2 files changed, 6 insertions(+), 3 deletions(-) diff --git a/R/a_summarize_aval_chg_diff.R b/R/a_summarize_aval_chg_diff.R index 3b7cb3ce..82f10e7b 100644 --- a/R/a_summarize_aval_chg_diff.R +++ b/R/a_summarize_aval_chg_diff.R @@ -82,7 +82,8 @@ s_aval_chg_col23_diff <- function( cur_lvl, weights_emmeans, method_combo, - weights_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]])) @@ -396,7 +397,8 @@ a_summarize_aval_chg_diff_j <- function( multivars = c("AVAL", "AVAL", "CHG"), weights_emmeans = NULL, method_combo = c("contrasts", "collapse"), - weights_combo = NULL) { + weights_combo = NULL +) { denom <- match.arg(denom) method_combo <- match.arg(method_combo) diff --git a/tests/testthat/test-get_ref_info.R b/tests/testthat/test-get_ref_info.R index 72f7123d..2455d757 100644 --- a/tests/testthat/test-get_ref_info.R +++ b/tests/testthat/test-get_ref_info.R @@ -255,7 +255,8 @@ test_that("get_ref_info returns split_name, ref_level, cur_col_val for matching } }) -test_that("get_ref_info returns split_name and ref_level even when ref_path is outside column splits (risk-diff column)", { +test_that("get_ref_info returns split_name and ref_level even when ref_path is + outside column splits (risk-diff column)", { dm <- formatters::DM dm$colspan_trt <- factor( ifelse(dm$ARM == "B: Placebo", " ", "Active Study Agent"), From 2f393675fcb85cc1884881bc07416e8d804cfe55 Mon Sep 17 00:00:00 2001 From: munoztd0 Date: Fri, 14 Aug 2026 16:37:21 +0200 Subject: [PATCH 12/38] f**** lint --- R/a_summarize_aval_chg_diff.R | 80 +++++++++++++++--------------- tests/testthat/test-get_ref_info.R | 3 +- 2 files changed, 41 insertions(+), 42 deletions(-) diff --git a/R/a_summarize_aval_chg_diff.R b/R/a_summarize_aval_chg_diff.R index 82f10e7b..00d05024 100644 --- a/R/a_summarize_aval_chg_diff.R +++ b/R/a_summarize_aval_chg_diff.R @@ -66,23 +66,23 @@ 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]])) @@ -375,29 +375,29 @@ 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 ) { denom <- match.arg(denom) method_combo <- match.arg(method_combo) diff --git a/tests/testthat/test-get_ref_info.R b/tests/testthat/test-get_ref_info.R index 2455d757..4dc314d6 100644 --- a/tests/testthat/test-get_ref_info.R +++ b/tests/testthat/test-get_ref_info.R @@ -255,8 +255,7 @@ test_that("get_ref_info returns split_name, ref_level, cur_col_val for matching } }) -test_that("get_ref_info returns split_name and ref_level even when ref_path is - outside column splits (risk-diff column)", { +test_that("get_ref_info returns split_name and ref_level in risk-diff columns", { dm <- formatters::DM dm$colspan_trt <- factor( ifelse(dm$ARM == "B: Placebo", " ", "Active Study Agent"), From 7c726d7588572b092982f437cda0ef3e11fad373 Mon Sep 17 00:00:00 2001 From: munoztd0 Date: Tue, 18 Aug 2026 11:32:43 +0200 Subject: [PATCH 13/38] lean get_ref_info --- R/get_ref_info.R | 47 +++++++------------------- man/get_ref_info.Rd | 3 -- tests/testthat/test-get_ref_info.R | 53 +++++++++--------------------- 3 files changed, 26 insertions(+), 77 deletions(-) diff --git a/R/get_ref_info.R b/R/get_ref_info.R index 912679fd..b99cc532 100644 --- a/R/get_ref_info.R +++ b/R/get_ref_info.R @@ -17,9 +17,6 @@ #' on `.var`), equivalent to `.ref_group` from [rtables::additional_fun_params]. #' * `in_ref_col`: logical, whether the current column is the reference column, #' equivalent to `.in_ref_col` from [rtables::additional_fun_params]. -#' * `split_name`: the most recent split name (last split in `ref_path`). -#' * `ref_level`: the reference level (last level in `ref_path`). -#' * `cur_col_val`: the current column's value for `split_name`. #' #' @details #' The reference group is specified in `colpath` hierarchical fashion in @@ -78,55 +75,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, split_name = NULL, ref_level = NULL, cur_col_val = NULL) - ) + return(NULL) } checkmate::assert_character(ref_path, min.len = 2L, names = "unnamed") 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) - cur_col_path <- cur_col_split_path(.spl_context) - cur_col_vars <- cur_col_path[seq(1L, length(cur_col_path), by = 2L)] - ref_path_last <- utils::tail(ref_path, 2L) - last_var_pos <- match(ref_path_last[1L], cur_col_vars) - cur_col_last_val <- if (!is.na(last_var_pos)) { - cur_col_path[2L * last_var_pos] - } else { - NULL - } - - # If ref_path variables are outside of the current column split variable. + # Compare column split names while ignoring split values. ref_path_val_pos <- seq(2L, length(ref_path), by = 2L) - ref_path_any_vals <- ref_path - ref_path_any_vals[ref_path_val_pos] <- "*" - if (!in_column(ref_path_any_vals, .spl_context)) { - return( - list( - ref_group = NULL, - in_ref_col = NULL, - split_name = ref_path_last[1L], - ref_level = ref_path_last[2L], - cur_col_val = cur_col_last_val - ) - ) + 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)) } leaf_sc <- .spl_context[nrow(.spl_context), ] full_df <- leaf_sc$full_parent_df[[1L]] - ref_path_levels <- paste(ref_path[ref_path_val_pos], collapse = ".") - row_in_ref_group <- leaf_sc[[ref_path_levels]][[1L]] - ref_group <- full_df[row_in_ref_group, ] + 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_column(ref_path, .spl_context), - split_name = ref_path_last[1L], - ref_level = ref_path_last[2L], - cur_col_val = cur_col_last_val + ref_group = ref_group ) } diff --git a/man/get_ref_info.Rd b/man/get_ref_info.Rd index 7f0c10db..d004dd7a 100644 --- a/man/get_ref_info.Rd +++ b/man/get_ref_info.Rd @@ -24,9 +24,6 @@ The variable being analyzed; see \link[rtables:additional_fun_params]{rtables::a on \code{.var}), equivalent to \code{.ref_group} from \link[rtables:additional_fun_params]{rtables::additional_fun_params}. \item \code{in_ref_col}: logical, whether the current column is the reference column, equivalent to \code{.in_ref_col} from \link[rtables:additional_fun_params]{rtables::additional_fun_params}. -\item \code{split_name}: the most recent split name (last split in \code{ref_path}). -\item \code{ref_level}: the reference level (last level in \code{ref_path}). -\item \code{cur_col_val}: the current column's value for \code{split_name}. } } } diff --git a/tests/testthat/test-get_ref_info.R b/tests/testthat/test-get_ref_info.R index 4dc314d6..d0996d62 100644 --- a/tests/testthat/test-get_ref_info.R +++ b/tests/testthat/test-get_ref_info.R @@ -204,12 +204,11 @@ 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, split_name = NULL, ref_level = NULL, cur_col_val = NULL) - expect_identical(res, exp) + expect_null(res) }) -test_that("get_ref_info returns split_name, ref_level, cur_col_val for matching column splits", { +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"), @@ -226,36 +225,28 @@ test_that("get_ref_info returns split_name, ref_level, cur_col_val for matching ref_path <- c("colspan_trt", " ", "ARM", "B: Placebo") - captured <- list() - spy_afun <- function(df, ref_path, .spl_context) { - captured[[length(captured) + 1L]] <<- get_ref_info(ref_path, .spl_context) - in_rows("x" = rcell(1, format = "xx")) + 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 = spy_afun, extra_args = list(ref_path = ref_path)) - - build_table(lyt, dm) + analyze("AGE", afun = introspect_ref_info, extra_args = list(ref_path = ref_path)) - for (res in captured) { - expect_identical(res$split_name, "ARM") - expect_identical(res$ref_level, "B: Placebo") - } - - ref_col <- Filter(function(r) isTRUE(r$in_ref_col), captured) - expect_length(ref_col, 1L) - expect_identical(ref_col[[1L]]$cur_col_val, "B: Placebo") + result <- build_table(lyt, dm) - non_ref_cols <- Filter(function(r) isFALSE(r$in_ref_col), captured) - expect_true(length(non_ref_cols) >= 1L) - for (res in non_ref_cols) { - expect_false(res$cur_col_val == "B: Placebo") - } + expect_snapshot( + cran = TRUE, + cat(sub("[[:space:]]+$", "", capture.output(result)), sep = "\n") + ) }) -test_that("get_ref_info returns split_name and ref_level in risk-diff columns", { +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"), @@ -300,9 +291,6 @@ test_that("get_ref_info returns split_name and ref_level in risk-diff columns", for (res in captured) { expect_null(res$ref_group) expect_null(res$in_ref_col) - expect_identical(res$split_name, "ARM") - expect_identical(res$ref_level, "B: Placebo") - expect_false(is.null(res$cur_col_val)) } }) @@ -356,14 +344,3 @@ test_that("h_get_trtvar_refpath returns the expected shape and values in a risk- expect_false(is.null(res$cur_trt_grp)) # cur_trt_grp is the active arm value } }) - -test_that("get_ref_info identifies cur_col_val from split variables", { - spl_context <- data.frame( - cur_col_split = I(list(c("COLSPAN", "ARM"))), - cur_col_split_val = I(list(c("ARM", "A: Drug X"))) - ) - - result <- get_ref_info(c("ARM", "B: Placebo"), spl_context) - - expect_identical(result$cur_col_val, "A: Drug X") -}) From f4706f61d8085a87a0f56f393c5d6b672c24fa4f Mon Sep 17 00:00:00 2001 From: munoztd0 Date: Tue, 18 Aug 2026 11:35:50 +0200 Subject: [PATCH 14/38] refactor `h_get_trtvar_refpath()` and `a_summarize_aval_chg_diff_j()` --- R/a_summarize_aval_chg_diff.R | 17 ++--------------- R/h_freq_funs.R | 20 +++++++++----------- 2 files changed, 11 insertions(+), 26 deletions(-) diff --git a/R/a_summarize_aval_chg_diff.R b/R/a_summarize_aval_chg_diff.R index 00d05024..4fe8c6df 100644 --- a/R/a_summarize_aval_chg_diff.R +++ b/R/a_summarize_aval_chg_diff.R @@ -478,21 +478,8 @@ a_summarize_aval_chg_diff_j <- function( .ref_group <- NULL ctrl_grp <- NULL if (comp_btw_group) { - ref <- get_ref_info(ref_path, .spl_context) - split_name_refspec <- ref$split_name - checkmate::assert_true(identical(trt_var, split_name_refspec)) - ctrl_grp <- ref$ref_level - - ### 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, - ")." - )) - } + ref_path_info <- h_get_trtvar_refpath(ref_path, .spl_context, df) + ctrl_grp <- ref_path_info$ctrl_grp if (trt_val == ctrl_grp) .in_ref_col <- TRUE diff --git a/R/h_freq_funs.R b/R/h_freq_funs.R index 71f78f87..800be0b5 100644 --- a/R/h_freq_funs.R +++ b/R/h_freq_funs.R @@ -284,11 +284,7 @@ h_df_add_newlevels <- function(df, .var, new_levels, addstr2levs = NULL, new_lev #' Get Treatment Variable Reference Path #' -#' @description `r lifecycle::badge("superseded")` -#' #' Retrieves the treatment variable reference path from the provided context. -#' Prefer [get_ref_info()] which now returns `split_name`, `ref_level`, and -#' `cur_col_val` in addition to `ref_group` and `in_ref_col`. #' #' @param ref_path (`character`)\cr Reference path for treatment variable. #' @param .spl_context (`data.frame`)\cr Current split context. @@ -297,16 +293,18 @@ h_df_add_newlevels <- function(df, .var, new_levels, addstr2levs = NULL, new_lev #' @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. + checkmate::assert_true(length(ref_path) %% 2L == 0L) - 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] + cur_col_path <- cur_col_split_path(.spl_context) + trt_var_refspec <- utils::tail(ref_path, n = 2L)[1L] + cur_col_split_names <- cur_col_path[seq(1L, length(cur_col_path), by = 2L)] + trt_var_pos <- match(trt_var_refspec, cur_col_split_names) - checkmate::assert_true(identical(trt_var, trt_var_refspec)) + checkmate::assert_true(!is.na(trt_var_pos)) - # 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) + trt_var <- cur_col_split_names[trt_var_pos] + cur_trt_grp <- cur_col_path[2L * trt_var_pos] + ctrl_grp <- utils::tail(ref_path, n = 1L) ### check that ctrl_grp is a level of the treatment variable, in case riskdiff is requested if (!ctrl_grp %in% levels(df[[trt_var]])) { From 41e519eb7e85c6979b8985757a097a70a4d8b565 Mon Sep 17 00:00:00 2001 From: munoztd0 Date: Tue, 18 Aug 2026 11:38:46 +0200 Subject: [PATCH 15/38] lint + document --- NEWS.md | 7 +++---- man/h_get_trtvar_refpath.Rd | 4 ---- tests/testthat/_snaps/get_ref_info.md | 11 +++++++++++ 3 files changed, 14 insertions(+), 8 deletions(-) diff --git a/NEWS.md b/NEWS.md index e023acfd..4ae4a191 100644 --- a/NEWS.md +++ b/NEWS.md @@ -13,7 +13,7 @@ - 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()`. @@ -40,9 +40,8 @@ - Update new exported calls from rtables.officer - update documentation to `roxygen2` 8.0.0 - Add extra statistics to `a_eair100_j` and introduce scaling factor `num_p_year` (default = 100) (#361) -- Unified `get_ref_info()` which now also returns `split_name`, `ref_level`, and `cur_col_val` (#295) -- `h_get_trtvar_refpath()` is marked as superseded -- `a_summarize_aval_chg_diff_j()` now uses `get_ref_info()` +- Updated `get_ref_info()` for matching column split paths (#295). +- `h_get_trtvar_refpath()` now uses `cur_col_split_path()` and is used by `a_summarize_aval_chg_diff_j()` (#295). diff --git a/man/h_get_trtvar_refpath.Rd b/man/h_get_trtvar_refpath.Rd index c62b425c..0d09cc18 100644 --- a/man/h_get_trtvar_refpath.Rd +++ b/man/h_get_trtvar_refpath.Rd @@ -17,9 +17,5 @@ h_get_trtvar_refpath(ref_path, .spl_context, df) List containing treatment variable details. } \description{ -\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#superseded}{\figure{lifecycle-superseded.svg}{options: alt='[Superseded]'}}}{\strong{[Superseded]}} - Retrieves the treatment variable reference path from the provided context. -Prefer \code{\link[=get_ref_info]{get_ref_info()}} which now returns \code{split_name}, \code{ref_level}, and -\code{cur_col_val} in addition to \code{ref_group} and \code{in_ref_col}. } 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 + From 942062fcb0f9b00e4b4b51933b43cd189993f8d7 Mon Sep 17 00:00:00 2001 From: Wojtek Date: Tue, 18 Aug 2026 19:25:30 +0200 Subject: [PATCH 16/38] get_ref_info(): man update. --- R/get_ref_info.R | 50 ++++++++++++++++++++++++----------------- man/get_ref_info.Rd | 54 +++++++++++++++++++++++++-------------------- 2 files changed, 60 insertions(+), 44 deletions(-) diff --git a/R/get_ref_info.R b/R/get_ref_info.R index b99cc532..0afb02af 100644 --- a/R/get_ref_info.R +++ b/R/get_ref_info.R @@ -1,31 +1,41 @@ -#' Obtain reference information for a global reference group. +#' @title Obtain reference group information from split context. #' -#' 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. +#' @description `r lifecycle::badge("stable")` #' -#' @param ref_path (`character`) +#' `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. +#' +#' 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"`. +#' +#' @param ref_path (`character`) \cr #' Reference group specification as an `rtables` `colpath`; see Details. -#' @param .spl_context (`data.frame`) +#' @param .spl_context (`data.frame`) \cr #' Ancestor split-state information passed by `rtables`. -#' @param .var (`character`) +#' @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. #' #' @return -#' * `get_ref_info()` returns a list with: -#' * `ref_group`: the reference group data (a `data.frame` or vector depending -#' on `.var`), equivalent to `.ref_group` from [rtables::additional_fun_params]. -#' * `in_ref_col`: logical, whether the current column is the reference column, -#' equivalent to `.in_ref_col` from [rtables::additional_fun_params]. +#' 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]. +#' } #' -#' @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. +#' If the reference path is not present in the current column-split +#' hierarchy, both elements are `NULL`. #' #' @export #' diff --git a/man/get_ref_info.Rd b/man/get_ref_info.Rd index d004dd7a..2d0f00b0 100644 --- a/man/get_ref_info.Rd +++ b/man/get_ref_info.Rd @@ -2,44 +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}) +\item{ref_path}{(\code{character}) \cr Reference group specification as an \code{rtables} \code{colpath}; see Details.} -\item{.spl_context}{(\code{data.frame}) +\item{.spl_context}{(\code{data.frame}) \cr Ancestor split-state information passed by \code{rtables}.} -\item{.var}{(\code{character}) -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 the following elements: \itemize{ -\item \code{get_ref_info()} returns a list with: -\itemize{ -\item \code{ref_group}: the reference group data (a \code{data.frame} or vector depending -on \code{.var}), equivalent to \code{.ref_group} from \link[rtables:additional_fun_params]{rtables::additional_fun_params}. -\item \code{in_ref_col}: logical, whether the current column is the reference column, -equivalent to \code{.in_ref_col} from \link[rtables:additional_fun_params]{rtables::additional_fun_params}. -} +\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{ -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. +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} + +\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 From baaa1129ddad9d18f34b7c7ec927871e41d3edba Mon Sep 17 00:00:00 2001 From: Wojtek Date: Tue, 18 Aug 2026 19:32:06 +0200 Subject: [PATCH 17/38] h_get_trtvar_refpath(): cosmetic code update. --- R/h_freq_funs.R | 18 +++++++++++------- 1 file changed, 11 insertions(+), 7 deletions(-) diff --git a/R/h_freq_funs.R b/R/h_freq_funs.R index 800be0b5..06009f79 100644 --- a/R/h_freq_funs.R +++ b/R/h_freq_funs.R @@ -296,8 +296,9 @@ h_get_trtvar_refpath <- function(ref_path, .spl_context, df) { checkmate::assert_true(length(ref_path) %% 2L == 0L) cur_col_path <- cur_col_split_path(.spl_context) - trt_var_refspec <- utils::tail(ref_path, n = 2L)[1L] cur_col_split_names <- cur_col_path[seq(1L, length(cur_col_path), by = 2L)] + + trt_var_refspec <- utils::tail(ref_path, n = 2L)[1L] trt_var_pos <- match(trt_var_refspec, cur_col_split_names) checkmate::assert_true(!is.na(trt_var_pos)) @@ -309,14 +310,17 @@ h_get_trtvar_refpath <- function(ref_path, .spl_context, df) { ### 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, - ")." + "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)) + + list( + trt_var = trt_var, + trt_var_refspec = trt_var_refspec, + cur_trt_grp = cur_trt_grp, + ctrl_grp = ctrl_grp + ) } # helper function to define expression for retrieving ref_group type of datasets From 08a9830d3c04c330eaff862c0ee89ecde95bbd04 Mon Sep 17 00:00:00 2001 From: munoztd0 Date: Wed, 19 Aug 2026 13:59:12 +0000 Subject: [PATCH 18/38] refactor --- R/h_freq_funs.R | 20 +++++++++++--------- 1 file changed, 11 insertions(+), 9 deletions(-) diff --git a/R/h_freq_funs.R b/R/h_freq_funs.R index 06009f79..f5262e33 100644 --- a/R/h_freq_funs.R +++ b/R/h_freq_funs.R @@ -296,18 +296,20 @@ h_get_trtvar_refpath <- function(ref_path, .spl_context, df) { checkmate::assert_true(length(ref_path) %% 2L == 0L) cur_col_path <- cur_col_split_path(.spl_context) - cur_col_split_names <- cur_col_path[seq(1L, length(cur_col_path), by = 2L)] - trt_var_refspec <- utils::tail(ref_path, n = 2L)[1L] - trt_var_pos <- match(trt_var_refspec, cur_col_split_names) + trt_var <- cur_col_path[length(cur_col_path) - 1] + trt_var_ref <- ref_path[length(ref_path) - 1] - checkmate::assert_true(!is.na(trt_var_pos)) + if (!identical(trt_var, trt_var_ref)) { + stop(paste0( + "treatment variable in split context (", trt_var, + ") does not match ref_path specification (", trt_var_ref, ")." + )) + } - trt_var <- cur_col_split_names[trt_var_pos] - cur_trt_grp <- cur_col_path[2L * trt_var_pos] - ctrl_grp <- utils::tail(ref_path, n = 1L) + cur_trt_grp <- cur_col_path[length(cur_col_path)] + ctrl_grp <- ref_path[length(ref_path)] - ### 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, @@ -317,7 +319,7 @@ h_get_trtvar_refpath <- function(ref_path, .spl_context, df) { list( trt_var = trt_var, - trt_var_refspec = trt_var_refspec, + trt_var_ref = trt_var_ref, cur_trt_grp = cur_trt_grp, ctrl_grp = ctrl_grp ) From aef4f7f0388a6f9fdd6ee622ed8081f483465d8e Mon Sep 17 00:00:00 2001 From: munoztd0 Date: Wed, 19 Aug 2026 15:28:34 +0000 Subject: [PATCH 19/38] refactor --- R/h_freq_funs.R | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/R/h_freq_funs.R b/R/h_freq_funs.R index f5262e33..cb12cf7e 100644 --- a/R/h_freq_funs.R +++ b/R/h_freq_funs.R @@ -297,6 +297,8 @@ h_get_trtvar_refpath <- function(ref_path, .spl_context, df) { cur_col_path <- cur_col_split_path(.spl_context) + checkmate::assert_true(length(cur_col_path) >= 2L) + trt_var <- cur_col_path[length(cur_col_path) - 1] trt_var_ref <- ref_path[length(ref_path) - 1] @@ -307,12 +309,12 @@ h_get_trtvar_refpath <- function(ref_path, .spl_context, df) { )) } - cur_trt_grp <- cur_col_path[length(cur_col_path)] - ctrl_grp <- ref_path[length(ref_path)] + trt_grp <- cur_col_path[length(cur_col_path)] + ctrl_grp_ref <- ref_path[length(ref_path)] if (!ctrl_grp %in% levels(df[[trt_var]])) { stop(paste0( - "control group specification in ref_path argument (", ctrl_grp, + "control group specification in ref_path argument (", ctrl_grp_ref, ") is not a level of your treatment group variable (", trt_var, ")." )) } @@ -320,8 +322,8 @@ h_get_trtvar_refpath <- function(ref_path, .spl_context, df) { list( trt_var = trt_var, trt_var_ref = trt_var_ref, - cur_trt_grp = cur_trt_grp, - ctrl_grp = ctrl_grp + trt_grp = trt_grp, + ctrl_grp_ref = ctrl_grp_ref ) } From 3e10ceb045475a31e559adeaed564a128e140ed9 Mon Sep 17 00:00:00 2001 From: Wojtek Date: Thu, 20 Aug 2026 10:37:16 +0200 Subject: [PATCH 20/38] updated h_get_trtvar_refpath() - PLEASE UPDATE UPSTREAM CODE RESPECTIVELLY. --- R/h_freq_funs.R | 35 ++++++++++++++++++++--------------- 1 file changed, 20 insertions(+), 15 deletions(-) diff --git a/R/h_freq_funs.R b/R/h_freq_funs.R index cb12cf7e..95817511 100644 --- a/R/h_freq_funs.R +++ b/R/h_freq_funs.R @@ -296,34 +296,39 @@ h_get_trtvar_refpath <- function(ref_path, .spl_context, df) { checkmate::assert_true(length(ref_path) %% 2L == 0L) cur_col_path <- cur_col_split_path(.spl_context) - checkmate::assert_true(length(cur_col_path) >= 2L) - trt_var <- cur_col_path[length(cur_col_path) - 1] - trt_var_ref <- ref_path[length(ref_path) - 1] + cur_trt_var <- cur_col_path[length(cur_col_path) - 1] + ref_trt_var <- ref_path[length(ref_path) - 1] - if (!identical(trt_var, trt_var_ref)) { + if (!identical(cur_trt_var, ref_trt_var)) { stop(paste0( - "treatment variable in split context (", trt_var, - ") does not match ref_path specification (", trt_var_ref, ")." + "Treatment variable mismatch: the treatment variable in the current ", + "split context is '", cur_trt_var, + "', but ref_path specifies '", ref_trt_var, + "'. These treatment variables must be identical." )) } - trt_grp <- cur_col_path[length(cur_col_path)] - ctrl_grp_ref <- ref_path[length(ref_path)] + cur_trt_grp <- cur_col_path[length(cur_col_path)] + ref_trt_grp <- ref_path[length(ref_path)] - if (!ctrl_grp %in% levels(df[[trt_var]])) { + if (!ref_trt_grp %in% levels(df[[cur_trt_var]])) { stop(paste0( - "control group specification in ref_path argument (", ctrl_grp_ref, - ") is not a level of your treatment group variable (", trt_var, ")." + "Treatment group mismatch: the treatment group specified in ref_path ('", + ref_trt_grp, + "') is not a level of the treatment variable '", + cur_trt_var, + "'. Available treatment groups are: ", + paste(levels(df[[cur_trt_var]]), collapse = ", "), + "." )) } list( - trt_var = trt_var, - trt_var_ref = trt_var_ref, - trt_grp = trt_grp, - ctrl_grp_ref = ctrl_grp_ref + cur_trt_var = cur_trt_var, + cur_trt_grp = cur_trt_grp, + ref_trt_grp = ref_trt_grp ) } From 27840b89601313d38d4ba98f8f9b173471105109 Mon Sep 17 00:00:00 2001 From: Wojtek Date: Thu, 20 Aug 2026 11:04:20 +0200 Subject: [PATCH 21/38] update h_get_trtvar_refpath() and its upstream dependencies. What is left is: dev/hotfix* --- R/a_freq_j.R | 16 ++++------------ R/a_freq_resp_var_j.R | 16 ++++------------ R/a_summarize_aval_chg_diff.R | 2 +- R/a_summarize_ex_j.R | 9 +++------ R/h_freq_funs.R | 5 +++-- man/h_get_trtvar_refpath.Rd | 3 ++- tests/testthat/test-get_ref_info.R | 7 +++---- 7 files changed, 20 insertions(+), 38 deletions(-) diff --git a/R/a_freq_j.R b/R/a_freq_j.R index b4ca1c9a..395830ca 100644 --- a/R/a_freq_j.R +++ b/R/a_freq_j.R @@ -926,18 +926,10 @@ a_freq_j <- function( } 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_refpath <- h_get_trtvar_refpath(ref_path, .spl_context, df) + trt_var <- trt_var_refpath[["cur_trt_var"]] + cur_trt_grp <- trt_var_refpath[["cur_trt_grp"]] + ctrl_grp <- trt_var_refpath[["ref_trt_grp"]] # for combined facet, denom_df value for the treatment group needs update new_denomdf <- upd_denom_df_combo( new_denomdf, diff --git a/R/a_freq_resp_var_j.R b/R/a_freq_resp_var_j.R index 1b4f896a..311aa297 100644 --- a/R/a_freq_resp_var_j.R +++ b/R/a_freq_resp_var_j.R @@ -137,18 +137,10 @@ 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_refpath <- h_get_trtvar_refpath(ref_path, .spl_context, df) + trt_var <- trt_var_refpath[["cur_trt_var"]] + cur_trt_grp <- trt_var_refpath[["cur_trt_grp"]] + ctrl_grp <- trt_var_refpath[["ref_trt_grp"]] } fn <- function(levii) { diff --git a/R/a_summarize_aval_chg_diff.R b/R/a_summarize_aval_chg_diff.R index 4fe8c6df..a0686c43 100644 --- a/R/a_summarize_aval_chg_diff.R +++ b/R/a_summarize_aval_chg_diff.R @@ -479,7 +479,7 @@ a_summarize_aval_chg_diff_j <- function( ctrl_grp <- NULL if (comp_btw_group) { ref_path_info <- h_get_trtvar_refpath(ref_path, .spl_context, df) - ctrl_grp <- ref_path_info$ctrl_grp + ctrl_grp <- ref_path_info[["ref_trt_grp"]] 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..1b273d73 100644 --- a/R/a_summarize_ex_j.R +++ b/R/a_summarize_ex_j.R @@ -67,12 +67,9 @@ 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 <- trt_var_refpath[["cur_trt_var"]] + cur_trt_grp <- trt_var_refpath[["cur_trt_grp"]] + ctrl_grp <- trt_var_refpath[["ref_trt_grp"]] .in_ref_col <- FALSE if (trt_var == ctrl_grp) .in_ref_col <- TRUE diff --git a/R/h_freq_funs.R b/R/h_freq_funs.R index 95817511..d59d48f3 100644 --- a/R/h_freq_funs.R +++ b/R/h_freq_funs.R @@ -289,7 +289,8 @@ h_df_add_newlevels <- function(df, .var, new_levels, addstr2levs = NULL, new_lev #' @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. +#' @return A character vector containing the treatment variable name, its current +#' level, and the reference level name. #' @export h_get_trtvar_refpath <- function(ref_path, .spl_context, df) { checkmate::check_character(ref_path, min.len = 2L, names = "unnamed") @@ -325,7 +326,7 @@ h_get_trtvar_refpath <- function(ref_path, .spl_context, df) { )) } - list( + c( cur_trt_var = cur_trt_var, cur_trt_grp = cur_trt_grp, ref_trt_grp = ref_trt_grp diff --git a/man/h_get_trtvar_refpath.Rd b/man/h_get_trtvar_refpath.Rd index 0d09cc18..5393a4b4 100644 --- a/man/h_get_trtvar_refpath.Rd +++ b/man/h_get_trtvar_refpath.Rd @@ -14,7 +14,8 @@ h_get_trtvar_refpath(ref_path, .spl_context, df) \item{df}{(\code{data.frame})\cr Data frame.} } \value{ -List containing treatment variable details. +A character vector containing the treatment variable name, its current +level, and the reference level name. } \description{ Retrieves the treatment variable reference path from the provided context. diff --git a/tests/testthat/test-get_ref_info.R b/tests/testthat/test-get_ref_info.R index d0996d62..152b0526 100644 --- a/tests/testthat/test-get_ref_info.R +++ b/tests/testthat/test-get_ref_info.R @@ -338,9 +338,8 @@ test_that("h_get_trtvar_refpath returns the expected shape and values in a risk- expect_length(captured, 2L) for (res in captured) { - expect_identical(res$trt_var, "ARM") - expect_identical(res$ctrl_grp, "B: Placebo") - expect_identical(res$trt_var_refspec, "ARM") # trt_var_refspec == trt_var by definition - expect_false(is.null(res$cur_trt_grp)) # cur_trt_grp is the active arm value + expect_identical(res[["cur_trt_var"]], "ARM") + expect_identical(res[["ref_trt_grp"]], "B: Placebo") + expect_false(is.null(res[["cur_trt_grp"]])) # cur_trt_grp is the active arm value } }) From cb143e0c6b050575633753fd541147c3a354ee07 Mon Sep 17 00:00:00 2001 From: Wojtek Date: Thu, 20 Aug 2026 11:09:09 +0200 Subject: [PATCH 22/38] styler only. --- R/a_freq_resp_var_j.R | 57 ++++++++++++++++++++-------------------- R/a_summarize_ex_j.R | 61 ++++++++++++++++++++++--------------------- 2 files changed, 60 insertions(+), 58 deletions(-) diff --git a/R/a_freq_resp_var_j.R b/R/a_freq_resp_var_j.R index 311aa297..51379e41 100644 --- a/R/a_freq_resp_var_j.R +++ b/R/a_freq_resp_var_j.R @@ -46,34 +46,35 @@ #' #' 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) +) { # ---- Derive statistics: xx / xx (xx.x%) if (is.null(resp_var)) { diff --git a/R/a_summarize_ex_j.R b/R/a_summarize_ex_j.R index 1b273d73..66179751 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) @@ -184,23 +184,24 @@ 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 +) { if (!is.numeric(df[[.var]])) { stop("a_summarize_ex_j issue: input variable must be numeric.") } From 41d6366c19f0d8252b5283d5a82787f0c4c1263c Mon Sep 17 00:00:00 2001 From: munoztd0 Date: Thu, 20 Aug 2026 09:33:20 +0000 Subject: [PATCH 23/38] fix(h_get_trtvar_refpath): match trt var by name not position.. --- R/h_freq_funs.R | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/R/h_freq_funs.R b/R/h_freq_funs.R index d59d48f3..5ae6cf82 100644 --- a/R/h_freq_funs.R +++ b/R/h_freq_funs.R @@ -299,19 +299,23 @@ h_get_trtvar_refpath <- function(ref_path, .spl_context, df) { cur_col_path <- cur_col_split_path(.spl_context) checkmate::assert_true(length(cur_col_path) >= 2L) - cur_trt_var <- cur_col_path[length(cur_col_path) - 1] ref_trt_var <- ref_path[length(ref_path) - 1] - if (!identical(cur_trt_var, ref_trt_var)) { + # Variable names is odd + var_positions <- seq(1L, length(cur_col_path), by = 2L) + trt_var_pos <- var_positions[cur_col_path[var_positions] == ref_trt_var] + + if (length(trt_var_pos) == 0L) { stop(paste0( "Treatment variable mismatch: the treatment variable in the current ", - "split context is '", cur_trt_var, + "split context is '", cur_col_path[length(cur_col_path) - 1L], "', but ref_path specifies '", ref_trt_var, "'. These treatment variables must be identical." )) } - cur_trt_grp <- cur_col_path[length(cur_col_path)] + cur_trt_var <- cur_col_path[trt_var_pos] + cur_trt_grp <- cur_col_path[trt_var_pos + 1L] ref_trt_grp <- ref_path[length(ref_path)] if (!ref_trt_grp %in% levels(df[[cur_trt_var]])) { From afb42b31fbc7a1c4958a61e31aaa9b40dee4af9e Mon Sep 17 00:00:00 2001 From: munoztd0 Date: Thu, 20 Aug 2026 10:02:18 +0000 Subject: [PATCH 24/38] vingette for get_ref_info --- _pkgdown.yml | 1 + vignettes/get_ref_info.Rmd | 234 +++++++++++++++++++++++++++++++++++++ 2 files changed, 235 insertions(+) create mode 100644 vignettes/get_ref_info.Rmd diff --git a/_pkgdown.yml b/_pkgdown.yml index 0bb95c8f..02dcdd22 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. diff --git a/vignettes/get_ref_info.Rmd b/vignettes/get_ref_info.Rmd new file mode 100644 index 00000000..10936d6b --- /dev/null +++ b/vignettes/get_ref_info.Rmd @@ -0,0 +1,234 @@ +--- +title: "Reference Group Handling with get_ref_info" +date: "`r Sys.Date()`" +author: "David Munoz Tord" +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 difference in means versus placebo, or +a risk difference versus a comparator arm. In `rtables`, the reference +group is normally injected automatically via `.ref_group` and +`.in_ref_col` when the analysis function is placed inside the reference +column's split. This works well for simple single-level column splits, +but breaks down when: + +- the reference column is nested under a spanning header (e.g. a + `colspan_trt` variable), +- 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(tern) +library(dplyr) +``` + +```{r load_data, message=FALSE} +adsl <- ex_adsl +``` + +## 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 +for a given layout. + +## 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). + +Here is a minimal analysis function that uses `get_ref_info()`: + +```{r basic_afun} +afun_diff_means <- function(x, .var, ref_path, .spl_context) { + ref <- get_ref_info(ref_path, .spl_context, .var) + + diff <- if (isFALSE(ref$in_ref_col)) { + mean(x, na.rm = TRUE) - mean(ref$ref_group, na.rm = TRUE) + } else { + NULL + } + + in_rows( + m = rcell(mean(x, na.rm = TRUE), label = "Mean", format = "xx.x"), + diff = rcell(diff, label = "Diff vs Placebo", format = "xx.x") + ) +} +``` + +Applied to a simple single-level column split: + +```{r basic_table} +ref_path <- c("ARM", "B: Placebo") + +lyt <- basic_table() |> + split_cols_by("ARM") |> + analyze("AGE", afun = afun_diff_means, extra_args = list(ref_path = ref_path)) + +build_table(lyt, adsl) +``` + +## With a Spanning Header + +When a spanning header variable (`colspan_trt`) sits above the treatment +split, the reference column is nested one level deeper. The `ref_path` +must include the spanning variable: + +```{r colspan_setup} +adsl2 <- adsl |> + mutate( + colspan_trt = factor( + ifelse(ARM == "B: Placebo", " ", "Active Study Agent"), + levels = c("Active Study Agent", " ") + ) + ) + +colspan_trt_map <- create_colspan_map( + adsl2, + 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_nested <- c("colspan_trt", " ", "ARM", "B: Placebo") +``` + +```{r colspan_table} +lyt2 <- basic_table() |> + split_cols_by("colspan_trt", split_fun = trim_levels_to_map(colspan_trt_map)) |> + split_cols_by("ARM") |> + analyze("AGE", afun = afun_diff_means, extra_args = list(ref_path = ref_path_nested)) + +build_table(lyt2, adsl2) +``` + +Note that `get_ref_info()` returns `in_ref_col = NULL` (not `FALSE`) +when the reference split variable is absent from the current column +hierarchy — for example, in an overall column added via +`add_overall_col()`. The analysis function should handle `NULL` +explicitly: + +```{r overall_col} +lyt3 <- basic_table() |> + split_cols_by("colspan_trt", split_fun = trim_levels_to_map(colspan_trt_map)) |> + split_cols_by("ARM") |> + add_overall_col("Total") |> + analyze("AGE", afun = afun_diff_means, extra_args = list(ref_path = ref_path_nested)) + +build_table(lyt3, adsl2) +``` + +The `Total` column receives `in_ref_col = NULL` because `colspan_trt` +is not part of its column path. The analysis function returns `NULL` for +the difference row, producing a blank cell. + +## Wildcard Matching + +`in_column()` — the underlying helper used by `get_ref_info()` — supports +`"*"` as a wildcard for any single split variable name or value. This is +useful when you want to check whether the current column belongs to a +particular split level regardless of the spanning header above it: + +```{r wildcard} +# Matches any column where ARM == "B: Placebo", regardless of spanning header +spl_context_placebo <- 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_context_placebo) + +# wildcard on the spanning header — still TRUE +in_column(c("*", "*", "ARM", "B: Placebo"), spl_context_placebo) + +# wildcard does not match a different ARM level +in_column(c("*", "*", "ARM", "A: Drug X"), spl_context_placebo) +``` + +## Relationship to `h_get_trtvar_refpath` + +`get_ref_info()` and `h_get_trtvar_refpath()` serve different purposes +and are used in different contexts: + +| | `get_ref_info()` | `h_get_trtvar_refpath()` | +|---|---|---| +| **Returns** | reference-group data + `in_ref_col` flag | treatment variable name, current group, reference group name | +| **Used for** | obtaining `.ref_group` / `.in_ref_col` for statistics | identifying the treatment variable when `split_cols_by_multivar` is present | +| **Typical callers** | `s_*` / `a_*` analysis functions | `a_summarize_aval_chg_diff_j`, `a_freq_j`, `a_eair_j` | + +In layouts that combine `split_cols_by_multivar` with difference +columns, `h_get_trtvar_refpath()` is called first to resolve the +treatment variable name from the interleaved column path, and +`get_ref_info()` is then called to obtain the reference-group data. + +## Inspecting Column Paths + +When constructing `ref_path`, it is helpful to inspect the column paths +of a built table: + +```{r col_paths} +tbl <- build_table(lyt2, adsl2) +col_paths(tbl) +``` + +Each path in the output corresponds to a leaf column. The `ref_path` +should match one of these paths exactly (or use `"*"` wildcards for +positions that should not be constrained). +``` From 89e2e580d5b514c582ace92a04f658afdf8f894f Mon Sep 17 00:00:00 2001 From: munoztd0 Date: Thu, 20 Aug 2026 13:32:08 +0000 Subject: [PATCH 25/38] added match + is.na defensice checks --- R/h_freq_funs.R | 19 +++++++++++-------- man/response_by_var.Rd | 2 +- 2 files changed, 12 insertions(+), 9 deletions(-) diff --git a/R/h_freq_funs.R b/R/h_freq_funs.R index 5ae6cf82..ada315c4 100644 --- a/R/h_freq_funs.R +++ b/R/h_freq_funs.R @@ -303,19 +303,22 @@ h_get_trtvar_refpath <- function(ref_path, .spl_context, df) { # Variable names is odd var_positions <- seq(1L, length(cur_col_path), by = 2L) - trt_var_pos <- var_positions[cur_col_path[var_positions] == ref_trt_var] - if (length(trt_var_pos) == 0L) { + if (anyDuplicated(cur_col_path[var_positions]) != 0) { + stop("Variable names on the current column split-path must be unique.") + } + + trt_var_pos <- match(ref_trt_var, cur_col_path[var_positions]) + + if (is.na(trt_var_pos)) { stop(paste0( - "Treatment variable mismatch: the treatment variable in the current ", - "split context is '", cur_col_path[length(cur_col_path) - 1L], - "', but ref_path specifies '", ref_trt_var, - "'. These treatment variables must be identical." + "ref_path treatment variable ('", ref_trt_var, + "') not found in the current column split-path." )) } - cur_trt_var <- cur_col_path[trt_var_pos] - cur_trt_grp <- cur_col_path[trt_var_pos + 1L] + cur_trt_var <- cur_col_path[var_positions[trt_var_pos]] + cur_trt_grp <- cur_col_path[var_positions[trt_var_pos] + 1L] ref_trt_grp <- ref_path[length(ref_path)] if (!ref_trt_grp %in% levels(df[[cur_trt_var]])) { 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} From e0c381148e04f589a23a580987e9e9ae4fa48c98 Mon Sep 17 00:00:00 2001 From: munoztd0 Date: Thu, 20 Aug 2026 15:23:31 +0000 Subject: [PATCH 26/38] use pharmaverseadamjnj instead for examples --- vignettes/get_ref_info.Rmd | 226 +++++++++++++++++++------------------ 1 file changed, 116 insertions(+), 110 deletions(-) diff --git a/vignettes/get_ref_info.Rmd b/vignettes/get_ref_info.Rmd index 10936d6b..98df37f4 100644 --- a/vignettes/get_ref_info.Rmd +++ b/vignettes/get_ref_info.Rmd @@ -1,7 +1,6 @@ --- title: "Reference Group Handling with get_ref_info" date: "`r Sys.Date()`" -author: "David Munoz Tord" output: rmarkdown::html_document: theme: "spacelab" @@ -28,15 +27,11 @@ knitr::opts_chunk$set( ## Overview Many clinical tables require statistics computed relative to a reference -(control) group, for example, a difference in means versus placebo, or -a risk difference versus a comparator arm. In `rtables`, the reference -group is normally injected automatically via `.ref_group` and -`.in_ref_col` when the analysis function is placed inside the reference -column's split. This works well for simple single-level column splits, -but breaks down when: - -- the reference column is nested under a spanning header (e.g. a - `colspan_trt` variable), +(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. @@ -46,14 +41,9 @@ the reference group itself, using an explicit column path (`ref_path`). ```{r load_packages, message=FALSE} library(rtables) library(junco) -library(tern) library(dplyr) ``` -```{r load_data, message=FALSE} -adsl <- ex_adsl -``` - ## The `ref_path` Convention `ref_path` is a character vector of alternating split-variable names and @@ -78,8 +68,7 @@ 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 -for a given layout. +Use `col_paths(build_table(lyt, df))` to inspect the available paths. ## Basic Usage @@ -91,144 +80,161 @@ for a given layout. - `ref_group`: the subset of the row data belonging to the reference group (a data frame, or a vector if `.var` is supplied). -Here is a minimal analysis function that uses `get_ref_info()`: - -```{r basic_afun} -afun_diff_means <- function(x, .var, ref_path, .spl_context) { - ref <- get_ref_info(ref_path, .spl_context, .var) +## Working Example: AE Table with Risk Difference Columns - diff <- if (isFALSE(ref$in_ref_col)) { - mean(x, na.rm = TRUE) - mean(ref$ref_group, na.rm = TRUE) - } else { - NULL - } +This example demonstrates the standard pattern for a table with +spanning headers and risk difference columns — the primary use case +for `get_ref_info()`. - in_rows( - m = rcell(mean(x, na.rm = TRUE), label = "Mean", format = "xx.x"), - diff = rcell(diff, label = "Diff vs Placebo", format = "xx.x") - ) -} -``` +```{r data_prep} +trtvar <- "TRT01A" +ctrl_grp <- "Placebo" -Applied to a simple single-level column split: +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") + )) -```{r basic_table} -ref_path <- c("ARM", "B: Placebo") +adae <- pharmaverseadamjnj::adae |> + filter(TRTEMFL == "Y") |> + select(USUBJID, TRTEMFL, AEBODSYS, AEDECOD) -lyt <- basic_table() |> - split_cols_by("ARM") |> - analyze("AGE", afun = afun_diff_means, extra_args = list(ref_path = ref_path)) +# 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) -build_table(lyt, adsl) +ae <- adae |> right_join(adsl, by = "USUBJID") ``` -## With a Spanning Header - -When a spanning header variable (`colspan_trt`) sits above the treatment -split, the reference column is nested one level deeper. The `ref_path` -must include the spanning variable: - -```{r colspan_setup} -adsl2 <- adsl |> - mutate( - colspan_trt = factor( - ifelse(ARM == "B: Placebo", " ", "Active Study Agent"), - levels = c("Active Study Agent", " ") - ) - ) +The `ref_path` must trace the full column-split hierarchy down to the +reference group: +```{r ref_path} colspan_trt_map <- create_colspan_map( - adsl2, - non_active_grp = "B: Placebo", + adsl, + non_active_grp = ctrl_grp, non_active_grp_span_lbl = " ", - active_grp_span_lbl = "Active Study Agent", - colspan_var = "colspan_trt", - trt_var = "ARM" + active_grp_span_lbl = "Active Study Agent", + colspan_var = "colspan_trt", + trt_var = trtvar ) -ref_path_nested <- c("colspan_trt", " ", "ARM", "B: Placebo") +ref_path <- c("colspan_trt", " ", trtvar, ctrl_grp) ``` -```{r colspan_table} -lyt2 <- basic_table() |> - split_cols_by("colspan_trt", split_fun = trim_levels_to_map(colspan_trt_map)) |> - split_cols_by("ARM") |> - analyze("AGE", afun = afun_diff_means, extra_args = list(ref_path = ref_path_nested)) +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)")) +) -build_table(lyt2, adsl2) +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) ``` -Note that `get_ref_info()` returns `in_ref_col = NULL` (not `FALSE`) -when the reference split variable is absent from the current column -hierarchy — for example, in an overall column added via -`add_overall_col()`. The analysis function should handle `NULL` -explicitly: +## How `get_ref_info` Works Internally -```{r overall_col} -lyt3 <- basic_table() |> - split_cols_by("colspan_trt", split_fun = trim_levels_to_map(colspan_trt_map)) |> - split_cols_by("ARM") |> - add_overall_col("Total") |> - analyze("AGE", afun = afun_diff_means, extra_args = list(ref_path = ref_path_nested)) +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). -build_table(lyt3, adsl2) -``` - -The `Total` column receives `in_ref_col = NULL` because `colspan_trt` -is not part of its column path. The analysis function returns `NULL` for -the difference row, producing a blank cell. +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 +## 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. This is -useful when you want to check whether the current column belongs to a -particular split level regardless of the spanning header above it: +`in_column()` — the underlying helper used by `get_ref_info()` — +supports `"*"` as a wildcard for any single split variable name or +value: ```{r wildcard} -# Matches any column where ARM == "B: Placebo", regardless of spanning header -spl_context_placebo <- data.frame( +# 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_context_placebo) +# Exact match +in_column(c("colspan_trt", " ", "ARM", "B: Placebo"), spl_ctx) -# wildcard on the spanning header — still TRUE -in_column(c("*", "*", "ARM", "B: Placebo"), spl_context_placebo) +# Wildcard on spanning header — still TRUE +in_column(c("*", "*", "ARM", "B: Placebo"), spl_ctx) -# wildcard does not match a different ARM level -in_column(c("*", "*", "ARM", "A: Drug X"), spl_context_placebo) +# Different ARM level — FALSE +in_column(c("*", "*", "ARM", "A: Drug X"), spl_ctx) ``` ## Relationship to `h_get_trtvar_refpath` -`get_ref_info()` and `h_get_trtvar_refpath()` serve different purposes -and are used in different contexts: +`get_ref_info()` and `h_get_trtvar_refpath()` serve different purposes: | | `get_ref_info()` | `h_get_trtvar_refpath()` | |---|---|---| | **Returns** | reference-group data + `in_ref_col` flag | treatment variable name, current group, reference group name | | **Used for** | obtaining `.ref_group` / `.in_ref_col` for statistics | identifying the treatment variable when `split_cols_by_multivar` is present | -| **Typical callers** | `s_*` / `a_*` analysis functions | `a_summarize_aval_chg_diff_j`, `a_freq_j`, `a_eair_j` | +| **Typical callers** | `a_freq_j`, `a_eair_j`, `s_ancova_j` | `a_summarize_aval_chg_diff_j` | In layouts that combine `split_cols_by_multivar` with difference -columns, `h_get_trtvar_refpath()` is called first to resolve the -treatment variable name from the interleaved column path, and -`get_ref_info()` is then called to obtain the reference-group data. +columns, `h_get_trtvar_refpath()` resolves the treatment variable name +from the interleaved column path, and `get_ref_info()` obtains the +reference-group data. ## Inspecting Column Paths -When constructing `ref_path`, it is helpful to inspect the column paths -of a built table: +When constructing `ref_path`, inspect the column paths of a built table: ```{r col_paths} -tbl <- build_table(lyt2, adsl2) -col_paths(tbl) +col_paths(result) ``` -Each path in the output corresponds to a leaf column. The `ref_path` -should match one of these paths exactly (or use `"*"` wildcards for -positions that should not be constrained). -``` +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). From 830ba97f9edac3e1ae6fa5a06fcaa6ffc8ea9ff6 Mon Sep 17 00:00:00 2001 From: munoztd0 Date: Fri, 21 Aug 2026 14:26:31 +0200 Subject: [PATCH 27/38] Added regression test --- tests/testthat/test-get_ref_info.R | 29 ++++++++++++++++++++++++++++- 1 file changed, 28 insertions(+), 1 deletion(-) diff --git a/tests/testthat/test-get_ref_info.R b/tests/testthat/test-get_ref_info.R index 152b0526..fd72e24a 100644 --- a/tests/testthat/test-get_ref_info.R +++ b/tests/testthat/test-get_ref_info.R @@ -318,7 +318,7 @@ test_that("h_get_trtvar_refpath returns the expected shape and values in a risk- 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_trtvar_refpath(ref_path, .spl_context, df) + res <- h_get_trtvar_refpath(ref_path, .spl_context, df, trt_var_pos = 3L) captured[[length(captured) + 1L]] <<- res } in_rows("x" = rcell(1, format = "xx")) @@ -343,3 +343,30 @@ test_that("h_get_trtvar_refpath returns the expected shape and values in a risk- expect_false(is.null(res[["cur_trt_grp"]])) # cur_trt_grp is the active arm value } }) + +test_that("h_get_trtvar_refpath uses the requested trt_var position", { + df <- data.frame( + ARM = factor("A", levels = c("A", "B", "Placebo")), + stringsAsFactors = FALSE + ) + spl_context <- data.frame( + cur_col_split = I(list(c("ARM", "stat", "ARM"))), + cur_col_split_val = I(list(c("A", "N", "B"))) + ) + ref_path <- c("ARM", "Placebo") + + result <- h_get_trtvar_refpath(ref_path, spl_context, df, trt_var_pos = 5L) + expect_identical(result[["cur_trt_grp"]], "B") + expect_error( + h_get_trtvar_refpath(ref_path, spl_context, df, trt_var_pos = 3L), + "does not match" + ) + expect_error( + h_get_trtvar_refpath(ref_path, spl_context, df, trt_var_pos = 4L), + "Must be TRUE" + ) + expect_error( + h_get_trtvar_refpath(ref_path, spl_context, df, trt_var_pos = 7L), + "not <= 5" + ) +}) From df9bb778ff28287fc06b222bc1af408bfdca3dff Mon Sep 17 00:00:00 2001 From: munoztd0 Date: Fri, 21 Aug 2026 14:29:11 +0200 Subject: [PATCH 28/38] Implemented the positional trt_var suggestion --- R/a_freq_j.R | 7 ++++++- R/a_freq_resp_var_j.R | 7 ++++++- R/a_summarize_aval_chg_diff.R | 7 ++++++- R/a_summarize_ex_j.R | 7 ++++++- R/h_freq_funs.R | 24 ++++++++++-------------- man/h_get_trtvar_refpath.Rd | 5 ++++- 6 files changed, 38 insertions(+), 19 deletions(-) diff --git a/R/a_freq_j.R b/R/a_freq_j.R index 395830ca..e34531a0 100644 --- a/R/a_freq_j.R +++ b/R/a_freq_j.R @@ -926,7 +926,12 @@ a_freq_j <- function( } if (riskdiff) { - trt_var_refpath <- h_get_trtvar_refpath(ref_path, .spl_context, df) + trt_var_refpath <- h_get_trtvar_refpath( + ref_path, + .spl_context, + df, + trt_var_pos = length(cur_col_split_path(.spl_context)) - 1L + ) trt_var <- trt_var_refpath[["cur_trt_var"]] cur_trt_grp <- trt_var_refpath[["cur_trt_grp"]] ctrl_grp <- trt_var_refpath[["ref_trt_grp"]] diff --git a/R/a_freq_resp_var_j.R b/R/a_freq_resp_var_j.R index 51379e41..5d2e8141 100644 --- a/R/a_freq_resp_var_j.R +++ b/R/a_freq_resp_var_j.R @@ -138,7 +138,12 @@ 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 <- h_get_trtvar_refpath( + ref_path, + .spl_context, + df, + trt_var_pos = length(cur_col_split_path(.spl_context)) - 1L + ) trt_var <- trt_var_refpath[["cur_trt_var"]] cur_trt_grp <- trt_var_refpath[["cur_trt_grp"]] ctrl_grp <- trt_var_refpath[["ref_trt_grp"]] diff --git a/R/a_summarize_aval_chg_diff.R b/R/a_summarize_aval_chg_diff.R index a0686c43..35208ac7 100644 --- a/R/a_summarize_aval_chg_diff.R +++ b/R/a_summarize_aval_chg_diff.R @@ -478,7 +478,12 @@ a_summarize_aval_chg_diff_j <- function( .ref_group <- NULL ctrl_grp <- NULL if (comp_btw_group) { - ref_path_info <- h_get_trtvar_refpath(ref_path, .spl_context, df) + ref_path_info <- h_get_trtvar_refpath( + ref_path, + .spl_context, + df, + trt_var_pos = 2L * (colvars_multivars - 1L) - 1L + ) ctrl_grp <- ref_path_info[["ref_trt_grp"]] 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 66179751..18b50c36 100644 --- a/R/a_summarize_ex_j.R +++ b/R/a_summarize_ex_j.R @@ -66,7 +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 <- h_get_trtvar_refpath( + ref_path, + .spl_context, + df, + trt_var_pos = length(cur_col_split_path(.spl_context)) - 1L + ) trt_var <- trt_var_refpath[["cur_trt_var"]] cur_trt_grp <- trt_var_refpath[["cur_trt_grp"]] ctrl_grp <- trt_var_refpath[["ref_trt_grp"]] diff --git a/R/h_freq_funs.R b/R/h_freq_funs.R index ada315c4..84f4e8a5 100644 --- a/R/h_freq_funs.R +++ b/R/h_freq_funs.R @@ -289,36 +289,32 @@ h_df_add_newlevels <- function(df, .var, new_levels, addstr2levs = NULL, new_lev #' @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. +#' @param trt_var_pos (`integer(1)`)\cr Position of the treatment variable in +#' the current interleaved column split path. #' @return A character vector containing the treatment variable name, its current #' level, and the reference level name. #' @export -h_get_trtvar_refpath <- function(ref_path, .spl_context, df) { +h_get_trtvar_refpath <- function(ref_path, .spl_context, df, trt_var_pos) { checkmate::check_character(ref_path, min.len = 2L, names = "unnamed") checkmate::assert_true(length(ref_path) %% 2L == 0L) cur_col_path <- cur_col_split_path(.spl_context) checkmate::assert_true(length(cur_col_path) >= 2L) + checkmate::assert_int(trt_var_pos, lower = 1L, upper = length(cur_col_path) - 1L) + checkmate::assert_true(trt_var_pos %% 2L == 1L) ref_trt_var <- ref_path[length(ref_path) - 1] - # Variable names is odd - var_positions <- seq(1L, length(cur_col_path), by = 2L) - - if (anyDuplicated(cur_col_path[var_positions]) != 0) { - stop("Variable names on the current column split-path must be unique.") - } - - trt_var_pos <- match(ref_trt_var, cur_col_path[var_positions]) - - if (is.na(trt_var_pos)) { + cur_trt_var <- cur_col_path[trt_var_pos] + if (!identical(cur_trt_var, ref_trt_var)) { stop(paste0( "ref_path treatment variable ('", ref_trt_var, - "') not found in the current column split-path." + "') does not match the treatment variable at position ", trt_var_pos, + " of the current column split-path ('", cur_trt_var, "')." )) } - cur_trt_var <- cur_col_path[var_positions[trt_var_pos]] - cur_trt_grp <- cur_col_path[var_positions[trt_var_pos] + 1L] + cur_trt_grp <- cur_col_path[trt_var_pos + 1L] ref_trt_grp <- ref_path[length(ref_path)] if (!ref_trt_grp %in% levels(df[[cur_trt_var]])) { diff --git a/man/h_get_trtvar_refpath.Rd b/man/h_get_trtvar_refpath.Rd index 5393a4b4..b1c5f7ad 100644 --- a/man/h_get_trtvar_refpath.Rd +++ b/man/h_get_trtvar_refpath.Rd @@ -4,7 +4,7 @@ \alias{h_get_trtvar_refpath} \title{Get Treatment Variable Reference Path} \usage{ -h_get_trtvar_refpath(ref_path, .spl_context, df) +h_get_trtvar_refpath(ref_path, .spl_context, df, trt_var_pos) } \arguments{ \item{ref_path}{(\code{character})\cr Reference path for treatment variable.} @@ -12,6 +12,9 @@ h_get_trtvar_refpath(ref_path, .spl_context, df) \item{.spl_context}{(\code{data.frame})\cr Current split context.} \item{df}{(\code{data.frame})\cr Data frame.} + +\item{trt_var_pos}{(\code{integer(1)})\cr Position of the treatment variable in +the current interleaved column split path.} } \value{ A character vector containing the treatment variable name, its current From 83396fbdc741de9b47f6a858ad59ec8374104ee6 Mon Sep 17 00:00:00 2001 From: Wojtek Date: Sat, 22 Aug 2026 09:47:55 +0200 Subject: [PATCH 29/38] replace h_get_trtvar_refpath() with h_get_cur_trt_grp(). The UPSTREAM CODE NEEDS TO BE UPDATED (except a_freq_j())! --- NAMESPACE | 2 +- NEWS.md | 7 ++-- R/a_freq_j.R | 18 ++++---- R/h_freq_funs.R | 82 ++++++++++++++++++++----------------- _pkgdown.yml | 2 +- man/h_get_cur_trt_grp.Rd | 41 +++++++++++++++++++ man/h_get_trtvar_refpath.Rd | 25 ----------- 7 files changed, 99 insertions(+), 78 deletions(-) create mode 100644 man/h_get_cur_trt_grp.Rd delete mode 100644 man/h_get_trtvar_refpath.Rd diff --git a/NAMESPACE b/NAMESPACE index e59dcb6f..e9d4ed3a 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -65,8 +65,8 @@ export(get_titles_from_file) export(get_visit_levels) export(grouped_cols_w_diffs) export(h_extract_coxreg_multivar) +export(h_get_cur_trt_grp) 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 4ae4a191..5069443f 100644 --- a/NEWS.md +++ b/NEWS.md @@ -9,6 +9,9 @@ ### 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`. @@ -40,10 +43,6 @@ - Update new exported calls from rtables.officer - update documentation to `roxygen2` 8.0.0 - Add extra statistics to `a_eair100_j` and introduce scaling factor `num_p_year` (default = 100) (#361) -- Updated `get_ref_info()` for matching column split paths (#295). -- `h_get_trtvar_refpath()` now uses `cur_col_split_path()` and is used by `a_summarize_aval_chg_diff_j()` (#295). - - ### Added - Added `categorize_pval()` for assigning p-values to validated, user-defined categories. diff --git a/R/a_freq_j.R b/R/a_freq_j.R index e34531a0..aca43ee0 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) @@ -926,16 +929,11 @@ a_freq_j <- function( } if (riskdiff) { - trt_var_refpath <- h_get_trtvar_refpath( - ref_path, - .spl_context, - df, - trt_var_pos = length(cur_col_split_path(.spl_context)) - 1L - ) - trt_var <- trt_var_refpath[["cur_trt_var"]] - cur_trt_grp <- trt_var_refpath[["cur_trt_grp"]] - ctrl_grp <- trt_var_refpath[["ref_trt_grp"]] - # for combined facet, denom_df value for the treatment group needs update + 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) + new_denomdf <- upd_denom_df_combo( new_denomdf, trt_var, diff --git a/R/h_freq_funs.R b/R/h_freq_funs.R index 84f4e8a5..0e6ab1df 100644 --- a/R/h_freq_funs.R +++ b/R/h_freq_funs.R @@ -281,59 +281,67 @@ 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 +#' +#' @description `r lifecycle::badge("stable")` +#' +#' Retrieves the current treatment group from the current column split-path, +#' given the treatment variable name. #' -#' Retrieves the treatment variable reference path from the provided context. +#' @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. #' -#' @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. -#' @param trt_var_pos (`integer(1)`)\cr Position of the treatment variable in -#' the current interleaved column split path. -#' @return A character vector containing the treatment variable name, its current -#' level, and the reference level name. +#' @author WW +#' @seealso [cur_col_split_path()] #' @export -h_get_trtvar_refpath <- function(ref_path, .spl_context, df, trt_var_pos) { - checkmate::check_character(ref_path, min.len = 2L, names = "unnamed") - checkmate::assert_true(length(ref_path) %% 2L == 0L) +#' @examples +#' .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) +#' +#' \dontrun{ +#' h_get_cur_trt_grp("TRT", .spl_context) +#' } +#' +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) - checkmate::assert_int(trt_var_pos, lower = 1L, upper = length(cur_col_path) - 1L) - checkmate::assert_true(trt_var_pos %% 2L == 1L) + checkmate::assert_true(length(cur_col_path) %% 2L == 0L) - ref_trt_var <- ref_path[length(ref_path) - 1] + trt_var_pos <- which(trt_var == cur_col_path) - cur_trt_var <- cur_col_path[trt_var_pos] - if (!identical(cur_trt_var, ref_trt_var)) { + if (length(trt_var_pos) == 0L) { stop(paste0( - "ref_path treatment variable ('", ref_trt_var, - "') does not match the treatment variable at position ", trt_var_pos, - " of the current column split-path ('", cur_trt_var, "')." + "Treatment variable name ('", trt_var, + "') not found in the current column split-path ('", + paste(cur_col_path, collapse = "."), "')." )) } - cur_trt_grp <- cur_col_path[trt_var_pos + 1L] - ref_trt_grp <- ref_path[length(ref_path)] + if (length(trt_var_pos) >= 2L) { + stop(paste0( + "Treatment variable name ('", trt_var, + "') must be unique in the current column split-path ('", + paste(cur_col_path, collapse = "."), "')." + )) + } - if (!ref_trt_grp %in% levels(df[[cur_trt_var]])) { + if (trt_var_pos %% 2 == 0L) { stop(paste0( - "Treatment group mismatch: the treatment group specified in ref_path ('", - ref_trt_grp, - "') is not a level of the treatment variable '", - cur_trt_var, - "'. Available treatment groups are: ", - paste(levels(df[[cur_trt_var]]), collapse = ", "), - "." + "Treatment variable ('", trt_var, + "') must be in an odd position in the current column split-path ('", + paste(cur_col_path, collapse = "."), "')." )) } - c( - cur_trt_var = cur_trt_var, - cur_trt_grp = cur_trt_grp, - ref_trt_grp = ref_trt_grp - ) + # Previous checks ensure that `trt_var_pos + 1L <= length(cur_col_path)` + cur_col_path[trt_var_pos + 1L] } # helper function to define expression for retrieving ref_group type of datasets diff --git a/_pkgdown.yml b/_pkgdown.yml index 02dcdd22..222804bb 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -82,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 @@ -156,6 +155,7 @@ reference: - smart_colwidths_1page - tt_to_tbldf - factor_by_order + - h_get_cur_trt_grp - title: junco Functions For generating .rtfs, .docxs and HTMLs desc: The following utility functions help to generate the .rtfs, .docxs and HTMLs. diff --git a/man/h_get_cur_trt_grp.Rd b/man/h_get_cur_trt_grp.Rd new file mode 100644 index 00000000..c475944d --- /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{ +.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) + +\dontrun{ +h_get_cur_trt_grp("TRT", .spl_context) +} + +} +\seealso{ +\code{\link[=cur_col_split_path]{cur_col_split_path()}} +} +\author{ +WW +} diff --git a/man/h_get_trtvar_refpath.Rd b/man/h_get_trtvar_refpath.Rd deleted file mode 100644 index b1c5f7ad..00000000 --- a/man/h_get_trtvar_refpath.Rd +++ /dev/null @@ -1,25 +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, trt_var_pos) -} -\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.} - -\item{trt_var_pos}{(\code{integer(1)})\cr Position of the treatment variable in -the current interleaved column split path.} -} -\value{ -A character vector containing the treatment variable name, its current -level, and the reference level name. -} -\description{ -Retrieves the treatment variable reference path from the provided context. -} From 2218cf3be187b2fb02ce4f11877a99b820eb18f0 Mon Sep 17 00:00:00 2001 From: Wojtek Date: Sat, 22 Aug 2026 13:22:51 +0200 Subject: [PATCH 30/38] cosmetic a_freq_j() update. --- R/a_freq_j.R | 19 ++++++++----------- 1 file changed, 8 insertions(+), 11 deletions(-) diff --git a/R/a_freq_j.R b/R/a_freq_j.R index aca43ee0..8bfa70fc 100644 --- a/R/a_freq_j.R +++ b/R/a_freq_j.R @@ -916,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." @@ -926,21 +925,12 @@ a_freq_j <- function( trt_var <- NULL ctrl_grp <- NULL cur_trt_grp <- NULL - } - - if (riskdiff) { + } 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) - new_denomdf <- upd_denom_df_combo( - new_denomdf, - trt_var, - cur_trt_grp, - .spl_context - ) - if (!is.null(colgroup) && trt_var == colgroup) { stop( "\n Problem: a_freq_j: colgroup and treatment variable from ref_path are the same. @@ -948,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( From df4a1c9c068f90f4d25a2504299e31393512f645 Mon Sep 17 00:00:00 2001 From: Wojtek Date: Mon, 24 Aug 2026 10:24:49 +0200 Subject: [PATCH 31/38] Added strict_match(). --- NAMESPACE | 1 + NEWS.md | 1 + R/h_freq_funs.R | 28 +------------------ R/utils.R | 65 +++++++++++++++++++++++++++++++++++++++++++++ _pkgdown.yml | 1 + man/strict_match.Rd | 42 +++++++++++++++++++++++++++++ 6 files changed, 111 insertions(+), 27 deletions(-) create mode 100644 man/strict_match.Rd diff --git a/NAMESPACE b/NAMESPACE index e9d4ed3a..57f6052c 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -141,6 +141,7 @@ export(s_summarize_mmrm) export(s_summary_diff) export(safe_prune_table) export(set_titles) +export(strict_match) export(string_to_title) export(summarize_coxreg_multivar) export(summarize_lsmeans_wide) diff --git a/NEWS.md b/NEWS.md index 5069443f..afef8f99 100644 --- a/NEWS.md +++ b/NEWS.md @@ -45,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/h_freq_funs.R b/R/h_freq_funs.R index 0e6ab1df..a4f579f4 100644 --- a/R/h_freq_funs.R +++ b/R/h_freq_funs.R @@ -314,33 +314,7 @@ h_get_cur_trt_grp <- function(trt_var, .spl_context) { cur_col_path <- cur_col_split_path(.spl_context) checkmate::assert_true(length(cur_col_path) %% 2L == 0L) - trt_var_pos <- which(trt_var == cur_col_path) - - if (length(trt_var_pos) == 0L) { - stop(paste0( - "Treatment variable name ('", trt_var, - "') not found in the current column split-path ('", - paste(cur_col_path, collapse = "."), "')." - )) - } - - if (length(trt_var_pos) >= 2L) { - stop(paste0( - "Treatment variable name ('", trt_var, - "') must be unique in the current column split-path ('", - paste(cur_col_path, collapse = "."), "')." - )) - } - - if (trt_var_pos %% 2 == 0L) { - stop(paste0( - "Treatment variable ('", trt_var, - "') must be in an odd position in the current column split-path ('", - paste(cur_col_path, collapse = "."), "')." - )) - } - - # Previous checks ensure that `trt_var_pos + 1L <= length(cur_col_path)` + trt_var_pos <- strict_match(trt_var, cur_col_path, odd = TRUE) cur_col_path[trt_var_pos + 1L] } diff --git a/R/utils.R b/R/utils.R index 40105812..2b818c72 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`. +#' +#' @author WW +#' +#' @export +#' @examples +#' strict_match("A", c("A", "Placebo")) +#' +#' strict_match("SEX", c("SomeVar", "SomeVal", "SEX", "Male")) +#' +#' \dontrun{ +#' 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 222804bb..226577d7 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -155,6 +155,7 @@ reference: - smart_colwidths_1page - tt_to_tbldf - factor_by_order + - strict_match - h_get_cur_trt_grp - title: junco Functions For generating .rtfs, .docxs and HTMLs diff --git a/man/strict_match.Rd b/man/strict_match.Rd new file mode 100644 index 00000000..bff03c89 --- /dev/null +++ b/man/strict_match.Rd @@ -0,0 +1,42 @@ +% 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{ +strict_match("A", c("A", "Placebo")) + +strict_match("SEX", c("SomeVar", "SomeVal", "SEX", "Male")) + +\dontrun{ +strict_match("ARM", c("SEX", "Male")) +strict_match("Male", c("SEX", "Male")) +strict_match("ARM", c("ARM", "Placebo", "ARM", "Active")) +} + +} +\author{ +WW +} From 39840692e9414f9c9d5fe829b99bad0b4e8aaecd Mon Sep 17 00:00:00 2001 From: munoztd0 Date: Mon, 24 Aug 2026 11:34:07 +0000 Subject: [PATCH 32/38] unexport --- NAMESPACE | 2 -- R/h_freq_funs.R | 1 - R/utils.R | 1 - _pkgdown.yml | 2 -- 4 files changed, 6 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 57f6052c..b582ad51 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -65,7 +65,6 @@ export(get_titles_from_file) export(get_visit_levels) export(grouped_cols_w_diffs) export(h_extract_coxreg_multivar) -export(h_get_cur_trt_grp) export(h_get_design_mat) export(h_tidy_pool) export(in_column) @@ -141,7 +140,6 @@ export(s_summarize_mmrm) export(s_summary_diff) export(safe_prune_table) export(set_titles) -export(strict_match) export(string_to_title) export(summarize_coxreg_multivar) export(summarize_lsmeans_wide) diff --git a/R/h_freq_funs.R b/R/h_freq_funs.R index a4f579f4..b35e4450 100644 --- a/R/h_freq_funs.R +++ b/R/h_freq_funs.R @@ -294,7 +294,6 @@ h_df_add_newlevels <- function(df, .var, new_levels, addstr2levs = NULL, new_lev #' #' @author WW #' @seealso [cur_col_split_path()] -#' @export #' @examples #' .spl_context <- data.frame( #' cur_col_split = I(list(c("ARM"))), diff --git a/R/utils.R b/R/utils.R index 2b818c72..464a5326 100644 --- a/R/utils.R +++ b/R/utils.R @@ -534,7 +534,6 @@ factor_by_order <- function(x, y, ordered = FALSE) { #' #' @author WW #' -#' @export #' @examples #' strict_match("A", c("A", "Placebo")) #' diff --git a/_pkgdown.yml b/_pkgdown.yml index 226577d7..2f472180 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -155,8 +155,6 @@ reference: - smart_colwidths_1page - tt_to_tbldf - factor_by_order - - strict_match - - h_get_cur_trt_grp - title: junco Functions For generating .rtfs, .docxs and HTMLs desc: The following utility functions help to generate the .rtfs, .docxs and HTMLs. From 1669baf8f512d9d9845ba7f59b32990f7d1c8278 Mon Sep 17 00:00:00 2001 From: munoztd0 Date: Mon, 24 Aug 2026 11:40:41 +0000 Subject: [PATCH 33/38] test: add unit test for strict_match --- tests/testthat/test-utils-strict_match.R | 22 ++++++++++++++++++++++ 1 file changed, 22 insertions(+) create mode 100644 tests/testthat/test-utils-strict_match.R 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") +}) From 1acd4a0ec4ff51e2f7c66e9027c5caa07212b568 Mon Sep 17 00:00:00 2001 From: munoztd0 Date: Mon, 24 Aug 2026 12:03:11 +0000 Subject: [PATCH 34/38] fix #446 . Update all the code (afuns) that uses the old h_get_trtvar_refpath(). --- R/a_freq_resp_var_j.R | 12 +++------- R/a_summarize_aval_chg_diff.R | 9 ++------ R/a_summarize_ex_j.R | 14 ++++-------- tests/testthat/test-get_ref_info.R | 35 +++++++----------------------- vignettes/get_ref_info.Rmd | 14 ++++++------ 5 files changed, 24 insertions(+), 60 deletions(-) diff --git a/R/a_freq_resp_var_j.R b/R/a_freq_resp_var_j.R index 5d2e8141..ef05f4ac 100644 --- a/R/a_freq_resp_var_j.R +++ b/R/a_freq_resp_var_j.R @@ -138,15 +138,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_pos = length(cur_col_split_path(.spl_context)) - 1L - ) - trt_var <- trt_var_refpath[["cur_trt_var"]] - cur_trt_grp <- trt_var_refpath[["cur_trt_grp"]] - ctrl_grp <- trt_var_refpath[["ref_trt_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 35208ac7..7e725071 100644 --- a/R/a_summarize_aval_chg_diff.R +++ b/R/a_summarize_aval_chg_diff.R @@ -478,13 +478,8 @@ a_summarize_aval_chg_diff_j <- function( .ref_group <- NULL ctrl_grp <- NULL if (comp_btw_group) { - ref_path_info <- h_get_trtvar_refpath( - ref_path, - .spl_context, - df, - trt_var_pos = 2L * (colvars_multivars - 1L) - 1L - ) - ctrl_grp <- ref_path_info[["ref_trt_grp"]] + ctrl_grp <- ref_path[length(ref_path)] + cur_trt_grp <- h_get_cur_trt_grp(ref_path[length(ref_path) - 1L], .spl_context) 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 18b50c36..0ecf024c 100644 --- a/R/a_summarize_ex_j.R +++ b/R/a_summarize_ex_j.R @@ -66,18 +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_pos = length(cur_col_split_path(.spl_context)) - 1L - ) - trt_var <- trt_var_refpath[["cur_trt_var"]] - cur_trt_grp <- trt_var_refpath[["cur_trt_grp"]] - ctrl_grp <- trt_var_refpath[["ref_trt_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, ] diff --git a/tests/testthat/test-get_ref_info.R b/tests/testthat/test-get_ref_info.R index fd72e24a..1b4bc3f8 100644 --- a/tests/testthat/test-get_ref_info.R +++ b/tests/testthat/test-get_ref_info.R @@ -294,7 +294,7 @@ test_that("get_ref_info returns NULL reference information in risk-diff columns" } }) -test_that("h_get_trtvar_refpath returns the expected shape and values in a risk-diff column", { +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"), @@ -318,7 +318,7 @@ test_that("h_get_trtvar_refpath returns the expected shape and values in a risk- 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_trtvar_refpath(ref_path, .spl_context, df, trt_var_pos = 3L) + res <- h_get_cur_trt_grp("ARM", .spl_context) captured[[length(captured) + 1L]] <<- res } in_rows("x" = rcell(1, format = "xx")) @@ -338,35 +338,16 @@ test_that("h_get_trtvar_refpath returns the expected shape and values in a risk- expect_length(captured, 2L) for (res in captured) { - expect_identical(res[["cur_trt_var"]], "ARM") - expect_identical(res[["ref_trt_grp"]], "B: Placebo") - expect_false(is.null(res[["cur_trt_grp"]])) # cur_trt_grp is the active arm value + expect_true(res %in% levels(dm$ARM)) + expect_false(res == "B: Placebo") } }) -test_that("h_get_trtvar_refpath uses the requested trt_var position", { - df <- data.frame( - ARM = factor("A", levels = c("A", "B", "Placebo")), - stringsAsFactors = FALSE - ) +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("ARM", "stat", "ARM"))), - cur_col_split_val = I(list(c("A", "N", "B"))) + cur_col_split = I(list(c("SEX"))), + cur_col_split_val = I(list(c("Male"))) ) - ref_path <- c("ARM", "Placebo") - result <- h_get_trtvar_refpath(ref_path, spl_context, df, trt_var_pos = 5L) - expect_identical(result[["cur_trt_grp"]], "B") - expect_error( - h_get_trtvar_refpath(ref_path, spl_context, df, trt_var_pos = 3L), - "does not match" - ) - expect_error( - h_get_trtvar_refpath(ref_path, spl_context, df, trt_var_pos = 4L), - "Must be TRUE" - ) - expect_error( - h_get_trtvar_refpath(ref_path, spl_context, df, trt_var_pos = 7L), - "not <= 5" - ) + expect_error(h_get_cur_trt_grp("ARM", spl_context), "not found") }) diff --git a/vignettes/get_ref_info.Rmd b/vignettes/get_ref_info.Rmd index 98df37f4..d7fb6486 100644 --- a/vignettes/get_ref_info.Rmd +++ b/vignettes/get_ref_info.Rmd @@ -212,18 +212,18 @@ in_column(c("*", "*", "ARM", "B: Placebo"), spl_ctx) in_column(c("*", "*", "ARM", "A: Drug X"), spl_ctx) ``` -## Relationship to `h_get_trtvar_refpath` +## Relationship to `h_get_cur_trt_grp` -`get_ref_info()` and `h_get_trtvar_refpath()` serve different purposes: +`get_ref_info()` and `h_get_cur_trt_grp()` serve different purposes: -| | `get_ref_info()` | `h_get_trtvar_refpath()` | +| | `get_ref_info()` | `h_get_cur_trt_grp()` | |---|---|---| -| **Returns** | reference-group data + `in_ref_col` flag | treatment variable name, current group, reference group name | -| **Used for** | obtaining `.ref_group` / `.in_ref_col` for statistics | identifying the treatment variable when `split_cols_by_multivar` is present | -| **Typical callers** | `a_freq_j`, `a_eair_j`, `s_ancova_j` | `a_summarize_aval_chg_diff_j` | +| **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_trtvar_refpath()` resolves the treatment variable name +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. From 8acd022b8676b7be6aa874d7df90257cd386e709 Mon Sep 17 00:00:00 2001 From: munoztd0 Date: Mon, 24 Aug 2026 12:08:25 +0000 Subject: [PATCH 35/38] adde assertions 6. ) assertions should be added to all other functions where `ref_path` Fixes #449 --- R/a_freq_resp_var_j.R | 3 +++ R/a_summarize_aval_chg_diff.R | 3 +++ R/a_summarize_ex_j.R | 3 +++ 3 files changed, 9 insertions(+) diff --git a/R/a_freq_resp_var_j.R b/R/a_freq_resp_var_j.R index ef05f4ac..34902365 100644 --- a/R/a_freq_resp_var_j.R +++ b/R/a_freq_resp_var_j.R @@ -75,6 +75,9 @@ a_freq_resp_var_j <- function( .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)) { diff --git a/R/a_summarize_aval_chg_diff.R b/R/a_summarize_aval_chg_diff.R index 7e725071..e721255d 100644 --- a/R/a_summarize_aval_chg_diff.R +++ b/R/a_summarize_aval_chg_diff.R @@ -399,6 +399,9 @@ a_summarize_aval_chg_diff_j <- function( 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) diff --git a/R/a_summarize_ex_j.R b/R/a_summarize_ex_j.R index 0ecf024c..e877fa1e 100644 --- a/R/a_summarize_ex_j.R +++ b/R/a_summarize_ex_j.R @@ -201,6 +201,9 @@ a_summarize_ex_j <- function( 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.") } From 2b8ab9790560fb9894c0a9e22b2d0f05eecbae66 Mon Sep 17 00:00:00 2001 From: munoztd0 Date: Mon, 24 Aug 2026 13:14:17 +0000 Subject: [PATCH 36/38] add dont run --- R/h_freq_funs.R | 6 +++--- R/utils.R | 5 +++-- man/h_get_cur_trt_grp.Rd | 6 +++--- man/strict_match.Rd | 3 ++- 4 files changed, 11 insertions(+), 9 deletions(-) diff --git a/R/h_freq_funs.R b/R/h_freq_funs.R index b35e4450..05ddec6d 100644 --- a/R/h_freq_funs.R +++ b/R/h_freq_funs.R @@ -292,18 +292,18 @@ h_df_add_newlevels <- function(df, .var, new_levels, addstr2levs = NULL, new_lev #' @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) -#' -#' \dontrun{ -#' h_get_cur_trt_grp("TRT", .spl_context) +#' h_get_cur_trt_grp("TRT", .spl_context) # errors: TRT not found #' } #' h_get_cur_trt_grp <- function(trt_var, .spl_context) { diff --git a/R/utils.R b/R/utils.R index 464a5326..d9833016 100644 --- a/R/utils.R +++ b/R/utils.R @@ -532,14 +532,15 @@ factor_by_order <- function(x, y, ordered = FALSE) { #' #' @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")) -#' -#' \dontrun{ +#' #' strict_match("ARM", c("SEX", "Male")) #' strict_match("Male", c("SEX", "Male")) #' strict_match("ARM", c("ARM", "Placebo", "ARM", "Active")) diff --git a/man/h_get_cur_trt_grp.Rd b/man/h_get_cur_trt_grp.Rd index c475944d..b674cb90 100644 --- a/man/h_get_cur_trt_grp.Rd +++ b/man/h_get_cur_trt_grp.Rd @@ -21,15 +21,14 @@ 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) - -\dontrun{ -h_get_cur_trt_grp("TRT", .spl_context) +h_get_cur_trt_grp("TRT", .spl_context) # errors: TRT not found } } @@ -39,3 +38,4 @@ h_get_cur_trt_grp("TRT", .spl_context) \author{ WW } +\keyword{internal} diff --git a/man/strict_match.Rd b/man/strict_match.Rd index bff03c89..88118e4c 100644 --- a/man/strict_match.Rd +++ b/man/strict_match.Rd @@ -26,11 +26,11 @@ 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")) -\dontrun{ strict_match("ARM", c("SEX", "Male")) strict_match("Male", c("SEX", "Male")) strict_match("ARM", c("ARM", "Placebo", "ARM", "Active")) @@ -40,3 +40,4 @@ strict_match("ARM", c("ARM", "Placebo", "ARM", "Active")) \author{ WW } +\keyword{internal} From 3ba2bb74dc660d1818e15c987195ab094a2114a4 Mon Sep 17 00:00:00 2001 From: munoztd0 Date: Mon, 24 Aug 2026 13:15:00 +0000 Subject: [PATCH 37/38] lintr --- R/utils.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/utils.R b/R/utils.R index d9833016..ebbb45c9 100644 --- a/R/utils.R +++ b/R/utils.R @@ -540,7 +540,7 @@ factor_by_order <- function(x, y, ordered = FALSE) { #' 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")) From 1bba4f17846932c9947430dfc12ab3d80bd50381 Mon Sep 17 00:00:00 2001 From: munoztd0 Date: Tue, 25 Aug 2026 12:40:02 +0000 Subject: [PATCH 38/38] fthis --- R/a_summarize_aval_chg_diff.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/R/a_summarize_aval_chg_diff.R b/R/a_summarize_aval_chg_diff.R index e721255d..89820392 100644 --- a/R/a_summarize_aval_chg_diff.R +++ b/R/a_summarize_aval_chg_diff.R @@ -481,8 +481,9 @@ a_summarize_aval_chg_diff_j <- function( .ref_group <- NULL ctrl_grp <- NULL if (comp_btw_group) { + checkmate::assert_true(identical(trt_var, ref_path[length(ref_path) - 1L])) ctrl_grp <- ref_path[length(ref_path)] - cur_trt_grp <- h_get_cur_trt_grp(ref_path[length(ref_path) - 1L], .spl_context) + stopifnot(ctrl_grp %in% levels(df[[trt_var]])) if (trt_val == ctrl_grp) .in_ref_col <- TRUE