交互式数据表:在重新绘制表后保留列筛选器

Interactive datatable: keep column filters after rerendering the table

本文关键字:保留 筛选 绘制 数据表 新绘制 交互式      更新时间:2023-09-26

此处为首次海报。我通常可以在不发帖的情况下得到所有答案,但这一次真的让我很困惑。我是一个中级R用户,没有任何javascript经验。以下是我要做的:

我有一个数据表,它通过操作按钮使用交互式闪亮过滤器(对我的数据进行子集设置),也使用内置的数据表过滤器。操作按钮通过对数据帧进行子设置来执行批量筛选。我遇到的问题是,每当应用其中一个大容量过滤器时,就会重新呈现数据表,并清除所有单独的列过滤器。我希望能够在数据被子集化和表被重新渲染时保持单独的列过滤器处于活动状态。

我已经设法发现,我可以使用输入$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过滤器。在本例中,您可以看到一旦重新渲染表,过滤器就会被清除。

谢谢!

我找到了一种不使用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

希望这能有所帮助。

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


    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)