R/Shiny -带有复选框和总计数的可滚动数据表

epggiuax 于 2023-06-19 发布在其他

关注(0)|答案(1)|浏览(72)

我有一个数据表，我添加了一个复选框列，并可以点击个别框。此外，有一个 actionButton 可以选择或取消选择所有复选框，一个被点击框的总数和一个搜索框。一切正常，除了三件事：
1.如果我单击单个复选框，计数不会改变。（不过，它对整个集合都是正确的。）
1.如果我点击了几个复选框，我立即搜索一个术语或按任何列排序，复选框就会被清除。
1.复选框列没有排序。如果对复选框进行排序可以累积所有在顶部单击的复选框，以便能够一次性查看选中的内容，那将是理想的。
你知道吗？
谢谢

library(shiny)
library(DT)

data <- data.frame(
  Checkbox         = rep(FALSE, 20),
  Name             = c("John", "Jane", "Michael", "Sara", "David","John1", "Jane1", "Michael1", "Sara1", "David1",
                       "John2", "Jane2", "Michael2", "Sara2", "David2","John3", "Jane3", "Michael3", "Sara3", "David3"),
  Volume           = round(100 * runif(20,0,1),0),
  stringsAsFactors = FALSE
)

ui <- fluidPage(
  titlePanel("Scrollable Datatable with Checkbox"),
  sidebarLayout(
    sidebarPanel(
      actionButton("selectBtn", "Select/Deselect All"),
      numericInput("selectedCount", "Selected Rows", 0, min = 0, max = nrow(data), width = "100%")
    ),
    mainPanel(
      DTOutput("myTable")
    )
  )
)

server <- function(input, output, session) {
  # Render the datatable
  output$myTable <- renderDT({
    datatable(data, 
              selection    = 'none',
              options      = list(
                scrollX    = TRUE,
                scrollY    = "400px",
                paging     = FALSE,
                searching  = TRUE,
                order      = list(1, 'asc'),
                columnDefs = list(
                  list(className = 'dt-center', targets = c(1, 3)),
                  list(className = 'dt-left', targets = 2),
                  list(targets = 1, render = JS(
                    "function(data, type, full, meta) {",
                    "var checkboxId = 'checkbox_' + meta.row;",
                    "return '<input type=\"checkbox\" id=\"' + checkboxId + '\" class=\"row-checkbox\" ' + (data ? 'checked' : '') + '></input>';",
                    "}"
                  ))
                )
              )
    )
  })
  
  # Select/Deselect all checkboxes     <============== (this works)
  observeEvent(input$selectBtn, {
    if (input$selectBtn %% 2 == 1) {
      data$Checkbox <- TRUE
    } else {
      data$Checkbox <- FALSE
    }
  # Update the datatable
    replaceData(proxy = dataTableProxy("myTable"), data, resetPaging = FALSE)
  # Update the selected count
    updateNumericInput(session, "selectedCount", value = sum(data$Checkbox))
  })
  
  # Row checkbox selection             <============== (this part doesn't work)
  observeEvent(input$myTable_cells_selected, {
    clicked_rows <- unique(input$myTable_cells_clicked$row)
    data$Checkbox[clicked_rows] <- !data$Checkbox[clicked_rows]
  # Update the datatable
    replaceData(proxy = dataTableProxy("myTable"), data, resetPaging = FALSE)
  # Update the selected count
    updateNumericInput(session, "selectedCount", value = sum(data$Checkbox))
  })
}

shinyApp(ui, server)

r

来源：https://stackoverflow.com/questions/76428171/r-shiny-scrollable-datatable-with-checkboxes-and-total-count

1条答案

按热度按时间

i2loujxw1#

使用server=FALSE，否则您将无法获得总计数，这更容易。
这里是一个应用程序，它解决了您的问题，除了总数（我稍后会做）：

library(shiny)
library(DT)

ui <- fluidPage(
  br(),
  fluidRow(
    column(
      6,
      DTOutput("dtable")
    ),
    column(
      6,
      verbatimTextOutput("reactiveDF")
    )
  )
)

checkboxColumn <- function(len, col, ...) { # `col` is the column index
  inputs <- character(len)
  for(i in seq_len(len)) {
    inputs[i] <- as.character(
      checkboxInput(paste0("checkb_", col, "_", i), label = NULL, ...)
    )
  }
  inputs
}

dat0 <- data.frame(
  fruit  = c("apple", "cherry", "pineapple", "pear"),
  letter = c("a", "b", "c", "d")
)

dat1 <- cbind(dat0, bool1 = FALSE, bool2 = FALSE)

dat2 <- cbind(
  dat0,
  check1 = checkboxColumn(nrow(dat0), 3),
  check2 = checkboxColumn(nrow(dat0), 4)
)

js <- function(dtid, cols, ns = identity) {
  code <- vector("list", length(cols))
  for(i in seq_along(cols)) {
    col <- cols[i]
    code[[i]] <- c(
      sprintf(
        "$('body').on('click', '[id^=checkb_%d_]', function() {",
        col),
      "  var id = this.getAttribute('id');",
      sprintf(
        "  var i = parseInt(/checkb_%d_(\\d+)/.exec(id)[1]);",
        col),
      "  var value = $(this).prop('checked');",
      sprintf(
        "  var info = [{row: i, col: %d, value: value}];",
        col),
      sprintf(
        "  Shiny.setInputValue('%s', info);",
        ns(sprintf("%s_cell_edit:DT.cellInfo", dtid))
      ),
      "});"
    )
  }
  do.call(c, code)
}

checkboxesColumns <- c(3, 4)

render <- function(col) { 
sprintf('
function(data, type, row, meta) {
  if(type == "sort") { 
    var i = meta.row + 1;
    var $box = $("#checkb_%d_" + i);
    data = $box.prop("checked") ? "true" : "false";
  }
  return data;
}', col)
}

server <- function(input, output, session) {
  
  Dat <- reactiveVal(dat1)
  
  output[["dtable"]] <- renderDT({
    datatable(
      dat2, 
      rownames = TRUE,
      escape = FALSE,
      editable = list(
        target = "cell", disable = list(columns = checkboxesColumns)
      ),
      selection = "none",
      callback = JS(js("dtable", checkboxesColumns)), 
      options = list(
        columnDefs = list(
         list(targets = 3, render = JS(render(3))),
         list(targets = 4, render = JS(render(4)))
        )
      )
    )
  }, server = FALSE)
  
  observeEvent(input[["dtable_cell_edit"]], { 
    info <- input[["dtable_cell_edit"]] # this input contains the info of the edit
    Dat(editData(Dat(), info))
  })
  
  output[["reactiveDF"]] <- renderPrint({ 
    Dat()
  })
  
}

shinyApp(ui, server)

赞(0）回复(0）举报 2023-06-19

我来回答

R/Shiny -带有复选框和总计数的可滚动数据表

1条答案

相关问题

热门标签

最新问答