Skip to contents

Shiny data filter module server function

shiny_data_filter.Rd

Shiny data filter module server function

Usage

shiny_data_filter(
  input,
  output,
  session,
  data,
  choices = names,
  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

choices

a list of values to select from, passed to selectizeInput. Alternatively, choices may also be a function used to extract choices from a (possibly filtered) data. Defaults to the names of data.

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 structuer also contains a "code" field which represents the code needed to generate the filtered data.

See also

shiny_data_filter_ui

Examples

if (FALSE) {
library(shiny)
library(shinyDataFilter)

library(dplyr)  # for data preprocessing 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 = TRUE
  )

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