Shiny data filter module server function
shiny_data_filter(input, output, session, data, verbose = FALSE)
requisite shiny module field specifying incoming ui input reactiveValues
requisite shiny module field capturing output for the shiny data filter ui
requisite shiny module field containing the active shiny session
a data.frame
or reactive expression
returning a
data.frame
to use as the input to the filter module
a logical
value indicating whether or not to print log
statements out to the console
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.
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)
}