From 8baff2c90f1556d05a897ce3fb50950d07691c95 Mon Sep 17 00:00:00 2001 From: Gabe Becker Date: Wed, 15 Apr 2026 15:48:17 -0700 Subject: [PATCH 1/5] multicomparator functionality --- NAMESPACE | 3 + R/risk_diff_col_struct.R | 626 +++++++++++++++++++++++++++ R/split_functions.R | 35 ++ man/col_struct_w_risk_diffs.Rd | 138 ++++++ man/make_multicomp_splfun.Rd | 132 ++++++ tests/testthat/test-multcomp-rrisk.R | 193 +++++++++ 6 files changed, 1127 insertions(+) create mode 100644 R/risk_diff_col_struct.R create mode 100644 man/col_struct_w_risk_diffs.Rd create mode 100644 man/make_multicomp_splfun.Rd create mode 100644 tests/testthat/test-multcomp-rrisk.R diff --git a/NAMESPACE b/NAMESPACE index e2ac5663..2d4d5c3d 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -36,6 +36,7 @@ export(c_proportion_logical) export(check_wrap_nobreak) export(cmp_cfun) export(cmp_split_fun) +export(col_struct_w_risk_diffs) export(column_stats) export(cond_rm_facets) export(count_pruner) @@ -84,6 +85,8 @@ export(lsmeans_wide_cfun) export(lsmeans_wide_first_split_fun_fct) export(lsmeans_wide_second_split_fun_fct) export(make_combo_splitfun) +export(make_dflt_comp_map) +export(make_multicomp_splfun) export(make_rbmi_cluster) export(no_data_to_report_str) export(or_clogit_j) diff --git a/R/risk_diff_col_struct.R b/R/risk_diff_col_struct.R new file mode 100644 index 00000000..4ae52e40 --- /dev/null +++ b/R/risk_diff_col_struct.R @@ -0,0 +1,626 @@ +add_sib_facets <- function(add_spl_var, add_lbl_var = add_spl_var, comp_path = NULL, combo_map_all) { + function(ret, spl, .spl_context, fulldf) { + + combo_map <- NULL + if (!is.null(combo_map_all)) { + combo_map <- combo_map_all[combo_map_all$comp_var == add_spl_var, ] + } + ret <- insert_subset_exprs(ret, spl, comp_path = comp_path) + if (identical(add_spl_var, spl_variable(spl)) && NROW(combo_map) == 0) { + out <- ret + } else { + exargs <- list() + if (!is.null(comp_path)) + exargs$ref_path <- comp_path + spl2 <- VarLevelSplit(var = add_spl_var, split_label = "new thang", labels_var = add_lbl_var, extra_args = list(exargs)) + ret2 <- do_base_split(spl2, fulldf) + if (NROW(combo_map) > 0) { + for (i in seq_len(NROW(combo_map))) { + ret2 <- add_combo_facet(combo_map$valname[i], + combo_map$label[i], + combo_map$levelcombo[[i]], + combo_map$exargs[[i]])( + ret = ret2, + spl = spl2, + .spl_context = .spl_context, + fulldf = fulldf + ) + } + } +# browser() + ret2 <- insert_subset_exprs(ret2, spl2, comp_path = comp_path) + if (identical(add_spl_var, spl_variable(spl))) { + ## if we're in the split variable case only add the new combo facets + cmbo_inds <- match(combo_map$valname, names(ret2$values)) + ret2 <- lapply(ret2, function(lsti) lsti[cmbo_inds]) + names(ret2) <- names(ret) + } + + if (any(names(ret2[[1]]) %in% names(ret[[1]]))) { + stop("add_spl_var variable cannot have levels matching any ", + "existing levels in the split. Try creating a new dummy ", + "variable that is a one to one mapping to the split ", + "variable if desired.") + } + + out <- lapply(names(ret), function(nm) c(ret[[nm]], ret2[[nm]])) + names(out) <- names(ret) + } + out + } +} + + +#' Make Multi-comparitor Split Function +#' +#' Create a custom splitting function suitable for creating risk +#' difference columns against one or more comparators. This is used +#' within `col_struct_w_risk_diffs`. +#' +#' @param comp_vars `(character)`\cr A vector of one or more different +#' variables to provide the comparitors. The first value must be +#' the variable being split on. +#' +#' @param comp_level_paths `(list of character vectors)`\cr A list of +#' comparator paths suitable for passing to e.g., `a_freq_j`'s +#' `ref_path` argument. +#' +#' @param lbl_vars `(character)`\cr A vector of label variables or +#' (`NA_character_` for no label variable) corresponding to each +#' of `comp_vars`. +#' +#' @param combo_levels_map `(data.frame or NULL)`\cr NULL (the +#' default) or a data.frame indicating combination levels to added +#' to some or all blocks of comparisons. See Details. +#' +#' @param .pre `(list)`\cr A list of additional preprocessing +#' functions to be provided to `make_split_fun`. Defaults to +#' `list()`. +#' +#' @param .post `(list)`\cr A list of additional postprocessing +#' functions to be provided to `make_split_fun` *after* those +#' which provide this function's primary multi-comparator +#' functionality. Defaults to `list()` +#' +#' @return A split function suitable for use in both `split_rows_by` +#' and `split_cols_by`. +#' +#' @details +#' This split function is intended to create a set of risk difference +#' or similiar columns. As such it will automatically exclude the facet +#' for each comparator level (e.g., Placebo vs Placebo) as determined +#' by the last element of each element of `comp_level_paths`. +#' +#' Each variable in `comp_vars` must be unique *and not have any +#' levels in common with any other comparator variables*. +#' +#' Further control of facets is provided by `comp_level_map`. If +#' `NULL` (the default), all non-control/reference groups will be +#' compared pairwise with all control/reference groups. +#' +#' If specified, `comp_level_map` must be a `data.frame` (including +#' `tbl_df`) with three columns: +#' +#' - `active` - (character) the value to be compared to a reference level, +#' - `comparator` - (character) the level that should be compared against, and +#' - `is_combo_active` - (logical) is the level specified in `active` a virtual combination level. +#' +#' If a `data.frame` with only the `active` and `comparator` columns +#' is given for `comp_level_map`, `is_combo_active` is assumed as +#' `FALSE` for all rows. +#' +#' If any rows of `comp_level_map` have `is_combo_active == TRUE`, the +#' values of `active` in those rows *must* also appear in +#' `combo_levels_map` with the correct level for comp_level (or `NA` +#' which indicates inclusion for all comparators). +#' +#' If specified, `combo_levels_map` must be a `data.frame` (including `tbl_df`) +#' with the following columns: +#' +#' - `valname` - (`character`) The name(s) for the combination level(s), +#' - `label` - (`character`) the label(s) for the combination level(s), +#' - `levelcombo` - (`list` of `character`) the levels of the split +#' variable to be combined, or `select_all_levels` for all levels, +#' - `exargs` - (`list`) the extra_args values for each combo level. If not +#' present this will be assumed to be `list()` for all combo levels. +#' - `compare_against` - (`list` of `character`) Optional. The reference level(s) the +#' combo level should be compared against, or `select_all_levels` for +#' inclusion against all comparators. +#' - `is_control` - (`logical`) Optional. Is this combination level going +#' to be used as a reference level (must appear as the last element in +#' one of `comp_level_paths` if so). +#' +#' When specifying `combo_levels_map` if the `compare_against` column +#' is ommitted, comparison against all reference levels will be +#' performed for all combination levels. If `is_control` is ommitted, +#' it will be assumed as `FALSE` for all combination levels. +#' +#' Order of combination levels when multiple are present for a single +#' comparator, as well as their position relative to non-combination +#' comparisons, is determined by row order in `combo_levels_map`. +#' +#' Labels (for the first reference level) and names (for the remaining +#' reference levels) of comparison columns involving combination +#' levels will be automatically computed in the form of +#' `" vs "` +#' +#' +#' The comparator reference path (`comp_level_path` elements) are +#' added as `ref_path` to the extra_args associated with generated +#' facet. As such, analysis (or content) functions used underneath a +#' split using the generated split function must accept either +#' `ref_path` or `...`. +#' +#' @note It is not currently possible to use a virtual combination +#' level as a comparator/reference group. If you need this +#' functionality please contact the maintainers by filing an issue +#' at https://github.com/johnsonandjohnson/junco/issues +#' +#' @family riskdiff_col_struct +#' +#'@export +make_multicomp_splfun <- function(comp_vars, + comp_level_paths, + lbl_vars = rep(NA, + length.out = length(comp_vars)), + combo_levels_map = NULL, + comp_level_map = NULL, + .pre = list(), + .post = list()) { + + nvars <- length(comp_vars) + if (length(comp_level_paths) != nvars || + length(lbl_vars) != nvars || + length(comp_level_paths) != nvars) { + stop( + "Lengths of arguments do not all match:\n[", + "comp_vars:", nvars, + ", comp_level_paths: ", length(comp_level_paths), + "lbl_vars:", length(lbl_vars), + "]." + ) + } + + + post <- c(.post) + comp_levels <- vapply(comp_level_paths, function(pth) tail(pth, 1), "") + if (!is.null(combo_levels_map)) { + comp_level_map <- fix_combo_comp_levels(comp_level_map, + combo_levels_map, + ref_lvls = comp_levels) + combo_levels_map <- expand_combo_map(combo_levels_map, comp_vars, ref_lvls = comp_levels) + } + + lbl_vars[is.na(lbl_vars)] <- comp_vars[is.na(lbl_vars)] + + funlst <- lapply( + seq_along(comp_vars), + function(i) { + function(ret, spl, .spl_context, fulldf) { + callstuff <<- list(ret = ret, spl = spl, spl_context = .spl_context, fulldf = fulldf) + sib_fac_fun <- add_sib_facets(comp_vars[i], lbl_vars[i], comp_path = comp_level_paths[[i]], combo_map_all = combo_levels_map) + one_sib_fac_fun <<- sib_fac_fun + sib_fac_fun(ret, spl, .spl_context, fulldf) + } + } + ) + + make_split_fun(pre = .pre, + post = c(funlst, + apply_comp_map(comp_vars, comp_levels, comp_map = comp_level_map, combo_map = combo_levels_map), + post)) +} + + +make_comp_name <- function(act_nm, comp_nm) paste0(act_nm, " vs ", comp_nm) + +## must be called ***before*** expand_combo_map so the old +## valnames are still there +fix_combo_comp_levels <- function(comp_map, combo_map, ref_lvls, ref_labs = ref_lvls) { + if(NROW(combo_map) == 0) + return(comp_map) + comp_inds <- which(comp_map$active_is_combo) + comp_map$active[comp_inds] <- vapply(comp_inds, function(ii) { + comp_rw <- comp_map[ii,] + combo_ind <- match(comp_rw$active, combo_map$valname) + make_comp_name(combo_map$label[combo_ind], ref_labs[match(comp_rw$comparator, ref_lvls)[1]]) + }, "") + comp_map +} + +expand_combo_map <- function(combo_map, comp_vars, ref_lvls, ref_labs = ref_lvls) { + + if (NROW(combo_map) == 0) { + return(combo_map) + } + + if (!("compare_against" %in% names(combo_map))) { + combo_map$compare_against <- lapply(seq_len(NROW(combo_map)), function(i) select_all_levels) + } + + rws <- lapply(seq_len(NROW(combo_map)), + function(ii) { + first_ref <- ref_lvls[1] + remaining_refs <- ref_lvls[-1] + mp_rw <- combo_map[ii, ] + comp_against <- mp_rw$compare_against[[1]] + if (is.null(comp_against) || is(comp_against, "AllLevelsSentinel")) + comp_against <- ref_lvls + + + rws_out <- lapply(comp_against, + function(cur_ref_lvl) { + ref_lvl_ind <- match(cur_ref_lvl, ref_lvls) + cur_ref_lab <- ref_labs[ref_lvl_ind] + cur_rw <- combo_map[ii, ] ## AllLvlsSentinel class getting dropped from map_rw somehow... + new_nm <- make_comp_name(mp_rw$label, cur_ref_lab) + cur_rw$valname <- new_nm + if (!is(cur_rw$levelcombo[[1]], "AllLevelsSentinel")) { + cur_rw$levelcombo[[1]] <- vapply(as.character(cur_rw$levelcombo[[1]]), + function(lvl) { + if (!is(lvl, "AllLevelsSentinel")) + lvl <- make_comp_name(lvl, cur_ref_lab) + lvl + }, "") + } + cur_rw$comp_var <- comp_vars[ref_lvl_ind] + cur_rw$label <- new_nm + cur_rw + }) + + do.call(rbind.data.frame, rws_out) + }) + do.call(rbind.data.frame, rws) +} + + +apply_comp_map <- function(comp_vars, ref_lvls, comp_map, combo_map) { + function(ret, spl, fulldf, ...) { + + splvar <- comp_vars[1] + more_comp_vars <- comp_vars[-1] + all_lvls <- levels(fulldf[[splvar]]) + + if (is.null(comp_map)) { + comp_map <- make_dflt_comp_map(fulldf, splvar, ref_lvls, combo_map, comp_vars) + } + + lvls_to_keep <- levels_from_comp_map(comp_map, fulldf, ref_lvls, comp_vars, combo_map) + restrict_facets(lvls_to_keep, op = "keep")(ret, spl, fulldf) + } +} + + +one_comp_level <- function(act_lvl, comp_lvl, df, ref_lvls, comp_vars, active_is_combo) { + if (active_is_combo) + return(act_lvl) + spl_var <- comp_vars[1] + var_ind <- match(comp_lvl, ref_lvls) + + if (is.na(var_ind)) { + stop("Invalid comparison map: comparator value [", comp_lvl, + "] not among reference levels.") + } + + row_ind <- which(df[[spl_var]] == act_lvl)[1] + as.character(df[row_ind, comp_vars[var_ind], drop = TRUE]) +} + +levels_from_comp_map <- function(map, df, ref_lvls, comp_vars, combo_map) { + # combo_map <- expand_combo_map(combo_map, comp_vars, ref_lvls) + if (is.null(map$active_is_combo)) { + map$active_is_combo <- FALSE + } + + mapply(one_comp_level, act_lvl = map[[1]], comp_lvl = map[[2]], active_is_combo = map$active_is_combo, + MoreArgs = list(df = df, + ref_lvls = ref_lvls, + comp_vars = comp_vars)) +} + +#' @export +#' @rdname make_multicomp_splfun +make_dflt_comp_map <- function(df, spl_var, ref_lvls, combo_map, comp_vars) { + all_lvls <- as.character(levels(df[[spl_var]])) + + non_ref <- setdiff(all_lvls, ref_lvls) + base_rws <- lapply(ref_lvls, + function(ref_lvl_i) { + data.frame(active = non_ref, comparator = ref_lvl_i, active_is_combo = FALSE, comparator_is_combo = FALSE) + }) + + combo_rws <- combodf_to_comp_map(combo_map, comp_vars, ref_lvls, all_lvls) + ret <- do.call(rbind.data.frame, c(base_rws, list(combo_rws))) + + ret$tmp_fact <- factor(ret$comparator, levels = ref_lvls) + o <- order(ret$tmp_fact) + ret <- ret[o,] + ret$tmp_fact <- NULL + ret +} + +combodf_to_comp_map <- function(combodf, comp_vars, ref_lvls, all_base_lvls) { + nrcombo <- NROW(combodf) + if (nrcombo == 0) { + return(NULL) + } + + if (!("is_control" %in% names(combodf))) { + combodf$is_control <- combodf$valname %in% ref_lvls + } + + non_ref_lvls <- c(setdiff(all_base_lvls, ref_lvls), + combodf$valname[!combodf$is_control]) + if (!("compare_against" %in% names(combodf))) { + combodf$compare_against <- ifelse(combodf$is_control, + replicate(nrcombo, list(non_ref_lvls)), + replicate(nrcombo, list(ref_lvls))) + } + + + + if (any(combodf$is_control) && !all(combodf$valname[combodf$is_control] %in% ref_lvls)) { + stop( + "Combination levels [", + paste(combodf$valname[combodf$is_control], collapse = ", "), + "] were listed as control groups in the combination df but are ", + "missing from specified reference levels" + ) + } + + + + rws <- lapply(seq_len(nrcombo), + function(i) { + cur_rw <- combodf[i, ] + is_ctrl <- cur_rw$is_control + comp_against <- cur_rw$compare_against[[1]] + if (is(comp_against, "AllLevelsSentinel")) { + if (is_ctrl) { + comp_against <- non_ref_lvls + } else { + comp_against <- ref_lvls + } + } + if (is_ctrl) { + data.frame(active = comp_against, comparator = cur_rw$valname, active_is_combo = !(comp_against %in% all_base_lvls), comparator_is_combo = TRUE) + } else { + data.frame(active = cur_rw$valname, comparator = comp_against, active_is_combo = TRUE, comparator_is_combo = comp_against %in% combodf$valname) + } + }) + + ## if there are combinations acting as both active and reference + ## levels the comparisons between them will be duplicated + ret <- do.call(rbind.data.frame, rws) + dups <- duplicated(ret[, c("active", "comparator")]) + ret[!dups,] +} + + + + +#' Construct column structure with main and risk difference sections +#' +#' @param lyt (`PreDataTableLayouts`). The layout to modify. This +#' should virually always be the object returned by `basic_table`. +#' @param colspan_trt_map (`data.frame`). The spanning label map for +#' the main columns, as given by `create_colspan_map`. +#' @param combo_map_df (`data.frame` or `NULL`). A combination data +#' frame as defined by [add_combo_levels()] with an additional +#' `is_control` column indicating whether the virtual level will +#' act as a reference (`TRUE`) or active (`FALSE`) group. +#' @param comp_map (`data.frame` or `NULL`). A data.frame with columns +#' `"active"`, `"comparator"`, `"active_is_combo"` and +#' `"comparator_is_combo"`, or `NULL` indicating the default +#' comparison behavior (See Details). +#' @param comp_vars (`character` or `NULL`). The names of columns to +#' be used as comparator levels, or *if only one reference path is +#' given*, `NULL`. +#' +#' @param comp_lbl_vars (`character` or `NULL`). Names of columns to +#' be used as labels for comparator levels. Defaults to +#' `comp_vars`. +#' +#' @param ref_paths (`list` of `character`, `character` or +#' `NULL`). The path(s) to reference column(s) in the main portion +#' of the column structure, to be passed to `junco` analysis +#' functions such as [a_freq_j()]. If `NULL` (the default), +#' inferred from `colspan_trt_map` +#' @param rrisk_header (`character(1)`). The spanning label for the +#' risk difference section of columns +#' +#' @param .main_pre (`list` of `function`s). Passed to +#' [rtables::make_split_fun()] as `pre` for treatment split in main +#' structure. +#' @param .main_post (`list` of `function`s). Passed to +#' [rtables::make_split_fun()] as `post` for treatment split in +#' main structure. +#' @param .rr_pre (`list` of `function`s). Passed to +#' [make_multicomp_splfun()] as `.pre` for risk difference +#' faceting. +#' @param .rr_post (`list` of `function`s). Passed to +#' [make_multicomp_splfun()] as `.post` for risk difference +#' faceting. +#' +#' @details +#' +#' This function combines multiple `rtables` column splitting +#' instructions with customized split functions to create a column +#' structure with treatment columns for each treatment arm (optionally +#' including combination arms), grouped by active and non-active, with +#' risk difference columns comparing active arm(s) against one or more +#' non-active controls. It is intended for use in layouts that will +#' use [a_freq_j()] or similar `junco`-style analysis functions which +#' support risk difference columns and accept a `ref_path` argument. +#' +#' It is equivalent to the following sequence of layout instructions: +#' +#' 1. splitting on a colspan labeling variable with +#' [rtables::trim_levels_to_map()] as the split function; +#' 2. splitting on treatment; +#' 3. adding a (non-nested) overall column acting as the risk difference spanning label; and finally +#' 4. splitting on treatment using [make_multicomp_splfun()] as the +#' split function +#' +#' In addition, it supports: +#' +#' - comparison against multiple control groups (via `comp_vars`, see [make_multicomp_splfun()]), +#' - virtual combination-levels as active an/or control "treatments" (via `combo_map_df`), +#' - full control of which comparisons are performed, and their order (via `comp_map`). +#' +#' If only one control group is specified by `colspan_trt_map`, +#' `comp_vars` does not need to be set, as the treatment variable +#' (defined as the second column in `colspan_trt_map`) will be used +#' automatically. If more than one control group is specified, +#' `comp_vars` must be specified explicitly as it can no longer be +#' inferred from the map. +#' +#' If combination levels are declared via `combo_map_df` but none +#' appear in `colspan_trt_map`, all combinations will be added to the +#' appropriate group within the map based on `combo_map_df$is_control` +#' (assumed to be `FALSE` if the column is missing), with a warning. +#' +#' If some combination levels *do* apppear in `combo_map_df` but +#' others do not, a warning will be thrown but the missing combination +#' levels will *not* be added to the treatment map. +#' +#' By default (when `comp_map` is `NULL`), all active treatments, +#' including active combinations, will be compared against all control +#' groups. +#' +#' The risk difference section of the structure is declared using +#' [make_multicomp_splfun()]. Reference paths are inferred +#' automatically from `colspan_trt_map` (after combination levels have +#' been added if necessary). +#' +#' For the purposes of pathin in the resulting structure, +#' `rrisk_header` will be both the split name and split value of the +#' parent containing the individual risk difference columns. +#' +#' @returns `lyt` updated with the specified main and risk difference +#' column structures added +#' +#' +#' @family riskdiff_col_struct +#' @export + +col_struct_w_risk_diffs <- function(lyt, + colspan_trt_map, + comp_vars = NULL, + combo_map_df = NULL, + ## default behavior for comp_map is taken care of in make_multicomp_splfun + comp_map = NULL, + comp_lbl_vars = comp_vars, + rrisk_header = "Risk Differences", + .main_pre = list(), + .main_post = list(), + .rr_pre = list(), + .rr_post = list()) { + + trtvar <- names(colspan_trt_map)[2] + spanvar <- names(colspan_trt_map)[1] + + ## default behavior resolution and arg checking cascade: + ## 1. add combinations to colspan_trt_map if needed + ## 2. use colspan_trt_map to infer ref_paths + ## 3. use ref_paths to check for valid comp_vars + if (!is.null(combo_map_df)) { + if (!("is_control" %in% names(combo_map_df))) { + combo_map_df$is_control <- FALSE + } + main_post <- lapply(seq_len(NROW(combo_map_df)), + function(i) { + force(i) + add_combo_facet(name = combo_map_df$valname[i], + label = combo_map_df$label[i], + levels = combo_map_df$levelcombo[[i]], + extra = combo_map_df$exargs[[i]]) + }) + + combo_nms <- combo_map_df$valname + + ## we're guaranteed to have some combo levels at this point + combo_found <- combo_nms %in% colspan_trt_map[[trtvar]] + if (!any(combo_found)) { + warning("none of the combination levels appeared in the colspan treatment map", + " adding them automatically.") + colspan_trt_map <- add_combo_levs_to_trtmap(colspan_trt_map, combo_map_df) + + } else if (any(!combo_found)) { + warning("some combination levels defined in combo_map_df do not appear in colspan_trt_map") + } + } else { + main_post <- list() + } + + ctrl_span <- unique(colspan_trt_map[[spanvar]])[2] ## assume second is non-active + ctrl_vals <- colspan_trt_map[colspan_trt_map[[spanvar]] == ctrl_span, trtvar] + ref_paths <- lapply(ctrl_vals, + function(vl) c(spanvar, ctrl_span, trtvar, vl)) + + if (is.null(comp_vars) && + (length(ref_paths) == 1 || is.character(ref_paths))) { + comp_vars <- trtvar + } else if (is.null(comp_vars)) { + stop("comp_vars must be specified when more than one control group is specified in colspan_trt_map") + } + + + main_post <- c(main_post, .trtmap_to_post_funs(colspan_trt_map), .main_post) + + main_splfun <- make_split_fun(pre = .main_pre, post = main_post) + + rr_splfun <- make_multicomp_splfun(comp_vars, ref_paths, comp_level_map = comp_map, combo_levels_map = combo_map_df, .pre = .rr_pre, .post = .rr_post) + + + lyt <- lyt |> + split_cols_by(names(colspan_trt_map)[1]) |> + split_cols_by(trtvar, split_fun = main_splfun) |> + add_overall_col(label = rrisk_header) |> + split_cols_by(trtvar, split_fun = rr_splfun) + lyt +} + + +combos_to_trtmap_rows <- function(combo_map, trtmap_sect) { + ret <- data.frame(trtmap_sect[[1]][1], + combo_map$valname) + names(ret) <- names(trtmap_sect) + ret +} + + +add_combo_levs_to_trtmap <- function(trtmap, combo_map) { + span_vec <- trtmap[[1]] + spltrtmap <- split(trtmap, span_vec) + spanorder <- unique(span_vec) ## need this because split sorts things... like a clown. + activedf <- spltrtmap[[spanorder[1]]] + ctrldf <- spltrtmap[[spanorder[2]]] + + if (any(combo_map$is_control)) { + ctrldf <- rbind( + ctrldf, + combos_to_trtmap_rows(combo_map[combo_map$is_control,], ctrldf) + ) + } + + if (any(!combo_map$is_control)) { + activedf <- rbind( + activedf, + combos_to_trtmap_rows(combo_map[!combo_map$is_control, ], activedf) + ) + } + rbind(activedf, ctrldf) +} + + + +.trtmap_to_post_funs <- function(trtmap) { + splmap <- split(trtmap, trtmap[[1]]) + lapply(splmap, + .map_sect_to_post_fun) +} + +.map_sect_to_post_fun <- function(map) { + cond_rm_facets(map[[2]], value = unique(map[[1]]), keep_matches = TRUE) +} diff --git a/R/split_functions.R b/R/split_functions.R index 394c11e3..61d3634c 100644 --- a/R/split_functions.R +++ b/R/split_functions.R @@ -386,3 +386,38 @@ do_exclude_split <- function(exclude_levels, .spl_context) { } FALSE } + + + + +insert_subset_exprs <- function(partinfo, spl, comp_path = NULL) { + rvs <- rawvalues(partinfo$values) + names(rvs) <- names(partinfo$values) + exprs <- lapply(rvs, function(rvi) rtables:::make_subset_expr(spl, rvi)) + newvals <- mapply(function(val, expr) { + exvals <- rtables:::splv_extra(val) + if (!is.null(rtables:::value_expr(val)) && "ref_path" %in% names(exvals)) { + return(val) + } + ## XXX fix ASAP, export setter from rtables + val@subset_expression <- expr + rtables:::splv_extra(val) <- c(exvals, list(ref_path = comp_path)) + val + }, + val = partinfo$values, + expr = exprs, + SIMPLIFY = FALSE) + names(newvals) <- names(partinfo$values) + + names(exprs) <- names(rvs) + make_split_result( + ##names(partinfo$values), ## AllLevelsSentinel is not playing nice here but should be handled by expr + newvals, + partinfo$datasplit, + partinfo$labels#, +# subset_exprs = exprs, + ## extras = replicate(length(rvs), + ## list(ref_path = comp_path), + ## simplify = FALSE) + ) +} diff --git a/man/col_struct_w_risk_diffs.Rd b/man/col_struct_w_risk_diffs.Rd new file mode 100644 index 00000000..b7d0405c --- /dev/null +++ b/man/col_struct_w_risk_diffs.Rd @@ -0,0 +1,138 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/risk_diff_col_struct.R +\name{col_struct_w_risk_diffs} +\alias{col_struct_w_risk_diffs} +\title{Construct column structure with main and risk difference sections} +\usage{ +col_struct_w_risk_diffs( + lyt, + colspan_trt_map, + comp_vars = NULL, + combo_map_df = NULL, + comp_map = NULL, + comp_lbl_vars = comp_vars, + rrisk_header = "Risk Differences", + .main_pre = list(), + .main_post = list(), + .rr_pre = list(), + .rr_post = list() +) +} +\arguments{ +\item{lyt}{(\code{PreDataTableLayouts}). The layout to modify. This +should virually always be the object returned by \code{basic_table}.} + +\item{colspan_trt_map}{(\code{data.frame}). The spanning label map for +the main columns, as given by \code{create_colspan_map}.} + +\item{comp_vars}{(\code{character} or \code{NULL}). The names of columns to +be used as comparator levels, or \emph{if only one reference path is +given}, \code{NULL}.} + +\item{combo_map_df}{(\code{data.frame} or \code{NULL}). A combination data +frame as defined by \code{\link[rtables:add_overall_level]{rtables::add_combo_levels()}} with an additional +\code{is_control} column indicating whether the virtual level will +act as a reference (\code{TRUE}) or active (\code{FALSE}) group.} + +\item{comp_map}{(\code{data.frame} or \code{NULL}). A data.frame with columns +\code{"active"}, \code{"comparator"}, \code{"active_is_combo"} and +\code{"comparator_is_combo"}, or \code{NULL} indicating the default +comparison behavior (See Details).} + +\item{comp_lbl_vars}{(\code{character} or \code{NULL}). Names of columns to +be used as labels for comparator levels. Defaults to +\code{comp_vars}.} + +\item{rrisk_header}{(\code{character(1)}). The spanning label for the +risk difference section of columns} + +\item{.main_pre}{(\code{list} of \code{function}s). Passed to +\code{\link[rtables:make_split_fun]{rtables::make_split_fun()}} as \code{pre} for treatment split in main +structure.} + +\item{.main_post}{(\code{list} of \code{function}s). Passed to +\code{\link[rtables:make_split_fun]{rtables::make_split_fun()}} as \code{post} for treatment split in +main structure.} + +\item{.rr_pre}{(\code{list} of \code{function}s). Passed to +\code{\link[=make_multicomp_splfun]{make_multicomp_splfun()}} as \code{.pre} for risk difference +faceting.} + +\item{.rr_post}{(\code{list} of \code{function}s). Passed to +\code{\link[=make_multicomp_splfun]{make_multicomp_splfun()}} as \code{.post} for risk difference +faceting.} + +\item{ref_paths}{(\code{list} of \code{character}, \code{character} or +\code{NULL}). The path(s) to reference column(s) in the main portion +of the column structure, to be passed to \code{junco} analysis +functions such as \code{\link[=a_freq_j]{a_freq_j()}}. If \code{NULL} (the default), +inferred from \code{colspan_trt_map}} +} +\value{ +\code{lyt} updated with the specified main and risk difference +column structures added +} +\description{ +Construct column structure with main and risk difference sections +} +\details{ +This function combines multiple \code{rtables} column splitting +instructions with customized split functions to create a column +structure with treatment columns for each treatment arm (optionally +including combination arms), grouped by active and non-active, with +risk difference columns comparing active arm(s) against one or more +non-active controls. It is intended for use in layouts that will +use \code{\link[=a_freq_j]{a_freq_j()}} or similar \code{junco}-style analysis functions which +support risk difference columns and accept a \code{ref_path} argument. + +It is equivalent to the following sequence of layout instructions: +\enumerate{ +\item splitting on a colspan labeling variable with +\code{\link[rtables:trim_levels_to_map]{rtables::trim_levels_to_map()}} as the split function; +\item splitting on treatment; +\item adding a (non-nested) overall column acting as the risk difference spanning label; and finally +\item splitting on treatment using \code{\link[=make_multicomp_splfun]{make_multicomp_splfun()}} as the +split function +} + +In addition, it supports: +\itemize{ +\item comparison against multiple control groups (via \code{comp_vars}, see \code{\link[=make_multicomp_splfun]{make_multicomp_splfun()}}), +\item virtual combination-levels as active an/or control "treatments" (via \code{combo_map_df}), +\item full control of which comparisons are performed, and their order (via \code{comp_map}). +} + +If only one control group is specified by \code{colspan_trt_map}, +\code{comp_vars} does not need to be set, as the treatment variable +(defined as the second column in \code{colspan_trt_map}) will be used +automatically. If more than one control group is specified, +\code{comp_vars} must be specified explicitly as it can no longer be +inferred from the map. + +If combination levels are declared via \code{combo_map_df} but none +appear in \code{colspan_trt_map}, all combinations will be added to the +appropriate group within the map based on \code{combo_map_df$is_control} +(assumed to be \code{FALSE} if the column is missing), with a warning. + +If some combination levels \emph{do} apppear in \code{combo_map_df} but +others do not, a warning will be thrown but the missing combination +levels will \emph{not} be added to the treatment map. + +By default (when \code{comp_map} is \code{NULL}), all active treatments, +including active combinations, will be compared against all control +groups. + +The risk difference section of the structure is declared using +\code{\link[=make_multicomp_splfun]{make_multicomp_splfun()}}. Reference paths are inferred +automatically from \code{colspan_trt_map} (after combination levels have +been added if necessary). + +For the purposes of pathin in the resulting structure, +\code{rrisk_header} will be both the split name and split value of the +parent containing the individual risk difference columns. +} +\seealso{ +Other riskdiff_col_struct: +\code{\link{make_multicomp_splfun}()} +} +\concept{riskdiff_col_struct} diff --git a/man/make_multicomp_splfun.Rd b/man/make_multicomp_splfun.Rd new file mode 100644 index 00000000..7c963253 --- /dev/null +++ b/man/make_multicomp_splfun.Rd @@ -0,0 +1,132 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/risk_diff_col_struct.R +\name{make_multicomp_splfun} +\alias{make_multicomp_splfun} +\alias{make_dflt_comp_map} +\title{Make Multi-comparitor Split Function} +\usage{ +make_multicomp_splfun( + comp_vars, + comp_level_paths, + lbl_vars = rep(NA, length.out = length(comp_vars)), + combo_levels_map = NULL, + comp_level_map = NULL, + .pre = list(), + .post = list() +) + +make_dflt_comp_map(df, spl_var, ref_lvls, combo_map, comp_vars) +} +\arguments{ +\item{comp_vars}{\code{(character)}\cr A vector of one or more different +variables to provide the comparitors. The first value must be +the variable being split on.} + +\item{comp_level_paths}{\verb{(list of character vectors)}\cr A list of +comparator paths suitable for passing to e.g., \code{a_freq_j}'s +\code{ref_path} argument.} + +\item{lbl_vars}{\code{(character)}\cr A vector of label variables or +(\code{NA_character_} for no label variable) corresponding to each +of \code{comp_vars}.} + +\item{combo_levels_map}{\verb{(data.frame or NULL)}\cr NULL (the +default) or a data.frame indicating combination levels to added +to some or all blocks of comparisons. See Details.} + +\item{.pre}{\code{(list)}\cr A list of additional preprocessing +functions to be provided to \code{make_split_fun}. Defaults to +\code{list()}.} + +\item{.post}{\code{(list)}\cr A list of additional postprocessing +functions to be provided to \code{make_split_fun} \emph{after} those +which provide this function's primary multi-comparator +functionality. Defaults to \code{list()}} +} +\value{ +A split function suitable for use in both \code{split_rows_by} +and \code{split_cols_by}. +} +\description{ +Create a custom splitting function suitable for creating risk +difference columns against one or more comparators. This is used +within \code{col_struct_w_risk_diffs}. +} +\details{ +This split function is intended to create a set of risk difference +or similiar columns. As such it will automatically exclude the facet +for each comparator level (e.g., Placebo vs Placebo) as determined +by the last element of each element of \code{comp_level_paths}. + +Each variable in \code{comp_vars} must be unique \emph{and not have any +levels in common with any other comparator variables}. + +Further control of facets is provided by \code{comp_level_map}. If +\code{NULL} (the default), all non-control/reference groups will be +compared pairwise with all control/reference groups. + +If specified, \code{comp_level_map} must be a \code{data.frame} (including +\code{tbl_df}) with three columns: +\itemize{ +\item \code{active} - (character) the value to be compared to a reference level, +\item \code{comparator} - (character) the level that should be compared against, and +\item \code{is_combo_active} - (logical) is the level specified in \code{active} a virtual combination level. +} + +If a \code{data.frame} with only the \code{active} and \code{comparator} columns +is given for \code{comp_level_map}, \code{is_combo_active} is assumed as +\code{FALSE} for all rows. + +If any rows of \code{comp_level_map} have \code{is_combo_active == TRUE}, the +values of \code{active} in those rows \emph{must} also appear in +\code{combo_levels_map} with the correct level for comp_level (or \code{NA} +which indicates inclusion for all comparators). + +If specified, \code{combo_levels_map} must be a \code{data.frame} (including \code{tbl_df}) +with the following columns: +\itemize{ +\item \code{valname} - (\code{character}) The name(s) for the combination level(s), +\item \code{label} - (\code{character}) the label(s) for the combination level(s), +\item \code{levelcombo} - (\code{list} of \code{character}) the levels of the split +variable to be combined, or \code{select_all_levels} for all levels, +\item \code{exargs} - (\code{list}) the extra_args values for each combo level. If not +present this will be assumed to be \code{list()} for all combo levels. +\item \code{compare_against} - (\code{list} of \code{character}) Optional. The reference level(s) the +combo level should be compared against, or \code{select_all_levels} for +inclusion against all comparators. +\item \code{is_control} - (\code{logical}) Optional. Is this combination level going +to be used as a reference level (must appear as the last element in +one of \code{comp_level_paths} if so). +} + +When specifying \code{combo_levels_map} if the \code{compare_against} column +is ommitted, comparison against all reference levels will be +performed for all combination levels. If \code{is_control} is ommitted, +it will be assumed as \code{FALSE} for all combination levels. + +Order of combination levels when multiple are present for a single +comparator, as well as their position relative to non-combination +comparisons, is determined by row order in \code{combo_levels_map}. + +Labels (for the first reference level) and names (for the remaining +reference levels) of comparison columns involving combination +levels will be automatically computed in the form of +\code{" vs "} + +The comparator reference path (\code{comp_level_path} elements) are +added as \code{ref_path} to the extra_args associated with generated +facet. As such, analysis (or content) functions used underneath a +split using the generated split function must accept either +\code{ref_path} or \code{...}. +} +\note{ +It is not currently possible to use a virtual combination +level as a comparator/reference group. If you need this +functionality please contact the maintainers by filing an issue +at https://github.com/johnsonandjohnson/junco/issues +} +\seealso{ +Other riskdiff_col_struct: +\code{\link{col_struct_w_risk_diffs}()} +} +\concept{riskdiff_col_struct} diff --git a/tests/testthat/test-multcomp-rrisk.R b/tests/testthat/test-multcomp-rrisk.R new file mode 100644 index 00000000..bb97ce32 --- /dev/null +++ b/tests/testthat/test-multcomp-rrisk.R @@ -0,0 +1,193 @@ + +library(dplyr) +library(junco) +library(tibble) + + +adsl_jnj <- pharmaverseadamjnj::adsl + +adae_jnj <- pharmaverseadamjnj::adae + + + +fix_usubjid <- function(adsl) { + rws <- which(adsl$TRT01P == "Std Of Care") + + usubj_char <- as.character(adsl$USUBJID) + subjid <- as.integer(as.character(adsl$SUBJID)) + subjid[rws] <- subjid[rws] + 1000 + substr(usubj_char, 8, 11) <- as.character(subjid) + adsl$USUBJID <- factor(usubj_char) + adsl$SUBJID <- factor(as.character(subjid)) + adsl + +} + + + +make_fake_adsl <- function(adsl) { + fakeyfake <- filter(adsl, TRT01P == "Placebo") + fakeyfake$TRT01P <- "Std Of Care" + fakeyfake$AGE <- floor(runif(NROW(fakeyfake), 30, 90)) + adsl$TRT01P <- as.character(adsl$TRT01P) + adsl <- rbind(adsl, fakeyfake) + adsl$TRT01P <- factor(adsl$TRT01P) + + fix_usubjid(adsl) + } + + + +borrow_aes <- function(adae, adsl, mult = 1) { #runif(1, .9, 1.1)) { + plac_count <- sum(adae$TRT01P == "Placebo", na.rm = TRUE) + new_count <- floor(plac_count * mult) + soc_usubjids <- as.character(adsl$USUBJID)[!is.na(adsl$TRT01P) & adsl$TRT01P == "Std Of Care"] + + duprows <- sample(seq_len(NROW(adae)), new_count, replace = TRUE) + + newrws <- adae[duprows,] + print(c(new_count, length(duprows), length(unique(duprows)), NROW(newrws))) + newrws$USUBJID <- sample(soc_usubjids, NROW(newrws), replace = TRUE) + rbind(adae, newrws) +} + + + + + +trtvar <- "TRT01P" + +adsl <- adsl_jnj |> + # filter(!!rlang::sym(popfl) == "Y") |> + make_fake_adsl() |> + create_colspan_var( + non_active_grp = c("Placebo", "Std Of Care"), + non_active_grp_span_lbl = " ", + active_grp_span_lbl = "Active Study Agent", + colspan_var = "colspan_trt", + trt_var = trtvar + ) |> + mutate( + rrisk_header = "Risk Difference (%) (95% CI)", + rrisk_label = paste(!!rlang::sym(trtvar), "vs Placebo"), + rrisk_label2 = paste(!!rlang::sym(trtvar), "vs Std of Care") + ) |> + select( + USUBJID, + # !!rlang::sym(popfl), + !!rlang::sym(trtvar), + colspan_trt, + rrisk_header, + rrisk_label, + rrisk_label2 + ) + + + + +adae <- adae_jnj |> + filter(TRTEMFL == "Y") |> + borrow_aes(adsl) |> + select( + USUBJID, + AESER, + AESDTH, + AESLIFE, + AESHOSP, + AESDISAB, + AESCONG, + AESMIE, + AEACN_DECODE, + AESEV + ) |> + group_by(USUBJID) |> + mutate(maxsev = max(as.character(AESEV), na.rm = TRUE)) |> + ungroup() |> + mutate(maxsev = ifelse(is.na(maxsev), "Missing", maxsev)) |> + mutate( + maxsev = factor(maxsev, levels = c("Mild", "Moderate", "Severe", "Missing")) + ) + + +adae <- inner_join(adae, adsl, by = c("USUBJID"), multiple = "all") + +ctrl_grp <- c("Placebo", "Std Of Care") + +colspan_trt_map <- create_colspan_map( + adsl, + non_active_grp = ctrl_grp, + non_active_grp_span_lbl = " ", + active_grp_span_lbl = "Active Study Agent", + colspan_var = "colspan_trt", + trt_var = trtvar +) + +ref_paths <- lapply(ctrl_grp, function(ctrl) c("colspan_trt", " ", trtvar, ctrl)) + +rr_splitfun <- make_multicomp_splfun(c(trtvar, "rrisk_label2"), ref_paths) + +#debugonce(rr_splitfun) + +lvls <- levels(adsl[[trtvar]]) +combodf <- tribble(~valname, ~label, ~levelcombo, ~exargs, + "all_active", "All Active", lvls[3:4],list(), + "all_patients", "All Patients", select_all_levels, list()) + + +comp_map <- junco:::make_dflt_comp_map(adsl, trtvar, ctrl_grp, combodf, c(trtvar, "rrisk_label2")) + ## tribble(~active, ~comparator, ~is_combo_active, + ## "all_active", "Placebo", TRUE, + ## "all_active", "Std Of Care", TRUE, + ## "all_patients", "Placebo", TRUE, + ## "all_patients", "Std Of Care", TRUE)) + + +lyt_basic <- basic_table() |> + split_cols_by("rrisk_header") |> + split_cols_by("TRT01P", split_fun = add_combo_levels(combodf)) |> + analyze("TRT01P") + +build_table(lyt_basic, adsl) + + + + +lyt <- basic_table() |> + split_cols_by("colspan_trt", split_fun = trim_levels_to_map(colspan_trt_map)) |> + split_cols_by(trtvar, show_colcounts = TRUE) |> + split_cols_by("rrisk_header", nested = FALSE) |> + split_cols_by(trtvar, labels_var = "rrisk_label", split_fun = rr_splitfun) |> + analyze("AESDTH", afun = function(x, ...) rcell("-")) + +build_table(lyt, adae, adsl) + +rr_splitfun2 <- make_multicomp_splfun(c(trtvar, "rrisk_label2"), ref_paths, comp_level_map = comp_map, combo_levels_map = combodf) + + +lyt <- basic_table() |> + split_cols_by("colspan_trt", split_fun = trim_levels_to_map(colspan_trt_map)) |> + split_cols_by(trtvar, show_colcounts = TRUE, split_fun = add_combo_levels(combodf)) |> + split_cols_by("rrisk_header", nested = FALSE) |> + split_cols_by(trtvar, labels_var = "rrisk_label", split_fun = rr_splitfun2) |> + analyze("AESDTH", afun = function(x, ref_path = NULL, ...) rcell(paste(ref_path, collapse = "."))) + +build_table(lyt, adae, adsl) + +lyt <- basic_table() |> + col_struct_w_risk_diffs(colspan_trt_map, + combodf, + comp_map, + comp_vars = c(trtvar, "rrisk_label2")) |> + analyze("AESDTH", afun = function(x, ref_path = NULL, ...) rcell(paste(ref_path, collapse = "."))) + +tbl <- build_table(lyt, adae, adsl) + + +lyt <- basic_table() |> + col_struct_w_risk_diffs(colspan_trt_map, + combo_map_df = NULL, + comp_map = NULL, + comp_vars = c(trtvar, "rrisk_label2")) |> + analyze("AESDTH", afun = function(x, ref_path = NULL, ...) rcell(paste(ref_path, collapse = "."))) + +tbl <- build_table(lyt, adae, adsl) From 3c2e245f73dfe3a7d047920719c52657484d24ea Mon Sep 17 00:00:00 2001 From: munoztd0 Date: Thu, 16 Apr 2026 16:34:35 +0200 Subject: [PATCH 2/5] update: WORDLIST and lintr --- NEWS.md | 1 + R/risk_diff_col_struct.R | 440 +++++++++++++++------------ R/split_functions.R | 32 +- inst/WORDLIST | 19 +- man/col_struct_w_risk_diffs.Rd | 6 +- man/make_multicomp_splfun.Rd | 12 +- tests/testthat/test-multcomp-rrisk.R | 123 ++++---- 7 files changed, 356 insertions(+), 277 deletions(-) diff --git a/NEWS.md b/NEWS.md index 0841eb9b..68541eb3 100644 --- a/NEWS.md +++ b/NEWS.md @@ -35,6 +35,7 @@ ### Added +- Added multi-comparator functionality (#271) - Added option to switch on/off the export of the csv in both `tt_to_tlgrtf()` and `export_as_docx_j()` - Added option to specify the output folder for the csv - Added argument 'validate' to `export_TLG_as_docx()` and `tt_to_flextable_j()` (#213) diff --git a/R/risk_diff_col_struct.R b/R/risk_diff_col_struct.R index 4ae52e40..2249e5f4 100644 --- a/R/risk_diff_col_struct.R +++ b/R/risk_diff_col_struct.R @@ -1,6 +1,5 @@ add_sib_facets <- function(add_spl_var, add_lbl_var = add_spl_var, comp_path = NULL, combo_map_all) { function(ret, spl, .spl_context, fulldf) { - combo_map <- NULL if (!is.null(combo_map_all)) { combo_map <- combo_map_all[combo_map_all$comp_var == add_spl_var, ] @@ -10,37 +9,47 @@ add_sib_facets <- function(add_spl_var, add_lbl_var = add_spl_var, comp_path = N out <- ret } else { exargs <- list() - if (!is.null(comp_path)) + if (!is.null(comp_path)) { exargs$ref_path <- comp_path - spl2 <- VarLevelSplit(var = add_spl_var, split_label = "new thang", labels_var = add_lbl_var, extra_args = list(exargs)) + } + spl2 <- VarLevelSplit( + var = add_spl_var, + split_label = "new thang", + labels_var = add_lbl_var, + extra_args = list(exargs) + ) ret2 <- do_base_split(spl2, fulldf) if (NROW(combo_map) > 0) { - for (i in seq_len(NROW(combo_map))) { - ret2 <- add_combo_facet(combo_map$valname[i], - combo_map$label[i], - combo_map$levelcombo[[i]], - combo_map$exargs[[i]])( - ret = ret2, - spl = spl2, - .spl_context = .spl_context, - fulldf = fulldf - ) + for (i in seq_len(NROW(combo_map))) { + ret2 <- add_combo_facet( + combo_map$valname[i], + combo_map$label[i], + combo_map$levelcombo[[i]], + combo_map$exargs[[i]] + )( + ret = ret2, + spl = spl2, + .spl_context = .spl_context, + fulldf = fulldf + ) } } -# browser() + ret2 <- insert_subset_exprs(ret2, spl2, comp_path = comp_path) if (identical(add_spl_var, spl_variable(spl))) { - ## if we're in the split variable case only add the new combo facets - cmbo_inds <- match(combo_map$valname, names(ret2$values)) - ret2 <- lapply(ret2, function(lsti) lsti[cmbo_inds]) - names(ret2) <- names(ret) + ## if we're in the split variable case only add the new combo facets + cmbo_inds <- match(combo_map$valname, names(ret2$values)) + ret2 <- lapply(ret2, function(lsti) lsti[cmbo_inds]) + names(ret2) <- names(ret) } - + if (any(names(ret2[[1]]) %in% names(ret[[1]]))) { - stop("add_spl_var variable cannot have levels matching any ", - "existing levels in the split. Try creating a new dummy ", - "variable that is a one to one mapping to the split ", - "variable if desired.") + stop( + "add_spl_var variable cannot have levels matching any ", + "existing levels in the split. Try creating a new dummy ", + "variable that is a one to one mapping to the split ", + "variable if desired." + ) } out <- lapply(names(ret), function(nm) c(ret[[nm]], ret2[[nm]])) @@ -51,14 +60,14 @@ add_sib_facets <- function(add_spl_var, add_lbl_var = add_spl_var, comp_path = N } -#' Make Multi-comparitor Split Function +#' Make Multi-comparator Split Function #' #' Create a custom splitting function suitable for creating risk #' difference columns against one or more comparators. This is used #' within `col_struct_w_risk_diffs`. #' #' @param comp_vars `(character)`\cr A vector of one or more different -#' variables to provide the comparitors. The first value must be +#' variables to provide the comparators. The first value must be #' the variable being split on. #' #' @param comp_level_paths `(list of character vectors)`\cr A list of @@ -72,12 +81,12 @@ add_sib_facets <- function(add_spl_var, add_lbl_var = add_spl_var, comp_path = N #' @param combo_levels_map `(data.frame or NULL)`\cr NULL (the #' default) or a data.frame indicating combination levels to added #' to some or all blocks of comparisons. See Details. -#' +#' #' @param .pre `(list)`\cr A list of additional preprocessing #' functions to be provided to `make_split_fun`. Defaults to #' `list()`. #' -#' @param .post `(list)`\cr A list of additional postprocessing +#' @param .post `(list)`\cr A list of additional post-processing #' functions to be provided to `make_split_fun` *after* those #' which provide this function's primary multi-comparator #' functionality. Defaults to `list()` @@ -87,7 +96,7 @@ add_sib_facets <- function(add_spl_var, add_lbl_var = add_spl_var, comp_path = N #' #' @details #' This split function is intended to create a set of risk difference -#' or similiar columns. As such it will automatically exclude the facet +#' or similar columns. As such it will automatically exclude the facet #' for each comparator level (e.g., Placebo vs Placebo) as determined #' by the last element of each element of `comp_level_paths`. #' @@ -131,8 +140,8 @@ add_sib_facets <- function(add_spl_var, add_lbl_var = add_spl_var, comp_path = N #' one of `comp_level_paths` if so). #' #' When specifying `combo_levels_map` if the `compare_against` column -#' is ommitted, comparison against all reference levels will be -#' performed for all combination levels. If `is_control` is ommitted, +#' is omitted, comparison against all reference levels will be +#' performed for all combination levels. If `is_control` is omitted, #' it will be assumed as `FALSE` for all combination levels. #' #' Order of combination levels when multiple are present for a single @@ -157,21 +166,21 @@ add_sib_facets <- function(add_spl_var, add_lbl_var = add_spl_var, comp_path = N #' at https://github.com/johnsonandjohnson/junco/issues #' #' @family riskdiff_col_struct -#' -#'@export +#' +#' @export make_multicomp_splfun <- function(comp_vars, comp_level_paths, lbl_vars = rep(NA, - length.out = length(comp_vars)), + length.out = length(comp_vars) + ), combo_levels_map = NULL, comp_level_map = NULL, .pre = list(), .post = list()) { - nvars <- length(comp_vars) if (length(comp_level_paths) != nvars || - length(lbl_vars) != nvars || - length(comp_level_paths) != nvars) { + length(lbl_vars) != nvars || + length(comp_level_paths) != nvars) { stop( "Lengths of arguments do not all match:\n[", "comp_vars:", nvars, @@ -181,15 +190,16 @@ make_multicomp_splfun <- function(comp_vars, ) } - + post <- c(.post) - comp_levels <- vapply(comp_level_paths, function(pth) tail(pth, 1), "") - if (!is.null(combo_levels_map)) { - comp_level_map <- fix_combo_comp_levels(comp_level_map, - combo_levels_map, - ref_lvls = comp_levels) - combo_levels_map <- expand_combo_map(combo_levels_map, comp_vars, ref_lvls = comp_levels) - } + comp_levels <- vapply(comp_level_paths, function(pth) tail(pth, 1), "") + if (!is.null(combo_levels_map)) { + comp_level_map <- fix_combo_comp_levels(comp_level_map, + combo_levels_map, + ref_lvls = comp_levels + ) + combo_levels_map <- expand_combo_map(combo_levels_map, comp_vars, ref_lvls = comp_levels) + } lbl_vars[is.na(lbl_vars)] <- comp_vars[is.na(lbl_vars)] @@ -197,18 +207,27 @@ make_multicomp_splfun <- function(comp_vars, seq_along(comp_vars), function(i) { function(ret, spl, .spl_context, fulldf) { - callstuff <<- list(ret = ret, spl = spl, spl_context = .spl_context, fulldf = fulldf) - sib_fac_fun <- add_sib_facets(comp_vars[i], lbl_vars[i], comp_path = comp_level_paths[[i]], combo_map_all = combo_levels_map) - one_sib_fac_fun <<- sib_fac_fun - sib_fac_fun(ret, spl, .spl_context, fulldf) + callstuff <<- list(ret = ret, spl = spl, spl_context = .spl_context, fulldf = fulldf) + sib_fac_fun <- add_sib_facets( + comp_vars[i], + lbl_vars[i], + comp_path = comp_level_paths[[i]], + combo_map_all = combo_levels_map + ) + one_sib_fac_fun <<- sib_fac_fun + sib_fac_fun(ret, spl, .spl_context, fulldf) } } ) - make_split_fun(pre = .pre, - post = c(funlst, - apply_comp_map(comp_vars, comp_levels, comp_map = comp_level_map, combo_map = combo_levels_map), - post)) + make_split_fun( + pre = .pre, + post = c( + funlst, + apply_comp_map(comp_vars, comp_levels, comp_map = comp_level_map, combo_map = combo_levels_map), + post + ) + ) } @@ -217,105 +236,119 @@ make_comp_name <- function(act_nm, comp_nm) paste0(act_nm, " vs ", comp_nm) ## must be called ***before*** expand_combo_map so the old ## valnames are still there fix_combo_comp_levels <- function(comp_map, combo_map, ref_lvls, ref_labs = ref_lvls) { - if(NROW(combo_map) == 0) - return(comp_map) - comp_inds <- which(comp_map$active_is_combo) - comp_map$active[comp_inds] <- vapply(comp_inds, function(ii) { - comp_rw <- comp_map[ii,] - combo_ind <- match(comp_rw$active, combo_map$valname) - make_comp_name(combo_map$label[combo_ind], ref_labs[match(comp_rw$comparator, ref_lvls)[1]]) - }, "") - comp_map + if (NROW(combo_map) == 0) { + return(comp_map) + } + comp_inds <- which(comp_map$active_is_combo) + comp_map$active[comp_inds] <- vapply(comp_inds, function(ii) { + comp_rw <- comp_map[ii, ] + combo_ind <- match(comp_rw$active, combo_map$valname) + make_comp_name(combo_map$label[combo_ind], ref_labs[match(comp_rw$comparator, ref_lvls)[1]]) + }, "") + comp_map } expand_combo_map <- function(combo_map, comp_vars, ref_lvls, ref_labs = ref_lvls) { - if (NROW(combo_map) == 0) { return(combo_map) } - + if (!("compare_against" %in% names(combo_map))) { combo_map$compare_against <- lapply(seq_len(NROW(combo_map)), function(i) select_all_levels) } - rws <- lapply(seq_len(NROW(combo_map)), - function(ii) { - first_ref <- ref_lvls[1] - remaining_refs <- ref_lvls[-1] - mp_rw <- combo_map[ii, ] - comp_against <- mp_rw$compare_against[[1]] - if (is.null(comp_against) || is(comp_against, "AllLevelsSentinel")) - comp_against <- ref_lvls - - - rws_out <- lapply(comp_against, - function(cur_ref_lvl) { - ref_lvl_ind <- match(cur_ref_lvl, ref_lvls) - cur_ref_lab <- ref_labs[ref_lvl_ind] - cur_rw <- combo_map[ii, ] ## AllLvlsSentinel class getting dropped from map_rw somehow... - new_nm <- make_comp_name(mp_rw$label, cur_ref_lab) - cur_rw$valname <- new_nm - if (!is(cur_rw$levelcombo[[1]], "AllLevelsSentinel")) { - cur_rw$levelcombo[[1]] <- vapply(as.character(cur_rw$levelcombo[[1]]), - function(lvl) { - if (!is(lvl, "AllLevelsSentinel")) - lvl <- make_comp_name(lvl, cur_ref_lab) + rws <- lapply( + seq_len(NROW(combo_map)), + function(ii) { + first_ref <- ref_lvls[1] + remaining_refs <- ref_lvls[-1] + mp_rw <- combo_map[ii, ] + comp_against <- mp_rw$compare_against[[1]] + if (is.null(comp_against) || is(comp_against, "AllLevelsSentinel")) { + comp_against <- ref_lvls + } + + + rws_out <- lapply( + comp_against, + function(cur_ref_lvl) { + ref_lvl_ind <- match(cur_ref_lvl, ref_lvls) + cur_ref_lab <- ref_labs[ref_lvl_ind] + cur_rw <- combo_map[ii, ] ## AllLvlsSentinel class getting dropped from map_rw somehow... + new_nm <- make_comp_name(mp_rw$label, cur_ref_lab) + cur_rw$valname <- new_nm + if (!is(cur_rw$levelcombo[[1]], "AllLevelsSentinel")) { + cur_rw$levelcombo[[1]] <- vapply( + as.character(cur_rw$levelcombo[[1]]), + function(lvl) { + if (!is(lvl, "AllLevelsSentinel")) { + lvl <- make_comp_name(lvl, cur_ref_lab) + } lvl - }, "") + }, "" + ) + } + cur_rw$comp_var <- comp_vars[ref_lvl_ind] + cur_rw$label <- new_nm + cur_rw } - cur_rw$comp_var <- comp_vars[ref_lvl_ind] - cur_rw$label <- new_nm - cur_rw - }) - - do.call(rbind.data.frame, rws_out) - }) + ) + + do.call(rbind.data.frame, rws_out) + } + ) do.call(rbind.data.frame, rws) } apply_comp_map <- function(comp_vars, ref_lvls, comp_map, combo_map) { - function(ret, spl, fulldf, ...) { + function(ret, spl, fulldf, ...) { + splvar <- comp_vars[1] + more_comp_vars <- comp_vars[-1] + all_lvls <- levels(fulldf[[splvar]]) - splvar <- comp_vars[1] - more_comp_vars <- comp_vars[-1] - all_lvls <- levels(fulldf[[splvar]]) - - if (is.null(comp_map)) { - comp_map <- make_dflt_comp_map(fulldf, splvar, ref_lvls, combo_map, comp_vars) - } - - lvls_to_keep <- levels_from_comp_map(comp_map, fulldf, ref_lvls, comp_vars, combo_map) - restrict_facets(lvls_to_keep, op = "keep")(ret, spl, fulldf) + if (is.null(comp_map)) { + comp_map <- make_dflt_comp_map(fulldf, splvar, ref_lvls, combo_map, comp_vars) } + + lvls_to_keep <- levels_from_comp_map(comp_map, fulldf, ref_lvls, comp_vars, combo_map) + restrict_facets(lvls_to_keep, op = "keep")(ret, spl, fulldf) + } } one_comp_level <- function(act_lvl, comp_lvl, df, ref_lvls, comp_vars, active_is_combo) { - if (active_is_combo) - return(act_lvl) - spl_var <- comp_vars[1] - var_ind <- match(comp_lvl, ref_lvls) - - if (is.na(var_ind)) { - stop("Invalid comparison map: comparator value [", comp_lvl, - "] not among reference levels.") - } + if (active_is_combo) { + return(act_lvl) + } + spl_var <- comp_vars[1] + var_ind <- match(comp_lvl, ref_lvls) - row_ind <- which(df[[spl_var]] == act_lvl)[1] - as.character(df[row_ind, comp_vars[var_ind], drop = TRUE]) + if (is.na(var_ind)) { + stop( + "Invalid comparison map: comparator value [", comp_lvl, + "] not among reference levels." + ) + } + + row_ind <- which(df[[spl_var]] == act_lvl)[1] + as.character(df[row_ind, comp_vars[var_ind], drop = TRUE]) } levels_from_comp_map <- function(map, df, ref_lvls, comp_vars, combo_map) { - # combo_map <- expand_combo_map(combo_map, comp_vars, ref_lvls) + # combo_map <- expand_combo_map(combo_map, comp_vars, ref_lvls) if (is.null(map$active_is_combo)) { map$active_is_combo <- FALSE } - mapply(one_comp_level, act_lvl = map[[1]], comp_lvl = map[[2]], active_is_combo = map$active_is_combo, - MoreArgs = list(df = df, - ref_lvls = ref_lvls, - comp_vars = comp_vars)) + mapply(one_comp_level, + act_lvl = map[[1]], comp_lvl = map[[2]], active_is_combo = map$active_is_combo, + MoreArgs = list( + df = df, + ref_lvls = ref_lvls, + comp_vars = comp_vars + ) + ) } #' @export @@ -324,17 +357,19 @@ make_dflt_comp_map <- function(df, spl_var, ref_lvls, combo_map, comp_vars) { all_lvls <- as.character(levels(df[[spl_var]])) non_ref <- setdiff(all_lvls, ref_lvls) - base_rws <- lapply(ref_lvls, - function(ref_lvl_i) { + base_rws <- lapply( + ref_lvls, + function(ref_lvl_i) { data.frame(active = non_ref, comparator = ref_lvl_i, active_is_combo = FALSE, comparator_is_combo = FALSE) - }) + } + ) combo_rws <- combodf_to_comp_map(combo_map, comp_vars, ref_lvls, all_lvls) ret <- do.call(rbind.data.frame, c(base_rws, list(combo_rws))) ret$tmp_fact <- factor(ret$comparator, levels = ref_lvls) o <- order(ret$tmp_fact) - ret <- ret[o,] + ret <- ret[o, ] ret$tmp_fact <- NULL ret } @@ -349,16 +384,18 @@ combodf_to_comp_map <- function(combodf, comp_vars, ref_lvls, all_base_lvls) { combodf$is_control <- combodf$valname %in% ref_lvls } - non_ref_lvls <- c(setdiff(all_base_lvls, ref_lvls), - combodf$valname[!combodf$is_control]) + non_ref_lvls <- c( + setdiff(all_base_lvls, ref_lvls), + combodf$valname[!combodf$is_control] + ) if (!("compare_against" %in% names(combodf))) { combodf$compare_against <- ifelse(combodf$is_control, - replicate(nrcombo, list(non_ref_lvls)), - replicate(nrcombo, list(ref_lvls))) + replicate(nrcombo, list(non_ref_lvls)), + replicate(nrcombo, list(ref_lvls)) + ) } - if (any(combodf$is_control) && !all(combodf$valname[combodf$is_control] %in% ref_lvls)) { stop( "Combination levels [", @@ -369,9 +406,9 @@ combodf_to_comp_map <- function(combodf, comp_vars, ref_lvls, all_base_lvls) { } - - rws <- lapply(seq_len(nrcombo), - function(i) { + rws <- lapply( + seq_len(nrcombo), + function(i) { cur_rw <- combodf[i, ] is_ctrl <- cur_rw$is_control comp_against <- cur_rw$compare_against[[1]] @@ -383,26 +420,35 @@ combodf_to_comp_map <- function(combodf, comp_vars, ref_lvls, all_base_lvls) { } } if (is_ctrl) { - data.frame(active = comp_against, comparator = cur_rw$valname, active_is_combo = !(comp_against %in% all_base_lvls), comparator_is_combo = TRUE) + data.frame( + active = comp_against, + comparator = cur_rw$valname, + active_is_combo = !(comp_against %in% all_base_lvls), + comparator_is_combo = TRUE + ) } else { - data.frame(active = cur_rw$valname, comparator = comp_against, active_is_combo = TRUE, comparator_is_combo = comp_against %in% combodf$valname) + data.frame( + active = cur_rw$valname, + comparator = comp_against, + active_is_combo = TRUE, + comparator_is_combo = comp_against %in% combodf$valname + ) } - }) + } + ) ## if there are combinations acting as both active and reference ## levels the comparisons between them will be duplicated ret <- do.call(rbind.data.frame, rws) dups <- duplicated(ret[, c("active", "comparator")]) - ret[!dups,] + ret[!dups, ] } - - #' Construct column structure with main and risk difference sections #' #' @param lyt (`PreDataTableLayouts`). The layout to modify. This -#' should virually always be the object returned by `basic_table`. +#' should virtually always be the object returned by `basic_table`. #' @param colspan_trt_map (`data.frame`). The spanning label map for #' the main columns, as given by `create_colspan_map`. #' @param combo_map_df (`data.frame` or `NULL`). A combination data @@ -480,7 +526,7 @@ combodf_to_comp_map <- function(combodf, comp_vars, ref_lvls, all_base_lvls) { #' appropriate group within the map based on `combo_map_df$is_control` #' (assumed to be `FALSE` if the column is missing), with a warning. #' -#' If some combination levels *do* apppear in `combo_map_df` but +#' If some combination levels *do* appear in `combo_map_df` but #' others do not, a warning will be thrown but the missing combination #' levels will *not* be added to the treatment map. #' @@ -496,11 +542,11 @@ combodf_to_comp_map <- function(combodf, comp_vars, ref_lvls, all_base_lvls) { #' For the purposes of pathin in the resulting structure, #' `rrisk_header` will be both the split name and split value of the #' parent containing the individual risk difference columns. -#' +#' #' @returns `lyt` updated with the specified main and risk difference #' column structures added #' -#' +#' #' @family riskdiff_col_struct #' @export @@ -516,38 +562,42 @@ col_struct_w_risk_diffs <- function(lyt, .main_post = list(), .rr_pre = list(), .rr_post = list()) { - trtvar <- names(colspan_trt_map)[2] - spanvar <- names(colspan_trt_map)[1] + spanvar <- names(colspan_trt_map)[1] ## default behavior resolution and arg checking cascade: ## 1. add combinations to colspan_trt_map if needed ## 2. use colspan_trt_map to infer ref_paths - ## 3. use ref_paths to check for valid comp_vars + ## 3. use ref_paths to check for valid comp_vars if (!is.null(combo_map_df)) { if (!("is_control" %in% names(combo_map_df))) { combo_map_df$is_control <- FALSE } - main_post <- lapply(seq_len(NROW(combo_map_df)), - function(i) { - force(i) - add_combo_facet(name = combo_map_df$valname[i], - label = combo_map_df$label[i], - levels = combo_map_df$levelcombo[[i]], - extra = combo_map_df$exargs[[i]]) - }) + main_post <- lapply( + seq_len(NROW(combo_map_df)), + function(i) { + force(i) + add_combo_facet( + name = combo_map_df$valname[i], + label = combo_map_df$label[i], + levels = combo_map_df$levelcombo[[i]], + extra = combo_map_df$exargs[[i]] + ) + } + ) combo_nms <- combo_map_df$valname ## we're guaranteed to have some combo levels at this point combo_found <- combo_nms %in% colspan_trt_map[[trtvar]] if (!any(combo_found)) { - warning("none of the combination levels appeared in the colspan treatment map", - " adding them automatically.") + warning( + "none of the combination levels appeared in the colspan treatment map", + " adding them automatically." + ) colspan_trt_map <- add_combo_levs_to_trtmap(colspan_trt_map, combo_map_df) - } else if (any(!combo_found)) { - warning("some combination levels defined in combo_map_df do not appear in colspan_trt_map") + warning("some combination levels defined in combo_map_df do not appear in colspan_trt_map") } } else { main_post <- list() @@ -555,70 +605,82 @@ col_struct_w_risk_diffs <- function(lyt, ctrl_span <- unique(colspan_trt_map[[spanvar]])[2] ## assume second is non-active ctrl_vals <- colspan_trt_map[colspan_trt_map[[spanvar]] == ctrl_span, trtvar] - ref_paths <- lapply(ctrl_vals, - function(vl) c(spanvar, ctrl_span, trtvar, vl)) + ref_paths <- lapply( + ctrl_vals, + function(vl) c(spanvar, ctrl_span, trtvar, vl) + ) if (is.null(comp_vars) && - (length(ref_paths) == 1 || is.character(ref_paths))) { + (length(ref_paths) == 1 || is.character(ref_paths))) { comp_vars <- trtvar } else if (is.null(comp_vars)) { stop("comp_vars must be specified when more than one control group is specified in colspan_trt_map") } - + main_post <- c(main_post, .trtmap_to_post_funs(colspan_trt_map), .main_post) main_splfun <- make_split_fun(pre = .main_pre, post = main_post) - rr_splfun <- make_multicomp_splfun(comp_vars, ref_paths, comp_level_map = comp_map, combo_levels_map = combo_map_df, .pre = .rr_pre, .post = .rr_post) + rr_splfun <- make_multicomp_splfun( + comp_vars, + ref_paths, + comp_level_map = comp_map, + combo_levels_map = combo_map_df, + .pre = .rr_pre, + post = .rr_post + ) + - lyt <- lyt |> split_cols_by(names(colspan_trt_map)[1]) |> - split_cols_by(trtvar, split_fun = main_splfun) |> - add_overall_col(label = rrisk_header) |> - split_cols_by(trtvar, split_fun = rr_splfun) + split_cols_by(trtvar, split_fun = main_splfun) |> + add_overall_col(label = rrisk_header) |> + split_cols_by(trtvar, split_fun = rr_splfun) lyt } combos_to_trtmap_rows <- function(combo_map, trtmap_sect) { - ret <- data.frame(trtmap_sect[[1]][1], - combo_map$valname) + ret <- data.frame( + trtmap_sect[[1]][1], + combo_map$valname + ) names(ret) <- names(trtmap_sect) ret } add_combo_levs_to_trtmap <- function(trtmap, combo_map) { - span_vec <- trtmap[[1]] - spltrtmap <- split(trtmap, span_vec) - spanorder <- unique(span_vec) ## need this because split sorts things... like a clown. - activedf <- spltrtmap[[spanorder[1]]] - ctrldf <- spltrtmap[[spanorder[2]]] - - if (any(combo_map$is_control)) { - ctrldf <- rbind( - ctrldf, - combos_to_trtmap_rows(combo_map[combo_map$is_control,], ctrldf) - ) - } + span_vec <- trtmap[[1]] + spltrtmap <- split(trtmap, span_vec) + spanorder <- unique(span_vec) ## need this because split sorts things... like a clown. + activedf <- spltrtmap[[spanorder[1]]] + ctrldf <- spltrtmap[[spanorder[2]]] + + if (any(combo_map$is_control)) { + ctrldf <- rbind( + ctrldf, + combos_to_trtmap_rows(combo_map[combo_map$is_control, ], ctrldf) + ) + } - if (any(!combo_map$is_control)) { - activedf <- rbind( - activedf, - combos_to_trtmap_rows(combo_map[!combo_map$is_control, ], activedf) - ) - } + if (any(!combo_map$is_control)) { + activedf <- rbind( + activedf, + combos_to_trtmap_rows(combo_map[!combo_map$is_control, ], activedf) + ) + } rbind(activedf, ctrldf) } - .trtmap_to_post_funs <- function(trtmap) { splmap <- split(trtmap, trtmap[[1]]) - lapply(splmap, - .map_sect_to_post_fun) + lapply( + splmap, + .map_sect_to_post_fun + ) } .map_sect_to_post_fun <- function(map) { diff --git a/R/split_functions.R b/R/split_functions.R index 61d3634c..fc1a092d 100644 --- a/R/split_functions.R +++ b/R/split_functions.R @@ -392,32 +392,32 @@ do_exclude_split <- function(exclude_levels, .spl_context) { insert_subset_exprs <- function(partinfo, spl, comp_path = NULL) { rvs <- rawvalues(partinfo$values) - names(rvs) <- names(partinfo$values) + names(rvs) <- names(partinfo$values) exprs <- lapply(rvs, function(rvi) rtables:::make_subset_expr(spl, rvi)) newvals <- mapply(function(val, expr) { - exvals <- rtables:::splv_extra(val) - if (!is.null(rtables:::value_expr(val)) && "ref_path" %in% names(exvals)) { - return(val) - } - ## XXX fix ASAP, export setter from rtables - val@subset_expression <- expr - rtables:::splv_extra(val) <- c(exvals, list(ref_path = comp_path)) - val + exvals <- rtables:::splv_extra(val) + if (!is.null(rtables:::value_expr(val)) && "ref_path" %in% names(exvals)) { + return(val) + } + ## XXX fix ASAP, export setter from rtables + val@subset_expression <- expr + rtables:::splv_extra(val) <- c(exvals, list(ref_path = comp_path)) + val }, val = partinfo$values, expr = exprs, SIMPLIFY = FALSE) names(newvals) <- names(partinfo$values) - + names(exprs) <- names(rvs) make_split_result( - ##names(partinfo$values), ## AllLevelsSentinel is not playing nice here but should be handled by expr - newvals, + ## names(partinfo$values), ## AllLevelsSentinel is not playing nice here but should be handled by expr + newvals, partinfo$datasplit, - partinfo$labels#, -# subset_exprs = exprs, + partinfo$labels + ## subset_exprs = exprs, ## extras = replicate(length(rvs), - ## list(ref_path = comp_path), - ## simplify = FALSE) + ## list(ref_path = comp_path), + ## simplify = FALSE) ) } diff --git a/inst/WORDLIST b/inst/WORDLIST index b930e06c..15a136d1 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -1,3 +1,7 @@ +2b +3d +5D +A1 ADSL AE AEBODSYS @@ -23,12 +27,15 @@ Lapply MMRM Miettinen Nurminen -Optimality PARAMCD PCTLDEF Parallelisation Parallelise +Q1 +Q2 +Q3 RBMI +RESP01 RTF Sato TEFOS @@ -50,6 +57,7 @@ analyse analysing ancova approxbayes +args bayes bugfix chisq @@ -87,6 +95,7 @@ fn formatters gentlg ggplot +ggplot2 github goto grepl @@ -98,6 +107,7 @@ iec insightsengineering jj jjcsformat +johnsonandjohnson keeprowtext lastcat lsm @@ -116,6 +126,7 @@ parallelisation parallelise parallelising parentdf +pathin pkgdown plotheight plotwidth @@ -166,3 +177,9 @@ unrounded unstratified wordbreaking xlsx +riskdiff +struct +TEFOS03 +TRT01A +X1 +X2 \ No newline at end of file diff --git a/man/col_struct_w_risk_diffs.Rd b/man/col_struct_w_risk_diffs.Rd index b7d0405c..6b768df7 100644 --- a/man/col_struct_w_risk_diffs.Rd +++ b/man/col_struct_w_risk_diffs.Rd @@ -20,7 +20,7 @@ col_struct_w_risk_diffs( } \arguments{ \item{lyt}{(\code{PreDataTableLayouts}). The layout to modify. This -should virually always be the object returned by \code{basic_table}.} +should virtually always be the object returned by \code{basic_table}.} \item{colspan_trt_map}{(\code{data.frame}). The spanning label map for the main columns, as given by \code{create_colspan_map}.} @@ -30,7 +30,7 @@ be used as comparator levels, or \emph{if only one reference path is given}, \code{NULL}.} \item{combo_map_df}{(\code{data.frame} or \code{NULL}). A combination data -frame as defined by \code{\link[rtables:add_overall_level]{rtables::add_combo_levels()}} with an additional +frame as defined by \code{\link[=add_combo_levels]{add_combo_levels()}} with an additional \code{is_control} column indicating whether the virtual level will act as a reference (\code{TRUE}) or active (\code{FALSE}) group.} @@ -114,7 +114,7 @@ appear in \code{colspan_trt_map}, all combinations will be added to the appropriate group within the map based on \code{combo_map_df$is_control} (assumed to be \code{FALSE} if the column is missing), with a warning. -If some combination levels \emph{do} apppear in \code{combo_map_df} but +If some combination levels \emph{do} appear in \code{combo_map_df} but others do not, a warning will be thrown but the missing combination levels will \emph{not} be added to the treatment map. diff --git a/man/make_multicomp_splfun.Rd b/man/make_multicomp_splfun.Rd index 7c963253..662c5cd3 100644 --- a/man/make_multicomp_splfun.Rd +++ b/man/make_multicomp_splfun.Rd @@ -3,7 +3,7 @@ \name{make_multicomp_splfun} \alias{make_multicomp_splfun} \alias{make_dflt_comp_map} -\title{Make Multi-comparitor Split Function} +\title{Make Multi-comparator Split Function} \usage{ make_multicomp_splfun( comp_vars, @@ -19,7 +19,7 @@ make_dflt_comp_map(df, spl_var, ref_lvls, combo_map, comp_vars) } \arguments{ \item{comp_vars}{\code{(character)}\cr A vector of one or more different -variables to provide the comparitors. The first value must be +variables to provide the comparators. The first value must be the variable being split on.} \item{comp_level_paths}{\verb{(list of character vectors)}\cr A list of @@ -38,7 +38,7 @@ to some or all blocks of comparisons. See Details.} functions to be provided to \code{make_split_fun}. Defaults to \code{list()}.} -\item{.post}{\code{(list)}\cr A list of additional postprocessing +\item{.post}{\code{(list)}\cr A list of additional post-processing functions to be provided to \code{make_split_fun} \emph{after} those which provide this function's primary multi-comparator functionality. Defaults to \code{list()}} @@ -54,7 +54,7 @@ within \code{col_struct_w_risk_diffs}. } \details{ This split function is intended to create a set of risk difference -or similiar columns. As such it will automatically exclude the facet +or similar columns. As such it will automatically exclude the facet for each comparator level (e.g., Placebo vs Placebo) as determined by the last element of each element of \code{comp_level_paths}. @@ -100,8 +100,8 @@ one of \code{comp_level_paths} if so). } When specifying \code{combo_levels_map} if the \code{compare_against} column -is ommitted, comparison against all reference levels will be -performed for all combination levels. If \code{is_control} is ommitted, +is omitted, comparison against all reference levels will be +performed for all combination levels. If \code{is_control} is omitted, it will be assumed as \code{FALSE} for all combination levels. Order of combination levels when multiple are present for a single diff --git a/tests/testthat/test-multcomp-rrisk.R b/tests/testthat/test-multcomp-rrisk.R index bb97ce32..6d951a4d 100644 --- a/tests/testthat/test-multcomp-rrisk.R +++ b/tests/testthat/test-multcomp-rrisk.R @@ -8,47 +8,43 @@ adsl_jnj <- pharmaverseadamjnj::adsl adae_jnj <- pharmaverseadamjnj::adae - - fix_usubjid <- function(adsl) { - rws <- which(adsl$TRT01P == "Std Of Care") + rws <- which(adsl$TRT01P == "Std Of Care") - usubj_char <- as.character(adsl$USUBJID) - subjid <- as.integer(as.character(adsl$SUBJID)) - subjid[rws] <- subjid[rws] + 1000 - substr(usubj_char, 8, 11) <- as.character(subjid) - adsl$USUBJID <- factor(usubj_char) - adsl$SUBJID <- factor(as.character(subjid)) - adsl + usubj_char <- as.character(adsl$USUBJID) + subjid <- as.integer(as.character(adsl$SUBJID)) + subjid[rws] <- subjid[rws] + 1000 + substr(usubj_char, 8, 11) <- as.character(subjid) + adsl$USUBJID <- factor(usubj_char) + adsl$SUBJID <- factor(as.character(subjid)) + adsl } - - make_fake_adsl <- function(adsl) { - fakeyfake <- filter(adsl, TRT01P == "Placebo") - fakeyfake$TRT01P <- "Std Of Care" - fakeyfake$AGE <- floor(runif(NROW(fakeyfake), 30, 90)) - adsl$TRT01P <- as.character(adsl$TRT01P) - adsl <- rbind(adsl, fakeyfake) - adsl$TRT01P <- factor(adsl$TRT01P) - - fix_usubjid(adsl) - } + fakeyfake <- filter(adsl, TRT01P == "Placebo") + fakeyfake$TRT01P <- "Std Of Care" + fakeyfake$AGE <- floor(runif(NROW(fakeyfake), 30, 90)) + adsl$TRT01P <- as.character(adsl$TRT01P) + adsl <- rbind(adsl, fakeyfake) + adsl$TRT01P <- factor(adsl$TRT01P) + + fix_usubjid(adsl) +} borrow_aes <- function(adae, adsl, mult = 1) { #runif(1, .9, 1.1)) { - plac_count <- sum(adae$TRT01P == "Placebo", na.rm = TRUE) - new_count <- floor(plac_count * mult) - soc_usubjids <- as.character(adsl$USUBJID)[!is.na(adsl$TRT01P) & adsl$TRT01P == "Std Of Care"] + plac_count <- sum(adae$TRT01P == "Placebo", na.rm = TRUE) + new_count <- floor(plac_count * mult) + soc_usubjids <- as.character(adsl$USUBJID)[!is.na(adsl$TRT01P) & adsl$TRT01P == "Std Of Care"] - duprows <- sample(seq_len(NROW(adae)), new_count, replace = TRUE) + duprows <- sample(seq_len(NROW(adae)), new_count, replace = TRUE) - newrws <- adae[duprows,] - print(c(new_count, length(duprows), length(unique(duprows)), NROW(newrws))) - newrws$USUBJID <- sample(soc_usubjids, NROW(newrws), replace = TRUE) - rbind(adae, newrws) + newrws <- adae[duprows, ] + print(c(new_count, length(duprows), length(unique(duprows)), NROW(newrws))) + newrws$USUBJID <- sample(soc_usubjids, NROW(newrws), replace = TRUE) + rbind(adae, newrws) } @@ -58,7 +54,7 @@ borrow_aes <- function(adae, adsl, mult = 1) { #runif(1, .9, 1.1)) { trtvar <- "TRT01P" adsl <- adsl_jnj |> - # filter(!!rlang::sym(popfl) == "Y") |> + # filter(!!rlang::sym(popfl) == "Y") |> make_fake_adsl() |> create_colspan_var( non_active_grp = c("Placebo", "Std Of Care"), @@ -74,7 +70,7 @@ adsl <- adsl_jnj |> ) |> select( USUBJID, - # !!rlang::sym(popfl), + # !!rlang::sym(popfl), !!rlang::sym(trtvar), colspan_trt, rrisk_header, @@ -87,7 +83,7 @@ adsl <- adsl_jnj |> adae <- adae_jnj |> filter(TRTEMFL == "Y") |> - borrow_aes(adsl) |> + borrow_aes(adsl) |> select( USUBJID, AESER, @@ -130,22 +126,22 @@ rr_splitfun <- make_multicomp_splfun(c(trtvar, "rrisk_label2"), ref_paths) lvls <- levels(adsl[[trtvar]]) combodf <- tribble(~valname, ~label, ~levelcombo, ~exargs, - "all_active", "All Active", lvls[3:4],list(), + "all_active", "All Active", lvls[3:4], list(), "all_patients", "All Patients", select_all_levels, list()) comp_map <- junco:::make_dflt_comp_map(adsl, trtvar, ctrl_grp, combodf, c(trtvar, "rrisk_label2")) - ## tribble(~active, ~comparator, ~is_combo_active, - ## "all_active", "Placebo", TRUE, - ## "all_active", "Std Of Care", TRUE, - ## "all_patients", "Placebo", TRUE, - ## "all_patients", "Std Of Care", TRUE)) +## tribble(~active, ~comparator, ~is_combo_active, +## "all_active", "Placebo", TRUE, +## "all_active", "Std Of Care", TRUE, +## "all_patients", "Placebo", TRUE, +## "all_patients", "Std Of Care", TRUE)) lyt_basic <- basic_table() |> - split_cols_by("rrisk_header") |> - split_cols_by("TRT01P", split_fun = add_combo_levels(combodf)) |> - analyze("TRT01P") + split_cols_by("rrisk_header") |> + split_cols_by("TRT01P", split_fun = add_combo_levels(combodf)) |> + analyze("TRT01P") build_table(lyt_basic, adsl) @@ -153,41 +149,44 @@ build_table(lyt_basic, adsl) lyt <- basic_table() |> - split_cols_by("colspan_trt", split_fun = trim_levels_to_map(colspan_trt_map)) |> - split_cols_by(trtvar, show_colcounts = TRUE) |> - split_cols_by("rrisk_header", nested = FALSE) |> - split_cols_by(trtvar, labels_var = "rrisk_label", split_fun = rr_splitfun) |> - analyze("AESDTH", afun = function(x, ...) rcell("-")) + split_cols_by("colspan_trt", split_fun = trim_levels_to_map(colspan_trt_map)) |> + split_cols_by(trtvar, show_colcounts = TRUE) |> + split_cols_by("rrisk_header", nested = FALSE) |> + split_cols_by(trtvar, labels_var = "rrisk_label", split_fun = rr_splitfun) |> + analyze("AESDTH", afun = function(x, ...) rcell("-")) build_table(lyt, adae, adsl) -rr_splitfun2 <- make_multicomp_splfun(c(trtvar, "rrisk_label2"), ref_paths, comp_level_map = comp_map, combo_levels_map = combodf) +rr_splitfun2 <- make_multicomp_splfun( + c(trtvar, "rrisk_label2"), ref_paths, + comp_level_map = comp_map, combo_levels_map = combodf +) lyt <- basic_table() |> - split_cols_by("colspan_trt", split_fun = trim_levels_to_map(colspan_trt_map)) |> - split_cols_by(trtvar, show_colcounts = TRUE, split_fun = add_combo_levels(combodf)) |> - split_cols_by("rrisk_header", nested = FALSE) |> - split_cols_by(trtvar, labels_var = "rrisk_label", split_fun = rr_splitfun2) |> - analyze("AESDTH", afun = function(x, ref_path = NULL, ...) rcell(paste(ref_path, collapse = "."))) + split_cols_by("colspan_trt", split_fun = trim_levels_to_map(colspan_trt_map)) |> + split_cols_by(trtvar, show_colcounts = TRUE, split_fun = add_combo_levels(combodf)) |> + split_cols_by("rrisk_header", nested = FALSE) |> + split_cols_by(trtvar, labels_var = "rrisk_label", split_fun = rr_splitfun2) |> + analyze("AESDTH", afun = function(x, ref_path = NULL, ...) rcell(paste(ref_path, collapse = "."))) build_table(lyt, adae, adsl) lyt <- basic_table() |> - col_struct_w_risk_diffs(colspan_trt_map, - combodf, - comp_map, - comp_vars = c(trtvar, "rrisk_label2")) |> - analyze("AESDTH", afun = function(x, ref_path = NULL, ...) rcell(paste(ref_path, collapse = "."))) + col_struct_w_risk_diffs(colspan_trt_map, + combodf, + comp_map, + comp_vars = c(trtvar, "rrisk_label2")) |> + analyze("AESDTH", afun = function(x, ref_path = NULL, ...) rcell(paste(ref_path, collapse = "."))) tbl <- build_table(lyt, adae, adsl) lyt <- basic_table() |> - col_struct_w_risk_diffs(colspan_trt_map, - combo_map_df = NULL, - comp_map = NULL, - comp_vars = c(trtvar, "rrisk_label2")) |> - analyze("AESDTH", afun = function(x, ref_path = NULL, ...) rcell(paste(ref_path, collapse = "."))) + col_struct_w_risk_diffs(colspan_trt_map, + combo_map_df = NULL, + comp_map = NULL, + comp_vars = c(trtvar, "rrisk_label2")) |> + analyze("AESDTH", afun = function(x, ref_path = NULL, ...) rcell(paste(ref_path, collapse = "."))) tbl <- build_table(lyt, adae, adsl) From bf6c8570e62d1bfd4451721f1058aa98763334cc Mon Sep 17 00:00:00 2001 From: Gabe Becker Date: Fri, 17 Apr 2026 14:16:31 -0700 Subject: [PATCH 3/5] add remote entry for now, and typo fix --- DESCRIPTION | 1 + R/risk_diff_col_struct.R | 2 +- 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index c8092193..d0074bd8 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -64,6 +64,7 @@ Imports: xml2, ggplot2, stringi +Remotes: insightsengineering/rtables@1080_restrict_facets Encoding: UTF-8 Language: en-US Roxygen: list(markdown = TRUE) diff --git a/R/risk_diff_col_struct.R b/R/risk_diff_col_struct.R index 2249e5f4..42cd0590 100644 --- a/R/risk_diff_col_struct.R +++ b/R/risk_diff_col_struct.R @@ -628,7 +628,7 @@ col_struct_w_risk_diffs <- function(lyt, comp_level_map = comp_map, combo_levels_map = combo_map_df, .pre = .rr_pre, - post = .rr_post + .post = .rr_post ) From f585d059cf192c1b0825eab48492a629356b0200 Mon Sep 17 00:00:00 2001 From: Gabe Becker Date: Wed, 22 Apr 2026 14:17:31 -0700 Subject: [PATCH 4/5] intermediate commit with 2 versions of everything --- NAMESPACE | 2 + R/risk_diff_col_struct.R | 284 ++++++++++++++++++++++++++++++++- R/split_functions.R | 3 +- man/col_struct_w_risk_diffs.Rd | 2 +- man/make_multicomp_splfun.Rd | 3 + 5 files changed, 288 insertions(+), 6 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 2d4d5c3d..0ab7e9f7 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -86,7 +86,9 @@ export(lsmeans_wide_first_split_fun_fct) export(lsmeans_wide_second_split_fun_fct) export(make_combo_splitfun) export(make_dflt_comp_map) +export(make_dflt_comp_map2) export(make_multicomp_splfun) +export(make_multicomp_splfun2) export(make_rbmi_cluster) export(no_data_to_report_str) export(or_clogit_j) diff --git a/R/risk_diff_col_struct.R b/R/risk_diff_col_struct.R index 42cd0590..ea8c2451 100644 --- a/R/risk_diff_col_struct.R +++ b/R/risk_diff_col_struct.R @@ -60,6 +60,97 @@ add_sib_facets <- function(add_spl_var, add_lbl_var = add_spl_var, comp_path = N } +get_all_comp_lvls <- function(colspan_trt_map) { + nonactlvl <- unique(as.character(colspan_trt_map[[1]]))[2] + unique(as.character(colspan_trt_map[colspan_trt_map[[1]] == nonactlvl, 2])) +} + +get_first_comp_lvl <- function(colspan_trt_map) { + get_all_comp_lvls(colspan_trt_map)[1] +} + +get_comp_path <- function(map, lvl) { + rw <- map[map[[2]] == lvl,] + c(names(map)[1], rw[[1]], names(map)[2], rw[[2]]) +} + + +## ugh. thisisfine.jpg XXX :( :( :( +do_sib_val_surgery <- function(splval, comp_lvl, newexargs) { + splval@value <- make_comp_name(splval@value, comp_lvl) + splval@label <- make_comp_name(splval@label, comp_lvl) + args <- c(newexargs, splval@extra) + splval@extra <- args + splval +} + + +## do "surgery" on all of the original values to enforce uniqueness and +## correct comparison labels +surgical_suite <- function(orig_ret, comp_lvl, newexargs) { + out <- orig_ret + out$values <- lapply(out$values, + do_sib_val_surgery, + comp_lvl = comp_lvl, + newexargs = newexargs) + out$labels <- vapply(out$values, function(x) x@label, "") + newnms <- vapply(out$values, value_names, "") + out <- lapply(out, + function(part) { + names(part) <- newnms + part + }) + names(out) <- names(orig_ret) + out +} + + +add_sib_facets2 <- function(comp_level, colspan_trt_map, combo_map_all) { + function(ret, spl, .spl_context, fulldf) { + combo_map <- NULL + if (!is.null(combo_map_all)) { + combo_map <- combo_map_all[combo_map_all$comparator_level == comp_level, ] + } + comp_path <- get_comp_path(colspan_trt_map, comp_level) + ret <- insert_subset_exprs(ret, spl, comp_path = comp_path) + first_comp <- get_first_comp_lvl(colspan_trt_map) +# if (identical(comp_level, first_comp) && NROW(combo_map) == 0) { + out <- ret +# } else { + exargs <- list(ref_path = get_comp_path(colspan_trt_map, comp_level)) + if (NROW(combo_map) > 0) { + for (i in seq_len(NROW(combo_map))) { + out <- add_combo_facet( + combo_map$valname[i], + combo_map$label[i], + combo_map$levelcombo[[i]], + combo_map$exargs[[i]] + )( + ret = out, + spl = spl, + .spl_context = .spl_context, + fulldf = fulldf + ) + } + # } + print(sapply(out[[1]], function(x) x@label)) + out <- surgical_suite(out, comp_level, exargs) + print(sapply(out[[1]], function(x) x@label)) + names(out) <- names(ret) + } + out + } +} + + + + + + + + + + #' Make Multi-comparator Split Function #' #' Create a custom splitting function suitable for creating risk @@ -207,14 +298,12 @@ make_multicomp_splfun <- function(comp_vars, seq_along(comp_vars), function(i) { function(ret, spl, .spl_context, fulldf) { - callstuff <<- list(ret = ret, spl = spl, spl_context = .spl_context, fulldf = fulldf) sib_fac_fun <- add_sib_facets( comp_vars[i], lbl_vars[i], comp_path = comp_level_paths[[i]], combo_map_all = combo_levels_map ) - one_sib_fac_fun <<- sib_fac_fun sib_fac_fun(ret, spl, .spl_context, fulldf) } } @@ -230,13 +319,70 @@ make_multicomp_splfun <- function(comp_vars, ) } +#' @export +make_multicomp_splfun2 <- function(colspan_trt_map, + combo_levels_map = NULL, + comp_level_map = NULL, + .pre = list(), + .post = list()) { + post <- c(.post) + if (is.null(comp_level_map)) { + comp_levels <- get_all_comp_lvls(colspan_trt_map) + + } else { + comp_levels <- unique(as.character(comp_level_map$comparator)) + } + if (!is.null(combo_levels_map)) { + ## comp_level_map <- fix_combo_comp_levels(comp_level_map, + ## combo_levels_map, + ## ref_lvls = comp_levels + ## ) + combo_levels_map <- expand_combo_map2(combo_levels_map, ref_lvls = comp_levels) + } + + funlst <- list( + function(ret, spl, .spl_context, fulldf) { + sib_sets <- lapply( + comp_levels, + function(lvl) { + + sib_fac_fun <- add_sib_facets2( + lvl, + colspan_trt_map = colspan_trt_map, + combo_map_all = combo_levels_map + ) + sib_fac_fun(ret, spl, .spl_context, fulldf) + }) + out <- lapply(names(ret), + function(nm) { + unlist(lapply(seq_along(sib_sets), function(ii) sib_sets[[ii]][[nm]]), + recursive = FALSE) + }) + names(out) <- names(ret) + out + }) + + make_split_fun( + pre = .pre, + post = c( + funlst, + apply_comp_map2(splvar = names(colspan_trt_map)[2], comp_levels, comp_map = comp_level_map, combo_map = combo_levels_map), + post + ) + ) +} + + + + + make_comp_name <- function(act_nm, comp_nm) paste0(act_nm, " vs ", comp_nm) ## must be called ***before*** expand_combo_map so the old ## valnames are still there fix_combo_comp_levels <- function(comp_map, combo_map, ref_lvls, ref_labs = ref_lvls) { - if (NROW(combo_map) == 0) { + if (NROW(combo_map) == 0 || NROW(comp_map) == 0) { return(comp_map) } comp_inds <- which(comp_map$active_is_combo) @@ -301,6 +447,66 @@ expand_combo_map <- function(combo_map, comp_vars, ref_lvls, ref_labs = ref_lvls } + + + +expand_combo_map2 <- function(combo_map, ref_lvls) { + if (NROW(combo_map) == 0) { + return(combo_map) + } + + if (!("compare_against" %in% names(combo_map))) { + combo_map$compare_against <- lapply(seq_len(NROW(combo_map)), function(i) select_all_levels) + } + + rws <- lapply( + seq_len(NROW(combo_map)), + function(ii) { + first_ref <- ref_lvls[1] + remaining_refs <- ref_lvls[-1] + mp_rw <- combo_map[ii, ] + comp_against <- mp_rw$compare_against[[1]] + if (is.null(comp_against) || is(comp_against, "AllLevelsSentinel")) { + comp_against <- ref_lvls + } + + + rws_out <- lapply( + comp_against, + function(cur_ref_lvl) { + ref_lvl_ind <- match(cur_ref_lvl, ref_lvls) + cur_rw <- combo_map[ii, ] ## AllLvlsSentinel class getting dropped from map_rw somehow... + ## new_nm <- make_comp_name(mp_rw$label, cur_ref_lvl) + ## cur_rw$valname <- new_nm + if (!is(cur_rw$levelcombo[[1]], "AllLevelsSentinel")) { + cur_rw$levelcombo[[1]] <- vapply( + as.character(cur_rw$levelcombo[[1]]), + function(lvl) { + if (!is(lvl, "AllLevelsSentinel")) { + lvl <- make_comp_name(lvl, cur_ref_lvl) + } + lvl + }, "" + ) + } + #cur_rw$label <- new_nm + cur_rw$comparator_level <- cur_ref_lvl + cur_rw + } + ) + + do.call(rbind.data.frame, rws_out) + } + ) + do.call(rbind.data.frame, rws) +} + + + + + + + apply_comp_map <- function(comp_vars, ref_lvls, comp_map, combo_map) { function(ret, spl, fulldf, ...) { splvar <- comp_vars[1] @@ -317,6 +523,35 @@ apply_comp_map <- function(comp_vars, ref_lvls, comp_map, combo_map) { } +apply_comp_map2 <- function(splvar, ref_lvls, comp_map, combo_map) { + function(ret, spl, fulldf, ...) { + all_lvls <- levels(fulldf[[splvar]]) + + if (is.null(comp_map)) { + comp_map <- make_dflt_comp_map2(fulldf, splvar, ref_lvls, combo_map) + } + lvls_to_keep <- make_comp_name(comp_map$active, comp_map$comparator) #levels_from_comp_map2(comp_map, combodf) + restrict_facets(lvls_to_keep, op = "keep")(ret, spl, fulldf) + } +} + + +levels_from_comp_map2 <- function(comps, combos) { + act_combo_inds <- which(comps$active_is_combo) + comp_combo_inds <- which(comps$comparator_is_combo) + + if (length(act_combo_inds) > 0) { + comps$active[act_combo_inds] <- combos$label[match(comps$active[act_combo_inds], combos$valname)] + } + + if (length(comp_combo_inds) > 0) { + comps$comparator[comp_combo_inds] <- combos$label[match(comps$comparator[comp_combo_inds], combos$valname)] + } + + make_comp_name(comps$active, comps$comparator) +} + + one_comp_level <- function(act_lvl, comp_lvl, df, ref_lvls, comp_vars, active_is_combo) { if (active_is_combo) { return(act_lvl) @@ -335,6 +570,24 @@ one_comp_level <- function(act_lvl, comp_lvl, df, ref_lvls, comp_vars, active_is as.character(df[row_ind, comp_vars[var_ind], drop = TRUE]) } +one_comp_level2 <- function(act_lvl, comp_lvl, df, ref_lvls, spl_var, active_is_combo) { + if (active_is_combo) { + return(act_lvl) + } + var_ind <- match(comp_lvl, ref_lvls) + + if (is.na(var_ind)) { + stop( + "Invalid comparison map: comparator value [", comp_lvl, + "] not among reference levels." + ) + } + + row_ind <- which(df[[spl_var]] == act_lvl)[1] + as.character(df[row_ind, spl_var, drop = TRUE]) +} + + levels_from_comp_map <- function(map, df, ref_lvls, comp_vars, combo_map) { # combo_map <- expand_combo_map(combo_map, comp_vars, ref_lvls) if (is.null(map$active_is_combo)) { @@ -351,6 +604,7 @@ levels_from_comp_map <- function(map, df, ref_lvls, comp_vars, combo_map) { ) } + #' @export #' @rdname make_multicomp_splfun make_dflt_comp_map <- function(df, spl_var, ref_lvls, combo_map, comp_vars) { @@ -374,6 +628,30 @@ make_dflt_comp_map <- function(df, spl_var, ref_lvls, combo_map, comp_vars) { ret } +#' @export +#' @rdname make_multicomp_splfun +make_dflt_comp_map2 <- function(df, spl_var, ref_lvls, combo_map) { + all_lvls <- as.character(levels(df[[spl_var]])) + + non_ref <- setdiff(all_lvls, ref_lvls) + base_rws <- lapply( + ref_lvls, + function(ref_lvl_i) { + data.frame(active = non_ref, comparator = ref_lvl_i, active_is_combo = FALSE, comparator_is_combo = FALSE) + } + ) + + combo_rws <- combodf_to_comp_map(combodf = combo_map, comp_vars = NULL, ref_lvls = ref_lvls, all_base_lvls = all_lvls) + ret <- do.call(rbind.data.frame, c(base_rws, list(combo_rws))) + + ret$tmp_fact <- factor(ret$comparator, levels = ref_lvls) + o <- order(ret$tmp_fact) + ret <- ret[o, ] + ret$tmp_fact <- NULL + ret +} + + combodf_to_comp_map <- function(combodf, comp_vars, ref_lvls, all_base_lvls) { nrcombo <- NROW(combodf) if (nrcombo == 0) { diff --git a/R/split_functions.R b/R/split_functions.R index fc1a092d..8ef8b984 100644 --- a/R/split_functions.R +++ b/R/split_functions.R @@ -396,12 +396,11 @@ insert_subset_exprs <- function(partinfo, spl, comp_path = NULL) { exprs <- lapply(rvs, function(rvi) rtables:::make_subset_expr(spl, rvi)) newvals <- mapply(function(val, expr) { exvals <- rtables:::splv_extra(val) - if (!is.null(rtables:::value_expr(val)) && "ref_path" %in% names(exvals)) { + if (!is.null(rtables:::value_expr(val))) { return(val) } ## XXX fix ASAP, export setter from rtables val@subset_expression <- expr - rtables:::splv_extra(val) <- c(exvals, list(ref_path = comp_path)) val }, val = partinfo$values, diff --git a/man/col_struct_w_risk_diffs.Rd b/man/col_struct_w_risk_diffs.Rd index 6b768df7..12e64ed0 100644 --- a/man/col_struct_w_risk_diffs.Rd +++ b/man/col_struct_w_risk_diffs.Rd @@ -30,7 +30,7 @@ be used as comparator levels, or \emph{if only one reference path is given}, \code{NULL}.} \item{combo_map_df}{(\code{data.frame} or \code{NULL}). A combination data -frame as defined by \code{\link[=add_combo_levels]{add_combo_levels()}} with an additional +frame as defined by \code{\link[rtables:add_overall_level]{rtables::add_combo_levels()}} with an additional \code{is_control} column indicating whether the virtual level will act as a reference (\code{TRUE}) or active (\code{FALSE}) group.} diff --git a/man/make_multicomp_splfun.Rd b/man/make_multicomp_splfun.Rd index 662c5cd3..53417ec4 100644 --- a/man/make_multicomp_splfun.Rd +++ b/man/make_multicomp_splfun.Rd @@ -3,6 +3,7 @@ \name{make_multicomp_splfun} \alias{make_multicomp_splfun} \alias{make_dflt_comp_map} +\alias{make_dflt_comp_map2} \title{Make Multi-comparator Split Function} \usage{ make_multicomp_splfun( @@ -16,6 +17,8 @@ make_multicomp_splfun( ) make_dflt_comp_map(df, spl_var, ref_lvls, combo_map, comp_vars) + +make_dflt_comp_map2(df, spl_var, ref_lvls, combo_map) } \arguments{ \item{comp_vars}{\code{(character)}\cr A vector of one or more different From 8af59e5713db68f26c791eb4a3d0d170e23835f3 Mon Sep 17 00:00:00 2001 From: Gabe Becker Date: Wed, 22 Apr 2026 15:12:44 -0700 Subject: [PATCH 5/5] reworked as discussed on tuesday re comp_vars, ref_paths etc --- NAMESPACE | 2 - R/risk_diff_col_struct.R | 484 +++++---------------------------- double_risk_test.R | 232 ++++++++++++++++ man/col_struct_w_risk_diffs.Rd | 25 +- man/make_multicomp_splfun.Rd | 76 +++--- 5 files changed, 337 insertions(+), 482 deletions(-) create mode 100644 double_risk_test.R diff --git a/NAMESPACE b/NAMESPACE index 0ab7e9f7..2d4d5c3d 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -86,9 +86,7 @@ export(lsmeans_wide_first_split_fun_fct) export(lsmeans_wide_second_split_fun_fct) export(make_combo_splitfun) export(make_dflt_comp_map) -export(make_dflt_comp_map2) export(make_multicomp_splfun) -export(make_multicomp_splfun2) export(make_rbmi_cluster) export(no_data_to_report_str) export(or_clogit_j) diff --git a/R/risk_diff_col_struct.R b/R/risk_diff_col_struct.R index ea8c2451..0e2ab424 100644 --- a/R/risk_diff_col_struct.R +++ b/R/risk_diff_col_struct.R @@ -1,65 +1,3 @@ -add_sib_facets <- function(add_spl_var, add_lbl_var = add_spl_var, comp_path = NULL, combo_map_all) { - function(ret, spl, .spl_context, fulldf) { - combo_map <- NULL - if (!is.null(combo_map_all)) { - combo_map <- combo_map_all[combo_map_all$comp_var == add_spl_var, ] - } - ret <- insert_subset_exprs(ret, spl, comp_path = comp_path) - if (identical(add_spl_var, spl_variable(spl)) && NROW(combo_map) == 0) { - out <- ret - } else { - exargs <- list() - if (!is.null(comp_path)) { - exargs$ref_path <- comp_path - } - spl2 <- VarLevelSplit( - var = add_spl_var, - split_label = "new thang", - labels_var = add_lbl_var, - extra_args = list(exargs) - ) - ret2 <- do_base_split(spl2, fulldf) - if (NROW(combo_map) > 0) { - for (i in seq_len(NROW(combo_map))) { - ret2 <- add_combo_facet( - combo_map$valname[i], - combo_map$label[i], - combo_map$levelcombo[[i]], - combo_map$exargs[[i]] - )( - ret = ret2, - spl = spl2, - .spl_context = .spl_context, - fulldf = fulldf - ) - } - } - - ret2 <- insert_subset_exprs(ret2, spl2, comp_path = comp_path) - if (identical(add_spl_var, spl_variable(spl))) { - ## if we're in the split variable case only add the new combo facets - cmbo_inds <- match(combo_map$valname, names(ret2$values)) - ret2 <- lapply(ret2, function(lsti) lsti[cmbo_inds]) - names(ret2) <- names(ret) - } - - if (any(names(ret2[[1]]) %in% names(ret[[1]]))) { - stop( - "add_spl_var variable cannot have levels matching any ", - "existing levels in the split. Try creating a new dummy ", - "variable that is a one to one mapping to the split ", - "variable if desired." - ) - } - - out <- lapply(names(ret), function(nm) c(ret[[nm]], ret2[[nm]])) - names(out) <- names(ret) - } - out - } -} - - get_all_comp_lvls <- function(colspan_trt_map) { nonactlvl <- unique(as.character(colspan_trt_map[[1]]))[2] unique(as.character(colspan_trt_map[colspan_trt_map[[1]] == nonactlvl, 2])) @@ -76,6 +14,8 @@ get_comp_path <- function(map, lvl) { ## ugh. thisisfine.jpg XXX :( :( :( +## +## this is where we munge treatment names/labels into comparison versions do_sib_val_surgery <- function(splval, comp_lvl, newexargs) { splval@value <- make_comp_name(splval@value, comp_lvl) splval@label <- make_comp_name(splval@label, comp_lvl) @@ -105,7 +45,7 @@ surgical_suite <- function(orig_ret, comp_lvl, newexargs) { } -add_sib_facets2 <- function(comp_level, colspan_trt_map, combo_map_all) { +add_sib_facets <- function(comp_level, colspan_trt_map, combo_map_all) { function(ret, spl, .spl_context, fulldf) { combo_map <- NULL if (!is.null(combo_map_all)) { @@ -113,66 +53,51 @@ add_sib_facets2 <- function(comp_level, colspan_trt_map, combo_map_all) { } comp_path <- get_comp_path(colspan_trt_map, comp_level) ret <- insert_subset_exprs(ret, spl, comp_path = comp_path) - first_comp <- get_first_comp_lvl(colspan_trt_map) -# if (identical(comp_level, first_comp) && NROW(combo_map) == 0) { - out <- ret -# } else { + out <- ret exargs <- list(ref_path = get_comp_path(colspan_trt_map, comp_level)) - if (NROW(combo_map) > 0) { - for (i in seq_len(NROW(combo_map))) { - out <- add_combo_facet( - combo_map$valname[i], - combo_map$label[i], - combo_map$levelcombo[[i]], - combo_map$exargs[[i]] - )( - ret = out, - spl = spl, - .spl_context = .spl_context, - fulldf = fulldf - ) - } - # } - print(sapply(out[[1]], function(x) x@label)) - out <- surgical_suite(out, comp_level, exargs) - print(sapply(out[[1]], function(x) x@label)) - names(out) <- names(ret) + if (NROW(combo_map) > 0) { + for (i in seq_len(NROW(combo_map))) { + out <- add_combo_facet( + combo_map$valname[i], + combo_map$label[i], + combo_map$levelcombo[[i]], + combo_map$exargs[[i]] + )( + ret = out, + spl = spl, + .spl_context = .spl_context, + fulldf = fulldf + ) + } # } } + out <- surgical_suite(out, comp_level, exargs) + names(out) <- names(ret) out } } - - - - - - - - - #' Make Multi-comparator Split Function #' #' Create a custom splitting function suitable for creating risk #' difference columns against one or more comparators. This is used #' within `col_struct_w_risk_diffs`. #' -#' @param comp_vars `(character)`\cr A vector of one or more different -#' variables to provide the comparators. The first value must be -#' the variable being split on. -#' -#' @param comp_level_paths `(list of character vectors)`\cr A list of -#' comparator paths suitable for passing to e.g., `a_freq_j`'s -#' `ref_path` argument. -#' -#' @param lbl_vars `(character)`\cr A vector of label variables or -#' (`NA_character_` for no label variable) corresponding to each -#' of `comp_vars`. -#' -#' @param combo_levels_map `(data.frame or NULL)`\cr NULL (the +#' @param colspan_trt_map (`data.frame`)\cr A data.frame defining the +#' active and non-active groups of treatment arms, including +#' combination arms defined in `combo_levels_map`, as returned by +#' [create_colspan_map()]. +#' +#' @param combo_levels_map (`data.frame` or `NULL`)\cr NULL (the #' default) or a data.frame indicating combination levels to added #' to some or all blocks of comparisons. See Details. #' +#' @param comp_level_map (`data.frame` or `NULL`)\cr A data.frame with +#' columns `active` and `comparator` indivating which risk +#' difference comparisons to include in the column structure, or +#' `NULL` (the default), indicating all active vs non-active +#' pairwise comparisons as defined `colspan_trt_map` treatment +#' groupings. +#' #' @param .pre `(list)`\cr A list of additional preprocessing #' functions to be provided to `make_split_fun`. Defaults to #' `list()`. @@ -191,28 +116,28 @@ add_sib_facets2 <- function(comp_level, colspan_trt_map, combo_map_all) { #' for each comparator level (e.g., Placebo vs Placebo) as determined #' by the last element of each element of `comp_level_paths`. #' -#' Each variable in `comp_vars` must be unique *and not have any -#' levels in common with any other comparator variables*. -#' #' Further control of facets is provided by `comp_level_map`. If #' `NULL` (the default), all non-control/reference groups will be -#' compared pairwise with all control/reference groups. +#' compared pairwise with all control/reference groups as defined by +#' the grouping in `colspan_trt_map`. #' #' If specified, `comp_level_map` must be a `data.frame` (including #' `tbl_df`) with three columns: #' #' - `active` - (character) the value to be compared to a reference level, #' - `comparator` - (character) the level that should be compared against, and -#' - `is_combo_active` - (logical) is the level specified in `active` a virtual combination level. +#' - `active_is_combo` - (logical) is the level specified in `active` a virtual combination level. +#' - `comparator_is_combo` - (logical) is the level specified in `comparator` a virtual combination level. #' #' If a `data.frame` with only the `active` and `comparator` columns -#' is given for `comp_level_map`, `is_combo_active` is assumed as -#' `FALSE` for all rows. +#' is given for `comp_level_map`, `active_is_combo` and +#' `comparator_is_combo` are inferred from `colspan_trt_map`. #' -#' If any rows of `comp_level_map` have `is_combo_active == TRUE`, the -#' values of `active` in those rows *must* also appear in -#' `combo_levels_map` with the correct level for comp_level (or `NA` -#' which indicates inclusion for all comparators). +#' If any rows of `comp_level_map` have `active_is_combo == TRUE` or +#' `comparator_is_combo`, the relevant values in those rows *must* +#' also appear in `combo_levels_map` with the correct level for +#' comp_level (or the `select_all_levels` sentinel value which +#' indicates inclusion for all comparators). #' #' If specified, `combo_levels_map` must be a `data.frame` (including `tbl_df`) #' with the following columns: @@ -239,17 +164,18 @@ add_sib_facets2 <- function(comp_level, colspan_trt_map, combo_map_all) { #' comparator, as well as their position relative to non-combination #' comparisons, is determined by row order in `combo_levels_map`. #' -#' Labels (for the first reference level) and names (for the remaining -#' reference levels) of comparison columns involving combination -#' levels will be automatically computed in the form of -#' `" vs "` +#' Labels and names of comparison columns involving combination levels +#' will be automatically computed in the form of +#' `" vs "`. Note currently +#' ref group *name* is always used as it needs to be inferable from +#' `colspan_trt_map`. #' #' -#' The comparator reference path (`comp_level_path` elements) are -#' added as `ref_path` to the extra_args associated with generated -#' facet. As such, analysis (or content) functions used underneath a -#' split using the generated split function must accept either -#' `ref_path` or `...`. +#' The comparator reference path is calculated based on +#' `colspan_trt_map` and then added as `ref_path` to the extra_args +#' associated with generated facet. As such, analysis (or content) +#' functions used underneath a split using the generated split +#' function must accept either `ref_path` or `...`. #' #' @note It is not currently possible to use a virtual combination #' level as a comparator/reference group. If you need this @@ -259,68 +185,7 @@ add_sib_facets2 <- function(comp_level, colspan_trt_map, combo_map_all) { #' @family riskdiff_col_struct #' #' @export -make_multicomp_splfun <- function(comp_vars, - comp_level_paths, - lbl_vars = rep(NA, - length.out = length(comp_vars) - ), - combo_levels_map = NULL, - comp_level_map = NULL, - .pre = list(), - .post = list()) { - nvars <- length(comp_vars) - if (length(comp_level_paths) != nvars || - length(lbl_vars) != nvars || - length(comp_level_paths) != nvars) { - stop( - "Lengths of arguments do not all match:\n[", - "comp_vars:", nvars, - ", comp_level_paths: ", length(comp_level_paths), - "lbl_vars:", length(lbl_vars), - "]." - ) - } - - - post <- c(.post) - comp_levels <- vapply(comp_level_paths, function(pth) tail(pth, 1), "") - if (!is.null(combo_levels_map)) { - comp_level_map <- fix_combo_comp_levels(comp_level_map, - combo_levels_map, - ref_lvls = comp_levels - ) - combo_levels_map <- expand_combo_map(combo_levels_map, comp_vars, ref_lvls = comp_levels) - } - - lbl_vars[is.na(lbl_vars)] <- comp_vars[is.na(lbl_vars)] - - funlst <- lapply( - seq_along(comp_vars), - function(i) { - function(ret, spl, .spl_context, fulldf) { - sib_fac_fun <- add_sib_facets( - comp_vars[i], - lbl_vars[i], - comp_path = comp_level_paths[[i]], - combo_map_all = combo_levels_map - ) - sib_fac_fun(ret, spl, .spl_context, fulldf) - } - } - ) - - make_split_fun( - pre = .pre, - post = c( - funlst, - apply_comp_map(comp_vars, comp_levels, comp_map = comp_level_map, combo_map = combo_levels_map), - post - ) - ) -} - -#' @export -make_multicomp_splfun2 <- function(colspan_trt_map, +make_multicomp_splfun <- function(colspan_trt_map, combo_levels_map = NULL, comp_level_map = NULL, .pre = list(), @@ -337,7 +202,7 @@ make_multicomp_splfun2 <- function(colspan_trt_map, ## combo_levels_map, ## ref_lvls = comp_levels ## ) - combo_levels_map <- expand_combo_map2(combo_levels_map, ref_lvls = comp_levels) + combo_levels_map <- expand_combo_map(combo_levels_map, ref_lvls = comp_levels) } funlst <- list( @@ -346,7 +211,7 @@ make_multicomp_splfun2 <- function(colspan_trt_map, comp_levels, function(lvl) { - sib_fac_fun <- add_sib_facets2( + sib_fac_fun <- add_sib_facets( lvl, colspan_trt_map = colspan_trt_map, combo_map_all = combo_levels_map @@ -366,7 +231,7 @@ make_multicomp_splfun2 <- function(colspan_trt_map, pre = .pre, post = c( funlst, - apply_comp_map2(splvar = names(colspan_trt_map)[2], comp_levels, comp_map = comp_level_map, combo_map = combo_levels_map), + apply_comp_map(splvar = names(colspan_trt_map)[2], comp_levels, comp_map = comp_level_map, combo_map = combo_levels_map), post ) ) @@ -394,63 +259,9 @@ fix_combo_comp_levels <- function(comp_map, combo_map, ref_lvls, ref_labs = ref_ comp_map } -expand_combo_map <- function(combo_map, comp_vars, ref_lvls, ref_labs = ref_lvls) { - if (NROW(combo_map) == 0) { - return(combo_map) - } - - if (!("compare_against" %in% names(combo_map))) { - combo_map$compare_against <- lapply(seq_len(NROW(combo_map)), function(i) select_all_levels) - } - - rws <- lapply( - seq_len(NROW(combo_map)), - function(ii) { - first_ref <- ref_lvls[1] - remaining_refs <- ref_lvls[-1] - mp_rw <- combo_map[ii, ] - comp_against <- mp_rw$compare_against[[1]] - if (is.null(comp_against) || is(comp_against, "AllLevelsSentinel")) { - comp_against <- ref_lvls - } - - - rws_out <- lapply( - comp_against, - function(cur_ref_lvl) { - ref_lvl_ind <- match(cur_ref_lvl, ref_lvls) - cur_ref_lab <- ref_labs[ref_lvl_ind] - cur_rw <- combo_map[ii, ] ## AllLvlsSentinel class getting dropped from map_rw somehow... - new_nm <- make_comp_name(mp_rw$label, cur_ref_lab) - cur_rw$valname <- new_nm - if (!is(cur_rw$levelcombo[[1]], "AllLevelsSentinel")) { - cur_rw$levelcombo[[1]] <- vapply( - as.character(cur_rw$levelcombo[[1]]), - function(lvl) { - if (!is(lvl, "AllLevelsSentinel")) { - lvl <- make_comp_name(lvl, cur_ref_lab) - } - lvl - }, "" - ) - } - cur_rw$comp_var <- comp_vars[ref_lvl_ind] - cur_rw$label <- new_nm - cur_rw - } - ) - - do.call(rbind.data.frame, rws_out) - } - ) - do.call(rbind.data.frame, rws) -} - - - - - -expand_combo_map2 <- function(combo_map, ref_lvls) { +## conversion of names/labels to comparison versions is now +## handled (much) later, in surgical_suite and apply_comp_map +expand_combo_map <- function(combo_map, ref_lvls) { if (NROW(combo_map) == 0) { return(combo_map) } @@ -476,8 +287,6 @@ expand_combo_map2 <- function(combo_map, ref_lvls) { function(cur_ref_lvl) { ref_lvl_ind <- match(cur_ref_lvl, ref_lvls) cur_rw <- combo_map[ii, ] ## AllLvlsSentinel class getting dropped from map_rw somehow... - ## new_nm <- make_comp_name(mp_rw$label, cur_ref_lvl) - ## cur_rw$valname <- new_nm if (!is(cur_rw$levelcombo[[1]], "AllLevelsSentinel")) { cur_rw$levelcombo[[1]] <- vapply( as.character(cur_rw$levelcombo[[1]]), @@ -489,7 +298,6 @@ expand_combo_map2 <- function(combo_map, ref_lvls) { }, "" ) } - #cur_rw$label <- new_nm cur_rw$comparator_level <- cur_ref_lvl cur_rw } @@ -502,135 +310,21 @@ expand_combo_map2 <- function(combo_map, ref_lvls) { } - - - - - -apply_comp_map <- function(comp_vars, ref_lvls, comp_map, combo_map) { - function(ret, spl, fulldf, ...) { - splvar <- comp_vars[1] - more_comp_vars <- comp_vars[-1] - all_lvls <- levels(fulldf[[splvar]]) - - if (is.null(comp_map)) { - comp_map <- make_dflt_comp_map(fulldf, splvar, ref_lvls, combo_map, comp_vars) - } - - lvls_to_keep <- levels_from_comp_map(comp_map, fulldf, ref_lvls, comp_vars, combo_map) - restrict_facets(lvls_to_keep, op = "keep")(ret, spl, fulldf) - } -} - - -apply_comp_map2 <- function(splvar, ref_lvls, comp_map, combo_map) { +apply_comp_map <- function(splvar, ref_lvls, comp_map, combo_map) { function(ret, spl, fulldf, ...) { all_lvls <- levels(fulldf[[splvar]]) if (is.null(comp_map)) { - comp_map <- make_dflt_comp_map2(fulldf, splvar, ref_lvls, combo_map) + comp_map <- make_dflt_comp_map(fulldf, splvar, ref_lvls, combo_map) } lvls_to_keep <- make_comp_name(comp_map$active, comp_map$comparator) #levels_from_comp_map2(comp_map, combodf) restrict_facets(lvls_to_keep, op = "keep")(ret, spl, fulldf) } } - -levels_from_comp_map2 <- function(comps, combos) { - act_combo_inds <- which(comps$active_is_combo) - comp_combo_inds <- which(comps$comparator_is_combo) - - if (length(act_combo_inds) > 0) { - comps$active[act_combo_inds] <- combos$label[match(comps$active[act_combo_inds], combos$valname)] - } - - if (length(comp_combo_inds) > 0) { - comps$comparator[comp_combo_inds] <- combos$label[match(comps$comparator[comp_combo_inds], combos$valname)] - } - - make_comp_name(comps$active, comps$comparator) -} - - -one_comp_level <- function(act_lvl, comp_lvl, df, ref_lvls, comp_vars, active_is_combo) { - if (active_is_combo) { - return(act_lvl) - } - spl_var <- comp_vars[1] - var_ind <- match(comp_lvl, ref_lvls) - - if (is.na(var_ind)) { - stop( - "Invalid comparison map: comparator value [", comp_lvl, - "] not among reference levels." - ) - } - - row_ind <- which(df[[spl_var]] == act_lvl)[1] - as.character(df[row_ind, comp_vars[var_ind], drop = TRUE]) -} - -one_comp_level2 <- function(act_lvl, comp_lvl, df, ref_lvls, spl_var, active_is_combo) { - if (active_is_combo) { - return(act_lvl) - } - var_ind <- match(comp_lvl, ref_lvls) - - if (is.na(var_ind)) { - stop( - "Invalid comparison map: comparator value [", comp_lvl, - "] not among reference levels." - ) - } - - row_ind <- which(df[[spl_var]] == act_lvl)[1] - as.character(df[row_ind, spl_var, drop = TRUE]) -} - - -levels_from_comp_map <- function(map, df, ref_lvls, comp_vars, combo_map) { - # combo_map <- expand_combo_map(combo_map, comp_vars, ref_lvls) - if (is.null(map$active_is_combo)) { - map$active_is_combo <- FALSE - } - - mapply(one_comp_level, - act_lvl = map[[1]], comp_lvl = map[[2]], active_is_combo = map$active_is_combo, - MoreArgs = list( - df = df, - ref_lvls = ref_lvls, - comp_vars = comp_vars - ) - ) -} - - -#' @export -#' @rdname make_multicomp_splfun -make_dflt_comp_map <- function(df, spl_var, ref_lvls, combo_map, comp_vars) { - all_lvls <- as.character(levels(df[[spl_var]])) - - non_ref <- setdiff(all_lvls, ref_lvls) - base_rws <- lapply( - ref_lvls, - function(ref_lvl_i) { - data.frame(active = non_ref, comparator = ref_lvl_i, active_is_combo = FALSE, comparator_is_combo = FALSE) - } - ) - - combo_rws <- combodf_to_comp_map(combo_map, comp_vars, ref_lvls, all_lvls) - ret <- do.call(rbind.data.frame, c(base_rws, list(combo_rws))) - - ret$tmp_fact <- factor(ret$comparator, levels = ref_lvls) - o <- order(ret$tmp_fact) - ret <- ret[o, ] - ret$tmp_fact <- NULL - ret -} - #' @export #' @rdname make_multicomp_splfun -make_dflt_comp_map2 <- function(df, spl_var, ref_lvls, combo_map) { +make_dflt_comp_map <- function(df, spl_var, ref_lvls, combo_map) { all_lvls <- as.character(levels(df[[spl_var]])) non_ref <- setdiff(all_lvls, ref_lvls) @@ -641,7 +335,7 @@ make_dflt_comp_map2 <- function(df, spl_var, ref_lvls, combo_map) { } ) - combo_rws <- combodf_to_comp_map(combodf = combo_map, comp_vars = NULL, ref_lvls = ref_lvls, all_base_lvls = all_lvls) + combo_rws <- combodf_to_comp_map(combodf = combo_map, ref_lvls = ref_lvls, all_base_lvls = all_lvls) ret <- do.call(rbind.data.frame, c(base_rws, list(combo_rws))) ret$tmp_fact <- factor(ret$comparator, levels = ref_lvls) @@ -652,7 +346,7 @@ make_dflt_comp_map2 <- function(df, spl_var, ref_lvls, combo_map) { } -combodf_to_comp_map <- function(combodf, comp_vars, ref_lvls, all_base_lvls) { +combodf_to_comp_map <- function(combodf, ref_lvls, all_base_lvls) { nrcombo <- NROW(combodf) if (nrcombo == 0) { return(NULL) @@ -737,19 +431,6 @@ combodf_to_comp_map <- function(combodf, comp_vars, ref_lvls, all_base_lvls) { #' `"active"`, `"comparator"`, `"active_is_combo"` and #' `"comparator_is_combo"`, or `NULL` indicating the default #' comparison behavior (See Details). -#' @param comp_vars (`character` or `NULL`). The names of columns to -#' be used as comparator levels, or *if only one reference path is -#' given*, `NULL`. -#' -#' @param comp_lbl_vars (`character` or `NULL`). Names of columns to -#' be used as labels for comparator levels. Defaults to -#' `comp_vars`. -#' -#' @param ref_paths (`list` of `character`, `character` or -#' `NULL`). The path(s) to reference column(s) in the main portion -#' of the column structure, to be passed to `junco` analysis -#' functions such as [a_freq_j()]. If `NULL` (the default), -#' inferred from `colspan_trt_map` #' @param rrisk_header (`character(1)`). The spanning label for the #' risk difference section of columns #' @@ -788,17 +469,10 @@ combodf_to_comp_map <- function(combodf, comp_vars, ref_lvls, all_base_lvls) { #' #' In addition, it supports: #' -#' - comparison against multiple control groups (via `comp_vars`, see [make_multicomp_splfun()]), +#' - comparison against multiple control groups (as specified by `colspan_trt_map` and/or `comp_map`), #' - virtual combination-levels as active an/or control "treatments" (via `combo_map_df`), #' - full control of which comparisons are performed, and their order (via `comp_map`). #' -#' If only one control group is specified by `colspan_trt_map`, -#' `comp_vars` does not need to be set, as the treatment variable -#' (defined as the second column in `colspan_trt_map`) will be used -#' automatically. If more than one control group is specified, -#' `comp_vars` must be specified explicitly as it can no longer be -#' inferred from the map. -#' #' If combination levels are declared via `combo_map_df` but none #' appear in `colspan_trt_map`, all combinations will be added to the #' appropriate group within the map based on `combo_map_df$is_control` @@ -830,11 +504,9 @@ combodf_to_comp_map <- function(combodf, comp_vars, ref_lvls, all_base_lvls) { col_struct_w_risk_diffs <- function(lyt, colspan_trt_map, - comp_vars = NULL, combo_map_df = NULL, ## default behavior for comp_map is taken care of in make_multicomp_splfun comp_map = NULL, - comp_lbl_vars = comp_vars, rrisk_header = "Risk Differences", .main_pre = list(), .main_post = list(), @@ -843,10 +515,6 @@ col_struct_w_risk_diffs <- function(lyt, trtvar <- names(colspan_trt_map)[2] spanvar <- names(colspan_trt_map)[1] - ## default behavior resolution and arg checking cascade: - ## 1. add combinations to colspan_trt_map if needed - ## 2. use colspan_trt_map to infer ref_paths - ## 3. use ref_paths to check for valid comp_vars if (!is.null(combo_map_df)) { if (!("is_control" %in% names(combo_map_df))) { combo_map_df$is_control <- FALSE @@ -881,28 +549,12 @@ col_struct_w_risk_diffs <- function(lyt, main_post <- list() } - ctrl_span <- unique(colspan_trt_map[[spanvar]])[2] ## assume second is non-active - ctrl_vals <- colspan_trt_map[colspan_trt_map[[spanvar]] == ctrl_span, trtvar] - ref_paths <- lapply( - ctrl_vals, - function(vl) c(spanvar, ctrl_span, trtvar, vl) - ) - - if (is.null(comp_vars) && - (length(ref_paths) == 1 || is.character(ref_paths))) { - comp_vars <- trtvar - } else if (is.null(comp_vars)) { - stop("comp_vars must be specified when more than one control group is specified in colspan_trt_map") - } - - main_post <- c(main_post, .trtmap_to_post_funs(colspan_trt_map), .main_post) main_splfun <- make_split_fun(pre = .main_pre, post = main_post) rr_splfun <- make_multicomp_splfun( - comp_vars, - ref_paths, + colspan_trt_map, comp_level_map = comp_map, combo_levels_map = combo_map_df, .pre = .rr_pre, diff --git a/double_risk_test.R b/double_risk_test.R new file mode 100644 index 00000000..27237a56 --- /dev/null +++ b/double_risk_test.R @@ -0,0 +1,232 @@ + +library(dplyr) +library(junco) +library(tibble) + + +adsl_jnj <- pharmaverseadamjnj::adsl + +adae_jnj <- pharmaverseadamjnj::adae + + + +fix_usubjid <- function(adsl) { + rws <- which(adsl$TRT01P == "Std Of Care") + + usubj_char <- as.character(adsl$USUBJID) + subjid <- as.integer(as.character(adsl$SUBJID)) + subjid[rws] <- subjid[rws] + 1000 + substr(usubj_char, 8, 11) <- as.character(subjid) + adsl$USUBJID <- factor(usubj_char) + adsl$SUBJID <- factor(as.character(subjid)) + adsl + +} + + + +make_fake_adsl <- function(adsl) { + fakeyfake <- filter(adsl, TRT01P == "Placebo") + fakeyfake$TRT01P <- "Std Of Care" + fakeyfake$AGE <- floor(runif(NROW(fakeyfake), 30, 90)) + adsl$TRT01P <- as.character(adsl$TRT01P) + adsl <- rbind(adsl, fakeyfake) + adsl$TRT01P <- factor(adsl$TRT01P) + + fix_usubjid(adsl) + } + + + +borrow_aes <- function(adae, adsl, mult = 1) { #runif(1, .9, 1.1)) { + plac_count <- sum(adae$TRT01P == "Placebo", na.rm = TRUE) + new_count <- floor(plac_count * mult) + soc_usubjids <- as.character(adsl$USUBJID)[!is.na(adsl$TRT01P) & adsl$TRT01P == "Std Of Care"] + + duprows <- sample(seq_len(NROW(adae)), new_count, replace = TRUE) + + newrws <- adae[duprows,] + print(c(new_count, length(duprows), length(unique(duprows)), NROW(newrws))) + newrws$USUBJID <- sample(soc_usubjids, NROW(newrws), replace = TRUE) + rbind(adae, newrws) +} + + + + + +trtvar <- "TRT01P" + +adsl <- adsl_jnj |> + # filter(!!rlang::sym(popfl) == "Y") |> + make_fake_adsl() |> + create_colspan_var( + non_active_grp = c("Placebo", "Std Of Care"), + non_active_grp_span_lbl = " ", + active_grp_span_lbl = "Active Study Agent", + colspan_var = "colspan_trt", + trt_var = trtvar + ) |> + mutate( + rrisk_header = "Risk Difference (%) (95% CI)", + rrisk_label = paste(!!rlang::sym(trtvar), "vs Placebo"), + rrisk_label2 = paste(!!rlang::sym(trtvar), "vs Std of Care") + ) |> + select( + USUBJID, + # !!rlang::sym(popfl), + !!rlang::sym(trtvar), + colspan_trt, + rrisk_header, + rrisk_label, + rrisk_label2 + ) + + + + +adae <- adae_jnj |> + filter(TRTEMFL == "Y") |> + borrow_aes(adsl) |> + select( + USUBJID, + AESER, + AESDTH, + AESLIFE, + AESHOSP, + AESDISAB, + AESCONG, + AESMIE, + AEACN_DECODE, + AESEV + ) |> + group_by(USUBJID) |> + mutate(maxsev = max(as.character(AESEV), na.rm = TRUE)) |> + ungroup() |> + mutate(maxsev = ifelse(is.na(maxsev), "Missing", maxsev)) |> + mutate( + maxsev = factor(maxsev, levels = c("Mild", "Moderate", "Severe", "Missing")) + ) + + +adae <- inner_join(adae, adsl, by = c("USUBJID"), multiple = "all") + +ctrl_grp <- c("Placebo", "Std Of Care") + +colspan_trt_map <- create_colspan_map( + adsl, + non_active_grp = ctrl_grp, + non_active_grp_span_lbl = " ", + active_grp_span_lbl = "Active Study Agent", + colspan_var = "colspan_trt", + trt_var = trtvar +) + + + +#debugonce(rr_splitfun) + +lvls <- levels(adsl[[trtvar]]) +combodf <- tribble(~valname, ~label, ~levelcombo, ~exargs, + "all_active", "All Active", lvls[3:4],list(), + "all_patients", "All Patients", select_all_levels, list()) + + +comp_map <- make_dflt_comp_map(adsl, trtvar, ctrl_grp, combodf) + ## tribble(~active, ~comparator, ~is_combo_active, + ## "all_active", "Placebo", TRUE, + ## "all_active", "Std Of Care", TRUE, + ## "all_patients", "Placebo", TRUE, + ## "all_patients", "Std Of Care", TRUE)) + + +lyt_basic <- basic_table() |> + split_cols_by("rrisk_header") |> + split_cols_by("TRT01P", split_fun = add_combo_levels(combodf)) |> + analyze("TRT01P") + +build_table(lyt_basic, adsl) + + + +rr_splitfun <- make_multicomp_splfun(colspan_trt_map) + +lyt <- basic_table() |> + split_cols_by("colspan_trt", split_fun = trim_levels_to_map(colspan_trt_map)) |> + split_cols_by(trtvar, show_colcounts = TRUE) |> + split_cols_by("rrisk_header", nested = FALSE) |> + split_cols_by(trtvar, split_fun = rr_splitfun) |> + analyze("AESDTH", afun = function(x, ...) rcell("-")) + +build_table(lyt, adae, adsl) + +rr_splitfun2 <- make_multicomp_splfun(colspan_trt_map, combo_levels_map = combodf, comp_level_map = comp_map) + + +lyt <- basic_table() |> + split_cols_by("colspan_trt", split_fun = trim_levels_to_map(colspan_trt_map)) |> + split_cols_by(trtvar, show_colcounts = TRUE, split_fun = add_combo_levels(combodf)) |> + split_cols_by("rrisk_header", nested = FALSE) |> + split_cols_by(trtvar, split_fun = rr_splitfun2) |> + analyze("AESDTH", afun = function(x, ref_path = NULL, ...) rcell(paste(ref_path, collapse = "."))) + +build_table(lyt, adae, adsl) + +lyt <- basic_table() |> + col_struct_w_risk_diffs(colspan_trt_map, + combodf, + comp_map) |> + analyze("AESDTH", afun = function(x, ref_path = NULL, ...) rcell(paste(ref_path, collapse = "."))) + +tbl <- build_table(lyt, adae, adsl) + + +afun_show_path <- function(x, ref_path = NULL, ...) rcell(paste(ref_path, collapse = ".")) + +lyt <- basic_table() |> + col_struct_w_risk_diffs(colspan_trt_map, + combo_map_df = NULL, + comp_map = NULL) |> + analyze("AESDTH", afun = afun_show_path) + +tbl <- build_table(lyt, adae, adsl) + + +rr_splitfun <- make_multicomp_splfun2(colspan_trt_map, combodf, NULL) + +lyt <- basic_table() |> + split_cols_by("colspan_trt", split_fun = trim_levels_to_map(colspan_trt_map)) |> + split_cols_by(trtvar, show_colcounts = TRUE) |> + split_cols_by("rrisk_header", nested = FALSE) |> + split_cols_by(trtvar, labels_var = "rrisk_label", split_fun = rr_splitfun) |> + analyze("AESDTH", afun = afun_show_path) + +build_table(lyt, adae, adsl) + + +rr_splitfun2 <- make_multicomp_splfun2(colspan_trt_map, combodf, data.frame(active = c("all_patients", "all_active"), comparator = c("Placebo", "Std Of Care"))) + + +lyt <- basic_table() |> + split_cols_by("colspan_trt", split_fun = trim_levels_to_map(colspan_trt_map)) |> + split_cols_by(trtvar, show_colcounts = TRUE) |> + split_cols_by("rrisk_header", nested = FALSE) |> + split_cols_by(trtvar, labels_var = "rrisk_label", split_fun = rr_splitfun2) |> + analyze("AESDTH", afun = afun_show_path) + +tbl <- build_table(lyt, adae, adsl) + + + + + + + + + + + + + + + diff --git a/man/col_struct_w_risk_diffs.Rd b/man/col_struct_w_risk_diffs.Rd index 12e64ed0..d91bd914 100644 --- a/man/col_struct_w_risk_diffs.Rd +++ b/man/col_struct_w_risk_diffs.Rd @@ -7,10 +7,8 @@ col_struct_w_risk_diffs( lyt, colspan_trt_map, - comp_vars = NULL, combo_map_df = NULL, comp_map = NULL, - comp_lbl_vars = comp_vars, rrisk_header = "Risk Differences", .main_pre = list(), .main_post = list(), @@ -25,10 +23,6 @@ should virtually always be the object returned by \code{basic_table}.} \item{colspan_trt_map}{(\code{data.frame}). The spanning label map for the main columns, as given by \code{create_colspan_map}.} -\item{comp_vars}{(\code{character} or \code{NULL}). The names of columns to -be used as comparator levels, or \emph{if only one reference path is -given}, \code{NULL}.} - \item{combo_map_df}{(\code{data.frame} or \code{NULL}). A combination data frame as defined by \code{\link[rtables:add_overall_level]{rtables::add_combo_levels()}} with an additional \code{is_control} column indicating whether the virtual level will @@ -39,10 +33,6 @@ act as a reference (\code{TRUE}) or active (\code{FALSE}) group.} \code{"comparator_is_combo"}, or \code{NULL} indicating the default comparison behavior (See Details).} -\item{comp_lbl_vars}{(\code{character} or \code{NULL}). Names of columns to -be used as labels for comparator levels. Defaults to -\code{comp_vars}.} - \item{rrisk_header}{(\code{character(1)}). The spanning label for the risk difference section of columns} @@ -61,12 +51,6 @@ faceting.} \item{.rr_post}{(\code{list} of \code{function}s). Passed to \code{\link[=make_multicomp_splfun]{make_multicomp_splfun()}} as \code{.post} for risk difference faceting.} - -\item{ref_paths}{(\code{list} of \code{character}, \code{character} or -\code{NULL}). The path(s) to reference column(s) in the main portion -of the column structure, to be passed to \code{junco} analysis -functions such as \code{\link[=a_freq_j]{a_freq_j()}}. If \code{NULL} (the default), -inferred from \code{colspan_trt_map}} } \value{ \code{lyt} updated with the specified main and risk difference @@ -97,18 +81,11 @@ split function In addition, it supports: \itemize{ -\item comparison against multiple control groups (via \code{comp_vars}, see \code{\link[=make_multicomp_splfun]{make_multicomp_splfun()}}), +\item comparison against multiple control groups (as specified by \code{colspan_trt_map} and/or \code{comp_map}), \item virtual combination-levels as active an/or control "treatments" (via \code{combo_map_df}), \item full control of which comparisons are performed, and their order (via \code{comp_map}). } -If only one control group is specified by \code{colspan_trt_map}, -\code{comp_vars} does not need to be set, as the treatment variable -(defined as the second column in \code{colspan_trt_map}) will be used -automatically. If more than one control group is specified, -\code{comp_vars} must be specified explicitly as it can no longer be -inferred from the map. - If combination levels are declared via \code{combo_map_df} but none appear in \code{colspan_trt_map}, all combinations will be added to the appropriate group within the map based on \code{combo_map_df$is_control} diff --git a/man/make_multicomp_splfun.Rd b/man/make_multicomp_splfun.Rd index 53417ec4..15bde7cb 100644 --- a/man/make_multicomp_splfun.Rd +++ b/man/make_multicomp_splfun.Rd @@ -3,40 +3,35 @@ \name{make_multicomp_splfun} \alias{make_multicomp_splfun} \alias{make_dflt_comp_map} -\alias{make_dflt_comp_map2} \title{Make Multi-comparator Split Function} \usage{ make_multicomp_splfun( - comp_vars, - comp_level_paths, - lbl_vars = rep(NA, length.out = length(comp_vars)), + colspan_trt_map, combo_levels_map = NULL, comp_level_map = NULL, .pre = list(), .post = list() ) -make_dflt_comp_map(df, spl_var, ref_lvls, combo_map, comp_vars) - -make_dflt_comp_map2(df, spl_var, ref_lvls, combo_map) +make_dflt_comp_map(df, spl_var, ref_lvls, combo_map) } \arguments{ -\item{comp_vars}{\code{(character)}\cr A vector of one or more different -variables to provide the comparators. The first value must be -the variable being split on.} - -\item{comp_level_paths}{\verb{(list of character vectors)}\cr A list of -comparator paths suitable for passing to e.g., \code{a_freq_j}'s -\code{ref_path} argument.} - -\item{lbl_vars}{\code{(character)}\cr A vector of label variables or -(\code{NA_character_} for no label variable) corresponding to each -of \code{comp_vars}.} +\item{colspan_trt_map}{(\code{data.frame})\cr A data.frame defining the +active and non-active groups of treatment arms, including +combination arms defined in \code{combo_levels_map}, as returned by +\code{\link[=create_colspan_map]{create_colspan_map()}}.} -\item{combo_levels_map}{\verb{(data.frame or NULL)}\cr NULL (the +\item{combo_levels_map}{(\code{data.frame} or \code{NULL})\cr NULL (the default) or a data.frame indicating combination levels to added to some or all blocks of comparisons. See Details.} +\item{comp_level_map}{(\code{data.frame} or \code{NULL})\cr A data.frame with +columns \code{active} and \code{comparator} indivating which risk +difference comparisons to include in the column structure, or +\code{NULL} (the default), indicating all active vs non-active +pairwise comparisons as defined \code{colspan_trt_map} treatment +groupings.} + \item{.pre}{\code{(list)}\cr A list of additional preprocessing functions to be provided to \code{make_split_fun}. Defaults to \code{list()}.} @@ -61,29 +56,29 @@ or similar columns. As such it will automatically exclude the facet for each comparator level (e.g., Placebo vs Placebo) as determined by the last element of each element of \code{comp_level_paths}. -Each variable in \code{comp_vars} must be unique \emph{and not have any -levels in common with any other comparator variables}. - Further control of facets is provided by \code{comp_level_map}. If \code{NULL} (the default), all non-control/reference groups will be -compared pairwise with all control/reference groups. +compared pairwise with all control/reference groups as defined by +the grouping in \code{colspan_trt_map}. If specified, \code{comp_level_map} must be a \code{data.frame} (including \code{tbl_df}) with three columns: \itemize{ \item \code{active} - (character) the value to be compared to a reference level, \item \code{comparator} - (character) the level that should be compared against, and -\item \code{is_combo_active} - (logical) is the level specified in \code{active} a virtual combination level. +\item \code{active_is_combo} - (logical) is the level specified in \code{active} a virtual combination level. +\item \code{comparator_is_combo} - (logical) is the level specified in \code{comparator} a virtual combination level. } If a \code{data.frame} with only the \code{active} and \code{comparator} columns -is given for \code{comp_level_map}, \code{is_combo_active} is assumed as -\code{FALSE} for all rows. +is given for \code{comp_level_map}, \code{active_is_combo} and +\code{comparator_is_combo} are inferred from \code{colspan_trt_map}. -If any rows of \code{comp_level_map} have \code{is_combo_active == TRUE}, the -values of \code{active} in those rows \emph{must} also appear in -\code{combo_levels_map} with the correct level for comp_level (or \code{NA} -which indicates inclusion for all comparators). +If any rows of \code{comp_level_map} have \code{active_is_combo == TRUE} or +\code{comparator_is_combo}, the relevant values in those rows \emph{must} +also appear in \code{combo_levels_map} with the correct level for +comp_level (or the \code{select_all_levels} sentinel value which +indicates inclusion for all comparators). If specified, \code{combo_levels_map} must be a \code{data.frame} (including \code{tbl_df}) with the following columns: @@ -111,16 +106,17 @@ Order of combination levels when multiple are present for a single comparator, as well as their position relative to non-combination comparisons, is determined by row order in \code{combo_levels_map}. -Labels (for the first reference level) and names (for the remaining -reference levels) of comparison columns involving combination -levels will be automatically computed in the form of -\code{" vs "} - -The comparator reference path (\code{comp_level_path} elements) are -added as \code{ref_path} to the extra_args associated with generated -facet. As such, analysis (or content) functions used underneath a -split using the generated split function must accept either -\code{ref_path} or \code{...}. +Labels and names of comparison columns involving combination levels +will be automatically computed in the form of +\code{" vs "}. Note currently +ref group \emph{name} is always used as it needs to be inferable from +\code{colspan_trt_map}. + +The comparator reference path is calculated based on +\code{colspan_trt_map} and then added as \code{ref_path} to the extra_args +associated with generated facet. As such, analysis (or content) +functions used underneath a split using the generated split +function must accept either \code{ref_path} or \code{...}. } \note{ It is not currently possible to use a virtual combination