esquisse (version 0.3.0)

module-filterDF: Shiny module to interactively filter a data.frame

Description

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

Usage

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

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

Run this code
# NOT RUN {
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)
  
}
# }

Run the code above in your browser using DataCamp Workspace