diff --git a/NEWS.md b/NEWS.md index 242fcd5..ca26634 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,9 @@ +# forestly 0.1.7 + +## New features + +- Add `ae_listing_placebo` to `prepare_ae_forestly()` (default `TRUE`). Set it to `FALSE` to exclude the `reference_group` from subject-level AE drill-down listing data while leaving forest plots and statistical results unchanged (#174). + # forestly 0.1.6 ## Improvements diff --git a/R/ae_forestly.R b/R/ae_forestly.R index 17fa4b1..1edf092 100644 --- a/R/ae_forestly.R +++ b/R/ae_forestly.R @@ -408,7 +408,7 @@ ae_forestly <- function(outdata, const store = %s; return (rowInfo) => { const enc = store.index[rowInfo.index]; - if (!enc) return null; + if (!enc || !enc.length) return null; let abs; if (enc.length === 2 && enc[1] < 0) { const start = enc[0], count = -enc[1]; diff --git a/R/prepare_ae_forestly.R b/R/prepare_ae_forestly.R index 677aa46..af96fe9 100644 --- a/R/prepare_ae_forestly.R +++ b/R/prepare_ae_forestly.R @@ -26,6 +26,12 @@ #' @param bisection A numeric value. A control parameter for the bisection #' method used to calculate confidence the lower and upper confidence #' interval bounds for the risk. The default value is `1e2`. +#' @param ae_listing_placebo A single non-missing logical value. If `TRUE` +#' (default), include all treatment groups in subject-level AE drill-down +#' listings. If `FALSE`, exclude records from the group selected by +#' `reference_group`. This affects listing data +#' only, not population denominators, AE counts, estimates, comparisons, +#' confidence intervals, or forest-plot rows. #' @param ... Additional arguments passed to [metalite.ae::rate_compare_sum()]. #' @return An `outdata` object. #' @@ -86,6 +92,10 @@ #' metalite::meta_build() #' #' prepare_ae_forestly(meta, parameter = "any") +#' +#' # Exclude placebo from listings only (the second treatment group here). +#' prepare_ae_forestly(meta, parameter = "any", reference_group = 2, +#' ae_listing_placebo = FALSE) prepare_ae_forestly <- function( meta, population = NULL, @@ -99,8 +109,14 @@ prepare_ae_forestly <- function( ), ae_listing_unique = FALSE, bisection = 1e2, + ae_listing_placebo = TRUE, ... ) { + if (!is.logical(ae_listing_placebo) || length(ae_listing_placebo) != 1L || + is.na(ae_listing_placebo)) { + stop("ae_listing_placebo must be a single non-missing logical value.", call. = FALSE) + } + if (is.null(population)) { if (length(meta$population) == 1) { population <- meta$population[[1]]$name @@ -199,6 +215,15 @@ prepare_ae_forestly <- function( x$name %in% x$ae_listing$Adverse_Event }) + # Determine forest-plot rows from the full listings above before excluding + # the reference group, so even placebo-only terms with missing SOC survive. + if (!ae_listing_placebo && nrow(ae_listing) > 0L) { + placebo_group <- res[[1]]$group[res[[1]]$reference_group] + ae_listing <- ae_listing[ + !(ae_listing$Treatment_Group %in% placebo_group), , drop = FALSE + ] + } + # Arrange data frame foo <- function(name) { tmp <- lapply(seq_along(res), function(i) { diff --git a/man/prepare_ae_forestly.Rd b/man/prepare_ae_forestly.Rd index 622b42f..a3310e8 100644 --- a/man/prepare_ae_forestly.Rd +++ b/man/prepare_ae_forestly.Rd @@ -15,6 +15,7 @@ prepare_ae_forestly( "AEREL", "AEACN", "AEOUT", "ADURN", "ADURU"), ae_listing_unique = FALSE, bisection = 100, + ae_listing_placebo = TRUE, ... ) } @@ -45,6 +46,16 @@ on AE listing table.} method used to calculate confidence the lower and upper confidence interval bounds for the risk. The default value is \code{1e2}.} +\item{ae_listing_placebo}{A single non-missing logical value. If \code{TRUE} +(default), include all treatment groups in subject-level AE drill-down +listings. If \code{FALSE}, exclude records from the group selected by +\code{reference_group} (including its default when \code{NULL}). This group is treated +as placebo regardless of its label; if the reference group is an active +treatment, that treatment is excluded instead. Set \code{reference_group} to the +placebo group's index to exclude placebo records. This affects listing data +only, not population denominators, AE counts, estimates, comparisons, +confidence intervals, or forest-plot rows.} + \item{...}{Additional arguments passed to \code{\link[metalite.ae:rate_compare_sum]{metalite.ae::rate_compare_sum()}}.} } \value{ @@ -108,4 +119,8 @@ meta <- metalite::meta_adam(population = adsl, observation = adae) |> metalite::meta_build() prepare_ae_forestly(meta, parameter = "any") + +# Exclude placebo from listings only (the second treatment group here). +prepare_ae_forestly(meta, parameter = "any", reference_group = 2, + ae_listing_placebo = FALSE) } diff --git a/tests/testthat/test-ae_forestly.R b/tests/testthat/test-ae_forestly.R index 699b943..e79cea4 100644 --- a/tests/testthat/test-ae_forestly.R +++ b/tests/testthat/test-ae_forestly.R @@ -51,6 +51,45 @@ test_that("ae_forestly(): drill-down listings render lazily via lt", { expect_true("lt-interactive.js" %in% lt_dep[[1]]$script) }) +test_that("ae_forestly(): excluded placebo records are not embedded in the widget", { + meta <- meta_ae_test() + meta$data_observation$Listing_Record <- ifelse( + meta$data_observation$TRTA == "Placebo", "PLACEBO-LISTING-RECORD", "ACTIVE-LISTING-RECORD" + ) + outdata <- prepare_ae_forestly(meta, parameter = "any", ae_listing_placebo = FALSE, + ae_listing_display = c("USUBJID", "Listing_Record")) |> + format_ae_forestly() + html_text <- as.character(ae_forestly(outdata)) + + expect_false(grepl("PLACEBO-LISTING-RECORD", html_text, fixed = TRUE)) + expect_true(grepl("ACTIVE-LISTING-RECORD", html_text, fixed = TRUE)) + expect_true(grepl("window.LT.render", html_text, fixed = TRUE)) +}) + +test_that("ae_forestly(): terms with no eligible records have no drill-down", { + meta <- meta_ae_test() + meta$data_observation$AESER <- "N" + i <- which(meta$data_observation$TRTA == "Placebo")[1] + meta$data_observation$AESER[i] <- "Y" + meta$data_observation$Listing_Record <- "OTHER-LISTING-RECORD" + meta$data_observation$Listing_Record[i] <- "PLACEBO-ONLY-SERIOUS-RECORD" + outdata <- prepare_ae_forestly(meta, parameter = "any;ser", + ae_listing_placebo = FALSE, ae_listing_display = c("USUBJID", "Listing_Record")) |> + format_ae_forestly() + expect_true(any(outdata$tbl$parameter == "ser")) + html_text <- as.character(ae_forestly(outdata)) + expect_false(grepl("PLACEBO-ONLY-SERIOUS-RECORD", html_text, fixed = TRUE)) + expect_true(grepl("if (!enc || !enc.length) return null;", html_text, fixed = TRUE)) + + # Also allow an entirely empty shared record store, keeping its column schema. + empty <- prepare_ae_forestly(meta, parameter = "ser", ae_listing_placebo = FALSE, + ae_listing_display = c("USUBJID", "Listing_Record")) |> + format_ae_forestly() + expect_equal(nrow(empty$ae_listing), 0) + expect_true(nrow(empty$tbl) > 0) + expect_no_error(ae_forestly(empty)) +}) + test_that("search-filter.js defines the shared globals and search logic", { js_path <- system.file("js", "search-filter.js", package = "forestly") expect_true(file.exists(js_path)) diff --git a/tests/testthat/test-prepare_ae_forestly.R b/tests/testthat/test-prepare_ae_forestly.R index b888175..c7f3c6e 100644 --- a/tests/testthat/test-prepare_ae_forestly.R +++ b/tests/testthat/test-prepare_ae_forestly.R @@ -124,3 +124,112 @@ test_that("prepare_ae_forestly() retains a specific AE with missing SOC", { expect_true(is.na(outdata$soc_name)) expect_equal(as.character(outdata$parameter_order), "ser") }) + +test_that("ae_listing_placebo must be a single non-missing logical value", { + invalid <- list(NULL, logical(), NA, c(TRUE, FALSE), 0, 1, "FALSE", list(FALSE)) + for (value in invalid) { + expect_error( + prepare_ae_forestly(NULL, ae_listing_placebo = value), + "ae_listing_placebo must be a single non-missing logical value.", + fixed = TRUE + ) + } +}) + +test_that("ae_listing_placebo filters listings without changing analysis results", { + meta <- meta_ae_test() + for (unique_records in c(FALSE, TRUE)) { + args <- list( + meta = meta, parameter = "any;rel;ser", components = c("soc", "par"), + ae_listing_unique = unique_records + ) + all_groups <- do.call(prepare_ae_forestly, args) + explicit_true <- do.call(prepare_ae_forestly, c(args, list(ae_listing_placebo = TRUE))) + active_only <- do.call(prepare_ae_forestly, c(args, list(ae_listing_placebo = FALSE))) + + expect_equal(explicit_true, all_groups) + expect_setequal(as.character(unique(all_groups$ae_listing$Treatment_Group)), + c("Placebo", "Low Dose", "High Dose")) + expected <- all_groups$ae_listing[ + all_groups$ae_listing$Treatment_Group != "Placebo", , drop = FALSE + ] + expect_equal(active_only$ae_listing, expected) + expect_setequal(unique(active_only$ae_listing$param), c("any", "rel", "ser")) + expect_setequal(as.character(unique(active_only$ae_listing$Treatment_Group)), + c("Low Dose", "High Dose")) + + fields <- setdiff(names(all_groups), "ae_listing") + expect_equal(active_only[fields], all_groups[fields]) + expect_equal(format_ae_forestly(active_only)$tbl, format_ae_forestly(all_groups)$tbl) + } +}) + +test_that("ae_listing_placebo uses the reference group with customized labels", { + meta <- meta_ae_test() + for (dataset in c("data_population", "data_observation")) { + meta[[dataset]]$TRTA <- factor(meta[[dataset]]$TRTA, + levels = c("Low Dose", "Placebo", "High Dose"), + labels = c("Treatment A", "Control Arm", "Treatment B") + ) + } + outdata <- prepare_ae_forestly(meta, parameter = "any", + reference_group = 2, ae_listing_placebo = FALSE) + expect_equal(outdata$group[outdata$reference_group], "Control Arm") + expect_setequal(as.character(unique(outdata$ae_listing$Treatment_Group)), + c("Treatment A", "Treatment B")) + + # An active reference group is excluded instead of guessing from its label. + outdata <- prepare_ae_forestly(meta, parameter = "any", + reference_group = 1, ae_listing_placebo = FALSE) + expect_setequal(as.character(unique(outdata$ae_listing$Treatment_Group)), + c("Control Arm", "Treatment B")) +}) + +test_that("ae_listing_placebo uses the default second reference group for two arms", { + meta <- meta_ae_test() + for (dataset in c("data_population", "data_observation")) { + meta[[dataset]] <- meta[[dataset]][meta[[dataset]]$TRTA != "High Dose", ] + meta[[dataset]]$TRTA <- factor(meta[[dataset]]$TRTA, + levels = c("Low Dose", "Placebo")) + } + implicit <- prepare_ae_forestly(meta, parameter = "any", ae_listing_placebo = FALSE) + explicit <- prepare_ae_forestly(meta, parameter = "any", + reference_group = 2, ae_listing_placebo = FALSE) + expect_equal(implicit, explicit) + expect_equal(implicit$reference_group, 2) + expect_equal(unique(as.character(implicit$ae_listing$Treatment_Group)), "Low Dose") +}) + +test_that("ae_listing_placebo supports character treatment variables", { + meta <- meta_ae_test() + meta$data_population$TRTA <- as.character(meta$data_population$TRTA) + meta$data_observation$TRTA <- as.character(meta$data_observation$TRTA) + # metalite.ae converts character treatment variables to alphabetically ordered factors. + expect_warning( + expect_warning( + outdata <- prepare_ae_forestly(meta, parameter = "any", + reference_group = 3, ae_listing_placebo = FALSE), + "In population level data, force group variable" + ), + "In observation level data, force group variable" + ) + expect_equal(outdata$group[outdata$reference_group], "Placebo") + expect_setequal(unique(outdata$ae_listing$Treatment_Group), c("Low Dose", "High Dose")) +}) + +test_that("ae_listing_placebo retains placebo-only terms even with missing SOC", { + meta <- meta_ae_test() + meta$data_observation$AESER <- "N" + i <- which(meta$data_observation$TRTA == "Placebo")[1] + meta$data_observation$AESER[i] <- "Y" + meta$data_observation$AEBODSYS[i] <- NA_character_ + + all_groups <- prepare_ae_forestly(meta, parameter = "ser") + active_only <- prepare_ae_forestly(meta, parameter = "ser", ae_listing_placebo = FALSE) + expect_equal(nrow(all_groups$ae_listing), 1) + expect_equal(nrow(active_only$ae_listing), 0) + expect_equal(names(active_only$ae_listing), names(all_groups$ae_listing)) + expect_equal(length(active_only$name), 1) + fields <- setdiff(names(all_groups), "ae_listing") + expect_equal(active_only[fields], all_groups[fields]) +}) diff --git a/vignettes/customize-listing-columns.Rmd b/vignettes/customize-listing-columns.Rmd index 1786f49..38379ae 100644 --- a/vignettes/customize-listing-columns.Rmd +++ b/vignettes/customize-listing-columns.Rmd @@ -90,3 +90,34 @@ meta |> format_ae_forestly() |> ae_forestly() ``` + +# Step 3: exclude placebo subjects from AE listings + +By default, `ae_listing_placebo = TRUE` includes records from all treatment groups +in the drill-down listings. Set it to `FALSE` to remove the reference group's +records from the listing data only. Population denominators, AE counts, +incidence estimates, treatment comparisons, confidence intervals, and forest +plots still include all treatment groups. AE terms with no remaining listing +records have no drill-down listing. + +The excluded group is identified by `reference_group`, not by a literal +`"Placebo"` label, so customized treatment labels are supported. In this example, +the treatment levels are `"Low Dose"` followed by `"Placebo"`, so the placebo +reference group is group 2: + +```{r} +meta |> + prepare_ae_forestly( + reference_group = 2, + ae_listing_display = c("USUBJID", "SITEID", "SEX", "RACE", "AGE"), + ae_listing_placebo = FALSE + ) |> + format_ae_forestly() |> + ae_forestly() +``` + +If `reference_group = NULL`, the usual reference-group default is used (group 2 +for two treatment groups, otherwise group 1). If the reference group is an +active treatment rather than placebo, `ae_listing_placebo = FALSE` excludes +that active treatment instead; select the placebo group's index explicitly +when needed. Use `ae_listing_placebo = TRUE` to retain listings for every group.