Allow non-display of subjects from placebo arm

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

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];

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) {

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))

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])
+})

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.