diff --git a/DESCRIPTION b/DESCRIPTION index 3bf5d20..9a1cfd9 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -50,4 +50,4 @@ Suggests: VignetteBuilder: knitr Config/testthat/edition: 3 Roxygen: list(markdown = TRUE) -RoxygenNote: 7.3.2 +RoxygenNote: 7.3.3 diff --git a/R/ae_forestly.R b/R/ae_forestly.R index 884119a..f08ac0a 100644 --- a/R/ae_forestly.R +++ b/R/ae_forestly.R @@ -20,6 +20,7 @@ #' #' @param outdata An `outdata` object created by [format_ae_forestly()]. #' @param display_soc_toggle A boolean value to display SOC toggle button. +#' @param display_diff_toggle A boolean value to display risk difference toggle button. #' @param filter A character value of the filter variable. #' @param filter_label A character value of the label for slider bar. #' @param filter_range A numeric vector of length 2 for the range of the slider bar. @@ -48,6 +49,7 @@ #' } ae_forestly <- function(outdata, display_soc_toggle = TRUE, + display_diff_toggle = FALSE, filter = c("prop", "n"), filter_label = NULL, filter_range = NULL, @@ -186,12 +188,29 @@ ae_forestly <- function(outdata, filter_subject$children[[2]]$attribs$`data-to` <- filter_range[2] filter_subject$children[[2]]$attribs$`data-max` <- filter_range[2] + diff_cols <- c( + names(outdata$diff) + ) + + all_diff_cols <- c(diff_cols, "diff_fig") + displayed_diff_cols <- intersect(all_diff_cols, c( + if ("diff" %in% outdata$display) diff_cols else NULL, + if ("fig_diff" %in% outdata$display) "diff_fig" else NULL + )) + + hidden_cols <- outdata$hidden_column + if (display_diff_toggle) { + hidden_cols <- setdiff(hidden_cols, displayed_diff_cols) + } + p_reactable <- reactable2( tbl, columns = outdata$reactable_columns, columnGroups = outdata$reactable_columns_group, - hidden_item = paste0("'", outdata$hidden_column, "'", collapse = ", "), + hidden_item = paste0("'", hidden_cols, "'", collapse = ", "), soc_toggle = display_soc_toggle, + diff_toggle = display_diff_toggle, + diff_columns = displayed_diff_cols, width = width, download = dowload_button, searchable = FALSE, diff --git a/R/format_ae_forestly.R b/R/format_ae_forestly.R index dc1fff9..fb7d332 100644 --- a/R/format_ae_forestly.R +++ b/R/format_ae_forestly.R @@ -38,12 +38,14 @@ #' for risk difference figure. #' @param color A vector of colors for analysis groups. #' Default value supports up to 4 groups. +#' @param ae_col_header Column header for adverse events item columns. +#' If NULL (default) and "par" specified in `components` from `prepare_ae_forestly()`, uses "Adverse Event". +#' If NULL and "soc" specified in `components` from `prepare_ae_forestly()`, uses "System Organ Class" for "soc". #' @param diff_label x-axis label for risk difference. -#' @param col_header Column header for risk difference table columns. +#' @param diff_col_header Column header for risk difference table columns. #' If NULL (default), uses "Risk Difference (%)
vs. Reference Group". -#' @param fig_header Column header for risk difference figure. +#' @param diff_fig_header Column header for risk difference figure. #' If NULL (default), uses "Risk Difference (%) + 95% CI
vs. Reference Group". -#' @param show_ae_parameter A boolean value to display AE parameter column. #' #' @return An `outdata` object. #' @@ -71,10 +73,10 @@ format_ae_forestly <- function( prop_range = NULL, diff_range = NULL, color = NULL, + ae_col_header = NULL, diff_label = "Treatment <- Favor -> Placebo", - col_header = NULL, - fig_header = NULL, - show_ae_parameter = FALSE) { + diff_col_header = NULL, + diff_fig_header = NULL) { display <- tolower(display) display <- match.arg( @@ -105,12 +107,20 @@ format_ae_forestly <- function( reference_name <- outdata$group[index_reference] # Set default headers if not provided - if (is.null(col_header)) { - col_header <- paste0("Risk Difference (%)
vs. ", reference_name) + if (is.null(ae_col_header)) { + if ("par" %in% outdata$components) { + ae_col_header <- "Adverse Event" + } else if ("soc" %in% outdata$components) { + ae_col_header <- "System Organ Class" + } + } + + if (is.null(diff_col_header)) { + diff_col_header <- paste0("Risk Difference (%)
vs. ", reference_name) } - if (is.null(fig_header)) { - fig_header <- paste0("Risk Difference (%) + 95% CI
vs. ", reference_name) + if (is.null(diff_fig_header)) { + diff_fig_header <- paste0("Risk Difference (%) + 95% CI
vs. ", reference_name) } # Input checking @@ -143,8 +153,6 @@ format_ae_forestly <- function( hide_n = apply(outdata$n[, 1:n_group], 1, max, na.rm = TRUE) ) - if (!show_ae_parameter) tbl <- tbl[, c(2:ncol(tbl), 1)] - rownames(tbl) <- NULL # JavaScript for plotly figures ---- @@ -251,7 +259,7 @@ format_ae_forestly <- function( ) } columnGroups[[m_group + 1]] <- reactable::colGroup( - name = col_header, + name = diff_col_header, html = TRUE, columns = names(outdata$diff) ) @@ -262,10 +270,10 @@ format_ae_forestly <- function( col_var <- list( parameter = reactable::colDef( header = "Type", - show = show_ae_parameter + show = FALSE ), name = reactable::colDef( - header = "Adverse Events", + header = ae_col_header, minWidth = width_term, align = "right" ), soc_name = reactable::colDef( @@ -342,7 +350,7 @@ format_ae_forestly <- function( # difference format col_diff_fig <- list(diff_fig = reactable::colDef( - header = fig_header, + header = diff_fig_header, defaultSortOrder = "desc", width = ifelse("fig_diff" %in% display, width_fig, 0), align = "center", diff --git a/R/prepare_ae_forestly.R b/R/prepare_ae_forestly.R index 6b40968..6aac709 100644 --- a/R/prepare_ae_forestly.R +++ b/R/prepare_ae_forestly.R @@ -170,6 +170,7 @@ prepare_ae_forestly <- function( order = info$order, parameter_order = parameter_order, group = res[[1]]$group, + components = components, reference_group = res[[1]]$reference_group, prop = values$prop, diff = values$diff, diff --git a/R/reactable2.R b/R/reactable2.R index dc03c38..9664e1e 100644 --- a/R/reactable2.R +++ b/R/reactable2.R @@ -48,7 +48,9 @@ #' @param label A logical value to display label as a hover text. #' @param download A logical value to display download button. #' @param soc_toggle A logical value to display SOC toggle button. +#' @param diff_toggle A logical value to display risk difference toggle button. #' @param hidden_item Vector for hidden columns. +#' @param diff_columns Character vector of risk difference column names. #' @param ... Additional arguments passed to [reactable::reactable()]. #' @inheritParams reactable::reactable #' @@ -76,7 +78,9 @@ reactable2 <- function( download = TRUE, col_def = NULL, soc_toggle = TRUE, + diff_toggle = FALSE, hidden_item = NULL, + diff_columns = NULL, ...) { # Display variable label as hover text if (label & is.null(col_def)) { @@ -110,25 +114,60 @@ reactable2 <- function( ... ) + buttons <- list() + if (soc_toggle) { - on_click2 <- paste0( - "function control_column(hidden_columns) {", + on_click_soc <- paste0( + "function control_soc(hidden_columns) {", " if (hidden_columns.includes('soc_name')) {", " Reactable.setHiddenColumns('", element_id, "', prevColumns => { - return prevColumns.length === 0 ? ['soc_name']:[", hidden_item, "]})", + return prevColumns.filter(col => col !== 'soc_name')})", " } else {", " Reactable.setHiddenColumns('", element_id, "', prevColumns => { - return prevColumns.length === 0 ? [ ]: ['soc_name',", hidden_item, "]})", + return [...prevColumns, 'soc_name']})", " }", "}", - "control_column(Reactable.getState('", element_id, "').hiddenColumns);" + "control_soc(Reactable.getState('", element_id, "').hiddenColumns);" ) - tbl <- htmltools::tagList( + buttons <- c(buttons, list( htmltools::tags$button( "Show/Hide SOC column", - onclick = on_click2 - ), + onclick = on_click_soc + ) + )) + } + + if (diff_toggle && !is.null(diff_columns) && length(diff_columns) > 0) { + diff_cols_js <- paste0("['", paste(diff_columns, collapse = "', '"), "']") + on_click_diff <- paste0( + "function control_diff(hidden_columns) {", + " const diffCols = ", diff_cols_js, ";", + " const allDiffHidden = diffCols.every(col => hidden_columns.includes(col));", + " if (allDiffHidden) {", + " Reactable.setHiddenColumns('", element_id, "', prevColumns => { + return prevColumns.filter(col => !diffCols.includes(col))})", + " } else {", + " Reactable.setHiddenColumns('", element_id, "', prevColumns => { + return [...new Set([...prevColumns, ...diffCols])]})", + " }", + "}", + "control_diff(Reactable.getState('", element_id, "').hiddenColumns);" + ) + + buttons <- c(buttons, list( + htmltools::tags$button( + "Show/Hide Risk Difference", + onclick = on_click_diff + ) + )) + } + + + + if (length(buttons) > 0) { + tbl <- htmltools::tagList( + buttons, tbl ) } diff --git a/_pkgdown.yml b/_pkgdown.yml index e615f6d..9dc8eab 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -37,6 +37,7 @@ articles: - customize-color - customize-ae-specific-columns - customize-diff-label + - customize-toggle-buttons - customize-xlimit - customize-width - customize-display-only-soc diff --git a/man/ae_forestly.Rd b/man/ae_forestly.Rd index b9b07e4..7cfc129 100644 --- a/man/ae_forestly.Rd +++ b/man/ae_forestly.Rd @@ -7,6 +7,7 @@ ae_forestly( outdata, display_soc_toggle = TRUE, + display_diff_toggle = FALSE, filter = c("prop", "n"), filter_label = NULL, filter_range = NULL, @@ -21,6 +22,8 @@ ae_forestly( \item{display_soc_toggle}{A boolean value to display SOC toggle button.} +\item{display_diff_toggle}{A boolean value to display risk difference toggle button.} + \item{filter}{A character value of the filter variable.} \item{filter_label}{A character value of the label for slider bar.} diff --git a/man/format_ae_forestly.Rd b/man/format_ae_forestly.Rd index 77850ba..a97832e 100644 --- a/man/format_ae_forestly.Rd +++ b/man/format_ae_forestly.Rd @@ -17,10 +17,10 @@ format_ae_forestly( prop_range = NULL, diff_range = NULL, color = NULL, + ae_col_header = NULL, diff_label = "Treatment <- Favor -> Placebo", - col_header = NULL, - fig_header = NULL, - show_ae_parameter = FALSE + diff_col_header = NULL, + diff_fig_header = NULL ) } \arguments{ @@ -58,15 +58,17 @@ for risk difference figure.} \item{color}{A vector of colors for analysis groups. Default value supports up to 4 groups.} +\item{ae_col_header}{Column header for adverse events item columns. +If NULL (default) and "par" specified in \code{components} from \code{prepare_ae_forestly()}, uses "Adverse Event". +If NULL and "soc" specified in \code{components} from \code{prepare_ae_forestly()}, uses "System Organ Class" for "soc".} + \item{diff_label}{x-axis label for risk difference.} -\item{col_header}{Column header for risk difference table columns. +\item{diff_col_header}{Column header for risk difference table columns. If NULL (default), uses "Risk Difference (\%) \if{html}{\out{
}} vs. Reference Group".} -\item{fig_header}{Column header for risk difference figure. +\item{diff_fig_header}{Column header for risk difference figure. If NULL (default), uses "Risk Difference (\%) + 95\% CI \if{html}{\out{
}} vs. Reference Group".} - -\item{show_ae_parameter}{A boolean value to display AE parameter column.} } \value{ An \code{outdata} object. diff --git a/tests/testthat/test-ae_forestly.R b/tests/testthat/test-ae_forestly.R index 6e279f8..bbd5444 100644 --- a/tests/testthat/test-ae_forestly.R +++ b/tests/testthat/test-ae_forestly.R @@ -17,3 +17,34 @@ test_that("ae_forestly(): test filter and width option", { expect_true(grepl("width:1500px", html$children[[1]], fixed = TRUE)) expect_true(grepl("Number of AE in One or More Treatment Groups", html$children[[1]], fixed = TRUE)) }) + +test_that("ae_forestly(): toggle risk difference button is hidden by default", { + outdata <- metalite.ae::meta_ae_example() |> + prepare_ae_forestly( + population = "apat", + observation = "wk12", + parameter = "any;rel;ser" + ) |> + format_ae_forestly(display = c("n", "prop", "fig_prop", "fig_diff", "diff")) + + html <- outdata |> ae_forestly(display_diff_toggle = FALSE) + html_text <- as.character(html) + + expect_false(grepl("Show/Hide Risk Difference", html_text, fixed = TRUE)) +}) + +test_that("ae_forestly(): toggle risk difference button can be enabled", { + outdata <- metalite.ae::meta_ae_example() |> + prepare_ae_forestly( + population = "apat", + observation = "wk12", + parameter = "any;rel;ser" + ) |> + format_ae_forestly(display = c("n", "prop", "fig_prop", "fig_diff", "diff")) + + html <- outdata |> ae_forestly(display_diff_toggle = TRUE) + html_text <- as.character(html) + + expect_true(grepl("Show/Hide Risk Difference", html_text, fixed = TRUE)) + expect_true(grepl("control_diff", html_text, fixed = TRUE)) +}) diff --git a/tests/testthat/test-format_ae_forestly.R b/tests/testthat/test-format_ae_forestly.R index c1df0de..9f768d1 100644 --- a/tests/testthat/test-format_ae_forestly.R +++ b/tests/testthat/test-format_ae_forestly.R @@ -11,8 +11,7 @@ test_that("Set `display` to ('n', 'prop', 'diff') then one has an additional ris width_diff = 80, footer_space = 90, color = NULL, - diff_label = "Treatment <- Favor -> Placebo", - show_ae_parameter = FALSE + diff_label = "Treatment <- Favor -> Placebo" ) # expect_named(ae_frm, c("n", "prop", "diff")) @@ -35,8 +34,7 @@ test_that("Set `display` to ('n', 'prop', 'total') then one has total column", { width_diff = 80, footer_space = 90, color = NULL, - diff_label = "Treatment <- Favor -> Placebo", - show_ae_parameter = FALSE + diff_label = "Treatment <- Favor -> Placebo" ) # expect_named(ae_frm, c("n", "prop", "total")) @@ -59,8 +57,7 @@ test_that("Set `display` to ('diff', 'total') without ('n', 'prop') columns", { width_diff = 80, footer_space = 90, color = NULL, - diff_label = "Treatment <- Favor -> Placebo", - show_ae_parameter = FALSE + diff_label = "Treatment <- Favor -> Placebo" ) # expect_named(ae_frm, c("n", "prop", "total")) @@ -83,8 +80,7 @@ test_that("1. Set `display` to ('n', 'prop', 'total', 'diff') and change column width_diff = 80, footer_space = 90, color = NULL, - diff_label = "MK-XXXX <- Favor -> Placebo", - show_ae_parameter = FALSE + diff_label = "MK-XXXX <- Favor -> Placebo" ) expect_equal(ae_frm$reactable_columns$diff_fig$width, 300) @@ -96,7 +92,7 @@ test_that("1. Set `display` to ('n', 'prop', 'total', 'diff') and change column expect_equal(ae_frm$reactable_columns$prop_4$minWidth, 60) }) -test_that("Set `show` to TRUE then display column 'Type' and change color for tratment group", { +test_that("Parameter column is always hidden", { out <- test_format_ae_forestly() ae_frm <- format_ae_forestly( out, @@ -109,11 +105,11 @@ test_that("Set `show` to TRUE then display column 'Type' and change color for tr width_diff = 80, footer_space = 90, color = c("BLACK", "BLUE", "YELLOW", "PINK"), - diff_label = "Treatment <- Favor -> Placebo", - show_ae_parameter = TRUE + diff_label = "Treatment <- Favor -> Placebo" ) expect_equal(ae_frm$reactable_columns$parameter$header, "Type") + expect_equal(ae_frm$reactable_columns$parameter$show, FALSE) }) test_that("Add variable name not in n, prop, total, diff causes error", { diff --git a/vignettes/customize-ae-specific-columns.Rmd b/vignettes/customize-ae-specific-columns.Rmd index 1f03c5c..3922cbb 100644 --- a/vignettes/customize-ae-specific-columns.Rmd +++ b/vignettes/customize-ae-specific-columns.Rmd @@ -104,4 +104,4 @@ meta |> prepare_ae_forestly() |> format_ae_forestly(display = c("n", "prop", "fig_prop", "fig_diff", "total")) |> ae_forestly() -``` +``` \ No newline at end of file diff --git a/vignettes/customize-toggle-buttons.Rmd b/vignettes/customize-toggle-buttons.Rmd new file mode 100644 index 0000000..2975e95 --- /dev/null +++ b/vignettes/customize-toggle-buttons.Rmd @@ -0,0 +1,92 @@ +--- +title: "Toggle Risk Difference Columns in the AE-Specific Tables" +authors: "Yujie Zhao" +output: + rmarkdown::html_document: + self_contained: no + number_sections: yes + code_folding: hide +vignette: | + %\VignetteIndexEntry{Toggle Risk Difference Columns in the AE-Specific Tables} + %\VignetteEngine{knitr::rmarkdown} + %\VignetteEncoding{UTF-8} +--- + +```{r, include = FALSE} +knitr::opts_chunk$set( + collapse = TRUE, + comment = "#>", + message = FALSE, + warning = FALSE +) +``` + +```{r} +library(forestly) +library(metalite) +``` + +The interactive AE forest plots include AE-specific tables that present both numerical and visual summaries for each AE SOC/PT term. In this vignette, we demonstrate how to toggle the visibility of risk difference columns using an interactive button. + +# Step 1: build your metadata + +Building interactive AE forest plots starts with constructing the metadata. The detailed procedure for building metadata is covered in the vignette [Generate Interactive AE Forest Plots with Drill Down to AE Listing](https://merck.github.io/forestly/articles/forestly.html). Therefore, in this vignette, we will skip those details and directly use the metadata created there. + +```{r} +adsl <- forestly_adsl +adae <- forestly_adae + +adsl$TRTA <- factor(forestly_adsl$TRT01A, + levels = c("Xanomeline Low Dose", "Placebo"), + labels = c("Low Dose", "Placebo") +) +adae$TRTA <- factor(forestly_adae$TRTA, + levels = c("Xanomeline Low Dose", "Placebo"), + labels = c("Low Dose", "Placebo") +) + +meta <- meta_adam(population = adsl, observation = adae) |> + define_plan(plan = plan( + analysis = "ae_forestly", + population = "apat", + observation = "apat", + parameter = "any;drug-related" + )) |> + define_analysis(name = "ae_forestly", label = "Interactive Forest Plot") |> + define_population( + name = "apat", group = "TRTA", id = "USUBJID", + subset = SAFFL == "Y", label = "All Patient as Treated" + ) |> + define_observation( + name = "apat", group = "TRTA", + subset = SAFFL == "Y", label = "All Patient as Treated" + ) |> + define_parameter( + name = "any", + subset = NULL, + label = "Any AEs", + var = "AEDECOD", soc = "AEBODSYS" + ) |> + define_parameter( + name = "drug-related", + subset = toupper(AREL) == "RELATED", + label = "Drug-related AEs", + var = "AEDECOD", soc = "AEBODSYS" + ) |> + meta_build() +``` + + +# Step 2: toggle risk difference columns + +Users can control the display of risk difference columns using the `display_diff_toggle = ...` argument in the `ae_forestly()` function. + +In the example below, we enable the risk difference toggle button by setting `display_diff_toggle = TRUE`. This adds an interactive "Show/Hide Risk Difference" button above the table, allowing users to dynamically show or hide all risk difference related columns, including the difference values (`diff`) and the risk difference visualization (`fig_diff`). + +```{r} +meta |> + prepare_ae_forestly() |> + format_ae_forestly(display = c("n", "prop", "fig_prop", "fig_diff", "diff")) |> + ae_forestly(display_diff_toggle = TRUE, + display_soc_toggle = TRUE) +```