User interface function to add a data filter panel

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

IDEAFilter_ui(id)

Arguments

id

a module id name

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