Shiny Dynamic filtering while importing files-CodePudding

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)

CodePudding user response：

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)