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))