r - 带有复选框和分页的 Shiny 数据表

Question

我正在尝试在 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)

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