交互式数据表：重新渲染表后保留列过滤器

Question

第一次在这里发布海报。我通常能够在不发布的情况下获得所有答案，但这确实让我难过。我是一个没有任何 javascript 经验的中级 R 用户。这是我正在尝试做的事情：

我有一个数据表，它通过操作按钮对我的数据进行子集化使用交互式闪亮过滤器，以及内置的数据表过滤器。操作按钮通过对数据框进行子集化来执行批量过滤。我遇到的问题是，每当应用这些批量过滤器之一时，都会重新呈现数据表并清除所有单独的列过滤器。我希望能够在对数据进行子集化和重新呈现表格时保持各个列过滤器处于活动状态。

我设法发现我可以使用 input$mytable_search_columns 从数据表中输出和隔离这些信息，但我不知道如何编写在重新渲染表时应用此条件的 javascript。

library(shinyBS)
library(DT)

server <- function(input, output, session) {

  df <- reactive({iris})

  df.sub <- reactive({
    if(input$buttonfilter == 0){
      df.sub <- df()
    }
    if(input$buttonfilter == 1){
      df.sub <- subset(df(), subset = Species == 'setosa')
    }
    df.sub
  })

  output$mytable <- DT::renderDataTable(df.sub(),
                                        filter = 'top')
  output$filters <- renderText({input$mytable_search_columns})
}
ui <- fluidPage(
  h3('Button Toggle Filter'),
  bsButton("buttonfilter","Show only Setosa", type = 'toggle'),
  br(),
  br(),
  h3('Current filters'),
  textOutput('filters'),
  br(),
  br(),
  DT::dataTableOutput('mytable')



)

shinyApp(ui = ui, server = server)

非常感谢。

编辑：

好的，我已经做到了，它应该是可重现的（需要 shinyBS 和 DT 包）。

我正在尝试做的是找到一种方法来维护当前的 DT 过滤器，当基于操作按钮启动的子集重新呈现表时。在此示例中，您可以看到重新渲染表格后过滤器被清除。

谢谢！

Answer 1

我找到了一种不使用 JavaScript 的方法。我真的很惊讶它起作用了。我从来不需要处理包 DT，但我认为这就是你想要的：

library(shinyBS)
library(DT)

server <- function(input, output, session) {

  df <- reactive({
    if(input$buttonfilter %% 2 == 0){
      df.sub <- iris
    } else {
      df.sub <- subset(iris, subset = Species == 'setosa')
    }
    df.sub
  })


  output$mytable <- DT::renderDataTable(isolate(df()), filter = 'top')
  proxy <- dataTableProxy('mytable')

  observe({
    replaceData(proxy, df(), resetPaging = FALSE)
  })  
}

ui <- fluidPage(h3('Button Toggle Filter'),
                bsButton("buttonfilter","Show only Setosa", type = 'toggle'),
                br(),br(),
                DT::dataTableOutput('mytable')
)

shiny::shinyApp(ui=ui,server=server)

我们基本上是为我们的表创建一个代理，然后替换渲染表的数据。有关详细信息，请查看此页面的最底部：https://rstudio.github.io/DT/shiny.html

我的电脑上没有找到上面提到的例子，但是你可以去 GitHub 复制粘贴：https://github.com/rstudio/DT/blob/master/inst/examples/DT-reload/app.R

希望这会有所帮助。

Answer 2

这是另一种解决方案。此解决方案的优点是即使显示的列发生更改，也会保留过滤器。为了实现这一点，创建了一个数据框来保存过滤器值和当前显示的列。

    library(shiny)           #  Shiny web app
    library(shinydashboard)  #  Dashboard framework for Shiny
    library(plotly)          #  Plotly interactive plots
    library(DT)

    # default global search value
    if (!exists("default_search")) default_search <- ""

    # ---- ui ----

    ui <- dashboardPage(
      dashboardHeader(),
      dashboardSidebar(
        sidebarMenu(
          menuItem(
            "select species",
            tabName = "selectspecies",
            selectizeInput(
              "select_species",
              '',
              choices = sort(iris$Species),
              selected = "versicolor",
              multiple =T)
          ),
          menuItem(
            "select Columns",
            tabName = "selectcols",
            selectizeInput(
              "select_cols",
              '',
              choices = sort(names(iris)),
              selected = names(iris),
              multiple =T )
          )
        )),
      dashboardBody(
        fluidRow(column(12, DTOutput("table"))
        )
      )
    )

    # ---- server ----


    server <- function(input, output, session) {

      # initialize help table
      transition <- reactiveValues()
      transition$table <- data.frame("colnames" = sort(names(iris)),
          "filter" = c("","","","",""), "active" = c(T,T,T,T,T) )

      # Update table if sidebar input is changed (lacy)
      fileData <- reactive({
        iris2 <- iris[iris$Species == input$select_species,]
        iris3 <- iris2[input$select_cols]
      })

      # before table is updated save all filter settings in transition$table
      observeEvent( c(input$select_cols,input$select_species ),{

        # Set type
        transition$table[,"filter"] <- as.character(transition$table[,"filter"])

        # check if it is the inital start
        if(length(input$table_search_columns )!=0){
          # save filter settings in currently displayed columns 
          transition$table[transition$table[,"active"]==T, "filter"] <- input$table_search_columns
        }
        # save new column state after changing
        transition$table[,"active"] <- transition$table[,"colnames"] %in% input$select_cols

      })

      observeEvent( fileData(),{

        # update global search and column search strings
        default_search <- input$table_search

        # set column settings
        default_search_columns <- c("",
             transition$table[transition$table[,"active"]==T, "filter"])


        # update the search terms on the proxy table (see below)
        proxy %>% updateSearch(keywords =
                                 list(global = default_search, columns = default_search_columns))


      })

      output$table <- renderDT({

        # reorder columns 
        fileData <- fileData()[,sort(names(fileData()))]

        DT::datatable(fileData, filter = "top", 
                      options = list(stateSave = F
                      )
        )
      })
      # initialize proxy to transfer settings
      proxy <- dataTableProxy("table")


    }

    shinyApp(ui,server)