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..00529d55 100644 --- a/R/cur_col_split_path_utils.R +++ b/R/cur_col_split_path_utils.R @@ -47,7 +47,7 @@ cur_col_split_path <- function(.spl_context) { checkmate::assert_list(.spl_context[nrow(.spl_context), "cur_col_split"], min.len = 1L) checkmate::assert_list(.spl_context[nrow(.spl_context), "cur_col_split_val"], min.len = 1L) checkmate::assert_character(.spl_context[nrow(.spl_context), "cur_col_split"][[1]], names = "unnamed") - checkmate::assert_character(.spl_context[nrow(.spl_context), "cur_col_split_val"][[1]], names = "unnamed") + checkmate::assert_character(.spl_context[nrow(.spl_context), "cur_col_split_val"][[1]]) checkmate::assert_true( length(.spl_context[nrow(.spl_context), "cur_col_split"][[1]]) == length(.spl_context[nrow(.spl_context), "cur_col_split_val"][[1]]) diff --git a/R/get_ref_info.R b/R/get_ref_info.R index a250d258..f2a4d005 100644 --- a/R/get_ref_info.R +++ b/R/get_ref_info.R @@ -1,20 +1,25 @@ -#' @title Obtain Reference Information for a Global Reference Group -#' -#' @description `r lifecycle::badge("stable")` +#' 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`)\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]. +#' @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]. #' -#' @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]. +#' @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 @@ -73,34 +78,55 @@ #' build_table(lyt, dm) get_ref_info <- function(ref_path, .spl_context, .var = NULL) { if (is.null(ref_path)) { - return(list(ref_group = NULL, in_ref_col = NULL)) + return( + 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) - 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 = ".") + 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. - 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)) + 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 + ) + ) } - # 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]] + 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, ] if (!is.null(.var)) { ref_group <- ref_group[[.var]] } - list(ref_group = ref_group, in_ref_col = in_ref_col) + 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], + cur_col_val = cur_col_last_val + ) } 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..c62e9756 100644 --- a/man/get_ref_info.Rd +++ b/man/get_ref_info.Rd @@ -2,27 +2,35 @@ % 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{.spl_context}{(\code{data.frame}) +Ancestor split-state information passed by \code{rtables}.} -\item{.var}{(\code{character})\cr the variable being analyzed, -see \link[rtables:additional_fun_params]{rtables::additional_fun_params}.} +\item{.var}{(\code{character}) +The variable being analyzed; 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}. +\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]}} - 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/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-cur_col_split_path.R b/tests/testthat/test-cur_col_split_path.R index e540b5f5..afe384e8 100644 --- a/tests/testthat/test-cur_col_split_path.R +++ b/tests/testthat/test-cur_col_split_path.R @@ -10,6 +10,18 @@ test_that("cur_col_split_path() works for a single-level split", { expect_identical(res, exp) }) +test_that("cur_col_split_path() accepts named split values", { + spl_context <- data.frame( + cur_col_split = I(list("ARM")), + cur_col_split_val = I(list(c(ARM = "Placebo"))) + ) + + res <- cur_col_split_path(spl_context) + exp <- c("ARM", "Placebo") + + expect_identical(unname(res), exp) +}) + test_that("cur_col_split_path() uses the leaf row split for a single-level split", { spl_context <- data.frame( cur_col_split = I(list("ARM_0", "ARM")), diff --git a/tests/testthat/test-get_ref_info.R b/tests/testthat/test-get_ref_info.R index d764e8a9..c544988d 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") +})