diff --git a/R/ae_forestly.R b/R/ae_forestly.R index 6477686..66de637 100644 --- a/R/ae_forestly.R +++ b/R/ae_forestly.R @@ -31,6 +31,55 @@ #' @param max_page A numeric value of max page number shown in the table. #' @param dowload_button A logical value to display download button. #' +#' @section Searching and filtering: +#' The interactive table has a search box for each column (and, in the +#' expandable detail listing, a table-wide search box). In addition to a +#' plain substring match, the search terms understand two extra styles. +#' +#' **Negation with `!`.** Prefix a term with an exclamation mark to *exclude* +#' matching rows instead of keeping them: +#' +#' \itemize{ +#' \item `Rash` --- keep rows whose value contains "Rash". +#' \item `!Rash` --- keep rows whose value does *not* contain "Rash". +#' } +#' +#' **Expressions.** If the term mentions the letter `x` (which stands for the +#' value of the cell being searched), it is evaluated as a small expression and +#' the row is kept when the expression is true. `x` behaves like the value in +#' that column, so numeric columns can be compared with numbers and text +#' columns with quoted text. Common patterns: +#' +#' \tabular{ll}{ +#' \strong{Type this in the search box} \tab \strong{Keeps rows where} \cr +#' `x > 5` \tab the value is greater than 5 \cr +#' `x >= 5` \tab the value is 5 or more \cr +#' `x < 65` \tab the value is less than 65 \cr +#' `x >= 18 && x <= 65` \tab the value is between 18 and 65 (inclusive) \cr +#' `x == 0` \tab the value equals 0 \cr +#' `x === "Rash"` \tab the value is exactly "Rash" \cr +#' `x !== "Rash"` \tab the value is anything except exactly "Rash" \cr +#' `x.includes("itch")` \tab the text contains "itch" \cr +#' `!x.includes("itch")` \tab the text does not contain "itch" \cr +#' `x.startsWith("Application")` \tab the text starts with "Application" \cr +#' `x.endsWith("itis")` \tab the text ends with "itis" \cr +#' `x === "M" || x === "F"` \tab the value is either "M" or "F" \cr +#' } +#' +#' Notes for the expression style: +#' \itemize{ +#' \item Wrap text values in quotes (`"Rash"`); numbers need no quotes (`5`). +#' \item Use `&&` for "and", `||` for "or", and `!` in front of a condition +#' for "not". +#' \item Comparisons use doubled symbols: `===` (equal), `!==` (not equal), +#' together with `>`, `>=`, `<`, `<=`. +#' \item Matching is case-sensitive in the expression style, so `x === "m"` +#' will not match "M". Use the plain substring style (which ignores case) +#' when case does not matter. +#' \item A term that mentions `x` but is not a valid expression is treated as +#' an ordinary substring search, so everyday searches keep working. +#' } +#' #' @return An AE forest plot saved as a `shiny.tag.list` object. #' #' @export @@ -256,6 +305,10 @@ ae_forestly <- function(outdata, # Extract labels for use in column definitions labels <- lapply(t_details, function(x) attr(x, "label")) + # Per-column filter supporting substring search, `!` negation, and JS + # expressions referencing the cell value `x` (see search_filter_js()). + col_filter_method <- search_filter_js("column") + # Create named column definitions using the labels col_defs <- stats::setNames( lapply(names(t_details), function(name) { @@ -265,7 +318,8 @@ ae_forestly <- function(outdata, header = label_name, # Use header instead of name cell = function(value) format(value, nsmall = 1), align = "center", - minWidth = 70 + minWidth = 70, + filterMethod = col_filter_method ) }), names(t_details) @@ -279,6 +333,7 @@ ae_forestly <- function(outdata, resizable = TRUE, filterable = TRUE, searchable = TRUE, + searchMethod = search_filter_js("table"), showPageSizeOptions = TRUE, borderless = TRUE, striped = TRUE, diff --git a/R/format_ae_forestly.R b/R/format_ae_forestly.R index bcec76d..f8faabd 100644 --- a/R/format_ae_forestly.R +++ b/R/format_ae_forestly.R @@ -278,6 +278,10 @@ format_ae_forestly <- function( # Column Definition ---- + # Filter method for the Adverse Event column: substring match, `!` negation, + # and JS expressions referencing the cell value `x` (see search_filter_js()). + text_filter_method <- search_filter_js("column") + # Format variables for group col_var <- list( parameter = reactable::colDef( @@ -286,7 +290,8 @@ format_ae_forestly <- function( ), name = reactable::colDef( header = ae_col_header, - minWidth = width_term, align = "right" + minWidth = width_term, align = "right", + filterMethod = text_filter_method ), soc_name = reactable::colDef( header = "SOC Name", diff --git a/R/search_filter.R b/R/search_filter.R new file mode 100644 index 0000000..75330e7 --- /dev/null +++ b/R/search_filter.R @@ -0,0 +1,111 @@ +# Copyright (c) 2023 Merck & Co., Inc., Rahway, NJ, USA and its affiliates. +# All rights reserved. +# +# This file is part of the forestly program. +# +# forestly is free software: you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation, either version 3 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see . + +#' Build a reactable search / filter function supporting negation and expressions +#' +#' Returns a `reactable::JS()` callback that can be used either as a per-column +#' `filterMethod` or as a table-wide `searchMethod`. In both cases it supports: +#' +#' * Substring matching, with a leading `!` to negate (e.g. `!Rash` keeps rows +#' that do *not* contain "Rash"). +#' * JavaScript expression evaluation when the term references the cell value +#' `x` (e.g. `x > 5`, `x !== "Rash"`, `!x.includes("Rash")`). The expression +#' is tested against both the string and, when applicable, the numeric form of +#' each cell. +#' +#' A row is kept when *any* searched cell satisfies a positive test, and only +#' when *every* searched cell satisfies a negation test (so rows containing the +#' excluded value are dropped). For a single-column filter these two rules +#' collapse to the same thing. +#' +#' @param scope Either `"column"` for a per-column `filterMethod` +#' (signature `function(rows, columnId, filterValue)`) or `"table"` for a +#' table-wide `searchMethod` (signature +#' `function(rows, columnIds, filterValue)`). +#' +#' @return A `reactable::JS()` object. +#' +#' @noRd +search_filter_js <- function(scope = c("column", "table")) { + scope <- match.arg(scope) + + # The body is identical for both scopes once the set of searched column ids + # is normalized to an array: a per-column filter searches `[columnId]`, a + # table-wide search searches all `columnIds`. Iterating with some()/every() + # over a one-element array reduces to testing that single cell. + signature <- if (scope == "column") { + "function(rows, columnId, filterValue)" + } else { + "function(rows, columnIds, filterValue)" + } + ids <- if (scope == "column") "[columnId]" else "columnIds" + + reactable::JS(sprintf( + "%s { + var v = filterValue.trim(); + if (v === '') return rows; + var ids = %s; + // JS expression mode: the term references the cell variable `x` + // (e.g. `x > 5`, `x !== \"Rash\"`, `!x.includes(\"Rash\")`). + if (/(^|[^\\w$])x([^\\w$]|$)/.test(v)) { + var fn; + try { + fn = new Function('x', 'return (' + v + ');'); + } catch (e) { + fn = null; + } + if (fn) { + // Negation expressions (leading `!` or `!=`) keep a row only when + // every searched cell satisfies the test; positive expressions keep + // a row when any searched cell satisfies it. + var isNegation = /^\\s*!|!=/.test(v); + var method = isNegation ? 'every' : 'some'; + var evalCell = function(raw) { + if (raw == null) return isNegation; + try { + var num = Number(raw); + return !!fn(String(raw)) || + (raw !== '' && isFinite(num) && !!fn(num)); + } catch (e) { + return false; + } + }; + return rows.filter(function(row) { + return ids[method](function(id) { + return evalCell(row.values[id]); + }); + }); + } + } + // Substring mode with optional leading `!` for negation. + var negate = v.charAt(0) === '!'; + var term = negate ? v.slice(1).trim() : v; + if (term === '') return rows; + var needle = term.toLowerCase(); + return rows.filter(function(row) { + var match = ids.some(function(id) { + var raw = row.values[id]; + return raw != null && + String(raw).toLowerCase().indexOf(needle) > -1; + }); + return negate ? !match : match; + }); + }", + signature, ids + )) +} diff --git a/man/ae_forestly.Rd b/man/ae_forestly.Rd index 164076f..facd382 100644 --- a/man/ae_forestly.Rd +++ b/man/ae_forestly.Rd @@ -46,6 +46,57 @@ An AE forest plot saved as a \code{shiny.tag.list} object. \description{ Display interactive forest plot } +\section{Searching and filtering}{ + +The interactive table has a search box for each column (and, in the +expandable detail listing, a table-wide search box). In addition to a +plain substring match, the search terms understand two extra styles. + +\strong{Negation with \code{!}.} Prefix a term with an exclamation mark to \emph{exclude} +matching rows instead of keeping them: + +\itemize{ +\item \code{Rash} --- keep rows whose value contains "Rash". +\item \code{!Rash} --- keep rows whose value does \emph{not} contain "Rash". +} + +\strong{Expressions.} If the term mentions the letter \code{x} (which stands for the +value of the cell being searched), it is evaluated as a small expression and +the row is kept when the expression is true. \code{x} behaves like the value in +that column, so numeric columns can be compared with numbers and text +columns with quoted text. Common patterns: + +\tabular{ll}{ +\strong{Type this in the search box} \tab \strong{Keeps rows where} \cr +\code{x > 5} \tab the value is greater than 5 \cr +\code{x >= 5} \tab the value is 5 or more \cr +\code{x < 65} \tab the value is less than 65 \cr +\code{x >= 18 && x <= 65} \tab the value is between 18 and 65 (inclusive) \cr +\code{x == 0} \tab the value equals 0 \cr +\verb{x === "Rash"} \tab the value is exactly "Rash" \cr +\verb{x !== "Rash"} \tab the value is anything except exactly "Rash" \cr +\code{x.includes("itch")} \tab the text contains "itch" \cr +\code{!x.includes("itch")} \tab the text does not contain "itch" \cr +\code{x.startsWith("Application")} \tab the text starts with "Application" \cr +\code{x.endsWith("itis")} \tab the text ends with "itis" \cr +\verb{x === "M" || x === "F"} \tab the value is either "M" or "F" \cr +} + +Notes for the expression style: +\itemize{ +\item Wrap text values in quotes (\code{"Rash"}); numbers need no quotes (\code{5}). +\item Use \code{&&} for "and", \code{||} for "or", and \code{!} in front of a condition +for "not". +\item Comparisons use doubled symbols: \verb{===} (equal), \verb{!==} (not equal), +together with \code{>}, \code{>=}, \code{<}, \code{<=}. +\item Matching is case-sensitive in the expression style, so \verb{x === "m"} +will not match "M". Use the plain substring style (which ignores case) +when case does not matter. +\item A term that mentions \code{x} but is not a valid expression is treated as +an ordinary substring search, so everyday searches keep working. +} +} + \examples{ adsl <- forestly_adsl[1:100, ] adae <- forestly_adae[1:100, ] diff --git a/tests/testthat/test-ae_forestly.R b/tests/testthat/test-ae_forestly.R index bbd5444..ae4c0af 100644 --- a/tests/testthat/test-ae_forestly.R +++ b/tests/testthat/test-ae_forestly.R @@ -18,6 +18,17 @@ test_that("ae_forestly(): test filter and width option", { expect_true(grepl("Number of AE in One or More Treatment Groups", html$children[[1]], fixed = TRUE)) }) +test_that("ae_forestly(): detail table embeds custom search method", { + outdata <- test_ae_forestly() + html <- outdata |> ae_forestly() + html_text <- as.character(html) + + # Custom searchMethod supporting substring, `!` negation, and JS expressions + expect_true(grepl("searchMethod", html_text, fixed = TRUE)) + expect_true(grepl("var negate = v.charAt(0) === '!'", html_text, fixed = TRUE)) + expect_true(grepl("new Function('x'", html_text, fixed = TRUE)) +}) + test_that("ae_forestly(): toggle risk difference button is hidden by default", { outdata <- metalite.ae::meta_ae_example() |> prepare_ae_forestly(