英文:
Add multiple checkboxes in shiny datatable and retrieve it's value
问题
I added multiple checkbox columns (check1, check2) to the datatable. I have corresponding table with bool1 and bool2 that I want to update based on the reactives for the checkboxes. I am able to retrieve the data for check1 only. I need to update the callback function to take in both check1 and check2 columns but I am not too familiar with JS. Need help figuring this out.
英文:
I added multiple checkbox columns (check1, check2) to the datatable. I have corresponding table with bool1 and bool2 that I want to update based on the reactives for the checkboxes. I am able to retrieve the data for check1 only. I need to update the callback function to take in both check1 and check2 columns but I am not too familiar with JS. Need help figuring this out.
library(shiny)
library(DT)
ui <- fluidPage(
br(),
fluidRow(
column(
6,
DTOutput("dtable")
),
column(
6,
verbatimTextOutput("reactiveDF")
)
)
)
shinyInput <- function(FUN, len, id, ...) {
inputs <- character(len)
for (i in seq_len(len)) {
inputs[i] <- as.character(FUN(paste0(id, 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 = shinyInput(checkboxInput, nrow(dat0), "checkb"),
check2 = shinyInput(checkboxInput, nrow(dat0), "checkc")
)
js <- c(
"$('[id^=checkb]').on('click', function(){",
" var id = this.getAttribute('id');",
" var i = parseInt(/checkb(\\d+)/.exec(id)[1]);",
" var value = $(this).prop('checked');",
" var info = [{row: i, col: 3, value: value}];",
" Shiny.setInputValue('dtable_cell_edit:DT.cellInfo', info);",
"})"
)
server <- function(input, output, session) {
Dat <- reactiveVal(dat1)
output[["dtable"]] <- renderDT({
datatable(
dat2,
rownames = TRUE,
escape = FALSE,
editable = list(target = "cell", disable = list(columns = c(3,4))),
selection = "none",
callback = JS(js)
)
}, server = FALSE)
observeEvent(input[["dtable_cell_edit"]], {
info <- input[["dtable_cell_edit"]] # this input contains the info of the edit
print(info)
Dat(editData(Dat(), info))
})
output[["reactiveDF"]] <- renderPrint({
Dat()
})
}
shinyApp(ui, server)
答案1
得分: 1
这是您提供的代码的翻译部分:
这是您提供的代码的翻译部分:
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)
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))
)
}, 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)
希望这对您有所帮助。如果您需要更多翻译或有其他问题,请随时告诉我。
英文:
Here we go. I added an argument ns
in case if you want to use this stuff in a Shiny module. If you don't use a module, keep the default value (identity
).
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)
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))
)
}, 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)
通过集体智慧和协作来改善编程学习和解决问题的方式。致力于成为全球开发者共同参与的知识库,让每个人都能够通过互相帮助和分享经验来进步。
评论