带有复选框和范围滑块的闪亮通用数据过滤器

Question

在我可以上传任何数据集的闪亮应用程序中，我试图添加一个过滤器系统以选择任何列并使用sliderInput或checkboxInput过滤数据

我的问题是：
-经过1个过滤器后，接下来的过滤器会损坏
-取消选中最后一个复选框不会删除该列的过滤器

我发现这样：Shiny - dynamic data filters using insertUI我使用了一个底数，但只允许使用复选框进行过滤（不适用于数值数据）

library(shiny)
library(shinyWidgets)

mydata = iris

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(mydata)

    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 = 0),
                    uiOutput("rowfilterIdP")
      )
    )
    #select column observer
    observeEvent(input[[colfilterId]], {
      col <- input[[colfilterId]]
      values <- as.list(unique(mydata[col]))[[1]]

      output$rowfilterIdP = renderUI(
        if (is.numeric(values)) {
          shinyWidgets::sliderTextInput(inputId = rowfilterId, label = "select", choices = as.character(order(values)))
        }else{
          checkboxGroupInput(rowfilterId , label = "Select variable    values", 
                             choices = values, selected = values, inline = TRUE)
        }
      )
      aggregFilterObserver[[filterId]]$col <<- col
      aggregFilterObserver[[filterId]]$rows <<- NULL
      print("----")
      print(aggregFilterObserver)
    })
    #input observer
    observeEvent(input[[rowfilterId]], {
      rows <- input[[rowfilterId]]
      aggregFilterObserver[[filterId]]$rows <<- rows
      print("----")
      print(aggregFilterObserver)
    })
    #remove selected filter
    observeEvent(input[[removeFilterId]], {
      removeUI(selector = paste0('#', filterId))
      aggregFilterObserver[[filterId]] <<- NULL
      print("----")
      print(aggregFilterObserver)
    })
  })

  output$data <- renderTable({
    dataSet <- mydata
    invisible(lapply(aggregFilterObserver, function(filter){
      dataSet <<- dataSet[which(!(dataSet[[filter$col]] %in% filter$rows)), ]
    }))
    dataSet
  })
}

shinyApp(ui = ui, server = server)

如何修改此代码以允许带范围滑块的数值输出过滤器。 这是我对代码的看法：

library(shiny)

mydata = iris

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(mydata)

    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),
                    uiOutput("rowfilterIdP")
      )
    )

    observeEvent(input[[colfilterId]], {
      col <- input[[colfilterId]]
      values <- as.list(unique(mydata[col]))[[1]]

      output$rowfilterIdP = renderUI(
        if (is.numeric(values)) {
          shinyWidgets::sliderTextInput(inputId = rowfilterId, label = "select", choices = as.character(order(values)))
        }else{
          checkboxGroupInput(rowfilterId , label = "Select variable    values", 
                             choices = values, selected = values, inline = TRUE)
        }
      )
      aggregFilterObserver[[filterId]]$col <<- col
      aggregFilterObserver[[filterId]]$rows <<- NULL
      print("----")
      print(aggregFilterObserver)
    })

    observeEvent(input[[rowfilterId]], {
      rows <- input[[rowfilterId]]
      aggregFilterObserver[[filterId]]$rows <<- rows
      print("----")
      print(aggregFilterObserver)
    })

    observeEvent(input[[removeFilterId]], {
      removeUI(selector = paste0('#', filterId))
      aggregFilterObserver[[filterId]] <<- NULL
      print("----")
      print(aggregFilterObserver)
    })
  })

  output$data <- renderTable({
    dataSet <- mydata
    invisible(lapply(aggregFilterObserver, function(filter){
      dataSet <<- dataSet[which(!(dataSet[[filter$col]] %in% filter$rows)), ]
    }))
    dataSet
  })
}

shinyApp(ui = ui, server = server)