IDEA data filter module server function

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

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

Arguments

id

a module id name

data

a data.frame or reactive expression returning a data.frame to use as the input to the filter module

...

placeholder for inclusion of additional parameters in future development

col_subset

a vector containing the list of allowable columns to filter on

preselection

a list that can be used to pre-populate the filter

verbose

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

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)
}
#> Loading required package: dplyr
#> 
#> Attaching package: ‘dplyr’
#> The following objects are masked from ‘package:stats’:
#> 
#>     filter, lag
#> The following objects are masked from ‘package:base’:
#> 
#>     intersect, setdiff, setequal, union