Shiny DT::renderDataTable 的“全选”复选框

Question

我想要一个复选框，用于在 Shiny 中的标准 DT::renderDataTable 中选择所有显示的行（显示是关键，因为这在您应用的过滤器和整个数据表之间有所不同）。

是否有任何 DT 扩展已经这样做了？我的编码技能很基础，所以我无法编写等效的 Java 或 HTML 代码。

到目前为止，这是我的应用程序，任何 csv 文件都兼容全选用途。目前有一种笨拙的方法来创建所有选定行的另一个表（手动逐个选择） - 当您想要选择 30 种具有相同特征的动物时，这很困难。

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



ui = pageWithSidebar(

  headerPanel(""),

  #This is where the full animal information file is input, as a ".txt" file.
  sidebarPanel(
    fileInput("ani", "Upload Animal Information File", accept = ".csv"),
    br(),
    numericInput("groups","Number of Ewe Groups", value = 1 ),
    #This is a list of the table headers. These headers can be indivdually selected to be part of the concatenated "Unique ID" single column.  
    uiOutput("choose_columns"),
    width = 2),
  mainPanel(
  DT::dataTableOutput("ani1"),
  DT::dataTableOutput("selectedEwes")
))






server = function(input, output, session) {

    animalinformation <- reactive({
        file1 <- input$ani
        if (is.null(file1))
            return(NULL)
        #This removes the Ewes and Status non-zero Rams from the displayed data, so that only live/at hand Rams are shown for selection.    
        isolate({
            anifile <- read.csv(file1$datapath, header = TRUE)
            anifile <- as.data.frame(anifile)
        })
        anifile
    })


    output$choose_columns <- renderUI({
        if (is.null(animalinformation()))
            return()
        colnames <- names(animalinformation())


        # Create the checkboxes and select them all by default
        checkboxGroupInput("columns", "Choose Columns",
                       choices = colnames,
                       selected = colnames)
    })




    #This line is repsonsible for creating the table for display.
    output$ani1 = DT::renderDataTable({
        if (is.null(animalinformation()))
            return()
        if (is.null(input$columns) || !(input$columns %in% names(animalinformation()))) { return() }
            { datatable(animalinformation()[, input$columns, drop = F], filter = "top") }
    })


    ani1_selected <- reactive({
        ids <- input$ani1_rows_selected
        animalinformation()[ids,]
    })





    #This displays the table of selected rows from the table of Rams. This table can be downloaded or printed, or copied using the buttons that appear above the table, thanks to the 'Buttons' extension.
    output$selectedEwes <- DT::renderDataTable({
        datatable(
      ani1_selected(),
      selection = list(mode = "none"),
      caption = "Copy to clipboard, download a .csv or print the following table of selected Ewes, using the above buttons.", extensions = 'Buttons', options = list(dom = 'Bfrtip', buttons = c('copy', 'csv', 'excel', 'pdf', 'print'))
    )
    })





}

shinyApp(ui = ui, server = server)

任何帮助将不胜感激。

Answer 1

这是我能想到的最简单的实现。它利用了 DT 将过滤器行索引返回给 R 的事实，在下面的示例中为 input$dt_rows_all。此外，它使用DT::dataTableProxy() 来控制行选择。最后，它可以在客户端模式和服务器端处理模式下工作。

顺便提一下，使用 javascript 来模拟 DT 中的选择/取消选择事件不会改变 R 中相关的闪亮绑定值（例如，input$dt_rows_selected）。这是因为 DT 有自己的行选择实现（将来可能会改变，但在撰写本文时还没有）。如果您想了解更多信息，请参阅rstudio/DT#366。

library(shiny)
ui <- tagList(
  DT::DTOutput("dt"),
  checkboxInput("dt_sel", "sel/desel all"),
  h4("selected_rows:"),
  verbatimTextOutput("selected_rows", TRUE)
)

server <- function(input, output, session) {
  dat <- reactive({iris})
  output$dt <- DT::renderDT(dat(), server = TRUE)
  dt_proxy <- DT::dataTableProxy("dt")
  observeEvent(input$dt_sel, {
    if (isTRUE(input$dt_sel)) {
      DT::selectRows(dt_proxy, input$dt_rows_all)
    } else {
      DT::selectRows(dt_proxy, NULL)
    }
  })
  output$selected_rows <- renderPrint(print(input$dt_rows_selected))
}

shiny::runApp(list(ui = ui, server = server))