Shiny - dynamic data filters using insertUI

后端 未结 1 1447
隐瞒了意图╮
隐瞒了意图╮ 2021-01-06 13:40

I am new to shiny and was trying to write an app where the user can dynamically add data filters (see code below). I thought insertUI and remove UI are pretty cool for that

1条回答
  •  醉梦人生
    2021-01-06 14:40

    Please see the code below for my suggestions. I basically did what you were hoping/trying to do, namely to add observers dynamically such that each new filter element has its own observer. It turns out: you can just do it. Just like that. So I added observers inside the exact observeEvent where the ui elements are rendered, to give them the reactivity they need. I even added "personal" remove buttons, which will be more convenient than just removing the bottommost one. Also, the logic to handle all those filters will be an aggregated list that stores all the information currently selected in the various filters. This makes the renderTable part much easier.

    Make yourself familiar with the code and please ask, if there are any uncertainties.

    Best Regards

    library(shiny)
    
    ui <- fluidPage(
      sidebarLayout(
        sidebarPanel(
          fluidRow(
            column(6, actionButton('addFilter', 'Add filter')),
            offset = 6
          ),
          tags$hr(),
          tags$div(id = 'placeholderAddRemFilt'),
          tags$div(id = 'placeholderFilter'),
          width = 4 # sidebar
        ),
        mainPanel(
          tableOutput("data")
        )
      )
    )
    
    server <- function(input, output,session) {
      filter <- character(0)
    
      makeReactiveBinding("aggregFilterObserver")
      aggregFilterObserver <- list()
    
      observeEvent(input$addFilter, {
        add <- input$addFilter
        filterId <- paste0('Filter_', add)
        colfilterId <- paste0('Col_Filter_', add)
        rowfilterId <- paste0('Row_Filter_', add)
        removeFilterId <- paste0('Remove_Filter_', add)
        headers <- names(mtcars)
        insertUI(
          selector = '#placeholderFilter',
          ui = tags$div(id = filterId,
            actionButton(removeFilterId, label = "Remove filter", style = "float: right;"),
            selectInput(colfilterId, label = "Some Filter", choices = as.list(headers), selected = 1),
            checkboxGroupInput(rowfilterId, label = "Select variable values",
                               choices = NULL, selected = NULL, width = 4000)
          )
        )
    
        observeEvent(input[[colfilterId]], {
    
          col <- input[[colfilterId]]
          values <- as.list(unique(mtcars[col]))[[1]]
    
          updateCheckboxGroupInput(session, rowfilterId , label = "Select variable    values", 
                                  choices = values, selected = values, inline = TRUE)
    
          aggregFilterObserver[[filterId]]$col <<- col
          aggregFilterObserver[[filterId]]$rows <<- NULL
        })
    
        observeEvent(input[[rowfilterId]], {
    
          rows <- input[[rowfilterId]]
    
          aggregFilterObserver[[filterId]]$rows <<- rows
    
        })
    
        observeEvent(input[[removeFilterId]], {
          removeUI(selector = paste0('#', filterId))
    
          aggregFilterObserver[[filterId]] <<- NULL
    
        })
      })
    
      output$data <- renderTable({
    
        dataSet <- mtcars
    
        invisible(lapply(aggregFilterObserver, function(filter){
    
          dataSet <<- dataSet[which(!(dataSet[[filter$col]] %in% filter$rows)), ]
    
        }))
    
        dataSet
      })
     }
    
    shinyApp(ui = ui, server = server)
    

    0 讨论(0)
提交回复
热议问题