diff --git a/NAMESPACE b/NAMESPACE
index 1b0b0a2b92561c8349cf65577baad55aa831ed5e..bc0a50587f91b04a4635d593623f4b0cfb1d9543 100644
--- a/NAMESPACE
+++ b/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)
diff --git a/R/filter_data_list.R b/R/filter_data_list.R
new file mode 100644
index 0000000000000000000000000000000000000000..985f3492bb8740fb1db62e027efa5396d9385731
--- /dev/null
+++ b/R/filter_data_list.R
@@ -0,0 +1,63 @@
+#' 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)
+ }
+ )
+ )
+ )
+ }
+
+}
diff --git a/man/filter_data_list.Rd b/man/filter_data_list.Rd
new file mode 100644
index 0000000000000000000000000000000000000000..bf1a210a92c06dca48c57c79ba64f17048dbe310
--- /dev/null
+++ b/man/filter_data_list.Rd
@@ -0,0 +1,26 @@
+% 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}
diff --git a/vignettes/background.Rmd b/vignettes/background.Rmd
index c8ea3015495c07cf6a89ade9523e1645c6f04fe5..1f229992bbaaa041e4fe847abe77954b0c043e7b 100644
--- a/vignettes/background.Rmd
+++ b/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")
)
)
diff --git a/vignettes/dl.Rmd b/vignettes/dl.Rmd
index 7d87efdd3ac5b8365f3bf4de15de97bc100191e4..354045eb97e48bf1148e6f647325bf9eb62513e0 100644
--- a/vignettes/dl.Rmd
+++ b/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")
)
)
diff --git a/vignettes/parameters.Rmd b/vignettes/parameters.Rmd
index 30314cbac19779159c0ed825883b3eaa26dbd622..e5c88360c2134c849fb55c4fb3d191a78d68c771 100644
--- a/vignettes/parameters.Rmd
+++ b/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(
diff --git a/vignettes/sites.Rmd b/vignettes/sites.Rmd
index 6397eed0fd293735f91bf1d86ccc81bc97111ed7..e0eb0cae2fbb833f4ce3da36da20b8ec126f494b 100644
--- a/vignettes/sites.Rmd
+++ b/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(