为了为您的解决方案创建答案,我使用以下方法实现了一个复选框组输入DT
包裹。该解决方案分为两部分: 1.Helper
功能。 2. 的App
.
示例图片
辅助函数
第一个辅助函数创建一个数据表checkbox
输入,每个都有一个独特的id
这是行名和列名的组合。
第二个辅助函数评估构造表中每个复选框的“选中”状态,返回一个矩阵TRUE
/FALSE
复选框表中每个单元格的值。
App
应用程序代码非常简单。
首先,我们使用第一个辅助函数创建一个示例表。
然后,我们用 DT 渲染表格,确保禁用escape
(这样复选框就可以被渲染),sorting
, paging
, and selection
在桌子上。最重要的是,我们发送preDrawCallback
and drawCallback
JS
确保复选框已注册的函数shiny
.
最后,每当用户与表格交互时,我们都会调用第二个辅助函数来评估复选框状态。您可以使用该信息做任何您想做的事情。
Code
# Checkbox Table Demo
library(shiny)
library(DT)
#### Helper Functions ####
#' Construct a checkbox table for an app.
construct_checkbox_table <- function(rows,
cols,
rownames,
colnames) {
checkbox_table <- matrix(
character(),
nrow = rows,
ncol = cols,
dimnames = list(rownames, colnames)
)
for (i in seq_len(rows)) {
for (j in seq_len(cols)) {
checkbox_table[i, j] <-
sprintf(
'<input id="%s,%s" type="checkbox" class="shiny-bound-input" />',
rownames[[i]],
colnames[[j]]
)
}
}
checkbox_table
}
#' Get the status of checkboxes in a checkbox table.
evaluate_checkbox_table_status <- function(input, input_table) {
table_status <-
matrix(
logical(),
nrow = nrow(input_table),
ncol = ncol(input_table),
dimnames = list(rownames(input_table), colnames(input_table))
)
table_rownames <- rownames(input_table)
table_colnames <- colnames(input_table)
for (i in seq_len(nrow(input_table))) {
for (j in seq_len(ncol(input_table))) {
table_status[i, j] <-
input[[sprintf("%s,%s", table_rownames[[i]], table_colnames[[j]])]]
}
}
table_status
}
#### End Helper Functions ####
#### App ####
# Create an example checkbox input table to use for the app
example_checkbox_table <-
construct_checkbox_table(
2,
4,
rownames = c("Annual Bottom Temp Absolute", "Bottom Temp Anomoly"),
colnames = c("GOM", "GB", "MAB", "SS")
)
ui <- fluidPage(DT::DTOutput("selection_table"),
verbatimTextOutput("table_selections"),)
server <- function(input, output, session) {
output$selection_table <- DT::renderDT({
DT::datatable(
example_checkbox_table,
escape = FALSE,
selection = "none",
options = list(
dom = "t",
ordering = FALSE,
paging = FALSE,
preDrawCallback = JS(
'function() { Shiny.unbindAll(this.api().table().node()); }'
),
drawCallback = JS(
'function() { Shiny.bindAll(this.api().table().node()); } '
)
)
)
}, server = FALSE)
observeEvent(input$selection_table_cell_clicked, {
output$table_selections <- renderPrint({
evaluate_checkbox_table_status(input, example_checkbox_table)
})
})
}
#### End App ####
shinyApp(ui, server)