shiny_data_filter {IDEAFilter}

Shiny data filter module server function

Description

Shiny data filter module server function

Usage

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

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

data

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

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

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