From 352b6f642cbfda368df2f1975877a1ae3ee81691 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Mon, 6 Mar 2023 10:24:43 -0500 Subject: [PATCH 001/101] Allow column preselection for filter inclusion --- R/shiny_data_filter.R | 22 +++++++++++++++++++++- 1 file changed, 21 insertions(+), 1 deletion(-) diff --git a/R/shiny_data_filter.R b/R/shiny_data_filter.R index 3bc65fe..dedfd17 100644 --- a/R/shiny_data_filter.R +++ b/R/shiny_data_filter.R @@ -117,7 +117,7 @@ shiny_data_filter_ui <- function(inputId) { #' shinyApp(ui = ui, server = server) #' } #' -shiny_data_filter <- function(input, output, session, data, verbose = FALSE) { +shiny_data_filter <- function(input, output, session, data, preselection = NULL, verbose = FALSE) { ns <- session$ns filter_log("calling module", verbose = verbose) @@ -198,6 +198,26 @@ shiny_data_filter <- function(input, output, session, data, verbose = FALSE) { ui = shiny_data_filter_item_ui(ns(fid), verbose = verbose)) }) + observeEvent(input$add_filter_select, { + req(preselection) + + filter_log("observing pre-selected columns", verbose = verbose) + + for (col_sel in preselection) { + if (!col_sel %in% names(datar())) next() + + update_filter(fid <- next_filter_id(), column_name = col_sel) + filters(append(filters(), fid)) + + insertUI( + selector = sprintf("#%s", ns("sortableList")), + where = "beforeEnd", + ui = shiny_data_filter_item_ui(ns(fid), verbose = verbose)) + + updateSelectInput(session, "add_filter_select", selected = "") + } + }, once = TRUE) + observeEvent(input$add_filter_select, { if (!input$add_filter_select %in% names(datar())) return() From 665a25f85b38f6bf692243c5b236dc1681ae3ce2 Mon Sep 17 00:00:00 2001 From: Jinhwan Kim Date: Wed, 12 Jul 2023 00:35:08 +0900 Subject: [PATCH 002/101] Update shiny_data_filter.R replaced deprecated code with structure(NULL, *) --- R/shiny_data_filter.R | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/R/shiny_data_filter.R b/R/shiny_data_filter.R index 3bc65fe..b1c2983 100644 --- a/R/shiny_data_filter.R +++ b/R/shiny_data_filter.R @@ -247,8 +247,12 @@ shiny_data_filter <- function(input, output, session, data, verbose = FALSE) { reactive({ filter_log("recalculating filtered data", verbose = verbose) structure( - d <- filter_returns[[utils::tail(filters(), 1)]]$data(), + d <- ifelse( + is.null(filter_returns[[utils::tail(filters(), 1)]]$data()), + list(), + filter_returns[[utils::tail(filters(), 1)]]$data() + ), code = code(), class = c("shinyDataFilter_df", class(d))) }) -} \ No newline at end of file +} From c4456d7c6cdeea112e4eff63d5f82ee8968f71b8 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Wed, 26 Jul 2023 13:03:07 -0400 Subject: [PATCH 003/101] Add basic framework --- R/shiny_data_filter.R | 14 +++++++++----- R/shiny_data_filter_item.R | 7 +++++-- R/shiny_vector_filter.R | 2 +- R/shiny_vector_filter_NULL.R | 2 +- R/shiny_vector_filter_character.R | 2 +- R/shiny_vector_filter_date.R | 2 +- R/shiny_vector_filter_datetime.R | 2 +- R/shiny_vector_filter_factor_few.R | 2 +- R/shiny_vector_filter_factor_many.R | 2 +- R/shiny_vector_filter_logical.R | 2 +- R/shiny_vector_filter_numeric_few.R | 2 +- R/shiny_vector_filter_numeric_many.R | 2 +- 12 files changed, 24 insertions(+), 17 deletions(-) diff --git a/R/shiny_data_filter.R b/R/shiny_data_filter.R index dedfd17..bce8fbf 100644 --- a/R/shiny_data_filter.R +++ b/R/shiny_data_filter.R @@ -138,7 +138,7 @@ shiny_data_filter <- function(input, output, session, data, preselection = NULL, code = reactive(TRUE), remove = NULL)) - update_filter <- function(fid, in_fid, column_name = NULL) { + update_filter <- function(fid, in_fid, column_name = NULL, preselection = NULL) { fs <- isolate(filters()) if (missing(in_fid)) @@ -158,7 +158,8 @@ shiny_data_filter <- function(input, output, session, data, preselection = NULL, fid, data = filter_returns[[in_fid]]$data, column_name = column_name, - verbose = verbose) + verbose = verbose, + preselection = preselection) } output$add_filter_select_ui <- renderUI({ @@ -203,10 +204,13 @@ shiny_data_filter <- function(input, output, session, data, preselection = NULL, filter_log("observing pre-selected columns", verbose = verbose) - for (col_sel in preselection) { - if (!col_sel %in% names(datar())) next() + for (col_sel in (names(preselection) %||% preselection)) { + if (!col_sel %in% names(datar())) { + warning(sprintf("Unable to add `%s` to filter list.", col_sel)) + next() + } - update_filter(fid <- next_filter_id(), column_name = col_sel) + update_filter(fid <- next_filter_id(), column_name = col_sel, preselection = if(is.list(preselection)) preselection[[col_sel]]) filters(append(filters(), fid)) insertUI( diff --git a/R/shiny_data_filter_item.R b/R/shiny_data_filter_item.R index 329e2ed..a3e2f8a 100644 --- a/R/shiny_data_filter_item.R +++ b/R/shiny_data_filter_item.R @@ -53,10 +53,12 @@ shiny_data_filter_item_ui <- function(inputId, verbose = FALSE) { #' @keywords internal #' shiny_data_filter_item <- function(input, output, session, data, - column_name = NULL, verbose = FALSE) { + column_name = NULL, preselection = NULL, verbose = FALSE) { ns <- session$ns + fna <- if ("filter_na" %in% names(preselection)) isTRUE(preselection[["filter_na"]]) else FALSE + module_return <- shiny::reactiveValues( data = data, code = TRUE, @@ -145,7 +147,7 @@ shiny_data_filter_item <- function(input, output, session, data, filter_na <- shiny::reactive({ if (is.null(input$filter_na_btn)) FALSE - else input$filter_na_btn %% 2 == 1 + else (input$filter_na_btn + 1*fna) %% 2 == 1 }) x <- shiny::eventReactive(filter_na(), { filter_log("observing filter_na")}) @@ -177,6 +179,7 @@ shiny_data_filter_item <- function(input, output, session, data, "vector_filter", x = vec, filter_na = filter_na, + filter_expr = preselection[["filter_expr"]], verbose = verbose) }) diff --git a/R/shiny_vector_filter.R b/R/shiny_vector_filter.R index f6d1307..07d53aa 100644 --- a/R/shiny_vector_filter.R +++ b/R/shiny_vector_filter.R @@ -106,7 +106,7 @@ shiny_vector_filter <- function(data, inputId, global = FALSE) { #' @keywords internal shiny_vector_filter.default <- function(data, inputId, ...) { function(input, output, session, x = shiny::reactive(NULL), - filter_na = shiny::reactive(FALSE), verbose = FALSE) { + filter_na = shiny::reactive(FALSE), filter_expr = NULL, verbose = FALSE) { module_return <- shiny::reactiveValues(code = FALSE, mask = FALSE) module_return$code <- shiny::reactive(FALSE) diff --git a/R/shiny_vector_filter_NULL.R b/R/shiny_vector_filter_NULL.R index 10ea625..d806c3b 100644 --- a/R/shiny_vector_filter_NULL.R +++ b/R/shiny_vector_filter_NULL.R @@ -11,7 +11,7 @@ shiny_vector_filter_ui.NULL = function(data, inputId) { #' @keywords internal shiny_vector_filter.NULL <- function(data, inputId, ...) { function(input, output, session, x = shiny::reactive(NULL), - filter_na = shiny::reactive(FALSE), verbose = FALSE) { + filter_na = shiny::reactive(FALSE), filter_expr = NULL, verbose = FALSE) { module_return <- shiny::reactiveValues(code = TRUE, mask = TRUE) module_return$code <- shiny::reactive(TRUE) diff --git a/R/shiny_vector_filter_character.R b/R/shiny_vector_filter_character.R index 28447be..908c8df 100644 --- a/R/shiny_vector_filter_character.R +++ b/R/shiny_vector_filter_character.R @@ -11,7 +11,7 @@ shiny_vector_filter_ui.character <- function(data, inputId) { #' @keywords internal shiny_vector_filter.character <- function(data, inputId, ...) { function(input, output, session, x = shiny::reactive(character()), - filter_na = shiny::reactive(FALSE), verbose = FALSE) { + filter_na = shiny::reactive(FALSE), filter_expr = NULL, verbose = FALSE) { ns <- session$ns diff --git a/R/shiny_vector_filter_date.R b/R/shiny_vector_filter_date.R index a9d1396..e06a749 100644 --- a/R/shiny_vector_filter_date.R +++ b/R/shiny_vector_filter_date.R @@ -12,7 +12,7 @@ shiny_vector_filter_ui.Date <- function(data, inputId) { #' @keywords internal shiny_vector_filter.Date <- function(data, inputId, ...) { function(input, output, session, x = shiny::reactive(Date()), - filter_na = shiny::reactive(FALSE), verbose = FALSE) { + filter_na = shiny::reactive(FALSE), filter_expr = NULL, verbose = FALSE) { ns <- session$ns module_return <- shiny::reactiveValues(code = TRUE, mask = TRUE) diff --git a/R/shiny_vector_filter_datetime.R b/R/shiny_vector_filter_datetime.R index d16d388..ca27374 100644 --- a/R/shiny_vector_filter_datetime.R +++ b/R/shiny_vector_filter_datetime.R @@ -12,7 +12,7 @@ shiny_vector_filter_ui.POSIXct <- function(data, inputId) { #' @keywords internal shiny_vector_filter.POSIXct <- function(data, inputId, ...) { function(input, output, session, x = shiny::reactive(), - filter_na = shiny::reactive(FALSE), verbose = FALSE) { + filter_na = shiny::reactive(FALSE), filter_expr = NULL, verbose = FALSE) { ns <- session$ns module_return <- shiny::reactiveValues(code = TRUE, mask = TRUE) diff --git a/R/shiny_vector_filter_factor_few.R b/R/shiny_vector_filter_factor_few.R index 5667353..6575441 100644 --- a/R/shiny_vector_filter_factor_few.R +++ b/R/shiny_vector_filter_factor_few.R @@ -23,7 +23,7 @@ #' @importFrom grDevices rgb #' @keywords internal shiny_vector_filter_factor_few <- function(input, output, session, - x = shiny::reactive(factor()), filter_na = shiny::reactive(TRUE), + x = shiny::reactive(factor()), filter_na = shiny::reactive(TRUE), filter_expr = NULL, verbose = FALSE) { ns <- session$ns diff --git a/R/shiny_vector_filter_factor_many.R b/R/shiny_vector_filter_factor_many.R index 9e47bca..df1ce72 100644 --- a/R/shiny_vector_filter_factor_many.R +++ b/R/shiny_vector_filter_factor_many.R @@ -19,7 +19,7 @@ #' @importFrom shiny reactive reactiveValues renderUI selectInput isolate #' @keywords internal shiny_vector_filter_factor_many <- function(input, output, session, - x = shiny::reactive(factor()), filter_na = shiny::reactive(FALSE), + x = shiny::reactive(factor()), filter_na = shiny::reactive(FALSE), filter_expr = NULL, verbose = FALSE) { ns <- session$ns diff --git a/R/shiny_vector_filter_logical.R b/R/shiny_vector_filter_logical.R index 61005d9..69f5990 100644 --- a/R/shiny_vector_filter_logical.R +++ b/R/shiny_vector_filter_logical.R @@ -12,7 +12,7 @@ shiny_vector_filter_ui.logical <- function(data, inputId) { #' @keywords internal shiny_vector_filter.logical <- function(data, inputId, ...) { function(input, output, session, - x = shiny::reactive(logical()), filter_na = shiny::reactive(TRUE), + x = shiny::reactive(logical()), filter_na = shiny::reactive(TRUE), filter_expr = NULL, verbose = FALSE) { ns <- session$ns diff --git a/R/shiny_vector_filter_numeric_few.R b/R/shiny_vector_filter_numeric_few.R index b3c790c..3154e8a 100644 --- a/R/shiny_vector_filter_numeric_few.R +++ b/R/shiny_vector_filter_numeric_few.R @@ -25,7 +25,7 @@ #' @keywords internal shiny_vector_filter_numeric_few <- function(input, output, session, x = shiny::reactive(factor()), #important: changed x to factor here - filter_na = shiny::reactive(FALSE), verbose = FALSE) { + filter_na = shiny::reactive(FALSE), filter_expr = NULL, verbose = FALSE) { ns <- session$ns diff --git a/R/shiny_vector_filter_numeric_many.R b/R/shiny_vector_filter_numeric_many.R index fc180a5..0090b76 100644 --- a/R/shiny_vector_filter_numeric_many.R +++ b/R/shiny_vector_filter_numeric_many.R @@ -24,7 +24,7 @@ #' @export #' @keywords internal shiny_vector_filter_numeric_many <- function(input, output, session, x = shiny::reactive(numeric()), - filter_na = shiny::reactive(FALSE), verbose = FALSE) { + filter_na = shiny::reactive(FALSE), filter_expr = NULL, verbose = FALSE) { ns <- session$ns module_return <- shiny::reactiveValues(code = TRUE, mask = TRUE) From cbffcd5c5fd4c8f114b94be3de9991a213d7ae75 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Wed, 26 Jul 2023 13:03:51 -0400 Subject: [PATCH 004/101] Implement using an expression in numeric many --- R/shiny_vector_filter_numeric_many.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/R/shiny_vector_filter_numeric_many.R b/R/shiny_vector_filter_numeric_many.R index 0090b76..5517e23 100644 --- a/R/shiny_vector_filter_numeric_many.R +++ b/R/shiny_vector_filter_numeric_many.R @@ -29,6 +29,7 @@ shiny_vector_filter_numeric_many <- function(input, output, session, x = shiny:: ns <- session$ns module_return <- shiny::reactiveValues(code = TRUE, mask = TRUE) + x_filtered <- Filter(function(x) !is.na(x) & eval(if (!is.null(filter_expr)) str2expression(filter_expr) else TRUE), x()) output$ui <- shiny::renderUI({ filter_log("updating ui", verbose = verbose) shiny::div( @@ -41,7 +42,7 @@ shiny_vector_filter_numeric_many <- function(input, output, session, x = shiny:: transform-origin: bottom;"), if (any(!is.na(x()))) { shiny::sliderInput(ns("param"), NULL, - value = shiny::isolate(input$param) %||% range(x(), na.rm = TRUE), + value = range(x_filtered), min = min(round(x(), 1), na.rm = TRUE), max = max(round(x(), 1), na.rm = TRUE)) } else { From 9ab2e48c217289e90dba16773a1711b4a89429bd Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Wed, 26 Jul 2023 13:06:03 -0400 Subject: [PATCH 005/101] Set `dev` version --- DESCRIPTION | 2 +- NEWS.md | 2 ++ 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index aa54ddc..d07a40e 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: IDEAFilter Type: Package -Version: 0.1.3 +Version: 0.1.3.9000 Title: Agnostic, Idiomatic Data Filter Module for Shiny Description: When added to an existing shiny app, users may subset any developer-chosen R data.frame on the fly. That is, users are empowered to diff --git a/NEWS.md b/NEWS.md index 6b9ecee..d348694 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,5 @@ +# IDEAFilter (development version) + # IDEAFilter 0.1.3 * Cited works of other contributors (`shinyDataFilter` & `SortableJS`) From 0ea052c227f9b209ec17ddd15bfc0f3f42aec8c6 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Wed, 26 Jul 2023 13:47:08 -0400 Subject: [PATCH 006/101] Utilize `%||%()` and set appropriate empty data structure --- R/shiny_data_filter.R | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) diff --git a/R/shiny_data_filter.R b/R/shiny_data_filter.R index b1c2983..1addd5b 100644 --- a/R/shiny_data_filter.R +++ b/R/shiny_data_filter.R @@ -247,11 +247,7 @@ shiny_data_filter <- function(input, output, session, data, verbose = FALSE) { reactive({ filter_log("recalculating filtered data", verbose = verbose) structure( - d <- ifelse( - is.null(filter_returns[[utils::tail(filters(), 1)]]$data()), - list(), - filter_returns[[utils::tail(filters(), 1)]]$data() - ), + d <- filter_returns[[utils::tail(filters(), 1)]]$data() %||% data.frame(), code = code(), class = c("shinyDataFilter_df", class(d))) }) From dbd733b03a8b076024f3495520e3c882cc56b58e Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Wed, 26 Jul 2023 13:48:43 -0400 Subject: [PATCH 007/101] Update NEWS --- DESCRIPTION | 2 +- NEWS.md | 1 + 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index d07a40e..d3edf01 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: IDEAFilter Type: Package -Version: 0.1.3.9000 +Version: 0.1.3.9001 Title: Agnostic, Idiomatic Data Filter Module for Shiny Description: When added to an existing shiny app, users may subset any developer-chosen R data.frame on the fly. That is, users are empowered to diff --git a/NEWS.md b/NEWS.md index d348694..6d6d8c9 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,4 +1,5 @@ # IDEAFilter (development version) +* Fix bug that was trying to assign an attribute to a NULL (#15) # IDEAFilter 0.1.3 * Cited works of other contributors (`shinyDataFilter` & `SortableJS`) From 1e7672a3961bef9bf00ec7ea372306a1f5d52b96 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Wed, 26 Jul 2023 14:28:46 -0400 Subject: [PATCH 008/101] Update documentation --- DESCRIPTION | 2 +- R/shiny_data_filter.R | 1 + R/shiny_data_filter_item.R | 1 + R/shiny_vector_filter_factor_few.R | 1 + R/shiny_vector_filter_factor_many.R | 1 + R/shiny_vector_filter_numeric_few.R | 1 + R/shiny_vector_filter_numeric_many.R | 1 + man/shiny_data_filter.Rd | 11 ++++++++++- man/shiny_data_filter_item.Rd | 3 +++ man/shiny_vector_filter_factor_few.Rd | 3 +++ man/shiny_vector_filter_factor_many.Rd | 3 +++ man/shiny_vector_filter_numeric_few.Rd | 3 +++ man/shiny_vector_filter_numeric_many.Rd | 3 +++ 13 files changed, 32 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index d3edf01..d880874 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -37,7 +37,7 @@ URL: https://biogen-inc.github.io/IDEAFilter/, https://github.com/Biogen-Inc/IDE BugReports: https://github.com/Biogen-Inc/IDEAFilter/issues Encoding: UTF-8 LazyData: true -RoxygenNote: 7.1.2 +RoxygenNote: 7.2.3 Imports: shiny, ggplot2, diff --git a/R/shiny_data_filter.R b/R/shiny_data_filter.R index 12bc98e..347561a 100644 --- a/R/shiny_data_filter.R +++ b/R/shiny_data_filter.R @@ -49,6 +49,7 @@ shiny_data_filter_ui <- function(inputId) { #' session #' @param data a \code{data.frame} or \code{reactive expression} returning a #' \code{data.frame} to use as the input to the filter module +#' @param preselection a \code{list} that can be used to pre-populate the filter #' @param verbose a \code{logical} value indicating whether or not to print log #' statements out to the console #' diff --git a/R/shiny_data_filter_item.R b/R/shiny_data_filter_item.R index a3e2f8a..3c3b4b7 100644 --- a/R/shiny_data_filter_item.R +++ b/R/shiny_data_filter_item.R @@ -38,6 +38,7 @@ shiny_data_filter_item_ui <- function(inputId, verbose = FALSE) { #' @param data a \code{reactive expression} returning a \code{data.frame} to use #' as the input to the filter item module #' @param column_name a value indicating the name of the column to be filtered +#' @param preselection a \code{list} that can be used to pre-populate the filter #' @param verbose a \code{logical} value indicating whether or not to print log #' statements out to the console #' diff --git a/R/shiny_vector_filter_factor_few.R b/R/shiny_vector_filter_factor_few.R index 6575441..40f802b 100644 --- a/R/shiny_vector_filter_factor_few.R +++ b/R/shiny_vector_filter_factor_few.R @@ -9,6 +9,7 @@ #' @param x a reactive expression resolving to the vector to filter #' @param filter_na a logical value indicating whether to filter \code{NA} #' values from the \code{x} vector +#' @param filter_expr A character string that can specify initial filtering #' @param verbose a \code{logical} value indicating whether or not to print log #' statements out to the console #' diff --git a/R/shiny_vector_filter_factor_many.R b/R/shiny_vector_filter_factor_many.R index df1ce72..7f9c37d 100644 --- a/R/shiny_vector_filter_factor_many.R +++ b/R/shiny_vector_filter_factor_many.R @@ -9,6 +9,7 @@ #' @param x a reactive expression resolving to the vector to filter #' @param filter_na a logical value indicating whether to filter \code{NA} #' values from the \code{x} vector +#' @param filter_expr A character string that can specify initial filtering #' @param verbose a \code{logical} value indicating whether or not to print log #' statements out to the console #' diff --git a/R/shiny_vector_filter_numeric_few.R b/R/shiny_vector_filter_numeric_few.R index 3154e8a..8ce99b9 100644 --- a/R/shiny_vector_filter_numeric_few.R +++ b/R/shiny_vector_filter_numeric_few.R @@ -8,6 +8,7 @@ #' session #' @param x The TODO #' @param filter_na The \code{logical} TODO +#' @param filter_expr A character string that can specify initial filtering #' @param verbose a \code{logical} value indicating whether or not to print log #' statements out to the console #' diff --git a/R/shiny_vector_filter_numeric_many.R b/R/shiny_vector_filter_numeric_many.R index 5517e23..044873b 100644 --- a/R/shiny_vector_filter_numeric_many.R +++ b/R/shiny_vector_filter_numeric_many.R @@ -8,6 +8,7 @@ #' session #' @param x The TODO #' @param filter_na The \code{logical} TODO +#' @param filter_expr A character string that can specify initial filtering #' @param verbose a \code{logical} value indicating whether or not to print log #' statements out to the console #' diff --git a/man/shiny_data_filter.Rd b/man/shiny_data_filter.Rd index f1e16f6..1401076 100644 --- a/man/shiny_data_filter.Rd +++ b/man/shiny_data_filter.Rd @@ -4,7 +4,14 @@ \alias{shiny_data_filter} \title{Shiny data filter module server function} \usage{ -shiny_data_filter(input, output, session, data, verbose = FALSE) +shiny_data_filter( + input, + output, + session, + data, + preselection = NULL, + verbose = FALSE +) } \arguments{ \item{input}{requisite shiny module field specifying incoming ui input @@ -19,6 +26,8 @@ session} \item{data}{a \code{data.frame} or \code{reactive expression} returning a \code{data.frame} to use as the input to the filter module} +\item{preselection}{a \code{list} that can be used to pre-populate the filter} + \item{verbose}{a \code{logical} value indicating whether or not to print log statements out to the console} } diff --git a/man/shiny_data_filter_item.Rd b/man/shiny_data_filter_item.Rd index d97d1dd..404bb3b 100644 --- a/man/shiny_data_filter_item.Rd +++ b/man/shiny_data_filter_item.Rd @@ -10,6 +10,7 @@ shiny_data_filter_item( session, data, column_name = NULL, + preselection = NULL, verbose = FALSE ) } @@ -28,6 +29,8 @@ as the input to the filter item module} \item{column_name}{a value indicating the name of the column to be filtered} +\item{preselection}{a \code{list} that can be used to pre-populate the filter} + \item{verbose}{a \code{logical} value indicating whether or not to print log statements out to the console} } diff --git a/man/shiny_vector_filter_factor_few.Rd b/man/shiny_vector_filter_factor_few.Rd index ee8bf29..7637ad5 100644 --- a/man/shiny_vector_filter_factor_few.Rd +++ b/man/shiny_vector_filter_factor_few.Rd @@ -10,6 +10,7 @@ shiny_vector_filter_factor_few( session, x = shiny::reactive(factor()), filter_na = shiny::reactive(TRUE), + filter_expr = NULL, verbose = FALSE ) } @@ -28,6 +29,8 @@ session} \item{filter_na}{a logical value indicating whether to filter \code{NA} values from the \code{x} vector} +\item{filter_expr}{A character string that can specify initial filtering} + \item{verbose}{a \code{logical} value indicating whether or not to print log statements out to the console} } diff --git a/man/shiny_vector_filter_factor_many.Rd b/man/shiny_vector_filter_factor_many.Rd index 3f6fea8..62dadc0 100644 --- a/man/shiny_vector_filter_factor_many.Rd +++ b/man/shiny_vector_filter_factor_many.Rd @@ -10,6 +10,7 @@ shiny_vector_filter_factor_many( session, x = shiny::reactive(factor()), filter_na = shiny::reactive(FALSE), + filter_expr = NULL, verbose = FALSE ) } @@ -28,6 +29,8 @@ session} \item{filter_na}{a logical value indicating whether to filter \code{NA} values from the \code{x} vector} +\item{filter_expr}{A character string that can specify initial filtering} + \item{verbose}{a \code{logical} value indicating whether or not to print log statements out to the console} } diff --git a/man/shiny_vector_filter_numeric_few.Rd b/man/shiny_vector_filter_numeric_few.Rd index c2ccfd3..c4852c5 100644 --- a/man/shiny_vector_filter_numeric_few.Rd +++ b/man/shiny_vector_filter_numeric_few.Rd @@ -10,6 +10,7 @@ shiny_vector_filter_numeric_few( session, x = shiny::reactive(factor()), filter_na = shiny::reactive(FALSE), + filter_expr = NULL, verbose = FALSE ) } @@ -27,6 +28,8 @@ session} \item{filter_na}{The \code{logical} TODO} +\item{filter_expr}{A character string that can specify initial filtering} + \item{verbose}{a \code{logical} value indicating whether or not to print log statements out to the console} } diff --git a/man/shiny_vector_filter_numeric_many.Rd b/man/shiny_vector_filter_numeric_many.Rd index 23fa394..696d9ef 100644 --- a/man/shiny_vector_filter_numeric_many.Rd +++ b/man/shiny_vector_filter_numeric_many.Rd @@ -10,6 +10,7 @@ shiny_vector_filter_numeric_many( session, x = shiny::reactive(numeric()), filter_na = shiny::reactive(FALSE), + filter_expr = NULL, verbose = FALSE ) } @@ -27,6 +28,8 @@ session} \item{filter_na}{The \code{logical} TODO} +\item{filter_expr}{A character string that can specify initial filtering} + \item{verbose}{a \code{logical} value indicating whether or not to print log statements out to the console} } From 8e0b38d8e38fccaa9efaa5bcd7873578c73d025b Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Wed, 26 Jul 2023 14:46:53 -0400 Subject: [PATCH 009/101] Use timezone of vector instead of trying to specify --- R/shiny_vector_filter_datetime.R | 26 ++++++++++++-------------- 1 file changed, 12 insertions(+), 14 deletions(-) diff --git a/R/shiny_vector_filter_datetime.R b/R/shiny_vector_filter_datetime.R index d16d388..6c70325 100644 --- a/R/shiny_vector_filter_datetime.R +++ b/R/shiny_vector_filter_datetime.R @@ -17,10 +17,8 @@ shiny_vector_filter.POSIXct <- function(data, inputId, ...) { ns <- session$ns module_return <- shiny::reactiveValues(code = TRUE, mask = TRUE) - p <- reactive({ - as.POSIXct(x(), origin = "1970-01-01 00:00:00", tz = "GMT") - }) - + tzone <- reactive(attr(x(), "tzone")) + output$ui <- shiny::renderUI({ filter_log("updating ui", verbose = verbose) shiny::div( @@ -32,18 +30,18 @@ shiny_vector_filter.POSIXct <- function(data, inputId, ...) { 0.5s ease-in 0s 1 shinyDataFilterFadeIn; transform-origin: bottom;"), if (any(!is.na(x()))) { - my_date <- as.Date(p()) + my_date <- as.Date(x()) div( div(style = "display: inline-block; vertical-align:middle;", shiny::dateInput(ns("st_date"), "Start Date",value = min(my_date, na.rm = TRUE) , min = min(my_date, na.rm = TRUE), max = max(my_date, na.rm = TRUE)), - shinyTime::timeInput(ns("st_time"), "Start Time (HH:MM:SS)", value = min(p(), na.rm = TRUE))# automatically takes the time element + shinyTime::timeInput(ns("st_time"), "Start Time (HH:MM:SS)", value = min(x(), na.rm = TRUE))# automatically takes the time element ), div(style = "display: inline-block; vertical-align:middle;", shiny::dateInput(ns("end_date"), "End Date",value = max(my_date, na.rm = TRUE) , min = min(my_date, na.rm = TRUE), max = max(my_date, na.rm = TRUE)), - shinyTime::timeInput(ns("end_time"), "End Time (HH:MM:SS)", value = max(p(), na.rm = TRUE)) # automatically takes the time element + shinyTime::timeInput(ns("end_time"), "End Time (HH:MM:SS)", value = max(x(), na.rm = TRUE)) # automatically takes the time element ) ) } else { @@ -54,21 +52,21 @@ shiny_vector_filter.POSIXct <- function(data, inputId, ...) { }) st_dt <- reactive({ - st <- substr(strftime(input$st_time, "%Y-%m-%d %H:%M:%S", tz = "GMT"),12,20) - as.POSIXct(paste(input$st_date, st), tz = "GMT") + st <- substr(strftime(input$st_time, "%Y-%m-%d %H:%M:%S", tz = tzone()),12,20) + as.POSIXct(paste(input$st_date, st), tz = tzone()) }) end_dt <- reactive({ - end <- substr(strftime(input$end_time, "%Y-%m-%d %H:%M:%S", tz = "GMT"),12,20) - as.POSIXct(paste(input$end_date, end), tz = "GMT") + end <- substr(strftime(input$end_time, "%Y-%m-%d %H:%M:%S", tz = tzone()),12,20) + as.POSIXct(paste(input$end_date, end), tz = tzone()) }) module_return$code <- shiny::reactive({ exprs <- list() - + if (!is.null(input$st_date) & !is.null(input$st_time) & !is.null(input$end_date) & !is.null(input$end_time)) { - if (st_dt() > min(p(), na.rm = TRUE)) + if (st_dt() > min(x(), na.rm = TRUE)) exprs <- append(exprs, bquote(.x >= .(st_dt()))) - if (end_dt() < max(p(), na.rm = TRUE)) + if (end_dt() < max(x(), na.rm = TRUE)) exprs <- append(exprs, bquote(.x <= .(end_dt()))) } From 0531c0a2f943e856fdaac253d654aa9f195280b9 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Thu, 27 Jul 2023 09:17:01 -0400 Subject: [PATCH 010/101] Change `filter_expr` to `filter_fn` --- NAMESPACE | 1 + R/shiny_data_filter_item.R | 4 ++-- R/shiny_vector_filter.R | 4 ++-- R/shiny_vector_filter_NULL.R | 4 ++-- R/shiny_vector_filter_character.R | 4 ++-- R/shiny_vector_filter_date.R | 4 ++-- R/shiny_vector_filter_datetime.R | 4 ++-- R/shiny_vector_filter_factor_few.R | 9 ++++++--- R/shiny_vector_filter_factor_many.R | 9 ++++++--- R/shiny_vector_filter_logical.R | 4 ++-- R/shiny_vector_filter_numeric_few.R | 9 ++++++--- R/shiny_vector_filter_numeric_many.R | 13 +++++++++---- man/shiny_vector_filter_factor_few.Rd | 7 +++++-- man/shiny_vector_filter_factor_many.Rd | 7 +++++-- man/shiny_vector_filter_numeric_few.Rd | 7 +++++-- man/shiny_vector_filter_numeric_many.Rd | 7 +++++-- 16 files changed, 62 insertions(+), 35 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 12a7dba..caa3772 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -42,6 +42,7 @@ importFrom(ggplot2,theme_void) importFrom(grDevices,rgb) importFrom(pillar,new_pillar_type) importFrom(purrr,map) +importFrom(purrr,possibly) importFrom(purrr,reduce) importFrom(shiny,HTML) importFrom(shiny,NS) diff --git a/R/shiny_data_filter_item.R b/R/shiny_data_filter_item.R index 3c3b4b7..3395c38 100644 --- a/R/shiny_data_filter_item.R +++ b/R/shiny_data_filter_item.R @@ -180,7 +180,7 @@ shiny_data_filter_item <- function(input, output, session, data, "vector_filter", x = vec, filter_na = filter_na, - filter_expr = preselection[["filter_expr"]], + filter_fn = preselection[["filter_fn"]], verbose = verbose) }) @@ -206,4 +206,4 @@ shiny_data_filter_item <- function(input, output, session, data, }) module_return -} \ No newline at end of file +} diff --git a/R/shiny_vector_filter.R b/R/shiny_vector_filter.R index 07d53aa..3b6565b 100644 --- a/R/shiny_vector_filter.R +++ b/R/shiny_vector_filter.R @@ -106,7 +106,7 @@ shiny_vector_filter <- function(data, inputId, global = FALSE) { #' @keywords internal shiny_vector_filter.default <- function(data, inputId, ...) { function(input, output, session, x = shiny::reactive(NULL), - filter_na = shiny::reactive(FALSE), filter_expr = NULL, verbose = FALSE) { + filter_na = shiny::reactive(FALSE), filter_fn = NULL, verbose = FALSE) { module_return <- shiny::reactiveValues(code = FALSE, mask = FALSE) module_return$code <- shiny::reactive(FALSE) @@ -140,4 +140,4 @@ get_dataFilter_class <- function(obj) { if (!length(vf_class)) return("unk") class(obj) <- vf_class pillar::new_pillar_type(obj)[[1]][1] -} \ No newline at end of file +} diff --git a/R/shiny_vector_filter_NULL.R b/R/shiny_vector_filter_NULL.R index d806c3b..6993cba 100644 --- a/R/shiny_vector_filter_NULL.R +++ b/R/shiny_vector_filter_NULL.R @@ -11,7 +11,7 @@ shiny_vector_filter_ui.NULL = function(data, inputId) { #' @keywords internal shiny_vector_filter.NULL <- function(data, inputId, ...) { function(input, output, session, x = shiny::reactive(NULL), - filter_na = shiny::reactive(FALSE), filter_expr = NULL, verbose = FALSE) { + filter_na = shiny::reactive(FALSE), filter_fn = NULL, verbose = FALSE) { module_return <- shiny::reactiveValues(code = TRUE, mask = TRUE) module_return$code <- shiny::reactive(TRUE) @@ -19,4 +19,4 @@ shiny_vector_filter.NULL <- function(data, inputId, ...) { module_return } -} \ No newline at end of file +} diff --git a/R/shiny_vector_filter_character.R b/R/shiny_vector_filter_character.R index 908c8df..7699b4e 100644 --- a/R/shiny_vector_filter_character.R +++ b/R/shiny_vector_filter_character.R @@ -11,7 +11,7 @@ shiny_vector_filter_ui.character <- function(data, inputId) { #' @keywords internal shiny_vector_filter.character <- function(data, inputId, ...) { function(input, output, session, x = shiny::reactive(character()), - filter_na = shiny::reactive(FALSE), filter_expr = NULL, verbose = FALSE) { + filter_na = shiny::reactive(FALSE), filter_fn = NULL, verbose = FALSE) { ns <- session$ns @@ -53,4 +53,4 @@ shiny_vector_filter.character <- function(data, inputId, ...) { }) module_return } -} \ No newline at end of file +} diff --git a/R/shiny_vector_filter_date.R b/R/shiny_vector_filter_date.R index e06a749..c079dcf 100644 --- a/R/shiny_vector_filter_date.R +++ b/R/shiny_vector_filter_date.R @@ -12,7 +12,7 @@ shiny_vector_filter_ui.Date <- function(data, inputId) { #' @keywords internal shiny_vector_filter.Date <- function(data, inputId, ...) { function(input, output, session, x = shiny::reactive(Date()), - filter_na = shiny::reactive(FALSE), filter_expr = NULL, verbose = FALSE) { + filter_na = shiny::reactive(FALSE), filter_fn = NULL, verbose = FALSE) { ns <- session$ns module_return <- shiny::reactiveValues(code = TRUE, mask = TRUE) @@ -73,4 +73,4 @@ shiny_vector_filter.Date <- function(data, inputId, ...) { module_return } -} \ No newline at end of file +} diff --git a/R/shiny_vector_filter_datetime.R b/R/shiny_vector_filter_datetime.R index ca27374..010d29d 100644 --- a/R/shiny_vector_filter_datetime.R +++ b/R/shiny_vector_filter_datetime.R @@ -12,7 +12,7 @@ shiny_vector_filter_ui.POSIXct <- function(data, inputId) { #' @keywords internal shiny_vector_filter.POSIXct <- function(data, inputId, ...) { function(input, output, session, x = shiny::reactive(), - filter_na = shiny::reactive(FALSE), filter_expr = NULL, verbose = FALSE) { + filter_na = shiny::reactive(FALSE), filter_fn = NULL, verbose = FALSE) { ns <- session$ns module_return <- shiny::reactiveValues(code = TRUE, mask = TRUE) @@ -93,4 +93,4 @@ shiny_vector_filter.POSIXct <- function(data, inputId, ...) { module_return } -} \ No newline at end of file +} diff --git a/R/shiny_vector_filter_factor_few.R b/R/shiny_vector_filter_factor_few.R index 40f802b..43375ed 100644 --- a/R/shiny_vector_filter_factor_few.R +++ b/R/shiny_vector_filter_factor_few.R @@ -9,7 +9,10 @@ #' @param x a reactive expression resolving to the vector to filter #' @param filter_na a logical value indicating whether to filter \code{NA} #' values from the \code{x} vector -#' @param filter_expr A character string that can specify initial filtering +#' @param filter_fn A function to modify, specified in one of the following ways: +#' * A named function, e.g. `mean`. +#' * An anonymous function, e.g. `\(x) x + 1` or `function(x) x + 1`. +#' * A formula, e.g. `~ .x + 1`. #' @param verbose a \code{logical} value indicating whether or not to print log #' statements out to the console #' @@ -24,7 +27,7 @@ #' @importFrom grDevices rgb #' @keywords internal shiny_vector_filter_factor_few <- function(input, output, session, - x = shiny::reactive(factor()), filter_na = shiny::reactive(TRUE), filter_expr = NULL, + x = shiny::reactive(factor()), filter_na = shiny::reactive(TRUE), filter_fn = NULL, verbose = FALSE) { ns <- session$ns @@ -81,4 +84,4 @@ shiny_vector_filter_factor_few <- function(input, output, session, }) module_return -} \ No newline at end of file +} diff --git a/R/shiny_vector_filter_factor_many.R b/R/shiny_vector_filter_factor_many.R index 7f9c37d..6413a6f 100644 --- a/R/shiny_vector_filter_factor_many.R +++ b/R/shiny_vector_filter_factor_many.R @@ -9,7 +9,10 @@ #' @param x a reactive expression resolving to the vector to filter #' @param filter_na a logical value indicating whether to filter \code{NA} #' values from the \code{x} vector -#' @param filter_expr A character string that can specify initial filtering +#' @param filter_fn A function to modify, specified in one of the following ways: +#' * A named function, e.g. `mean`. +#' * An anonymous function, e.g. `\(x) x + 1` or `function(x) x + 1`. +#' * A formula, e.g. `~ .x + 1`. #' @param verbose a \code{logical} value indicating whether or not to print log #' statements out to the console #' @@ -20,7 +23,7 @@ #' @importFrom shiny reactive reactiveValues renderUI selectInput isolate #' @keywords internal shiny_vector_filter_factor_many <- function(input, output, session, - x = shiny::reactive(factor()), filter_na = shiny::reactive(FALSE), filter_expr = NULL, + x = shiny::reactive(factor()), filter_na = shiny::reactive(FALSE), filter_fn = NULL, verbose = FALSE) { ns <- session$ns @@ -51,4 +54,4 @@ shiny_vector_filter_factor_many <- function(input, output, session, }) module_return -} \ No newline at end of file +} diff --git a/R/shiny_vector_filter_logical.R b/R/shiny_vector_filter_logical.R index 69f5990..992b24d 100644 --- a/R/shiny_vector_filter_logical.R +++ b/R/shiny_vector_filter_logical.R @@ -12,7 +12,7 @@ shiny_vector_filter_ui.logical <- function(data, inputId) { #' @keywords internal shiny_vector_filter.logical <- function(data, inputId, ...) { function(input, output, session, - x = shiny::reactive(logical()), filter_na = shiny::reactive(TRUE), filter_expr = NULL, + x = shiny::reactive(logical()), filter_na = shiny::reactive(TRUE), filter_fn = NULL, verbose = FALSE) { ns <- session$ns @@ -66,4 +66,4 @@ shiny_vector_filter.logical <- function(data, inputId, ...) { module_return } -} \ No newline at end of file +} diff --git a/R/shiny_vector_filter_numeric_few.R b/R/shiny_vector_filter_numeric_few.R index 8ce99b9..fc22830 100644 --- a/R/shiny_vector_filter_numeric_few.R +++ b/R/shiny_vector_filter_numeric_few.R @@ -8,7 +8,10 @@ #' session #' @param x The TODO #' @param filter_na The \code{logical} TODO -#' @param filter_expr A character string that can specify initial filtering +#' @param filter_fn A function to modify, specified in one of the following ways: +#' * A named function, e.g. `mean`. +#' * An anonymous function, e.g. `\(x) x + 1` or `function(x) x + 1`. +#' * A formula, e.g. `~ .x + 1`. #' @param verbose a \code{logical} value indicating whether or not to print log #' statements out to the console #' @@ -26,7 +29,7 @@ #' @keywords internal shiny_vector_filter_numeric_few <- function(input, output, session, x = shiny::reactive(factor()), #important: changed x to factor here - filter_na = shiny::reactive(FALSE), filter_expr = NULL, verbose = FALSE) { + filter_na = shiny::reactive(FALSE), filter_fn = NULL, verbose = FALSE) { ns <- session$ns @@ -82,4 +85,4 @@ shiny_vector_filter_numeric_few <- function(input, output, session, }) module_return -} \ No newline at end of file +} diff --git a/R/shiny_vector_filter_numeric_many.R b/R/shiny_vector_filter_numeric_many.R index 044873b..c7e0941 100644 --- a/R/shiny_vector_filter_numeric_many.R +++ b/R/shiny_vector_filter_numeric_many.R @@ -8,7 +8,10 @@ #' session #' @param x The TODO #' @param filter_na The \code{logical} TODO -#' @param filter_expr A character string that can specify initial filtering +#' @param filter_fn A function to modify, specified in one of the following ways: +#' * A named function, e.g. `mean`. +#' * An anonymous function, e.g. `\(x) x + 1` or `function(x) x + 1`. +#' * A formula, e.g. `~ .x + 1`. #' @param verbose a \code{logical} value indicating whether or not to print log #' statements out to the console #' @@ -18,6 +21,7 @@ #' scale_y_continuous #' @importFrom grDevices rgb #' @importFrom stats density +#' @importFrom purrr possibly #' #' @return a \code{\link[shiny]{reactiveValues}} list containing a logical #' vector called "mask" which can be used to filter the provided vector and an @@ -25,12 +29,13 @@ #' @export #' @keywords internal shiny_vector_filter_numeric_many <- function(input, output, session, x = shiny::reactive(numeric()), - filter_na = shiny::reactive(FALSE), filter_expr = NULL, verbose = FALSE) { + filter_na = shiny::reactive(FALSE), filter_fn = NULL, verbose = FALSE) { ns <- session$ns module_return <- shiny::reactiveValues(code = TRUE, mask = TRUE) + fn <- if (is.null(filter_fn)) function(x) TRUE else purrr::possibly(filter_fn, otherwise = TRUE, quiet = FALSE) - x_filtered <- Filter(function(x) !is.na(x) & eval(if (!is.null(filter_expr)) str2expression(filter_expr) else TRUE), x()) + x_filtered <- Filter(function(x) !is.na(x) & fn(x), x()) output$ui <- shiny::renderUI({ filter_log("updating ui", verbose = verbose) shiny::div( @@ -83,4 +88,4 @@ shiny_vector_filter_numeric_many <- function(input, output, session, x = shiny:: }) module_return -} \ No newline at end of file +} diff --git a/man/shiny_vector_filter_factor_few.Rd b/man/shiny_vector_filter_factor_few.Rd index 7637ad5..b97875f 100644 --- a/man/shiny_vector_filter_factor_few.Rd +++ b/man/shiny_vector_filter_factor_few.Rd @@ -10,7 +10,7 @@ shiny_vector_filter_factor_few( session, x = shiny::reactive(factor()), filter_na = shiny::reactive(TRUE), - filter_expr = NULL, + filter_fn = NULL, verbose = FALSE ) } @@ -29,7 +29,10 @@ session} \item{filter_na}{a logical value indicating whether to filter \code{NA} values from the \code{x} vector} -\item{filter_expr}{A character string that can specify initial filtering} +\item{filter_fn}{A function to modify, specified in one of the following ways: +* A named function, e.g. `mean`. +* An anonymous function, e.g. `\(x) x + 1` or `function(x) x + 1`. +* A formula, e.g. `~ .x + 1`.} \item{verbose}{a \code{logical} value indicating whether or not to print log statements out to the console} diff --git a/man/shiny_vector_filter_factor_many.Rd b/man/shiny_vector_filter_factor_many.Rd index 62dadc0..9fe7715 100644 --- a/man/shiny_vector_filter_factor_many.Rd +++ b/man/shiny_vector_filter_factor_many.Rd @@ -10,7 +10,7 @@ shiny_vector_filter_factor_many( session, x = shiny::reactive(factor()), filter_na = shiny::reactive(FALSE), - filter_expr = NULL, + filter_fn = NULL, verbose = FALSE ) } @@ -29,7 +29,10 @@ session} \item{filter_na}{a logical value indicating whether to filter \code{NA} values from the \code{x} vector} -\item{filter_expr}{A character string that can specify initial filtering} +\item{filter_fn}{A function to modify, specified in one of the following ways: +* A named function, e.g. `mean`. +* An anonymous function, e.g. `\(x) x + 1` or `function(x) x + 1`. +* A formula, e.g. `~ .x + 1`.} \item{verbose}{a \code{logical} value indicating whether or not to print log statements out to the console} diff --git a/man/shiny_vector_filter_numeric_few.Rd b/man/shiny_vector_filter_numeric_few.Rd index c4852c5..303848c 100644 --- a/man/shiny_vector_filter_numeric_few.Rd +++ b/man/shiny_vector_filter_numeric_few.Rd @@ -10,7 +10,7 @@ shiny_vector_filter_numeric_few( session, x = shiny::reactive(factor()), filter_na = shiny::reactive(FALSE), - filter_expr = NULL, + filter_fn = NULL, verbose = FALSE ) } @@ -28,7 +28,10 @@ session} \item{filter_na}{The \code{logical} TODO} -\item{filter_expr}{A character string that can specify initial filtering} +\item{filter_fn}{A function to modify, specified in one of the following ways: +* A named function, e.g. `mean`. +* An anonymous function, e.g. `\(x) x + 1` or `function(x) x + 1`. +* A formula, e.g. `~ .x + 1`.} \item{verbose}{a \code{logical} value indicating whether or not to print log statements out to the console} diff --git a/man/shiny_vector_filter_numeric_many.Rd b/man/shiny_vector_filter_numeric_many.Rd index 696d9ef..2d54e65 100644 --- a/man/shiny_vector_filter_numeric_many.Rd +++ b/man/shiny_vector_filter_numeric_many.Rd @@ -10,7 +10,7 @@ shiny_vector_filter_numeric_many( session, x = shiny::reactive(numeric()), filter_na = shiny::reactive(FALSE), - filter_expr = NULL, + filter_fn = NULL, verbose = FALSE ) } @@ -28,7 +28,10 @@ session} \item{filter_na}{The \code{logical} TODO} -\item{filter_expr}{A character string that can specify initial filtering} +\item{filter_fn}{A function to modify, specified in one of the following ways: +* A named function, e.g. `mean`. +* An anonymous function, e.g. `\(x) x + 1` or `function(x) x + 1`. +* A formula, e.g. `~ .x + 1`.} \item{verbose}{a \code{logical} value indicating whether or not to print log statements out to the console} From 349a67f73fce34598d19af2397bc31a0d55bf212 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Thu, 27 Jul 2023 09:55:35 -0400 Subject: [PATCH 011/101] Turn back to silently failing for now --- R/shiny_vector_filter_numeric_many.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/shiny_vector_filter_numeric_many.R b/R/shiny_vector_filter_numeric_many.R index c7e0941..7249f04 100644 --- a/R/shiny_vector_filter_numeric_many.R +++ b/R/shiny_vector_filter_numeric_many.R @@ -33,7 +33,7 @@ shiny_vector_filter_numeric_many <- function(input, output, session, x = shiny:: ns <- session$ns module_return <- shiny::reactiveValues(code = TRUE, mask = TRUE) - fn <- if (is.null(filter_fn)) function(x) TRUE else purrr::possibly(filter_fn, otherwise = TRUE, quiet = FALSE) + fn <- if (is.null(filter_fn)) function(x) TRUE else purrr::possibly(filter_fn, otherwise = TRUE) x_filtered <- Filter(function(x) !is.na(x) & fn(x), x()) output$ui <- shiny::renderUI({ From 1615f9279e1fca34ba3ca6ab3a7009fa2562e4b2 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Thu, 27 Jul 2023 09:56:06 -0400 Subject: [PATCH 012/101] Implement preselection for datetime types --- R/shiny_vector_filter_datetime.R | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/R/shiny_vector_filter_datetime.R b/R/shiny_vector_filter_datetime.R index 010d29d..441ce59 100644 --- a/R/shiny_vector_filter_datetime.R +++ b/R/shiny_vector_filter_datetime.R @@ -16,6 +16,9 @@ shiny_vector_filter.POSIXct <- function(data, inputId, ...) { ns <- session$ns module_return <- shiny::reactiveValues(code = TRUE, mask = TRUE) + fn <- if (is.null(filter_fn)) function(x) TRUE else purrr::possibly(filter_fn, otherwise = TRUE) + + x_filtered <- Filter(function(x) !is.na(x) & fn(x), x()) p <- reactive({ as.POSIXct(x(), origin = "1970-01-01 00:00:00", tz = "GMT") @@ -35,15 +38,15 @@ shiny_vector_filter.POSIXct <- function(data, inputId, ...) { my_date <- as.Date(p()) div( div(style = "display: inline-block; vertical-align:middle;", - shiny::dateInput(ns("st_date"), "Start Date",value = min(my_date, na.rm = TRUE) + shiny::dateInput(ns("st_date"), "Start Date",value = min(as.Date(x_filtered)) , min = min(my_date, na.rm = TRUE), max = max(my_date, na.rm = TRUE)), - shinyTime::timeInput(ns("st_time"), "Start Time (HH:MM:SS)", value = min(p(), na.rm = TRUE))# automatically takes the time element + shinyTime::timeInput(ns("st_time"), "Start Time (HH:MM:SS)", value = min(x_filtered))# automatically takes the time element ), div(style = "display: inline-block; vertical-align:middle;", - shiny::dateInput(ns("end_date"), "End Date",value = max(my_date, na.rm = TRUE) + shiny::dateInput(ns("end_date"), "End Date",value = max(as.Date(x_filtered)) , min = min(my_date, na.rm = TRUE), max = max(my_date, na.rm = TRUE)), - shinyTime::timeInput(ns("end_time"), "End Time (HH:MM:SS)", value = max(p(), na.rm = TRUE)) # automatically takes the time element + shinyTime::timeInput(ns("end_time"), "End Time (HH:MM:SS)", value = max(x_filtered)) # automatically takes the time element ) ) } else { From aa5bfa55d7a4cc99c371d95c5dda8465a20d1f46 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Thu, 27 Jul 2023 10:55:59 -0400 Subject: [PATCH 013/101] Update other methods with preselection --- R/shiny_vector_filter_character.R | 5 ++++- R/shiny_vector_filter_date.R | 7 +++++-- R/shiny_vector_filter_factor_few.R | 5 ++++- R/shiny_vector_filter_factor_many.R | 5 ++++- R/shiny_vector_filter_logical.R | 7 ++++++- R/shiny_vector_filter_numeric_few.R | 5 ++++- 6 files changed, 27 insertions(+), 7 deletions(-) diff --git a/R/shiny_vector_filter_character.R b/R/shiny_vector_filter_character.R index 7699b4e..4fcabc2 100644 --- a/R/shiny_vector_filter_character.R +++ b/R/shiny_vector_filter_character.R @@ -19,6 +19,9 @@ shiny_vector_filter.character <- function(data, inputId, ...) { x_wo_NAs <- shiny::reactive(Filter(Negate(is.na), x())) module_return <- shiny::reactiveValues(code = TRUE, mask = TRUE) + fn <- if (is.null(filter_fn)) function(x) FALSE else purrr::possibly(filter_fn, otherwise = FALSE) + + x_filtered <- Filter(function(x) !is.na(x) & fn(x), x()) output$ui <- shiny::renderUI({ @@ -32,7 +35,7 @@ shiny_vector_filter.character <- function(data, inputId, ...) { } else { proportionSelectInput(ns("param"), NULL, vec = x, - selected = shiny::isolate(input$param) %||% c(), + selected = x_filtered, multiple = TRUE, width = "100%") } diff --git a/R/shiny_vector_filter_date.R b/R/shiny_vector_filter_date.R index c079dcf..4730919 100644 --- a/R/shiny_vector_filter_date.R +++ b/R/shiny_vector_filter_date.R @@ -16,6 +16,9 @@ shiny_vector_filter.Date <- function(data, inputId, ...) { ns <- session$ns module_return <- shiny::reactiveValues(code = TRUE, mask = TRUE) + fn <- if (is.null(filter_fn)) function(x) TRUE else purrr::possibly(filter_fn, otherwise = TRUE) + + x_filtered <- Filter(function(x) !is.na(x) & fn(x), x()) output$ui <- shiny::renderUI({ filter_log("updating ui", verbose = verbose) @@ -30,8 +33,8 @@ shiny_vector_filter.Date <- function(data, inputId, ...) { if (any(!is.na(x()))) { shiny::dateRangeInput(ns("param"), NULL, #value = shiny::isolate(input$param) %||% range(x(), na.rm = TRUE), - start = min(x(), na.rm = TRUE), - end = max(x(), na.rm = TRUE), + start = min(x_filtered), + end = max(x_filtered), min = min(x(), na.rm = TRUE), max = max(x(), na.rm = TRUE) ) diff --git a/R/shiny_vector_filter_factor_few.R b/R/shiny_vector_filter_factor_few.R index 43375ed..2a045c0 100644 --- a/R/shiny_vector_filter_factor_few.R +++ b/R/shiny_vector_filter_factor_few.R @@ -34,6 +34,9 @@ shiny_vector_filter_factor_few <- function(input, output, session, x_wo_NA <- shiny::reactive(Filter(Negate(is.na), x())) module_return <- shiny::reactiveValues(code = TRUE, mask = TRUE) + fn <- if (is.null(filter_fn)) function(x) FALSE else purrr::possibly(filter_fn, otherwise = FALSE) + + x_filtered <- Filter(function(x) !is.na(x) & fn(x), x()) choices <- shiny::reactive(unique(as.character(x_wo_NA()))) @@ -50,7 +53,7 @@ shiny_vector_filter_factor_few <- function(input, output, session, ), shiny::checkboxGroupInput(ns("param"), NULL, choices = choices(), - selected = shiny::isolate(input$param) %||% c(), + selected = x_filtered, width = "100%")) }) diff --git a/R/shiny_vector_filter_factor_many.R b/R/shiny_vector_filter_factor_many.R index 6413a6f..1e6d2ec 100644 --- a/R/shiny_vector_filter_factor_many.R +++ b/R/shiny_vector_filter_factor_many.R @@ -30,12 +30,15 @@ shiny_vector_filter_factor_many <- function(input, output, session, x_wo_NAs <- shiny::reactive(Filter(Negate(is.na), x())) module_return <- shiny::reactiveValues(code = TRUE, mask = TRUE) + fn <- if (is.null(filter_fn)) function(x) FALSE else purrr::possibly(filter_fn, otherwise = FALSE) + + x_filtered <- Filter(function(x) !is.na(x) & fn(x), x()) output$ui <- shiny::renderUI({ filter_log("updating ui", verbose = verbose) proportionSelectInput(ns("param"), NULL, vec = x, - selected = shiny::isolate(input$param) %||% c(), + selected = x_filtered, multiple = TRUE, width = "100%") }) diff --git a/R/shiny_vector_filter_logical.R b/R/shiny_vector_filter_logical.R index 992b24d..11cbedc 100644 --- a/R/shiny_vector_filter_logical.R +++ b/R/shiny_vector_filter_logical.R @@ -19,6 +19,11 @@ shiny_vector_filter.logical <- function(data, inputId, ...) { x_wo_NA <- shiny::reactive(Filter(Negate(is.na), x())) module_return <- shiny::reactiveValues(code = TRUE, mask = TRUE) + fn <- if (is.null(filter_fn)) function(x) FALSE else purrr::possibly(filter_fn, otherwise = FALSE) + + x_filtered <- Filter(function(x) !is.na(x) & fn(x), x()) + filter_selected <- Filter(function(i) i %in% x_filtered, c("True" = TRUE, "False" = FALSE)) + choices <- shiny::reactive({ Filter(function(i) i %in% x(), c("True" = TRUE, "False" = FALSE)) }) @@ -36,7 +41,7 @@ shiny_vector_filter.logical <- function(data, inputId, ...) { shiny::plotOutput(ns("plot"), height = "100%")), shiny::checkboxGroupInput(ns("param"), NULL, choices = choices(), - selected = shiny::isolate(input$param) %||% c(), + selected = filter_selected, width = "100%")) }) diff --git a/R/shiny_vector_filter_numeric_few.R b/R/shiny_vector_filter_numeric_few.R index fc22830..1afeb2d 100644 --- a/R/shiny_vector_filter_numeric_few.R +++ b/R/shiny_vector_filter_numeric_few.R @@ -35,6 +35,9 @@ shiny_vector_filter_numeric_few <- function(input, output, session, x_wo_NA <- shiny::reactive(Filter(Negate(is.na), x())) module_return <- shiny::reactiveValues(code = TRUE, mask = TRUE) + fn <- if (is.null(filter_fn)) function(x) FALSE else purrr::possibly(filter_fn, otherwise = FALSE) + + x_filtered <- Filter(function(x) !is.na(x) & fn(x), x()) choices <- shiny::reactive(unique(as.character(sort(x_wo_NA())))) @@ -51,7 +54,7 @@ shiny_vector_filter_numeric_few <- function(input, output, session, ), shiny::checkboxGroupInput(ns("param"), NULL, choices = choices(), - selected = shiny::isolate(input$param) %||% c(), + selected = x_filtered, width = "100%")) }) From 708f9c6340219956c99f96f5dec54ce5c6722d61 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Thu, 27 Jul 2023 11:48:06 -0400 Subject: [PATCH 014/101] Update NEWS --- DESCRIPTION | 2 +- NEWS.md | 1 + 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index d3edf01..3f966ad 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: IDEAFilter Type: Package -Version: 0.1.3.9001 +Version: 0.1.3.9002 Title: Agnostic, Idiomatic Data Filter Module for Shiny Description: When added to an existing shiny app, users may subset any developer-chosen R data.frame on the fly. That is, users are empowered to diff --git a/NEWS.md b/NEWS.md index 6d6d8c9..c1df96e 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,6 @@ # IDEAFilter (development version) * Fix bug that was trying to assign an attribute to a NULL (#15) +* Fix bug that was causing inaccurate filtering for `datetime` vectors (#17) # IDEAFilter 0.1.3 * Cited works of other contributors (`shinyDataFilter` & `SortableJS`) From 2b32f774ef78a97547f4bf60451036eaea2e5aec Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Wed, 2 Aug 2023 08:53:08 -0400 Subject: [PATCH 015/101] Move preselection argument to end --- R/shiny_data_filter.R | 2 +- R/shiny_data_filter_item.R | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/R/shiny_data_filter.R b/R/shiny_data_filter.R index 347561a..0cc49eb 100644 --- a/R/shiny_data_filter.R +++ b/R/shiny_data_filter.R @@ -118,7 +118,7 @@ shiny_data_filter_ui <- function(inputId) { #' shinyApp(ui = ui, server = server) #' } #' -shiny_data_filter <- function(input, output, session, data, preselection = NULL, verbose = FALSE) { +shiny_data_filter <- function(input, output, session, data, verbose = FALSE, preselection = NULL) { ns <- session$ns filter_log("calling module", verbose = verbose) diff --git a/R/shiny_data_filter_item.R b/R/shiny_data_filter_item.R index 3395c38..397ca48 100644 --- a/R/shiny_data_filter_item.R +++ b/R/shiny_data_filter_item.R @@ -54,7 +54,7 @@ shiny_data_filter_item_ui <- function(inputId, verbose = FALSE) { #' @keywords internal #' shiny_data_filter_item <- function(input, output, session, data, - column_name = NULL, preselection = NULL, verbose = FALSE) { + column_name = NULL, verbose = FALSE, preselection = NULL) { ns <- session$ns From b19b56ff50119a8ed22d9f02663fc37d2c54e42e Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Wed, 2 Aug 2023 08:53:46 -0400 Subject: [PATCH 016/101] Make preselection reactive --- R/shiny_data_filter.R | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/R/shiny_data_filter.R b/R/shiny_data_filter.R index 0cc49eb..7cbf619 100644 --- a/R/shiny_data_filter.R +++ b/R/shiny_data_filter.R @@ -126,6 +126,7 @@ shiny_data_filter <- function(input, output, session, data, verbose = FALSE, pre # retrieve input from callModule call (sys.call(-5L)) data_call <- as.list(sys.call(-5L))$data datar <- if (is.reactive(data)) data else reactive(data) + preselectionr <- if (is.reactive(preselection)) preselection else reactive(preselection) filter_counter <- 0 next_filter_id <- function() { @@ -201,17 +202,17 @@ shiny_data_filter <- function(input, output, session, data, verbose = FALSE, pre }) observeEvent(input$add_filter_select, { - req(preselection) + req(preselectionr()) filter_log("observing pre-selected columns", verbose = verbose) - for (col_sel in (names(preselection) %||% preselection)) { + for (col_sel in (names(preselectionr()) %||% preselectionr())) { if (!col_sel %in% names(datar())) { warning(sprintf("Unable to add `%s` to filter list.", col_sel)) next() } - update_filter(fid <- next_filter_id(), column_name = col_sel, preselection = if(is.list(preselection)) preselection[[col_sel]]) + update_filter(fid <- next_filter_id(), column_name = col_sel, preselection = if(is.list(preselectionr())) preselectionr()[[col_sel]]) filters(append(filters(), fid)) insertUI( From ac7aeb36d63a72881b497055b49342f92f3cf261 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Wed, 2 Aug 2023 10:08:09 -0400 Subject: [PATCH 017/101] Make application of filter pre-selection a function --- R/shiny_data_filter.R | 37 +++++++++++++++++++++---------------- 1 file changed, 21 insertions(+), 16 deletions(-) diff --git a/R/shiny_data_filter.R b/R/shiny_data_filter.R index 7cbf619..45ce791 100644 --- a/R/shiny_data_filter.R +++ b/R/shiny_data_filter.R @@ -164,6 +164,26 @@ shiny_data_filter <- function(input, output, session, data, verbose = FALSE, pre preselection = preselection) } + apply_preselection <- function(preselection = NULL) { + + for (col_sel in (names(preselectionr()) %||% preselectionr())) { + if (!col_sel %in% names(datar())) { + warning(sprintf("Unable to add `%s` to filter list.", col_sel)) + next() + } + + update_filter(fid <- next_filter_id(), column_name = col_sel, preselection = if(is.list(preselectionr())) preselectionr()[[col_sel]]) + filters(append(filters(), fid)) + + insertUI( + selector = sprintf("#%s", ns("sortableList")), + where = "beforeEnd", + ui = shiny_data_filter_item_ui(ns(fid), verbose = verbose)) + + updateSelectInput(session, "add_filter_select", selected = "") + } + } + output$add_filter_select_ui <- renderUI({ columnSelectInput( ns("add_filter_select"), @@ -206,22 +226,7 @@ shiny_data_filter <- function(input, output, session, data, verbose = FALSE, pre filter_log("observing pre-selected columns", verbose = verbose) - for (col_sel in (names(preselectionr()) %||% preselectionr())) { - if (!col_sel %in% names(datar())) { - warning(sprintf("Unable to add `%s` to filter list.", col_sel)) - next() - } - - update_filter(fid <- next_filter_id(), column_name = col_sel, preselection = if(is.list(preselectionr())) preselectionr()[[col_sel]]) - filters(append(filters(), fid)) - - insertUI( - selector = sprintf("#%s", ns("sortableList")), - where = "beforeEnd", - ui = shiny_data_filter_item_ui(ns(fid), verbose = verbose)) - - updateSelectInput(session, "add_filter_select", selected = "") - } + apply_preselection(preselectionr()) }, once = TRUE) observeEvent(input$add_filter_select, { From 8afdbd900fe552801c3c772baf28a31cbc34ad6f Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Wed, 2 Aug 2023 10:08:47 -0400 Subject: [PATCH 018/101] Allow chaning/updating filter pre-selection --- R/shiny_data_filter.R | 21 +++++++++++++++++++++ 1 file changed, 21 insertions(+) diff --git a/R/shiny_data_filter.R b/R/shiny_data_filter.R index 45ce791..162bc57 100644 --- a/R/shiny_data_filter.R +++ b/R/shiny_data_filter.R @@ -229,6 +229,27 @@ shiny_data_filter <- function(input, output, session, data, verbose = FALSE, pre apply_preselection(preselectionr()) }, once = TRUE) + observeEvent(preselectionr(), { + req(!is.null(input$add_filter_select)) + + filter_log("scrubbing all filters", verbose = verbose) + for (fid in filters()[-1]) { + idx <- utils::head(which(filters() == fid), 1) + filter_returns[[fid]]$destroy + + filters(setdiff(filters(), fid)) + + # overwrite existing module call with one taking new input data + if (!idx > length(filters())) update_filter(filters()[[idx]]) + + removeUI(selector = sprintf("#%s-ui", ns(fid))) + } + + filter_log("applying updated selection", verbose = verbose) + apply_preselection(preselectionr()) + + }) + observeEvent(input$add_filter_select, { if (!input$add_filter_select %in% names(datar())) return() From aedd0ff3791ba4a59a70e5d9f8d1454a8479b196 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Wed, 2 Aug 2023 10:40:42 -0400 Subject: [PATCH 019/101] Update documentation --- R/shiny_data_filter.R | 2 +- R/shiny_data_filter_item.R | 2 +- man/shiny_data_filter.Rd | 8 ++++---- man/shiny_data_filter_item.Rd | 8 ++++---- 4 files changed, 10 insertions(+), 10 deletions(-) diff --git a/R/shiny_data_filter.R b/R/shiny_data_filter.R index 162bc57..d62ab4a 100644 --- a/R/shiny_data_filter.R +++ b/R/shiny_data_filter.R @@ -49,9 +49,9 @@ shiny_data_filter_ui <- function(inputId) { #' session #' @param data a \code{data.frame} or \code{reactive expression} returning a #' \code{data.frame} to use as the input to the filter module -#' @param preselection a \code{list} that can be used to pre-populate the filter #' @param verbose a \code{logical} value indicating whether or not to print log #' statements out to the console +#' @param preselection a \code{list} that can be used to pre-populate the filter #' #' @return a \code{reactive expression} which returns the filtered data wrapped #' in an additional class, "shinyDataFilter_df". This structure also contains diff --git a/R/shiny_data_filter_item.R b/R/shiny_data_filter_item.R index 397ca48..eaf5adc 100644 --- a/R/shiny_data_filter_item.R +++ b/R/shiny_data_filter_item.R @@ -38,9 +38,9 @@ shiny_data_filter_item_ui <- function(inputId, verbose = FALSE) { #' @param data a \code{reactive expression} returning a \code{data.frame} to use #' as the input to the filter item module #' @param column_name a value indicating the name of the column to be filtered -#' @param preselection a \code{list} that can be used to pre-populate the filter #' @param verbose a \code{logical} value indicating whether or not to print log #' statements out to the console +#' @param preselection a \code{list} that can be used to pre-populate the filter #' #' @return a \code{\link[shiny]{reactiveValues}} list of three reactive elements; #' (1) a reactive data frame, (2) the code to filter a vector with the name of diff --git a/man/shiny_data_filter.Rd b/man/shiny_data_filter.Rd index 1401076..925ca06 100644 --- a/man/shiny_data_filter.Rd +++ b/man/shiny_data_filter.Rd @@ -9,8 +9,8 @@ shiny_data_filter( output, session, data, - preselection = NULL, - verbose = FALSE + verbose = FALSE, + preselection = NULL ) } \arguments{ @@ -26,10 +26,10 @@ session} \item{data}{a \code{data.frame} or \code{reactive expression} returning a \code{data.frame} to use as the input to the filter module} -\item{preselection}{a \code{list} that can be used to pre-populate the filter} - \item{verbose}{a \code{logical} value indicating whether or not to print log statements out to the console} + +\item{preselection}{a \code{list} that can be used to pre-populate the filter} } \value{ a \code{reactive expression} which returns the filtered data wrapped diff --git a/man/shiny_data_filter_item.Rd b/man/shiny_data_filter_item.Rd index 404bb3b..4c1af46 100644 --- a/man/shiny_data_filter_item.Rd +++ b/man/shiny_data_filter_item.Rd @@ -10,8 +10,8 @@ shiny_data_filter_item( session, data, column_name = NULL, - preselection = NULL, - verbose = FALSE + verbose = FALSE, + preselection = NULL ) } \arguments{ @@ -29,10 +29,10 @@ as the input to the filter item module} \item{column_name}{a value indicating the name of the column to be filtered} -\item{preselection}{a \code{list} that can be used to pre-populate the filter} - \item{verbose}{a \code{logical} value indicating whether or not to print log statements out to the console} + +\item{preselection}{a \code{list} that can be used to pre-populate the filter} } \value{ a \code{\link[shiny]{reactiveValues}} list of three reactive elements; From 7cfaf06c6d2b46af3ec165d6167889ff0bd4c92f Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Wed, 2 Aug 2023 11:18:58 -0400 Subject: [PATCH 020/101] Add wrappers for data filter item --- DESCRIPTION | 2 +- NAMESPACE | 2 ++ R/shiny_data_filter.R | 11 +++++++++ R/shiny_data_filter_item.R | 49 +++++++++++++++++++++++++++++++++++++- man/IDEAFilter_item.Rd | 31 ++++++++++++++++++++++++ man/IDEAFilter_item_ui.Rd | 18 ++++++++++++++ 6 files changed, 111 insertions(+), 2 deletions(-) create mode 100644 man/IDEAFilter_item.Rd create mode 100644 man/IDEAFilter_item_ui.Rd diff --git a/DESCRIPTION b/DESCRIPTION index 3f966ad..b676fce 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -37,7 +37,7 @@ URL: https://biogen-inc.github.io/IDEAFilter/, https://github.com/Biogen-Inc/IDE BugReports: https://github.com/Biogen-Inc/IDEAFilter/issues Encoding: UTF-8 LazyData: true -RoxygenNote: 7.1.2 +RoxygenNote: 7.2.3 Imports: shiny, ggplot2, diff --git a/NAMESPACE b/NAMESPACE index 12a7dba..06566fd 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -16,6 +16,8 @@ S3method(shiny_vector_filter_ui,default) S3method(shiny_vector_filter_ui,factor) S3method(shiny_vector_filter_ui,logical) S3method(shiny_vector_filter_ui,numeric) +export(IDEAFilter_item) +export(IDEAFilter_item_ui) export(getInitializationCode.shinyDataFilter_df) export(shiny_data_filter) export(shiny_data_filter_item) diff --git a/R/shiny_data_filter.R b/R/shiny_data_filter.R index 1addd5b..52ddc74 100644 --- a/R/shiny_data_filter.R +++ b/R/shiny_data_filter.R @@ -252,3 +252,14 @@ shiny_data_filter <- function(input, output, session, data, verbose = FALSE) { class = c("shinyDataFilter_df", class(d))) }) } + +IDEAFilter_ui <- function(id) { + shiny_data_filter_ui(inputId = id) +} + +IDEAFilter <- function(id, data, ..., verbose = FALSE) { + moduleServer(id, function(input, output, session) { + shiny_data_filter(input = input, output = output, session = session, + data = data, verbose = verbose) + }) +} diff --git a/R/shiny_data_filter_item.R b/R/shiny_data_filter_item.R index 329e2ed..b44ce92 100644 --- a/R/shiny_data_filter_item.R +++ b/R/shiny_data_filter_item.R @@ -202,4 +202,51 @@ shiny_data_filter_item <- function(input, output, session, data, }) module_return -} \ No newline at end of file +} + +#' A single filter item as part of a IDEA filter module panel +#' +#' This is a wrapper for \code{\link{shiny_data_filter_item_ui}} created to match up with the module server function \code{\link{IDEAFilter_item}}. +#' +#' @param id a module id name +#' +#' @return a shiny \code{\link[shiny]{wellPanel}} to house the filter +#' +#' @importFrom shiny NS uiOutput +#' @export +#' @keywords internal +#' +IDEAFilter_item_ui <- function(id) { + shiny_data_filter_item_ui(inputId = id) +} + +#' The server function for the IDEA filter item module +#' +#' Serves as a wrapper fo \code{\link{shiny_data_filter_item}} and utilizes \code{moduleSever()} for a more modern implementation of the data item filter. +#' +#' @param id a module id name +#' @param data a \code{reactive expression} returning a \code{data.frame} to use +#' as the input to the filter item module +#' @param column_name a value indicating the name of the column to be filtered +#' @param ... placeholder for inclusion of additional parameters in future development +#' @param verbose a \code{logical} value indicating whether or not to print log +#' statements out to the console +#' +#' @return a \code{\link[shiny]{reactiveValues}} list of three reactive elements; +#' (1) a reactive data frame, (2) the code to filter a vector with the name of +#' the specified data column, and (3) a flag indicating when to remove this +#' filter. +#' +#' @importFrom shiny reactiveValues wellPanel fillRow selectInput h4 actionLink +#' icon uiOutput div HTML span textOutput eventReactive renderUI tag +#' renderText reactive observeEvent callModule +#' @export +#' @keywords internal +#' +IDEAFilter_item <- function(id, data, column_name = NULL, ..., verbose = FALSE) { + moduleServer(id, function(input, output, session) { + shiny_data_filter_item(input = input, output = output, session = session, + data = data, column_name = column_name, + verbose = verbose) + }) +} diff --git a/man/IDEAFilter_item.Rd b/man/IDEAFilter_item.Rd new file mode 100644 index 0000000..c33f128 --- /dev/null +++ b/man/IDEAFilter_item.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/shiny_data_filter_item.R +\name{IDEAFilter_item} +\alias{IDEAFilter_item} +\title{The server function for the IDEA filter item module} +\usage{ +IDEAFilter_item(id, data, column_name = NULL, ..., verbose = FALSE) +} +\arguments{ +\item{id}{a module id name} + +\item{data}{a \code{reactive expression} returning a \code{data.frame} to use +as the input to the filter item module} + +\item{column_name}{a value indicating the name of the column to be filtered} + +\item{...}{placeholder for inclusion of additional parameters in future development} + +\item{verbose}{a \code{logical} value indicating whether or not to print log +statements out to the console} +} +\value{ +a \code{\link[shiny]{reactiveValues}} list of three reactive elements; + (1) a reactive data frame, (2) the code to filter a vector with the name of + the specified data column, and (3) a flag indicating when to remove this + filter. +} +\description{ +Serves as a wrapper fo \code{\link{shiny_data_filter_item}} and utilizes \code{moduleSever()} for a more modern implementation of the data item filter. +} +\keyword{internal} diff --git a/man/IDEAFilter_item_ui.Rd b/man/IDEAFilter_item_ui.Rd new file mode 100644 index 0000000..498631e --- /dev/null +++ b/man/IDEAFilter_item_ui.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/shiny_data_filter_item.R +\name{IDEAFilter_item_ui} +\alias{IDEAFilter_item_ui} +\title{A single filter item as part of a IDEA filter module panel} +\usage{ +IDEAFilter_item_ui(id) +} +\arguments{ +\item{id}{a module id name} +} +\value{ +a shiny \code{\link[shiny]{wellPanel}} to house the filter +} +\description{ +This is a wrapper for \code{\link{shiny_data_filter_item_ui}} created to match up with the module server function \code{\link{IDEAFilter_item}}. +} +\keyword{internal} From 93a5e81462eef3d3114bb004828fa2a6a5125583 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Wed, 2 Aug 2023 13:20:39 -0400 Subject: [PATCH 021/101] Add wrappers for shiny data filter --- NAMESPACE | 2 + R/shiny_data_filter.R | 91 +++++++++++++++++++++++++++++++++++++++++++ man/IDEAFilter.Rd | 84 +++++++++++++++++++++++++++++++++++++++ man/IDEAFilter_ui.Rd | 75 +++++++++++++++++++++++++++++++++++ 4 files changed, 252 insertions(+) create mode 100644 man/IDEAFilter.Rd create mode 100644 man/IDEAFilter_ui.Rd diff --git a/NAMESPACE b/NAMESPACE index 06566fd..c36a775 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -16,8 +16,10 @@ S3method(shiny_vector_filter_ui,default) S3method(shiny_vector_filter_ui,factor) S3method(shiny_vector_filter_ui,logical) S3method(shiny_vector_filter_ui,numeric) +export(IDEAFilter) export(IDEAFilter_item) export(IDEAFilter_item_ui) +export(IDEAFilter_ui) export(getInitializationCode.shinyDataFilter_df) export(shiny_data_filter) export(shiny_data_filter_item) diff --git a/R/shiny_data_filter.R b/R/shiny_data_filter.R index 52ddc74..0b01d1f 100644 --- a/R/shiny_data_filter.R +++ b/R/shiny_data_filter.R @@ -253,10 +253,101 @@ shiny_data_filter <- function(input, output, session, data, verbose = FALSE) { }) } +#' User interface function to add a data filter panel +#' +#' This is a wrapper for \code{\link{shiny_data_filter_ui}} created to match up with the module server function \code{\link{IDEAFilter}}. +#' +#' @param id a module id name +#' @return a shiny \code{\link[shiny]{tagList}} containing the filter ui +#' +#' @import shiny +#' +#' @importFrom shiny NS tagList div actionButton icon +#' @export +#' @keywords internal +#' @seealso \link{shiny_data_filter_ui}, \link{IDEAFilter} +#' +#' @inherit shiny_data_filter examples +#' IDEAFilter_ui <- function(id) { shiny_data_filter_ui(inputId = id) } +#' IDEA data filter module server function +#' +#' Serves as a wrapper fo \code{\link{shiny_data_filter}} and utilizes \code{moduleSever()} for a more modern implementation of the data item filter. +#' +#' @param id a module id name +#' @param data a \code{data.frame} or \code{reactive expression} returning a +#' \code{data.frame} to use as the input to the filter module +#' @param ... placeholder for inclusion of additional parameters in future development +#' @param verbose a \code{logical} value indicating whether or not to print log +#' statements out to the console +#' +#' @return a \code{reactive expression} which returns the filtered data wrapped +#' in an additional class, "shinyDataFilter_df". This structure also contains +#' a "code" field which represents the code needed to generate the filtered +#' data. +#' +#' @seealso \link{IDEAFilter_ui}, \link{shiny_data_filter} +#' +#' @import shiny +#' @importFrom utils head tail +#' @importFrom stats setNames +#' @export +#' +#' @examples +#' if(all(c(interactive(), require("dplyr"), require("IDEAFilter")))) { +#' library(shiny) +#' library(IDEAFilter) +#' library(dplyr) # for data pre-processing and example data +#' +#' # prep a new data.frame with more diverse data types +#' starwars2 <- starwars %>% +#' mutate_if(~is.numeric(.) && all(Filter(Negate(is.na), .) %% 1 == 0), as.integer) %>% +#' mutate_if(~is.character(.) && length(unique(.)) <= 25, as.factor) %>% +#' mutate(is_droid = species == "Droid") %>% +#' select(name, gender, height, mass, hair_color, eye_color, vehicles, is_droid) +#' +#' # create some labels to showcase column select input +#' attr(starwars2$name, "label") <- "name of character" +#' attr(starwars2$gender, "label") <- "gender of character" +#' attr(starwars2$height, "label") <- "height of character in centimeters" +#' attr(starwars2$mass, "label") <- "mass of character in kilograms" +#' attr(starwars2$is_droid, "label") <- "whether character is a droid" +#' +#' ui <- fluidPage( +#' titlePanel("Filter Data Example"), +#' fluidRow( +#' column(8, +#' verbatimTextOutput("data_summary"), +#' verbatimTextOutput("data_filter_code")), +#' column(4, IDEAFilter_ui("data_filter")))) +#' +#' server <- function(input, output, session) { +#' filtered_data <- IDEAFilter( +#' "data_filter", +#' data = starwars2, +#' verbose = FALSE) +#' +#' output$data_filter_code <- renderPrint({ +#' cat(gsub("%>%", "%>% \n ", +#' gsub("\\s{2,}", " ", +#' paste0( +#' capture.output(attr(filtered_data(), "code")), +#' collapse = " ")) +#' )) +#' }) +#' +#' output$data_summary <- renderPrint({ +#' if (nrow(filtered_data())) show(filtered_data()) +#' else "No data available" +#' }) +#' } +#' +#' shinyApp(ui = ui, server = server) +#' } +#' IDEAFilter <- function(id, data, ..., verbose = FALSE) { moduleServer(id, function(input, output, session) { shiny_data_filter(input = input, output = output, session = session, diff --git a/man/IDEAFilter.Rd b/man/IDEAFilter.Rd new file mode 100644 index 0000000..52cae70 --- /dev/null +++ b/man/IDEAFilter.Rd @@ -0,0 +1,84 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/shiny_data_filter.R +\name{IDEAFilter} +\alias{IDEAFilter} +\title{IDEA data filter module server function} +\usage{ +IDEAFilter(id, data, ..., verbose = FALSE) +} +\arguments{ +\item{id}{a module id name} + +\item{data}{a \code{data.frame} or \code{reactive expression} returning a +\code{data.frame} to use as the input to the filter module} + +\item{...}{placeholder for inclusion of additional parameters in future development} + +\item{verbose}{a \code{logical} value indicating whether or not to print log +statements out to the console} +} +\value{ +a \code{reactive expression} which returns the filtered data wrapped + in an additional class, "shinyDataFilter_df". This structure also contains + a "code" field which represents the code needed to generate the filtered + data. +} +\description{ +Serves as a wrapper fo \code{\link{shiny_data_filter}} and utilizes \code{moduleSever()} for a more modern implementation of the data item filter. +} +\examples{ +if(all(c(interactive(), require("dplyr"), require("IDEAFilter")))) { +library(shiny) +library(IDEAFilter) +library(dplyr) # for data pre-processing and example data + +# prep a new data.frame with more diverse data types +starwars2 <- starwars \%>\% + mutate_if(~is.numeric(.) && all(Filter(Negate(is.na), .) \%\% 1 == 0), as.integer) \%>\% + mutate_if(~is.character(.) && length(unique(.)) <= 25, as.factor) \%>\% + mutate(is_droid = species == "Droid") \%>\% + select(name, gender, height, mass, hair_color, eye_color, vehicles, is_droid) + +# create some labels to showcase column select input +attr(starwars2$name, "label") <- "name of character" +attr(starwars2$gender, "label") <- "gender of character" +attr(starwars2$height, "label") <- "height of character in centimeters" +attr(starwars2$mass, "label") <- "mass of character in kilograms" +attr(starwars2$is_droid, "label") <- "whether character is a droid" + +ui <- fluidPage( + titlePanel("Filter Data Example"), + fluidRow( + column(8, + verbatimTextOutput("data_summary"), + verbatimTextOutput("data_filter_code")), + column(4, IDEAFilter_ui("data_filter")))) + +server <- function(input, output, session) { + filtered_data <- IDEAFilter( + "data_filter", + data = starwars2, + verbose = FALSE) + + output$data_filter_code <- renderPrint({ + cat(gsub("\%>\%", "\%>\% \n ", + gsub("\\\\s{2,}", " ", + paste0( + capture.output(attr(filtered_data(), "code")), + collapse = " ")) + )) + }) + + output$data_summary <- renderPrint({ + if (nrow(filtered_data())) show(filtered_data()) + else "No data available" + }) +} + +shinyApp(ui = ui, server = server) +} + +} +\seealso{ +\link{IDEAFilter_ui}, \link{shiny_data_filter} +} diff --git a/man/IDEAFilter_ui.Rd b/man/IDEAFilter_ui.Rd new file mode 100644 index 0000000..92fe151 --- /dev/null +++ b/man/IDEAFilter_ui.Rd @@ -0,0 +1,75 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/shiny_data_filter.R +\name{IDEAFilter_ui} +\alias{IDEAFilter_ui} +\title{User interface function to add a data filter panel} +\usage{ +IDEAFilter_ui(id) +} +\arguments{ +\item{id}{a module id name} +} +\value{ +a shiny \code{\link[shiny]{tagList}} containing the filter ui +} +\description{ +This is a wrapper for \code{\link{shiny_data_filter_ui}} created to match up with the module server function \code{\link{IDEAFilter}}. +} +\examples{ +if(all(c(interactive(), require("dplyr"), require("IDEAFilter")))) { +library(shiny) +library(IDEAFilter) +library(dplyr) # for data pre-processing and example data + +# prep a new data.frame with more diverse data types +starwars2 <- starwars \%>\% + mutate_if(~is.numeric(.) && all(Filter(Negate(is.na), .) \%\% 1 == 0), as.integer) \%>\% + mutate_if(~is.character(.) && length(unique(.)) <= 25, as.factor) \%>\% + mutate(is_droid = species == "Droid") \%>\% + select(name, gender, height, mass, hair_color, eye_color, vehicles, is_droid) + +# create some labels to showcase column select input +attr(starwars2$name, "label") <- "name of character" +attr(starwars2$gender, "label") <- "gender of character" +attr(starwars2$height, "label") <- "height of character in centimeters" +attr(starwars2$mass, "label") <- "mass of character in kilograms" +attr(starwars2$is_droid, "label") <- "whether character is a droid" + +ui <- fluidPage( + titlePanel("Filter Data Example"), + fluidRow( + column(8, + verbatimTextOutput("data_summary"), + verbatimTextOutput("data_filter_code")), + column(4, shiny_data_filter_ui("data_filter")))) + +server <- function(input, output, session) { + filtered_data <- callModule( + shiny_data_filter, + "data_filter", + data = starwars2, + verbose = FALSE) + + output$data_filter_code <- renderPrint({ + cat(gsub("\%>\%", "\%>\% \n ", + gsub("\\\\s{2,}", " ", + paste0( + capture.output(attr(filtered_data(), "code")), + collapse = " ")) + )) + }) + + output$data_summary <- renderPrint({ + if (nrow(filtered_data())) show(filtered_data()) + else "No data available" + }) +} + +shinyApp(ui = ui, server = server) +} + +} +\seealso{ +\link{shiny_data_filter_ui}, \link{IDEAFilter} +} +\keyword{internal} From 262e616714a3c22cad41c44fa486bae92456f7e6 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Wed, 2 Aug 2023 13:23:31 -0400 Subject: [PATCH 022/101] Update NEWS --- DESCRIPTION | 2 +- NEWS.md | 1 + 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index b676fce..f7f032c 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: IDEAFilter Type: Package -Version: 0.1.3.9002 +Version: 0.1.3.9003 Title: Agnostic, Idiomatic Data Filter Module for Shiny Description: When added to an existing shiny app, users may subset any developer-chosen R data.frame on the fly. That is, users are empowered to diff --git a/NEWS.md b/NEWS.md index c1df96e..1e2652f 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,6 +1,7 @@ # IDEAFilter (development version) * Fix bug that was trying to assign an attribute to a NULL (#15) * Fix bug that was causing inaccurate filtering for `datetime` vectors (#17) +* Add wrappers for module functions for more modern implementation (#22) # IDEAFilter 0.1.3 * Cited works of other contributors (`shinyDataFilter` & `SortableJS`) From 9b00b3dbee36688ae3f9d983f40034c7c34d1b4a Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Wed, 2 Aug 2023 13:29:10 -0400 Subject: [PATCH 023/101] Add reader readme action --- .github/workflows/render-readme.yml | 40 +++++++++++++++++++++++++++++ 1 file changed, 40 insertions(+) create mode 100644 .github/workflows/render-readme.yml diff --git a/.github/workflows/render-readme.yml b/.github/workflows/render-readme.yml new file mode 100644 index 0000000..1a111d9 --- /dev/null +++ b/.github/workflows/render-readme.yml @@ -0,0 +1,40 @@ +# Workflow derived from https://github.com/r-lib/actions/tree/v2/examples +# Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help + +# this is set to re-render whenever README.Rmd is changed on a given branch +# the file is rendered and committed to the same branch +# adapted from: https://github.com/r-lib/actions/tree/v2/examples#render-rmarkdown +on: + push: + paths: ['README.Rmd'] + +name: render-readme + +jobs: + render-rmarkdown: + runs-on: ubuntu-latest + env: + GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} + steps: + - name: Checkout repo + uses: actions/checkout@v3 + with: + fetch-depth: 0 + + - uses: r-lib/actions/setup-pandoc@v2 + + - uses: r-lib/actions/setup-r@v2 + + # install packages needed + - name: install required packages + run: Rscript -e 'install.packages(c("rmarkdown"))' + + - name: Render Rmarkdown files and Commit Results + run: | + Rscript -e 'rmarkdown::render("README.Rmd", output_format = "github_document")' + git config --local user.name "$GITHUB_ACTOR" + git config --local user.email "$GITHUB_ACTOR@users.noreply.github.com" + git add README.md || echo "WARN: README.md was not updated" + git add man/figures/README-* || echo "No figure updates were found" + git commit -m 'Re-build Rmarkdown files' || echo "No changes to commit" + git push origin || echo "No changes to commit" From e8a5d438e140806cb00096507115373a1994c45b Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Wed, 2 Aug 2023 13:29:27 -0400 Subject: [PATCH 024/101] Update README to use wrappers --- README.Rmd | 12 +++++------- 1 file changed, 5 insertions(+), 7 deletions(-) diff --git a/README.Rmd b/README.Rmd index 7c24c26..e0c0139 100644 --- a/README.Rmd +++ b/README.Rmd @@ -45,15 +45,14 @@ devtools::install_github("Biogen-Inc/IDEAFilter") After installation, you now have access to the`IDEAFilter` shiny module. On the UI side, you need only include the following line of code to place the filtering widget somewhere in your app: ```{r, eval=FALSE} -shiny_data_filter_ui(inputId = "data_filter") +IDEAFilter_ui(id = "data_filter") ``` -The server side logic needs to call the `shiny_data_filter` module, match the input ID from the UI, and provide a data source. The returned reactive data.frame (called "filtered_data") may used for downstream processes regardless on if the user chooses to apply filters or not. +The server side logic needs to call the `IDEAFilter` module, match the input ID from the UI, and provide a data source. The returned reactive data.frame (called "filtered_data") may used for downstream processes regardless on if the user chooses to apply filters or not. ```{r, eval=FALSE} filtered_data <- # name the returned reactive data frame - callModule( - shiny_data_filter, # call the module by name + IDEAFilter( "data_filter", # give the filter a name(space) data = starwars2, # feed it raw data verbose = FALSE @@ -98,14 +97,13 @@ ui <- fluidPage( dataTableOutput("data_summary"), h4("Generated Code"), verbatimTextOutput("data_filter_code")), - column(4, shiny_data_filter_ui("data_filter")))) + column(4, IDEAFilter_ui("data_filter")))) server <- function(input, output, session) { filtered_data <- # name the returned reactive data frame - callModule( - shiny_data_filter, # call the module + IDEAFilter( "data_filter", # give the filter a name(space) data = starwars2, # feed it raw data verbose = FALSE From 4ebe12408d84ec56afb5a1fe3ca711a081f255b6 Mon Sep 17 00:00:00 2001 From: Jeff-Thompson12 Date: Wed, 2 Aug 2023 17:36:04 +0000 Subject: [PATCH 025/101] Re-build Rmarkdown files --- README.md | 18 ++++++++---------- 1 file changed, 8 insertions(+), 10 deletions(-) diff --git a/README.md b/README.md index 87c8feb..28c2d8d 100644 --- a/README.md +++ b/README.md @@ -61,18 +61,17 @@ On the UI side, you need only include the following line of code to place the filtering widget somewhere in your app: ``` r -shiny_data_filter_ui(inputId = "data_filter") +IDEAFilter_ui(id = "data_filter") ``` -The server side logic needs to call the `shiny_data_filter` module, -match the input ID from the UI, and provide a data source. The returned -reactive data.frame (called “filtered_data”) may used for downstream -processes regardless on if the user chooses to apply filters or not. +The server side logic needs to call the `IDEAFilter` module, match the +input ID from the UI, and provide a data source. The returned reactive +data.frame (called “filtered_data”) may used for downstream processes +regardless on if the user chooses to apply filters or not. ``` r filtered_data <- # name the returned reactive data frame - callModule( - shiny_data_filter, # call the module by name + IDEAFilter( "data_filter", # give the filter a name(space) data = starwars2, # feed it raw data verbose = FALSE @@ -119,14 +118,13 @@ ui <- fluidPage( dataTableOutput("data_summary"), h4("Generated Code"), verbatimTextOutput("data_filter_code")), - column(4, shiny_data_filter_ui("data_filter")))) + column(4, IDEAFilter_ui("data_filter")))) server <- function(input, output, session) { filtered_data <- # name the returned reactive data frame - callModule( - shiny_data_filter, # call the module + IDEAFilter( "data_filter", # give the filter a name(space) data = starwars2, # feed it raw data verbose = FALSE From 88b9a29261a4250d86d7fa4a6ff1ba658754a5f0 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Wed, 2 Aug 2023 13:42:15 -0400 Subject: [PATCH 026/101] Clean up comments and examples a little --- R/shiny_data_filter.R | 12 ++++++------ R/shiny_data_filter_item.R | 7 +++++-- README.Rmd | 6 +----- man/IDEAFilter.Rd | 9 ++++----- man/IDEAFilter_item.Rd | 4 +++- man/IDEAFilter_item_ui.Rd | 3 ++- man/IDEAFilter_ui.Rd | 3 ++- 7 files changed, 23 insertions(+), 21 deletions(-) diff --git a/R/shiny_data_filter.R b/R/shiny_data_filter.R index 0b01d1f..a3e326c 100644 --- a/R/shiny_data_filter.R +++ b/R/shiny_data_filter.R @@ -255,7 +255,8 @@ shiny_data_filter <- function(input, output, session, data, verbose = FALSE) { #' User interface function to add a data filter panel #' -#' This is a wrapper for \code{\link{shiny_data_filter_ui}} created to match up with the module server function \code{\link{IDEAFilter}}. +#' This is a wrapper for \code{\link{shiny_data_filter_ui}} created to match up +#' with the module server function \code{\link{IDEAFilter}}. #' #' @param id a module id name #' @return a shiny \code{\link[shiny]{tagList}} containing the filter ui @@ -275,7 +276,9 @@ IDEAFilter_ui <- function(id) { #' IDEA data filter module server function #' -#' Serves as a wrapper fo \code{\link{shiny_data_filter}} and utilizes \code{moduleSever()} for a more modern implementation of the data item filter. +#' Serves as a wrapper fo \code{\link{shiny_data_filter}} and utilizes +#' \code{moduleSever()} for a more modern implementation of the data item +#' filter. #' #' @param id a module id name #' @param data a \code{data.frame} or \code{reactive expression} returning a @@ -325,10 +328,7 @@ IDEAFilter_ui <- function(id) { #' column(4, IDEAFilter_ui("data_filter")))) #' #' server <- function(input, output, session) { -#' filtered_data <- IDEAFilter( -#' "data_filter", -#' data = starwars2, -#' verbose = FALSE) +#' filtered_data <- IDEAFilter("data_filter", data = starwars2, verbose = FALSE) #' #' output$data_filter_code <- renderPrint({ #' cat(gsub("%>%", "%>% \n ", diff --git a/R/shiny_data_filter_item.R b/R/shiny_data_filter_item.R index b44ce92..5ca8109 100644 --- a/R/shiny_data_filter_item.R +++ b/R/shiny_data_filter_item.R @@ -206,7 +206,8 @@ shiny_data_filter_item <- function(input, output, session, data, #' A single filter item as part of a IDEA filter module panel #' -#' This is a wrapper for \code{\link{shiny_data_filter_item_ui}} created to match up with the module server function \code{\link{IDEAFilter_item}}. +#' This is a wrapper for \code{\link{shiny_data_filter_item_ui}} created to +#' match up with the module server function \code{\link{IDEAFilter_item}}. #' #' @param id a module id name #' @@ -222,7 +223,9 @@ IDEAFilter_item_ui <- function(id) { #' The server function for the IDEA filter item module #' -#' Serves as a wrapper fo \code{\link{shiny_data_filter_item}} and utilizes \code{moduleSever()} for a more modern implementation of the data item filter. +#' Serves as a wrapper fo \code{\link{shiny_data_filter_item}} and utilizes +#' \code{moduleSever()} for a more modern implementation of the data item +#' filter. #' #' @param id a module id name #' @param data a \code{reactive expression} returning a \code{data.frame} to use diff --git a/README.Rmd b/README.Rmd index e0c0139..588aa4f 100644 --- a/README.Rmd +++ b/README.Rmd @@ -103,11 +103,7 @@ server <- function(input, output, session) { filtered_data <- # name the returned reactive data frame - IDEAFilter( - "data_filter", # give the filter a name(space) - data = starwars2, # feed it raw data - verbose = FALSE - ) + IDEAFilter("data_filter", data = starwars2,verbose = FALSE) # extract & display the "code" attribute to see dplyr::filter() # statements performed diff --git a/man/IDEAFilter.Rd b/man/IDEAFilter.Rd index 52cae70..948e6a8 100644 --- a/man/IDEAFilter.Rd +++ b/man/IDEAFilter.Rd @@ -24,7 +24,9 @@ a \code{reactive expression} which returns the filtered data wrapped data. } \description{ -Serves as a wrapper fo \code{\link{shiny_data_filter}} and utilizes \code{moduleSever()} for a more modern implementation of the data item filter. +Serves as a wrapper fo \code{\link{shiny_data_filter}} and utilizes +\code{moduleSever()} for a more modern implementation of the data item +filter. } \examples{ if(all(c(interactive(), require("dplyr"), require("IDEAFilter")))) { @@ -55,10 +57,7 @@ ui <- fluidPage( column(4, IDEAFilter_ui("data_filter")))) server <- function(input, output, session) { - filtered_data <- IDEAFilter( - "data_filter", - data = starwars2, - verbose = FALSE) + filtered_data <- IDEAFilter("data_filter", data = starwars2, verbose = FALSE) output$data_filter_code <- renderPrint({ cat(gsub("\%>\%", "\%>\% \n ", diff --git a/man/IDEAFilter_item.Rd b/man/IDEAFilter_item.Rd index c33f128..07283c9 100644 --- a/man/IDEAFilter_item.Rd +++ b/man/IDEAFilter_item.Rd @@ -26,6 +26,8 @@ a \code{\link[shiny]{reactiveValues}} list of three reactive elements; filter. } \description{ -Serves as a wrapper fo \code{\link{shiny_data_filter_item}} and utilizes \code{moduleSever()} for a more modern implementation of the data item filter. +Serves as a wrapper fo \code{\link{shiny_data_filter_item}} and utilizes +\code{moduleSever()} for a more modern implementation of the data item +filter. } \keyword{internal} diff --git a/man/IDEAFilter_item_ui.Rd b/man/IDEAFilter_item_ui.Rd index 498631e..9f286c8 100644 --- a/man/IDEAFilter_item_ui.Rd +++ b/man/IDEAFilter_item_ui.Rd @@ -13,6 +13,7 @@ IDEAFilter_item_ui(id) a shiny \code{\link[shiny]{wellPanel}} to house the filter } \description{ -This is a wrapper for \code{\link{shiny_data_filter_item_ui}} created to match up with the module server function \code{\link{IDEAFilter_item}}. +This is a wrapper for \code{\link{shiny_data_filter_item_ui}} created to +match up with the module server function \code{\link{IDEAFilter_item}}. } \keyword{internal} diff --git a/man/IDEAFilter_ui.Rd b/man/IDEAFilter_ui.Rd index 92fe151..721bd68 100644 --- a/man/IDEAFilter_ui.Rd +++ b/man/IDEAFilter_ui.Rd @@ -13,7 +13,8 @@ IDEAFilter_ui(id) a shiny \code{\link[shiny]{tagList}} containing the filter ui } \description{ -This is a wrapper for \code{\link{shiny_data_filter_ui}} created to match up with the module server function \code{\link{IDEAFilter}}. +This is a wrapper for \code{\link{shiny_data_filter_ui}} created to match up +with the module server function \code{\link{IDEAFilter}}. } \examples{ if(all(c(interactive(), require("dplyr"), require("IDEAFilter")))) { From f7711b40f8b2e8905f46871e6887fbb11f26ae60 Mon Sep 17 00:00:00 2001 From: Jeff-Thompson12 Date: Wed, 2 Aug 2023 17:50:33 +0000 Subject: [PATCH 027/101] Re-build Rmarkdown files --- README.md | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) diff --git a/README.md b/README.md index 28c2d8d..04d2745 100644 --- a/README.md +++ b/README.md @@ -124,11 +124,7 @@ server <- function(input, output, session) { filtered_data <- # name the returned reactive data frame - IDEAFilter( - "data_filter", # give the filter a name(space) - data = starwars2, # feed it raw data - verbose = FALSE - ) + IDEAFilter("data_filter", data = starwars2,verbose = FALSE) # extract & display the "code" attribute to see dplyr::filter() # statements performed From 52205e1f0d4e4d5cdfb49e02ae9ac9637b3f075d Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Fri, 4 Aug 2023 15:13:47 -0400 Subject: [PATCH 028/101] Separate out IDEAFilter modules --- DESCRIPTION | 2 +- R/shiny_data_filter.R | 104 +------------------------------------ R/shiny_data_filter_item.R | 52 +------------------ 3 files changed, 5 insertions(+), 153 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index f7f032c..11e8212 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -33,7 +33,7 @@ Authors@R: c( comment = "SortableJS library"), person(given = "Biogen", role = "cph")) License: AGPL-3 + file LICENSE -URL: https://biogen-inc.github.io/IDEAFilter/, https://github.com/Biogen-Inc/IDEAFilter +URL: https://biogen-inc.github.io/IDEAFilter, https://github.com/Biogen-Inc/IDEAFilter BugReports: https://github.com/Biogen-Inc/IDEAFilter/issues Encoding: UTF-8 LazyData: true diff --git a/R/shiny_data_filter.R b/R/shiny_data_filter.R index a3e326c..742b2a0 100644 --- a/R/shiny_data_filter.R +++ b/R/shiny_data_filter.R @@ -13,6 +13,7 @@ #' @inherit shiny_data_filter examples #' shiny_data_filter_ui <- function(inputId) { + .Deprecated("IDEAFilter_ui") ns <- shiny::NS(inputId) shinyDataFilter_resourcePath() @@ -118,6 +119,7 @@ shiny_data_filter_ui <- function(inputId) { #' } #' shiny_data_filter <- function(input, output, session, data, verbose = FALSE) { + .Deprecated("IDEAFilter") ns <- session$ns filter_log("calling module", verbose = verbose) @@ -252,105 +254,3 @@ shiny_data_filter <- function(input, output, session, data, verbose = FALSE) { class = c("shinyDataFilter_df", class(d))) }) } - -#' User interface function to add a data filter panel -#' -#' This is a wrapper for \code{\link{shiny_data_filter_ui}} created to match up -#' with the module server function \code{\link{IDEAFilter}}. -#' -#' @param id a module id name -#' @return a shiny \code{\link[shiny]{tagList}} containing the filter ui -#' -#' @import shiny -#' -#' @importFrom shiny NS tagList div actionButton icon -#' @export -#' @keywords internal -#' @seealso \link{shiny_data_filter_ui}, \link{IDEAFilter} -#' -#' @inherit shiny_data_filter examples -#' -IDEAFilter_ui <- function(id) { - shiny_data_filter_ui(inputId = id) -} - -#' IDEA data filter module server function -#' -#' Serves as a wrapper fo \code{\link{shiny_data_filter}} and utilizes -#' \code{moduleSever()} for a more modern implementation of the data item -#' filter. -#' -#' @param id a module id name -#' @param data a \code{data.frame} or \code{reactive expression} returning a -#' \code{data.frame} to use as the input to the filter module -#' @param ... placeholder for inclusion of additional parameters in future development -#' @param verbose a \code{logical} value indicating whether or not to print log -#' statements out to the console -#' -#' @return a \code{reactive expression} which returns the filtered data wrapped -#' in an additional class, "shinyDataFilter_df". This structure also contains -#' a "code" field which represents the code needed to generate the filtered -#' data. -#' -#' @seealso \link{IDEAFilter_ui}, \link{shiny_data_filter} -#' -#' @import shiny -#' @importFrom utils head tail -#' @importFrom stats setNames -#' @export -#' -#' @examples -#' if(all(c(interactive(), require("dplyr"), require("IDEAFilter")))) { -#' library(shiny) -#' library(IDEAFilter) -#' library(dplyr) # for data pre-processing and example data -#' -#' # prep a new data.frame with more diverse data types -#' starwars2 <- starwars %>% -#' mutate_if(~is.numeric(.) && all(Filter(Negate(is.na), .) %% 1 == 0), as.integer) %>% -#' mutate_if(~is.character(.) && length(unique(.)) <= 25, as.factor) %>% -#' mutate(is_droid = species == "Droid") %>% -#' select(name, gender, height, mass, hair_color, eye_color, vehicles, is_droid) -#' -#' # create some labels to showcase column select input -#' attr(starwars2$name, "label") <- "name of character" -#' attr(starwars2$gender, "label") <- "gender of character" -#' attr(starwars2$height, "label") <- "height of character in centimeters" -#' attr(starwars2$mass, "label") <- "mass of character in kilograms" -#' attr(starwars2$is_droid, "label") <- "whether character is a droid" -#' -#' ui <- fluidPage( -#' titlePanel("Filter Data Example"), -#' fluidRow( -#' column(8, -#' verbatimTextOutput("data_summary"), -#' verbatimTextOutput("data_filter_code")), -#' column(4, IDEAFilter_ui("data_filter")))) -#' -#' server <- function(input, output, session) { -#' filtered_data <- IDEAFilter("data_filter", data = starwars2, verbose = FALSE) -#' -#' output$data_filter_code <- renderPrint({ -#' cat(gsub("%>%", "%>% \n ", -#' gsub("\\s{2,}", " ", -#' paste0( -#' capture.output(attr(filtered_data(), "code")), -#' collapse = " ")) -#' )) -#' }) -#' -#' output$data_summary <- renderPrint({ -#' if (nrow(filtered_data())) show(filtered_data()) -#' else "No data available" -#' }) -#' } -#' -#' shinyApp(ui = ui, server = server) -#' } -#' -IDEAFilter <- function(id, data, ..., verbose = FALSE) { - moduleServer(id, function(input, output, session) { - shiny_data_filter(input = input, output = output, session = session, - data = data, verbose = verbose) - }) -} diff --git a/R/shiny_data_filter_item.R b/R/shiny_data_filter_item.R index 5ca8109..003bd30 100644 --- a/R/shiny_data_filter_item.R +++ b/R/shiny_data_filter_item.R @@ -18,6 +18,7 @@ #' @keywords internal #' shiny_data_filter_item_ui <- function(inputId, verbose = FALSE) { + .Deprecated("IDEAFilter_item_ui") ns <- shiny::NS(inputId) shiny::uiOutput(ns("ui"), class = "list-group-item well", @@ -54,6 +55,7 @@ shiny_data_filter_item_ui <- function(inputId, verbose = FALSE) { #' shiny_data_filter_item <- function(input, output, session, data, column_name = NULL, verbose = FALSE) { + .Deprecated("IDEAFilter_item") ns <- session$ns @@ -203,53 +205,3 @@ shiny_data_filter_item <- function(input, output, session, data, module_return } - -#' A single filter item as part of a IDEA filter module panel -#' -#' This is a wrapper for \code{\link{shiny_data_filter_item_ui}} created to -#' match up with the module server function \code{\link{IDEAFilter_item}}. -#' -#' @param id a module id name -#' -#' @return a shiny \code{\link[shiny]{wellPanel}} to house the filter -#' -#' @importFrom shiny NS uiOutput -#' @export -#' @keywords internal -#' -IDEAFilter_item_ui <- function(id) { - shiny_data_filter_item_ui(inputId = id) -} - -#' The server function for the IDEA filter item module -#' -#' Serves as a wrapper fo \code{\link{shiny_data_filter_item}} and utilizes -#' \code{moduleSever()} for a more modern implementation of the data item -#' filter. -#' -#' @param id a module id name -#' @param data a \code{reactive expression} returning a \code{data.frame} to use -#' as the input to the filter item module -#' @param column_name a value indicating the name of the column to be filtered -#' @param ... placeholder for inclusion of additional parameters in future development -#' @param verbose a \code{logical} value indicating whether or not to print log -#' statements out to the console -#' -#' @return a \code{\link[shiny]{reactiveValues}} list of three reactive elements; -#' (1) a reactive data frame, (2) the code to filter a vector with the name of -#' the specified data column, and (3) a flag indicating when to remove this -#' filter. -#' -#' @importFrom shiny reactiveValues wellPanel fillRow selectInput h4 actionLink -#' icon uiOutput div HTML span textOutput eventReactive renderUI tag -#' renderText reactive observeEvent callModule -#' @export -#' @keywords internal -#' -IDEAFilter_item <- function(id, data, column_name = NULL, ..., verbose = FALSE) { - moduleServer(id, function(input, output, session) { - shiny_data_filter_item(input = input, output = output, session = session, - data = data, column_name = column_name, - verbose = verbose) - }) -} From 827917d9e77621ca758e14c098e3fd8de0ca0a2f Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Mon, 7 Aug 2023 15:41:28 -0400 Subject: [PATCH 029/101] Add new filters using modern module implementation --- R/IDEAFilter.R | 251 ++++++++++++++++++++++++++++++++++++++++++++ R/IDEAFilter_item.R | 199 +++++++++++++++++++++++++++++++++++ 2 files changed, 450 insertions(+) create mode 100644 R/IDEAFilter.R create mode 100644 R/IDEAFilter_item.R diff --git a/R/IDEAFilter.R b/R/IDEAFilter.R new file mode 100644 index 0000000..8f609b3 --- /dev/null +++ b/R/IDEAFilter.R @@ -0,0 +1,251 @@ +#' User interface function to add a data filter panel +#' +#' This is a wrapper for \code{\link{shiny_data_filter_ui}} created to match up +#' with the module server function \code{\link{IDEAFilter}}. +#' +#' @param id a module id name +#' @return a shiny \code{\link[shiny]{tagList}} containing the filter ui +#' +#' @import shiny +#' +#' @importFrom shiny NS tagList div actionButton icon +#' @export +#' @keywords internal +#' @seealso \link{shiny_data_filter_ui}, \link{IDEAFilter} +#' +#' @inherit shiny_data_filter examples +#' +IDEAFilter_ui <- function(id) { + ns <- shiny::NS(id) + + shinyDataFilter_resourcePath() + + shiny::tagList( + css_sortableJS_style_script(), + js_sortableJS_script(), + css_shinyDataFilter_animation_script(), + css_shinyDataFilter_style_script(), + shiny::div( + id = ns("sortableList"), + class = "listWithHandle list-group", + style = "margin-bottom: 0;"), + shiny::div( + id = "shinyDataFilter-addFilter", + width = "100%", + uiOutput(ns("add_filter_select_ui"))) + ) +} + +#' IDEA data filter module server function +#' +#' Serves as a wrapper fo \code{\link{shiny_data_filter}} and utilizes +#' \code{moduleSever()} for a more modern implementation of the data item +#' filter. +#' +#' @param id a module id name +#' @param data a \code{data.frame} or \code{reactive expression} returning a +#' \code{data.frame} to use as the input to the filter module +#' @param ... placeholder for inclusion of additional parameters in future development +#' @param verbose a \code{logical} value indicating whether or not to print log +#' statements out to the console +#' +#' @return a \code{reactive expression} which returns the filtered data wrapped +#' in an additional class, "shinyDataFilter_df". This structure also contains +#' a "code" field which represents the code needed to generate the filtered +#' data. +#' +#' @seealso \link{IDEAFilter_ui}, \link{shiny_data_filter} +#' +#' @import shiny +#' @importFrom utils head tail +#' @importFrom stats setNames +#' @export +#' +#' @examples +#' if(all(c(interactive(), require("dplyr"), require("IDEAFilter")))) { +#' library(shiny) +#' library(IDEAFilter) +#' library(dplyr) # for data pre-processing and example data +#' +#' # prep a new data.frame with more diverse data types +#' starwars2 <- starwars %>% +#' mutate_if(~is.numeric(.) && all(Filter(Negate(is.na), .) %% 1 == 0), as.integer) %>% +#' mutate_if(~is.character(.) && length(unique(.)) <= 25, as.factor) %>% +#' mutate(is_droid = species == "Droid") %>% +#' select(name, gender, height, mass, hair_color, eye_color, vehicles, is_droid) +#' +#' # create some labels to showcase column select input +#' attr(starwars2$name, "label") <- "name of character" +#' attr(starwars2$gender, "label") <- "gender of character" +#' attr(starwars2$height, "label") <- "height of character in centimeters" +#' attr(starwars2$mass, "label") <- "mass of character in kilograms" +#' attr(starwars2$is_droid, "label") <- "whether character is a droid" +#' +#' ui <- fluidPage( +#' titlePanel("Filter Data Example"), +#' fluidRow( +#' column(8, +#' verbatimTextOutput("data_summary"), +#' verbatimTextOutput("data_filter_code")), +#' column(4, IDEAFilter_ui("data_filter")))) +#' +#' server <- function(input, output, session) { +#' filtered_data <- IDEAFilter("data_filter", data = starwars2, verbose = FALSE) +#' +#' output$data_filter_code <- renderPrint({ +#' cat(gsub("%>%", "%>% \n ", +#' gsub("\\s{2,}", " ", +#' paste0( +#' capture.output(attr(filtered_data(), "code")), +#' collapse = " ")) +#' )) +#' }) +#' +#' output$data_summary <- renderPrint({ +#' if (nrow(filtered_data())) show(filtered_data()) +#' else "No data available" +#' }) +#' } +#' +#' shinyApp(ui = ui, server = server) +#' } +#' +IDEAFilter <- function(id, data, ..., verbose = FALSE) { + moduleServer(id, function(input, output, session) { + ns <- session$ns + filter_log("calling module", verbose = verbose) + + data_call <- as.list(sys.call(-5L))$data + datar <- if (is.reactive(data)) data else reactive(data) + + filter_counter <- 0 + next_filter_id <- function() { + filter_counter <<- filter_counter + 1 + sprintf("filter_%d", filter_counter) + } + + filters <- reactiveVal(c("filter_0")) + filter_returns <- list(filter_0 = reactiveValues( + data = datar, + code = reactive(TRUE), + filters = reactive(list()), + remove = NULL)) + + update_filter <- function(fid, in_fid, column_name = NULL) { + fs <- isolate(filters()) + + if (missing(in_fid)) + if (fid %in% fs) in_fid <- fs[[utils::head(which(fid == fs), 1) - 1]] + else in_fid <- utils::tail(fs, 1) + + if (!in_fid %in% fs | !in_fid %in% names(filter_returns)) + stop('no known filter for inbound filter id.') + + if (fid %in% names(filter_returns)) { + column_name <- filter_returns[[fid]]$column_name + filter_returns[[fid]]$destroy + } + + filter_returns[[fid]] <<- IDEAFilter_item( + fid, + data = datar, + column_name = column_name, + filters = filter_returns[[in_fid]]$filters, + verbose = verbose) + } + + output$add_filter_select_ui <- renderUI({ + columnSelectInput( + ns("add_filter_select"), + label = NULL, + data = datar, + placeholder = "Add Filter", + width = "100%") + }) + + observe({ + filter_log("scrubbing filters tagged for removal", verbose = verbose) + for (fid in filters()[-1]) + if (isTRUE(filter_returns[[fid]]$remove)) { + idx <- utils::head(which(filters() == fid), 1) + filter_returns[[fid]]$destroy + + filters(setdiff(filters(), fid)) + + # overwrite existing module call with one taking new input data + if (!idx > length(filters())) update_filter(filters()[[idx]]) + + removeUI(selector = sprintf("#%s-ui", ns(fid))) + break + } + }) + + observeEvent(input$add_filter_btn, { + filter_log("observing add filter button press", verbose = verbose) + update_filter(fid <- next_filter_id()) + filters(append(filters(), fid)) + + insertUI( + selector = sprintf("#%s", ns("sortableList")), + where = "beforeEnd", + ui = IDEAFilter_item_ui(ns(fid))) + }) + + observeEvent(input$add_filter_select, { + if (!input$add_filter_select %in% names(datar())) return() + + filter_log("observing add filter button press", verbose = verbose) + update_filter(fid <- next_filter_id(), column_name = input$add_filter_select) + filters(append(filters(), fid)) + + insertUI( + selector = sprintf("#%s", ns("sortableList")), + where = "beforeEnd", + ui = IDEAFilter_item_ui(ns(fid))) + + updateSelectInput(session, "add_filter_select", selected = "") + }, ignoreInit = TRUE, ignoreNULL = TRUE) + + # observe drag-and-drop and update data flow + observeEvent(input$sortableList, { + old_filters <- filters() + + filters(c( + filters()[1], # preserve input 'filter' + gsub(sprintf("^%s", ns("")), "", Filter(nchar, input$sortableList)) + )) + + filter_log("updating sortableJS list: ", + paste(filters(), collapse = ", "), + verbose = verbose) + + # update filters downstream of change, isolate to prevent premature updates + idxs <- which(cumsum(old_filters != filters()) > 0) + + isolate(for (idx in idxs) update_filter(filters()[[idx]])) + }) + + filter_logical <- reactiveVal(TRUE) + code <- reactive({ + filter_log("building code", verbose = verbose) + filter_exprs <- Filter( + Negate(isTRUE), + Map(function(fi) filter_returns[[fi]]$code(), filters())) + + filter_logical(if (!length(filter_exprs)) rep(TRUE,nrow(datar())) else Reduce("&", Map(function(x) with(datar(), eval(x)), filter_exprs))) + + Reduce( + function(l,r) bquote(.(l) %>% filter(.(r))), + filter_exprs, + init = data_call) + }) + + reactive({ + filter_log("recalculating filtered data", verbose = verbose) + structure( + d <- subset(datar(), filter_logical()) %||% data.frame(), + code = code(), + class = c("shinyDataFilter_df", class(d))) + }) + }) +} \ No newline at end of file diff --git a/R/IDEAFilter_item.R b/R/IDEAFilter_item.R new file mode 100644 index 0000000..1b9b4b2 --- /dev/null +++ b/R/IDEAFilter_item.R @@ -0,0 +1,199 @@ +#' A single filter item as part of a IDEA filter module panel +#' +#' This is a wrapper for \code{\link{shiny_data_filter_item_ui}} created to +#' match up with the module server function \code{\link{IDEAFilter_item}}. +#' +#' @param id a module id name +#' +#' @return a shiny \code{\link[shiny]{wellPanel}} to house the filter +#' +#' @importFrom shiny NS uiOutput +#' @export +#' @keywords internal +#' +IDEAFilter_item_ui <- function(id) { + ns <- shiny::NS(id) + shiny::uiOutput(ns("ui"), + class = "list-group-item well", + style = "padding: 6px 14px 0px 14px; margin-bottom: 6px;", + `data-id` = id) +} + +#' The server function for the IDEA filter item module +#' +#' Serves as a wrapper fo \code{\link{shiny_data_filter_item}} and utilizes +#' \code{moduleSever()} for a more modern implementation of the data item +#' filter. +#' +#' @param id a module id name +#' @param data a \code{reactive expression} returning a \code{data.frame} to use +#' as the input to the filter item module +#' @param column_name a value indicating the name of the column to be filtered +#' @param ... placeholder for inclusion of additional parameters in future development +#' @param verbose a \code{logical} value indicating whether or not to print log +#' statements out to the console +#' +#' @return a \code{\link[shiny]{reactiveValues}} list of three reactive elements; +#' (1) a reactive data frame, (2) the code to filter a vector with the name of +#' the specified data column, and (3) a flag indicating when to remove this +#' filter. +#' +#' @importFrom shiny reactiveValues wellPanel fillRow selectInput h4 actionLink +#' icon uiOutput div HTML span textOutput eventReactive renderUI tag +#' renderText reactive observeEvent callModule +#' @export +#' @keywords internal +#' +IDEAFilter_item <- function(id, data, column_name = NULL, ..., filters = list(), verbose = FALSE) { + filters <- if (is.reactive(filters)) filters else reactiveVal(filters) + moduleServer(id, function(input, output, session) { + ns <- session$ns + + module_return <- shiny::reactiveValues( + # data = data, + code = TRUE, + remove = FALSE, + filters = filters, + column_name = column_name) + + filter_logical <- reactive({ + if (!length(filters())) rep(TRUE, nrow(data())) else Reduce("&", Map(function(x) with(data(), eval(x)), filters())) + }) + + + filter_log("calling filter item", verbose = verbose) + + # ui to show to select a new filter column + column_select_ui <- reactive(shiny::fillRow( + flex = c(NA, 1, NA), + height = "40px", + shiny::h4(style = 'margin-right: 8px;', + shiny::icon("grip-vertical", class = "sortableJS-handle")), + columnSelectInput( + ns("column_select"), + NULL, + data = data, + multiple = TRUE, + width = '100%'), + shiny::h4(style = 'float: right; margin: 8px 0px 0px 8px;', + shiny::actionLink( + ns('remove_filter_btn'), + NULL, + shiny::icon('times-circle'))))) + + # filter column-specific ui + column_filter_ui <- shiny::tagList( + shiny::h4( + shiny::icon("grip-vertical", class = "sortableJS-handle"), + shiny::uiOutput(ns("column_name"), inline = TRUE), + shiny::actionLink( + ns("column_select_edit_btn"), + NULL, + shiny::icon("edit")), + shiny::div(style = "display: inline-block; opacity: 0.3; font-style: italic;", + shiny::HTML(paste0( + shiny::span("("), + shiny::textOutput(ns("nrow"), inline = TRUE), + shiny::uiOutput(ns("filter_na_btn_ui"), inline = TRUE), + shiny::span(")")))), + shiny::actionLink(ns("remove_filter_btn"), NULL, + style = 'float: right;', + shiny::icon("times-circle")) + ), + shiny::uiOutput(ns("vector_filter_ui"))) + + ui <- shiny::eventReactive(module_return$column_name, ignoreNULL = FALSE, { + if (is.null(module_return$column_name)) column_select_ui() + else column_filter_ui + }) + + output$ui <- shiny::renderUI({ + filter_log("updating ui", verbose = verbose) + ui() + }) + + output$filter_na_btn_ui <- shiny::renderUI({ + if (nna() <= 0) return() + shiny::HTML(paste0( + shiny::span(", "), + shiny::actionLink(style = "text-decoration: none;", + ns("filter_na_btn"), + shiny::uiOutput(ns("nna_out"), inline = TRUE)))) + }) + + output$nna_out <- shiny::renderUI({ + shiny::span(class = if (filter_na()) "shinyDataFilterStrikeout" else c(), + shiny::HTML(paste0( + nna(), + shiny::tags$small( + style = "position: relative; bottom: 0.025em; left: 0.1em;", + "NA")))) + }) + + + output$vector_filter_ui <- shiny::renderUI({ + shiny_vector_filter_ui(vec(), ns("vector_filter")) + }) + + output$column_name <- shiny::renderUI({ + module_return$column_name + }) + + output$nrow <- shiny::renderText({ + out_log <- if (isTRUE(module_return$code())) filter_logical() else with(data(), eval(module_return$code())) & filter_logical() + sum(out_log, na.rm = TRUE) + }) + + filter_na <- shiny::reactive({ + if (is.null(input$filter_na_btn)) FALSE + else input$filter_na_btn %% 2 == 1 + }) + + x <- shiny::eventReactive(filter_na(), { filter_log("observing filter_na")}) + + nna <- shiny::reactive(sum(is.na(vec()))) + + vec <- shiny::reactive({ + if (is.null(module_return$column_name)) NULL + else data()[filter_logical(), module_return$column_name, drop = TRUE] + }) + + shiny::observeEvent(input$column_select, { + module_return$column_name <- input$column_select + }) + + shiny::observeEvent(input$column_select_edit_btn, { + module_return$column_name <- NULL + }) + + shiny::observeEvent(input$remove_filter_btn, { + module_return$remove <- TRUE + }) + + vector_module_srv <- shiny::reactive(shiny_vector_filter(vec(), "vec")) + + vector_module_return <- shiny::reactive({ + shiny::callModule( + vector_module_srv(), + "vector_filter", + x = vec, + filter_na = filter_na, + verbose = verbose) + }) + + module_return$code <- shiny::reactive({ + if (is.null(module_return$column_name)) return(TRUE) + + do.call(substitute, list( + vector_module_return()$code(), + list(.x = as.name(module_return$column_name)))) + }) + + module_return$filters <- shiny::reactive({ + Filter(Negate(isTRUE), + append(filters(), module_return$code())) + }) + + module_return + }) +} From 144ddbbb6f006466b9cb0d46435e81f1580f889e Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Mon, 7 Aug 2023 15:42:00 -0400 Subject: [PATCH 030/101] Add tests for new implementation --- tests/shinytest/shinytest_IDEAFilter/app.R | 30 +++++++++++ .../shinytest/shinytest_IDEAFilter_item/app.R | 27 ++++++++++ tests/testthat/test_IDEAFilter.R | 53 +++++++++++++++++++ tests/testthat/test_IDEAFilter_item.R | 49 +++++++++++++++++ 4 files changed, 159 insertions(+) create mode 100644 tests/shinytest/shinytest_IDEAFilter/app.R create mode 100644 tests/shinytest/shinytest_IDEAFilter_item/app.R create mode 100644 tests/testthat/test_IDEAFilter.R create mode 100644 tests/testthat/test_IDEAFilter_item.R diff --git a/tests/shinytest/shinytest_IDEAFilter/app.R b/tests/shinytest/shinytest_IDEAFilter/app.R new file mode 100644 index 0000000..d38af83 --- /dev/null +++ b/tests/shinytest/shinytest_IDEAFilter/app.R @@ -0,0 +1,30 @@ +ui <- fluidPage( + titlePanel("Filter Data Example"), + fluidRow( + column(8, + verbatimTextOutput("data_summary"), + verbatimTextOutput("data_filter_code")), + column(4, IDEAFilter::IDEAFilter_ui("data_filter")))) + +srv <- function(input, output, session) { + filtered_data <- IDEAFilter::IDEAFilter( + "data_filter", + data = airquality, + verbose = FALSE) + + output$data_filter_code <- renderPrint({ + cat(gsub("%>%", "%>% \n ", + gsub("\\s{2,}", " ", + paste0( + capture.output(attr(filtered_data(), "code")), + collapse = " ")) + )) + }) + + output$data_summary <- renderPrint({ + if (nrow(filtered_data())) show(filtered_data()) + else "No data available" + }) +} + +shinyApp(ui, srv) diff --git a/tests/shinytest/shinytest_IDEAFilter_item/app.R b/tests/shinytest/shinytest_IDEAFilter_item/app.R new file mode 100644 index 0000000..5fb04b9 --- /dev/null +++ b/tests/shinytest/shinytest_IDEAFilter_item/app.R @@ -0,0 +1,27 @@ +data <- mtcars +data[which((data * 0.987) %% 0.2 < 0.01, arr.ind = TRUE)] <- NA + +ui <- fluidPage( + mainPanel(verbatimTextOutput("data_display")), + sidebarPanel(IDEAFilter::IDEAFilter_item_ui("filter"))) + +srv <- function(input, output, session) { + filtered_data <- IDEAFilter::IDEAFilter_item( + "filter", + data = reactive(data)) + + filter_logical <- reactiveVal(TRUE) + observe({ + filter_exprs <- Filter( + Negate(isTRUE), + Map(function(fi) filtered_data$code(), filtered_data$filters())) + + filter_logical(if (!length(filter_exprs)) rep(TRUE,nrow(data)) else Reduce("&", Map(function(x) with(data, eval(x)), filter_exprs))) + }) + + output$data_display <- renderPrint({ + print(IDEAFilter:::`%||%`(subset(data, filter_logical()), data.frame())) + }) +} + +shinyApp(ui, srv) diff --git a/tests/testthat/test_IDEAFilter.R b/tests/testthat/test_IDEAFilter.R new file mode 100644 index 0000000..5bfd73d --- /dev/null +++ b/tests/testthat/test_IDEAFilter.R @@ -0,0 +1,53 @@ +context("test_shiny_data_filter") +skip_on_cran() + +app_path <- IDEAFilter:::shinytest_path("shinytest_IDEAFilter") +app <- shinytest2::AppDriver$new(app_path) + +app$set_inputs(`data_filter-add_filter_select` = "Wind") +app$wait_for_js('document.getElementById("data_filter-filter_1-remove_filter_btn")') +app$set_inputs(`data_filter-filter_1-remove_filter_btn` = "click") + +test_that("test that a new filter item has been added", { + expect_true(!"data_filter-filter_1-column_select" %in% lapply(app$get_values(), names)$input) +}) + + + +app$set_inputs(`data_filter-add_filter_select` = "Ozone") +app$wait_for_js('document.getElementById("data_filter-filter_2-vector_filter-param")') +app$set_inputs(`data_filter-filter_2-vector_filter-param` = c(30, 90)) + +test_that("test that a new filter item has been added", { + expect_equal( + app$get_value(output = "data_summary"), + renderPrint(subset(airquality, is.na(Ozone) | (Ozone >= 30 & Ozone <= 90)))()) +}) + + + +app$set_inputs(`data_filter-filter_2-filter_na_btn` = "click") + +test_that("test that a new filter item has been added", { + expect_equal( + app$get_value(output = "data_summary"), + renderPrint(subset(airquality, Ozone >= 30 & Ozone <= 90))()) +}) + + + + +app$set_inputs(`data_filter-add_filter_select` = "Wind") +app$wait_for_js('document.getElementById("data_filter-filter_3-vector_filter-param")') +app$set_inputs(`data_filter-filter_3-vector_filter-param` = c(5, 10)) + +test_that("test that nrow reactive value is accurate", { + expect_equal( + app$get_value(output = "data_summary"), + renderPrint(subset(airquality, + (Ozone >= 30 & Ozone <= 90) & + (is.na(Wind) | (Wind >= 5 & Wind <= 10)) + ))()) +}) + +app$stop() diff --git a/tests/testthat/test_IDEAFilter_item.R b/tests/testthat/test_IDEAFilter_item.R new file mode 100644 index 0000000..28c222a --- /dev/null +++ b/tests/testthat/test_IDEAFilter_item.R @@ -0,0 +1,49 @@ +context("test_shiny_data_filter_item") +skip_on_cran() + +# reflects data used in shinytest +data <- mtcars +data[which((data * 0.987) %% 0.2 < 0.01, arr.ind = TRUE)] <- NA + +app_path <- IDEAFilter:::shinytest_path("shinytest_IDEAFilter_item") +app <- shinytest2::AppDriver$new(app_path) + + +test_that("test that filter item initializes with column select", { + expect_true(!"filter-vector_filter-param" %in% lapply(app$get_values(), names)) +}) + + + +app$set_inputs(`filter-column_select` = "mpg") +app$wait_for_js('document.getElementById("filter-vector_filter-param")') +app$set_inputs(`filter-vector_filter-param` = c(20, 25)) + + + +test_that("test that nrow reactive value is accurate", { + expect_equal( + app$get_value(output = "filter-nrow"), + as.character(nrow(subset(data, is.na(mpg) | (mpg >= 20 & mpg <= 25))))) +}) + + + +app$set_inputs(`filter-filter_na_btn` = "click") + +test_that("test that filtering NAs works", { + expect_equal( + app$get_value(output = "filter-nrow"), + as.character(nrow(subset(data, mpg >= 20 & mpg <= 25)))) +}) + + + +app$set_inputs(`filter-column_select_edit_btn` = "click") + +test_that("test editing column removes vector filter", { + expect_true(!"filter-vector_filter-param" %in% lapply(app$get_values(), names)) +}) + + +app$stop() From 0574fbc0e2f5542da190bc7d98f17729ff7b0cb9 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Mon, 7 Aug 2023 15:48:13 -0400 Subject: [PATCH 031/101] Update example apps --- inst/examples/iris_app/adsl.xpt | Bin 114640 -> 0 bytes inst/examples/iris_app/app.R | 8 ++------ inst/examples/starwars_app/app.R | 8 ++------ 3 files changed, 4 insertions(+), 12 deletions(-) delete mode 100644 inst/examples/iris_app/adsl.xpt diff --git a/inst/examples/iris_app/adsl.xpt b/inst/examples/iris_app/adsl.xpt deleted file mode 100644 index 56e04ac80dab0d9bca3b48296a2c1eac654ccfb3..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 114640 zcmd6Q37i~PdFMDBfk3jdEnAW$+wBA6OLq5k&*gLa&6`VAH4>Wfp}>NLJVF9nGLnoj zIp|!FEP>sQ@XJ*w$0 zek;4@Re#-8^}YJ{cfRkvH#gn1)4MCXr>A!AwpZd`Ja2Y4ckijpg`Zu7f7PD9>zIo;5bNGvPNGe`+H;rDdc&elFrcxRDfuW(HCl8&mxO9u%GjA)4$L_uJ{>uEF%ZH8~+<$QS$Xeji+5Atx zr|;L*I$oYM^aHmn-ePtTFSi^z`22g9D~tC&`?<^ej;+m<-m`<3Co8>B>v(zW&|`#^ zEGG6JK2kY$fcWD_rZ<&V@1a`@hRDmA@LW~=wo59R#@N-xwpUN#OrzPTIf z%q}0@cjVwb#||DoR5`rAvg@wBhYk^M%_Dc~-O{bzOR4hyBBd8})y$kAh!=@;H}_~^YymMg~&2an1<12RU_t{r+JF655g zKe_DPdig>vczH7MG9B^~@9oLTTD;s_hzI>Lc==)C#oj_bfxY+0UKQx}kLL0__uhXr z{iDTWsOV+nt-k*Wr59?!%a1f~owcNPE6o=?hj2Q0*ZmcH_~>%w^1VkZ_dv&FvZD7M z>fq()3h|&{1~30*>XyXrT%4{<-Fx@FchQr1!Sd-bqnGL6<>g8*)Pk1{%~}2_R+`UQ z*2|t&tM}3`%lltedZE_om&XmANxV37r1r?MbUNm!qW9|H<@HK0)Z)3E1zt$+!ZwDy zbmb;aI?|)C}gJ^|Ghc>b>;K^8PDIFVs3-&K=q`y)?HlKUJwrA3Jd9;J$;$?$?X2(dxbQYx4dN zm0qaDbJ@JuoSAV!*y7&(%f!g8!}qYtBkykJuD#FEJ9W2uFa1Q`|C7=SwcusT{L&Kh zGJoh8Idj{W4sT~`v?fz}uMS?mru0HBcsXx+2G3=B|Nevf_U=3FC!_c3;N|N|FVupU zty4RbUE}m*rVihI&t1#MmX92DUd(OF%g?Kf_j)*buMS?mq4Yv6c-iK7sg2IW8NAd+ zdoZK->fq&@N-xxcm-8Jj!;MT{h8x9s`R77B=$FCE1$KUMYUjdCY!BXvfK>u&d+_MK z!xZNqq9EG`vN!8f$hAlRqL(k!f|m>J;_l`&{a%85-&wiSF>tujoDOc@W`mFPUP_kt z|ElytEqJNer8(#q|2&rO%;!Mwocmn9Rfq@uGVIYsCYd)**O|RXm+v}wXt_d!%H_{{ z&b4AL9KP=P12U3tlcG{jzg`qF9Y#cOE*r ze9V~v67psGJ?p)+?H$9Oaeg5l^vmGosT4F4JL$Ml*|-y*p?$@!-uqavZVLY=Y{uYY*%`r7SH91TjwcbS8HQ*>%pT3kM+pat$|Uk5D)rg z_gpp(UAcQ^amg-C`JC$R<^9V?mJd--uy}0mkz6GjWSB-0D-&Lllc^e6z+<vy!=1d@Pr0<$r7ZUJe%GLBH%U+B$TN zow77M=Ef%W9=dbykvk8*h_brG5aq}Ya&E{y4()u<>SdIK_h&p`>4jRy%UMI$+Ns^s z&BZCZn-m-M-6eH99*y2D-RixRiuY&yqS6bsz^Ixei_=RxmnyEUEFC^ZdDYYUr}xq? z3oma_dXYA3Ja4DL7-Z_R(;UB?a?a|m`FJO#(W|xXWAvhS#J%X4{-><|zU5~hR^GYI zqG>03eP$EbV4M6lf8BgY&q}xEX1u>)bc8Y~8}Me&baVIOZF4jZlHw)(M!!5WH@~>6 z=_2c$yDM>XX?|g+`{Ew{M+auhmIvwIL&GE6Z>U$ztK$>&@1z;s&;N|v($4-a-`iaE zDARAcu{Laz$1`oXT5D{lr&S$pa{$^{iq>2O``Tw0sKnEh_-&u2M;b@nsf3D=@vBUf zhU>NJaJ>YSq90qjZcMQLGSVb7k5xd3?FbYq={p3R#aWDg!U zyBMt#%~QC)ZT=rVFfo7o0Hd_yyG$cQhPPM8w^!+hr2jyhNTak%t`%Lz2TgnH^lp;! z>0754XtW^w*Szxu6m>6GreEMjncTnLD2)?J<3Q>5y@w9pjc{X*ylT!QXVHudxAgkV z#`~F5n{46Md;mQ#$s=|8*RZ2+0(}Swf!&CrfpbrMk#c@YLhO z_aWV%MKhy#n7ux;$?g0ln=EsyzgazZ>e@-Bn;qN?m4T9zCHj$Ws9oo~}qmg)^csZoL~CBMa-+J*bj`ww$7Wa3BNPy2u!MLx)g zySaXpX4aCW^R_r0r*`Qf+~3^fhz~y0d;ome`9A=k75;obQ2H3tfC$;3V9c9oqzIiB z)qfsw>2onzlK3^#E;Yt#)y7yEcIornLmT}idVd}_U4P6iAl)=h-ECI!rjW+VM=8@T zy@t^_Zl<=lgX7H>ZfR#e!UyI`yl0dmsA)okG~V!b3NrjZ(CXWV11;FRL#`De+ch}5 zG(jj$2ufKREQ_XEtJh~XLH&5ym#1;=9_Y z!L2f(C{10o%5?QaN|dEd&|xqMsB zP~X$eJq~A0;dJ?i8A+9M8zs@b{U{X5`gY4)!LCH@>5FR2G8k@t{}Y6+$B z?KJZ0|M_c4pNpY%Hl9kREK$5v%ZQiyk7^@Cgf_-+L{Tz{dq@=3j$MJLA`$ZXHD11t zM}e(FY1M z#ZbaI*&44gTB|iiyX;c`D8+DTZM>6NH%OWcnHfZlQ*Yk@dW4>>-^a^GNj&k*k1`9~84o;>KjkQiJSLqm&HM zFEFPzxrtlNwwi>0*~jfDs)Y;`W0`hoTgnsH+{10)qxp4tvU3lE&kEBYVp)n?Oamh0 zDNliDr16GR$h9>d`aC#U8X=80Qbx8leh2r^Cby#Z@8hQHkAbN5ks->LCDC}BPPl(x z5LtR1Yuu{24rusDbn>I%b02?O@_4Uh8c>?ZK#70~VyHGs$YB;jNkf%PSsEwrVO+e2 zAWH3D<3*Z#_$qpT2>>!P{FE9~4?Y0;IOt{gc%t#r-h=vhdw_=5c+)=%ei|`<0K4Qf zMESXg&=XgU7ePRaX}n(E13ThwaEbmOC`$1+xYsuRS8kiTfQFBkHk@KYnX;rP@nhHA zgXZxJ?2p%Y)6WGzGTsG^_qR-AS#p7G+Q)OQdCEKYQEmJkKCci;y=94D8t=AC1IRs` zU`}lWw7mB)%H*M`)+8U8S-fAr_mCge3Q85+LB^MKdXS}6ra|L% zdEz8rl*bE@^WH;*D#t=7^~#CYCWdSD>XN1YQIZif8~r+ZFY%JflD+I9&_%}9kJ6fU zX=_TBUJI|m+}z^(ds{Mt*vLGUzYV*z12xEm5((1S_Th9?i`+xt_xWo{p9|TgUMLM$ z>os}-rL0^+7LB_{e|mjpBaGMB_+I|H#!Gsxw)uHH6E~+KH%i`|**!niq*+?YG!76( zHY>Qsnka37CobblD>%y-$Wrqp-rM;qADDAu2h$fIOZaK2EOm^i6G}9G8``B+xt8>~ z7)m|jC6c5Xy-JX!=pJU-M(;%LuSXA5mZm;i0X+u26j^ekfP2iDti$T!mIon07^B!t4-d-tvLcFd>-%O zXM>Kxw~X9_H$(FacAm_Vvrut!F=|$*h+zKKX^lsF$r9H+Yz9gqOK<0Q$5n>?lb!!8 z_>oKnP`Z?9K*Tu^Z5;*LXu9rUg}**z6F`64{L-A=-MpGQzirFwOkhL^hIrT#Tu{7c+J8~*{GhIk2D*=5iE8tAzi?{sTh zduTkMbROSmNIY?kYIies$9?W$3gNa{U|$1OlkrRVR3Jjx)?mbsY2^2X`3PT+Bz+zn zO0}_Cz1FSq`j@5TLGGblKsr_9B`-@F)ml8m^?TwyP{R1qIVm6S;TGS}NQOv2ooS*TcuF4>xM`>at7yqZHxs z+vwl%RMaj>hREk0`p${3iBdZE@HWVbj-Yr?d{#!(FA01+sjMMHC_Pk7RU5M`(I{XT z>3Wo;&&5#c;p0)bRHIiJD7~4{vC&6>k{CyorKug0pd&Gp;p6qM@g$G8t;Kf|jrV%I zGc%AG1E*og8maVJa7OIG$ ziEQAIGxy=20nEARRh>dZ>gFtd?hlEN_g>uHsE_w`yti{N;{$W?qbzKUQVfrp5plAV z9#JPjN>?R&S(57OfmI;aN9lJmTE_TNi~z~T_i^tvy798KaS~6ZL?6$|5}|})arGYF z#vmNW+v`CD3mR3Y1b$z0Qmz%Z_+Z!Ep2hho z7wggVGnziR)2$bRf4dIcf0S0o*n7xViucO4)<^4vQW@FSxWSy-`0u#Y5p{kO{P{j) zThnz9Z)8vVq?u%yIpDLc%{|}~WqCu8r7M{RL`J$ZM9zB%B3&;_(&u7!NlZdkR9hb> zl*YT~T=egWM^eonzYx8Lc^Wba^u8TK7RAf~vi19TYv#l+gvOH$(VN*Goit0ZOa93k z)M=GJ?lB2Qd%4_PA-Su{M?HAXJ9YBG5ie_dmIJy%ABh(sj6SUEUoE@Z)4rIUwk~x<2}uppL)ZO)y|?$!<^4DCbc!TQ1=><Pd}i^;~WHpBb|zN?UL*K}jpU z;zt;z<_bQwqkqB&=EGZ@f`lg?<3nh-tQsO3Q4h4BM=3#{i=lKD7|D{Q#_&XqUS-5f z|G;;(F|4Aw3QTw(@0ArM^k0FTZlZDBm>f|AZ(8W)sS!Iz!B6#R&X4!iVarU51L zx;ryO6xF6?ncXATl0Fy9iJys+Gf`@g&TW)YCmz3u?`o54xy|+QX24vD8gHW$n!1kF zYCT>JcFE@+<^?6G3xkgrdg3&C9%wh%D)K18>XcRVMf+S#mU{Sjjm9vc)SYeZKSLBl z&)ek1KnX!^J14Gryb1KIyB=>~bq|-b4%1OU^&XxJ&E~aK^Go3K>G05j(kjzfmME$X zM=5|3)rn{Mc+%%WC~4X^Tb3GxQgIUC7UGG&3-8RbGe0zA^AvwbQSB4?z>Go0pz+?oG-$kZ{u?xMD#Gd%)p!xc zrw5ZEa*oURuzQVFhbOAlplWgevUE51(8ixY?{{(2mZc4+KwkpA3{QLy=N_)X4TjRA zfJ*fmZ|b$+XCCN5mTqMl5TQ!1KyH}kDpta%_5s|=#(%*F#q3g^k4N^fN*a$|W3Je% zp5?P;(ZI`Eo;Z9a8^4mjp6laH;%a@!Qm;H7;HTfxvXU#FbuQ*2rs5>2o2CmzyDSD2 zdc?ueFya8)`Eh2X`G46iVXQXV$}~cRoVoOBHcTUO3Z)hF#YWJc#Zb!g#2rc#gwlkd zl%?IWXy9cnjrU>xnvMRBTO;F0dakzl+1Atb9&+O)avnG*ej(#g7g<`tosHxkG*@q@ z9>X7KUJ>5ItC$9jN14@5S#lYoAckt!iGPdFi+3(ARhD*EW_HH$&fB)%vP(1Kl}db= zb_<|YTxSm7b=Tqhw$n}^xiv(DQmsleW2zJ{4c;z2%ADHxSJC^Aantpu%&1nXCeK06 zN9>Yjh;DSEM6;h;V9CzCjStLu?1^LTl<1F`29)S&1^ygp6X}tQRk@b*xtLwbiC{b_h#ijTL4HQrh9tp%kO+|OJKlzbj<63(W% z19l6t^qc%;Ad;T<2O8B71<3hqlk~Ze#?z3XD_(LaQPm{9N{}U4Ur5)OQ*D4})c$KC z9G792MB|;umZ-DRODm8!;Qn^*8GK+aW66`bfd9rcM#R~mV19+tQa;|KTq}7JAN0tH z&tE%TSvY*GlF(|m_?Md#cPLT3M6VKLDPCnxZTxL+wbIz<@qUBJL;Y*K9@$p-c;}`x z-n$=hLR8h2b-edH57{@HgQ!-j0)R+06&oo^;TjNLd#-1eSx>t}>kyH`D+49C*f!qH zaHv3gl&+lwdNI)ImZknPL?TOQ-nevq$KD5}+;OP0o?n3iV7l;Ss&16}_VHXjKS#AG zS$crqoisIg3HosC>`Q^trHZMW8S}rH29!wibfHAvc|h~ml0Fyn9?r(2$wX;nyf!>S zGd7)%H_)hd2kP)_^lRw-!(hTBF+V0dayjUIj{@d;;xg;PY)+x1b>f|4wN24@GVa8( zwBzf{BcbFTZbs9Sn()DkMMcLyoZx`K$$3w(ae~!GJL%F627aA5iP3P^%`%- zB!6C_ENQ%S4(m3p^iqvC#@Lo*|3Itka)f zpV_F&U$YUS+uUqxsqqrqrL*h&Pf&W0QK)v!*qr|i^V|Fc%h*Y-6PGpq2ocT@h5j65 ziELFEFRk(=hP2Pc?9wKjoP|=oPPMJ|GGr;ajqhrc|HiFpfC)3tkE}8EkI?yM3iNL8 zVPHO)1om-W^LYKEBtG5+EIpdXQ;iqn*P_w3o%sg% zyq3Q$wXLsb8ssKDhgOjbwV=0g(&s|5q$g*g)S#6F=v9J`7rhK9MZd^xv%-zfiJQCR zeXcB>t|y)w)w1_MtG;hRoGR5RI=-Zo9 z+d3)Nijbu(EPcoBY^Hu`<;sez+Q>*L`mOuY|J$&`qa%RP`R$vPWimtMo{44G@7+5D58{~P|G z`Bml*qkz#{m_{gJZHK^90F82c!Dxopp3#?atwK8}AUzH?=$o`XcD-_r!BG9+f@t_|nEyRQm`rLw+vc2HfAyJPG`awzx&S^b$S> zA~a(&?LCk?k)CBsYO}1Fd5{ z@rUJFvYvP`l+MJ-nHrDg)zYeKU9vQQx(7IQHa^97H&=rRGsm|4fM4N8MmWkqNi|+d zmUNE#&B#c!HQpBRc|P)ckfpaWjb+KnO^~w#jUwH!?m<2A_)$KunD@|2mWFBnrD2Mf z2Cwnn&79i!v*-}L%5UcUDrC~Zt-h~CDx9WrBb|FiJk?l=s7Wac1H zf_yO|T-X$P&=8$q%6SH=qY*hh&J(d=BUl z=w--~tH&enA?@SoT9dmvyocF$fS)TvSz2Y9%2Fsdppg~~W$6L*MeC-Dp|lYvXKK7L z+B0U%2@?H3P#-Tr+R`RJ%6B){feAAQy>B<{0lja#lrKwy(pKELV`famdhmogz;@;b z!O!(T51u$&9zuk?ZjzgHyu@>wQe(9(+{y1|RLIBcB})^u|I!3SwF5^f`den%#xv;s zv(N(*w?N+pLjNm*_Vyl}EV1bmb0KIXwka~1FH98|Ko5Z`8$qCemdq4CJ23%qX7 zMpL61?Yak~nTpAhsNO7DqGhV7I;C5d`uD_TuLm28EU7)v4ACWzIZf ztG>St-it{fOMVo5>e=9D`a$JC0IJJ~MD z3OA>i#&YA*;$0e#XaRD5g_~qMpI1zlHt;#!Yx7f7OGAL}1&x;#|76i{xi#V?iR@HI zYqnL-)wciYlpZMYh-RNsuWpbluUYk zyf?C@J834N`I@J|mz}#C{DgH6F_>1ALQerG(fDl;LwUrd&&5#68((s=G)i`9RP0ig z++@+vuQg;T8so3o=)35>prq$&n?JsEy19q7WXYuCB^|lY>Xa35V&^4dNUgkvd5nYz zMgfD^h>>&a5QU!js$5I@Tnwci8gIBp)hTZOrGd**bc|WHagE#D9p_4nYGr)sJl0`4 zul4~vN!?Z0|NiGDz-Oug`7Wk0N^Y)F7fQ6wSCHHD*OERLL#cXFo=v9JUio|<} z_oDXz4UZ`JTjqKXlE+Ku#C6Y@YuMv%$4hg+4?efBMwFEVP@4g{q00Sq9*^?mv~FuC zOAn)CR{C7X$IG3uNg9t9UURQ5SsFm@;bqLSjWMufu0apf4o!V&g$d?X(AS?K>fwna z_pl`;OPa@%k#ldC=3fbZHnZ<1Rg*2I0VT?bcg9PU+Y4=#_v&NVtHo z70`EcGgP81ou87W_u_tCdq3|u8~mILOyP-tfN6{f$xT=<1R6ONp^w+XwYAU1WN8CV z&O)h9yWP{P3#9>g;)uU>~7JE6+Mv6^kY zj5VHAr(jkO$Gkl-$eTAw-08mVpdU)bUJ&2E&6~SiFz{?s@ zZTxZmnoaKG*2sJ%Jy%;ZgQHSVLhd1*$5UDA%!x;ELYtp=i6dPt>RrqnP$Ik3mB%A5 zIrJV@(HHIWz~ZI)_&BYPCsAz{B3U%>vIa`gOZaOxp5)d5G(FX~`Bjsrn|tUXOF-!? zL_p%>J=_96*P->bt#dyG`j)_Zh<<`;gc8@|b?l%(@e<8x3goLD)z0yG#ZcPF=VWGE z8zfBhD#H^$!gsaN+qqSH1XkLAHGV2Zmf(q}*XGyR&r;i}4zQhlF8I8N?UKxX#%Kmm zO0Sc`^5u3Y3FOPiOR}3$F;Bb~O0))Y!>xhr>{6E8WYP2)_xj8xui&rQg&WZOyjf;t zj;Om7(H@hYv8gpgb1XB*{qH|QHpram6rQY|lKd?5PKb~VqReVK_u$f?*?VkCp9}53 zlv~?M_pMSMk6vR{0%|1dsb|qn3#AxSUTlmpS^b^qx!UU9E$f%1+^Cj4aW^vt&s{X0 zW{7Iwpm_&cI}5vHu40c+Wz2}}Wd)!zpkL&4*pqdk(MO@@H-rTP;gXWST z_aLi2F-mU!Qjl5Ak}ofpqDP9Y%8?f@Ih01IwsnMRTL&*o@a?SZh-!WeD0Tid2ps#^ zGbUG-NZ)Z(yAhT~WJ#miQE=j)?98tNrD}^?c;d(S7_vmMQKu}q0gZsxT;Z?NKI-4# zgJPbz1a4WfRHJo>=v4wr2{JA=c?xrE@D|+&{+2jas~YcYZ zXJjte64<35VNM}8WP<{)8#F>GkS||>oIsrxTJ=3QC+_Uw1g)Lo<^nod8mz{{Xta$H zM(XP7s_~|-I>k?*|B;J)Ph2uY>3TfB>N`u=0i7sm?GwR|comSP*C|Tmb<_NcAcBQ_ zQ6**QiBIy^NtWKr2gPJbe#Tj{G)y~m)2j=m{ynPqSS*i3}0)0V+$~a{+1IdZ_VM`4W_SK%a}nOFit; zFm3%zuM$v-|DIX4$uzg-8R&tDV72X57zQKxy>1_G5OV?9F8RGpd40U&B13ZDHcI=M z!RGHkBSMx?Q^<1TyoWB0m!8Gx?UKw^EhbAnQ5q(cD33RA?;&~+D8&g-`XEs1{F|R4 z8U#w@;#JHAj0?r7jFQf)?L^5S?`Y=OZgzJwmAU9wkygbC&b(7RUz9T-aIAw$$zfsD9F<2V~l zG9%5;fgi}y$M_9oiSl^C=sC0?S@wYDrddbeFV z-E3=*cqwZX@Kx+-A2$*g`QQKiH^HZ5(1FtDnWlEByS6o5mF!1Bq|e1r+K2~{rSa+w zT1lW$MpPU972nmyuur+Ga@-2$)<2@&Gxy-^(mDLQ(6#w>wWzCGd}B2ScIpm(Z)Wi; zVw9r)#WY6A?OWElKAv04HSj1r;?n0r8n0KpR3D?Aea5H)xx+5?ukjLi+BOmI;b!je zkeP*bwr653h5Q}o`nF3N)t-YpOH`{B$P+-r=ka!o0HsZ^VvJJqL`8|T8%4E&4T4>A z#a`{z1^kG*^tn(TuXze=X37$+VpvxnFNkXUN6D`ig<7JfBtX=A@a=9ew|-g5wM&Z9 zMJgTa<7uVW9fHy-?r(Qs?qc&(OqZ3aFXRs)OXMj8mHSz==A>Lp`rcziy?d=mP0nPZ zMDv&GZvIk-EcIWVB5U~A=#$L4c@27?=-3Mp&X$-V(mbA2tBUua8c%m`g!vq@H~%*H zd=|?Ra^kYuHX*_l$f4W-rSvMH-g}6?$k!@nmwI>)4a$krs|1wdm^roa_t5(faN}pj z*r$94bPIYP-b3y_7gB+|nWaPR(l4_Qcc8lhS#lwlu#1OLz!(uZ5TV$pQd6^QW0VMyu#S~zWUDAcl!a3AXMA2Ul=6H$ zMu|o)oR8;F8mwKqlsUEWEP9W(LuMKpW$JZb2R%2c?cWoZZ0kn$S9BFaMQH+jcr7&x z)n|lHc;e?WkC3Hw1ncE1%;Vj|U#D#A0v{C9cpGqXmMqoBX@~A{8cy#(X#jSq&UdvD zU}&y@3AIa87p*d(|GJ0#cu7#Y04Pa@NVBa_$U{E&U_}GV96@;Ee)colrH*;EOiRhq zB>HHhCLa_-DNmMYJeblB?lo2&OUqLKD8T`z{P1JJ@h%OY!gU*Zf{)AJntbt-;T(qzn;fThns^G4w+@5cU!d_!uYJ#*8)p z9CV=cDW(A>+RH3JglL2k)w_oA(kl99lNKKovrBp21MM$er5zOLHRhJ}8V~H!0A=aP z%yI50pheHt@8jjhODs#YlEAqsAMZo#OB_&?wD8wX{Qxs!7U5L@rF0%IOO`^v&&Nya z$`GB22hk-<4kfBUrdJ6lMW5lj+USqbd-_TJC4{}cRN%91B@E-*3& zL`G7GFwM>43~KZ|;?n108ZU1YkWnJM#1DWwpcKZ21sRqe|kB4CuLWIIsvP(hj9grit6xb?%t#$4F+(YBlXl;Ia zm4H$*43u%C9(uoz8``}Q@rXSio^Sp-M17B3&`>R}H7N?eW8~r{mar3EmZpCcd`_|~$v*1; z#x&M$r1ZiF7P3Sl79i&lmp&J($6LVz%0h|8Eoi+5%87S);{BuKeY`*5yX)|YdJj|A zPBOj3)pdE~Vo#;{FO0{@4wSCwuuF4)3x2|}TFK`#N>1Yi{+!anij}sH_Z9THh{n?g zl#LQawKa-r2aghdn>PAM^!_Q_P#zDmG_`_cgh9%yl&Dth(iZ48u}iv3mh5Hbwbb=f z;Pa*66B-XZ5+d*((xZSxOKU-Imqgna^Td0255sjrsa^(3@!Pn&R@&TA!2URL2^4-JTX|yh*uM{4PEymLWoBH#1%u z9wCi4A{sBt>&~Kqmo+@`_!>mF{z)yjx!C0>%X0R*LwGCBv0tTm~q*qJIb zVrngJff6E3AVTp{kPTv*o4*w1#8>%L%88@T#k>bOIaA|}Q9a&RDY*yaz-;t2X5DN@ z54>G^?J3ZAgI>ajx_S?rq45MI)p(l6dl>h(=EuQLf}8|29)>P~Qd+x#=2Cesv06P>+x+#!2jJr&s;$7A zlaUL}iR*48tKh_5|7t!kuYj)sS$Y}MfCyFdr)!7^B67xq7|P3~^tqTUt$>kClxXkg zVYm15;8B7#wzA)(`4E`s{A&rT%l`(TDl2Hr~Rm(RgW8 zda@B2NmHs_;%feMyrgz%fw4QF!KAeayUlg1@g9Q4dk-@Ul&C^7utA`atqNsnMfw(F z^stzZCv0Y+RIiOv#8iqb{Q|RWlUZ&J(#z;Z@VCsdT9Ku+kGF!G8(HDTYpMBP#*03@E*Zc~_J=GDMum%g%|T&xKG@1DUDu8dQPY=(bD!XNY2q(fS%97-Aa9M()At z4hntSr5-4unm@hr+6q5-;sc(a|NYO1_i#-hOYvhAB|?NoDbhY3qm)|V<^fz=`&`T} z_0o6^TH&VQ96b7epx#4#AG2(eF>cLop$8f-*~>o!`cBYG%!zM;KOh=!MfkV@zZQ>@ z?q!y$^g7I6R=X5xH=>bUB1IV3Dt|5Mb0Jw$q0W>g%01LI_b^zLZsQ)>_!Zpd?sku_ zWvpU&x}Nx&vb2%$(3RI--vU1}R;v!MovVU=@qYdX?_q{%K#5l6==8+hjOakVe11Jf ztXNEzdU)b>%01AlOO^(p@lfGq<0o-XwFfFoQ(Kul)PJ3LZoH&ob+x!UHhCw{uJl#3EM4?Mn<-i<_2nh}k65}eqX2KXES9kTS_m zu2P`gh(;POJtNxJ$x5FWmu|6pDofM5llg__(zLCZJ(a~>I~Nvr?q0m-@S&rJk5ugP zzJo^(9zH}#;f-J`y!%_AFL9G$mj>X8!^cb4wkk^MiGz(HJNMJzCsjiP2!Rsiztf|D zEK6a9ziM@xpva?`T{;^NqDz*X?V~MY=r!iH*__DIZdo*3ZY_=XVg8y;?ndwNR!{Y9 ziDR{-@%E4*F}>FlUj-|6?tk-vxsW|^Sx@|}Oan@^8%dB2f-DhG0j(`d=<{G?iBY0T zuPVh$4yA$mco8&+jV?m(&&Sj7vb6UU=tx175!K3wx=G8@8&0@?CpAN)(}wI63Ioj~ ze~wvZJG}Qm!xm$mGh^HkdwPAmUFf5Yp27!(WU0A=lQU(BeiK!<|I*-5YVlod3>b72 zP*Jj%J;a}vS?B zVwbLrS(tzlGRBHhcTSw<2Zkf+tGK52xe!VkxMj)`6?)Mo-CZd4?>!_?aXSCN+$m2* zG@LzWGZXsX=b}eci}mp~wfIhwd(ahb#zFPfS@W+4Kax*kloCKlD6yvyW`jWMh?iFQ z5;QaB<$O>`ek2WuuJ`Gy!dlK zDUnJq@$pQ|`scVEy$esJ{5;;-9HHrqOjZkt+a&(RY zl6+AHHf!WU`dkPl4T-Z*BBMkqk1|9ZDD|)LqW5qQZS*hb{Tw%bj{4L;%llch>zAb- z8V~VO1$Ig59^NK0q#2@9xWAo2b(Xmz^d8>IA2LdARq6l{(CR6_&uh=1Znp5CZTxOND29@_F)AI)HLeuALcJbU*Hc_Zn|^ga;Ily%br3*I?rp^4&G}ZKT4=ZvGzVWqJ>grEM*~Q%4Pv&IQDWLv~(r4`+qB zhs`+C*(JB?dw__SuV9qjYrOb=KChT8;a=T&Jjy)`(@NF!D#6E#KEj;Z*l=r5+Q!G> zA5&_)#5wVEU};2_G+t^#^XfphoxT-(hB@&FwhD+){yT_`K%?rfAWyCifc80VPDPcS zGnMI?nfa;alyf-sU%YqU^D2k;S7`OvgZuXGyT3mHABS2;E(Bh_Hz#(PjV0N9z>RO6+@j@y8>qH z4C*vYC`+=@7lPP`Xoz$}jkhY-l0Fyn#D$S8yHuy~C3=;BlI$gJlV4}n%}daO z&cFHVwhmzA0=b8?T71)v+{4wNdLM7*hxl9OdSHs&1F9c^2qjko?FL$h_wX=Zf^rWZ z=YwK)=^UJ#jS{Uj$-xolE(I!_O;@ECXNW@NJWA5%LMZj} z#OuSP@rFg?1+p}N+{1rz4{iK@^j>RQHQRdGHK0e_^f4E3O_a95w-!%acTkXeJfFv# zdj|Lk_qmY$t07BdhB`fQm&XetU5}FVxfn{KE;BVAja<}A8M%mmihFHixZvugdLQp8 z6+D$0Zu&qe-^X(^Hc8{1*Wz1r#7i+_*YGIKTn&C2VIJ=&&g6KBX7qQWM0;$8^{&lH z{yNPv`z1aoHh*aaCugEmCzR@?#7n=zchz<3)h>aR_TT>3d&oygM*%r=r~5DIdg2S< z!J{<$8YY;FTHL}De+3_tEb%B{M>Rhxkb@e%wk*N;7LujhRo}@jHE0ucdciIQ8n6F6 zUi7EjLmQpqR_AYfS=s=4{z?L;>*M94XUH{tO?O*+AnZ@Xp~qP)(#A~S?dzhc*N8OhnJbnWevfAjQOoJ?u(hKTXL31lPY0{@s@z;ufoX;zy@$}?O zS>oX(N{n~NQvWDP_TI+O8s;KqoHPxr_SDN)nP7590sF3P)f%F6IAf=E;=00(u2kIu zUv|gW_@IfT-vPEu@mrV%MAD-aOmk~`g+AUra;^A}ajhbhTgdZ#MZZe?2!tw1}&fq47kPHp6?6+=I%}3^bemgzXM6q6>2(UfRyg5hCP< zQ*CRY-9YQ`@mA3n?Q{R%yT5PFd>TF2&=_vW;KNt&aA2??K0E`$nlp zyd>TOo}HkivUJ@Rr`aCzD9z&cZ!TrYlbukn?Gu5_-0NSy~gN^qO9;Z{fbO*0D!v{@YA% zewif?8ZYYb#Jff=$W{e0lpm{&pydmp)Kiv5scLf6sk=dIya=<2t?VvrJ_a;8|CT$x z#CbePV~Q+&hz-vHBR-z@#OE-CVzxp*B3^nevkO_GI`N=F614PA!ya+zb1{v#36Cbz zE{zdNv;uOcEcNd_$htl@`T*bEpa79}$pSO>icf=n3*MI^OUQ|z!xl)r2d#Uk;l6$p zeC}!BXA^rjs1uj!X+i|m#%a4m!4lc3Kntn^V52YbwF=3SGLnsw1E>t|LH13y$uFb# zAI4MZ{QG^V=1-4Ys9jQ&R>6^-U*-d|4Vc2m`y$g=Zk#_C*dU_0#NPI>lG4kP^tq5M z^|VVg%dASX%vhGP{JAU|`n86S7r%+WW|RMl-hV>RO1J%IhqfFB(r*xanLU zZywoBBOW183N;>OYPwLO6+uH;T1DTq&xKIRt8HcPVVt~&aq%9q5XqwHbMEz-jSuqI zY@0*`pg92}@8jq%H(vZ4nyn*KNVz>)7 z{uAcdT#O!=Y4(7RPrd3S=zT}Ey-}h(o)qT@N}3_k>XZ%O%g#O?{9MZ@$x782XNJb3 zd|IdX;Iv?f(mir5>2o2wq-8RhDAB4Mlx{7_+XGp9h0L0^A{ zC>JGNn?F5Ps~T^@g-b!aG`A1@$hrgY@v2NClw5i!HI}5bl*ZeIzSsx~q8Lg&e7xES zZNM}_OLI6kFOa4FquK<$_H!;!LeP$vmM8I4`i_^9++DIH+gi~$m3N$5!ILyvj|U)z ztbGLh%mwk1te{4Skf%U4C>T8lExi(aQ)ManMZQ)cl=9YlaCWISI_h2}pcEnJV55IP z?+?k-(XrZ14bb5LmtmJEL4=WuEi5%1c1dSHuYxaYQKw;Uz_%ew&*KjvH?{2!W&KAq z9=Ql<>P*|{+k9RjlzM7B@*ZmCcn^QhoZ93y+~(%-L`#&R@g$Fz-U(IXrE48@r14tJ z9*qe-oe$KThL87IrZFPU2BmWk@WcbZPtVmp7xVEpfRRkQL{4~(c2MZlcms%P@jJ9J z+y))1^=o>KNi~Q>xh0~M&JgJ=vl{0h_Is4(euAHpkzE8KOWwyLyF@5;$r8m&VNQG% z4_f~%otqA){*(3dqH&2;XrKqgz2B}+0Js1QoM@_56v_cOgpkfr1a+-sYB61`WH zq$Vnc1Ja-wZ)q1>L@F~2On*JN`b3NxCBq#nora|Lnja*RGWRNxT z*OERD4yDmXZFp3CysRiSi^i@eu4b}JmImO7 z!tK1W_h@O>^ZPmI52a+FASMOm0RFBdQiN4QnF+*&ZI`)hS5h0Y= zI}h{Z%}Mk{`&a++Ey}D59U*pL*rd9=^1~UFzR1fVXPU}Qhg~9+Xy#dvkI=x>#>in7(|E#2 zCQ6iTt!HFg2Vj@(;vU*~6MFw{Zib9jP1f-Qz7Ok(pU1kbE}pp7J?ueNwe3Cp8#CDa z1fz5kRg=$R8Z;i|9y&)ZNS0DQ-YWX2eJ&O+;W=e%JlegnPP;dDW{3u0mqwUnD|?!m zSD^>$iQ5ZKFrnn?6gTJM!Yxj@(VhsL6W0;--Ap~+yaRmMnLh?U;VOpFWlUp~+)BDZ zo&oaZCYlA_!>U{>LWEpQb>=6n@or-p%aTJWJ-!4V zFU%0F@YgB7jy@N&OQ&#hmR)MlvTO9}LTLbY>CJps8v`xfRoJf)W^- zQLQ#n4aaH+fYN_(4{dx7w`MChL&l(;I(!G{Q+U7rJYIghBpIS@xPy2PniH33+M_i8 zO7L^`qby`V=^vQ}L|j6sZG%7~?;%8K7w%-^&3sTumU43sZp4K4jG-4$%JRCiXy9cn zPy8|bHLDfK|3lA8w`K+%*e#3=3fcRnUW zC>1o8t?_~}Cy%)Fd0?_sYtUG2!xa*xWoZCDp30JpoMZUL+oh>bt@0BnwQ3R>qRs3t zXl?78;oF%>=lDH%+&|fQFsLi7K$gC(D3J}ylBJGyTOZ)B)4W<_nv2O&o+nPSL@QXi zR~JeH(0CtZmTmOg+-gmLdg4BcpAPsWqdai@=+R?C!Sun^(_p;Ni)Ls=^>vXn%xh6Dr~Q0 z_r__a5h7eQ8Sa)qG|slBG~OzIo$M0&TnMFHPn=|lQsVAa0!p&_n2ndD_vnG4iMHt=%Mlaj7>(Q8zrg}5AD)DxTdb$I54|Z z8=I)n3n*oI-B~p7vW6!vbJJ~tEPn1v)swi|`giCqsPVK;deZ@zUvPyfsleo4qz2t5uX_eOCWu=eB^)i=hdDlFzoXEOq&Klotr+VfbrFpNpZC z=ZU+F?g;JuJR)`}OK!4g`1P+LOA#_aHu@%dFLp`K)wcirmwJq-OH}&^!z3E-11u{i zbp*xRr5X5G=Bfat=o)5|?UKuhr)7zdqk6n7S&}{%LP=F`miI6`O0qOshQ>?qJG9B4 z0;LZtF6s9BFus&tw^jFkj-c^8N;^ni%DeJ+Gj zFYlp2du-CHOXKyQdq^;ZZj)Ct>jtGnZBKl&Xu?_atQ?JpoOp|GA$dH%S`?`I6Snp* z_*=%ZhmJYw3FJ#r>X0Qui7JqTNLM3wtrIWiJ>+RTw+tUuAk%BC)}RbgmUhdcad+rX zug`1(SnR^p=zX3nl|H^?Hp90TjrSUUcieRD>@$BM_`EdGc*y~#0VR4`0U}Iul_Q~# zx5{51(mofHr89AIm&S7_(I_CjfYM-d4=>`o+8FTYD!Q6`nEK)*f1ba>%>cXy7^3!~Lu#c=+5@EOhpj8W?jlxSQw zkQ+rQ9KUV*c<6I6Svs5V-|dMLO2gw+HAy@Bu*M5yssG$V{B^#oO&&q-KMf}Q+Wglo zf}T58d%78-HBpk)_C=Po?xDuRNc(-=!|bKtr`qBcp7^7D3`8h4N>_T3U836YKnr@5 zq|XCGsXj&{>SJZtC8=q(@p1GXsc}9I|7fgVj`zUhOKfOz>%>>UjkRy#1Ctu7{Swn4 zOI}jZjCnpS%PP4^)n zqVs`+_;@;^{&evo;KtETs4@z8DP#`JmX^{O982F7JW- z$SPH*&}*zVGVoErFYsM${IlHpxquiT8?u+31U*;d4ZwRqRGVJmMm639qx4Yo6th7n zi7%R319_D{R9OoBIgec6QFx6feJ&cls3{HkNM>OIgtAoTBmf3ou@z|RKu@sP*stZnV|9$dT>)I#{t`S=pP z)?nf#htdf7cq1Z9S@BO6jai^Sy*{(?zwy^>B32ncRXx?W2Ch{*f`ZBqHM zXuLE^n#a4j#XNYF=HA2a%_Z>tpz*%SG?p7Tco85%H1ZzOeqZw*{yOcT@M1nFRyDbT zle07)ZBwcI?7+Ol6BRwT0K|W?}PVnPD+-vPF#IFeX_G3VwTK> z_%@>y-OV&Y1hbz5?FNn4QTMQlUTNJ!F^z{&(QZ%N$!m?)6R%Moufs0&?>$7n%PiaI z&$-nle$51@J{x{6U=uwnL*t1orRUYE#*0|9o$wi=seb~WGFS_gR+$Dw2&llH1C8?4 z0dndg*$6UNOqOu3Y?Nq$o4VU}Zr~^-BiuuqAP1opU4E9?Mr4po#9!-UZT=o37g@8+ z)O)!8Q8r9%jVGS?Wh_gW{hU-4CDLwAoKp38(0HMb_W=50lON-Qf!QTmmcK?Xpp>QE zvS{FCEsggd{58MN1rkMis&7lJ^n#DK4S0wrt{QKO!>Hq0ZeVwOlzD2tnPt6-IT!!P zG{_BslD12(Y$QeVh{wOq=M~d{xp}oMzE#Kg(lle&-c|Uff9G$Rd!UiwJ?vr{P@>g8yL>#VKn{>=PV(2O?%@tT zC?reG6`b7VJy3q5N;@dfYpg~CfumV+lSRYj){rGxpW8cLCO-NL>0)iv(MmB zN}j_#)GWS10x}H|z3YDzu!miO#=A%@4OjCkN;}1SSOrUV4hGU($(Uk&JXt4`P+}Vt z)`T;yGbgUslF^z%8c$VkrYzB>fYmy=;|{2SW?TK*DL>4QL9?1Zs@*ur^fG5`ijQ{@ zq(kOh{EB3TWUSWPl6egIo2`rz)|yNn$2_veBXJ7HWr19JZ6dGn5>%QL^6_-gI1{A? zX}m@m8ZSmB-o{@98W?inoJ*X#sE3j*$1bz($(T8A{p4>*sMX;ToI8~>F z9)-V_^tqTUox)?uL}`?2TSuv6vO|{oA5o7n_NlvM83c&ld$8wX)UDk4OYA*tW0za^ zUs}P#FuEH_3-9fXAK(LXze-+hSgRjdmfRfLuId!pK_QHnR^(doEBK(0_n-k~CQ6*f zqj;$UrT(MZ_(tYbSJyRT=z*Ds#+mxh3KL4rJ;2AqjYv9Db}44f*6_doxwnF!Fxx7- zKmaAmGX#i$M&q|Z4ApG$CCJA^-lZ5ydASGYJxq|sn-Gl`*ronuDS8#NY$M6MJOw@Q zcIn4YF`>-a&*F)1WA8!tUwVgl;JXB+7WlIEh2Tfll|}C1mzYL~P)JMvcgYg@c!78B z^LVoFbs>~`c@N||P)@uIjh7%!vJ3EV4T8qD#(V1H@l?vIKvqwj!&g5FsM%JDm;CR4 z9vMRejd)42 z{#JI3(%M!%SKAU-i&B)%!@VT;@Cvp&RnuV2+g>|m$A9IorROjG7So{JoH(U2L|m~F zu0QFu=X!R@%3bx{p+o~0^y;!p1JHP%VP$?toGJk0kOOK+o!t4y0>!I2FSgkz;K1Bt>6MqNO7!jAVOUn`> z-K+}a1oPdCX}liZLydO!p;s9i??1VReyvG}7SqB%Wk$7v(q=YHx~A9bTYP)dnG>IX zCg|rt^58vuooSF80wq91kqh(WZH@OaKCc)`oA{jWkqf8s$OETW39=MnMy8D)i{5`6 zOsJ1%pLzsz3wjyjONtWfHXTua1HU_IZtAp44Q8bI3YM`0$cY=K5h7%iNS3-hajKOI zv#qP>i;W-02gOiARGp0y0aSB4`?z>1%TvgrftNMBhXvty;Uj#YKAxVdt?oouB1&7? z(x@k{HAJ1chZr204S_7lo`!@H2@+Lxr8ORfx#U0u^5tbo`dkd9y!lH`md0t8**Fa{ z4LquikiE3g9|9$WmrbTJx)N#B809 z+wni*o|L%4jb?~8LgRJJxflgHUgOQd6E_zJ-b1`gQ6e{iv|HDl3mRVvJPLm;>2on3 z?@Tb1i4v`yQg>^o3>>BC<$PD~Vgr3k;kLUt*4UM+dzjT+6XrLBDik5ar9D8+w?-hYmp_UgJf zOn{D`YbidSM73K|@siJpgCCz0pFIhFQu|y$Tf;67y@Cf0Fqryf}>Zl=Nlv33x zt9%KX8G{T_A(V3WGIJ=6kzpF^mZkntl3ng?{5uJ=}%D7 z_33GW!)e4u=H>vUPP-H!LdX$HH0>gkC0v>`9{OAirM#TDLy1Pz=~aSVl3hq_{2O>G zZ|8l<0|{&3Nco zt>(n9b&9Rtu9}>EF@8-~0zIJg5~cwq8U;+F#Ih7-jr2j=1mo1j>{6aA(Fz7t+M%0X zV=nzLKG>0qALSnUy@*!$t*;^SD^>ShkC$(kWPC}2deL|~qCN~?&dbvLGnhfMIq<|~ z)CDL}9xsTEloqbI+nhunZTx&bD3&40%RM-hXhl$Zm4K38#c(fre-(P5Iq|7iRzRNu zy$o489hAI}H~A>|xwXYDe7tM@dmOEk+VzbO0SQxrmLFHU4`vmgP(~< zSQ7%JPcjX1L!flY64i+Z-nrL!@i9KHm|a5j-(8*JP^wc@>n7JajhE$FXVI7i`qS$( z8(+a+v+-YWo4eb6f~&1xmU?;*9R~z4h-mij*&cEM>xq#=k z_@;uAdJm(pKVIWW?xFcc_<*SNdMBR=ln9Ydlqf?Ku3p_n2~}*xP|AyH9ZIzKGrhVr z-T-{OH*ybkw`#w$&nT0Jrk-BmgZ}3)t?51VUWaHE{MhIMKF}u(AMa&M14?9<0vn{V zl&T@xCD)Q!X2tAMUOgV8L<>HQ(f&&Vm!^gUe7-?KW!qcnXd__<+=Q+e1yA$}>-a!}$7 zQCL^x>mHI}KChT8oyF(mpwu9gC_^;(cnLF2eBFa)TSepfmDd))Tp!*;50uEotC;jG zGu_Kf_Sp1uF6Mum88PRuT@sX@#x$TrIe>IM9-%bIx`!U#Lw%Sky@nk`^nVc54!{$K z7i;4mLhr?w^ZNpx`&Xdf%1t?QE+mf!KS8_)Md{`i-&pOCot3!m(g3CCWBeVUlr=LZ zoi%D}JY-IbX}pto5LrH6omO6>7f{Obtg~pi+!~&^RA|`vm-y?so_OE6hc!L%jVIhc z%@FCx#dR&_%Z~z1{~q`p4l+cY>*IA*O;U|s;P-jNrO(BDyk4?I#r#x3RDvwU(6c%d z*gTsb0*$D1X6ArB|IK(R)1a?kk2U>dd>b5MQTA-L+>VZ;&+&g-efKv1T_s~Wt9x^ByqP0?3{~WLz5TED! zc&D3t=#3KDrHw7-q$7`42TDF(n*Abw%UsC6BGf%ZzsNK~1eIPv1glywwelKneRQ?|jX}3-Q diff --git a/inst/examples/iris_app/app.R b/inst/examples/iris_app/app.R index b12fdbd..c89fedc 100644 --- a/inst/examples/iris_app/app.R +++ b/inst/examples/iris_app/app.R @@ -12,15 +12,11 @@ ui <- fluidPage( verbatimTextOutput("data_filter_code"), dataTableOutput("data_summary") ), - column(4, shiny_data_filter_ui("data_filter")))) + column(4, IDEAFilter_ui("data_filter")))) server <- function(input, output, session) { - filtered_data <- callModule( - IDEAFilter::shiny_data_filter, - "data_filter", - data = iris, - verbose = FALSE) + filtered_data <- IDEAFilter("data_filter", data = iris, verbose = FALSE) output$data_filter_code <- renderPrint({ cat(gsub("%>%", "%>% \n ", diff --git a/inst/examples/starwars_app/app.R b/inst/examples/starwars_app/app.R index 9d75234..cdca543 100644 --- a/inst/examples/starwars_app/app.R +++ b/inst/examples/starwars_app/app.R @@ -23,14 +23,10 @@ ui <- fluidPage( dataTableOutput("data_summary"), h4("Generated code:"), verbatimTextOutput("data_filter_code")), - column(4, shiny_data_filter_ui("data_filter")))) + column(4, IDEAFilter_ui("data_filter")))) server <- function(input, output, session) { - filtered_data <- callModule( - shiny_data_filter, - "data_filter", - data = starwars2, - verbose = FALSE) + filtered_data <- IDEAFilter("data_filter", data = starwars2, verbose = FALSE) output$data_filter_code <- renderPrint({ cat(gsub("%>%", "%>% \n ", From 7b5f4ab65463464017665bdd5d7dd2af76498595 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Mon, 7 Aug 2023 16:51:09 -0400 Subject: [PATCH 032/101] Fix bug when changing dataset --- R/IDEAFilter.R | 3 +++ 1 file changed, 3 insertions(+) diff --git a/R/IDEAFilter.R b/R/IDEAFilter.R index 8f609b3..d48e624 100644 --- a/R/IDEAFilter.R +++ b/R/IDEAFilter.R @@ -226,6 +226,9 @@ IDEAFilter <- function(id, data, ..., verbose = FALSE) { }) filter_logical <- reactiveVal(TRUE) + observeEvent(datar(), { + filter_logical(TRUE) + }) code <- reactive({ filter_log("building code", verbose = verbose) filter_exprs <- Filter( From a1c3b77645f0134f0c4757977edcea3fb5d77d98 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Mon, 7 Aug 2023 16:51:41 -0400 Subject: [PATCH 033/101] Repair `data_call` --- R/IDEAFilter.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/IDEAFilter.R b/R/IDEAFilter.R index d48e624..9e04d62 100644 --- a/R/IDEAFilter.R +++ b/R/IDEAFilter.R @@ -115,7 +115,7 @@ IDEAFilter <- function(id, data, ..., verbose = FALSE) { ns <- session$ns filter_log("calling module", verbose = verbose) - data_call <- as.list(sys.call(-5L))$data + data_call <- as.list(sys.call(-7L))$data datar <- if (is.reactive(data)) data else reactive(data) filter_counter <- 0 From b1caa5b024590922175c922c17b497466ef91fab Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Tue, 8 Aug 2023 08:19:40 -0400 Subject: [PATCH 034/101] Repair bug when switching datasets with added filters --- R/IDEAFilter_item.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/IDEAFilter_item.R b/R/IDEAFilter_item.R index 1b9b4b2..cff720a 100644 --- a/R/IDEAFilter_item.R +++ b/R/IDEAFilter_item.R @@ -154,7 +154,7 @@ IDEAFilter_item <- function(id, data, column_name = NULL, ..., filters = list(), nna <- shiny::reactive(sum(is.na(vec()))) vec <- shiny::reactive({ - if (is.null(module_return$column_name)) NULL + if (is.null(module_return$column_name) || !(module_return$column_name %in% names(data()))) NULL else data()[filter_logical(), module_return$column_name, drop = TRUE] }) From 7e76a4e9bd4620172a8dd7f2d17d49a4fc932548 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Tue, 8 Aug 2023 08:37:51 -0400 Subject: [PATCH 035/101] Update documentation --- R/IDEAFilter_item.R | 12 +++++++----- man/IDEAFilter.Rd | 2 +- man/IDEAFilter_item.Rd | 23 +++++++++++++++++------ man/IDEAFilter_item_ui.Rd | 2 +- man/IDEAFilter_ui.Rd | 2 +- 5 files changed, 27 insertions(+), 14 deletions(-) diff --git a/R/IDEAFilter_item.R b/R/IDEAFilter_item.R index cff720a..d775a62 100644 --- a/R/IDEAFilter_item.R +++ b/R/IDEAFilter_item.R @@ -30,13 +30,16 @@ IDEAFilter_item_ui <- function(id) { #' as the input to the filter item module #' @param column_name a value indicating the name of the column to be filtered #' @param ... placeholder for inclusion of additional parameters in future development +#' @param filters a \code{reactive expression} containing the a list of filters +#' passed as \code{language} types #' @param verbose a \code{logical} value indicating whether or not to print log #' statements out to the console #' -#' @return a \code{\link[shiny]{reactiveValues}} list of three reactive elements; -#' (1) a reactive data frame, (2) the code to filter a vector with the name of -#' the specified data column, and (3) a flag indicating when to remove this -#' filter. +#' @return a \code{\link[shiny]{reactiveValues}} list of four reactive elements; +#' (1) the code to filter a vector with the name of the specified data column, +#' (2) a flag indicating when to remove this filter, (3) the append list of +#' combining the `filters` argument with (1), and (4) the column name of the +#' `data` used to create the item. #' #' @importFrom shiny reactiveValues wellPanel fillRow selectInput h4 actionLink #' icon uiOutput div HTML span textOutput eventReactive renderUI tag @@ -50,7 +53,6 @@ IDEAFilter_item <- function(id, data, column_name = NULL, ..., filters = list(), ns <- session$ns module_return <- shiny::reactiveValues( - # data = data, code = TRUE, remove = FALSE, filters = filters, diff --git a/man/IDEAFilter.Rd b/man/IDEAFilter.Rd index 948e6a8..0ae5078 100644 --- a/man/IDEAFilter.Rd +++ b/man/IDEAFilter.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/shiny_data_filter.R +% Please edit documentation in R/IDEAFilter.R \name{IDEAFilter} \alias{IDEAFilter} \title{IDEA data filter module server function} diff --git a/man/IDEAFilter_item.Rd b/man/IDEAFilter_item.Rd index 07283c9..5b724ac 100644 --- a/man/IDEAFilter_item.Rd +++ b/man/IDEAFilter_item.Rd @@ -1,10 +1,17 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/shiny_data_filter_item.R +% Please edit documentation in R/IDEAFilter_item.R \name{IDEAFilter_item} \alias{IDEAFilter_item} \title{The server function for the IDEA filter item module} \usage{ -IDEAFilter_item(id, data, column_name = NULL, ..., verbose = FALSE) +IDEAFilter_item( + id, + data, + column_name = NULL, + ..., + filters = list(), + verbose = FALSE +) } \arguments{ \item{id}{a module id name} @@ -16,14 +23,18 @@ as the input to the filter item module} \item{...}{placeholder for inclusion of additional parameters in future development} +\item{filters}{a \code{reactive expression} containing the a list of filters +passed as \code{language} types} + \item{verbose}{a \code{logical} value indicating whether or not to print log statements out to the console} } \value{ -a \code{\link[shiny]{reactiveValues}} list of three reactive elements; - (1) a reactive data frame, (2) the code to filter a vector with the name of - the specified data column, and (3) a flag indicating when to remove this - filter. +a \code{\link[shiny]{reactiveValues}} list of four reactive elements; + (1) the code to filter a vector with the name of the specified data column, + (2) a flag indicating when to remove this filter, (3) the append list of + combining the `filters` argument with (1), and (4) the column name of the + `data` used to create the item. } \description{ Serves as a wrapper fo \code{\link{shiny_data_filter_item}} and utilizes diff --git a/man/IDEAFilter_item_ui.Rd b/man/IDEAFilter_item_ui.Rd index 9f286c8..ab7f6fb 100644 --- a/man/IDEAFilter_item_ui.Rd +++ b/man/IDEAFilter_item_ui.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/shiny_data_filter_item.R +% Please edit documentation in R/IDEAFilter_item.R \name{IDEAFilter_item_ui} \alias{IDEAFilter_item_ui} \title{A single filter item as part of a IDEA filter module panel} diff --git a/man/IDEAFilter_ui.Rd b/man/IDEAFilter_ui.Rd index 721bd68..d8a258f 100644 --- a/man/IDEAFilter_ui.Rd +++ b/man/IDEAFilter_ui.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/shiny_data_filter.R +% Please edit documentation in R/IDEAFilter.R \name{IDEAFilter_ui} \alias{IDEAFilter_ui} \title{User interface function to add a data filter panel} From 4faa89d39f7dd552841c310143cc86ed067c7124 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Tue, 8 Aug 2023 10:30:49 -0400 Subject: [PATCH 036/101] Add tests for reactive data --- DESCRIPTION | 16 +++---- R/IDEAFilter.R | 16 ++++--- tests/shinytest/shinytest_reactive_data/app.R | 46 +++++++++++++++++++ tests/testthat/test_IDEAFilter.R | 2 +- tests/testthat/test_IDEAFilter_item.R | 2 +- tests/testthat/test_reactive_data.R | 46 +++++++++++++++++++ 6 files changed, 111 insertions(+), 17 deletions(-) create mode 100644 tests/shinytest/shinytest_reactive_data/app.R create mode 100644 tests/testthat/test_reactive_data.R diff --git a/DESCRIPTION b/DESCRIPTION index 11e8212..1dc31bc 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -39,19 +39,19 @@ Encoding: UTF-8 LazyData: true RoxygenNote: 7.2.3 Imports: - shiny, + crayon, ggplot2, pillar (>= 1.5.0), - crayon, + purrr, RColorBrewer, - shinyTime, - purrr + shiny, + shinyTime Suggests: - shinytest, - shinytest2, - testthat, + dplyr, knitr, rmarkdown, + shinytest, + shinytest2, spelling, - dplyr + testthat Language: en-US diff --git a/R/IDEAFilter.R b/R/IDEAFilter.R index 9e04d62..2a95483 100644 --- a/R/IDEAFilter.R +++ b/R/IDEAFilter.R @@ -243,12 +243,14 @@ IDEAFilter <- function(id, data, ..., verbose = FALSE) { init = data_call) }) - reactive({ - filter_log("recalculating filtered data", verbose = verbose) - structure( - d <- subset(datar(), filter_logical()) %||% data.frame(), - code = code(), - class = c("shinyDataFilter_df", class(d))) - }) + bindEvent( + reactive({ + filter_log("recalculating filtered data", verbose = verbose) + structure( + d <- subset(datar(), filter_logical()) %||% data.frame(), + code = code(), + class = c("shinyDataFilter_df", class(d))) + }), + code()) }) } \ No newline at end of file diff --git a/tests/shinytest/shinytest_reactive_data/app.R b/tests/shinytest/shinytest_reactive_data/app.R new file mode 100644 index 0000000..2517856 --- /dev/null +++ b/tests/shinytest/shinytest_reactive_data/app.R @@ -0,0 +1,46 @@ +mtcars2 <- mtcars +mtcars2[which((mtcars2 * 0.987) %% 0.2 < 0.01, arr.ind = TRUE)] <- NA + +ui <- fluidPage( + fluidRow( + column(8, + selectInput("select_data", "Select Data", c("airquality", "mtcars"), selected = "airquality"), + verbatimTextOutput("data_summary"), + verbatimTextOutput("data_filter_code")), + column(4, IDEAFilter::IDEAFilter_ui("data_filter")))) + +srv <- function(input, output, session) { + data <- reactiveVal(airquality) + filtered_data <- IDEAFilter::IDEAFilter( + "data_filter", + data = data, + verbose = FALSE) + + exportTestValues( + filtered_data = filtered_data() + ) + + observeEvent(input$select_data, { + if (input$select_data == "airquality") + data(airquality) + else + data(mtcars2) + }) + + output$data_filter_code <- renderPrint({ + cat(gsub("%>%", "%>% \n ", + gsub("\\s{2,}", " ", + paste0( + capture.output(attr(filtered_data(), "code")), + collapse = " ")) + )) + }) + + output$data_summary <- renderPrint({ + if (nrow(filtered_data())) show(filtered_data()) + else "No data available" + }) + +} + +shinyApp(ui, srv) diff --git a/tests/testthat/test_IDEAFilter.R b/tests/testthat/test_IDEAFilter.R index 5bfd73d..ac41850 100644 --- a/tests/testthat/test_IDEAFilter.R +++ b/tests/testthat/test_IDEAFilter.R @@ -1,4 +1,4 @@ -context("test_shiny_data_filter") +context("test_IDEAFilter") skip_on_cran() app_path <- IDEAFilter:::shinytest_path("shinytest_IDEAFilter") diff --git a/tests/testthat/test_IDEAFilter_item.R b/tests/testthat/test_IDEAFilter_item.R index 28c222a..d3b65ac 100644 --- a/tests/testthat/test_IDEAFilter_item.R +++ b/tests/testthat/test_IDEAFilter_item.R @@ -1,4 +1,4 @@ -context("test_shiny_data_filter_item") +context("test_IDEAFilter_item") skip_on_cran() # reflects data used in shinytest diff --git a/tests/testthat/test_reactive_data.R b/tests/testthat/test_reactive_data.R new file mode 100644 index 0000000..5de4766 --- /dev/null +++ b/tests/testthat/test_reactive_data.R @@ -0,0 +1,46 @@ +context("test_reactive_data") +skip_on_cran() + +# reflects data used in shinytest +mtcars2 <- mtcars +mtcars2[which((mtcars2 * 0.987) %% 0.2 < 0.01, arr.ind = TRUE)] <- NA + +app_path <- IDEAFilter:::shinytest_path("shinytest_reactive_data") +app <- shinytest2::AppDriver$new(app_path) + +app$set_inputs(`data_filter-add_filter_select` = "Ozone") +app$wait_for_js('document.getElementById("data_filter-filter_1-remove_filter_btn")') +app$wait_for_idle() +app$set_inputs(`data_filter-filter_1-vector_filter-param` = c(30, 90)) + +test_that("test that a new filter item has been added", { + expect_equivalent( + app$get_value(output = "data_summary"), + renderPrint(subset(airquality, is.na(Ozone) | (Ozone >= 30 & Ozone <= 90)))()) +}) + +app$set_inputs(select_data = "mtcars") + +test_that("test that a new filter item has been added", { + expect_equivalent( + app$get_value(output = "data_summary"), + renderPrint(mtcars2)()) +}) + +app$set_inputs(`data_filter-add_filter_select` = "mpg") +app$wait_for_js('document.getElementById("data_filter-filter_2-remove_filter_btn")') +app$set_inputs(`data_filter-filter_2-vector_filter-param` = c(20, 25)) + +test_that("test that a new filter item has been added", { + expect_equivalent( + app$get_value(output = "data_summary"), + renderPrint(subset(mtcars2, is.na(mpg) | (mpg >= 20 & mpg <= 25)))()) +}) + +app$set_inputs(select_data = "airquality") + +test_that("test that a new filter item has been added", { + expect_equivalent( + app$get_value(output = "data_summary"), + renderPrint(subset(airquality, is.na(Ozone) | (Ozone >= 30 & Ozone <= 90)))()) +}) From 8e65c5c2c33d48cfd21e395335b05b1a602736af Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Tue, 8 Aug 2023 10:44:16 -0400 Subject: [PATCH 037/101] Add waiter --- tests/testthat/test_reactive_data.R | 1 + 1 file changed, 1 insertion(+) diff --git a/tests/testthat/test_reactive_data.R b/tests/testthat/test_reactive_data.R index 5de4766..facf016 100644 --- a/tests/testthat/test_reactive_data.R +++ b/tests/testthat/test_reactive_data.R @@ -29,6 +29,7 @@ test_that("test that a new filter item has been added", { app$set_inputs(`data_filter-add_filter_select` = "mpg") app$wait_for_js('document.getElementById("data_filter-filter_2-remove_filter_btn")') +app$wait_for_idle() app$set_inputs(`data_filter-filter_2-vector_filter-param` = c(20, 25)) test_that("test that a new filter item has been added", { From bf403ffe3ccbe924bf0edc268cd002007d78e864 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Tue, 8 Aug 2023 11:10:11 -0400 Subject: [PATCH 038/101] Update NEWS --- NEWS.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index 1e2652f..cf35986 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,7 +1,7 @@ # IDEAFilter (development version) * Fix bug that was trying to assign an attribute to a NULL (#15) * Fix bug that was causing inaccurate filtering for `datetime` vectors (#17) -* Add wrappers for module functions for more modern implementation (#22) +* Add new implementation `IDEAFilter()` that uses a more modern implementation and less resources (#22) # IDEAFilter 0.1.3 * Cited works of other contributors (`shinyDataFilter` & `SortableJS`) From 938236e9c30dda91ad996f0f2e80521dc1298bdd Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Tue, 8 Aug 2023 14:45:22 -0400 Subject: [PATCH 039/101] Implement pre-selection using `IDEAFilter()` --- R/IDEAFilter.R | 56 ++++++++++++++++++++++++++- R/IDEAFilter_item.R | 13 ++++--- R/shiny_data_filter.R | 58 ++-------------------------- R/shiny_data_filter_item.R | 8 +--- R/shiny_vector_filter_character.R | 2 +- R/shiny_vector_filter_date.R | 4 +- R/shiny_vector_filter_datetime.R | 8 ++-- R/shiny_vector_filter_factor_few.R | 2 +- R/shiny_vector_filter_factor_many.R | 2 +- R/shiny_vector_filter_logical.R | 2 +- R/shiny_vector_filter_numeric_few.R | 2 +- R/shiny_vector_filter_numeric_many.R | 2 +- man/IDEAFilter.Rd | 4 +- man/IDEAFilter_item.Rd | 9 +++-- man/shiny_data_filter.Rd | 11 +----- man/shiny_data_filter_item.Rd | 5 +-- 16 files changed, 90 insertions(+), 98 deletions(-) diff --git a/R/IDEAFilter.R b/R/IDEAFilter.R index 2a95483..768a757 100644 --- a/R/IDEAFilter.R +++ b/R/IDEAFilter.R @@ -46,6 +46,7 @@ IDEAFilter_ui <- function(id) { #' @param data a \code{data.frame} or \code{reactive expression} returning a #' \code{data.frame} to use as the input to the filter module #' @param ... placeholder for inclusion of additional parameters in future development +#' @param preselection a \code{list} that can be used to pre-populate the filter #' @param verbose a \code{logical} value indicating whether or not to print log #' statements out to the console #' @@ -110,13 +111,14 @@ IDEAFilter_ui <- function(id) { #' shinyApp(ui = ui, server = server) #' } #' -IDEAFilter <- function(id, data, ..., verbose = FALSE) { +IDEAFilter <- function(id, data, ..., preselection = NULL, verbose = FALSE) { moduleServer(id, function(input, output, session) { ns <- session$ns filter_log("calling module", verbose = verbose) data_call <- as.list(sys.call(-7L))$data datar <- if (is.reactive(data)) data else reactive(data) + preselectionr <- if (is.reactive(preselection)) preselection else reactive(preselection) filter_counter <- 0 next_filter_id <- function() { @@ -131,7 +133,7 @@ IDEAFilter <- function(id, data, ..., verbose = FALSE) { filters = reactive(list()), remove = NULL)) - update_filter <- function(fid, in_fid, column_name = NULL) { + update_filter <- function(fid, in_fid, column_name = NULL, preselection = NULL) { fs <- isolate(filters()) if (missing(in_fid)) @@ -151,9 +153,30 @@ IDEAFilter <- function(id, data, ..., verbose = FALSE) { data = datar, column_name = column_name, filters = filter_returns[[in_fid]]$filters, + preselection = preselection, verbose = verbose) } + apply_preselection <- function(preselection = NULL) { + + for (col_sel in (names(preselectionr()) %||% preselectionr())) { + if (!col_sel %in% names(datar())) { + warning(sprintf("Unable to add `%s` to filter list.", col_sel)) + next() + } + + update_filter(fid <- next_filter_id(), column_name = col_sel, preselection = if(is.list(preselectionr())) preselectionr()[[col_sel]]) + filters(append(filters(), fid)) + + insertUI( + selector = sprintf("#%s", ns("sortableList")), + where = "beforeEnd", + ui = shiny_data_filter_item_ui(ns(fid), verbose = verbose)) + + updateSelectInput(session, "add_filter_select", selected = "") + } + } + output$add_filter_select_ui <- renderUI({ columnSelectInput( ns("add_filter_select"), @@ -189,6 +212,35 @@ IDEAFilter <- function(id, data, ..., verbose = FALSE) { selector = sprintf("#%s", ns("sortableList")), where = "beforeEnd", ui = IDEAFilter_item_ui(ns(fid))) + }) + + observeEvent(input$add_filter_select, { + req(preselectionr()) + + filter_log("observing pre-selected columns", verbose = verbose) + + apply_preselection(preselectionr()) + }, once = TRUE) + + observeEvent(preselectionr(), { + req(!is.null(input$add_filter_select)) + + filter_log("scrubbing all filters", verbose = verbose) + for (fid in filters()[-1]) { + idx <- utils::head(which(filters() == fid), 1) + filter_returns[[fid]]$destroy + + filters(setdiff(filters(), fid)) + + # overwrite existing module call with one taking new input data + if (!idx > length(filters())) update_filter(filters()[[idx]]) + + removeUI(selector = sprintf("#%s-ui", ns(fid))) + } + + filter_log("applying updated selection", verbose = verbose) + apply_preselection(preselectionr()) + }) observeEvent(input$add_filter_select, { diff --git a/R/IDEAFilter_item.R b/R/IDEAFilter_item.R index d775a62..2f4a6e5 100644 --- a/R/IDEAFilter_item.R +++ b/R/IDEAFilter_item.R @@ -29,9 +29,10 @@ IDEAFilter_item_ui <- function(id) { #' @param data a \code{reactive expression} returning a \code{data.frame} to use #' as the input to the filter item module #' @param column_name a value indicating the name of the column to be filtered -#' @param ... placeholder for inclusion of additional parameters in future development #' @param filters a \code{reactive expression} containing the a list of filters #' passed as \code{language} types +#' @param ... placeholder for inclusion of additional parameters in future development +#' @param preselection a \code{list} that can be used to pre-populate the filter #' @param verbose a \code{logical} value indicating whether or not to print log #' statements out to the console #' @@ -47,11 +48,13 @@ IDEAFilter_item_ui <- function(id) { #' @export #' @keywords internal #' -IDEAFilter_item <- function(id, data, column_name = NULL, ..., filters = list(), verbose = FALSE) { +IDEAFilter_item <- function(id, data, column_name = NULL, filters = list(), ..., preselection = NULL, verbose = FALSE) { filters <- if (is.reactive(filters)) filters else reactiveVal(filters) moduleServer(id, function(input, output, session) { ns <- session$ns + filter_na <- reactiveVal(if ("filter_na" %in% names(preselection)) isTRUE(preselection[["filter_na"]]) else FALSE) + module_return <- shiny::reactiveValues( code = TRUE, remove = FALSE, @@ -146,9 +149,8 @@ IDEAFilter_item <- function(id, data, column_name = NULL, ..., filters = list(), sum(out_log, na.rm = TRUE) }) - filter_na <- shiny::reactive({ - if (is.null(input$filter_na_btn)) FALSE - else input$filter_na_btn %% 2 == 1 + observeEvent(input$filter_na_btn, { + filter_na(!filter_na()) }) x <- shiny::eventReactive(filter_na(), { filter_log("observing filter_na")}) @@ -180,6 +182,7 @@ IDEAFilter_item <- function(id, data, column_name = NULL, ..., filters = list(), "vector_filter", x = vec, filter_na = filter_na, + filter_fn = preselection[["filter_fn"]], verbose = verbose) }) diff --git a/R/shiny_data_filter.R b/R/shiny_data_filter.R index 34ef665..742b2a0 100644 --- a/R/shiny_data_filter.R +++ b/R/shiny_data_filter.R @@ -52,7 +52,6 @@ shiny_data_filter_ui <- function(inputId) { #' \code{data.frame} to use as the input to the filter module #' @param verbose a \code{logical} value indicating whether or not to print log #' statements out to the console -#' @param preselection a \code{list} that can be used to pre-populate the filter #' #' @return a \code{reactive expression} which returns the filtered data wrapped #' in an additional class, "shinyDataFilter_df". This structure also contains @@ -119,7 +118,7 @@ shiny_data_filter_ui <- function(inputId) { #' shinyApp(ui = ui, server = server) #' } #' -shiny_data_filter <- function(input, output, session, data, verbose = FALSE, preselection = NULL) { +shiny_data_filter <- function(input, output, session, data, verbose = FALSE) { .Deprecated("IDEAFilter") ns <- session$ns @@ -128,7 +127,6 @@ shiny_data_filter <- function(input, output, session, data, verbose = FALSE, pre # retrieve input from callModule call (sys.call(-5L)) data_call <- as.list(sys.call(-5L))$data datar <- if (is.reactive(data)) data else reactive(data) - preselectionr <- if (is.reactive(preselection)) preselection else reactive(preselection) filter_counter <- 0 next_filter_id <- function() { @@ -142,7 +140,7 @@ shiny_data_filter <- function(input, output, session, data, verbose = FALSE, pre code = reactive(TRUE), remove = NULL)) - update_filter <- function(fid, in_fid, column_name = NULL, preselection = NULL) { + update_filter <- function(fid, in_fid, column_name = NULL) { fs <- isolate(filters()) if (missing(in_fid)) @@ -162,28 +160,7 @@ shiny_data_filter <- function(input, output, session, data, verbose = FALSE, pre fid, data = filter_returns[[in_fid]]$data, column_name = column_name, - verbose = verbose, - preselection = preselection) - } - - apply_preselection <- function(preselection = NULL) { - - for (col_sel in (names(preselectionr()) %||% preselectionr())) { - if (!col_sel %in% names(datar())) { - warning(sprintf("Unable to add `%s` to filter list.", col_sel)) - next() - } - - update_filter(fid <- next_filter_id(), column_name = col_sel, preselection = if(is.list(preselectionr())) preselectionr()[[col_sel]]) - filters(append(filters(), fid)) - - insertUI( - selector = sprintf("#%s", ns("sortableList")), - where = "beforeEnd", - ui = shiny_data_filter_item_ui(ns(fid), verbose = verbose)) - - updateSelectInput(session, "add_filter_select", selected = "") - } + verbose = verbose) } output$add_filter_select_ui <- renderUI({ @@ -223,35 +200,6 @@ shiny_data_filter <- function(input, output, session, data, verbose = FALSE, pre ui = shiny_data_filter_item_ui(ns(fid), verbose = verbose)) }) - observeEvent(input$add_filter_select, { - req(preselectionr()) - - filter_log("observing pre-selected columns", verbose = verbose) - - apply_preselection(preselectionr()) - }, once = TRUE) - - observeEvent(preselectionr(), { - req(!is.null(input$add_filter_select)) - - filter_log("scrubbing all filters", verbose = verbose) - for (fid in filters()[-1]) { - idx <- utils::head(which(filters() == fid), 1) - filter_returns[[fid]]$destroy - - filters(setdiff(filters(), fid)) - - # overwrite existing module call with one taking new input data - if (!idx > length(filters())) update_filter(filters()[[idx]]) - - removeUI(selector = sprintf("#%s-ui", ns(fid))) - } - - filter_log("applying updated selection", verbose = verbose) - apply_preselection(preselectionr()) - - }) - observeEvent(input$add_filter_select, { if (!input$add_filter_select %in% names(datar())) return() diff --git a/R/shiny_data_filter_item.R b/R/shiny_data_filter_item.R index 0667fe4..003bd30 100644 --- a/R/shiny_data_filter_item.R +++ b/R/shiny_data_filter_item.R @@ -41,7 +41,6 @@ shiny_data_filter_item_ui <- function(inputId, verbose = FALSE) { #' @param column_name a value indicating the name of the column to be filtered #' @param verbose a \code{logical} value indicating whether or not to print log #' statements out to the console -#' @param preselection a \code{list} that can be used to pre-populate the filter #' #' @return a \code{\link[shiny]{reactiveValues}} list of three reactive elements; #' (1) a reactive data frame, (2) the code to filter a vector with the name of @@ -55,13 +54,11 @@ shiny_data_filter_item_ui <- function(inputId, verbose = FALSE) { #' @keywords internal #' shiny_data_filter_item <- function(input, output, session, data, - column_name = NULL, verbose = FALSE, preselection = NULL) { + column_name = NULL, verbose = FALSE) { .Deprecated("IDEAFilter_item") ns <- session$ns - fna <- if ("filter_na" %in% names(preselection)) isTRUE(preselection[["filter_na"]]) else FALSE - module_return <- shiny::reactiveValues( data = data, code = TRUE, @@ -150,7 +147,7 @@ shiny_data_filter_item <- function(input, output, session, data, filter_na <- shiny::reactive({ if (is.null(input$filter_na_btn)) FALSE - else (input$filter_na_btn + 1*fna) %% 2 == 1 + else input$filter_na_btn %% 2 == 1 }) x <- shiny::eventReactive(filter_na(), { filter_log("observing filter_na")}) @@ -182,7 +179,6 @@ shiny_data_filter_item <- function(input, output, session, data, "vector_filter", x = vec, filter_na = filter_na, - filter_fn = preselection[["filter_fn"]], verbose = verbose) }) diff --git a/R/shiny_vector_filter_character.R b/R/shiny_vector_filter_character.R index 4fcabc2..887e60e 100644 --- a/R/shiny_vector_filter_character.R +++ b/R/shiny_vector_filter_character.R @@ -35,7 +35,7 @@ shiny_vector_filter.character <- function(data, inputId, ...) { } else { proportionSelectInput(ns("param"), NULL, vec = x, - selected = x_filtered, + selected = isolate(input$param) %||% x_filtered, multiple = TRUE, width = "100%") } diff --git a/R/shiny_vector_filter_date.R b/R/shiny_vector_filter_date.R index 4730919..bf5688d 100644 --- a/R/shiny_vector_filter_date.R +++ b/R/shiny_vector_filter_date.R @@ -33,8 +33,8 @@ shiny_vector_filter.Date <- function(data, inputId, ...) { if (any(!is.na(x()))) { shiny::dateRangeInput(ns("param"), NULL, #value = shiny::isolate(input$param) %||% range(x(), na.rm = TRUE), - start = min(x_filtered), - end = max(x_filtered), + start = isolate(input$param[[1]]) %||% min(x_filtered), + end = isolate(input$param[[2]]) %||% max(x_filtered), min = min(x(), na.rm = TRUE), max = max(x(), na.rm = TRUE) ) diff --git a/R/shiny_vector_filter_datetime.R b/R/shiny_vector_filter_datetime.R index f6f446c..0bd7fb2 100644 --- a/R/shiny_vector_filter_datetime.R +++ b/R/shiny_vector_filter_datetime.R @@ -36,15 +36,15 @@ shiny_vector_filter.POSIXct <- function(data, inputId, ...) { my_date <- as.Date(x()) div( div(style = "display: inline-block; vertical-align:middle;", - shiny::dateInput(ns("st_date"), "Start Date",value = min(as.Date(x_filtered)) + shiny::dateInput(ns("st_date"), "Start Date", value = isolate(input$st_date) %||% min(as.Date(x_filtered)) , min = min(my_date, na.rm = TRUE), max = max(my_date, na.rm = TRUE)), - shinyTime::timeInput(ns("st_time"), "Start Time (HH:MM:SS)", value = min(x_filtered))# automatically takes the time element + shinyTime::timeInput(ns("st_time"), "Start Time (HH:MM:SS)", value = isolate(input$st_time) %||% min(x_filtered))# automatically takes the time element ), div(style = "display: inline-block; vertical-align:middle;", - shiny::dateInput(ns("end_date"), "End Date",value = max(as.Date(x_filtered)) + shiny::dateInput(ns("end_date"), "End Date", value = isolate(input$end_date) %||% max(as.Date(x_filtered)) , min = min(my_date, na.rm = TRUE), max = max(my_date, na.rm = TRUE)), - shinyTime::timeInput(ns("end_time"), "End Time (HH:MM:SS)", value = max(x_filtered)) # automatically takes the time element + shinyTime::timeInput(ns("end_time"), "End Time (HH:MM:SS)", value = isolate(input$end_time) %||% max(x_filtered)) # automatically takes the time element ) ) } else { diff --git a/R/shiny_vector_filter_factor_few.R b/R/shiny_vector_filter_factor_few.R index 2a045c0..a78ec26 100644 --- a/R/shiny_vector_filter_factor_few.R +++ b/R/shiny_vector_filter_factor_few.R @@ -53,7 +53,7 @@ shiny_vector_filter_factor_few <- function(input, output, session, ), shiny::checkboxGroupInput(ns("param"), NULL, choices = choices(), - selected = x_filtered, + selected = isolate(input$param) %||% x_filtered, width = "100%")) }) diff --git a/R/shiny_vector_filter_factor_many.R b/R/shiny_vector_filter_factor_many.R index 1e6d2ec..9d861eb 100644 --- a/R/shiny_vector_filter_factor_many.R +++ b/R/shiny_vector_filter_factor_many.R @@ -38,7 +38,7 @@ shiny_vector_filter_factor_many <- function(input, output, session, filter_log("updating ui", verbose = verbose) proportionSelectInput(ns("param"), NULL, vec = x, - selected = x_filtered, + selected = isolate(input$param) %||% x_filtered, multiple = TRUE, width = "100%") }) diff --git a/R/shiny_vector_filter_logical.R b/R/shiny_vector_filter_logical.R index 11cbedc..c8bcf1d 100644 --- a/R/shiny_vector_filter_logical.R +++ b/R/shiny_vector_filter_logical.R @@ -41,7 +41,7 @@ shiny_vector_filter.logical <- function(data, inputId, ...) { shiny::plotOutput(ns("plot"), height = "100%")), shiny::checkboxGroupInput(ns("param"), NULL, choices = choices(), - selected = filter_selected, + selected = isolate(input$param) %||% filter_selected, width = "100%")) }) diff --git a/R/shiny_vector_filter_numeric_few.R b/R/shiny_vector_filter_numeric_few.R index 1afeb2d..a3c9fa0 100644 --- a/R/shiny_vector_filter_numeric_few.R +++ b/R/shiny_vector_filter_numeric_few.R @@ -54,7 +54,7 @@ shiny_vector_filter_numeric_few <- function(input, output, session, ), shiny::checkboxGroupInput(ns("param"), NULL, choices = choices(), - selected = x_filtered, + selected = isolate(input$param) %||% x_filtered, width = "100%")) }) diff --git a/R/shiny_vector_filter_numeric_many.R b/R/shiny_vector_filter_numeric_many.R index 7249f04..cb16c8e 100644 --- a/R/shiny_vector_filter_numeric_many.R +++ b/R/shiny_vector_filter_numeric_many.R @@ -48,7 +48,7 @@ shiny_vector_filter_numeric_many <- function(input, output, session, x = shiny:: transform-origin: bottom;"), if (any(!is.na(x()))) { shiny::sliderInput(ns("param"), NULL, - value = range(x_filtered), + value = isolate(input$param) %||% range(x_filtered), min = min(round(x(), 1), na.rm = TRUE), max = max(round(x(), 1), na.rm = TRUE)) } else { diff --git a/man/IDEAFilter.Rd b/man/IDEAFilter.Rd index 0ae5078..64a8db7 100644 --- a/man/IDEAFilter.Rd +++ b/man/IDEAFilter.Rd @@ -4,7 +4,7 @@ \alias{IDEAFilter} \title{IDEA data filter module server function} \usage{ -IDEAFilter(id, data, ..., verbose = FALSE) +IDEAFilter(id, data, ..., preselection = NULL, verbose = FALSE) } \arguments{ \item{id}{a module id name} @@ -14,6 +14,8 @@ IDEAFilter(id, data, ..., verbose = FALSE) \item{...}{placeholder for inclusion of additional parameters in future development} +\item{preselection}{a \code{list} that can be used to pre-populate the filter} + \item{verbose}{a \code{logical} value indicating whether or not to print log statements out to the console} } diff --git a/man/IDEAFilter_item.Rd b/man/IDEAFilter_item.Rd index 5b724ac..b6fee2a 100644 --- a/man/IDEAFilter_item.Rd +++ b/man/IDEAFilter_item.Rd @@ -8,8 +8,9 @@ IDEAFilter_item( id, data, column_name = NULL, - ..., filters = list(), + ..., + preselection = NULL, verbose = FALSE ) } @@ -21,11 +22,13 @@ as the input to the filter item module} \item{column_name}{a value indicating the name of the column to be filtered} -\item{...}{placeholder for inclusion of additional parameters in future development} - \item{filters}{a \code{reactive expression} containing the a list of filters passed as \code{language} types} +\item{...}{placeholder for inclusion of additional parameters in future development} + +\item{preselection}{a \code{list} that can be used to pre-populate the filter} + \item{verbose}{a \code{logical} value indicating whether or not to print log statements out to the console} } diff --git a/man/shiny_data_filter.Rd b/man/shiny_data_filter.Rd index 925ca06..f1e16f6 100644 --- a/man/shiny_data_filter.Rd +++ b/man/shiny_data_filter.Rd @@ -4,14 +4,7 @@ \alias{shiny_data_filter} \title{Shiny data filter module server function} \usage{ -shiny_data_filter( - input, - output, - session, - data, - verbose = FALSE, - preselection = NULL -) +shiny_data_filter(input, output, session, data, verbose = FALSE) } \arguments{ \item{input}{requisite shiny module field specifying incoming ui input @@ -28,8 +21,6 @@ session} \item{verbose}{a \code{logical} value indicating whether or not to print log statements out to the console} - -\item{preselection}{a \code{list} that can be used to pre-populate the filter} } \value{ a \code{reactive expression} which returns the filtered data wrapped diff --git a/man/shiny_data_filter_item.Rd b/man/shiny_data_filter_item.Rd index 4c1af46..d97d1dd 100644 --- a/man/shiny_data_filter_item.Rd +++ b/man/shiny_data_filter_item.Rd @@ -10,8 +10,7 @@ shiny_data_filter_item( session, data, column_name = NULL, - verbose = FALSE, - preselection = NULL + verbose = FALSE ) } \arguments{ @@ -31,8 +30,6 @@ as the input to the filter item module} \item{verbose}{a \code{logical} value indicating whether or not to print log statements out to the console} - -\item{preselection}{a \code{list} that can be used to pre-populate the filter} } \value{ a \code{\link[shiny]{reactiveValues}} list of three reactive elements; From 1c5b475720365bceb2840d38421921481c73dba4 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Tue, 8 Aug 2023 15:24:15 -0400 Subject: [PATCH 040/101] Increment version number --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 1dc31bc..20e6378 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: IDEAFilter Type: Package -Version: 0.1.3.9003 +Version: 0.1.3.9004 Title: Agnostic, Idiomatic Data Filter Module for Shiny Description: When added to an existing shiny app, users may subset any developer-chosen R data.frame on the fly. That is, users are empowered to From 5d07343325cd4ef51f8a6e5ef8c35e98a3575efe Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Tue, 8 Aug 2023 15:42:55 -0400 Subject: [PATCH 041/101] Implement column subsetting --- R/IDEAFilter.R | 15 ++++++++------- 1 file changed, 8 insertions(+), 7 deletions(-) diff --git a/R/IDEAFilter.R b/R/IDEAFilter.R index 2a95483..cb2a0d4 100644 --- a/R/IDEAFilter.R +++ b/R/IDEAFilter.R @@ -110,13 +110,14 @@ IDEAFilter_ui <- function(id) { #' shinyApp(ui = ui, server = server) #' } #' -IDEAFilter <- function(id, data, ..., verbose = FALSE) { +IDEAFilter <- function(id, data, ..., col_subset = NULL, verbose = FALSE) { moduleServer(id, function(input, output, session) { ns <- session$ns filter_log("calling module", verbose = verbose) data_call <- as.list(sys.call(-7L))$data datar <- if (is.reactive(data)) data else reactive(data) + datar_subset <- if (is.null(col_subset)) datar else reactive(datar()[col_subset]) filter_counter <- 0 next_filter_id <- function() { @@ -126,7 +127,7 @@ IDEAFilter <- function(id, data, ..., verbose = FALSE) { filters <- reactiveVal(c("filter_0")) filter_returns <- list(filter_0 = reactiveValues( - data = datar, + data = datar_subset, code = reactive(TRUE), filters = reactive(list()), remove = NULL)) @@ -148,7 +149,7 @@ IDEAFilter <- function(id, data, ..., verbose = FALSE) { filter_returns[[fid]] <<- IDEAFilter_item( fid, - data = datar, + data = datar_subset, column_name = column_name, filters = filter_returns[[in_fid]]$filters, verbose = verbose) @@ -158,7 +159,7 @@ IDEAFilter <- function(id, data, ..., verbose = FALSE) { columnSelectInput( ns("add_filter_select"), label = NULL, - data = datar, + data = datar_subset, placeholder = "Add Filter", width = "100%") }) @@ -192,7 +193,7 @@ IDEAFilter <- function(id, data, ..., verbose = FALSE) { }) observeEvent(input$add_filter_select, { - if (!input$add_filter_select %in% names(datar())) return() + if (!input$add_filter_select %in% names(datar_subset())) return() filter_log("observing add filter button press", verbose = verbose) update_filter(fid <- next_filter_id(), column_name = input$add_filter_select) @@ -226,7 +227,7 @@ IDEAFilter <- function(id, data, ..., verbose = FALSE) { }) filter_logical <- reactiveVal(TRUE) - observeEvent(datar(), { + observeEvent(datar_subset(), { filter_logical(TRUE) }) code <- reactive({ @@ -235,7 +236,7 @@ IDEAFilter <- function(id, data, ..., verbose = FALSE) { Negate(isTRUE), Map(function(fi) filter_returns[[fi]]$code(), filters())) - filter_logical(if (!length(filter_exprs)) rep(TRUE,nrow(datar())) else Reduce("&", Map(function(x) with(datar(), eval(x)), filter_exprs))) + filter_logical(if (!length(filter_exprs)) rep(TRUE,nrow(datar_subset())) else Reduce("&", Map(function(x) with(datar_subset(), eval(x)), filter_exprs))) Reduce( function(l,r) bquote(.(l) %>% filter(.(r))), From ff438ab54406da1943a2cceae16b8218d9d6b215 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Tue, 8 Aug 2023 15:44:02 -0400 Subject: [PATCH 042/101] Update NEWS --- DESCRIPTION | 2 +- NEWS.md | 1 + 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 1dc31bc..20e6378 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: IDEAFilter Type: Package -Version: 0.1.3.9003 +Version: 0.1.3.9004 Title: Agnostic, Idiomatic Data Filter Module for Shiny Description: When added to an existing shiny app, users may subset any developer-chosen R data.frame on the fly. That is, users are empowered to diff --git a/NEWS.md b/NEWS.md index cf35986..97ba1ad 100644 --- a/NEWS.md +++ b/NEWS.md @@ -2,6 +2,7 @@ * Fix bug that was trying to assign an attribute to a NULL (#15) * Fix bug that was causing inaccurate filtering for `datetime` vectors (#17) * Add new implementation `IDEAFilter()` that uses a more modern implementation and less resources (#22) +* Allow user to restrict filter to a subset of columns (#14) # IDEAFilter 0.1.3 * Cited works of other contributors (`shinyDataFilter` & `SortableJS`) From c59d597e6496fcf40b1f8aaf3d76dfc62a304a01 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Tue, 8 Aug 2023 15:59:02 -0400 Subject: [PATCH 043/101] Update documentation --- R/IDEAFilter.R | 1 + man/IDEAFilter.Rd | 4 +++- 2 files changed, 4 insertions(+), 1 deletion(-) diff --git a/R/IDEAFilter.R b/R/IDEAFilter.R index cb2a0d4..7f1638d 100644 --- a/R/IDEAFilter.R +++ b/R/IDEAFilter.R @@ -46,6 +46,7 @@ IDEAFilter_ui <- function(id) { #' @param data a \code{data.frame} or \code{reactive expression} returning a #' \code{data.frame} to use as the input to the filter module #' @param ... placeholder for inclusion of additional parameters in future development +#' @param col_subset a \code{vector} containing the list of allowable columns to filter on #' @param verbose a \code{logical} value indicating whether or not to print log #' statements out to the console #' diff --git a/man/IDEAFilter.Rd b/man/IDEAFilter.Rd index 0ae5078..f931503 100644 --- a/man/IDEAFilter.Rd +++ b/man/IDEAFilter.Rd @@ -4,7 +4,7 @@ \alias{IDEAFilter} \title{IDEA data filter module server function} \usage{ -IDEAFilter(id, data, ..., verbose = FALSE) +IDEAFilter(id, data, ..., col_subset = NULL, verbose = FALSE) } \arguments{ \item{id}{a module id name} @@ -14,6 +14,8 @@ IDEAFilter(id, data, ..., verbose = FALSE) \item{...}{placeholder for inclusion of additional parameters in future development} +\item{col_subset}{a \code{vector} containing the list of allowable columns to filter on} + \item{verbose}{a \code{logical} value indicating whether or not to print log statements out to the console} } From 4cafa9e6454a6dcceaad6e5f2da08e498d71de50 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Tue, 8 Aug 2023 16:23:03 -0400 Subject: [PATCH 044/101] Use `pillar::type_sum()` instead of `pillar::new_pillar_type()` --- NAMESPACE | 2 +- R/shiny_vector_filter.R | 5 +++-- 2 files changed, 4 insertions(+), 3 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index c36a775..137bdd7 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -44,7 +44,7 @@ importFrom(ggplot2,scale_x_discrete) importFrom(ggplot2,scale_y_continuous) importFrom(ggplot2,theme_void) importFrom(grDevices,rgb) -importFrom(pillar,new_pillar_type) +importFrom(pillar,type_sum) importFrom(purrr,map) importFrom(purrr,reduce) importFrom(shiny,HTML) diff --git a/R/shiny_vector_filter.R b/R/shiny_vector_filter.R index f6d1307..0c6d8c0 100644 --- a/R/shiny_vector_filter.R +++ b/R/shiny_vector_filter.R @@ -125,7 +125,7 @@ shiny_vector_filter.default <- function(data, inputId, ...) { #' #' @return a pillar formatted class name #' -#' @importFrom pillar new_pillar_type +#' @importFrom pillar type_sum #' @keywords internal #' get_dataFilter_class <- function(obj) { @@ -139,5 +139,6 @@ get_dataFilter_class <- function(obj) { if (!length(vf_class)) return("unk") class(obj) <- vf_class - pillar::new_pillar_type(obj)[[1]][1] + type <- pillar::type_sum(obj) + if (length(type) == 0L) "" else type } \ No newline at end of file From e542fae0ca026a29d0ef3b13a129ac00c5c96ac7 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Tue, 8 Aug 2023 16:28:23 -0400 Subject: [PATCH 045/101] Update NEWS --- DESCRIPTION | 2 +- NEWS.md | 1 + 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 20e6378..9c220a7 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: IDEAFilter Type: Package -Version: 0.1.3.9004 +Version: 0.1.3.9005 Title: Agnostic, Idiomatic Data Filter Module for Shiny Description: When added to an existing shiny app, users may subset any developer-chosen R data.frame on the fly. That is, users are empowered to diff --git a/NEWS.md b/NEWS.md index 97ba1ad..88ae34b 100644 --- a/NEWS.md +++ b/NEWS.md @@ -3,6 +3,7 @@ * Fix bug that was causing inaccurate filtering for `datetime` vectors (#17) * Add new implementation `IDEAFilter()` that uses a more modern implementation and less resources (#22) * Allow user to restrict filter to a subset of columns (#14) +* Upgraded `pillar::new_pillar_type()` to `pillar::type_sum()` (#9) # IDEAFilter 0.1.3 * Cited works of other contributors (`shinyDataFilter` & `SortableJS`) From a25f48cdb776373b8f873402553a4c4e3388ece8 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Wed, 9 Aug 2023 09:58:05 -0400 Subject: [PATCH 046/101] Fix bug with NAs imcorrectly displaying --- R/IDEAFilter_item.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/IDEAFilter_item.R b/R/IDEAFilter_item.R index 2f4a6e5..e69c7e1 100644 --- a/R/IDEAFilter_item.R +++ b/R/IDEAFilter_item.R @@ -159,7 +159,7 @@ IDEAFilter_item <- function(id, data, column_name = NULL, filters = list(), ..., vec <- shiny::reactive({ if (is.null(module_return$column_name) || !(module_return$column_name %in% names(data()))) NULL - else data()[filter_logical(), module_return$column_name, drop = TRUE] + else subset(data(), filter_logical(), module_return$column_name, drop = TRUE) }) shiny::observeEvent(input$column_select, { From fafe952dbe4e8939ac5a9a101c56c75f492386f3 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Wed, 9 Aug 2023 13:51:06 -0400 Subject: [PATCH 047/101] Fix issue where `IDEAFilter()` was pointing to `shiny_data_filter_item_ui()` --- R/IDEAFilter.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/IDEAFilter.R b/R/IDEAFilter.R index f29946e..9c5fa4c 100644 --- a/R/IDEAFilter.R +++ b/R/IDEAFilter.R @@ -173,7 +173,7 @@ IDEAFilter <- function(id, data, ..., col_subset = NULL, preselection = NULL, ve insertUI( selector = sprintf("#%s", ns("sortableList")), where = "beforeEnd", - ui = shiny_data_filter_item_ui(ns(fid), verbose = verbose)) + ui = IDEAFilter_item_ui(ns(fid))) updateSelectInput(session, "add_filter_select", selected = "") } From 0a959d68f785efb3c9f2f0e00f68fb29d16c0037 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Wed, 9 Aug 2023 13:51:33 -0400 Subject: [PATCH 048/101] Simplify `code()` reactive in `IDEAFilter()` --- R/IDEAFilter.R | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/R/IDEAFilter.R b/R/IDEAFilter.R index 9c5fa4c..8691a86 100644 --- a/R/IDEAFilter.R +++ b/R/IDEAFilter.R @@ -285,9 +285,7 @@ IDEAFilter <- function(id, data, ..., col_subset = NULL, preselection = NULL, ve }) code <- reactive({ filter_log("building code", verbose = verbose) - filter_exprs <- Filter( - Negate(isTRUE), - Map(function(fi) filter_returns[[fi]]$code(), filters())) + filter_exprs <- filter_returns[[utils::tail(filters(), 1)]]$filters() filter_logical(if (!length(filter_exprs)) rep(TRUE,nrow(datar_subset())) else Reduce("&", Map(function(x) with(datar_subset(), eval(x)), filter_exprs))) From 3de74d30a102ea408bb1d6e84ca13950ba191eba Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Wed, 9 Aug 2023 13:51:48 -0400 Subject: [PATCH 049/101] Add test for pre-selection --- tests/shinytest/shinytest_preselection/app.R | 47 ++++++++++++++++++++ tests/testthat/test_preselection.R | 31 +++++++++++++ 2 files changed, 78 insertions(+) create mode 100644 tests/shinytest/shinytest_preselection/app.R create mode 100644 tests/testthat/test_preselection.R diff --git a/tests/shinytest/shinytest_preselection/app.R b/tests/shinytest/shinytest_preselection/app.R new file mode 100644 index 0000000..bed490f --- /dev/null +++ b/tests/shinytest/shinytest_preselection/app.R @@ -0,0 +1,47 @@ +ui <- fluidPage( + titlePanel("Filter Data Example"), + fluidRow( + column(8, + selectInput("filter_select", NULL, choices = c("filter_1", "filter_2")), + verbatimTextOutput("data_summary"), + verbatimTextOutput("data_filter_code")), + column(4, IDEAFilter::IDEAFilter_ui("data_filter")))) + +srv <- function(input, output, session) { + + preselection <- reactiveVal(list(Ozone = list(filter_na = TRUE, filter_fn = ~ .x >= 30), + Solar = list(filter_fn = ~ .x > 100), + Month = list(filter_fn = ~ .x == 9))) + + observeEvent(input$filter_select, { + if (input$filter_select == "filter_1") + preselection(list(Ozone = list(filter_na = TRUE, filter_fn = ~ .x >= 30), + Solar = list(filter_fn = ~ .x > 100), + Month = list(filter_fn = ~ .x == 9))) + else + preselection(list(Ozone = list(filter_fn = ~ .x >= 30 & .x <= 90), + Wind = list(filter_fn = ~.x >= 5 & .x <= 10))) + }) + +filtered_data <- IDEAFilter::IDEAFilter( + "data_filter", + data = airquality, + preselection = preselection, + verbose = FALSE) + + output$data_filter_code <- renderPrint({ + cat(gsub("%>%", "%>% \n ", + gsub("\\s{2,}", " ", + paste0( + capture.output(attr(filtered_data(), "code")), + collapse = " ")) + )) + }) + + output$data_summary <- renderPrint({ + if (nrow(filtered_data())) show(filtered_data()) + else "No data available" + }) +} + +shinyApp(ui, srv) diff --git a/tests/testthat/test_preselection.R b/tests/testthat/test_preselection.R new file mode 100644 index 0000000..2eca1ab --- /dev/null +++ b/tests/testthat/test_preselection.R @@ -0,0 +1,31 @@ +context("test_preselection") +skip_on_cran() + +app_path <- IDEAFilter:::shinytest_path("shinytest_preselection") +app <- shinytest2::AppDriver$new(app_path) + +app$wait_for_idle() + +test_that("test that a new filter item has been added", { + expect_true(!"data_filter-filter_2-column_select" %in% lapply(app$get_values(), names)$input) +}) + +test_that("test that a new filter item has been added", { + expect_equal( + app$get_value(output = "data_summary"), + renderPrint(subset(airquality, Ozone >= 30 & Month == 9))()) +}) + +app$set_inputs(filter_select = "filter_2") +app$wait_for_idle() + +test_that("test that nrow reactive value is accurate", { + expect_equal( + app$get_value(output = "data_summary"), + renderPrint(subset(airquality, + (is.na(Ozone) | (Ozone >= 30 & Ozone <= 90)) & + (is.na(Wind) | (Wind >= 5 & Wind <= 10)) + ))()) +}) + +app$stop() From 770555b14f765d185a903b436b5a020bfc4b87f5 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Wed, 9 Aug 2023 13:52:10 -0400 Subject: [PATCH 050/101] Increment version number --- DESCRIPTION | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 0663f8a..034716f 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,10 +1,6 @@ Package: IDEAFilter Type: Package -<<<<<<< HEAD -Version: 0.1.3.9004 -======= -Version: 0.1.3.9005 ->>>>>>> 27ec96320f587a51c32e97bdedf9cdd596efd6b0 +Version: 0.1.3.9006 Title: Agnostic, Idiomatic Data Filter Module for Shiny Description: When added to an existing shiny app, users may subset any developer-chosen R data.frame on the fly. That is, users are empowered to From 8231cc8ebd64b762107eb92e59efa8dff7fa4941 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Thu, 10 Aug 2023 07:53:36 -0400 Subject: [PATCH 051/101] Initialize vignettes --- DESCRIPTION | 1 + vignettes/.gitignore | 2 ++ vignettes/IDEAFilter.Rmd | 23 +++++++++++++++++++++++ 3 files changed, 26 insertions(+) create mode 100644 vignettes/.gitignore create mode 100644 vignettes/IDEAFilter.Rmd diff --git a/DESCRIPTION b/DESCRIPTION index 034716f..52c9450 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -55,3 +55,4 @@ Suggests: spelling, testthat Language: en-US +VignetteBuilder: knitr diff --git a/vignettes/.gitignore b/vignettes/.gitignore new file mode 100644 index 0000000..097b241 --- /dev/null +++ b/vignettes/.gitignore @@ -0,0 +1,2 @@ +*.html +*.R diff --git a/vignettes/IDEAFilter.Rmd b/vignettes/IDEAFilter.Rmd new file mode 100644 index 0000000..e8d7779 --- /dev/null +++ b/vignettes/IDEAFilter.Rmd @@ -0,0 +1,23 @@ +--- +title: "Introduction to IDEAFilter" +output: rmarkdown::html_vignette +vignette: > + %\VignetteIndexEntry{Introduction to IDEAFilter} + %\VignetteEngine{knitr::rmarkdown} + %\VignetteEncoding{UTF-8} +--- + +```{r, include = FALSE} +knitr::opts_chunk$set( + collapse = TRUE, + comment = "#>" +) +``` + +```{r setup} +library(IDEAFilter) +``` + +When exploring data in a Shiny application, one may want to look at a subset of the data. Oftentimes, you as the developer will restrict this filtering by design based on the specifications of your app. But what if you need to let the user filter on the fields of their choice? Or what if the data set the user will be exploring does not have a stable structure? + +In this situation you need a filtering structure that is not constrained to a specific data set but can also be understood by users. The IDEAFilter package can help you solve your problem by providing an agnostic and idiomatic data filter module to be used in your application. \ No newline at end of file From 3c5b24de50d2ba2069d914bb904510f671578021 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Mon, 14 Aug 2023 14:45:20 -0400 Subject: [PATCH 052/101] Don't reinitialize modules on resort --- R/IDEAFilter.R | 21 ++++++++++----------- R/IDEAFilter_item.R | 10 +++++----- 2 files changed, 15 insertions(+), 16 deletions(-) diff --git a/R/IDEAFilter.R b/R/IDEAFilter.R index 8691a86..b0b3fa0 100644 --- a/R/IDEAFilter.R +++ b/R/IDEAFilter.R @@ -131,7 +131,7 @@ IDEAFilter <- function(id, data, ..., col_subset = NULL, preselection = NULL, ve filters <- reactiveVal(c("filter_0")) filter_returns <- list(filter_0 = reactiveValues( data = datar_subset, - code = reactive(TRUE), + pre_filters = reactive(list()), filters = reactive(list()), remove = NULL)) @@ -146,17 +146,16 @@ IDEAFilter <- function(id, data, ..., col_subset = NULL, preselection = NULL, ve stop('no known filter for inbound filter id.') if (fid %in% names(filter_returns)) { - column_name <- filter_returns[[fid]]$column_name - filter_returns[[fid]]$destroy + filter_returns[[fid]]$pre_filters <- filter_returns[[in_fid]]$filters + } else { + filter_returns[[fid]] <<- IDEAFilter_item( + fid, + data = datar_subset, + column_name = column_name, + filters = filter_returns[[in_fid]]$filters, + preselection = preselection, + verbose = verbose) } - - filter_returns[[fid]] <<- IDEAFilter_item( - fid, - data = datar_subset, - column_name = column_name, - filters = filter_returns[[in_fid]]$filters, - preselection = preselection, - verbose = verbose) } apply_preselection <- function(preselection = NULL) { diff --git a/R/IDEAFilter_item.R b/R/IDEAFilter_item.R index e69c7e1..fdcd536 100644 --- a/R/IDEAFilter_item.R +++ b/R/IDEAFilter_item.R @@ -56,13 +56,13 @@ IDEAFilter_item <- function(id, data, column_name = NULL, filters = list(), ..., filter_na <- reactiveVal(if ("filter_na" %in% names(preselection)) isTRUE(preselection[["filter_na"]]) else FALSE) module_return <- shiny::reactiveValues( - code = TRUE, + pre_filters = filters, remove = FALSE, filters = filters, column_name = column_name) filter_logical <- reactive({ - if (!length(filters())) rep(TRUE, nrow(data())) else Reduce("&", Map(function(x) with(data(), eval(x)), filters())) + if (!length(module_return$pre_filters())) rep(TRUE, nrow(data())) else Reduce("&", Map(function(x) with(data(), eval(x)), module_return$pre_filters())) }) @@ -145,7 +145,7 @@ IDEAFilter_item <- function(id, data, column_name = NULL, filters = list(), ..., }) output$nrow <- shiny::renderText({ - out_log <- if (isTRUE(module_return$code())) filter_logical() else with(data(), eval(module_return$code())) & filter_logical() + out_log <- if (isTRUE(code())) filter_logical() else with(data(), eval(code())) & filter_logical() sum(out_log, na.rm = TRUE) }) @@ -186,7 +186,7 @@ IDEAFilter_item <- function(id, data, column_name = NULL, filters = list(), ..., verbose = verbose) }) - module_return$code <- shiny::reactive({ + code <- shiny::reactive({ if (is.null(module_return$column_name)) return(TRUE) do.call(substitute, list( @@ -196,7 +196,7 @@ IDEAFilter_item <- function(id, data, column_name = NULL, filters = list(), ..., module_return$filters <- shiny::reactive({ Filter(Negate(isTRUE), - append(filters(), module_return$code())) + append(module_return$pre_filters(), code())) }) module_return From 7854af2a726b999e2cf032c488c01cd005e68691 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Mon, 14 Aug 2023 15:08:46 -0400 Subject: [PATCH 053/101] Repair test for IDEAFilter_item --- tests/shinytest/shinytest_IDEAFilter_item/app.R | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/tests/shinytest/shinytest_IDEAFilter_item/app.R b/tests/shinytest/shinytest_IDEAFilter_item/app.R index 5fb04b9..9434c83 100644 --- a/tests/shinytest/shinytest_IDEAFilter_item/app.R +++ b/tests/shinytest/shinytest_IDEAFilter_item/app.R @@ -12,9 +12,7 @@ srv <- function(input, output, session) { filter_logical <- reactiveVal(TRUE) observe({ - filter_exprs <- Filter( - Negate(isTRUE), - Map(function(fi) filtered_data$code(), filtered_data$filters())) + filter_exprs <- filtered_data$filters() filter_logical(if (!length(filter_exprs)) rep(TRUE,nrow(data)) else Reduce("&", Map(function(x) with(data, eval(x)), filter_exprs))) }) From 59b70b0f880aec82ef32a18a2d9ab9fa03d7426c Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Tue, 15 Aug 2023 09:38:05 -0400 Subject: [PATCH 054/101] Add erase filter selection feature --- NAMESPACE | 1 + R/IDEAFilter_item.R | 10 ++++++++- R/shiny_vector_filter.R | 3 ++- R/shiny_vector_filter_NULL.R | 3 ++- R/shiny_vector_filter_character.R | 4 +++- R/shiny_vector_filter_date.R | 4 +++- R/shiny_vector_filter_datetime.R | 27 ++++++++++++++++++------- R/shiny_vector_filter_factor_few.R | 4 +++- R/shiny_vector_filter_factor_many.R | 4 +++- R/shiny_vector_filter_logical.R | 4 +++- R/shiny_vector_filter_numeric_few.R | 4 +++- R/shiny_vector_filter_numeric_many.R | 4 +++- man/IDEAFilter.Rd | 9 ++++++++- man/shiny_vector_filter_factor_few.Rd | 3 ++- man/shiny_vector_filter_factor_many.Rd | 3 ++- man/shiny_vector_filter_numeric_few.Rd | 3 ++- man/shiny_vector_filter_numeric_many.Rd | 3 ++- 17 files changed, 71 insertions(+), 22 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 0cd7ed6..c055b2d 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -82,6 +82,7 @@ importFrom(shiny,uiOutput) importFrom(shiny,validate) importFrom(shiny,wellPanel) importFrom(shinyTime,timeInput) +importFrom(shinyTime,updateTimeInput) importFrom(stats,density) importFrom(stats,setNames) importFrom(utils,capture.output) diff --git a/R/IDEAFilter_item.R b/R/IDEAFilter_item.R index fdcd536..51d664d 100644 --- a/R/IDEAFilter_item.R +++ b/R/IDEAFilter_item.R @@ -103,7 +103,10 @@ IDEAFilter_item <- function(id, data, column_name = NULL, filters = list(), ..., shiny::span(")")))), shiny::actionLink(ns("remove_filter_btn"), NULL, style = 'float: right;', - shiny::icon("times-circle")) + shiny::icon("times-circle")), + shiny::actionLink(ns("erase_filter_btn"), NULL, + style = 'float: right; margin-right: 10px;', + shiny::icon("eraser")) ), shiny::uiOutput(ns("vector_filter_ui"))) @@ -174,6 +177,10 @@ IDEAFilter_item <- function(id, data, column_name = NULL, filters = list(), ..., module_return$remove <- TRUE }) + observeEvent(input$erase_filter_btn, { + filter_na(FALSE) + }) + vector_module_srv <- shiny::reactive(shiny_vector_filter(vec(), "vec")) vector_module_return <- shiny::reactive({ @@ -183,6 +190,7 @@ IDEAFilter_item <- function(id, data, column_name = NULL, filters = list(), ..., x = vec, filter_na = filter_na, filter_fn = preselection[["filter_fn"]], + erase_filters = reactive(input$erase_filter_btn), verbose = verbose) }) diff --git a/R/shiny_vector_filter.R b/R/shiny_vector_filter.R index f415c2d..6e57ed7 100644 --- a/R/shiny_vector_filter.R +++ b/R/shiny_vector_filter.R @@ -106,7 +106,8 @@ shiny_vector_filter <- function(data, inputId, global = FALSE) { #' @keywords internal shiny_vector_filter.default <- function(data, inputId, ...) { function(input, output, session, x = shiny::reactive(NULL), - filter_na = shiny::reactive(FALSE), filter_fn = NULL, verbose = FALSE) { + filter_na = shiny::reactive(FALSE), filter_fn = NULL, verbose = FALSE, + erase_filters = shiny::reactive(0)) { module_return <- shiny::reactiveValues(code = FALSE, mask = FALSE) module_return$code <- shiny::reactive(FALSE) diff --git a/R/shiny_vector_filter_NULL.R b/R/shiny_vector_filter_NULL.R index 6993cba..2eeb202 100644 --- a/R/shiny_vector_filter_NULL.R +++ b/R/shiny_vector_filter_NULL.R @@ -11,7 +11,8 @@ shiny_vector_filter_ui.NULL = function(data, inputId) { #' @keywords internal shiny_vector_filter.NULL <- function(data, inputId, ...) { function(input, output, session, x = shiny::reactive(NULL), - filter_na = shiny::reactive(FALSE), filter_fn = NULL, verbose = FALSE) { + filter_na = shiny::reactive(FALSE), filter_fn = NULL, verbose = FALSE, + erase_filters = shiny::reactive(0)) { module_return <- shiny::reactiveValues(code = TRUE, mask = TRUE) module_return$code <- shiny::reactive(TRUE) diff --git a/R/shiny_vector_filter_character.R b/R/shiny_vector_filter_character.R index 887e60e..d15097d 100644 --- a/R/shiny_vector_filter_character.R +++ b/R/shiny_vector_filter_character.R @@ -11,7 +11,8 @@ shiny_vector_filter_ui.character <- function(data, inputId) { #' @keywords internal shiny_vector_filter.character <- function(data, inputId, ...) { function(input, output, session, x = shiny::reactive(character()), - filter_na = shiny::reactive(FALSE), filter_fn = NULL, verbose = FALSE) { + filter_na = shiny::reactive(FALSE), filter_fn = NULL, verbose = FALSE, + erase_filters = shiny::reactive(0)) { ns <- session$ns @@ -41,6 +42,7 @@ shiny_vector_filter.character <- function(data, inputId, ...) { } }) + observeEvent(erase_filters(), updateSelectizeInput(session, "param", selected = "")) module_return$code <- shiny::reactive({ if (length(input$param)) diff --git a/R/shiny_vector_filter_date.R b/R/shiny_vector_filter_date.R index bf5688d..57b12ed 100644 --- a/R/shiny_vector_filter_date.R +++ b/R/shiny_vector_filter_date.R @@ -12,7 +12,8 @@ shiny_vector_filter_ui.Date <- function(data, inputId) { #' @keywords internal shiny_vector_filter.Date <- function(data, inputId, ...) { function(input, output, session, x = shiny::reactive(Date()), - filter_na = shiny::reactive(FALSE), filter_fn = NULL, verbose = FALSE) { + filter_na = shiny::reactive(FALSE), filter_fn = NULL, verbose = FALSE, + erase_filters = shiny::reactive(0)) { ns <- session$ns module_return <- shiny::reactiveValues(code = TRUE, mask = TRUE) @@ -44,6 +45,7 @@ shiny_vector_filter.Date <- function(data, inputId, ...) { shiny::tags$h5(shiny::tags$i("no numeric values"))) }) }) + observeEvent(erase_filters(), updateDateRangeInput(session, "param", start = min(x(), na.rm = TRUE), end = max(x(), na.rm = TRUE))) module_return$code <- shiny::reactive({ exprs <- list() diff --git a/R/shiny_vector_filter_datetime.R b/R/shiny_vector_filter_datetime.R index 0bd7fb2..1a6e4bb 100644 --- a/R/shiny_vector_filter_datetime.R +++ b/R/shiny_vector_filter_datetime.R @@ -1,4 +1,4 @@ -#' @importFrom shinyTime timeInput +#' @importFrom shinyTime timeInput updateTimeInput #' @importFrom shiny NS uiOutput #' @export #' @keywords internal @@ -12,7 +12,8 @@ shiny_vector_filter_ui.POSIXct <- function(data, inputId) { #' @keywords internal shiny_vector_filter.POSIXct <- function(data, inputId, ...) { function(input, output, session, x = shiny::reactive(), - filter_na = shiny::reactive(FALSE), filter_fn = NULL, verbose = FALSE) { + filter_na = shiny::reactive(FALSE), filter_fn = NULL, verbose = FALSE, + erase_filters = shiny::reactive(0)) { ns <- session$ns module_return <- shiny::reactiveValues(code = TRUE, mask = TRUE) @@ -20,7 +21,7 @@ shiny_vector_filter.POSIXct <- function(data, inputId, ...) { x_filtered <- Filter(function(x) !is.na(x) & fn(x), x()) - tzone <- reactive(attr(x(), "tzone")) + tzone <- reactive(attr(x(), "tzone") %||% "") output$ui <- shiny::renderUI({ filter_log("updating ui", verbose = verbose) @@ -34,17 +35,21 @@ shiny_vector_filter.POSIXct <- function(data, inputId, ...) { transform-origin: bottom;"), if (any(!is.na(x()))) { my_date <- as.Date(x()) + my_min_date <- if (is.null(isolate(input$st_date))) NULL else max(isolate(input$st_date), min(my_date, na.rm = TRUE)) + my_min_time <- if (is.null(isolate(input$st_time))) NULL else max(isolate(st_dt()), min(x(), na.rm = TRUE)) + my_max_date <- if (is.null(isolate(input$end_date))) NULL else min(isolate(input$end_date), max(my_date, na.rm = TRUE)) + my_max_time <- if (is.null(isolate(input$end_time))) NULL else min(isolate(end_dt()), max(x(), na.rm = TRUE)) div( div(style = "display: inline-block; vertical-align:middle;", - shiny::dateInput(ns("st_date"), "Start Date", value = isolate(input$st_date) %||% min(as.Date(x_filtered)) + shiny::dateInput(ns("st_date"), "Start Date", value = my_min_date %||% min(as.Date(x_filtered)) , min = min(my_date, na.rm = TRUE), max = max(my_date, na.rm = TRUE)), - shinyTime::timeInput(ns("st_time"), "Start Time (HH:MM:SS)", value = isolate(input$st_time) %||% min(x_filtered))# automatically takes the time element + shinyTime::timeInput(ns("st_time"), "Start Time (HH:MM:SS)", value = my_min_time %||% min(x_filtered))# automatically takes the time element ), div(style = "display: inline-block; vertical-align:middle;", - shiny::dateInput(ns("end_date"), "End Date", value = isolate(input$end_date) %||% max(as.Date(x_filtered)) + shiny::dateInput(ns("end_date"), "End Date", value = my_max_date %||% max(as.Date(x_filtered)) , min = min(my_date, na.rm = TRUE), max = max(my_date, na.rm = TRUE)), - shinyTime::timeInput(ns("end_time"), "End Time (HH:MM:SS)", value = isolate(input$end_time) %||% max(x_filtered)) # automatically takes the time element + shinyTime::timeInput(ns("end_time"), "End Time (HH:MM:SS)", value = my_max_time %||% max(x_filtered)) # automatically takes the time element ) ) } else { @@ -54,6 +59,14 @@ shiny_vector_filter.POSIXct <- function(data, inputId, ...) { }) }) + observeEvent(erase_filters(), { + my_date <- as.Date(x()) + updateDateInput(session, "st_date", value = min(my_date, na.rm = TRUE)) + shinyTime::updateTimeInput(session, "st_time", value = min(x(), na.rm = TRUE)) + updateDateInput(session, "end_date", value = max(my_date, na.rm = TRUE)) + shinyTime::updateTimeInput(session, "end_time", value = max(x(), na.rm = TRUE)) + }) + st_dt <- reactive({ st <- substr(strftime(input$st_time, "%Y-%m-%d %H:%M:%S", tz = tzone()),12,20) as.POSIXct(paste(input$st_date, st), tz = tzone()) diff --git a/R/shiny_vector_filter_factor_few.R b/R/shiny_vector_filter_factor_few.R index a78ec26..c009184 100644 --- a/R/shiny_vector_filter_factor_few.R +++ b/R/shiny_vector_filter_factor_few.R @@ -28,7 +28,8 @@ #' @keywords internal shiny_vector_filter_factor_few <- function(input, output, session, x = shiny::reactive(factor()), filter_na = shiny::reactive(TRUE), filter_fn = NULL, - verbose = FALSE) { + verbose = FALSE, + erase_filters = shiny::reactive(0)) { ns <- session$ns @@ -56,6 +57,7 @@ shiny_vector_filter_factor_few <- function(input, output, session, selected = isolate(input$param) %||% x_filtered, width = "100%")) }) + observeEvent(erase_filters(), updateCheckboxGroupInput(session, "param", selected = "")) # Normalized # ggplot2::ggplot() + diff --git a/R/shiny_vector_filter_factor_many.R b/R/shiny_vector_filter_factor_many.R index 9d861eb..96aef0c 100644 --- a/R/shiny_vector_filter_factor_many.R +++ b/R/shiny_vector_filter_factor_many.R @@ -24,7 +24,8 @@ #' @keywords internal shiny_vector_filter_factor_many <- function(input, output, session, x = shiny::reactive(factor()), filter_na = shiny::reactive(FALSE), filter_fn = NULL, - verbose = FALSE) { + verbose = FALSE, + erase_filters = shiny::reactive(0)) { ns <- session$ns @@ -42,6 +43,7 @@ shiny_vector_filter_factor_many <- function(input, output, session, multiple = TRUE, width = "100%") }) + observeEvent(erase_filters(), updateSelectizeInput(session, "param", selected = "")) module_return$code <- shiny::reactive({ if (length(input$param)) diff --git a/R/shiny_vector_filter_logical.R b/R/shiny_vector_filter_logical.R index c8bcf1d..aefa9fb 100644 --- a/R/shiny_vector_filter_logical.R +++ b/R/shiny_vector_filter_logical.R @@ -13,7 +13,8 @@ shiny_vector_filter_ui.logical <- function(data, inputId) { shiny_vector_filter.logical <- function(data, inputId, ...) { function(input, output, session, x = shiny::reactive(logical()), filter_na = shiny::reactive(TRUE), filter_fn = NULL, - verbose = FALSE) { + verbose = FALSE, + erase_filters = shiny::reactive(0)) { ns <- session$ns @@ -44,6 +45,7 @@ shiny_vector_filter.logical <- function(data, inputId, ...) { selected = isolate(input$param) %||% filter_selected, width = "100%")) }) + observeEvent(erase_filters(), updateCheckboxGroupInput(session, "param", selected = "")) module_return$code <- shiny::reactive({ exprs <- list() diff --git a/R/shiny_vector_filter_numeric_few.R b/R/shiny_vector_filter_numeric_few.R index a3c9fa0..d203963 100644 --- a/R/shiny_vector_filter_numeric_few.R +++ b/R/shiny_vector_filter_numeric_few.R @@ -29,7 +29,8 @@ #' @keywords internal shiny_vector_filter_numeric_few <- function(input, output, session, x = shiny::reactive(factor()), #important: changed x to factor here - filter_na = shiny::reactive(FALSE), filter_fn = NULL, verbose = FALSE) { + filter_na = shiny::reactive(FALSE), filter_fn = NULL, verbose = FALSE, + erase_filters = shiny::reactive(0)) { ns <- session$ns @@ -57,6 +58,7 @@ shiny_vector_filter_numeric_few <- function(input, output, session, selected = isolate(input$param) %||% x_filtered, width = "100%")) }) + observeEvent(erase_filters(), updateCheckboxGroupInput(session, "param", selected = "")) # Normalized # ggplot2::ggplot() + diff --git a/R/shiny_vector_filter_numeric_many.R b/R/shiny_vector_filter_numeric_many.R index cb16c8e..7df1c81 100644 --- a/R/shiny_vector_filter_numeric_many.R +++ b/R/shiny_vector_filter_numeric_many.R @@ -29,7 +29,8 @@ #' @export #' @keywords internal shiny_vector_filter_numeric_many <- function(input, output, session, x = shiny::reactive(numeric()), - filter_na = shiny::reactive(FALSE), filter_fn = NULL, verbose = FALSE) { + filter_na = shiny::reactive(FALSE), filter_fn = NULL, verbose = FALSE, + erase_filters = shiny::reactive(0)) { ns <- session$ns module_return <- shiny::reactiveValues(code = TRUE, mask = TRUE) @@ -57,6 +58,7 @@ shiny_vector_filter_numeric_many <- function(input, output, session, x = shiny:: shiny::tags$h5(shiny::tags$i("no numeric values"))) }) }) + observeEvent(erase_filters(), updateSliderInput(session, "param", value = range(x(), na.rm = TRUE))) module_return$code <- shiny::reactive({ exprs <- list() diff --git a/man/IDEAFilter.Rd b/man/IDEAFilter.Rd index a7366e8..ab31f28 100644 --- a/man/IDEAFilter.Rd +++ b/man/IDEAFilter.Rd @@ -4,7 +4,14 @@ \alias{IDEAFilter} \title{IDEA data filter module server function} \usage{ -IDEAFilter(id, data, ..., col_subset = NULL, preselection = NULL, verbose = FALSE) +IDEAFilter( + id, + data, + ..., + col_subset = NULL, + preselection = NULL, + verbose = FALSE +) } \arguments{ \item{id}{a module id name} diff --git a/man/shiny_vector_filter_factor_few.Rd b/man/shiny_vector_filter_factor_few.Rd index b97875f..b02ff0b 100644 --- a/man/shiny_vector_filter_factor_few.Rd +++ b/man/shiny_vector_filter_factor_few.Rd @@ -11,7 +11,8 @@ shiny_vector_filter_factor_few( x = shiny::reactive(factor()), filter_na = shiny::reactive(TRUE), filter_fn = NULL, - verbose = FALSE + verbose = FALSE, + erase_filters = shiny::reactive(0) ) } \arguments{ diff --git a/man/shiny_vector_filter_factor_many.Rd b/man/shiny_vector_filter_factor_many.Rd index 9fe7715..952ad80 100644 --- a/man/shiny_vector_filter_factor_many.Rd +++ b/man/shiny_vector_filter_factor_many.Rd @@ -11,7 +11,8 @@ shiny_vector_filter_factor_many( x = shiny::reactive(factor()), filter_na = shiny::reactive(FALSE), filter_fn = NULL, - verbose = FALSE + verbose = FALSE, + erase_filters = shiny::reactive(0) ) } \arguments{ diff --git a/man/shiny_vector_filter_numeric_few.Rd b/man/shiny_vector_filter_numeric_few.Rd index 303848c..6c11fd8 100644 --- a/man/shiny_vector_filter_numeric_few.Rd +++ b/man/shiny_vector_filter_numeric_few.Rd @@ -11,7 +11,8 @@ shiny_vector_filter_numeric_few( x = shiny::reactive(factor()), filter_na = shiny::reactive(FALSE), filter_fn = NULL, - verbose = FALSE + verbose = FALSE, + erase_filters = shiny::reactive(0) ) } \arguments{ diff --git a/man/shiny_vector_filter_numeric_many.Rd b/man/shiny_vector_filter_numeric_many.Rd index 2d54e65..8d8d169 100644 --- a/man/shiny_vector_filter_numeric_many.Rd +++ b/man/shiny_vector_filter_numeric_many.Rd @@ -11,7 +11,8 @@ shiny_vector_filter_numeric_many( x = shiny::reactive(numeric()), filter_na = shiny::reactive(FALSE), filter_fn = NULL, - verbose = FALSE + verbose = FALSE, + erase_filters = shiny::reactive(0) ) } \arguments{ From 2c6e9bdd95cfb4c9f9871365c6e0cacf89a458ad Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Wed, 16 Aug 2023 08:25:14 -0400 Subject: [PATCH 055/101] Remove inputs when exiting module --- R/IDEAFilter_item.R | 2 ++ R/shiny_data_filter_item.R | 1 + R/shiny_vector_filter_date.R | 7 ++++--- R/utils.R | 9 +++++++++ 4 files changed, 16 insertions(+), 3 deletions(-) diff --git a/R/IDEAFilter_item.R b/R/IDEAFilter_item.R index 51d664d..fc94d0a 100644 --- a/R/IDEAFilter_item.R +++ b/R/IDEAFilter_item.R @@ -171,10 +171,12 @@ IDEAFilter_item <- function(id, data, column_name = NULL, filters = list(), ..., shiny::observeEvent(input$column_select_edit_btn, { module_return$column_name <- NULL + remove_shiny_inputs("vector_filter", input, ns = ns) }) shiny::observeEvent(input$remove_filter_btn, { module_return$remove <- TRUE + remove_shiny_inputs("vector_filter", input, ns = ns) }) observeEvent(input$erase_filter_btn, { diff --git a/R/shiny_data_filter_item.R b/R/shiny_data_filter_item.R index 003bd30..1517225 100644 --- a/R/shiny_data_filter_item.R +++ b/R/shiny_data_filter_item.R @@ -169,6 +169,7 @@ shiny_data_filter_item <- function(input, output, session, data, shiny::observeEvent(input$remove_filter_btn, { module_return$remove <- TRUE + remove_shiny_inputs("vector_filter", input, ns = ns) }) vector_module_srv <- shiny::reactive(shiny_vector_filter(vec(), "vec")) diff --git a/R/shiny_vector_filter_date.R b/R/shiny_vector_filter_date.R index 57b12ed..eae0c7e 100644 --- a/R/shiny_vector_filter_date.R +++ b/R/shiny_vector_filter_date.R @@ -32,10 +32,11 @@ shiny_vector_filter.Date <- function(data, inputId, ...) { 0.5s ease-in 0s 1 shinyDataFilterFadeIn; transform-origin: bottom;"), if (any(!is.na(x()))) { + my_min_date <- if (is.null(isolate(input$param))) NULL else max(isolate(input$param[[1]]), min(x(), na.rm = TRUE)) + my_max_date <- if (is.null(isolate(input$param))) NULL else min(isolate(input$param[[2]]), max(x(), na.rm = TRUE)) shiny::dateRangeInput(ns("param"), NULL, - #value = shiny::isolate(input$param) %||% range(x(), na.rm = TRUE), - start = isolate(input$param[[1]]) %||% min(x_filtered), - end = isolate(input$param[[2]]) %||% max(x_filtered), + start = my_min_date %||% min(x_filtered), + end = my_max_date %||% max(x_filtered), min = min(x(), na.rm = TRUE), max = max(x(), na.rm = TRUE) ) diff --git a/R/utils.R b/R/utils.R index 9bdeded..04a2c28 100644 --- a/R/utils.R +++ b/R/utils.R @@ -150,3 +150,12 @@ strip_leading_ws <- function(txt, simplify = TRUE) { is.empty <- function(x) { identical("", x) } + +remove_shiny_inputs <- function(id, .input, ns = NS(NULL)) { + invisible( + lapply(grep(id, names(.input), value = TRUE), function(i) { + .subset2(.input, "impl")$.values$remove(ns(i)) + }) + ) +} + From de0cc04ae4d92886f87f48985db46a89a8b44718 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Wed, 16 Aug 2023 08:26:09 -0400 Subject: [PATCH 056/101] Remove observers when exiting vector module --- R/IDEAFilter_item.R | 2 ++ R/shiny_data_filter_item.R | 1 + R/shiny_vector_filter_character.R | 3 ++- R/shiny_vector_filter_date.R | 3 ++- R/shiny_vector_filter_datetime.R | 3 ++- R/shiny_vector_filter_factor_few.R | 3 ++- R/shiny_vector_filter_factor_many.R | 3 ++- R/shiny_vector_filter_logical.R | 3 ++- R/shiny_vector_filter_numeric_few.R | 3 ++- R/shiny_vector_filter_numeric_many.R | 3 ++- 10 files changed, 19 insertions(+), 8 deletions(-) diff --git a/R/IDEAFilter_item.R b/R/IDEAFilter_item.R index fc94d0a..ac6a9ea 100644 --- a/R/IDEAFilter_item.R +++ b/R/IDEAFilter_item.R @@ -172,11 +172,13 @@ IDEAFilter_item <- function(id, data, column_name = NULL, filters = list(), ..., shiny::observeEvent(input$column_select_edit_btn, { module_return$column_name <- NULL remove_shiny_inputs("vector_filter", input, ns = ns) + session$userData$eraser_observer$destroy() }) shiny::observeEvent(input$remove_filter_btn, { module_return$remove <- TRUE remove_shiny_inputs("vector_filter", input, ns = ns) + session$userData$eraser_observer$destroy() }) observeEvent(input$erase_filter_btn, { diff --git a/R/shiny_data_filter_item.R b/R/shiny_data_filter_item.R index 1517225..347de30 100644 --- a/R/shiny_data_filter_item.R +++ b/R/shiny_data_filter_item.R @@ -170,6 +170,7 @@ shiny_data_filter_item <- function(input, output, session, data, shiny::observeEvent(input$remove_filter_btn, { module_return$remove <- TRUE remove_shiny_inputs("vector_filter", input, ns = ns) + session$userData$eraser_observer$destroy() }) vector_module_srv <- shiny::reactive(shiny_vector_filter(vec(), "vec")) diff --git a/R/shiny_vector_filter_character.R b/R/shiny_vector_filter_character.R index d15097d..4fe73f8 100644 --- a/R/shiny_vector_filter_character.R +++ b/R/shiny_vector_filter_character.R @@ -42,7 +42,8 @@ shiny_vector_filter.character <- function(data, inputId, ...) { } }) - observeEvent(erase_filters(), updateSelectizeInput(session, "param", selected = "")) + session$userData$eraser_observer <- + observeEvent(erase_filters(), updateSelectizeInput(session, "param", selected = "")) module_return$code <- shiny::reactive({ if (length(input$param)) diff --git a/R/shiny_vector_filter_date.R b/R/shiny_vector_filter_date.R index eae0c7e..fe6699b 100644 --- a/R/shiny_vector_filter_date.R +++ b/R/shiny_vector_filter_date.R @@ -46,7 +46,8 @@ shiny_vector_filter.Date <- function(data, inputId, ...) { shiny::tags$h5(shiny::tags$i("no numeric values"))) }) }) - observeEvent(erase_filters(), updateDateRangeInput(session, "param", start = min(x(), na.rm = TRUE), end = max(x(), na.rm = TRUE))) + session$userData$eraser_observer <- + observeEvent(erase_filters(), updateDateRangeInput(session, "param", start = min(x(), na.rm = TRUE), end = max(x(), na.rm = TRUE))) module_return$code <- shiny::reactive({ exprs <- list() diff --git a/R/shiny_vector_filter_datetime.R b/R/shiny_vector_filter_datetime.R index 1a6e4bb..be8b604 100644 --- a/R/shiny_vector_filter_datetime.R +++ b/R/shiny_vector_filter_datetime.R @@ -59,7 +59,8 @@ shiny_vector_filter.POSIXct <- function(data, inputId, ...) { }) }) - observeEvent(erase_filters(), { + session$userData$eraser_observer <- + observeEvent(erase_filters(), { my_date <- as.Date(x()) updateDateInput(session, "st_date", value = min(my_date, na.rm = TRUE)) shinyTime::updateTimeInput(session, "st_time", value = min(x(), na.rm = TRUE)) diff --git a/R/shiny_vector_filter_factor_few.R b/R/shiny_vector_filter_factor_few.R index c009184..e2e6951 100644 --- a/R/shiny_vector_filter_factor_few.R +++ b/R/shiny_vector_filter_factor_few.R @@ -57,7 +57,8 @@ shiny_vector_filter_factor_few <- function(input, output, session, selected = isolate(input$param) %||% x_filtered, width = "100%")) }) - observeEvent(erase_filters(), updateCheckboxGroupInput(session, "param", selected = "")) + session$userData$eraser_observer <- + observeEvent(erase_filters(), updateCheckboxGroupInput(session, "param", selected = "")) # Normalized # ggplot2::ggplot() + diff --git a/R/shiny_vector_filter_factor_many.R b/R/shiny_vector_filter_factor_many.R index 96aef0c..a9a08e4 100644 --- a/R/shiny_vector_filter_factor_many.R +++ b/R/shiny_vector_filter_factor_many.R @@ -43,7 +43,8 @@ shiny_vector_filter_factor_many <- function(input, output, session, multiple = TRUE, width = "100%") }) - observeEvent(erase_filters(), updateSelectizeInput(session, "param", selected = "")) + session$userData$eraser_observer <- + observeEvent(erase_filters(), updateSelectizeInput(session, "param", selected = "")) module_return$code <- shiny::reactive({ if (length(input$param)) diff --git a/R/shiny_vector_filter_logical.R b/R/shiny_vector_filter_logical.R index aefa9fb..53f4fe6 100644 --- a/R/shiny_vector_filter_logical.R +++ b/R/shiny_vector_filter_logical.R @@ -45,7 +45,8 @@ shiny_vector_filter.logical <- function(data, inputId, ...) { selected = isolate(input$param) %||% filter_selected, width = "100%")) }) - observeEvent(erase_filters(), updateCheckboxGroupInput(session, "param", selected = "")) + session$userData$eraser_observer <- + observeEvent(erase_filters(), updateCheckboxGroupInput(session, "param", selected = "")) module_return$code <- shiny::reactive({ exprs <- list() diff --git a/R/shiny_vector_filter_numeric_few.R b/R/shiny_vector_filter_numeric_few.R index d203963..e41f130 100644 --- a/R/shiny_vector_filter_numeric_few.R +++ b/R/shiny_vector_filter_numeric_few.R @@ -58,7 +58,8 @@ shiny_vector_filter_numeric_few <- function(input, output, session, selected = isolate(input$param) %||% x_filtered, width = "100%")) }) - observeEvent(erase_filters(), updateCheckboxGroupInput(session, "param", selected = "")) + session$userData$eraser_observer <- + observeEvent(erase_filters(), updateCheckboxGroupInput(session, "param", selected = "")) # Normalized # ggplot2::ggplot() + diff --git a/R/shiny_vector_filter_numeric_many.R b/R/shiny_vector_filter_numeric_many.R index 7df1c81..d4461b2 100644 --- a/R/shiny_vector_filter_numeric_many.R +++ b/R/shiny_vector_filter_numeric_many.R @@ -58,7 +58,8 @@ shiny_vector_filter_numeric_many <- function(input, output, session, x = shiny:: shiny::tags$h5(shiny::tags$i("no numeric values"))) }) }) - observeEvent(erase_filters(), updateSliderInput(session, "param", value = range(x(), na.rm = TRUE))) + session$userData$eraser_observer <- + observeEvent(erase_filters(), updateSliderInput(session, "param", value = range(x(), na.rm = TRUE))) module_return$code <- shiny::reactive({ exprs <- list() From 34ea8c154dab33a572db5e1f02c2cca68157e5a4 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Wed, 16 Aug 2023 08:26:24 -0400 Subject: [PATCH 057/101] Increment version number --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 034716f..68137b3 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: IDEAFilter Type: Package -Version: 0.1.3.9006 +Version: 0.1.3.9007 Title: Agnostic, Idiomatic Data Filter Module for Shiny Description: When added to an existing shiny app, users may subset any developer-chosen R data.frame on the fly. That is, users are empowered to From b9e1bec3e13257ffb1943def86601e6835eefdc1 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Wed, 16 Aug 2023 08:30:54 -0400 Subject: [PATCH 058/101] Add data to test data types --- .Rbuildignore | 1 + DESCRIPTION | 2 ++ R/sysdata.rda | Bin 0 -> 1861 bytes data-raw/internal-data.R | 17 ++++++++++++ tests/shinytest/shinytest_data_types/app.R | 30 +++++++++++++++++++++ 5 files changed, 50 insertions(+) create mode 100644 R/sysdata.rda create mode 100644 data-raw/internal-data.R create mode 100644 tests/shinytest/shinytest_data_types/app.R diff --git a/.Rbuildignore b/.Rbuildignore index 8301922..fdb200e 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -12,3 +12,4 @@ cran-comments.md ^pkgdown$ ^cran-comments\.md$ ^CRAN-RELEASE$ +^data-raw$ diff --git a/DESCRIPTION b/DESCRIPTION index 68137b3..89a9e36 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -55,3 +55,5 @@ Suggests: spelling, testthat Language: en-US +Depends: + R (>= 2.10) diff --git a/R/sysdata.rda b/R/sysdata.rda new file mode 100644 index 0000000000000000000000000000000000000000..150b810571b8471227eb1538933292b9465db57e GIT binary patch literal 1861 zcmV-L2fFw|T4*^jL0KkKS#WqakpL4ufB*mg|J|8IU;qFA|M0*6|MkPN0vSOlYz<*i z62qVcK+E6;e_q||&aZGf4hJF50euFFVG)$^B-3g%WM}|1{VC+sc?k5Gp{cbD#Rg3Q z`k5M;s2-ph0009gqLcst08G^XB9)QftTITLP(K44v6upmfK#sEVDO`8bz zl^e7gA)<}Rb5&O&fgGAeP-EwSU|}A)K-G#07;SlxkwscvDqSv@U47mdKoS~60dvj( z7e1A|@i0LcAT8;Fj--gCd-y;QkceRpjNlp&&6r@y04!uIgb_zX1R%hn41fl}uq= z=!ZP*1B&jXEP@2m-bd?e6y_bF{)G0w68D`hHKB!z#7~ zFZLdmR~s|VKzKH_yZwe(fFnSL!XrRBV1j_aS@#eCD;JAWXu`(g_YVnB^Q>BErG)K! zXI&N4y#y~BFE-%Y;o#l%_Rq!HXs~2fRxJ$9!!GR%u9lS3MNuGw001>1CBPT~0U=6) zg-R4vEF};rD2ho%V*?mO2_^&q0UEA%s<1#87pUC8Wk_i?pnxu04kw)FxVk)Ksl$C# z+=FtnKIYpfkZ5W$3VVxvPBHCy^~wl^(w+L$XB=Q_6^6vCTy2HR5w5l+Q`uTwWNt-` zT`)1RdPSxJHL3{dV6?h=7<3(2Un~x*b6PWt&ekCC&8=Kc zi|el`$&#h6NOp$hoh-K(HIPFvHZ|b;Xfk`ns~1eEENeUI93wLwRl(xbg!UbpI^%H7 z>=`}BvW_9*o;y?Sz&-&(t5~ zMIG1Yb@nkSOl?u{sTfM8x(r=cMKVlc)hSeZ>ayobh_RWORD3G2Q)BL~ZcrKHHYIAB z1}naL6>}eznN|_qpw?iRKGdofH0@?_xj37Kgw<3msxGD#wvl@beHo)c*v%Pf%40LE zxcyp1Jj?QJ+EuFi3tb@qIS`#40ILT(N1nFHqVs}^sJImD5j&|c=iAi!eody z>nsno=<=}onferOx%6?N-gfndWDaC#&5(rRN+ZOCkVlfn4>t964mY&dcB4h=zOpvQ z*2BZIlf!~LN_7cgsU zfYTvSkAB;v!Xnfp(D&!5*SHX)sjH7EOx(j1p#Tal(R25W*GXA$zNSoqHMXL>&DNdQ z@LYF*1o~ak9asa6SU72%3nK!;-cIX8T`bWRC!3nh>||Q5AQK+HEPhIED}tZV4;4Y;ysE>2&w2sMpK_wkX?dW@$HoU{_|c;O`KWgPL%D z3Lyk$XaGm1%_k~v8rirJM=G~yx3B`q;pD8l5)08>V34k=Us_%^|#G+?sa7PVU=~O zt@xju2m*pm><|Uk>T7>B<-x$g;zY&aQ?dXe#2EwtBL_CzC;l$vig2MI;P7uEqcu7? literal 0 HcmV?d00001 diff --git a/data-raw/internal-data.R b/data-raw/internal-data.R new file mode 100644 index 0000000..f2ace27 --- /dev/null +++ b/data-raw/internal-data.R @@ -0,0 +1,17 @@ +## code to prepare `internal-data` dataset goes here +set.seed(5000) +vector_data <- + dplyr::tibble( + character = purrr::map_chr(1:50, ~ paste(sample(letters, 5, replace = TRUE), collapse = "")), + date = as.Date("2021-03-02") + floor(50*runif(50, min = -1)), + datetime = as.POSIXct("2021-02-02 11:54:56", format = "%Y-%m-%d %H:%M:%S") + floor((1:50*24*60*60 + runif(50, min = -1)*24*60*60)), + factor_few = as.factor(sample(LETTERS[1:4], 50, replace = TRUE)), + factor_many = as.factor(sample(LETTERS[1:10], 50, replace = TRUE)), + logical = runif(50, min = -1) > 0, + numeric_few = sample(1:5, 50, replace = TRUE), + numeric_many = floor(100*runif(50)), + unknown = purrr::map(1:50, ~ list(A = sample(letters, 5, replace = TRUE), B = sample(LETTERS, 5, replace = TRUE))) + ) +attr(vector_data$datetime, "tzone") <- "UTC" + +usethis::use_data(vector_data, overwrite = TRUE, internal = TRUE) diff --git a/tests/shinytest/shinytest_data_types/app.R b/tests/shinytest/shinytest_data_types/app.R new file mode 100644 index 0000000..83a3c9d --- /dev/null +++ b/tests/shinytest/shinytest_data_types/app.R @@ -0,0 +1,30 @@ +ui <- fluidPage( + titlePanel("Filter Data Example"), + fluidRow( + column(8, + verbatimTextOutput("data_summary"), + verbatimTextOutput("data_filter_code")), + column(4, IDEAFilter_ui("data_filter")))) + +srv <- function(input, output, session) { + filtered_data <- IDEAFilter( + "data_filter", + data = vector_data, + verbose = FALSE) + + output$data_filter_code <- renderPrint({ + cat(gsub("%>%", "%>% \n ", + gsub("\\s{2,}", " ", + paste0( + capture.output(attr(filtered_data(), "code")), + collapse = " ")) + )) + }) + + output$data_summary <- renderPrint({ + if (nrow(filtered_data())) show(filtered_data()) + else "No data available" + }) +} + +shinyApp(ui, srv) \ No newline at end of file From fc1301da58e6f1f1e1d2ff61bffe32b82b0375ff Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Wed, 16 Aug 2023 09:08:17 -0400 Subject: [PATCH 059/101] Fix bug causing the erase filters event to trigger --- R/shiny_vector_filter_character.R | 6 +++++- R/shiny_vector_filter_date.R | 6 +++++- R/shiny_vector_filter_datetime.R | 2 +- R/shiny_vector_filter_factor_few.R | 22 +++++----------------- R/shiny_vector_filter_factor_many.R | 5 ++++- R/shiny_vector_filter_logical.R | 6 +++++- R/shiny_vector_filter_numeric_few.R | 22 +++++----------------- R/shiny_vector_filter_numeric_many.R | 6 +++++- 8 files changed, 35 insertions(+), 40 deletions(-) diff --git a/R/shiny_vector_filter_character.R b/R/shiny_vector_filter_character.R index 4fe73f8..593278c 100644 --- a/R/shiny_vector_filter_character.R +++ b/R/shiny_vector_filter_character.R @@ -43,7 +43,11 @@ shiny_vector_filter.character <- function(data, inputId, ...) { }) session$userData$eraser_observer <- - observeEvent(erase_filters(), updateSelectizeInput(session, "param", selected = "")) + observeEvent( + erase_filters(), + updateSelectizeInput(session, "param", selected = ""), + ignoreInit = TRUE + ) module_return$code <- shiny::reactive({ if (length(input$param)) diff --git a/R/shiny_vector_filter_date.R b/R/shiny_vector_filter_date.R index fe6699b..d4e7704 100644 --- a/R/shiny_vector_filter_date.R +++ b/R/shiny_vector_filter_date.R @@ -47,7 +47,11 @@ shiny_vector_filter.Date <- function(data, inputId, ...) { }) }) session$userData$eraser_observer <- - observeEvent(erase_filters(), updateDateRangeInput(session, "param", start = min(x(), na.rm = TRUE), end = max(x(), na.rm = TRUE))) + observeEvent( + erase_filters(), + updateDateRangeInput(session, "param", start = min(x(), na.rm = TRUE), end = max(x(), na.rm = TRUE)), + ignoreInit = TRUE + ) module_return$code <- shiny::reactive({ exprs <- list() diff --git a/R/shiny_vector_filter_datetime.R b/R/shiny_vector_filter_datetime.R index be8b604..29f7b9f 100644 --- a/R/shiny_vector_filter_datetime.R +++ b/R/shiny_vector_filter_datetime.R @@ -66,7 +66,7 @@ shiny_vector_filter.POSIXct <- function(data, inputId, ...) { shinyTime::updateTimeInput(session, "st_time", value = min(x(), na.rm = TRUE)) updateDateInput(session, "end_date", value = max(my_date, na.rm = TRUE)) shinyTime::updateTimeInput(session, "end_time", value = max(x(), na.rm = TRUE)) - }) + }, ignoreInit = TRUE) st_dt <- reactive({ st <- substr(strftime(input$st_time, "%Y-%m-%d %H:%M:%S", tz = tzone()),12,20) diff --git a/R/shiny_vector_filter_factor_few.R b/R/shiny_vector_filter_factor_few.R index e2e6951..db8c781 100644 --- a/R/shiny_vector_filter_factor_few.R +++ b/R/shiny_vector_filter_factor_few.R @@ -58,23 +58,11 @@ shiny_vector_filter_factor_few <- function(input, output, session, width = "100%")) }) session$userData$eraser_observer <- - observeEvent(erase_filters(), updateCheckboxGroupInput(session, "param", selected = "")) - - # Normalized - # ggplot2::ggplot() + - # # sort factor so that it reflects checkbox order - # ggplot2::aes(x = factor( - # as.character(x_wo_NA()), - # levels = rev(choices()))) + - # ggplot2::geom_bar( - # width = 0.95, - # fill = grDevices::rgb(66/255, 139/255, 202/255), - # color = NA, - # alpha = 0.2) + - # ggplot2::coord_flip() + - # ggplot2::theme_void() + - # ggplot2::scale_x_discrete(expand = c(0, 0)) + - # ggplot2::scale_y_continuous(expand = c(0, 0)) + observeEvent( + erase_filters(), + updateCheckboxGroupInput(session, "param", selected = ""), + ignoreInit = TRUE + ) module_return$code <- shiny::reactive({ if (length(input$param)) diff --git a/R/shiny_vector_filter_factor_many.R b/R/shiny_vector_filter_factor_many.R index a9a08e4..37a2694 100644 --- a/R/shiny_vector_filter_factor_many.R +++ b/R/shiny_vector_filter_factor_many.R @@ -44,7 +44,10 @@ shiny_vector_filter_factor_many <- function(input, output, session, width = "100%") }) session$userData$eraser_observer <- - observeEvent(erase_filters(), updateSelectizeInput(session, "param", selected = "")) + observeEvent( + erase_filters(), updateSelectizeInput(session, "param", selected = ""), + ignoreInit = TRUE + ) module_return$code <- shiny::reactive({ if (length(input$param)) diff --git a/R/shiny_vector_filter_logical.R b/R/shiny_vector_filter_logical.R index 53f4fe6..2634cfc 100644 --- a/R/shiny_vector_filter_logical.R +++ b/R/shiny_vector_filter_logical.R @@ -46,7 +46,11 @@ shiny_vector_filter.logical <- function(data, inputId, ...) { width = "100%")) }) session$userData$eraser_observer <- - observeEvent(erase_filters(), updateCheckboxGroupInput(session, "param", selected = "")) + observeEvent( + erase_filters(), + updateCheckboxGroupInput(session, "param", selected = ""), + ignoreInit = TRUE + ) module_return$code <- shiny::reactive({ exprs <- list() diff --git a/R/shiny_vector_filter_numeric_few.R b/R/shiny_vector_filter_numeric_few.R index e41f130..68e8609 100644 --- a/R/shiny_vector_filter_numeric_few.R +++ b/R/shiny_vector_filter_numeric_few.R @@ -59,23 +59,11 @@ shiny_vector_filter_numeric_few <- function(input, output, session, width = "100%")) }) session$userData$eraser_observer <- - observeEvent(erase_filters(), updateCheckboxGroupInput(session, "param", selected = "")) - - # Normalized - # ggplot2::ggplot() + - # # sort factor so that it reflects checkbox order - # ggplot2::aes(x = factor( - # as.character(x_wo_NA()), - # levels = rev(choices()))) + - # ggplot2::geom_bar( - # width = 0.95, - # fill = grDevices::rgb(66/255, 139/255, 202/255), - # color = NA, - # alpha = 0.2) + - # ggplot2::coord_flip() + - # ggplot2::theme_void() + - # ggplot2::scale_x_discrete(expand = c(0, 0)) + - # ggplot2::scale_y_continuous(expand = c(0, 0)) + observeEvent( + erase_filters(), + updateCheckboxGroupInput(session, "param", selected = ""), + ignoreInit = TRUE + ) module_return$code <- shiny::reactive({ if (length(input$param)) diff --git a/R/shiny_vector_filter_numeric_many.R b/R/shiny_vector_filter_numeric_many.R index d4461b2..881ed8e 100644 --- a/R/shiny_vector_filter_numeric_many.R +++ b/R/shiny_vector_filter_numeric_many.R @@ -59,7 +59,11 @@ shiny_vector_filter_numeric_many <- function(input, output, session, x = shiny:: }) }) session$userData$eraser_observer <- - observeEvent(erase_filters(), updateSliderInput(session, "param", value = range(x(), na.rm = TRUE))) + observeEvent( + erase_filters(), + updateSliderInput(session, "param", value = range(x(), na.rm = TRUE)), + ignoreInit = TRUE + ) module_return$code <- shiny::reactive({ exprs <- list() From b0f97db5914a052e7d62c7647d0acb2e8ffdb79f Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Wed, 16 Aug 2023 09:14:13 -0400 Subject: [PATCH 060/101] Update NEWS --- NEWS.md | 1 + R/shiny_data_filter_item.R | 2 ++ 2 files changed, 3 insertions(+) diff --git a/NEWS.md b/NEWS.md index 88ae34b..942493d 100644 --- a/NEWS.md +++ b/NEWS.md @@ -4,6 +4,7 @@ * Add new implementation `IDEAFilter()` that uses a more modern implementation and less resources (#22) * Allow user to restrict filter to a subset of columns (#14) * Upgraded `pillar::new_pillar_type()` to `pillar::type_sum()` (#9) +* Delete inputs and observers from vector modules when exiting them # IDEAFilter 0.1.3 * Cited works of other contributors (`shinyDataFilter` & `SortableJS`) diff --git a/R/shiny_data_filter_item.R b/R/shiny_data_filter_item.R index 347de30..2e722aa 100644 --- a/R/shiny_data_filter_item.R +++ b/R/shiny_data_filter_item.R @@ -165,6 +165,8 @@ shiny_data_filter_item <- function(input, output, session, data, shiny::observeEvent(input$column_select_edit_btn, { module_return$column_name <- NULL + remove_shiny_inputs("vector_filter", input, ns = ns) + session$userData$eraser_observer$destroy() }) shiny::observeEvent(input$remove_filter_btn, { From ef20ba47d338c68fb2ef82c597c5aced0fb84262 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Wed, 16 Aug 2023 09:21:05 -0400 Subject: [PATCH 061/101] Update NEWS again --- NEWS.md | 1 + 1 file changed, 1 insertion(+) diff --git a/NEWS.md b/NEWS.md index 942493d..8c75226 100644 --- a/NEWS.md +++ b/NEWS.md @@ -4,6 +4,7 @@ * Add new implementation `IDEAFilter()` that uses a more modern implementation and less resources (#22) * Allow user to restrict filter to a subset of columns (#14) * Upgraded `pillar::new_pillar_type()` to `pillar::type_sum()` (#9) +* Allow user to easily erase the applied filters * Delete inputs and observers from vector modules when exiting them # IDEAFilter 0.1.3 From 846749df2a5ded4ad59ce21204c634dd348ec7f7 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Wed, 16 Aug 2023 09:44:56 -0400 Subject: [PATCH 062/101] Require data --- R/IDEAFilter.R | 2 ++ 1 file changed, 2 insertions(+) diff --git a/R/IDEAFilter.R b/R/IDEAFilter.R index b0b3fa0..3b6fb50 100644 --- a/R/IDEAFilter.R +++ b/R/IDEAFilter.R @@ -114,6 +114,8 @@ IDEAFilter_ui <- function(id) { #' IDEAFilter <- function(id, data, ..., col_subset = NULL, preselection = NULL, verbose = FALSE) { moduleServer(id, function(input, output, session) { + req(data) + ns <- session$ns filter_log("calling module", verbose = verbose) From 0dd4bb1b5f6e26d52a01c0d62591d3851f118561 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Wed, 16 Aug 2023 14:00:40 -0400 Subject: [PATCH 063/101] Add checks for data being present --- R/IDEAFilter.R | 4 ++-- R/IDEAFilter_item.R | 1 + 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/R/IDEAFilter.R b/R/IDEAFilter.R index 3b6fb50..110cb82 100644 --- a/R/IDEAFilter.R +++ b/R/IDEAFilter.R @@ -114,8 +114,6 @@ IDEAFilter_ui <- function(id) { #' IDEAFilter <- function(id, data, ..., col_subset = NULL, preselection = NULL, verbose = FALSE) { moduleServer(id, function(input, output, session) { - req(data) - ns <- session$ns filter_log("calling module", verbose = verbose) @@ -181,6 +179,7 @@ IDEAFilter <- function(id, data, ..., col_subset = NULL, preselection = NULL, ve } output$add_filter_select_ui <- renderUI({ + req(datar_subset()) columnSelectInput( ns("add_filter_select"), label = NULL, @@ -285,6 +284,7 @@ IDEAFilter <- function(id, data, ..., col_subset = NULL, preselection = NULL, ve filter_logical(TRUE) }) code <- reactive({ + req(datar_subset()) filter_log("building code", verbose = verbose) filter_exprs <- filter_returns[[utils::tail(filters(), 1)]]$filters() diff --git a/R/IDEAFilter_item.R b/R/IDEAFilter_item.R index ac6a9ea..8fe0bda 100644 --- a/R/IDEAFilter_item.R +++ b/R/IDEAFilter_item.R @@ -62,6 +62,7 @@ IDEAFilter_item <- function(id, data, column_name = NULL, filters = list(), ..., column_name = column_name) filter_logical <- reactive({ + req(data()) if (!length(module_return$pre_filters())) rep(TRUE, nrow(data())) else Reduce("&", Map(function(x) with(data(), eval(x)), module_return$pre_filters())) }) From 41bc20c0f284454ee87b5dc1852f17a817bfdb23 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Wed, 16 Aug 2023 14:01:51 -0400 Subject: [PATCH 064/101] Increment version number --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 89a9e36..b325564 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: IDEAFilter Type: Package -Version: 0.1.3.9007 +Version: 0.1.3.9008 Title: Agnostic, Idiomatic Data Filter Module for Shiny Description: When added to an existing shiny app, users may subset any developer-chosen R data.frame on the fly. That is, users are empowered to From 2c4cc7c96122084568eb8d9b928fca1cd72f58c1 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Mon, 21 Aug 2023 15:36:55 -0400 Subject: [PATCH 065/101] Fix bug when switching between numeric few and many --- R/shiny_vector_filter_numeric_many.R | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/R/shiny_vector_filter_numeric_many.R b/R/shiny_vector_filter_numeric_many.R index 881ed8e..72c8e33 100644 --- a/R/shiny_vector_filter_numeric_many.R +++ b/R/shiny_vector_filter_numeric_many.R @@ -49,7 +49,7 @@ shiny_vector_filter_numeric_many <- function(input, output, session, x = shiny:: transform-origin: bottom;"), if (any(!is.na(x()))) { shiny::sliderInput(ns("param"), NULL, - value = isolate(input$param) %||% range(x_filtered), + value = range(isolate(input$param) %||% x_filtered), min = min(round(x(), 1), na.rm = TRUE), max = max(round(x(), 1), na.rm = TRUE)) } else { @@ -67,12 +67,13 @@ shiny_vector_filter_numeric_many <- function(input, output, session, x = shiny:: module_return$code <- shiny::reactive({ exprs <- list() + last_n <- length(input$param) if (!is.null(input$param)) { if (input$param[[1]] > min(x(), na.rm = TRUE)) exprs <- append(exprs, bquote(.x >= .(as.numeric(input$param[[1]])))) - if (input$param[[2]] < max(x(), na.rm = TRUE)) - exprs <- append(exprs, bquote(.x <= .(as.numeric(input$param[[2]])))) + if (input$param[[last_n]] < max(x(), na.rm = TRUE)) + exprs <- append(exprs, bquote(.x <= .(as.numeric(input$param[[last_n]])))) } if (length(exprs) > 1) { From a0092bb4f8f602dd7d391d8671bd158b34118757 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Mon, 21 Aug 2023 15:39:08 -0400 Subject: [PATCH 066/101] Add `try()` when destroying observer --- R/IDEAFilter_item.R | 4 ++-- R/shiny_data_filter_item.R | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/R/IDEAFilter_item.R b/R/IDEAFilter_item.R index 8fe0bda..aa55557 100644 --- a/R/IDEAFilter_item.R +++ b/R/IDEAFilter_item.R @@ -173,13 +173,13 @@ IDEAFilter_item <- function(id, data, column_name = NULL, filters = list(), ..., shiny::observeEvent(input$column_select_edit_btn, { module_return$column_name <- NULL remove_shiny_inputs("vector_filter", input, ns = ns) - session$userData$eraser_observer$destroy() + try(session$userData$eraser_observer$destroy(), silent = TRUE) }) shiny::observeEvent(input$remove_filter_btn, { module_return$remove <- TRUE remove_shiny_inputs("vector_filter", input, ns = ns) - session$userData$eraser_observer$destroy() + try(session$userData$eraser_observer$destroy(), silent = TRUE) }) observeEvent(input$erase_filter_btn, { diff --git a/R/shiny_data_filter_item.R b/R/shiny_data_filter_item.R index 2e722aa..41a8f66 100644 --- a/R/shiny_data_filter_item.R +++ b/R/shiny_data_filter_item.R @@ -166,13 +166,13 @@ shiny_data_filter_item <- function(input, output, session, data, shiny::observeEvent(input$column_select_edit_btn, { module_return$column_name <- NULL remove_shiny_inputs("vector_filter", input, ns = ns) - session$userData$eraser_observer$destroy() + try(session$userData$eraser_observer$destroy(), silent = TRUE) }) shiny::observeEvent(input$remove_filter_btn, { module_return$remove <- TRUE remove_shiny_inputs("vector_filter", input, ns = ns) - session$userData$eraser_observer$destroy() + try(session$userData$eraser_observer$destroy(), silent = TRUE) }) vector_module_srv <- shiny::reactive(shiny_vector_filter(vec(), "vec")) From d702a75da115d8a4cfa6492bdc2bf5c633497ffb Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Mon, 28 Aug 2023 13:10:09 -0400 Subject: [PATCH 067/101] Update version number --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 6fea6c4..92c400f 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: IDEAFilter Type: Package -Version: 0.1.3.9008 +Version: 0.1.3.9009 Title: Agnostic, Idiomatic Data Filter Module for Shiny Description: When added to an existing shiny app, users may subset any developer-chosen R data.frame on the fly. That is, users are empowered to From 4aa8583cd931342781f99122489c9f1113e4a538 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Mon, 28 Aug 2023 15:35:23 -0400 Subject: [PATCH 068/101] Resolve minor bug when switching from character vector --- R/shiny_vector_filter_character.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/shiny_vector_filter_character.R b/R/shiny_vector_filter_character.R index 593278c..998a6c0 100644 --- a/R/shiny_vector_filter_character.R +++ b/R/shiny_vector_filter_character.R @@ -28,7 +28,7 @@ shiny_vector_filter.character <- function(data, inputId, ...) { filter_log("updating ui", verbose = verbose) - if (purrr::reduce(purrr::map(x(), is.empty), `&`)) { + if (purrr::reduce(purrr::map(x(), is.empty), `&`, .init = TRUE)) { shiny::div(style = "opacity: 0.5;", p(width = "100%", align = "center", From 0071ceb864f0caa55a59ebbcc4d799736197bf39 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Tue, 29 Aug 2023 10:11:20 -0400 Subject: [PATCH 069/101] Update authorship --- DESCRIPTION | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 92c400f..9b1838c 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -19,6 +19,9 @@ Authors@R: c( email = "clark.aaronchris@gmail.com", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-0123-0970")), + person( + given = "Jeff", family = "Thompson", + email = "jeff.thompson51317@gmail.com", role = "aut"), person( given = "Doug", family = "Kelkhoff", email = "doug.kelkhoff@gmail.com", role = c("ctb", "cph"), @@ -26,9 +29,6 @@ Authors@R: c( person( given = "Maya", family = "Gans", email = "maya.gans@biogen.com", role = "ctb"), - person( - given = "Jeff", family = "Thompson", - email = "jeff.thompson51317@gmail.com", role = "ctb"), person(family = "SortableJS contributors", role = "ctb", comment = "SortableJS library"), person(given = "Biogen", role = "cph")) From 63295abbe91cb420a4e45eb4d81813c6e3b7a343 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Tue, 29 Aug 2023 10:12:57 -0400 Subject: [PATCH 070/101] Separate inputs in numeric few and many --- R/shiny_vector_filter_numeric_few.R | 12 ++++++------ R/shiny_vector_filter_numeric_many.R | 18 +++++++++--------- 2 files changed, 15 insertions(+), 15 deletions(-) diff --git a/R/shiny_vector_filter_numeric_few.R b/R/shiny_vector_filter_numeric_few.R index 68e8609..da730c9 100644 --- a/R/shiny_vector_filter_numeric_few.R +++ b/R/shiny_vector_filter_numeric_few.R @@ -38,7 +38,7 @@ shiny_vector_filter_numeric_few <- function(input, output, session, module_return <- shiny::reactiveValues(code = TRUE, mask = TRUE) fn <- if (is.null(filter_fn)) function(x) FALSE else purrr::possibly(filter_fn, otherwise = FALSE) - x_filtered <- Filter(function(x) !is.na(x) & fn(x), x()) + x_filtered <- unique(as.character(Filter(function(x) !is.na(x) & fn(x), x()))) choices <- shiny::reactive(unique(as.character(sort(x_wo_NA())))) @@ -53,21 +53,21 @@ shiny_vector_filter_numeric_few <- function(input, output, session, 0.5s ease-in 0s 1 shinyDataFilterFadeIn; transform-origin: left;" #, ), - shiny::checkboxGroupInput(ns("param"), NULL, + shiny::checkboxGroupInput(ns("param_few"), NULL, choices = choices(), - selected = isolate(input$param) %||% x_filtered, + selected = isolate(input$param_few) %||% x_filtered, width = "100%")) }) session$userData$eraser_observer <- observeEvent( erase_filters(), - updateCheckboxGroupInput(session, "param", selected = ""), + updateCheckboxGroupInput(session, "param_few", selected = ""), ignoreInit = TRUE ) module_return$code <- shiny::reactive({ - if (length(input$param)) - bquote(.x %in% .(c(if (filter_na()) c() else NA, input$param))) + if (length(input$param_few)) + bquote(.x %in% .(c(if (filter_na()) c() else NA, input$param_few))) else if (filter_na()) bquote(!is.na(.x)) else diff --git a/R/shiny_vector_filter_numeric_many.R b/R/shiny_vector_filter_numeric_many.R index 72c8e33..48e142b 100644 --- a/R/shiny_vector_filter_numeric_many.R +++ b/R/shiny_vector_filter_numeric_many.R @@ -48,8 +48,8 @@ shiny_vector_filter_numeric_many <- function(input, output, session, x = shiny:: 0.5s ease-in 0s 1 shinyDataFilterFadeIn; transform-origin: bottom;"), if (any(!is.na(x()))) { - shiny::sliderInput(ns("param"), NULL, - value = range(isolate(input$param) %||% x_filtered), + shiny::sliderInput(ns("param_many"), NULL, + value = range(isolate(input$param_many) %||% x_filtered), min = min(round(x(), 1), na.rm = TRUE), max = max(round(x(), 1), na.rm = TRUE)) } else { @@ -61,19 +61,19 @@ shiny_vector_filter_numeric_many <- function(input, output, session, x = shiny:: session$userData$eraser_observer <- observeEvent( erase_filters(), - updateSliderInput(session, "param", value = range(x(), na.rm = TRUE)), + updateSliderInput(session, "param_many", value = range(x(), na.rm = TRUE)), ignoreInit = TRUE ) module_return$code <- shiny::reactive({ exprs <- list() - last_n <- length(input$param) + last_n <- length(input$param_many) - if (!is.null(input$param)) { - if (input$param[[1]] > min(x(), na.rm = TRUE)) - exprs <- append(exprs, bquote(.x >= .(as.numeric(input$param[[1]])))) - if (input$param[[last_n]] < max(x(), na.rm = TRUE)) - exprs <- append(exprs, bquote(.x <= .(as.numeric(input$param[[last_n]])))) + if (!is.null(input$param_many)) { + if (input$param_many[[1]] > min(x(), na.rm = TRUE)) + exprs <- append(exprs, bquote(.x >= .(as.numeric(input$param_many[[1]])))) + if (input$param_many[[last_n]] < max(x(), na.rm = TRUE)) + exprs <- append(exprs, bquote(.x <= .(as.numeric(input$param_many[[last_n]])))) } if (length(exprs) > 1) { From cdf4e1e0c35a4e4a19aa113f55e9693f156e7d1a Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Tue, 29 Aug 2023 10:13:13 -0400 Subject: [PATCH 071/101] Update example apps --- inst/examples/iris_app/app.R | 4 +--- inst/examples/starwars_app/app.R | 33 ++++++++++++++++++++++++++++++-- 2 files changed, 32 insertions(+), 5 deletions(-) diff --git a/inst/examples/iris_app/app.R b/inst/examples/iris_app/app.R index c89fedc..5bba523 100644 --- a/inst/examples/iris_app/app.R +++ b/inst/examples/iris_app/app.R @@ -37,6 +37,4 @@ server <- function(input, output, session) { } -shinyApp(ui = ui, server = server) - - +shinyApp(ui = ui, server = server) \ No newline at end of file diff --git a/inst/examples/starwars_app/app.R b/inst/examples/starwars_app/app.R index cdca543..c4afdcc 100644 --- a/inst/examples/starwars_app/app.R +++ b/inst/examples/starwars_app/app.R @@ -23,10 +23,39 @@ ui <- fluidPage( dataTableOutput("data_summary"), h4("Generated code:"), verbatimTextOutput("data_filter_code")), - column(4, IDEAFilter_ui("data_filter")))) + column(4, + varSelectizeInput("col_subset", "Choose Column Subset", starwars2, multiple = TRUE), + div( + class = "form-group", + tags$label(class = "control-label", "Choose Pre-selection"), + div( + style = "display: flex", + actionButton("ex1", HTML("gender: feminine
height: >= 180cm"), width = "50%"), + actionButton("ex2", HTML("is_droid: TRUE; not NA
mass: < 50kg"), width = "50%") + ) + ), + hr(), + br(), + IDEAFilter_ui("data_filter")) + )) server <- function(input, output, session) { - filtered_data <- IDEAFilter("data_filter", data = starwars2, verbose = FALSE) + + preselection <- reactiveVal(NULL) + observeEvent(input$ex1, { + preselection( + list(gender = list(filter_fn = ~ .x == "feminine"), + height = list(filter_fn = ~ .x >= 180)) + ) + }) + observeEvent(input$ex2, { + preselection( + list(is_droid = list(filter_na = TRUE, filter_fn = ~ isTRUE(.x)), + mass = list(filter_fn = ~ .x < 50)) + ) + }) + + filtered_data <- IDEAFilter("data_filter", data = starwars2, col_subset = reactive(input$col_subset), preselection = preselection, verbose = FALSE) output$data_filter_code <- renderPrint({ cat(gsub("%>%", "%>% \n ", From a86572e8990888d3c6e95e2ad1f1d8439112017f Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Tue, 29 Aug 2023 10:13:36 -0400 Subject: [PATCH 072/101] Flesh out vignette a little more --- README.Rmd | 2 +- vignettes/IDEAFilter.Rmd | 41 ++++++++++++++++++++++++++++++++++++---- 2 files changed, 38 insertions(+), 5 deletions(-) diff --git a/README.Rmd b/README.Rmd index 588aa4f..413d6b5 100644 --- a/README.Rmd +++ b/README.Rmd @@ -54,7 +54,7 @@ The server side logic needs to call the `IDEAFilter` module, match the input ID filtered_data <- # name the returned reactive data frame IDEAFilter( "data_filter", # give the filter a name(space) - data = starwars2, # feed it raw data + data = starwars, # feed it raw data verbose = FALSE ) ``` diff --git a/vignettes/IDEAFilter.Rmd b/vignettes/IDEAFilter.Rmd index e8d7779..82d448d 100644 --- a/vignettes/IDEAFilter.Rmd +++ b/vignettes/IDEAFilter.Rmd @@ -1,8 +1,8 @@ --- -title: "Introduction to IDEAFilter" +title: "Using IDEAFilter" output: rmarkdown::html_vignette vignette: > - %\VignetteIndexEntry{Introduction to IDEAFilter} + %\VignetteIndexEntry{Using IDEAFilter} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- @@ -18,6 +18,39 @@ knitr::opts_chunk$set( library(IDEAFilter) ``` -When exploring data in a Shiny application, one may want to look at a subset of the data. Oftentimes, you as the developer will restrict this filtering by design based on the specifications of your app. But what if you need to let the user filter on the fields of their choice? Or what if the data set the user will be exploring does not have a stable structure? +# Minimal Example -In this situation you need a filtering structure that is not constrained to a specific data set but can also be understood by users. The IDEAFilter package can help you solve your problem by providing an agnostic and idiomatic data filter module to be used in your application. \ No newline at end of file +Here is a minimal example using `IDEAFilter_ui()` and `IDEAFilter()` to explore a dataset: +```{r, eval=FALSE} +library(shiny) +library(IDEAFilter) +library(dplyr) +shinyApp( + ui = fluidPage( + titlePanel("Filter Data Example"), + fluidRow( + column(8, dataTableOutput("data_summary")), + column(4, IDEAFilter_ui("data_filter")))), + server = function(input, output, session) { + filtered_data <- IDEAFilter("data_filter", data = iris, verbose = FALSE) + output$data_summary <- + renderDataTable(filtered_data(), + options = list(scrollX = TRUE, pageLength = 5)) + } +) +``` +The server side of the module returns the reactive `ShinyDataFilter_df` object which includes the filtered data frame and the code used to filter it as an attribute. + +# A Larger Example + +With the release of `IDEAFilter()` to replace the deprecated `shiny_data_filter()`, a couple more arguments have been introduced to enhance the functionality of the filter. + +* Column Sub-setting: you can now restrict the columns a user can add to the filter. +* Pre-selection: you can now pre-specify a collection of filters to either pre-load in the filter or for users to dynamically apply. + +To explore these features we can run the following example application: + +```{r, eval=FALSE} +app <- system.file("examples", "starwars_app", package = "IDEAFilter") +runApp(app) +``` \ No newline at end of file From 736d49f38a001a95e18233ed13d0b02be100380d Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Tue, 29 Aug 2023 14:01:21 -0400 Subject: [PATCH 073/101] Change implementation of column subsetting --- R/IDEAFilter.R | 20 +++++++++++--------- R/IDEAFilter_item.R | 19 ++++++++++++------- R/selectInput_column.R | 5 ++++- man/IDEAFilter_item.Rd | 3 +++ man/columnSelectInput.Rd | 3 +++ 5 files changed, 33 insertions(+), 17 deletions(-) diff --git a/R/IDEAFilter.R b/R/IDEAFilter.R index 110cb82..bfcaad8 100644 --- a/R/IDEAFilter.R +++ b/R/IDEAFilter.R @@ -119,7 +119,7 @@ IDEAFilter <- function(id, data, ..., col_subset = NULL, preselection = NULL, ve data_call <- as.list(sys.call(-7L))$data datar <- if (is.reactive(data)) data else reactive(data) - datar_subset <- if (is.null(col_subset)) datar else reactive(datar()[col_subset]) + col_subsetr <- if (is.reactive(col_subset)) col_subset else reactive(col_subset) preselectionr <- if (is.reactive(preselection)) preselection else reactive(preselection) filter_counter <- 0 @@ -130,7 +130,7 @@ IDEAFilter <- function(id, data, ..., col_subset = NULL, preselection = NULL, ve filters <- reactiveVal(c("filter_0")) filter_returns <- list(filter_0 = reactiveValues( - data = datar_subset, + data = datar, pre_filters = reactive(list()), filters = reactive(list()), remove = NULL)) @@ -150,9 +150,10 @@ IDEAFilter <- function(id, data, ..., col_subset = NULL, preselection = NULL, ve } else { filter_returns[[fid]] <<- IDEAFilter_item( fid, - data = datar_subset, + data = datar, column_name = column_name, filters = filter_returns[[in_fid]]$filters, + col_subset = col_subsetr, preselection = preselection, verbose = verbose) } @@ -179,11 +180,12 @@ IDEAFilter <- function(id, data, ..., col_subset = NULL, preselection = NULL, ve } output$add_filter_select_ui <- renderUI({ - req(datar_subset()) + req(datar()) columnSelectInput( ns("add_filter_select"), label = NULL, - data = datar_subset, + data = datar, + col_subset = col_subsetr, placeholder = "Add Filter", width = "100%") }) @@ -246,7 +248,7 @@ IDEAFilter <- function(id, data, ..., col_subset = NULL, preselection = NULL, ve }) observeEvent(input$add_filter_select, { - if (!input$add_filter_select %in% names(datar_subset())) return() + if (!input$add_filter_select %in% names(datar())) return() filter_log("observing add filter button press", verbose = verbose) update_filter(fid <- next_filter_id(), column_name = input$add_filter_select) @@ -280,15 +282,15 @@ IDEAFilter <- function(id, data, ..., col_subset = NULL, preselection = NULL, ve }) filter_logical <- reactiveVal(TRUE) - observeEvent(datar_subset(), { + observeEvent(datar(), { filter_logical(TRUE) }) code <- reactive({ - req(datar_subset()) + req(datar()) filter_log("building code", verbose = verbose) filter_exprs <- filter_returns[[utils::tail(filters(), 1)]]$filters() - filter_logical(if (!length(filter_exprs)) rep(TRUE,nrow(datar_subset())) else Reduce("&", Map(function(x) with(datar_subset(), eval(x)), filter_exprs))) + filter_logical(if (!length(filter_exprs)) rep(TRUE,nrow(datar())) else Reduce("&", Map(function(x) with(datar(), eval(x)), filter_exprs))) Reduce( function(l,r) bquote(.(l) %>% filter(.(r))), diff --git a/R/IDEAFilter_item.R b/R/IDEAFilter_item.R index aa55557..3d68f43 100644 --- a/R/IDEAFilter_item.R +++ b/R/IDEAFilter_item.R @@ -32,6 +32,7 @@ IDEAFilter_item_ui <- function(id) { #' @param filters a \code{reactive expression} containing the a list of filters #' passed as \code{language} types #' @param ... placeholder for inclusion of additional parameters in future development +#' @param col_subset a \code{vector} containing the list of allowable columns to filter on #' @param preselection a \code{list} that can be used to pre-populate the filter #' @param verbose a \code{logical} value indicating whether or not to print log #' statements out to the console @@ -48,11 +49,14 @@ IDEAFilter_item_ui <- function(id) { #' @export #' @keywords internal #' -IDEAFilter_item <- function(id, data, column_name = NULL, filters = list(), ..., preselection = NULL, verbose = FALSE) { +IDEAFilter_item <- function(id, data, column_name = NULL, filters = list(), ..., col_subset = NULL, preselection = NULL, verbose = FALSE) { filters <- if (is.reactive(filters)) filters else reactiveVal(filters) moduleServer(id, function(input, output, session) { ns <- session$ns + datar <- if (is.reactive(data)) data else reactive(data) + col_subsetr <- if (is.reactive(col_subset)) col_subset else reactive(col_subset) + filter_na <- reactiveVal(if ("filter_na" %in% names(preselection)) isTRUE(preselection[["filter_na"]]) else FALSE) module_return <- shiny::reactiveValues( @@ -62,8 +66,8 @@ IDEAFilter_item <- function(id, data, column_name = NULL, filters = list(), ..., column_name = column_name) filter_logical <- reactive({ - req(data()) - if (!length(module_return$pre_filters())) rep(TRUE, nrow(data())) else Reduce("&", Map(function(x) with(data(), eval(x)), module_return$pre_filters())) + req(datar()) + if (!length(module_return$pre_filters())) rep(TRUE, nrow(datar())) else Reduce("&", Map(function(x) with(datar(), eval(x)), module_return$pre_filters())) }) @@ -78,7 +82,8 @@ IDEAFilter_item <- function(id, data, column_name = NULL, filters = list(), ..., columnSelectInput( ns("column_select"), NULL, - data = data, + data = datar, + col_subset = col_subsetr, multiple = TRUE, width = '100%'), shiny::h4(style = 'float: right; margin: 8px 0px 0px 8px;', @@ -149,7 +154,7 @@ IDEAFilter_item <- function(id, data, column_name = NULL, filters = list(), ..., }) output$nrow <- shiny::renderText({ - out_log <- if (isTRUE(code())) filter_logical() else with(data(), eval(code())) & filter_logical() + out_log <- if (isTRUE(code())) filter_logical() else with(datar(), eval(code())) & filter_logical() sum(out_log, na.rm = TRUE) }) @@ -162,8 +167,8 @@ IDEAFilter_item <- function(id, data, column_name = NULL, filters = list(), ..., nna <- shiny::reactive(sum(is.na(vec()))) vec <- shiny::reactive({ - if (is.null(module_return$column_name) || !(module_return$column_name %in% names(data()))) NULL - else subset(data(), filter_logical(), module_return$column_name, drop = TRUE) + if (is.null(module_return$column_name) || !(module_return$column_name %in% names(datar()))) NULL + else subset(datar(), filter_logical(), module_return$column_name, drop = TRUE) }) shiny::observeEvent(input$column_select, { diff --git a/R/selectInput_column.R b/R/selectInput_column.R index 251ae5b..fde0c84 100644 --- a/R/selectInput_column.R +++ b/R/selectInput_column.R @@ -5,6 +5,7 @@ #' @param data \code{data.frame} object from which fields should be populated #' @param selected default selection #' @param ... passed to \code{\link[shiny]{selectizeInput}} +#' @param col_subset a \code{vector} containing the list of allowable columns to select #' @param placeholder passed to \code{\link[shiny]{selectizeInput}} options #' @param onInitialize passed to \code{\link[shiny]{selectizeInput}} options #' @@ -14,9 +15,10 @@ #' @keywords internal #' columnSelectInput <- function(inputId, label, data, selected = "", ..., - placeholder = "", onInitialize) { + col_subset = NULL, placeholder = "", onInitialize) { datar <- if (is.reactive(data)) data else reactive(data) + col_subsetr <- if (is.reactive(col_subset)) col_subset else reactive(col_subset) labels <- Map(function(col) { json <- sprintf(strip_leading_ws(' @@ -30,6 +32,7 @@ columnSelectInput <- function(inputId, label, data, selected = "", ..., get_dataFilter_class(datar()[[col]])) }, col = names(datar())) choices <- setNames(names(datar()), labels) + choices <- choices[match(col_subset() %||% choices, choices)] shiny::selectizeInput( inputId = inputId, diff --git a/man/IDEAFilter_item.Rd b/man/IDEAFilter_item.Rd index b6fee2a..58f5a6d 100644 --- a/man/IDEAFilter_item.Rd +++ b/man/IDEAFilter_item.Rd @@ -10,6 +10,7 @@ IDEAFilter_item( column_name = NULL, filters = list(), ..., + col_subset = NULL, preselection = NULL, verbose = FALSE ) @@ -27,6 +28,8 @@ passed as \code{language} types} \item{...}{placeholder for inclusion of additional parameters in future development} +\item{col_subset}{a \code{vector} containing the list of allowable columns to filter on} + \item{preselection}{a \code{list} that can be used to pre-populate the filter} \item{verbose}{a \code{logical} value indicating whether or not to print log diff --git a/man/columnSelectInput.Rd b/man/columnSelectInput.Rd index 284f41b..ca7124d 100644 --- a/man/columnSelectInput.Rd +++ b/man/columnSelectInput.Rd @@ -10,6 +10,7 @@ columnSelectInput( data, selected = "", ..., + col_subset = NULL, placeholder = "", onInitialize ) @@ -25,6 +26,8 @@ columnSelectInput( \item{...}{passed to \code{\link[shiny]{selectizeInput}}} +\item{col_subset}{a \code{vector} containing the list of allowable columns to select} + \item{placeholder}{passed to \code{\link[shiny]{selectizeInput}} options} \item{onInitialize}{passed to \code{\link[shiny]{selectizeInput}} options} From 2377a0c0529c510a07aa5d95c8db962776a6c81d Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Tue, 29 Aug 2023 14:02:56 -0400 Subject: [PATCH 074/101] Increment version number --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index b325564..4feca34 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: IDEAFilter Type: Package -Version: 0.1.3.9008 +Version: 0.1.3.9009 Title: Agnostic, Idiomatic Data Filter Module for Shiny Description: When added to an existing shiny app, users may subset any developer-chosen R data.frame on the fly. That is, users are empowered to From b343dbf46f425e33fd8822305a8fb05497ef2233 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Tue, 29 Aug 2023 14:14:33 -0400 Subject: [PATCH 075/101] Update `columnSelectInput()` --- R/selectInput_column.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/selectInput_column.R b/R/selectInput_column.R index fde0c84..de7e4e7 100644 --- a/R/selectInput_column.R +++ b/R/selectInput_column.R @@ -32,7 +32,7 @@ columnSelectInput <- function(inputId, label, data, selected = "", ..., get_dataFilter_class(datar()[[col]])) }, col = names(datar())) choices <- setNames(names(datar()), labels) - choices <- choices[match(col_subset() %||% choices, choices)] + choices <- choices[match(col_subsetr() %||% choices, choices)] shiny::selectizeInput( inputId = inputId, From a011445941c75edb4b2ebdb28f1fcfcf0e4ebee3 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Tue, 29 Aug 2023 14:36:43 -0400 Subject: [PATCH 076/101] Increment version number --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 9b1838c..f5feda1 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: IDEAFilter Type: Package -Version: 0.1.3.9009 +Version: 0.1.3.9010 Title: Agnostic, Idiomatic Data Filter Module for Shiny Description: When added to an existing shiny app, users may subset any developer-chosen R data.frame on the fly. That is, users are empowered to From dcc21a5fb4e1e2e5c4618404bcbf8bbc87b5af29 Mon Sep 17 00:00:00 2001 From: Jeff-Thompson12 Date: Tue, 29 Aug 2023 18:43:01 +0000 Subject: [PATCH 077/101] Re-build Rmarkdown files --- README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.md b/README.md index 04d2745..98c8813 100644 --- a/README.md +++ b/README.md @@ -73,7 +73,7 @@ regardless on if the user chooses to apply filters or not. filtered_data <- # name the returned reactive data frame IDEAFilter( "data_filter", # give the filter a name(space) - data = starwars2, # feed it raw data + data = starwars, # feed it raw data verbose = FALSE ) ``` From b46555ff72d1c8579247b45a9624e3573d83641e Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Tue, 29 Aug 2023 15:38:29 -0400 Subject: [PATCH 078/101] Repair tests --- tests/testthat/test_IDEAFilter.R | 8 ++++---- tests/testthat/test_IDEAFilter_item.R | 4 ++-- tests/testthat/test_reactive_data.R | 4 ++-- tests/testthat/test_shiny_data_filter.R | 8 ++++---- tests/testthat/test_shiny_data_filter_item.R | 4 ++-- tests/testthat/test_shiny_vector_filter_numeric.R | 6 +++--- 6 files changed, 17 insertions(+), 17 deletions(-) diff --git a/tests/testthat/test_IDEAFilter.R b/tests/testthat/test_IDEAFilter.R index ac41850..e36f126 100644 --- a/tests/testthat/test_IDEAFilter.R +++ b/tests/testthat/test_IDEAFilter.R @@ -15,8 +15,8 @@ test_that("test that a new filter item has been added", { app$set_inputs(`data_filter-add_filter_select` = "Ozone") -app$wait_for_js('document.getElementById("data_filter-filter_2-vector_filter-param")') -app$set_inputs(`data_filter-filter_2-vector_filter-param` = c(30, 90)) +app$wait_for_js('document.getElementById("data_filter-filter_2-vector_filter-param_many")') +app$set_inputs(`data_filter-filter_2-vector_filter-param_many` = c(30, 90)) test_that("test that a new filter item has been added", { expect_equal( @@ -38,8 +38,8 @@ test_that("test that a new filter item has been added", { app$set_inputs(`data_filter-add_filter_select` = "Wind") -app$wait_for_js('document.getElementById("data_filter-filter_3-vector_filter-param")') -app$set_inputs(`data_filter-filter_3-vector_filter-param` = c(5, 10)) +app$wait_for_js('document.getElementById("data_filter-filter_3-vector_filter-param_many")') +app$set_inputs(`data_filter-filter_3-vector_filter-param_many` = c(5, 10)) test_that("test that nrow reactive value is accurate", { expect_equal( diff --git a/tests/testthat/test_IDEAFilter_item.R b/tests/testthat/test_IDEAFilter_item.R index d3b65ac..e1e6a4e 100644 --- a/tests/testthat/test_IDEAFilter_item.R +++ b/tests/testthat/test_IDEAFilter_item.R @@ -16,8 +16,8 @@ test_that("test that filter item initializes with column select", { app$set_inputs(`filter-column_select` = "mpg") -app$wait_for_js('document.getElementById("filter-vector_filter-param")') -app$set_inputs(`filter-vector_filter-param` = c(20, 25)) +app$wait_for_js('document.getElementById("filter-vector_filter-param_many")') +app$set_inputs(`filter-vector_filter-param_many` = c(20, 25)) diff --git a/tests/testthat/test_reactive_data.R b/tests/testthat/test_reactive_data.R index facf016..5bdc2e4 100644 --- a/tests/testthat/test_reactive_data.R +++ b/tests/testthat/test_reactive_data.R @@ -11,7 +11,7 @@ app <- shinytest2::AppDriver$new(app_path) app$set_inputs(`data_filter-add_filter_select` = "Ozone") app$wait_for_js('document.getElementById("data_filter-filter_1-remove_filter_btn")') app$wait_for_idle() -app$set_inputs(`data_filter-filter_1-vector_filter-param` = c(30, 90)) +app$set_inputs(`data_filter-filter_1-vector_filter-param_many` = c(30, 90)) test_that("test that a new filter item has been added", { expect_equivalent( @@ -30,7 +30,7 @@ test_that("test that a new filter item has been added", { app$set_inputs(`data_filter-add_filter_select` = "mpg") app$wait_for_js('document.getElementById("data_filter-filter_2-remove_filter_btn")') app$wait_for_idle() -app$set_inputs(`data_filter-filter_2-vector_filter-param` = c(20, 25)) +app$set_inputs(`data_filter-filter_2-vector_filter-param_many` = c(20, 25)) test_that("test that a new filter item has been added", { expect_equivalent( diff --git a/tests/testthat/test_shiny_data_filter.R b/tests/testthat/test_shiny_data_filter.R index 1c489e6..1add023 100644 --- a/tests/testthat/test_shiny_data_filter.R +++ b/tests/testthat/test_shiny_data_filter.R @@ -15,8 +15,8 @@ test_that("test that a new filter item has been added", { app$set_inputs(`data_filter-add_filter_select` = "Ozone") -app$wait_for_js('document.getElementById("data_filter-filter_2-vector_filter-param")') -app$set_inputs(`data_filter-filter_2-vector_filter-param` = c(30, 90)) +app$wait_for_js('document.getElementById("data_filter-filter_2-vector_filter-param_many")') +app$set_inputs(`data_filter-filter_2-vector_filter-param_many` = c(30, 90)) test_that("test that a new filter item has been added", { expect_equal( @@ -38,8 +38,8 @@ test_that("test that a new filter item has been added", { app$set_inputs(`data_filter-add_filter_select` = "Wind") -app$wait_for_js('document.getElementById("data_filter-filter_3-vector_filter-param")') -app$set_inputs(`data_filter-filter_3-vector_filter-param` = c(5, 10)) +app$wait_for_js('document.getElementById("data_filter-filter_3-vector_filter-param_many")') +app$set_inputs(`data_filter-filter_3-vector_filter-param_many` = c(5, 10)) test_that("test that nrow reactive value is accurate", { expect_equal( diff --git a/tests/testthat/test_shiny_data_filter_item.R b/tests/testthat/test_shiny_data_filter_item.R index b462d24..b26787e 100644 --- a/tests/testthat/test_shiny_data_filter_item.R +++ b/tests/testthat/test_shiny_data_filter_item.R @@ -16,8 +16,8 @@ test_that("test that filter item initializes with column select", { app$set_inputs(`filter-column_select` = "mpg") -app$wait_for_js('document.getElementById("filter-vector_filter-param")') -app$set_inputs(`filter-vector_filter-param` = c(20, 25)) +app$wait_for_js('document.getElementById("filter-vector_filter-param_many")') +app$set_inputs(`filter-vector_filter-param_many` = c(20, 25)) diff --git a/tests/testthat/test_shiny_vector_filter_numeric.R b/tests/testthat/test_shiny_vector_filter_numeric.R index 1394612..3428d32 100644 --- a/tests/testthat/test_shiny_vector_filter_numeric.R +++ b/tests/testthat/test_shiny_vector_filter_numeric.R @@ -6,11 +6,11 @@ app <- shinytest2::AppDriver$new(app_path) data <- c(1:9, NA) app$set_inputs(`data_dput` = paste(capture.output(dput(data)), paste = "\n")) -app$wait_for_js('document.getElementById("test_in-param")') +app$wait_for_js('document.getElementById("test_in-param_many")') test_that("testing that numeric vectors get filtered properly", { - app$set_inputs(`test_in-param` = c(3, 6)) + app$set_inputs(`test_in-param_many` = c(3, 6)) app$set_inputs(`filter_na` = TRUE) expect_equal( @@ -33,7 +33,7 @@ test_that("testing that numeric vectors get filtered properly", { test_that("testing that numeric vector filter code builds properly", { - app$set_inputs(`test_in-param` = c(5, 8)) + app$set_inputs(`test_in-param_many` = c(5, 8)) app$set_inputs(`filter_na` = TRUE) expect_equal( From 73cee62ddd48eac98f1ad75459dfc6924a67b8e5 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Tue, 19 Sep 2023 08:52:03 -0400 Subject: [PATCH 079/101] Resolve some warnings --- R/IDEAFilter_item.R | 1 + R/selectInput_column.R | 2 +- R/shiny_vector_filter_numeric_many.R | 10 +++++++--- 3 files changed, 9 insertions(+), 4 deletions(-) diff --git a/R/IDEAFilter_item.R b/R/IDEAFilter_item.R index 3d68f43..4372180 100644 --- a/R/IDEAFilter_item.R +++ b/R/IDEAFilter_item.R @@ -177,6 +177,7 @@ IDEAFilter_item <- function(id, data, column_name = NULL, filters = list(), ..., shiny::observeEvent(input$column_select_edit_btn, { module_return$column_name <- NULL + preselection <<- NULL remove_shiny_inputs("vector_filter", input, ns = ns) try(session$userData$eraser_observer$destroy(), silent = TRUE) }) diff --git a/R/selectInput_column.R b/R/selectInput_column.R index de7e4e7..a548cc6 100644 --- a/R/selectInput_column.R +++ b/R/selectInput_column.R @@ -32,7 +32,7 @@ columnSelectInput <- function(inputId, label, data, selected = "", ..., get_dataFilter_class(datar()[[col]])) }, col = names(datar())) choices <- setNames(names(datar()), labels) - choices <- choices[match(col_subsetr() %||% choices, choices)] + choices <- choices[match(if (length(col_subsetr()) == 0 || isTRUE(col_subsetr() == "")) choices else col_subsetr(), choices)] shiny::selectizeInput( inputId = inputId, diff --git a/R/shiny_vector_filter_numeric_many.R b/R/shiny_vector_filter_numeric_many.R index 48e142b..526da85 100644 --- a/R/shiny_vector_filter_numeric_many.R +++ b/R/shiny_vector_filter_numeric_many.R @@ -48,10 +48,14 @@ shiny_vector_filter_numeric_many <- function(input, output, session, x = shiny:: 0.5s ease-in 0s 1 shinyDataFilterFadeIn; transform-origin: bottom;"), if (any(!is.na(x()))) { + value_range <- range(isolate(input$param_many) %||% x_filtered) + overall_range <- range(x(), na.rm = TRUE) + value_range[1] <- min(max(value_range[1], overall_range[1]), overall_range[2]) + value_range[2] <- max(min(value_range[2], overall_range[2]), overall_range[1]) shiny::sliderInput(ns("param_many"), NULL, - value = range(isolate(input$param_many) %||% x_filtered), - min = min(round(x(), 1), na.rm = TRUE), - max = max(round(x(), 1), na.rm = TRUE)) + value = value_range, + min = overall_range[1], + max = overall_range[2]) } else { shiny::div( style = "padding-top: 10px; opacity: 0.3; text-align: center;", From e63c145de0f62279b1e9c0dec6696b20f3f5fe9c Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Fri, 22 Sep 2023 08:56:48 -0400 Subject: [PATCH 080/101] Resolve issue where column subsets were not getting updated --- R/IDEAFilter_item.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/IDEAFilter_item.R b/R/IDEAFilter_item.R index 4372180..3f80cc4 100644 --- a/R/IDEAFilter_item.R +++ b/R/IDEAFilter_item.R @@ -116,7 +116,7 @@ IDEAFilter_item <- function(id, data, column_name = NULL, filters = list(), ..., ), shiny::uiOutput(ns("vector_filter_ui"))) - ui <- shiny::eventReactive(module_return$column_name, ignoreNULL = FALSE, { + ui <- shiny::reactive({ if (is.null(module_return$column_name)) column_select_ui() else column_filter_ui }) From 53a47092d6b1dce0004a7a9803efea49adc3ba6e Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Fri, 22 Sep 2023 09:37:51 -0400 Subject: [PATCH 081/101] Flesh out vignette a little more --- vignettes/IDEAFilter.Rmd | 40 ++++++++++++++++++++++++++------- vignettes/images/colsubset.png | Bin 0 -> 26801 bytes 2 files changed, 32 insertions(+), 8 deletions(-) create mode 100644 vignettes/images/colsubset.png diff --git a/vignettes/IDEAFilter.Rmd b/vignettes/IDEAFilter.Rmd index 82d448d..365d04f 100644 --- a/vignettes/IDEAFilter.Rmd +++ b/vignettes/IDEAFilter.Rmd @@ -14,13 +14,10 @@ knitr::opts_chunk$set( ) ``` -```{r setup} -library(IDEAFilter) -``` - # Minimal Example -Here is a minimal example using `IDEAFilter_ui()` and `IDEAFilter()` to explore a dataset: +Here is a minimal example using `IDEAFilter_ui()` and `IDEAFilter()` to explore a data set: + ```{r, eval=FALSE} library(shiny) library(IDEAFilter) @@ -39,18 +36,45 @@ shinyApp( } ) ``` + The server side of the module returns the reactive `ShinyDataFilter_df` object which includes the filtered data frame and the code used to filter it as an attribute. # A Larger Example With the release of `IDEAFilter()` to replace the deprecated `shiny_data_filter()`, a couple more arguments have been introduced to enhance the functionality of the filter. -* Column Sub-setting: you can now restrict the columns a user can add to the filter. -* Pre-selection: you can now pre-specify a collection of filters to either pre-load in the filter or for users to dynamically apply. +- Column Sub-setting: you can now restrict the columns a user can add to the filter. +- Pre-selection: you can now pre-specify a collection of filters to either pre-load in the filter or for users to dynamically apply. To explore these features we can run the following example application: ```{r, eval=FALSE} +library(shiny) +library(IDEAFilter) app <- system.file("examples", "starwars_app", package = "IDEAFilter") runApp(app) -``` \ No newline at end of file +``` + +## Column Sub-setting + +In the application you can freely select a subset of columns to include in the filter. You can now freely set what columns users are able to add to the filter. You should note these columns can still be set using pre-selection and will still be applied to the filter. For instance, you can see below that only `height` has been selected but `gender` is still being applied. + +![](images/colsubset.png){style="position:center; width:100%"} + +## Pre-selection + +The application comes with two choices to apply pre-selection: + +- Gender listed as feminine and height greater than 180 cm +- Character is a droid (excluding `NA`s) and has a mass less than 50 kg + +Looking at the second example is informative on how a user can create their own pre-selections. + +```{r, eval=FALSE} +list( + is_droid = list(filter_na = TRUE, filter_fn = ~ isTRUE(.x)), + mass = list(filter_fn = ~ .x < 50)) +) +``` + +The argument `preselection` is a named list where the names correspond to column names in the data set and the elements are lists containing the elements `filter_na` and `filter_fn`. The missing values (i.e. NAs) will be filtered if `filter_na` is set to `TRUE`. The `filter_fn` element can either be a formula or a function. The filter will attempt to apply the function to the data set when populating the initial values. diff --git a/vignettes/images/colsubset.png b/vignettes/images/colsubset.png new file mode 100644 index 0000000000000000000000000000000000000000..ecf1a89fec4eda244073e93bb3ad523bdef77f31 GIT binary patch literal 26801 zcmce;2|U#AyEi_S773Ltgm2l&5+Qq~$ev|P_9WT&eb<7LDEq!MW-!XmV3d%3H!&Ep zj%~6I#`4_0zjMy({GR_g&pH3|e_sDyW%&4P_kCaYb-l0m`?`AnL`#MGBFjYx1VXL) z_@OQYa@qp|IYqi~4jd87|IP(IC|w>KxrJ+R8+*i9V@;NR~Qt>75#V9ED}ho!hn&)8B4$-FU9rT$yNKtm*A+ zKYqSDD2sd^YnFxfwqLXTlW{(8;d70*@z#%K+oJKXFWS%d1#37b*8I9?crOoV=}NsH z)x2|-Ug_fLh>Lfdx(+R0Qrm}}I`<+ZzjR^d8>j0?N@b&XQz9v#5l=L_;#7?j0&n>= z!Lfi9e1{27YL{vIvgdin@0m0(s_2Ap?H+z}a^SoPPZk4FuBk`vRB) z2&2m1m()<6t5c58hYL<@L4ESXf9{A$XxWOxRc3;Yu?c2RN_y5aC5s!3LSua=?@$H= zTJiF3t=R5Oda?6g+D$$Ufy_|K_f^7*MCG-ir)aV9vwVRVhM81DIFf209>)B~B@p3u zi$&{hmabh*Zm3h{l*p2u)o-!cnPI^*ZCP#*e5Q=@nbH z+Pmxj++0F>{0vxg9b?#%7lp1wdilPNTUVe*?msqcy4_9uOgOyFR_+)4ZuJR#QqGK* zU#~?X1MBUeU9d1bEV*B4zk9cJPbJ7XrHi|QB1U-n~81X-y#f1>-)u&w2_q-p)doP(J6^@FvQo~Q1 zQ*9MdWZYskY)5o$hJOAWpCJ>E;wTw-c~Mr|dEifxI<)_riLG(y4s)q*y_cp@x|(`e zv@uLK=K+RPsOI}>p-=>hK>Rj<>53`aXzF)NOm51}P^!IWCHcO#zrRF*Gs@T9^tboJ z!*|GFRUR-HWs&pR_0o;2N9cXzbg8ZjsIl(FjlVgH&nhTyz&CzM-7j560Jr>rO{OrX2at7ilp6&8l|MQk;zMtIITs0oUl&FI5PFt^$x ze(|V!B4bI1w~<-aDW?Stlq*-0BCtLggIn#3ZQ9)%?C?f?=^M~(ok}U-Ac}1CJm7LVZs_j%k6ZO)Lh*Ti?V=16BDkhcOA_Yx}% zM(w$V6OmlcUfnaxhu@@IvQy1{4ue{l@wxmg_uE;c=Vm!o)Tl4AA2nLYq%OBPuA7jA zv!bB4T-0Sxi!drf- zN9`hWP6Z5?#quf_+w2q$P|j?#l8aUQSLaO&X8&O%3}a63$Kn!;2KEJdU5r$l<{cUC zFZ7>{uY$JNBlV5Uk!f4HgJBvBiqpxZFVl+bRO*5Ye^r^L#wJk;dzjR+DV|VtQROpF-HS7jkW`&T_r-w-jl_*>3AGEqC}3(l zc7s8dH!(M03^apkqZK*REs*;?mKpbm-t7VhGs_+>Z#<5HN=Hoc4jxILlAWVv~Q(j))t=44Pfe!Mv>t#8=f`VCldwax(52=KC zNK@nm!iaf8L&N@`X4*;*f-W}~7oV7zo6Oib$P5b$i!Kb7Xk={cNo*ipU4o3qJ-Fz> z5q$9V_smSC&-!nI4IM<|sftRtpP!!x*3`S(Ll5$7Ec8w|3JzDHq@*QWoe@rtK&AU-~Gy;15$4K+8UGk8DZ@5@kXPKVh{mP)j8P8MD>hk^3U>1cD@8jA|?=WEsd`Pxw1#Ps99fiIBr4kHU$|Shfr`yx=jZc|eM^yc@h%R>KLxa!vnR`M$uJ-jA2#v%<^S6H<(a zxDm^l$2yAS`Jlt?z}5`P{f%l2=V5a%{aswia=O%Zl`o#$m`#+U|1zkA@0SX|DV91f zI;J1$-8H)crhY}t(tS}uo?Nxnfiq%yYC9;k#qnl^{3jiMTRtYssCMfh*(>CoQEkm=4@ADS2K5PANMfe)pful)-fwlr zloC@J??-yc*SEIr_NrHSGp4 zj;DHWW#6KQFq=KHep9c`x61!&`M?Cv)5+eQYFpll_HN7}2HI{g-8B62>>GX6g(eNE z%F@#ztRK18=477pRn1`c+hFV?W9Ms-*TK{jH*6;weot)7B@PAY;Y~<^L{8deS&=|( zb2GWzZt%DyhJrhNj~+hcdwXSE^>JU~ai?pb@5ShASFYR+RRPnGBn_N-1@j*X2C4GwZ9b~3Daox1lJ zJPr7O__Va*nwpwqCz_MnodM_%@{;%EWiYJ&2Jb2jsN}0Cc{W}+%$^K;;1af%v%X%g&UicCPz~18zXgyYk1vGl~ zpiRx5+|og>rowbVcrs*KD(Gt$%P0Ohjw)ch3*e)EoTQQ?SQZar=xycoR}e-E+wI6L^?z@^B$ z@i$S^*!jXID6U~CLOsDJl-yZg+Ijcoy2(RS(|SngDB8jy>vf9W&ZH~u?!4F6 zSE+()s_|}K2>3*9&>3M&H z$084#$SiJEsBBj}pY!FhgcAKtEoC&xS@(B49dg6I?KVT{=Os0>>%4L=ku|L*)OSw1 z=4$Dm^L1WQ-+ul@+Hocgv-$G|(Z2A44~KT)?Gl@s?{y^)XjDEQFURHW*s&q?Kaq5i z$O{)7lvC{^;`#RkQh}))r%9U8-kj6OPsut%|q~;>(mLEm}1v zEhU#)Vq{d4)eN6IVFA{4h;c?eouiasbl6tF>+fBpo2h)UCM|i8vCALRe5IZ}p~f}y zI_q4j$Wth;Fz2*(Qi(Ch*2q$45#0OdN7j4rz9Zss@&{(Dn@r+RlXC6UR{vL%f0@HJ za#*DN@ap(az7eG|0B5{3c&CK=7rcu6tJy!M3i>uEnF{~Obn46Vf{4sNKSX9spt1vp zyj#vVl&0!8M)_;F@_6LKiAG^PB!~2@jNC2RN3Sm(s%>=fQnCDeEp%bMs$2F}N`od6 zd1+&Eh(cJ7a{8e4iPx0>Y9NP|{<^?soEbqn++0)GHnz%H5Nc}mi8LVlqUZa`+n6n4 zv(*JzGW4BePS9yM4_&1##(LxEiwX3u#;X=N3&o$lSEbg(sSW)~_(#6puCiW}W(>10 z%17G#@Q*2q$gg>k@l~R=C z_eB$7CM9~vEnYFP0V(q+g-apBN#rla^%FCM)2v&A!1D5_~N~7(Uy&OvoEc~*OIC#aWkje_cWfWsbdPAje`+9mfL)9|- zh?subvwLHBzT-xLDZwnZbd`$@y_B+vqRL#O$4m*P0&ppR%&Y|uQ80}5>g{LZJI@f+;PCoOsHvz4AWe7g?! zLcZ?$Sl+r>_Un5-fIx8Df&bJIeQ)Mq+%lUXl`gQUpTMwN_r`YU1Gny4l?D{5Z@+w` zsg@SCGx4La&+yY;tjVbAOl(eV&fFmv!^&VfVbEdwXgcs>^losK-5p1&eS*N0Uh&?Z zGWjAY(U-KYkB+oFCqD@SXsHM^9T{h>0KUg)Bj*<+*R)~NpOpuBt&TT$t2+;DYjms# zp-6@23RQ%|&7!`K=<_8SD--kk_XPXW_Rlu~E3 z?~Yuvh=1!}&zUTc=C%f1-TKAbX$Z<&-EL1!4THTcc* z_+mSiMLoLKRoJC%C=!{Nr(tD%?J(px1E3kpw_laxlgaRX-MRRok7cDTc?|8hCod>l zAyPK37bx^$oO}6I*S8UEJ9qd+8ZZe>su)UHLt$)Oh=hzx4p9a|tDvf_3RJAS&a3>M@~D~No-=*(qjS(E_? zp#9{|K8HDnb&SER^hg}7vmXvEhO&yM?6sm74# z9NzEMW;~l&eh~l_cfN-p1-*6z@tZzRuW%zUMFGDuS`8?WW8Rg0p7cZyG$}KAdBm(O zjk4Fi1gXuj#~*~->Cdd<#!0gqqJcNF5A&jfG&o^9VyQog(+XP;Su>{q`>;Qc!zDg;C zYI4VpKjvz@8;L6_zCzW1C+$g3l$e!lgz{ExI#{x5NAwOezOBMxPC%Pii;-UtRZz2C2Me*eGJsNOe6P3Vt z^^$KgD7w0Dodxt_;jT~A#*X#!FSkv`To%^ZH^Lt{zen7Fsn?qF+jF(+-&EYo!Ph7J zkk#W#4mSzMJXrE*U@HU&F2`B=@CHUZ8$gt}7wo5#7yqd9$(2?TR#q~+UCA3?!|h(N zYW{8w3{on9R^GUj7ur`!v9P+S(aTD6DOrtj|;hYmqvzTht#+ZfAG#S*)C`Axy{e>d&Q9t&&L7&rm;pzx#5t&oILK zY<#^El0Z+-(J)aQdiJH(HV;8xL#oLq?YIo;vVvS$uUMhnbH z$&x3la=JMKeuMNG@72cgt@L7wGgRKK{dPjuO# z7l4kpZGZ8?80h%i{S|C!j%D4ozaFp0NZOifeiiGEK0zD^b}tRVfv@tq1ixI)-v0NV zZLKD+Bo1|<`g*sLPkZ#NJFrB*^2c5lJurhPRQMRc+Z7e!3-jQ zgTw>R2wV0%Ym~)s)cdohz27eq6~~G^3*9O{5v3J?1@V4g^+LDd2QftnI59?jDh|Pc) zaqYY5D`LKo5Qz%d@~5&&=K|a-!}s^BZv(?cyr6Qfq5>$a3EV7nrzM%Ncr(try7)=O%DvZFs4bNaHLk61|)uHhD)N} zlkSF`EA$L9MYmz8rv)sJGG|{0cZkE_VT#O*$hryRvzH7$i$lKz^h$kCn{CLhScuJa z?dn&MkX*~$*N)3@pGVjlqm;*AqZ?E;JM_K6`VaF3{8NWKMmA+w%!Q#7RjV1IysEaw zP!IrlH5|8&DdZ0*Yh8ouE=J!$)-@f=OA$HT9?^#=4)WdKJ_-qP918j}xJACU;@x*` z^;-T-BCLdVh4!PR_Lm5}S;_Z)Wtp+mp$eWy)#n4B!;yl>xLWHXkri&Ianv{f0ph>* zK9YX;C>|*Dbm#}>xg1 zA@m61;Y0KeZ6M5E`=+UDs@m>JtqNF!I8#=+Pb{k&96=W>_&j{SMoC{EBR%Z+>8Q%D zrUT;WwTY)7FID6B=22VHA7titudS6mkzjP8j=81szSeSW-gmFdRKZn!3$(tXW}|TY0cjK8!zz6YtY=&4MeCN?js*CL=DhNuJ!8JHXILzlZyc|okes6 zFS{s?f;nJ2GKKobv(_Z<-w@KD!{{S{| zZ)l`1>dr}tO}qTmiOr!43g&R(eExIzd8GeMmQyH#13ZqW!M9#32H`<0$zqc!gOVlB zd2xUA>nC@vde?_U^>G3nj9kIrUSn>Vo}%zM&VZ}!zHhjRV14?#yvt6fUX1hnq?=rl zBjs#+`NT4_Xie1E7MBRPUDpFJbwE85J97>7lmAO|oRfJ5zl3@#InLiDvs7HNnpn@3 zjPyqs*6QY0O!#01%i@ca?CcVCV=12LMk@T2Ey-!@kqZ4@6J8AG(75hOC5BPxB+1@w zy$qklXYQ#2phNR<7K%yR=R$1n+Ch@T{v^ibC;qiZ+AcIBvFpBz1U(C7^6erU=RJ2_csK>1PzQ6 zxk{irEWYqh8crP#XM*%X6>Rvn76@lFr^QNs>Jfsaw~)_4@c0OhdSvhp)AvLr{6AVe1ob%b()?O-p=fCX-v+hY>J57 zD-xNk?Ukke9*kbUF+lPGDr`XD2l(j)7yVs@@saph4Vy_ryH`rMRCncc-K!Umr{+q8 z_k9Z9Ct0mY7g+k|4Ok~}c$ahbO7U# zqD$rHchNFBQPlnh&dLKeA1*6fT*rO(y!rF{Me*L7ADRTF_U2`X^=8_bwc}Tt^(jk- zMXq26`Z1};A%FN61H7RekhJh->0|UgZ>0-jai0`M><0B6Cua8OpH?=rqN40)FZMqH zNx{=;=@9`eonh3ca4r<=xpI}5<~OLF{%F*6yd^@LUa)+l&t;o9`$3>Y>gX?@NjUPN zUU)#+N*(I_g}=rlgG60kJ)F9T^&mbFbG~=cBx?2d{J+)$OxwxfrDkQnK~c7kGJ@7@ z5nMKfn_IXbD!5hxf2kN&mR3q9b>l#VPA2-gZoDl^m#F3JH#CGx2q!XyXfO&FIFtE? zmHO4%xzB(gAq~!d(b(h~{fkUXt1^pxe(ZJDkW;3rq9jB63*9H9scV&*7N0@zvWpn5 zXkN_Q)UPag?vwo(XpOQ-IRo3RXMdGvaC{-;h`Z#cv%i*V$KvYk zdAz({iB>+cu;8h{I?XZ4S$8L+>&oVmi{*P4^u*e_mmdhwTTN$ZHB|gXg+QV)wYQZF z*jC#p_SEK1V-R2W6NK?u{g#K3{Q(r=}`b4CC z)bG|uS!ml(ug@BgkZlUH7tB%$VgDI7V)FP^&&zUK8ymiH$5SEv5_j%!rFJU=t|KN= z;THXkRR#`@QWOfcY)22#s0Q3dOIzFEzmXBIgr%hoOG-+X78j@VghLFSZEPO1v9Z}X zIzrvt!~n0MPPx+j;L1P=h6_<$4RdsKTp|!Ych1$J!cO12JL(__?j{Is;p*xNrULR* z<%@!Y+>P@ml^I=H#s5=@@&Cko04VccDgeR)ap`qvbn^r#3V~33b(#L|O8R?UZEdK) zk?(JBz`)0UUOMvs_4)rBRrB9@<^O*!5f&I?OV@&*XsWAY615X+E>)Be$W#Htl`Gjv zN!P$)b~;su?_Br3KD;^f@ZrOsFU#9smJ`M*?U#r|T7vJ5eDP}BYEc)Mw!i9u8k7TG!>szU z+XK#%LmHXyUzC0#z34g7$hMLn@8qn2lBfR$y8X`zh(4qc&OM8`WHy8dGiVsL8VsZr zhAF#^YgAu=gs=`yF;oWpLWV{AZ%^|c+I==HO8jBBXR7MAHObYT`pSdhL{gtw9U2=$ zhEg$UEd`<8ym{j$lO7`{mHhGj`*pT9f`^@p%aa&-1_o~Qgu?WUlI}4tviNT9n~Byl zl7WtvDUE^0^~nx^`y1>X%^!sO=jCx5ef5cO4=sYhmlgZUkHM#D?uzAyfw10SWm)Wa zfiG5?X2}aZJTXy{ubvo%c77_Jhg%&PE`mvjicb08x_R@#?c2A3#6ECx2&{o>L}cVv z;Qg3RL{)cs$Np3pGW>qo>{*(P5SUOR$(BQgc`9E z6N5~>>|g(!f!futd=ukgU>H3Cw;tir=>Do1?7YC;YEQCM-?mYEJwMtI{3#vquQEmE zjgzQm=YTx?ovI=^5vbsE`25xkrGFOHElAjt%W2znc3y;a>qJDo7u+Cph5{wbc1$1( z*ix0PHkfr|79>lI`HnlrzdstQeffE%>d}73Vdml=oK~f2Lfp0Q1QX$OX?JBXJfkXy zWG+NQgDG4)b7!?2)ED5Z`nR^X5uhxgGf^b5TT)_Byw`J^5WA*OQZH||Y1wSvytceN zNEn1yK5x0$oh;6~vTz2X@i|J-2K&uRB1yoyvJ_JampGfRoqUTm2kX+`3l9Z*6y)P^C)=~Nb!lU+6V$zZiTKN+$K^1)2ccJb zsB<3mm^m6Xv=-hbs}&c+VOG*`1~WV&Rj0pUR7B%wf^?xx3Y8EabC3jMR?*SXiHL~M z)zFA^&PeNi84Kul$8y}N9wS9DYR&|c=j(UV|NYhZ?m@Xtm_yvL=&~gVu~KSKbfEaK zeRKy=g&E6DsJSa2i`KQo4$6(;aGrz#ZXv_6hcUcK>9XEhn+v^IC0hBst}YGvtv;m` z#o$I^lbWo?#>Ojciv&VHn%G!$bacc|bw3@JCW9LlRE>CF!9O6mzLy$n(Y0Ccvz}vu z>gRb3bcm0)zo%vIY?HP<0a z5Z#p>3I;m5+_O}SHs4;KJ$bT71<=QB*2Zfa9o-jt*!=q+VbL-N4FM&+9l8cRGh^G| z(M$V>r>v}22l{CSgOp7DNTKk`?IOdDj*fx-ak%G{&xf>mrQsD_gOO7WxNVd`=H!y> z%Olz-B)4d35^2w_F=*E>6?N7gPtk+xdx|(HeaXLEWbBzW-N7gFt03taK0QQqVeiM4 zA}j9}e#4mGzqd5j?5u>?kB#l$R?l@N3IfL&s69fwbob|1pyiK%!>NK*cT3+`d4;ib5oip{URmtdnNrZQ%u zS!a$%EakGQ@C`*d9np6J!k${mRXr}cQ;40k&-~-dE3l%33JeTfT3wCDts3a-$IbU< zmj3+t82|eH(NU0U#$Td#h0C(}XU;y739zk{RIG$W|1#bhQ%CFXroL#Wvy@AN>nEER zzF8&Nx*wSZ%BtFtCpu-GltHQCot}Kb@rc>cEDpx&(C717t9$ozWP(X$H1%6)RVqA1 z1um7=81+hl(T$2I9L&Bg!+BXDeZ(HBy&SF@)3sennNEWF?V|;^9$F-4cvRUQE%1D~ zDq)ipo5qo$e;8j`+e9Z|EgfB5`u_gt zbLY>Oq91tI20yVr@_6LU)5_n&j@X=7%W5vsg6nyqO%p}TckD5~!xej9)f0u=ovQ7@ zj0-2)ciFi(I2516yt{W7{Tm=5hOO7V432pwXh`L%;H_X6# z5`HE)xs*{a%f86h?7Xp*4N;`AC*DD9w_q?Hg7Bjqc#trVqBDw zk)a10Wp~%d)5|N0busd?l&ENvoD3xCW0!@nu-V)m!f3}ecf)*Dr!z_01F_MdU1`~p zej}q$h2uzd!1U|<#^)F6ePQGNv&H+56%P_=J@jJ^M;^(<`D@>^G0vK8iBVXCrqYkx zvwo#&58oc?m*ijQ-D<&U(DoYUE8^lYoGEM8_bzj>WjAHy9H4*^~`m|3{{Pfa>wt@_G2r4fAdGl zcBy7$LsfytI!YpMgBbSpt4>T@Ow83g7pSSJ5g3d)2zap>=Ly$62+dWUM%S#dY?K+7 zhrJyi-|qj+Ip52iEhH&v09<>W2O-88S80z8*p%cxxe!)rHVoWHpv91n0;K7+^4r=w zB@vajlSut|MRvutgLP=N#_#Xsox;x_Sf0nmSs=Gc%v@6wJ|=m-z#iDv1w4H!=yB!B zm7w6MGskQ(*`0Ls&x3}Q!wncXEm>gb5W#$Vqy zKu3AEU(MZ+8MRAr@5^s>Po$?~L!h0~m;H<3!S~j`_UE3HvAlpmqj6HltE2MTKUR%PeH!NqtPa*68L=F?B=QIP@$>c6=? zw~N&0F|!%c?&wL6jv)KAMxRQU3jW|;Z%fJ0+WGEaq6o4?UANwJx^XD@*O`fW-_3y7 zPEa@)5FZPi9>B?DgR5f>Ra4ELN?MrEvomA5sIh}DCTu-z3cQb@g2f9BIi%yoIC{Z! zXZ`km_F*%(c4krQwJlucViN`zUt{-vLB=yzRKTu!+)ceN#IY-Sd2zAtkc2Mv!@{Cuk@&o-77?`ugMRMI%^Jm z@Xds7yj@aj{bU=h;HJi`T=~P-K;&4xbj-;#PpMY0QX`YE_ID)BQKwhBuw1wRGJ4$}6xgNr1tPXXAn^i;IR2N>bq5nekiX=%F0w4bw79 zhm09EC)-%Pqv3B=n?&_SX%D@?$-htm$Y6P1)kB$GWz36m+hI1!{Z386%Ke1Tipkhk z!&PyEM~=^)-8()a9t*4bEoO&5xF`YEJ0dD-C$(DgN<+_ASgi8cO?tXH-*n+bb>J@= z1=4i#(O?GVd(s6{yHD~BkfL~cdw0&c5mrXagW6b2(}9P=Zu>zX(^GLIt(>x6j-ual zl%D<~2L`G5EjbG}3$2(HqXxT-6%O-$dkiKgGQ7dM5|6-ieHe`W5F2-yTUEVcweeB=)BTk=sRiiuJ|VAfox8`_WN|{cNHCmP|Gy#>^snETjMl+^1O;4)>|QUo}1O8N6_w70(a{C!gl5` zmGh3eE7ev!bUO1f(~fa)vQi4Dy(KHzHB$e2T1{cR-aWBD*85>=+?)|1eM~9urk)z4 z=XwugyB+){#=SAWTd@~A{k_f8kBqm&A${%0)xrHD=F+I1Vf6NoH*~Du%yxG5#scmH z|L~38X9_4dsOS83wZaLfWaJ&F!ikIvZ_vsq`Y+hwxi&^;q zqVjyHvWk$P6B zsdAjz?Wcv_UYew~Xn2a>T84EVJLm@~9oN7bBvTWUvI2u$GY#H8xomH1+Ycau2Wi4P ze3iWpI73i3H3%|G>%%}lxcDrv*ms=>!3Mfo##XK{lQYz2L+G~NMP8zBbL#sE_WWXU z;-c|#0=c&|HSaw|oh`H5$9M0pNqqUpadp9VdqI3?=UAZ#!@4w-uq_zpQlja6xDi5g z?3662c-+Ezt4me4IN{Kl7BRosQ1|=N_PKSP6e*Fd>~27yAZu$4m6Vh$C{Ji68Sl06 zLMF}(M`4pcaVtcCCYhZmA%DG)M1xRYAV^}#VYJy!9Dp8is~*BUS_&^Kx7eAjbalT- zO}IFrzv!mFbbbz_-%JpemeB4jlU!`)%^a#@=<-atG_%14C;|*2oC$}+Z4=;`OYWKE z>w?B0I<^+Gp0JipKQy@dx{tn!0-iAP{r|Jy%;Xmq>*e85SWuwc-Q7L2h7Q28I zeP9xy@h%4!IbE}$^^lN|P*Yde3ko`_AvbQ17$Xsg{#b1V=Czlh6Nrslb44bVdqoFF z9Du(wc=9YhCH2{foWP;i2E3ln`0qusM^ zKmO1e9*u*Rs~gU#czR&}NP7?O;_v!YxC45R!t&caUR7#8l$sy1%Am4xZfyKd8hfwb z{mx*WqOmcfcxT%_cSX{<^42pQ`vxDp{HupY670)q1ThD3dBSWH@udlHvu!7TC^~f` z{EWfODfy!nv3RUsCiy^2p5*C%EiErGL(d)M+SP66vtx+K+TFz{fc}~NG(bUyS@qxJ zb?lj#Y6xEz2(H%dso zeBd+P*I&#ivG@mDzGc!>5D70RWd_z_s2b6k=S3%U*ncvi7%jts!iAPX)T=5*U zuKMyF8c$&}lvU$2Age?A#{az18u$|+a(i@J}{g0O)onw3OM=-D1~Dr+!&m`44)Y2fTrkd%9kVl z)gx@1yb>a&BHyG`fg3CtW=a1@%W)Sy;Wx89DeV#C&7ST(sdGPeRsntM3^$ue)q+&ge6pf;4Fg{i7fPQCSJ4 zViMMW`0&SD?LXhCMEHb+gz`R6VZgqS@!goEc7=n+q>$wkZ~bq?<}X2yWo#)-Q}d%) z;P$X9Nn-7!qbH;Rb-^K-rjzDCCC?5{bm)VX*b z1TuBUH!H2I;GKTb(VrkV2A& zX5^bns2q;DX1Tt=1v>un)YmgM1|11fMa4W zrGU1tRi-$t&!`GUrQcL zI1xq@?_5t5s~{ggo!i5=L@)MV;-5hX8O==`e-?RBn4K@QODX1M|G{--NW`X`Wk{|A zHMWr_d26TY_cxXJY(@$1$94g#y|&dEV$@ekJ4CSaiDuU%t^?=zR$!&bgxZ%@&0p&A zsA7x^N(~dBTlVPj@eFAoxFq$!6=%efm&g*gtvi*_?dKM`AY?2PxJj%tGR_NY_LEz# z4H048RS;zv2Z#e&cunZETSeffejviyRB{K-t6u-Qc;*)^b)&b z^eCn75n7x^5MO^GXFUYJWCX0ZJ*5ilf8L?MBaAAm0xz4QJXFOrKOOU{#MC_4#IVnV>o@T9XA!j%P5|8kde8=Fxqt)sz$nB*^1VS_YlimH1cX7v`}d!_ zTPtKw+|;{w?>+$yp!?+@z=MD#<`~#~pl0n9z3deCueAWxI9M`x{d+z@?0p3KG3%Xf z%)V6yiZ&!kfv(-`2C+R&8r+H?{(0rmC^Z=8KQ-b1S8MW5efvxjgVaqF|FII6+WUW9 ziNoL7SJbg;VP;#AWdB02XC2&HB`GH+boF0Em8^Ua>Nhw~MJ3coQ zofjjtuyXKbcu(*~e56b4%$gMtCd)sXvX%S(C_1T8#P#Sz96Slqq{ zcwI}&-2MIig6(=hmuJn;j(PT7aA*Hpgj+_Vj(?%FJ$6;BJ-*-ysFw|p^Uebm)02;y zPq-OZwMJ6;*q)TVhmUDm3|d6sScMpE)}H#jE1N1DCAAf69c?$diB_4I>yWk9AK3SMbrno|={xdnH@z^=^eYyNS&7!QiRETIg#Q(^4!7`H>RaRT)QD1id{84vO!K^NhI0@C6Q(;k1 zDi&im&V#ZH*%K?ZckAgGc5YxB8x=t3e#fepARv!{QVRo&i1W9H!NC|Veo0BMv?nA~ z&~6FI6F(zcxo|!hAqW@PexuZD>;Iz6?jp>8^2Gu_be?JH898t)4Fkh##f$|3oi5G+ z+Dvd`>o8}ipB?p9JAX04V|T#LG03iz{cH7NWuh12k5qfiX~73G6_%qg{VEliCvH#M z@dAUHfjqbK1X8s7M0uqZR%BK+BV+`$@PlS6!0Q;E@W2qJTYdisphoNK>q{#uah-E4 z)jTfS8c0NEou8;!alZvproeR>*arG%-z{renJt&(pw-OALEocGUBhh zVS}5RuiCcN@_!zy?EUCL12 zU>hDlvK&N7(u=UP0?V$HqI>`Q-K9Z>dae6EGQl%*H* zlr{M7UAH9JOu0r;?8Jnoy}cmF0566872T#}Y|IM&s|b_E0N*EqhMJn)j^TCL+>(3SF)r*?I+9qBWf?U>wWZjaC`4eaWT;c;&b@=%ZVk*;?>FcKz&#km8^bRpTecZN5j2( z^tsHq1a(5w(&AO(wDp&TPc=rk96|-RzP!II>axcqQHTkv(i%edn7i$a`aG9C4Qk_> zR}g`BZ5Bk1h(tqS`JO2PQfi$P$b zNdHmBcm4)T-^(S^q*~IaM3MrY@VcQ+gJ>q|M+Sc>!`ge${!MzkGxY}hqVm!)$ zRc!S0O0b}zNm#2=>6p8}TdJa>B0kY8p?Ianm>7W7Ims0Z1=yfam;*W4ta?Cg9^1hs zX2zFANeQXaXJCibX}3&(&fjU6-D#9C?U_E4GR#ctQ*!?8v6Coqkc+Lez{|_q^rfVy zr$+&aJ-NGo&^MCk@Q@%U*bkGF{3xdb&^pam;-K^n+T2EZa~UwWG`(!!9cUB%Acot zv@-Z5r(Nc|8Nwzm+naRhZ}|sEDAt9Gfls+voE;sM2+Dh$YIh3F_P3rzJ$R1Yru+p( znU$60aCr_VAtCV(3uA>sLxK1dz&)*E)6Udeh|BY%cNE+5My1u&i7hQHJiaM_Lk^+2 zMoRPi2pe5k#)rG>qBH)4)v-<+#9=+r(2M?Z=Br{LHlxsKc!nOS@h=dMXj&YtG-bZk zvszS;RoG`lA1x)ST7K|&uQF||;048zn2eLN^Wf~Pio3fQP_8y&s*X=ihJOEsc;uz0 zn|xAKUQ#=F3aPG$!^!9pIeHv7?S(%8MU#Y)u*Po?#>RqshSqbmGBuqNp?!=2W zPf{;FZD}%+@sCvpPWk=^a&s$qbd70YI-2ew5QL_QpunXo|r-Z*#PSr&|#*grUdx!6%-U2 zJNf4CvdmAbu#rI`)}bMh?!4^&SSMwgbxwP9)UuRDi;{>h2Y6pa7#!7z!ZJTzhV9xv zKJ~KCSjK5eGJMYBTKRDC&<$!o7bX!N+373un?au9$i4E*7yg1Vu{C2_H=4q!O6Kub zl__q4gRx!N=U;o1t_RCq^4LPMu0hvs%^vPAirqPUtESbnPjZO8%GkQj2q_GlA?BYL~mq-9}Yp`)|2ao)~u zV>sto7?)Pz1L5Yf%uGLkJiLSbm@OtG|B_=gOxyuO*il40nj(--x*xg_aO5 zC#@%EAm^#pz{xj5TJTTl;udYNbIDy__h8T~hWjvK~Xq3(bTvOj&+g-JO&0O{NpQy^PVWPuq&0Vw2Os)9rfca*j^PydY-282Vm2E#&me z;Z6e=tm@%`vsPGr?ugP3C7}iIc#l|E28V|DIK#C$$w3KHL0MVZPWRcf##C&->gsAH z>LBOKl@6wV78jKs`IU~pH#f(PWy2E~JpLXT6{QW%G7U@@4j@;HaHmIF83qa_4H#Q0E8h7TL z(Y>!9Z45vs}!y_d#o{Xhl4-v;3-!M6K1q05;z+CBe^?)c?I* zlGifVaLyqA`-v?baaemZST6BEtM{;q8>^g)gN-dN8vaLG+SJX_+b-rHHYtgE)l##Z zbj?Ft*sA|vW^7Uzj^DF#*E)!6x{NtwFJLXOQhGktE^DRY>*3(7YQ9+w@3qzm0?Jb?rB~^($3bi}$Oh2RpTi&E7*Y zKg0(8JV@mggC2CA^(IRs0&i+xz(G;bEbZmx)zTmTGC#j=<#+&oBrU!4;z6I1PTc$A zw8syl7BEsO%a>18S&=^EO`lB%BY(gi=_={01vi|<8txT*E3iALAr-P%nh@MST?}(H z^s#R@!8R*cSzYZPhjoB#J|QuYos*MadaTgjUp^yCKQfwyi-!*=-nnu3{BGQeao*dQ~*zURBgEKNRK))Tc z5T(FX&NrRGu7U-*uUKEmq|dhg?31bOE~~C~f0@F~$k^t%rI+~K&@h-i;fQe(4&Cs9 ziO=NycBun#so&JOM5T2zh)1TxK)SlG)s#R#`{c@&9eqaFV3~X|uOeuMH5OKk*_2w~ zZ)i_ml0(nRo8{rNFftCIFFAzO2ihH_gxiB|Egc?iYm(m{=wCPaF@A-z9h0NyTCoaR zxLx6N%yqT8siAJnlQ&R>jf{mJPEaJgpzk+A3z0{9dZof_yp0J{`lv0g*8;aW#}M9~ zh*OH6KYwPQ&(GAH*~(d@hooOS`+Wsxe*RpLJE`fkMTc1AfC;%p?^+ti#9>A_iMqt& z2udQ_nK>cv*Z(wk#Hj@}L; zKRCo-g{^>R$Ja*QKlqG!ySF|}l#IV4mEwtL{Z+$5=w#FT)@AQk*!fkYe$PxzXAZH- z{z{tIhYP99=$M#;B^tzG{BjZJH-CR6_mhHm9B*BB)UQ)}36Z|np}DaXK5{Wxk)u;` zSPh#?v416SFMIx75?=1|Lk&UJ-(AmVJO_{h}5Q?sQZ$y zw>+CNLM*;UjF8+n)irsg5+A?QmHHqjadPZ-!o-zt$rg>#*tTlkdr*T<72_;*0^dqE3XVn=;}$$e4c^v$Rx~uh?9z zGPxJX*5*9M>s2cO#t19QhH*%#1b=WaGW|`lk+E1e{LI|tV1$*O3)>~!JLjA+zM-vP zws)r>_JC=x*Wr>OVev5|qsjWbo2@vuqT}4QSs_d03PbrHMkosU@)7ae6+ih=l`w7d zz7j9ibXl;W_Z^}gF`7ZRR3PT9ovGK4`YEZDG|mbql;lqt0ahGl6+o9`|d|D&rQ#D zNIYyX)O9Op(TxM4f|O;cWUc0i?YhQ3qDr@(K!6h|OehX=Y|WfJE57DM?Fb zD!DCwRL@V`MJs|;xIBch|7bSXwZ zg7ybv!9-UeMIqZTRg%qfya$Ga*9H_ZK-a)i*iOsXURQ7LGAMO4P6RN{QWoG zR9sTR`kwt?B@;@{&VoSb`i27;+>s53vUJA)j522@Y*(o#{Uk?ITKaBOXA7us#0lBX zf?&~VJRdTNb9Lsz4Mj-p=o*MuK?4kvI$KsLgtauDRKkA&h4BxT0U18v!}0pr{yhtP6&TU}$WNLazbN3jiR=YNd=vQh=~VhlI$t zwH8ALlC_jSq7*?qPHMzAyIO8-SuZT`>!|{>!;R`(+T>A>i+Y8#BOTmHSp`y8Y*7e= zN(hXDp&>eBhM}aOfLJwY$Bmt-`h6g{PHgx;m%!K%^2*As%MKCo@l@O8B#;Oy76}Qu z*lqy}inp=dGOII?)k0>cI!HQj*7@966Tej+>}ftogbcx>!z_cCal^9AyWo8G7xZbSN- zRBDl)-i$@z$n{gIAH{vHwFa>13efw2-!}a=mjieOBbQnO@SlB=%!(EN#|P`d~?}Ni8gTDh028p;0yx)(%&W{o2$5U3|aE$G4 zya40>J=CCFv&<=+D4ej4W^g8&GRw_FR;4Ki>OAhs#q;3p1Fhe&y|S(GYA7ltoA)9k zMAwG2BhkcSUTsoYea*`c+uIf3XKX1vf8uBY(i0AhZjN0$_UY^s)q*dO1oYkU$4COq zWnv?`b8eroyjRQY-1P@)(9n76sVAHs%7E&eVGmMV} zjhD4`=EGISjeIu~zPKvx@$n1tYvB}e(PG+usD({tNN=?&k+txlIO`|_^)VF|{A}Qy zRNS`ofnC;}sb+U!5z~^xJ=k#)t$X4_0*uP15(xUFAJ%T5d3RXd{z=LUXEA4Y=AO^H zrg4rNN*5|S+Is7l;GmP!I`4TDRmVX8ns|+v%dAK=;$t8mj?}L3Pmzzir{jhO?E$ft zK03*0q+I4qsHZo*yTLueml`g!c)FTRNkUexSEr)rGZQIVVOmT{`+d~FxA2rr47(8V zMq<)%l-wm>-6OrWMeAY}{dJb6iRgY6cjnASF6H5pQ1`r#NA#m=s-)UW+(fQ}3m(PB z`U3%W{1Mls$Sy9d#K5j&A~7>%!a|rbd3dYD=Jz`G7{8=!9WATXfxbu|Fq7T4y@utpAqgjzZ?7`BIUnOO7r&!ZJSSY{jdH$Tj`4|UVh z>xU&0Cgu~MV7#XY-U|@{t7irsQ6BJd;U*7O$HNyJzjmt@tgTa>Y#_H}tQ0Li@T>C^ zA5!_$VAoB?l|2aiBKxDLUu;x)i;IK0rdLh1Ip*m8?K~aT^;S1D_iG?w$9t>UgcJ%I zM~xx+>;whxhP~xfHcAzvs;LkXIOW@E#W_eJx)9Vh8;6GFy^(?F|0}SI{>POO4eINr ztGJS1{Aixc{Sc>z!Wu?vPbE|R(+XL8bRJtLPLzy$AK>k!xS%Mv9_f}^ewcAozwE&q zm8cE4P%Ecu-`mZIIuByLBCmSs(lsVCXvdR+JZ_vKV46noPK&@t1c6Nk_oCv@^QWGS z#>ac57?x)|-dJSJiUUPq}prrCo5JtVPWvol4iV7qopIjX(VWZ67ts3~2ZG2vI@g-$dEnYRE zdEcL6+Rq1;hE3vzgNi(P;xUd+v}5N<3hZDMy(r~{HATSHBT|MMY}+rZ3opM?ZKLC$ zoDTSHu%b zo|V?Du+h-(!^_EJJXL&6dbAW})%$g(pLkZ#k2$F#qA%xrv%XnVfVmyQbguuW)LE$M zcFNDJ42+e!U+~OK{Mar0Vgj#Odv$%Uq@&~TkEXq>yJw4ayXg4E*Ia!mEUU;T?+M%0 zlwBXRh-_F;z90J#U+i9KCb1_xZaw}n68Ux93cKsE$PT(K=H=EGTT$W;Q0@@7CY~C9 zfhT4#t4Ln>{_?iq)bXu4Z(n5%-3~kl;G_bhSaS=vk8RjzY|W>z!lKNlf^85T_JW0Z zxX#7DrcYeiCK|ujY7cAf%r70jJ0zCno^b7u>Ql)oU_@<8h4z~HhVL#l2pV1roU3u( zL#SL{h!Tlgn-HIF?nRT^H$5+4e)Td_0)MJqERhgxpTtrt&J+zFuP=p@ijBo$3f8e!qqPQW z^+0>4bk@U}Za}~Q%0v1;;T--qe8s=Lm+>Abso;gRlWrH^@FV^y?Td}3yfUS>(mqgj zcD(W_iSN$?z*PLjt0r~}{*)r4h`$Nj(I^WUN=Uc^rJ zd&R#O;px4Fw_eBEK1^i`cbR?YqhRla`)_$vQyK{n5UA9jq-Di$0GF5{pCjwWu%Q2fxQ@a z_*}}<`N{YV(}}&DsZzg}e(t3y716<`xU7F=2ewdEcbNTWX`yukHn*j5jrbs7d`1mZNL^E$!-X{ z^*sAtubpexESrZ3Ge*B!BbI?D<@hxXHdF|3pt!9w%)FKN&eEmmLw(aR2z#diRFjWp zx&LW(fZ~g$Nm`mPSoZe?EjrZGO@rT${X`(~ykHJUXyE4Ai6s#>KEr%J!oN9&s%vaE zp!)9R6X_Hc^OiQ+gnoP1zpNGZRe)+HC7-|Sx&E8DeP^yR+Lx!(7f%^U_FdUB@ z!WGQPNW#Pdawj^gA8l>2#l^+OYV-itLiQa+k)ZDRuIF<2f3z(B&GaGIqEVgFce_V! zJVwW(eYe^;r7ZvB5VipzDgn7V>ua`~y99u*D_{YO_wQmO5Ap*=HsB{l)NgP!i44Hy z0KQjMRTXM+LL^wzbiIAJnL*(DKc2po_|LLl+U{C^$l gf5zqRTw`HZ%|8fEnFhMRTelQsRHT1BfA{IX03dPGDgXcg literal 0 HcmV?d00001 From d9d2f12ad019bd10f23095202d452fa0d1f932c8 Mon Sep 17 00:00:00 2001 From: Jeff Thompson Date: Fri, 22 Sep 2023 10:56:14 -0400 Subject: [PATCH 082/101] Update some language in vignette --- vignettes/IDEAFilter.Rmd | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/vignettes/IDEAFilter.Rmd b/vignettes/IDEAFilter.Rmd index 365d04f..4a6fd9f 100644 --- a/vignettes/IDEAFilter.Rmd +++ b/vignettes/IDEAFilter.Rmd @@ -43,8 +43,8 @@ The server side of the module returns the reactive `ShinyDataFilter_df` object w With the release of `IDEAFilter()` to replace the deprecated `shiny_data_filter()`, a couple more arguments have been introduced to enhance the functionality of the filter. -- Column Sub-setting: you can now restrict the columns a user can add to the filter. -- Pre-selection: you can now pre-specify a collection of filters to either pre-load in the filter or for users to dynamically apply. +- Column Sub-setting: restricting the columns a user can add to the filter. +- Pre-selection: pre-specifying a collection of filters to either pre-load in the filter or for users to dynamically apply. To explore these features we can run the following example application: @@ -57,7 +57,7 @@ runApp(app) ## Column Sub-setting -In the application you can freely select a subset of columns to include in the filter. You can now freely set what columns users are able to add to the filter. You should note these columns can still be set using pre-selection and will still be applied to the filter. For instance, you can see below that only `height` has been selected but `gender` is still being applied. +In the application you can freely select a subset of columns to include in the filter. The `col_subset` argument can be set in development of an application or can be a reactive variable in deployment. You should note these columns can still be set using pre-selection and will still be applied to the filter. For instance, you can see below that only `height` has been selected but `gender` is still being applied. ![](images/colsubset.png){style="position:center; width:100%"} @@ -68,7 +68,7 @@ The application comes with two choices to apply pre-selection: - Gender listed as feminine and height greater than 180 cm - Character is a droid (excluding `NA`s) and has a mass less than 50 kg -Looking at the second example is informative on how a user can create their own pre-selections. +Looking at the second example is informative on how a developer can create their own pre-selections. ```{r, eval=FALSE} list( From 33e18eede517a8b88660e08cf75a4ea9f3dbaf0e Mon Sep 17 00:00:00 2001 From: Jeff Thompson <160783290+jthompson-arcus@users.noreply.github.com> Date: Tue, 2 Apr 2024 14:13:43 -0400 Subject: [PATCH 083/101] Fix some issues introduced by changes in selectize.js --- R/selectInput_column.R | 4 ++-- R/selectInput_proportion.R | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/R/selectInput_column.R b/R/selectInput_column.R index a548cc6..d7f5ada 100644 --- a/R/selectInput_column.R +++ b/R/selectInput_column.R @@ -45,7 +45,7 @@ columnSelectInput <- function(inputId, label, data, selected = "", ..., // format the way that options are rendered option: function(item, escape) { item.data = JSON.parse(item.label); - return '
' + + return '
' + '
' + escape(item.data.name) + ' ' + ' ' + @@ -57,7 +57,7 @@ columnSelectInput <- function(inputId, label, data, selected = "", ..., }, // avoid data vomit splashing on screen when an option is selected - item: function(item, escape) { return ''; } + item: function(item, escape) { return ''; } }")), # fix for highlight persisting diff --git a/R/selectInput_proportion.R b/R/selectInput_proportion.R index f0162cf..ee0d8fa 100644 --- a/R/selectInput_proportion.R +++ b/R/selectInput_proportion.R @@ -53,7 +53,7 @@ proportionSelectInput <- function(inputId, label, vec, selected = "", ..., // format the way that options are rendered option: function(item, escape) { item.data = JSON.parse(item.label); - return '
' + + return '
' + '
' + '
' + escape(item.data.name) + ' ' + From 3829ec3c828f0cf7d6c1320055b6389e64bd009c Mon Sep 17 00:00:00 2001 From: Jeff Thompson <160783290+jthompson-arcus@users.noreply.github.com> Date: Tue, 2 Apr 2024 14:46:41 -0400 Subject: [PATCH 084/101] Fix minor bug applying NA filter to logical vector --- R/shiny_vector_filter_logical.R | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/R/shiny_vector_filter_logical.R b/R/shiny_vector_filter_logical.R index 2634cfc..31ddb3b 100644 --- a/R/shiny_vector_filter_logical.R +++ b/R/shiny_vector_filter_logical.R @@ -18,7 +18,6 @@ shiny_vector_filter.logical <- function(data, inputId, ...) { ns <- session$ns - x_wo_NA <- shiny::reactive(Filter(Negate(is.na), x())) module_return <- shiny::reactiveValues(code = TRUE, mask = TRUE) fn <- if (is.null(filter_fn)) function(x) FALSE else purrr::possibly(filter_fn, otherwise = FALSE) @@ -60,7 +59,7 @@ shiny_vector_filter.logical <- function(data, inputId, ...) { if (FALSE %in% input$param) exprs <- append(exprs, list(quote(!.x))) - if (length(input$param) == 2 && filter_na()) + if (length(input$param) %% 2 == 0 && filter_na()) exprs <- list(quote(!is.na(.x))) else if (length(input$param) && !filter_na()) exprs <- append(exprs, list(quote(is.na(.x)))) From c07de5a7a657e05d879e3e61e7a3dc97ad0a2da8 Mon Sep 17 00:00:00 2001 From: Jeff Thompson <160783290+jthompson-arcus@users.noreply.github.com> Date: Tue, 2 Apr 2024 14:47:29 -0400 Subject: [PATCH 085/101] Don't show deprecated message for `shiny_data_filter_item` when called inside `shiny_data_filer` --- R/shiny_data_filter.R | 35 +++++++++++++++++++++++++++-------- 1 file changed, 27 insertions(+), 8 deletions(-) diff --git a/R/shiny_data_filter.R b/R/shiny_data_filter.R index 742b2a0..5ee1b1c 100644 --- a/R/shiny_data_filter.R +++ b/R/shiny_data_filter.R @@ -155,12 +155,17 @@ shiny_data_filter <- function(input, output, session, data, verbose = FALSE) { filter_returns[[fid]]$destroy } - filter_returns[[fid]] <<- callModule( - shiny_data_filter_item, - fid, - data = filter_returns[[in_fid]]$data, - column_name = column_name, - verbose = verbose) + filter_returns[[fid]] <<- withCallingHandlers(callModule( + shiny_data_filter_item, + fid, + data = filter_returns[[in_fid]]$data, + column_name = column_name, + verbose = verbose), + warning = function(w) { + if (inherits(w, "deprecatedWarning") && grepl("IDEAFilter_item", conditionMessage(w))) + invokeRestart("muffleWarning") + } + ) } output$add_filter_select_ui <- renderUI({ @@ -197,7 +202,14 @@ shiny_data_filter <- function(input, output, session, data, verbose = FALSE) { insertUI( selector = sprintf("#%s", ns("sortableList")), where = "beforeEnd", - ui = shiny_data_filter_item_ui(ns(fid), verbose = verbose)) + ui = withCallingHandlers( + shiny_data_filter_item_ui(ns(fid), verbose = verbose), + warning = function(w) { + if (inherits(w, "deprecatedWarning") && grepl("IDEAFilter_item", conditionMessage(w))) + invokeRestart("muffleWarning") + } + ) + ) }) observeEvent(input$add_filter_select, { @@ -210,7 +222,14 @@ shiny_data_filter <- function(input, output, session, data, verbose = FALSE) { insertUI( selector = sprintf("#%s", ns("sortableList")), where = "beforeEnd", - ui = shiny_data_filter_item_ui(ns(fid), verbose = verbose)) + ui = withCallingHandlers( + shiny_data_filter_item_ui(ns(fid), verbose = verbose), + warning = function(w) { + if (inherits(w, "deprecatedWarning") && grepl("IDEAFilter_item", conditionMessage(w))) + invokeRestart("muffleWarning") + } + ) + ) updateSelectInput(session, "add_filter_select", selected = "") }, ignoreInit = TRUE, ignoreNULL = TRUE) From 27de7cf5130c4022e9b849c9a1de9ecaa5c494c6 Mon Sep 17 00:00:00 2001 From: Jeff Thompson <160783290+jthompson-arcus@users.noreply.github.com> Date: Wed, 3 Apr 2024 13:32:48 -0400 Subject: [PATCH 086/101] Polish NEWS --- NEWS.md | 22 ++++++++++++++-------- 1 file changed, 14 insertions(+), 8 deletions(-) diff --git a/NEWS.md b/NEWS.md index 8c75226..15c0269 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,11 +1,17 @@ -# IDEAFilter (development version) -* Fix bug that was trying to assign an attribute to a NULL (#15) -* Fix bug that was causing inaccurate filtering for `datetime` vectors (#17) -* Add new implementation `IDEAFilter()` that uses a more modern implementation and less resources (#22) -* Allow user to restrict filter to a subset of columns (#14) -* Upgraded `pillar::new_pillar_type()` to `pillar::type_sum()` (#9) -* Allow user to easily erase the applied filters -* Delete inputs and observers from vector modules when exiting them +# IDEAFilter 0.2.0 + +## New features +* Added a new module implementation `IDEAFilter()` that is more modern and uses less resources. The old implementation `shiny_data_filter()` has been deprecated. +* Added a feature to allow users to restrict the filter to a subset of columns +* Added an erase button to filter items to allow users to clear applied filters + +## Minor improvements and fixes +* Fixed a bug that was trying to assign an attribute to a NULL +* Fixed a bug that was causing inaccurate filtering for `datetime` vectors +* Fixed a bug that was not always including a selected NA filter for `logical` vectors +* Fixed a bug that was causing the column selectize input to fail +* Upgraded `pillar::new_pillar_type()` to `pillar::type_sum()` +* Added trash collector to delete inputs and observers from dynamic vector modules when removed from UI # IDEAFilter 0.1.3 * Cited works of other contributors (`shinyDataFilter` & `SortableJS`) From d97d981d1167c14215914dd53bbbb4ed388e3e24 Mon Sep 17 00:00:00 2001 From: Jeff Thompson <160783290+jthompson-arcus@users.noreply.github.com> Date: Wed, 3 Apr 2024 13:33:05 -0400 Subject: [PATCH 087/101] Fix URL redirect --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index f5feda1..5f77bda 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -33,7 +33,7 @@ Authors@R: c( comment = "SortableJS library"), person(given = "Biogen", role = "cph")) License: AGPL-3 + file LICENSE -URL: https://biogen-inc.github.io/IDEAFilter, https://github.com/Biogen-Inc/IDEAFilter +URL: https://biogen-inc.github.io/IDEAFilter/, https://github.com/Biogen-Inc/IDEAFilter BugReports: https://github.com/Biogen-Inc/IDEAFilter/issues Encoding: UTF-8 LazyData: true From c512f021dde286c9d64e8b196ef70efa344e9be9 Mon Sep 17 00:00:00 2001 From: Jeff Thompson <160783290+jthompson-arcus@users.noreply.github.com> Date: Wed, 3 Apr 2024 13:33:20 -0400 Subject: [PATCH 088/101] Update CRAN comments --- cran-comments.md | 81 +++++++----------------------------------------- 1 file changed, 11 insertions(+), 70 deletions(-) diff --git a/cran-comments.md b/cran-comments.md index f3d5371..cb61086 100644 --- a/cran-comments.md +++ b/cran-comments.md @@ -1,75 +1,16 @@ -## Re-submission 2022-06-27 -This is a re-submission. In this version I have: - -* Referenced package names using single quotes in the description field. Also, spelled out 'UI' to 'user interface'. - -* Added appropriate `@return` roxygen comments for the following exported functions to generate `\value` statement in `.Rd` files: - - getInitializationCode.shinyDataFilter_df.Rd - - shiny_vector_filter_numeric_few.Rd - - shiny_vector_filter_numeric_many.Rd - -#### R CMD Check +## R CMD check results 0 errors | 0 warnings | 1 note ``` -checking CRAN incoming feasibility ... NOTE - Maintainer: 'Aaron Clark ' - - New submission +Found the following (possibly) invalid URLs: + URL: https://bit.ly/demo_IDEAFilter (moved to https://rinpharma.shinyapps.io/IDEAfilter/) + From: README.md + Status: 301 + Message: Moved Permanently + For content that is 'Moved Permanently', please change http to https, + add trailing slashes, or replace the old by the new URL. ``` +This is an intentional redirect that allows the package maintainer to monitor traffic to the demo application originating from the package README -## Re-submission 2022-06-24 -This is a re-submission. In this version I have: - -* Added more details about the package functionality in the Description field of the DESCRIPTION file. - -* Removed `@examples` section for unexported functions, which coincidentally also removed an instance where `:::` was used. - -* Used `if(interactive())` and not `\dontrun` in `man/shiny_data_filter.Rd`'s `@examples` section since it is insufficient by itself. - - -#### R CMD Check -0 errors | 0 warnings | 1 note -``` -checking CRAN incoming feasibility ... NOTE - Maintainer: 'Aaron Clark ' - - New submission -``` - - -## Re-submission 2022-06-11 -This is a re-submission. In this version I have: - -* Clearly identified the copyright holder in the DESCRIPTION file, and omitted the extra LICENSE file, per request, as it was not needed for AGPL-3. - -* Reduced the size of the package to be less than 5MB. - -#### R CMD Check -0 errors | 0 warnings | 1 note -``` -checking CRAN incoming feasibility ... NOTE - Maintainer: 'Aaron Clark ' - - New submission -``` -## Initial submission 2022-06-10 -#### R CMD Check -0 errors | 0 warnings | 1 note - -``` -checking CRAN incoming feasibility ... NOTE - Maintainer: 'Aaron Clark ' - - New submission - - License components with restrictions and base license permitting such: - AGPL-3 + file LICENSE - File 'LICENSE': - YEAR: 2020 - COPYRIGHT HOLDER: Biogen; - - Size of tarball: 5464618 bytes -``` -### Downstream dependencies +## Reverse dependency check -There are none. +The 1 reverse dependency was checked by running R CMD check using the development version of this package \ No newline at end of file From 747a74618be9a05cc8f27ccf401496095095b886 Mon Sep 17 00:00:00 2001 From: Jeff Thompson <160783290+jthompson-arcus@users.noreply.github.com> Date: Wed, 3 Apr 2024 13:33:32 -0400 Subject: [PATCH 089/101] Increment for minor release --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 5f77bda..4d6d7ff 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: IDEAFilter Type: Package -Version: 0.1.3.9010 +Version: 0.2.0 Title: Agnostic, Idiomatic Data Filter Module for Shiny Description: When added to an existing shiny app, users may subset any developer-chosen R data.frame on the fly. That is, users are empowered to From 69ddbcda1650c9a847ab639c4b23d6402b02124e Mon Sep 17 00:00:00 2001 From: Jeff Thompson <160783290+jthompson-arcus@users.noreply.github.com> Date: Wed, 3 Apr 2024 13:44:20 -0400 Subject: [PATCH 090/101] Update cran-comments.md Co-authored-by: Aaron Clark --- cran-comments.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cran-comments.md b/cran-comments.md index cb61086..92ecfae 100644 --- a/cran-comments.md +++ b/cran-comments.md @@ -13,4 +13,4 @@ This is an intentional redirect that allows the package maintainer to monitor tr ## Reverse dependency check -The 1 reverse dependency was checked by running R CMD check using the development version of this package \ No newline at end of file +One reverse dependency exists (`{tidyCDISC}`) and was tested by running R CMD Check using the development version of `IDEAFilter`. The changes have no negative impact on it's reverse dependency. \ No newline at end of file From 796bb246299a29c56cbcc9af055a7ca6643940fb Mon Sep 17 00:00:00 2001 From: "Aaron Clark (Arcus)" Date: Wed, 3 Apr 2024 14:00:37 -0400 Subject: [PATCH 091/101] .Rbuildignore, description, CRAN-SUB file changed --- .Rbuildignore | 1 + CRAN-SUBMISSION | 3 +++ DESCRIPTION | 2 +- 3 files changed, 5 insertions(+), 1 deletion(-) create mode 100644 CRAN-SUBMISSION diff --git a/.Rbuildignore b/.Rbuildignore index fdb200e..ad4f687 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -13,3 +13,4 @@ cran-comments.md ^cran-comments\.md$ ^CRAN-RELEASE$ ^data-raw$ +^CRAN-SUBMISSION$ diff --git a/CRAN-SUBMISSION b/CRAN-SUBMISSION new file mode 100644 index 0000000..a176342 --- /dev/null +++ b/CRAN-SUBMISSION @@ -0,0 +1,3 @@ +Version: 0.2.0 +Date: 2024-04-03 17:57:24 UTC +SHA: 69ddbcda1650c9a847ab639c4b23d6402b02124e diff --git a/DESCRIPTION b/DESCRIPTION index 4d6d7ff..864a12a 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -37,7 +37,7 @@ URL: https://biogen-inc.github.io/IDEAFilter/, https://github.com/Biogen-Inc/IDE BugReports: https://github.com/Biogen-Inc/IDEAFilter/issues Encoding: UTF-8 LazyData: true -RoxygenNote: 7.2.3 +RoxygenNote: 7.3.1 Imports: crayon, ggplot2, From 3b7224f9ebb0ca37cf6d22d1e6c0fd780c0a7338 Mon Sep 17 00:00:00 2001 From: tidyCDISC <166622251+tidyCDISC@users.noreply.github.com> Date: Wed, 10 Apr 2024 09:16:04 -0400 Subject: [PATCH 092/101] Update LICENSE.md --- LICENSE.md | 680 ++--------------------------------------------------- 1 file changed, 21 insertions(+), 659 deletions(-) diff --git a/LICENSE.md b/LICENSE.md index fab6548..6c6f0ed 100644 --- a/LICENSE.md +++ b/LICENSE.md @@ -1,659 +1,21 @@ -GNU Affero General Public License -================================= - -_Version 3, 19 November 2007_ -_Copyright (C) 2007 Free Software Foundation, Inc. <>_ - -Everyone is permitted to copy and distribute verbatim copies of this -license document, but changing it is not allowed. - -## Preamble - -The GNU Affero General Public License is a free, copyleft license for -software and other kinds of works, specifically designed to ensure -cooperation with the community in the case of network server software. - -The licenses for most software and other practical works are designed -to take away your freedom to share and change the works. By contrast, -our General Public Licenses are intended to guarantee your freedom to -share and change all versions of a program--to make sure it remains -free software for all its users. - -When we speak of free software, we are referring to freedom, not -price. Our General Public Licenses are designed to make sure that you -have the freedom to distribute copies of free software (and charge for -them if you wish), that you receive source code or can get it if you -want it, that you can change the software or use pieces of it in new -free programs, and that you know you can do these things. - -Developers that use our General Public Licenses protect your rights -with two steps: (1) assert copyright on the software, and (2) offer -you this License which gives you legal permission to copy, distribute -and/or modify the software. - -A secondary benefit of defending all users' freedom is that -improvements made in alternate versions of the program, if they -receive widespread use, become available for other developers to -incorporate. Many developers of free software are heartened and -encouraged by the resulting cooperation. However, in the case of -software used on network servers, this result may fail to come about. -The GNU General Public License permits making a modified version and -letting the public access it on a server without ever releasing its -source code to the public. - -The GNU Affero General Public License is designed specifically to -ensure that, in such cases, the modified source code becomes available -to the community. It requires the operator of a network server to -provide the source code of the modified version running there to the -users of that server. Therefore, public use of a modified version, on -a publicly accessible server, gives the public access to the source -code of the modified version. - -An older license, called the Affero General Public License and -published by Affero, was designed to accomplish similar goals. This is -a different license, not a version of the Affero GPL, but Affero has -released a new version of the Affero GPL which permits relicensing -under this license. - -The precise terms and conditions for copying, distribution and -modification follow. - -## TERMS AND CONDITIONS - -### 0. Definitions. - -"This License" refers to version 3 of the GNU Affero General Public -License. - -"Copyright" also means copyright-like laws that apply to other kinds -of works, such as semiconductor masks. - -"The Program" refers to any copyrightable work licensed under this -License. Each licensee is addressed as "you". "Licensees" and -"recipients" may be individuals or organizations. - -To "modify" a work means to copy from or adapt all or part of the work -in a fashion requiring copyright permission, other than the making of -an exact copy. The resulting work is called a "modified version" of -the earlier work or a work "based on" the earlier work. - -A "covered work" means either the unmodified Program or a work based -on the Program. - -To "propagate" a work means to do anything with it that, without -permission, would make you directly or secondarily liable for -infringement under applicable copyright law, except executing it on a -computer or modifying a private copy. Propagation includes copying, -distribution (with or without modification), making available to the -public, and in some countries other activities as well. - -To "convey" a work means any kind of propagation that enables other -parties to make or receive copies. Mere interaction with a user -through a computer network, with no transfer of a copy, is not -conveying. - -An interactive user interface displays "Appropriate Legal Notices" to -the extent that it includes a convenient and prominently visible -feature that (1) displays an appropriate copyright notice, and (2) -tells the user that there is no warranty for the work (except to the -extent that warranties are provided), that licensees may convey the -work under this License, and how to view a copy of this License. If -the interface presents a list of user commands or options, such as a -menu, a prominent item in the list meets this criterion. - -### 1. Source Code. - -The "source code" for a work means the preferred form of the work for -making modifications to it. "Object code" means any non-source form of -a work. - -A "Standard Interface" means an interface that either is an official -standard defined by a recognized standards body, or, in the case of -interfaces specified for a particular programming language, one that -is widely used among developers working in that language. - -The "System Libraries" of an executable work include anything, other -than the work as a whole, that (a) is included in the normal form of -packaging a Major Component, but which is not part of that Major -Component, and (b) serves only to enable use of the work with that -Major Component, or to implement a Standard Interface for which an -implementation is available to the public in source code form. A -"Major Component", in this context, means a major essential component -(kernel, window system, and so on) of the specific operating system -(if any) on which the executable work runs, or a compiler used to -produce the work, or an object code interpreter used to run it. - -The "Corresponding Source" for a work in object code form means all -the source code needed to generate, install, and (for an executable -work) run the object code and to modify the work, including scripts to -control those activities. However, it does not include the work's -System Libraries, or general-purpose tools or generally available free -programs which are used unmodified in performing those activities but -which are not part of the work. For example, Corresponding Source -includes interface definition files associated with source files for -the work, and the source code for shared libraries and dynamically -linked subprograms that the work is specifically designed to require, -such as by intimate data communication or control flow between those -subprograms and other parts of the work. - -The Corresponding Source need not include anything that users can -regenerate automatically from other parts of the Corresponding Source. - -The Corresponding Source for a work in source code form is that same -work. - -### 2. Basic Permissions. - -All rights granted under this License are granted for the term of -copyright on the Program, and are irrevocable provided the stated -conditions are met. This License explicitly affirms your unlimited -permission to run the unmodified Program. The output from running a -covered work is covered by this License only if the output, given its -content, constitutes a covered work. This License acknowledges your -rights of fair use or other equivalent, as provided by copyright law. - -You may make, run and propagate covered works that you do not convey, -without conditions so long as your license otherwise remains in force. -You may convey covered works to others for the sole purpose of having -them make modifications exclusively for you, or provide you with -facilities for running those works, provided that you comply with the -terms of this License in conveying all material for which you do not -control copyright. Those thus making or running the covered works for -you must do so exclusively on your behalf, under your direction and -control, on terms that prohibit them from making any copies of your -copyrighted material outside their relationship with you. - -Conveying under any other circumstances is permitted solely under the -conditions stated below. Sublicensing is not allowed; section 10 makes -it unnecessary. - -### 3. Protecting Users' Legal Rights From Anti-Circumvention Law. - -No covered work shall be deemed part of an effective technological -measure under any applicable law fulfilling obligations under article -11 of the WIPO copyright treaty adopted on 20 December 1996, or -similar laws prohibiting or restricting circumvention of such -measures. - -When you convey a covered work, you waive any legal power to forbid -circumvention of technological measures to the extent such -circumvention is effected by exercising rights under this License with -respect to the covered work, and you disclaim any intention to limit -operation or modification of the work as a means of enforcing, against -the work's users, your or third parties' legal rights to forbid -circumvention of technological measures. - -### 4. Conveying Verbatim Copies. - -You may convey verbatim copies of the Program's source code as you -receive it, in any medium, provided that you conspicuously and -appropriately publish on each copy an appropriate copyright notice; -keep intact all notices stating that this License and any -non-permissive terms added in accord with section 7 apply to the code; -keep intact all notices of the absence of any warranty; and give all -recipients a copy of this License along with the Program. - -You may charge any price or no price for each copy that you convey, -and you may offer support or warranty protection for a fee. - -### 5. Conveying Modified Source Versions. - -You may convey a work based on the Program, or the modifications to -produce it from the Program, in the form of source code under the -terms of section 4, provided that you also meet all of these -conditions: - -- a) The work must carry prominent notices stating that you modified - it, and giving a relevant date. -- b) The work must carry prominent notices stating that it is - released under this License and any conditions added under - section 7. This requirement modifies the requirement in section 4 - to "keep intact all notices". -- c) You must license the entire work, as a whole, under this - License to anyone who comes into possession of a copy. This - License will therefore apply, along with any applicable section 7 - additional terms, to the whole of the work, and all its parts, - regardless of how they are packaged. This License gives no - permission to license the work in any other way, but it does not - invalidate such permission if you have separately received it. -- d) If the work has interactive user interfaces, each must display - Appropriate Legal Notices; however, if the Program has interactive - interfaces that do not display Appropriate Legal Notices, your - work need not make them do so. - -A compilation of a covered work with other separate and independent -works, which are not by their nature extensions of the covered work, -and which are not combined with it such as to form a larger program, -in or on a volume of a storage or distribution medium, is called an -"aggregate" if the compilation and its resulting copyright are not -used to limit the access or legal rights of the compilation's users -beyond what the individual works permit. Inclusion of a covered work -in an aggregate does not cause this License to apply to the other -parts of the aggregate. - -### 6. Conveying Non-Source Forms. - -You may convey a covered work in object code form under the terms of -sections 4 and 5, provided that you also convey the machine-readable -Corresponding Source under the terms of this License, in one of these -ways: - -- a) Convey the object code in, or embodied in, a physical product - (including a physical distribution medium), accompanied by the - Corresponding Source fixed on a durable physical medium - customarily used for software interchange. -- b) Convey the object code in, or embodied in, a physical product - (including a physical distribution medium), accompanied by a - written offer, valid for at least three years and valid for as - long as you offer spare parts or customer support for that product - model, to give anyone who possesses the object code either (1) a - copy of the Corresponding Source for all the software in the - product that is covered by this License, on a durable physical - medium customarily used for software interchange, for a price no - more than your reasonable cost of physically performing this - conveying of source, or (2) access to copy the Corresponding - Source from a network server at no charge. -- c) Convey individual copies of the object code with a copy of the - written offer to provide the Corresponding Source. This - alternative is allowed only occasionally and noncommercially, and - only if you received the object code with such an offer, in accord - with subsection 6b. -- d) Convey the object code by offering access from a designated - place (gratis or for a charge), and offer equivalent access to the - Corresponding Source in the same way through the same place at no - further charge. You need not require recipients to copy the - Corresponding Source along with the object code. If the place to - copy the object code is a network server, the Corresponding Source - may be on a different server (operated by you or a third party) - that supports equivalent copying facilities, provided you maintain - clear directions next to the object code saying where to find the - Corresponding Source. Regardless of what server hosts the - Corresponding Source, you remain obligated to ensure that it is - available for as long as needed to satisfy these requirements. -- e) Convey the object code using peer-to-peer transmission, - provided you inform other peers where the object code and - Corresponding Source of the work are being offered to the general - public at no charge under subsection 6d. - -A separable portion of the object code, whose source code is excluded -from the Corresponding Source as a System Library, need not be -included in conveying the object code work. - -A "User Product" is either (1) a "consumer product", which means any -tangible personal property which is normally used for personal, -family, or household purposes, or (2) anything designed or sold for -incorporation into a dwelling. In determining whether a product is a -consumer product, doubtful cases shall be resolved in favor of -coverage. For a particular product received by a particular user, -"normally used" refers to a typical or common use of that class of -product, regardless of the status of the particular user or of the way -in which the particular user actually uses, or expects or is expected -to use, the product. A product is a consumer product regardless of -whether the product has substantial commercial, industrial or -non-consumer uses, unless such uses represent the only significant -mode of use of the product. - -"Installation Information" for a User Product means any methods, -procedures, authorization keys, or other information required to -install and execute modified versions of a covered work in that User -Product from a modified version of its Corresponding Source. The -information must suffice to ensure that the continued functioning of -the modified object code is in no case prevented or interfered with -solely because modification has been made. - -If you convey an object code work under this section in, or with, or -specifically for use in, a User Product, and the conveying occurs as -part of a transaction in which the right of possession and use of the -User Product is transferred to the recipient in perpetuity or for a -fixed term (regardless of how the transaction is characterized), the -Corresponding Source conveyed under this section must be accompanied -by the Installation Information. But this requirement does not apply -if neither you nor any third party retains the ability to install -modified object code on the User Product (for example, the work has -been installed in ROM). - -The requirement to provide Installation Information does not include a -requirement to continue to provide support service, warranty, or -updates for a work that has been modified or installed by the -recipient, or for the User Product in which it has been modified or -installed. Access to a network may be denied when the modification -itself materially and adversely affects the operation of the network -or violates the rules and protocols for communication across the -network. - -Corresponding Source conveyed, and Installation Information provided, -in accord with this section must be in a format that is publicly -documented (and with an implementation available to the public in -source code form), and must require no special password or key for -unpacking, reading or copying. - -### 7. Additional Terms. - -"Additional permissions" are terms that supplement the terms of this -License by making exceptions from one or more of its conditions. -Additional permissions that are applicable to the entire Program shall -be treated as though they were included in this License, to the extent -that they are valid under applicable law. If additional permissions -apply only to part of the Program, that part may be used separately -under those permissions, but the entire Program remains governed by -this License without regard to the additional permissions. - -When you convey a copy of a covered work, you may at your option -remove any additional permissions from that copy, or from any part of -it. (Additional permissions may be written to require their own -removal in certain cases when you modify the work.) You may place -additional permissions on material, added by you to a covered work, -for which you have or can give appropriate copyright permission. - -Notwithstanding any other provision of this License, for material you -add to a covered work, you may (if authorized by the copyright holders -of that material) supplement the terms of this License with terms: - -- a) Disclaiming warranty or limiting liability differently from the - terms of sections 15 and 16 of this License; or -- b) Requiring preservation of specified reasonable legal notices or - author attributions in that material or in the Appropriate Legal - Notices displayed by works containing it; or -- c) Prohibiting misrepresentation of the origin of that material, - or requiring that modified versions of such material be marked in - reasonable ways as different from the original version; or -- d) Limiting the use for publicity purposes of names of licensors - or authors of the material; or -- e) Declining to grant rights under trademark law for use of some - trade names, trademarks, or service marks; or -- f) Requiring indemnification of licensors and authors of that - material by anyone who conveys the material (or modified versions - of it) with contractual assumptions of liability to the recipient, - for any liability that these contractual assumptions directly - impose on those licensors and authors. - -All other non-permissive additional terms are considered "further -restrictions" within the meaning of section 10. If the Program as you -received it, or any part of it, contains a notice stating that it is -governed by this License along with a term that is a further -restriction, you may remove that term. If a license document contains -a further restriction but permits relicensing or conveying under this -License, you may add to a covered work material governed by the terms -of that license document, provided that the further restriction does -not survive such relicensing or conveying. - -If you add terms to a covered work in accord with this section, you -must place, in the relevant source files, a statement of the -additional terms that apply to those files, or a notice indicating -where to find the applicable terms. - -Additional terms, permissive or non-permissive, may be stated in the -form of a separately written license, or stated as exceptions; the -above requirements apply either way. - -### 8. Termination. - -You may not propagate or modify a covered work except as expressly -provided under this License. Any attempt otherwise to propagate or -modify it is void, and will automatically terminate your rights under -this License (including any patent licenses granted under the third -paragraph of section 11). - -However, if you cease all violation of this License, then your license -from a particular copyright holder is reinstated (a) provisionally, -unless and until the copyright holder explicitly and finally -terminates your license, and (b) permanently, if the copyright holder -fails to notify you of the violation by some reasonable means prior to -60 days after the cessation. - -Moreover, your license from a particular copyright holder is -reinstated permanently if the copyright holder notifies you of the -violation by some reasonable means, this is the first time you have -received notice of violation of this License (for any work) from that -copyright holder, and you cure the violation prior to 30 days after -your receipt of the notice. - -Termination of your rights under this section does not terminate the -licenses of parties who have received copies or rights from you under -this License. If your rights have been terminated and not permanently -reinstated, you do not qualify to receive new licenses for the same -material under section 10. - -### 9. Acceptance Not Required for Having Copies. - -You are not required to accept this License in order to receive or run -a copy of the Program. Ancillary propagation of a covered work -occurring solely as a consequence of using peer-to-peer transmission -to receive a copy likewise does not require acceptance. However, -nothing other than this License grants you permission to propagate or -modify any covered work. These actions infringe copyright if you do -not accept this License. Therefore, by modifying or propagating a -covered work, you indicate your acceptance of this License to do so. - -### 10. Automatic Licensing of Downstream Recipients. - -Each time you convey a covered work, the recipient automatically -receives a license from the original licensors, to run, modify and -propagate that work, subject to this License. You are not responsible -for enforcing compliance by third parties with this License. - -An "entity transaction" is a transaction transferring control of an -organization, or substantially all assets of one, or subdividing an -organization, or merging organizations. If propagation of a covered -work results from an entity transaction, each party to that -transaction who receives a copy of the work also receives whatever -licenses to the work the party's predecessor in interest had or could -give under the previous paragraph, plus a right to possession of the -Corresponding Source of the work from the predecessor in interest, if -the predecessor has it or can get it with reasonable efforts. - -You may not impose any further restrictions on the exercise of the -rights granted or affirmed under this License. For example, you may -not impose a license fee, royalty, or other charge for exercise of -rights granted under this License, and you may not initiate litigation -(including a cross-claim or counterclaim in a lawsuit) alleging that -any patent claim is infringed by making, using, selling, offering for -sale, or importing the Program or any portion of it. - -### 11. Patents. - -A "contributor" is a copyright holder who authorizes use under this -License of the Program or a work on which the Program is based. The -work thus licensed is called the contributor's "contributor version". - -A contributor's "essential patent claims" are all patent claims owned -or controlled by the contributor, whether already acquired or -hereafter acquired, that would be infringed by some manner, permitted -by this License, of making, using, or selling its contributor version, -but do not include claims that would be infringed only as a -consequence of further modification of the contributor version. For -purposes of this definition, "control" includes the right to grant -patent sublicenses in a manner consistent with the requirements of -this License. - -Each contributor grants you a non-exclusive, worldwide, royalty-free -patent license under the contributor's essential patent claims, to -make, use, sell, offer for sale, import and otherwise run, modify and -propagate the contents of its contributor version. - -In the following three paragraphs, a "patent license" is any express -agreement or commitment, however denominated, not to enforce a patent -(such as an express permission to practice a patent or covenant not to -sue for patent infringement). To "grant" such a patent license to a -party means to make such an agreement or commitment not to enforce a -patent against the party. - -If you convey a covered work, knowingly relying on a patent license, -and the Corresponding Source of the work is not available for anyone -to copy, free of charge and under the terms of this License, through a -publicly available network server or other readily accessible means, -then you must either (1) cause the Corresponding Source to be so -available, or (2) arrange to deprive yourself of the benefit of the -patent license for this particular work, or (3) arrange, in a manner -consistent with the requirements of this License, to extend the patent -license to downstream recipients. "Knowingly relying" means you have -actual knowledge that, but for the patent license, your conveying the -covered work in a country, or your recipient's use of the covered work -in a country, would infringe one or more identifiable patents in that -country that you have reason to believe are valid. - -If, pursuant to or in connection with a single transaction or -arrangement, you convey, or propagate by procuring conveyance of, a -covered work, and grant a patent license to some of the parties -receiving the covered work authorizing them to use, propagate, modify -or convey a specific copy of the covered work, then the patent license -you grant is automatically extended to all recipients of the covered -work and works based on it. - -A patent license is "discriminatory" if it does not include within the -scope of its coverage, prohibits the exercise of, or is conditioned on -the non-exercise of one or more of the rights that are specifically -granted under this License. You may not convey a covered work if you -are a party to an arrangement with a third party that is in the -business of distributing software, under which you make payment to the -third party based on the extent of your activity of conveying the -work, and under which the third party grants, to any of the parties -who would receive the covered work from you, a discriminatory patent -license (a) in connection with copies of the covered work conveyed by -you (or copies made from those copies), or (b) primarily for and in -connection with specific products or compilations that contain the -covered work, unless you entered into that arrangement, or that patent -license was granted, prior to 28 March 2007. - -Nothing in this License shall be construed as excluding or limiting -any implied license or other defenses to infringement that may -otherwise be available to you under applicable patent law. - -### 12. No Surrender of Others' Freedom. - -If conditions are imposed on you (whether by court order, agreement or -otherwise) that contradict the conditions of this License, they do not -excuse you from the conditions of this License. If you cannot convey a -covered work so as to satisfy simultaneously your obligations under -this License and any other pertinent obligations, then as a -consequence you may not convey it at all. For example, if you agree to -terms that obligate you to collect a royalty for further conveying -from those to whom you convey the Program, the only way you could -satisfy both those terms and this License would be to refrain entirely -from conveying the Program. - -### 13. Remote Network Interaction; Use with the GNU General Public License. - -Notwithstanding any other provision of this License, if you modify the -Program, your modified version must prominently offer all users -interacting with it remotely through a computer network (if your -version supports such interaction) an opportunity to receive the -Corresponding Source of your version by providing access to the -Corresponding Source from a network server at no charge, through some -standard or customary means of facilitating copying of software. This -Corresponding Source shall include the Corresponding Source for any -work covered by version 3 of the GNU General Public License that is -incorporated pursuant to the following paragraph. - -Notwithstanding any other provision of this License, you have -permission to link or combine any covered work with a work licensed -under version 3 of the GNU General Public License into a single -combined work, and to convey the resulting work. The terms of this -License will continue to apply to the part which is the covered work, -but the work with which it is combined will remain governed by version -3 of the GNU General Public License. - -### 14. Revised Versions of this License. - -The Free Software Foundation may publish revised and/or new versions -of the GNU Affero General Public License from time to time. Such new -versions will be similar in spirit to the present version, but may -differ in detail to address new problems or concerns. - -Each version is given a distinguishing version number. If the Program -specifies that a certain numbered version of the GNU Affero General -Public License "or any later version" applies to it, you have the -option of following the terms and conditions either of that numbered -version or of any later version published by the Free Software -Foundation. If the Program does not specify a version number of the -GNU Affero General Public License, you may choose any version ever -published by the Free Software Foundation. - -If the Program specifies that a proxy can decide which future versions -of the GNU Affero General Public License can be used, that proxy's -public statement of acceptance of a version permanently authorizes you -to choose that version for the Program. - -Later license versions may give you additional or different -permissions. However, no additional obligations are imposed on any -author or copyright holder as a result of your choosing to follow a -later version. - -### 15. Disclaimer of Warranty. - -THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY -APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT -HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT -WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT -LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND -PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE -DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR -CORRECTION. - -### 16. Limitation of Liability. - -IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING -WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR -CONVEYS THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, -INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES -ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT -NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR -LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM -TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER -PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. - -### 17. Interpretation of Sections 15 and 16. - -If the disclaimer of warranty and limitation of liability provided -above cannot be given local legal effect according to their terms, -reviewing courts shall apply local law that most closely approximates -an absolute waiver of all civil liability in connection with the -Program, unless a warranty or assumption of liability accompanies a -copy of the Program in return for a fee. - -END OF TERMS AND CONDITIONS - -## How to Apply These Terms to Your New Programs - -If you develop a new program, and you want it to be of the greatest -possible use to the public, the best way to achieve this is to make it -free software which everyone can redistribute and change under these -terms. - -To do so, attach the following notices to the program. It is safest to -attach them to the start of each source file to most effectively state -the exclusion of warranty; and each file should have at least the -"copyright" line and a pointer to where the full notice is found. - - - Copyright (C) - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU Affero 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 Affero General Public License for more details. - - You should have received a copy of the GNU Affero General Public License - along with this program. If not, see . - -Also add information on how to contact you by electronic and paper -mail. - -If your software can interact with users remotely through a computer -network, you should also make sure that it provides a way for users to -get its source. For example, if your program is a web application, its -interface could display a "Source" link that leads users to an archive -of the code. There are many ways you could offer source, and different -solutions will be better for different programs; see section 13 for -the specific requirements. - -You should also get your employer (if you work as a programmer) or -school, if any, to sign a "copyright disclaimer" for the program, if -necessary. For more information on this, and how to apply and follow -the GNU AGPL, see . +# MIT License + +Copyright (c) 2024 Biogen Inc + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE. From e4c9a4a7720e5d2f8b3fb7a13d50d1042e757f32 Mon Sep 17 00:00:00 2001 From: tidyCDISC <166622251+tidyCDISC@users.noreply.github.com> Date: Wed, 10 Apr 2024 09:16:58 -0400 Subject: [PATCH 093/101] Update LICENSE --- LICENSE | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/LICENSE b/LICENSE index b667dd8..881b967 100644 --- a/LICENSE +++ b/LICENSE @@ -1,3 +1,6 @@ +YEAR: 2024 +COPYRIGHT HOLDER: Biogen Inc + The IDEAFilter package includes other open source software components. The following is a list of these components (full copies of the license agreements used by these components are included below): @@ -53,4 +56,4 @@ FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE -SOFTWARE. \ No newline at end of file +SOFTWARE. From 77a5263dedfa4f9d8f273fb42524a77cbba31cbf Mon Sep 17 00:00:00 2001 From: tidyCDISC <166622251+tidyCDISC@users.noreply.github.com> Date: Wed, 10 Apr 2024 09:27:57 -0400 Subject: [PATCH 094/101] Update README.Rmd --- README.Rmd | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/README.Rmd b/README.Rmd index 413d6b5..d10c1a6 100644 --- a/README.Rmd +++ b/README.Rmd @@ -7,7 +7,7 @@ output: "github_document" Agnostic, Idiomatic Data Filter Module for Shiny.
- + Demo example app that leverages the IDEAFilter shiny module
@@ -128,4 +128,4 @@ server <- function(input, output, session) { } shinyApp(ui = ui, server = server) -``` \ No newline at end of file +``` From 41beb9394ec72134055a2b387b7b9ac105f4d80d Mon Sep 17 00:00:00 2001 From: "Aaron Clark (Arcus)" Date: Wed, 10 Apr 2024 09:30:48 -0400 Subject: [PATCH 095/101] re-compile readme.md --- README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.md b/README.md index 98c8813..ec7e52d 100644 --- a/README.md +++ b/README.md @@ -4,7 +4,7 @@ Agnostic, Idiomatic Data Filter Module for Shiny.
- + Demo example app that leverages the IDEAFilter shiny module
From 6a3f3690864db2fc320db13db2587248a1f697ce Mon Sep 17 00:00:00 2001 From: "Aaron Clark (Arcus)" Date: Wed, 10 Apr 2024 09:36:50 -0400 Subject: [PATCH 096/101] push updated cran-comments --- cran-comments.md | 21 +++++++++++++++++++-- 1 file changed, 19 insertions(+), 2 deletions(-) diff --git a/cran-comments.md b/cran-comments.md index 92ecfae..4993df8 100644 --- a/cran-comments.md +++ b/cran-comments.md @@ -1,4 +1,21 @@ -## R CMD check results +# CRAN v0.2.0 Re-submission + +On April 10, 2024 + +### R CMD check results +0 errors | 0 warnings | 0 note + +### Reverse dependency check + +One reverse dependency exists (`{tidyCDISC}`) and was tested by running R CMD Check using the development version of `IDEAFilter`. The changes have no negative impact on it's reverse dependency. + +
+ +# Initial CRAN v0.2.0 Submission + +On April 3, 2024 + +### R CMD check results 0 errors | 0 warnings | 1 note ``` Found the following (possibly) invalid URLs: @@ -11,6 +28,6 @@ Found the following (possibly) invalid URLs: ``` This is an intentional redirect that allows the package maintainer to monitor traffic to the demo application originating from the package README -## Reverse dependency check +### Reverse dependency check One reverse dependency exists (`{tidyCDISC}`) and was tested by running R CMD Check using the development version of `IDEAFilter`. The changes have no negative impact on it's reverse dependency. \ No newline at end of file From 3f225ee584022a1712f4bbdc7f677576d75688cc Mon Sep 17 00:00:00 2001 From: "Aaron Clark (Arcus)" Date: Wed, 10 Apr 2024 10:07:50 -0400 Subject: [PATCH 097/101] Add cran submission file --- CRAN-SUBMISSION | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/CRAN-SUBMISSION b/CRAN-SUBMISSION index a176342..5d197b0 100644 --- a/CRAN-SUBMISSION +++ b/CRAN-SUBMISSION @@ -1,3 +1,3 @@ Version: 0.2.0 -Date: 2024-04-03 17:57:24 UTC -SHA: 69ddbcda1650c9a847ab639c4b23d6402b02124e +Date: 2024-04-10 13:38:58 UTC +SHA: 6a3f3690864db2fc320db13db2587248a1f697ce From 622758d301359df0c434dc1804c90165fc780260 Mon Sep 17 00:00:00 2001 From: tidyCDISC <166622251+tidyCDISC@users.noreply.github.com> Date: Wed, 10 Apr 2024 10:09:09 -0400 Subject: [PATCH 098/101] Update DESCRIPTION's reference to license --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 864a12a..fe182e1 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -32,7 +32,7 @@ Authors@R: c( person(family = "SortableJS contributors", role = "ctb", comment = "SortableJS library"), person(given = "Biogen", role = "cph")) -License: AGPL-3 + file LICENSE +License: MIT + file LICENSE URL: https://biogen-inc.github.io/IDEAFilter/, https://github.com/Biogen-Inc/IDEAFilter BugReports: https://github.com/Biogen-Inc/IDEAFilter/issues Encoding: UTF-8 From df367feb0e6f29a2c08d2a981eb7e96160c52b1b Mon Sep 17 00:00:00 2001 From: "Aaron Clark (Arcus)" Date: Wed, 10 Apr 2024 10:18:55 -0400 Subject: [PATCH 099/101] update wordlist & fix spelling --- R/IDEAFilter.R | 2 +- R/IDEAFilter_item.R | 2 +- inst/WORDLIST | 3 +++ man/IDEAFilter.Rd | 2 +- man/IDEAFilter_item.Rd | 2 +- tests/spelling.R | 2 ++ 6 files changed, 9 insertions(+), 4 deletions(-) diff --git a/R/IDEAFilter.R b/R/IDEAFilter.R index bfcaad8..3364a38 100644 --- a/R/IDEAFilter.R +++ b/R/IDEAFilter.R @@ -38,7 +38,7 @@ IDEAFilter_ui <- function(id) { #' IDEA data filter module server function #' -#' Serves as a wrapper fo \code{\link{shiny_data_filter}} and utilizes +#' Serves as a wrapper for \code{\link{shiny_data_filter}} and utilizes #' \code{moduleSever()} for a more modern implementation of the data item #' filter. #' diff --git a/R/IDEAFilter_item.R b/R/IDEAFilter_item.R index 3f80cc4..d44396a 100644 --- a/R/IDEAFilter_item.R +++ b/R/IDEAFilter_item.R @@ -21,7 +21,7 @@ IDEAFilter_item_ui <- function(id) { #' The server function for the IDEA filter item module #' -#' Serves as a wrapper fo \code{\link{shiny_data_filter_item}} and utilizes +#' Serves as a wrapper for \code{\link{shiny_data_filter_item}} and utilizes #' \code{moduleSever()} for a more modern implementation of the data item #' filter. #' diff --git a/inst/WORDLIST b/inst/WORDLIST index 267093f..952ca3c 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -1,5 +1,6 @@ Cheng Pharma +Pre UI df dplyr @@ -7,9 +8,11 @@ dropdown getInitializationCode ns pharma +pre reactiveValues readme scriptgloss +selectize selectizeInput shinyDataFilter shinytest diff --git a/man/IDEAFilter.Rd b/man/IDEAFilter.Rd index ab31f28..b27722e 100644 --- a/man/IDEAFilter.Rd +++ b/man/IDEAFilter.Rd @@ -35,7 +35,7 @@ a \code{reactive expression} which returns the filtered data wrapped data. } \description{ -Serves as a wrapper fo \code{\link{shiny_data_filter}} and utilizes +Serves as a wrapper for \code{\link{shiny_data_filter}} and utilizes \code{moduleSever()} for a more modern implementation of the data item filter. } diff --git a/man/IDEAFilter_item.Rd b/man/IDEAFilter_item.Rd index 58f5a6d..b406262 100644 --- a/man/IDEAFilter_item.Rd +++ b/man/IDEAFilter_item.Rd @@ -43,7 +43,7 @@ a \code{\link[shiny]{reactiveValues}} list of four reactive elements; `data` used to create the item. } \description{ -Serves as a wrapper fo \code{\link{shiny_data_filter_item}} and utilizes +Serves as a wrapper for \code{\link{shiny_data_filter_item}} and utilizes \code{moduleSever()} for a more modern implementation of the data item filter. } diff --git a/tests/spelling.R b/tests/spelling.R index 6713838..e329bec 100644 --- a/tests/spelling.R +++ b/tests/spelling.R @@ -1,3 +1,5 @@ if(requireNamespace('spelling', quietly = TRUE)) spelling::spell_check_test(vignettes = TRUE, error = FALSE, skip_on_cran = TRUE) +spelling::spell_check_package() +spelling::update_wordlist() \ No newline at end of file From fb6f1fbe1a4f883c2fa7e819abfa0772dac6be50 Mon Sep 17 00:00:00 2001 From: "Aaron Clark (Arcus)" Date: Wed, 10 Apr 2024 10:24:17 -0400 Subject: [PATCH 100/101] hide spellcheck code --- tests/spelling.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/spelling.R b/tests/spelling.R index e329bec..06a1204 100644 --- a/tests/spelling.R +++ b/tests/spelling.R @@ -1,5 +1,5 @@ if(requireNamespace('spelling', quietly = TRUE)) spelling::spell_check_test(vignettes = TRUE, error = FALSE, skip_on_cran = TRUE) -spelling::spell_check_package() -spelling::update_wordlist() \ No newline at end of file +# spelling::spell_check_package() +# spelling::update_wordlist() \ No newline at end of file From 68b74996d03cd86c39ce8a905dafd8b998de9dda Mon Sep 17 00:00:00 2001 From: "Aaron Clark (Arcus)" Date: Wed, 10 Apr 2024 11:11:00 -0400 Subject: [PATCH 101/101] update another spot in readme where link was getting redirected --- CRAN-SUBMISSION | 4 ++-- README.Rmd | 2 +- README.md | 2 +- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/CRAN-SUBMISSION b/CRAN-SUBMISSION index 5d197b0..74bb8de 100644 --- a/CRAN-SUBMISSION +++ b/CRAN-SUBMISSION @@ -1,3 +1,3 @@ Version: 0.2.0 -Date: 2024-04-10 13:38:58 UTC -SHA: 6a3f3690864db2fc320db13db2587248a1f697ce +Date: 2024-04-10 14:26:56 UTC +SHA: fb6f1fbe1a4f883c2fa7e819abfa0772dac6be50 diff --git a/README.Rmd b/README.Rmd index d10c1a6..34aeb65 100644 --- a/README.Rmd +++ b/README.Rmd @@ -64,7 +64,7 @@ filtered_data <- # name the returned reactive data frame Copy & paste the code below into a live R session to see the inner workings of the Star Wars app referenced above. Or click the button below to test drive the example app now!
- + Demo example app that leverages the IDEAFilter shiny module
diff --git a/README.md b/README.md index ec7e52d..aa71899 100644 --- a/README.md +++ b/README.md @@ -85,7 +85,7 @@ workings of the Star Wars app referenced above. Or click the button below to test drive the example app now!
- + Demo example app that leverages the IDEAFilter shiny module