R Shiny 动态 DT 数据表记住过滤器/排序

Question

我正在 build 一个 R Shiny带有动态数据表的应用程序，使用 DT包裹。用户可以在包含更多列的 data.frame 中选择两列。

当用户选择一列时，数据表会更新，所有过滤器/排序都将重置为数据表对象内的默认值。当给定的列未被用户替换时，如何让应用程序记住过滤器和排序？

下面的最小工作示例:

library(shiny)
library(DT)
library(data.table)


server <- function(input, output) {

  df <- data.frame(
    name = rep('a',20),
    dimA = 1:20,
    dimB = 21:40,
    dimC = 41:60
  )

  observe({
    columns <- c('name', input$dim1ID, input$dim2ID)
    dfDt <- df[names(df) %in% columns]

    output$dtDataTable = DT::renderDataTable(
      server = FALSE,

      expr = datatable(
        dfDt,
        filter = 'top',
        rownames = FALSE,
        selection = 'none',
        options = list(sDom  = '<"top">rt<"bottom">ip')
      )
    )
  })
}

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      ## Dimension 1
      selectInput(
        inputId = "dim1ID",
        label = "Dimensie 1",
        choices = c('dimA', 'dimB', 'dimC'),
        selected = 'dimA'
      ),
      ## Dimension 2      
      selectInput(
        inputId = "dim2ID",
        label = "Dimensie 2",
        choices = c('dimA', 'dimB', 'dimC'),
        selected = 'dimB'
      )
    ),
    mainPanel(DT::dataTableOutput('dtDataTable'))
  )
)

shinyApp(ui = ui, server = server)

Answer 1

这可以使用 DataTables Information 来完成。 ，特别是包含当前表的顺序信息的“状态”信息( input$tableId_state )和 input$tableId_search_columns其中包含按列过滤的信息。如果列是固定的(即，在上面的示例中，“Dimensie 1”和“Dimensie 2”将始终位于同一位置)，则“记住”订购了哪个列要简单得多(与按字母顺序排列的原始示例不同)创建表时重新排序)。例如，基于上面的示例，如果您对“A”列进行排序并将右列从“B”更改为“C”并返回，则以下内容将起作用:

library(shiny)
library(DT)
library(data.table)


server <- function(input, output) {
    
    df <- data.frame(
        name = rep('a',20),
        dimA = 1:20,
        dimB = 21:40,
        dimC = 41:60
    )
    
    values <- reactiveValues(
        prevDim1 = "",
        prevDim2 = "",
        options = list(sDom  = '<"top">rt<"bottom">ip',
                       stateSave = TRUE,
                       order = list())
    )
    
    observeEvent(input$dtDataTable_state$order, {
        values$options$order <- input$dtDataTable_state$order
    })
    
    observeEvent({
        input$dim1ID
        input$dim2ID
    },{
        columns <- c('name', input$dim1ID, input$dim2ID)
        dfDt <- df[names(df) %in% columns]
        
        if(length(values$options$order) != 0 && ((values$prevDim1 != input$dim1ID && values$options$order[[1]][[1]] == 1) | (values$prevDim2 != input$dim2ID && values$options$order[[1]][[1]] == 2)) ){
            values$options$order = list()
        }
        
        values$prevDim1 <- input$dim1ID
        values$prevDim2 <- input$dim2ID
        
        output$dtDataTable = DT::renderDataTable(
            server = FALSE,
            
            expr = datatable(
                dfDt,
                filter = 'top',
                rownames = FALSE,
                selection = 'none',
                options = values$options
            )
        )
    })
}

ui <- fluidPage(
    sidebarLayout(
        sidebarPanel(
            ## Dimension 1
            selectInput(
                inputId = "dim1ID",
                label = "Dimensie 1",
                choices = c('dimA', 'dimB', 'dimC'),
                selected = 'dimA'
            ),
            ## Dimension 2      
            selectInput(
                inputId = "dim2ID",
                label = "Dimensie 2",
                choices = c('dimA', 'dimB', 'dimC'),
                selected = 'dimB'
            )
        ),
        mainPanel(DT::dataTableOutput('dtDataTable'))
    )
)

shinyApp(ui = ui, server = server)