英文:
R/Shiny - Scrollable datatable with checkboxes and total count
问题
我有一个数据表格,其中我添加了一个复选框列,并可以点击单个复选框。此外,还有一个 actionButton 可以选择或取消选择所有复选框,以及点击的复选框的总数和一个搜索框。除了以下三个问题外,一切都正常:
- 如果我点击单个复选框,计数不会改变。(但是对整个集合而言,它可以正常工作。)
- 如果我点击了一些复选框,然后立即搜索一个词或按任何列排序,复选框会被清除。
- 复选框列没有排序。如果对复选框进行排序,将累积所有已点击的复选框以便一目了然已选择了哪些,将会更理想。
有什么建议吗?
英文:
I have a datatable to which I add a checkbox column, and can click on individual boxes. Also, have an actionButton that can select or deselect all the checkboxes, a total count of the clicked boxes, and a search box. Everything works except for three things:
- If I click on individual checkboxes, the count doesn't change. (It works correctly, though, for the whole set.)
- If I click on a few checkboxes and I immediately search for a term or sort by any column, the checkboxes are cleared.
- There is no sorting for the checkbox column. It would be ideal if sorting the checkboxes could accumulate all those that were clicked at the top, to be able to see in one go what has been selected.
Any idea?
Thanks
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)
答案1
得分: 1
以下是翻译好的部分:
-
Use
server=FALSE
, otherwise you won't be able to get the total count and this is easier.- 使用
server=FALSE
,否则您将无法获取总计数,这更容易。
- 使用
-
Here is an app which adresses your issues except the total count (I'll do it later):
- 这是一个应用程序,除了总计数之外,它解决了您的问题(我稍后会处理总计数):
-
library(shiny)
- 加载库(shiny)
-
library(DT)
- 加载库(DT)
-
ui <- fluidPage(
- 用户界面 <- 流式页面(
-
checkboxColumn <- function(len, col, ...) { #
col
is the column index- checkboxColumn <- function(len, col, ...) { #
col
是列索引
- checkboxColumn <- function(len, col, ...) { #
-
inputs <- character(len)
- inputs <- character(len)
-
dat0 <- data.frame(
- dat0 <- 数据框(
-
dat1 <- cbind(dat0, bool1 = FALSE, bool2 = FALSE)
- dat1 <- cbind(dat0, bool1 = FALSE, bool2 = FALSE)
-
dat2 <- cbind(
- dat2 <- cbind(
-
js <- function(dtid, cols, ns = identity) {
- js <- function(dtid, cols, ns = identity) {
-
checkboxColumns <- c(3, 4)
- checkboxColumns <- c(3, 4)
-
render <- function(col) {
- render <- function(col) {
-
server <- function(input, output, session) {
- server <- function(input, output, session) {
-
Dat <- reactiveVal(dat1)
- Dat <- reactiveVal(dat1)
-
output[["dtable"]] <- renderDT({
- output[["dtable"]] <- renderDT({
-
datatable(
- datatable(
-
options = list(
- options = list(
-
observeEvent(input[["dtable_cell_edit"]], {
- observeEvent(input[["dtable_cell_edit"]], {
-
output[["reactiveDF"]] <- renderPrint({
- output[["reactiveDF"]] <- renderPrint({
-
shinyApp(ui, server)
- shinyApp(ui, server)
英文:
Use server=FALSE
, otherwise you won't be able to get the total count and this is easier.
Here is an app which adresses your issues except the total count (I'll do it later):
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)
通过集体智慧和协作来改善编程学习和解决问题的方式。致力于成为全球开发者共同参与的知识库,让每个人都能够通过互相帮助和分享经验来进步。
评论