Shiny module to interactively filter a data.frame

Module generate inputs to filter data.frame according column's type. Code to reproduce the filter is returned as an expression with filtered data.

filterDF_UI(id, show_nrow = TRUE)

filterDF(
  input,
  output,
  session,
  data_table = reactive(),
  data_vars = shiny::reactive(NULL),
  data_name = reactive("data"),
  label_nrow = "Number of rows:",
  drop_ids = TRUE,
  picker = FALSE
)

Arguments

id	Module id. See callModule.
show_nrow	Show number of filtered rows and total.
input, output, session	standards shiny server arguments.
data_table	reactive function returning a data.frame to filter.
data_vars	reactive function returning a character vector of variable to use for filters.
data_name	reactive function returning a character string representing data_table name.
label_nrow	Text to display before the number of rows of filtered data / source data.
drop_ids	Drop columns containing more than 90% of unique values, or than 50 distinct values.
picker	Use shinyWidgets::pickerInput instead of shiny::selectizeInput (default).

Value

A list with 2 elements :

• data_filtered : reactive function returning data filtered.

• code : reactiveValues with 2 slots : expr (raw expression to filter data) and dplyr (code with dplyr pipeline).

Examples

if (interactive()) {
  
  library(shiny)
  library(shinyWidgets)
  library(ggplot2)
  library(esquisse)
  
  # Add some NAs to mpg
  mpg_na <- mpg
  mpg_na[] <- lapply(
    X = mpg_na,
    FUN = function(x) {
      x[sample.int(n = length(x), size = sample(15:30, 1))] <- NA
      x
    }
  )
  
  ui <- fluidPage(
    tags$h2("Filter data.frame"),
    
    radioButtons(
      inputId = "dataset", 
      label = "Data:",
      choices = c(
        "iris", "mtcars", "economics", 
        "midwest", "mpg", "mpg_na", "msleep", "diamonds",
        "faithfuld", "txhousing"
      ),
      inline = TRUE
    ),
    
    fluidRow(
      column(
        width = 3,
        filterDF_UI("filtering")
      ),
      column(
        width = 9,
        progressBar(
          id = "pbar", value = 100, 
          total = 100, display_pct = TRUE
        ),
        DT::dataTableOutput(outputId = "table"),
        tags$p("Code dplyr:"),
        verbatimTextOutput(outputId = "code_dplyr"),
        tags$p("Expression:"),
        verbatimTextOutput(outputId = "code"),
        tags$p("Filtered data:"),
        verbatimTextOutput(outputId = "res_str")
      )
    )
  )
  
  server <- function(input, output, session) {
    
    data <- reactive({
      get(input$dataset)
    })
    
    res_filter <- callModule(
      module = filterDF, 
      id = "filtering", 
      data_table = data,
      data_name = reactive(input$dataset)
    )
    
    observeEvent(res_filter$data_filtered(), {
      updateProgressBar(
        session = session, id = "pbar", 
        value = nrow(res_filter$data_filtered()), total = nrow(data())
      )
    })
    
    output$table <- DT::renderDT({
      res_filter$data_filtered()
    }, options = list(pageLength = 5))
    
    
    output$code_dplyr <- renderPrint({
      res_filter$code$dplyr
    })
    output$code <- renderPrint({
      res_filter$code$expr
    })
    
    output$res_str <- renderPrint({
      str(res_filter$data_filtered())
    })
    
  }
  
  shinyApp(ui, server)
  
}