Mit R Shiny möchte ich eine Tabelle anzeigen (z. B. über das Paket „DT“), in der jede Zelle ein Kontrollkästchen enthält. Neben jeder Zeilen- und Spaltenüberschrift möchte ich ein „Alle auswählen“/„Haupt-Kontrollkästchen“ anzeigen, das bei Auswahl alle Kontrollkästchen in der entsprechenden Zeile oder Spalte auswählt. Als zusätzliche Funktion werden mit dem Kontrollkästchen in der oberen linken Zelle alle Kontrollkästchen in der Tabelle ausgewählt. Ein Beispiel:
Ich habe hier ein Beispiel für diese Funktionalität gefunden, bei dem eine Spalte ein Haupt-Kontrollkästchen hat (mit etwas JavaScript), aber ich kann nicht herausfinden, wie ich es entsprechend meinen Anforderungen erweitern kann.
library(shiny) library(DT) ui <- fluidPage( # Sidebar panel sidebarPanel(), # Main panel with the table mainPanel( DTOutput("myTable") ) ) server <- function(input, output){ dat <- data.frame( vapply(1:6, function(i){ as.character( checkboxInput(paste0("col1-", i), label = NULL, width = "150px") ) }, character(1)), vapply(1:6, function(i){ as.character( checkboxInput(paste0("col2-", i), label = NULL, width = "150px") ) }, character(1)), vapply(1:6, function(i){ as.character( checkboxInput(paste0("col3-", i), label = NULL, width = "150px") ) }, character(1)) ) names(dat) <- c( as.character(checkboxInput("col1", label = "1", width = "150px")), as.character(checkboxInput("col2", label = "2", width = "150px")), as.character(checkboxInput("col3", label = "3", width = "150px")) ) row_names <- LETTERS[1:6] rownames(dat) <- row_names output$myTable <- renderDT({ datatable( dat, escape = FALSE, options = list( columnDefs = list( list(targets = c(1, 2, 3), orderable = FALSE, className = "dt-center") ) ), callback = JS( "$('#col1').on('click', function(){", " var cboxes = $('[id^=col1-]');", " var checked = $('#col1').is(':checked');", " cboxes.each(function(i, cbox) {", " $(cbox).prop('checked', checked);", " });", "});", "$('#col2').on('click', function(){", " var cboxes = $('[id^=col2-]');", " var checked = $('#col2').is(':checked');", " cboxes.each(function(i, cbox) {", " $(cbox).prop('checked', checked);", " });", "});", "$('#col3').on('click', function(){", " var cboxes = $('[id^=col3-]');", " var checked = $('#col3').is(':checked');", " cboxes.each(function(i, cbox) {", " $(cbox).prop('checked', checked);", " });", "});" ) ) }) } shinyApp(ui, server)
Das ist ein Anfang, aber ich kann nicht herausfinden, wie ich das Haupt-Kontrollkästchen neben der Zeile bekomme, und ich kann auch kein Haupt-Kontrollkästchen in der oberen linken Ecke aller Kästchen finden. Außerdem ist das Ganze etwas groß – es wäre schön, wenn es kompakter wäre.
library(shiny) library(DT) rowName <- function(L) { as.character( checkboxInput(paste0("row", L), label = L, width = "150px") ) } rowNames <- vapply(LETTERS[1:6], rowName, character(1)) ui <- fluidPage( # Sidebar panel sidebarPanel(), # Main panel with the table mainPanel( DTOutput("myTable") ) ) server <- function(input, output){ dat <- data.frame( vapply(LETTERS[1:6], function(i){ as.character( checkboxInput(paste0("col1-", i), label = NULL, width = "150px") ) }, character(1)), vapply(LETTERS[1:6], function(i){ as.character( checkboxInput(paste0("col2-", i), label = NULL, width = "150px") ) }, character(1)), vapply(LETTERS[1:6], function(i){ as.character( checkboxInput(paste0("col3-", i), label = NULL, width = "150px") ) }, character(1)) ) names(dat) <- c( as.character(checkboxInput("col1", label = "1", width = "150px")), as.character(checkboxInput("col2", label = "2", width = "150px")), as.character(checkboxInput("col3", label = "3", width = "150px")) ) rownames(dat) <- rowNames output$myTable <- renderDT({ datatable( dat, escape = FALSE, select = "none", options = list( columnDefs = list( list(targets = c(1, 2, 3), orderable = FALSE, className = "dt-center") ), initComplete = JS( "function() {", " $('#col1').on('click', function(){", " var cboxes = $('[id^=col1-]');", " var checked = $('#col1').is(':checked');", " cboxes.each(function(i, cbox) {", " $(cbox).prop('checked', checked);", " });", " });", " $('#col2').on('click', function(){", " var cboxes = $('[id^=col2-]');", " var checked = $('#col2').is(':checked');", " cboxes.each(function(i, cbox) {", " $(cbox).prop('checked', checked);", " });", " });", " $('#col3').on('click', function(){", " var cboxes = $('[id^=col3-]');", " var checked = $('#col3').is(':checked');", " cboxes.each(function(i, cbox) {", " $(cbox).prop('checked', checked);", " });", " });", " $('#rowA').on('click', function(){", " var cboxes = $('[id$=-A]');", " var checked = $('#rowA').is(':checked');", " cboxes.each(function(i, cbox) {", " $(cbox).prop('checked', checked);", " });", " });", " $('#rowB').on('click', function(){", " var cboxes = $('[id$=-B]');", " var checked = $('#rowB').is(':checked');", " cboxes.each(function(i, cbox) {", " $(cbox).prop('checked', checked);", " });", " });", " $('#rowC').on('click', function(){", " var cboxes = $('[id$=-C]');", " var checked = $('#rowC').is(':checked');", " cboxes.each(function(i, cbox) {", " $(cbox).prop('checked', checked);", " });", " });", " $('#rowD').on('click', function(){", " var cboxes = $('[id$=-D]');", " var checked = $('#rowD').is(':checked');", " cboxes.each(function(i, cbox) {", " $(cbox).prop('checked', checked);", " });", " });", " $('#rowE').on('click', function(){", " var cboxes = $('[id$=-E]');", " var checked = $('#rowE').is(':checked');", " cboxes.each(function(i, cbox) {", " $(cbox).prop('checked', checked);", " });", " });", " $('#rowF').on('click', function(){", " var cboxes = $('[id$=-F]');", " var checked = $('#rowF').is(':checked');", " cboxes.each(function(i, cbox) {", " $(cbox).prop('checked', checked);", " });", " });", "}" ), preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node()); }'), drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); } ') ) ) }) } shinyApp(ui, server)编辑：“全选”复选框
library(shiny) library(DT) library(htmltools) rowName <- function(L) { as.character( checkboxInput(paste0("row", L), label = L, width = "150px") ) } rowNames <- vapply(LETTERS[1:6], rowName, character(1)) sketch <- htmltools::withTags( table( class = "display", thead( tr( th(HTML(as.character(checkboxInput("allboxes", label = "ALL", width = "150px")))), th(HTML(as.character(checkboxInput("col1", label = "1", width = "150px")))), th(HTML(as.character(checkboxInput("col2", label = "2", width = "150px")))), th(HTML(as.character(checkboxInput("col3", label = "3", width = "150px")))) ) ) ) ) ui <- fluidPage( br(), # Sidebar panel sidebarPanel(), # Main panel with the table mainPanel( DTOutput("myTable") ) ) server <- function(input, output){ dat <- data.frame( vapply(LETTERS[1:6], function(i){ as.character( checkboxInput(paste0("col1-", i), label = NULL, width = "150px") ) }, character(1)), vapply(LETTERS[1:6], function(i){ as.character( checkboxInput(paste0("col2-", i), label = NULL, width = "150px") ) }, character(1)), vapply(LETTERS[1:6], function(i){ as.character( checkboxInput(paste0("col3-", i), label = NULL, width = "150px") ) }, character(1)) ) rownames(dat) <- rowNames output$myTable <- renderDT({ datatable( dat, container = sketch, escape = FALSE, select = "none", options = list( columnDefs = list( list(targets = c(1, 2, 3), orderable = FALSE, className = "dt-center") ), initComplete = JS( "function() {", " $('#allboxes').on('click', function(){", " var cboxes = $('input[type=checkbox]');", " var checked = $('#allboxes').is(':checked');", " cboxes.each(function(i, cbox) {", " $(cbox).prop('checked', checked);", " });", " });", " $('#col1').on('click', function(){", " var cboxes = $('[id^=col1-]');", " var checked = $('#col1').is(':checked');", " cboxes.each(function(i, cbox) {", " $(cbox).prop('checked', checked);", " });", " });", " $('#col2').on('click', function(){", " var cboxes = $('[id^=col2-]');", " var checked = $('#col2').is(':checked');", " cboxes.each(function(i, cbox) {", " $(cbox).prop('checked', checked);", " });", " });", " $('#col3').on('click', function(){", " var cboxes = $('[id^=col3-]');", " var checked = $('#col3').is(':checked');", " cboxes.each(function(i, cbox) {", " $(cbox).prop('checked', checked);", " });", " });", " $('#rowA').on('click', function(){", " var cboxes = $('[id$=-A]');", " var checked = $('#rowA').is(':checked');", " cboxes.each(function(i, cbox) {", " $(cbox).prop('checked', checked);", " });", " });", " $('#rowB').on('click', function(){", " var cboxes = $('[id$=-B]');", " var checked = $('#rowB').is(':checked');", " cboxes.each(function(i, cbox) {", " $(cbox).prop('checked', checked);", " });", " });", " $('#rowC').on('click', function(){", " var cboxes = $('[id$=-C]');", " var checked = $('#rowC').is(':checked');", " cboxes.each(function(i, cbox) {", " $(cbox).prop('checked', checked);", " });", " });", " $('#rowD').on('click', function(){", " var cboxes = $('[id$=-D]');", " var checked = $('#rowD').is(':checked');", " cboxes.each(function(i, cbox) {", " $(cbox).prop('checked', checked);", " });", " });", " $('#rowE').on('click', function(){", " var cboxes = $('[id$=-E]');", " var checked = $('#rowE').is(':checked');", " cboxes.each(function(i, cbox) {", " $(cbox).prop('checked', checked);", " });", " });", " $('#rowF').on('click', function(){", " var cboxes = $('[id$=-F]');", " var checked = $('#rowF').is(':checked');", " cboxes.each(function(i, cbox) {", " $(cbox).prop('checked', checked);", " });", " });", "}" ), preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node()); }'), drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); } ') ) ) }) } shinyApp(ui, server)