Add negation and JS-expression search in AE listing detail table

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,

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",

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 <http://www.gnu.org/licenses/>.
+
+#' 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
+  ))
+}

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(