Question

这里的第一次海报。我通常能够在没有张贴的情况下得到我的所有答案但是这个真的让我很难过。我是一个没有任何javascript经验的中级R用户。这就是我想要做的事情：

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

我设法发现我可以使用输入$ 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)

非常感谢。

编辑：

好的我已经做到了它应该是可重现的（需要有光泽的BS和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)

交互式数据表：重新呈现表

2 个答案: