Type:	Package
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 slice & dice data by applying multiple (order specific) filters using the AND (&) operator between each, and getting real-time updates on the number of rows effected/available along the way. Thus, any downstream processes that leverage this data source (like tables, plots, or statistical procedures) will re-render after new filters are applied. The shiny module’s user interface has a 'minimalist' aesthetic so that the focus can be on the data & other visuals. In addition to returning a reactive (filtered) data.frame, 'IDEAFilter' as also returns 'dplyr' filter statements used to actually slice the data.
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
RoxygenNote:	7.3.1
Imports:	crayon, ggplot2, pillar (≥ 1.5.0), purrr, RColorBrewer, shiny, shinyTime
Suggests:	dplyr, knitr, rmarkdown, shinytest, shinytest2, spelling, testthat
Language:	en-US
VignetteBuilder:	knitr
Depends:	R (≥ 2.10)
NeedsCompilation:	no
Packaged:	2024-04-15 14:58:41 UTC; aclark02
Author:	Aaron Clark [aut, cre], Jeff Thompson [aut], Doug Kelkhoff [ctb, cph] (Author of shinyDataFilter), Maya Gans [ctb], SortableJS contributors [ctb] (SortableJS library), Biogen [cph]
Maintainer:	Aaron Clark <clark.aaronchris@gmail.com>
Repository:	CRAN
Date/Publication:	2024-04-15 15:30:02 UTC

IDEA data filter module server function

Description

Serves as a wrapper for shiny_data_filter and utilizes moduleSever() for a more modern implementation of the data item filter.

Usage

IDEAFilter(
  id,
  data,
  ...,
  col_subset = NULL,
  preselection = NULL,
  verbose = FALSE
)

Arguments

Value

a 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.

See Also

IDEAFilter_ui, shiny_data_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)
}

The server function for the IDEA filter item module

Description

Serves as a wrapper for shiny_data_filter_item and utilizes moduleSever() for a more modern implementation of the data item filter.

Usage

IDEAFilter_item(
  id,
  data,
  column_name = NULL,
  filters = list(),
  ...,
  col_subset = NULL,
  preselection = NULL,
  verbose = FALSE
)

Arguments

Value

a 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.

A single filter item as part of a IDEA filter module panel

Description

This is a wrapper for shiny_data_filter_item_ui created to match up with the module server function IDEAFilter_item.

Usage

IDEAFilter_item_ui(id)

Arguments

Value

a shiny wellPanel to house the filter

User interface function to add a data filter panel

Description

This is a wrapper for shiny_data_filter_ui created to match up with the module server function IDEAFilter.

Usage

IDEAFilter_ui(id)

Arguments

Value

a shiny tagList containing the filter ui

See Also

shiny_data_filter_ui, 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)
}

A selectizeInput customized for data frames with column labels

Description

A selectizeInput customized for data frames with column labels

Usage

columnSelectInput(
  inputId,
  label,
  data,
  selected = "",
  ...,
  col_subset = NULL,
  placeholder = "",
  onInitialize
)

Arguments

Value

a selectizeInput dropdown element

A logging function that captures the shiny namespace

Description

A logging function that captures the shiny namespace

Usage

filter_log(..., ns, verbose = TRUE)

Arguments

Value

NULL

A crayon style derived from a rough hash of the namespace name

Description

A crayon style derived from a rough hash of the namespace name

Usage

filter_log_ns_style(txt)

Arguments

A crayon style for the filter log

Description

A crayon style for the filter log

Usage

filter_log_style(...)

Arguments

Handler for retrieving static code for a shinyDataFilter_df

Description

A function for scriptgloss::getInitializationCode to dispatch to

Usage

getInitializationCode.shinyDataFilter_df(obj, name = NULL)

Arguments

Value

Returns the 'code' attribute as a string from any object of class shinyDataFilter_df

Return the class used for dispatch to shiny_vector_filter formatted using pillar

Description

Return the class used for dispatch to shiny_vector_filter formatted using pillar

Usage

get_dataFilter_class(obj)

Arguments

Value

a pillar formatted class name

Check if string is blank ""

Description

Check if string is blank ""

Usage

is.empty(x)

Arguments

Value

logical of blank or not

Shorthand operator for NULL fallback

Description

Shorthand operator for NULL fallback

Usage

lhs %||% rhs

Arguments

A selectizeInput customized for unique element select from vector

Description

A selectizeInput customized for unique element select from vector

Usage

proportionSelectInput(
  inputId,
  label,
  vec,
  selected = "",
  ...,
  placeholder = " ",
  onInitialize,
  sort = c("count", "alpha", "order")
)

Arguments

Value

a selectizeInput dropdown element

Shiny data filter module server function

Description

Shiny data filter module server function

Usage

shiny_data_filter(input, output, session, data, verbose = FALSE)

Arguments

Value

a 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.

See Also

shiny_data_filter_ui

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)
}

The server function for the filter item module of a data filter module panel

Description

The server function for the filter item module of a data filter module panel

Usage

shiny_data_filter_item(
  input,
  output,
  session,
  data,
  column_name = NULL,
  verbose = FALSE
)

Arguments

Value

a 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 single filter item as part of a data filter module panel

Description

This sub-module contains the logic for the filter item itself. This contains general ui elements such as the button to remove the filter and the grip for drag-and-drop. It also handles the conditional logic of showing a column selector or the column name. When a column is selected it also embeds another module showing module for filtering the specified vector of data.

Usage

shiny_data_filter_item_ui(inputId, verbose = FALSE)

Arguments

Value

a shiny wellPanel to house the filter

User interface function to add a data filter panel

Description

User interface function to add a data filter panel

Usage

shiny_data_filter_ui(inputId)

Arguments

Value

a shiny tagList containing the filter ui

See Also

shiny_data_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, 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)
}

Vector-specific filter module server function

Description

The shiny_vector_filter family of S3 dispatched functions use the input data to route to the appropriate ui and server functions for the vector datatype.

Usage

shiny_vector_filter(data, inputId, global = FALSE)

Arguments

Details

The shiny_vector_filter functions return the shiny module server functions to use for the specified filter. These functions should follow the following template:

  function(input, output, session, x, filter_na, verbose = FALSE) {
    # ... additional code here
    reactiveValues(code = TRUE, mask = TRUE)
  }

This function will conform to the following specification

Arguments

input

requisite shiny module field specifying incoming ui input reactiveValues

output

requisite shiny module field capturing output for the shiny data filter ui

session

requisite shiny module field containing the active shiny session

x

a reactive expression resolving to the vector to filter

filter_na

a logical value indicating whether to filter NA values from the x vector

verbose

a logical value indicating whether or not to print log statements out to the console

Value a reactiveValues list containing a logical vector called "mask" which can be used to filter the provided vector and an element "code" which is the expression used to generate the mask.

Value

a shiny server function as described in the details

A vector filter for factors with only a few choices

Description

A vector filter for factors with only a few choices

Usage

shiny_vector_filter_factor_few(
  input,
  output,
  session,
  x = shiny::reactive(factor()),
  filter_na = shiny::reactive(TRUE),
  filter_fn = NULL,
  verbose = FALSE,
  erase_filters = shiny::reactive(0)
)

Arguments

Value

a reactiveValues list containing a logical vector called "mask" which can be used to filter the provided vector and an element "code" which is the expression used to generate the mask.

A vector filter for factors with only a few choices

Description

A vector filter for factors with only a few choices

Usage

shiny_vector_filter_factor_many(
  input,
  output,
  session,
  x = shiny::reactive(factor()),
  filter_na = shiny::reactive(FALSE),
  filter_fn = NULL,
  verbose = FALSE,
  erase_filters = shiny::reactive(0)
)

Arguments

Value

a reactiveValues list containing a logical vector called "mask" which can be used to filter the provided vector and an element "code" which is the expression used to generate the mask.

A vector filter for numeric variables with only a few choices

Description

A vector filter for numeric variables with only a few choices

Usage

shiny_vector_filter_numeric_few(
  input,
  output,
  session,
  x = shiny::reactive(factor()),
  filter_na = shiny::reactive(FALSE),
  filter_fn = NULL,
  verbose = FALSE,
  erase_filters = shiny::reactive(0)
)

Arguments

Value

a reactiveValues list containing a logical vector called "mask" which can be used to filter the provided vector and an element "code" which is the expression used to generate the mask.

A vector filter for numeric variables with only many choices

Description

A vector filter for numeric variables with only many choices

Usage

shiny_vector_filter_numeric_many(
  input,
  output,
  session,
  x = shiny::reactive(numeric()),
  filter_na = shiny::reactive(FALSE),
  filter_fn = NULL,
  verbose = FALSE,
  erase_filters = shiny::reactive(0)
)

Arguments

Value

a reactiveValues list containing a logical vector called "mask" which can be used to filter the provided vector and an element "code" which is the expression used to generate the mask.

A stub UI for a vector filter module

Description

This is a stub of a UI which assumes any dispatched module will create the needed UI in the "ui" uiOutput target

Usage

shiny_vector_filter_ui(data, inputId)

Arguments

Value

an empty link[shiny]{div} or a link[shiny]{uiOutput} placeholder expecting output "ui"

Helper to debug shinytests so they work interactively as well as during test

Description

Helper to debug shinytests so they work interactively as well as during test

Usage

shinytest_path(path)

Arguments

Value

a path that works irrespective of how the code is executed

Strip leading white space from a block of text

Description

Strip leading white space from a block of text

Usage

strip_leading_ws(txt, simplify = TRUE)

Arguments

Value

the block of text with entire columns of leading whitespace removed