使 DT in-table 过滤器响应子集数据

Make DT in-table filters responsive to subsetted data

我正在创建一个 table,我希望用户能够首先使用小部件过滤数据以减少数据集,但仍然希望用户能够使用内置的 DT 过滤器进一步减少数据。但是,当采用这种方法时,我发现内置过滤器仍然包含原始数据集中存在的值,这些值实际上并不存在于要传递的数据中。

例如,在这种情况下,只有 'setosa' 和 'versicolor' 包含在 table 中,但 'virginica' 仍然是内置过滤器中的一个选项。

Issue Example Image

有没有办法让内置过滤器只包含输入数据集中存在的选项?

下面是演示该问题的示例代码:

##### Load Libraries #####
library(shiny)
library(shinyWidgets)
library(shinythemes)
library(DT)
library(shinyBS)
library(rgdal)
library(tidyverse)
library(shinyjs)

ui <- fluidPage(
  mainPanel(
    pickerInput("SpeciesPick","Select Species",choices=c("setosa","versicolor","virginica"),multiple=TRUE),
    div(DT::dataTableOutput("Table1"),filter="top")
    
  )
)

server <- function(input, output) {
  
  iris1<-reactive(iris[,])
  iris2<-reactive({iris1()%>%filter(Species%in%input$SpeciesPick)})
  
  #### Datatable 1 #####
  
  output$Table1<-DT::renderDT(
    iris2(),extensions=c('Buttons','Select','Scroller'),
    options=list(
      scrollX=TRUE,
      scrollY=400,
      scroller=TRUE,
      select=list(style='os',items='row'),
      dom='Blfrtip',
      buttons = list(list(extend='selectAll',className='selectAll',
                          text="Select All Visible",
                          action=DT::JS("function () {
                            var table = $('#Table1 table.dataTable').DataTable();
                            table.rows({ search: 'applied'}).deselect();
                            table.rows({ search: 'applied'}).select();
            }")
      ), list(extend='selectNone',className='selectNone',
              text="Deselect All Visible",
              action=DT::JS("function () {
                            var table = $('#Table1 table.dataTable').DataTable();
                            table.rows({ search: 'applied'}).select();
                            table.rows({ search: 'applied'}).deselect();

            }")
      ),'selectAll','selectNone','copy','csv')),
    selection='none',
    class="display nowrap compact",
    filter="top",
    server = FALSE
  )
}

shinyApp(ui = ui, server = server)

这是因为iris$Species是一个因子,DT滤镜使用的是这个因子的水平,在[=之后仍然是setosavirginicaversicolor 15=] 过滤,即使其中一些出现次数为 0。要删除出现次数为 0 的级别,请使用 droplevels 函数:

iris2 <- reactive({
  droplevels(iris1() %>% filter(Species %in% input$SpeciesPick))
})