add filter_data_list function

NAMESPACE

@@ -9,6 +9,7 @@ export(clear_cache_dir)
 export(combine_tables)
 export(download_file)
 export(extract_archive)
+export(filter_data_list)
 export(get_cache_dir)
 export(get_file_ext)
 export(get_file_size)

R/filter_data_list.R

+#' Filter Data List Column
+#'
+#' @description Create a data list column filter for a React Table.
+#'   Requires that the \pkg{htmltools} packages is available.
+#'
+#' @param table_id 'character' string.
+#'   Unique table identifier.
+#' @param style 'character' string.
+#'   CSS style applied to input HTML tag.
+#'
+#' @return Returns a function to perform filtering.
+#'
+#' @export
+#'
+#' @keywords internal
+#'
+#' @examples
+#' f <- filter_data_list("table-id")
+
+# Code adapted from R-package 'reactable' vignette at
+# https://github.com/glin/reactable/blob/HEAD/vignettes/custom-filtering.Rmd
+# Accessed on 2024-05-30
+# License: MIT
+# YEAR: 2019
+# COPYRIGHT HOLDER: Greg Lin, Tanner Linsley
+
+filter_data_list <- function(table_id, style = "width: 100%; height: 28px;") {
+
+  # check system dependencies
+  if (!requireNamespace("htmltools", quietly = TRUE)) {
+    stop("Creating a data list column filter requires the 'htmltools' package", call. = FALSE)
+  }
+
+  # check arguments
+  checkmate::assert_string(table_id)
+  checkmate::assert_string(style)
+
+  # make function
+  function(values, name) {
+    list_id <- sprintf("%s-%s-list", table_id, name)
+    htmltools::tagList(
+      htmltools::tags$input(
+        type = "text",
+        list = list_id,
+        oninput = sprintf(
+          "Reactable.setFilter('%s', '%s', event.target.value || undefined)",
+          table_id, name
+        ),
+        "aria-label" = sprintf("Filter %s", name),
+        style = style
+      ),
+      htmltools::tags$datalist(
+        id = list_id,
+        lapply(sort(unique(values)),
+          FUN = function(x) {
+            htmltools::tags$option(value = x)
+          }
+        )
+      )
+    )
+  }
+
+}

man/filter_data_list.Rd

+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/filter_data_list.R
+\name{filter_data_list}
+\alias{filter_data_list}
+\title{Filter Data List Column}
+\usage{
+filter_data_list(table_id, style = "width: 100\%; height: 28px;")
+}
+\arguments{
+\item{table_id}{'character' string.
+Unique table identifier.}
+
+\item{style}{'character' string.
+CSS style applied to input HTML tag.}
+}
+\value{
+Returns a function to perform filtering.
+}
+\description{
+Create a data list column filter for a React Table.
+Requires that the \pkg{htmltools} packages is available.
+}
+\examples{
+f <- filter_data_list("table-id")
+}
+\keyword{internal}

vignettes/background.Rmd

@@ -11,17 +11,6 @@ Water-quality background concentrations for selected radionuclides, organic comp
 
 data <- inldata::background
 
-filter_input <- function(values, name) {
-  choices <- values |> unique() |> stats::na.omit() |> as.character() |> sort()
-  htmltools::tags$select(
-    onchange = sprintf("Reactable.setFilter('background-table', '%s', event.target.value || undefined)", name),
-    htmltools::tags$option(value = "", "All"),
-    lapply(choices, FUN = htmltools::tags$option),
-    "aria-label" = paste("Filter", name),
-    style = "width: 100%; height: 28px;"
-  )
-}
-
 urls <- c(
   "Bartholomay and Hall (2016)" = "https://doi.org/10.3133/sir20165056",
   "Knobel and others (1992)" = NA_character_,
@@ -74,7 +63,7 @@ columns <- list(
         htmltools::tags$a(href = href, target = "_blank", value)
       }
     },
-    filterInput = filter_input
+    filterInput = inldata::filter_data_list(table_id = "background-table")
   )
 )
 

vignettes/dl.Rmd

@@ -11,17 +11,6 @@ Analytical method detection limits of selected radionuclides based on laboratory
 
 data <- inldata::dl
 
-filter_input <- function(values, name) {
-  choices <- values |> unique() |> stats::na.omit() |> as.character() |> sort()
-  htmltools::tags$select(
-    onchange = sprintf("Reactable.setFilter('dl-table', '%s', event.target.value || undefined)", name),
-    htmltools::tags$option(value = "", "All"),
-    lapply(choices, FUN = htmltools::tags$option),
-    "aria-label" = paste("Filter", name),
-    style = "width: 100%; height: 28px;"
-  )
-}
-
 urls <- c(
   "Bartholomay and others (2003, table 9)" = "https://doi.org/10.3133/ofr0342",
   "Bartholomay and others (2014, table D1)" = "https://pubs.usgs.gov/of/2014/1146/",
@@ -73,7 +62,7 @@ columns <- list(
         htmltools::tags$a(href = href, target = "_blank", value)
       }
     },
-    filterInput = filter_input
+    filterInput = inldata::filter_data_list(table_id = "dl-table")
   )
 )
 

vignettes/parameters.Rmd

@@ -20,17 +20,6 @@ Parameter information for `r nparameters` chemical constituents, organic compoun
 
 data <- inldata::parameters
 
-filter_input <- function(values, name) {
-  choices <- values |> unique() |> stats::na.omit() |> as.character() |> sort()
-  htmltools::tags$select(
-    onchange = sprintf("Reactable.setFilter('parameters-table', '%s', event.target.value || undefined)", name),
-    htmltools::tags$option(value = "", "All"),
-    lapply(choices, FUN = htmltools::tags$option),
-    "aria-label" = paste("Filter", name),
-    style = "width: 100%; height: 28px;"
-  )
-}
-
 columns <- list(
 
   "parm_nm" = reactable::colDef(
@@ -52,7 +41,7 @@ columns <- list(
       title = "Parameter group name."
     ),
     minWidth = 120,
-    filterInput = filter_input
+    filterInput = inldata::filter_data_list(table_id = "parameters-table")
   ),
 
   "casrn" = reactable::colDef(
@@ -75,7 +64,7 @@ columns <- list(
       title = "Parameter units of measurement."
     ),
     minWidth = 120,
-    filterInput = filter_input
+    filterInput = inldata::filter_data_list(table_id = "parameters-table")
   ),
 
   "min_dt" = reactable::colDef(

vignettes/sites.Rmd

@@ -96,17 +96,6 @@ map
 
 data <- as.data.frame(inldata::sites)
 
-filter_input <- function(values, name) {
-  choices <- values |> unique() |> stats::na.omit() |> as.character() |> sort()
-  htmltools::tags$select(
-    onchange = sprintf("Reactable.setFilter('sites-table', '%s', event.target.value || undefined)", name),
-    htmltools::tags$option(value = "", "All"),
-    lapply(choices, FUN = htmltools::tags$option),
-    "aria-label" = paste("Filter", name),
-    style = "width: 100%; height: 28px;"
-  )
-}
-
 columns <- list(
 
   "site_nm" = reactable::colDef(
@@ -205,7 +194,7 @@ columns <- list(
         "'P' is an open hole completion prior to multilevel completion."
       )
     ),
-    filterInput = filter_input
+    filterInput = inldata::filter_data_list(table_id = "sites-table")
   ),
 
   "network_cd" = reactable::colDef(
@@ -217,7 +206,7 @@ columns <- list(
         "'S' is the surface-water monitoring network."
       )
     ),
-    filterInput = filter_input
+    filterInput = inldata::filter_data_list(table_id = "sites-table")
   ),
 
   "construction_dt" = reactable::colDef(