使用 Shiny ActionButton 选择所有行或将所有行添加到当前视图中的选择中，并在 DT 数据表中进行过滤

Question

1. 我一直在尝试创建 ActionButtons 以允许用户在反应式过滤数据表中“选择视图中的所有行”。

目前该按钮使用 tableid_rows_current;但是，我还想添加一个表代理，这样如果您在另一个页面上，它就不会重置到结果的第一页，但是经过多次谷歌搜索后我无法弄清楚语法（请参阅注释中的尝试代码）。此外，如果您手动选择某些行，它将不再起作用。

1. 另一个允许用户“将视图中的所有行添加到选择”的操作按钮。也就是说，将视图中的所有当前行添加到您之前的选择中。这个我什至不知道从哪里开始，所以任何想法都值得赞赏。

（此处不包括，但如果有人感兴趣，我确实已经有“清除选择”和“清除过滤器”按钮）

下面的最小可重现代码。该应用程序旨在显示所选行的图像，但在这里您不会显示实际图像，这并不是什么大问题。

library(DT)
library(shiny)

dat <- data.frame(
  type = c("car", "truck", "scooter", "bike"),
  frontimage = c("carf.jpg", "truckf.jpg", "scooterf.jpg", "bikef")
)
  
# ----UI----
ui <- fluidPage(
  titlePanel("Buttons 'select all' and 'add to select'"),
  
  mainPanel(
    DTOutput("table"),
    actionButton("select_all_current", "Select All Rows in View"),
    actionButton("add_to_selection", "Add All Rows in View to Selection"),
    uiOutput("img1")
  )
)

# ----Server----
server = function(input, output, session){
  
  # Action button to select all rows in current view
  var <- reactiveValues()
  tableProxy <- dataTableProxy('table')
  
  observeEvent(input$select_all_current, {
    print("select_all_current")
    # tableProxy %>% selectRows(1:nrow(input$table_rows_current))
    # var$selected <- tableProxy %>% input$table_rows_current
    
    tableProxy <- #I want the table proxy to be whatever the current selection and filters are and the current page view to stay the same after selecting
      var$selected <- input$table_rows_current
  })
  
  # Action button to add all rows in current view to previous selection
  observeEvent(input$add_to_selection, {
    print("select_all_current")
    
  })
  
  # Data table with filtering
  output$table = DT::renderDT({
    datatable(dat, filter = list(position = "top", clear = FALSE), 
              selection = list(target = 'row', selected = var$selected),
              options = list(
                autowidth = TRUE,
                pageLength = 2,
                lengthMenu = c(2, 4)
              ))
  })
  
  # Reactive call that only renders images for selected rows 
  df <- reactive({
    dat[input[["table_rows_selected"]], ]
  })
  
  # Front image output
  output$img1 = renderUI({
    imgfr <- lapply(df()$frontimage, function(file){
      tags$div(
        tags$img(src=file, width="100%", height="100%")
      )
      
    })
    do.call(tagList, imgfr)
  })

}
# ----APP----    
# Run the application 
shinyApp(ui, server)

Answer 1

这是否符合您的要求？

library(DT)
library(shiny)

dat <- data.frame(
  type = c("car", "truck", "scooter", "bike"),
  frontimage = c("carf.jpg", "truckf.jpg", "scooterf.jpg", "bikef")
)

# ----UI----
ui <- fluidPage(
  titlePanel("Buttons 'select all' and 'add to select'"),
  
  mainPanel(
    DTOutput("table"),
    actionButton("select_all_current", "Select All Rows in View"),
    actionButton("add_to_selection", "Add All Rows in View to Selection"),
    uiOutput("img1")
  )
)

# ----Server----
server = function(input, output, session){
  
  # Action button to select all rows in current view
  var <- reactiveValues()
  tableProxy <- dataTableProxy('table')
  
  observeEvent(input$select_all_current, {
    print("select_all_current")
    # tableProxy %>% selectRows(1:nrow(input$table_rows_current))
    # var$selected <- tableProxy %>% input$table_rows_current
    
    # tableProxy <- #I want the table proxy to be whatever the current selection and filters are and the current page view to stay the same after selecting
      # var$selected <- input$table_rows_current
    selectRows(proxy = tableProxy,
               selected = input$table_rows_current)
  })
  
  # Action button to add all rows in current view to previous selection
  observeEvent(input$add_to_selection, {
    print("select_all_current")
    
    selectRows(proxy = tableProxy,
               selected = c(input$table_rows_selected, input$table_rows_current))
    
  })
  
  # Data table with filtering
  output$table = DT::renderDT({
    datatable(dat, filter = list(position = "top", clear = FALSE), 
              selection = list(target = 'row'),#, selected = var$selected),
              options = list(
                autowidth = TRUE,
                pageLength = 2,
                lengthMenu = c(2, 4)
              ))
  })
  
  # Reactive call that only renders images for selected rows 
  df <- reactive({
    dat[input[["table_rows_selected"]], ]
  })
  
  # Front image output
  output$img1 = renderUI({
    imgfr <- lapply(df()$frontimage, function(file){
      tags$div(
        tags$img(src=file, width="100%", height="100%")
      )
      
    })
    do.call(tagList, imgfr)
  })
  
}
# ----APP----    
# Run the application 
shinyApp(ui, server)