带有复选框和分页的闪亮数据表答案

【问题标题】：Datatable in Shiny with checkboxes and pagination带有复选框和分页的闪亮数据表
【发布时间】：2020-02-29 18:50:37
【问题描述】：

我正在尝试在 R 中创建一个带有分页的数据表，并带有预先选择的复选框。其他示例（例如here）不考虑分页。

在以下示例中，当您返回页面时，复选框状态会被重置。此外，excludedrows 变量不计算在其他页面上检查的行数。

library(shiny)
library(DT)

ui = fluidPage(

tags$script(HTML('$(document).on("click", "input", function () {
var checkboxes = document.getElementsByName("row_selected");
var checkboxesChecked = [];
for (var i=0; i<checkboxes.length; i++) {

if (checkboxes[i].checked) {
checkboxesChecked.push(checkboxes[i].value);
}}
Shiny.onInputChange("checked_rows",checkboxesChecked);
})')),

  verbatimTextOutput("excludedRows"),
  DTOutput('myDT')
)

server = function(input, output) {

  mymtcars_reactive <- reactive(mtcars)

  output$myDT <- renderDataTable({

    mymtcars <- mymtcars_reactive()
    mymtcars[["Select"]] <- paste0('<input type="checkbox" name="row_selected" value=',1:nrow(mymtcars),' checked>')

    datatable(mymtcars,selection = "multiple",
          options = list(pageLength = 14,
                         lengthChange = FALSE,
                         stateSave = TRUE),
          rownames= FALSE,
          escape=F)
  })

  output$excludedRows <- renderPrint({
    intersect(input$checked_rows,1:nrow(mymtcars_reactive()))
  })
}

shinyApp(ui,server, options = list(launch.browser = TRUE)

【问题讨论】：

您是否尝试在DT::renderDataTable 中设置server = FALSE ？
server = FALSE解决了checked状态被重置的问题，但是没有给出正确的input$checked_rows值，仍然只统计当前页面的checked items。

标签： r shiny dt

【解决方案1】：

这是一种方法：

library(shiny)
library(DT)

mymtcars <- mtcars
mymtcars[["Select"]] <- paste0('<input type="checkbox" name="row_selected" value=',1:nrow(mymtcars),' checked>')
mymtcars[["_id"]] <- paste0("row_", seq(nrow(mymtcars)))

callback <- c(
  sprintf("table.on('click', 'td:nth-child(%d)', function(){", 
          which(names(mymtcars) == "Select")),
  "  var checkbox = $(this).children()[0];",
  "  var $row = $(this).closest('tr');",
  "  if(checkbox.checked){",
  "    $row.removeClass('excluded');",
  "  }else{",
  "    $row.addClass('excluded');",
  "  }",
  "  var excludedRows = [];",
  "  table.$('tr').each(function(i, row){",
  "    if($(this).hasClass('excluded')){",
  "      excludedRows.push(parseInt($(row).attr('id').split('_')[1]));",
  "    }",
  "  });",
  "  Shiny.setInputValue('excludedRows', excludedRows);",
  "});"
)

ui = fluidPage(
  verbatimTextOutput("excludedRows"),
  DTOutput('myDT')
)

server = function(input, output) {

  output$myDT <- renderDT({

    datatable(
      mymtcars, selection = "multiple",
      options = list(pageLength = 5,
                     lengthChange = FALSE,
                     rowId = JS(sprintf("function(data){return data[%d];}", 
                                        ncol(mymtcars)-1)),
                     columnDefs = list( # hide the '_id' column
                       list(visible = FALSE, targets = ncol(mymtcars)-1)
                     )
      ),
      rownames = FALSE,
      escape = FALSE,
      callback = JS(callback)
    )
  }, server = FALSE)

  output$excludedRows <- renderPrint({
    input[["excludedRows"]]
  })
}

shinyApp(ui,server, options = list(launch.browser = TRUE))

【讨论】：

在我的实际用例中，mymtcars 是一个具有动态长度的反应元素mymtcars()。因此，我尝试将回调JS直接放在数据表脚本中的服务器中`callback = JS(c(printf("table.on('...`)，但这不起作用。
@fithace 动态列数？您可以编辑您的问题以发布这样的示例吗？
好的，我已经更改了示例，因此有一个反应元素被制成数据表。这部分回调`sprintf("table.on('click', 'td:nth-child(%d)', function(){", which(names(mymtcars) == "Select")),`不能引用 reactive(mymtcars) 而不是 mymtcars，因为它在服务器函数之外。
@fithace 如果我举这个例子，如果将回调脚本放在renderDT 中，我看不出有任何问题。那么有什么问题呢？
好的，我犯了一个小错误（missed , server = FALSE）。非常感谢，它有效。