R Shiny: How to dynamically append arbitrary number of input widgets

后端 未结 4 460
没有蜡笔的小新
没有蜡笔的小新 2021-02-02 01:06

The goal

I am working on a Shiny app that allows the user to upload their own data and focus on the entire data or a subset by providing data filtering widgets describ

4条回答
  •  北荒
    北荒 (楼主)
    2021-02-02 01:56

    Now, I think that I understand better the problem.

    Suppose the user selects the datasets::airquality dataset (here, I'm showing only the first 10 rows):

    The field 'Select Variable 1' shows all the possible variables based on the column names of said dataset:

    Then, the user selects the condition and the value to filter the dataset by:

    Then, we want to add a second filter (still maintaining the first one):

    Finally, we get the dataset filtered by the two conditions:

    If we want to add a third filter:

    You can keep adding filters until you run out of data.

    You can also change the conditions to accommodate factors or character variables. All you need to do is change the selectInput and numericInput to whatever you want.

    If this is what you want, I've solved it using modules and by creating a reactiveValue (tmpFilters) that contains all selections (variable + condition + value). From it, I created a list with all filters (tmpList) and from it I created the proper filter (tmpListFilters) to use with subset.

    This works because the final dataset is "constantly" being subset by this reactiveValue (the tmpFilters). At the beginning, tmpFilters is empty, so we get the original dataset. Whenever the user adds the first filter (and other filters after that), this reactiveValue gets updated and so does the dataset.

    Here's the code for it:

    library(shiny)
    
    # > MODULE #####################################################################
    
    ## |__ MODULE UI ===============================================================
    
    variablesUI <- function(id, number, LHSchoices) {
      
      ns <- NS(id)
      
      tagList(
        fluidRow(
          column(
            width = 4,
            selectInput(
              inputId = ns("variable"),
              label   = paste0("Select Variable ", number),
              choices = c("Choose" = "", LHSchoices)
            )
          ),
          
          column(
            width = 4,
            selectInput(
              inputId = ns("condition"),
              label   = paste0("Select condition ", number),
              choices = c("Choose" = "", c("==", "!=", ">", ">=", "<", "<="))
            )
          ),
          
          column(
            width = 4,
            numericInput(
              inputId = ns("value.variable"),
              label   = paste0("Value ", number),
              value   = NA, 
              min     = 0
            )
          )
        )
      )
    }
    
    ## |__ MODULE SERVER ===========================================================
    
    filter <- function(input, output, session){
      reactive({
        
        req(input$variable, input$condition, input$value.variable)
    
        fullFilter <- paste0(
          input$variable,
          input$condition, 
          input$value.variable
        )
        
        return(fullFilter)
        
      })
    }
    
    # Shiny ########################################################################
    
    ## |__ UI ======================================================================
    
    ui <- fixedPage(
      fixedRow(
        column(
          width = 5,
          selectInput(
            inputId = "userDataset",
            label   = paste0("Select dataset"),
            choices = c("Choose" = "", ls("package:datasets"))
          ),
          h5(""),
          actionButton("insertBtn", "Add another filter")
        ),
        column(
          width = 7, 
          tableOutput("finalTable")
        )
      )
    )
    
    ## |__ Server ==================================================================
    
    server <- function(input, output) {
      
      ### \__ Get dataset from user selection ------------------------------------
      
      originalDF <- reactive({
        
        req(input$userDataset)
        
        tmpData <- eval(parse(text = paste0("datasets::", input$userDataset)))
        
        if (!class(tmpData) == "data.frame") {
          stop("Please select a dataset of class data.frame")
        }
        
        tmpData
        
      })
      
      ### \__ Get the column names -----------------------------------------------
      
      columnNames <- reactive({
        
        req(input$userDataset)
        
        tmpData <- eval(parse(text = paste0("datasets::", input$userDataset)))
        
        names(tmpData)  
          
      })
      
      ### \__ Create Reactive Filter ---------------------------------------------
      
      tmpFilters <- reactiveValues()
      
      ### \__ First UI Element ---------------------------------------------------
      ### Add first UI element with column names
      
      observeEvent(input$userDataset, {
        insertUI(
          selector = "h5",
          where    = "beforeEnd",
          ui       = tagList(variablesUI(paste0("var", 1), 1, columnNames()))
        )
      })
      
      ### Update Reactive Filter with first filter
      
      filter01 <- callModule(filter, paste0("var", 1))
      
      observe(tmpFilters[['1']] <- filter01())
      
      ### \__ Other UI Elements --------------------------------------------------
      ### Add other UI elements with column names and update the filter 
      
      observeEvent(input$insertBtn, {
        
        btn <- sum(input$insertBtn, 1)
        
        insertUI(
          selector = "h5",
          where    = "beforeEnd",
          ui       = tagList(variablesUI(paste0("var", btn), btn, columnNames()))
        )
        
        newFilter <- callModule(filter, paste0("var", btn))
        
        observeEvent(newFilter(), {
          tmpFilters[[paste0("'", btn, "'")]] <- newFilter()
        })
        
      })
      
      ### \__ Dataset with Filtered Results --------------------------------------
      
      resultsFiltered <- reactive({
        
        req(filter01())
        
        tmpDF <- originalDF()
        
        tmpList <- reactiveValuesToList(tmpFilters)
        
        if (length(tmpList) > 1) {
          tmpListFilters <- paste(tmpList, "", collapse = "& ")
        } else {
          tmpListFilters <- unlist(tmpList)
        }
        
        tmpResult <- subset(tmpDF, eval(parse(text = tmpListFilters)))
        
        tmpResult
        
      })
      
      ### \__ Print the Dataset with Filtered Results ----------------------------
      
      output$finalTable <- renderTable({
        
        req(input$userDataset)
        
        if (is.null(tmpFilters[['1']])) {
          head(originalDF(), 10)
          
        } else {
          head(resultsFiltered(), 10)
        }
    
      })
    }
    
    #------------------------------------------------------------------------------#
    shinyApp(ui, server)
    
    # End
    

提交回复
热议问题