rshinyfilteringshinyappsfile-import

Shiny Dynamic filtering while importing files


Here is an example of dynamic filtering conducted using the iris data frame.

 library(dplyr)
 library(shiny)
 library(purrr)

   make_ui <- function(x, var) {
  if (is.numeric(x)) {
    rng <- range(x, na.rm = TRUE)
    sliderInput(var, var, min = rng[1], max = rng[2], value = rng)
  } else if (is.factor(x)) {
    levs <- levels(x)
    selectInput(var, var, choices = levs, selected = levs, multiple = TRUE)
  } else {
    # Not supported
    NULL
  }
}


filter_var <- function(x, val) {
  if (is.numeric(x)) {
    !is.na(x) & x >= val[1] & x <= val[2]
  } else if (is.factor(x)) {
    x %in% val
  } else {
    # No control, so don't filter
    TRUE
  }
}
 

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      map(names(iris), ~ make_ui(iris[[.x]], .x))
    ),
    mainPanel(
      tableOutput("data")
    )
  )
)
server <- function(input, output, session) {
  selected <- reactive({
    each_var <- map(names(iris), ~ filter_var(iris[[.x]], input[[.x]]))
    reduce(each_var, ~ .x & .y)
  })
  
  output$data <- renderTable(head(iris[selected(), ], 12))
} 
shinyApp(ui, server)

The output looks like this: enter image description here

How should the code be modified to have a similar output for the time in which we need to import a file, for example, a CSV file using the following code (rather than using a data frame already available):

fileInput('inputFile', 'Choose CSV/XLSX File',
                                             multiple = FALSE,
                                             accept = c('text/csv',
                                                        'text/comma-separated-values',
                                                        'application/vnd.ms-excel',
                                                        'application/vnd.openxmlformats-officedocument.spreadsheetml.sheet',
                                                        '.csv'))

Here is a code to generate a sample CSV file:

write.csv(iris, "my_example.csv", row.names = F)

Solution

  • There's no need to modularise. Since you now want part of your UI (the sidebar) to respond dynamically to user input, you can't define that part of the UI in the Ui function. Instead, you need to delegate the population to the server function using uiOutput and renderUI.

    I've added a selectInput to the sidebar to allow you to choose either mtcars or iris. Obviously, you should adapt this to satisfy your real use case. This selectInput is used to define a reactive (selectedData) that returns the required dataset. So the other changes simply replace iris with selectedData().

    library(dplyr)
    library(shiny)
    library(purrr)
    
    make_ui <- function(x, var) {
      if (is.numeric(x)) {
        rng <- range(x, na.rm = TRUE)
        sliderInput(var, var, min = rng[1], max = rng[2], value = rng)
      } else if (is.factor(x)) {
        levs <- levels(x)
        selectInput(var, var, choices = levs, selected = levs, multiple = TRUE)
      } else {
        # Not supported
        NULL
      }
    }
    
    filter_var <- function(x, val) {
      if (is.numeric(x)) {
        !is.na(x) & x >= val[1] & x <= val[2]
      } else if (is.factor(x)) {
        x %in% val
      } else {
        # No control, so don't filter
        TRUE
      }
    }
    
    ui <- fluidPage(
      sidebarLayout(
        sidebarPanel(
          selectInput("sourceData", "Source data:", c("iris", "mtcars")),
          uiOutput("sidebar")
        ),
        mainPanel(
          tableOutput("data")
        )
      )
    )
    server <- function(input, output, session) {
      selected <- reactive({
        each_var <- map(names(selectedData()), ~ filter_var(selectedData()[[.x]], input[[.x]]))
        reduce(each_var, ~ .x & .y)
      })
      
      selectedData <- reactive({
        if (input$sourceData == "iris") {
          iris
        } else {
          mtcars
        }
      })
      
      output$sidebar <- renderUI({
        map(names(selectedData()), ~ make_ui(selectedData()[[.x]], .x))
      })
      
      output$data <- renderTable(head(selectedData()[selected(), ], 12))
    } 
    
    shinyApp(ui, server)