我有一个数据表，我在其中添加了复选框供我的用户选择各种选项。不幸的是，shiny 似乎看到的唯一输入是已经显示在表中的输入。因此，如果我有多个页面，我只能看到前 10 个输入。
在下面的示例中，我打印了我可以看到的所有在数据表对象上方注册的输入。目前，我只看到前 10 个输入 (A - J)。我希望能够在表格首次加载时看到所有 26 个(无需切换页面)。
在我的实际应用程序中，我有多列复选框，因此行选择是不够的。关于如何一次注册所有 26 个输入的任何提示或建议？
library(shiny)
library(DT)
shinyInput <- function (FUN, id_base, suffix, label = "", ...)
{
inputId <- paste0(id_base, suffix)
args <- list(...)
args <- c(list(label = label), args)
args <- lapply(args, function(a) rep(a, length.out = length(inputId)))
rv <- character(length(inputId))
for (i in seq_along(rv)) {
this_arg <- lapply(args, `[`, i)
ctrl <- do.call(FUN, c(list(inputId = inputId[i]), this_arg))
rv[i] <- as.character(ctrl)
}
rv
}
X <- data.frame(id = LETTERS,
selected = sample(c(TRUE, FALSE),
size = length(LETTERS),
replace = TRUE))
X$IsSelected <-
shinyInput(
shiny::checkboxInput,
id_base = "new_input_",
suffix = X$id,
value = X$selected
)
shinyApp(
ui = fluidPage(
verbatimTextOutput("value_check"),
textOutput("input_a_value"),
DT::dataTableOutput("dt")
),
server = shinyServer(function(input, output, session){
Data <- reactiveValues(
X = X
)
output$value_check <-
renderPrint({
sort(names(input))
})
output$dt <-
DT::renderDataTable({
DT::datatable(X,
selection = "none",
escape = FALSE,
filter = "top",
#rownames = FALSE,
class = "compact cell-border",
options = list(preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); } ')))
})
})
)
附录
下一个例子有点复杂，但更能说明问题的动机。看来最大的问题是我想使用诸如“全选”之类的按钮。此外，当与框交互时，我不会立即处理任何操作。取而代之的是，用户进行选择，并且在单击“保存选择”按钮之前不会保存选择。
发生的事情是我点击“全选”按钮，它会检查所有已经绘制的输入框。如果我只查看了表格的第一页，它只会更新那些输入，而不会更新接下来几页的任何输入。这确实是我需要改变的行为。
# Set up environment ------------------------------------------------
library(shiny)
library(DT)
library(magrittr)
# Example of data coming from the database. -------------------------
set.seed(pi^2)
SourceData <-
data.frame(sample_id = 1:25,
is_selected = sample(c(TRUE, FALSE), 25, replace = TRUE))
# Support Functions -------------------------------------------------
# These would exist, for example, in an internal package
shinyInput <- function (FUN, id_base, suffix, label = "", ...)
{
inputId <- paste0(id_base, suffix)
args <- list(...)
args <- c(list(label = label), args)
args <- lapply(args, function(a) rep(a, length.out = length(inputId)))
rv <- character(length(inputId))
for (i in seq_along(rv)) {
this_arg <- lapply(args, `[`, i)
ctrl <- do.call(FUN, c(list(inputId = inputId[i]), this_arg))
rv[i] <- as.character(ctrl)
}
rv
}
prepareDataForDisplay <- function(Data){
Data$is_selected <-
shinyInput(shiny::checkboxInput,
id_base = "is_selected_",
suffix = Data$sample_id,
value = Data$is_selected)
Data
}
# User Interface ----------------------------------------------------
ui <-
fluidPage(
verbatimTextOutput("value_check"),
actionButton(inputId = "btn_saveSelection",
label = "Save Selection"),
actionButton(inputId = "btn_selectAll",
label = "Select All"),
actionButton(inputId = "btn_unselectAll",
label = "Unselect All"),
actionButton(inputId = "btn_restoreDefault",
label = "Restore Default (select odd only)"),
DT::dataTableOutput("dt")
)
# Server ------------------------------------------------------------
server <-
shinyServer(function(input, output, session){
# Event Observers -----------------------------------------------
observeEvent(
input$btn_selectAll,
{
check_input <- names(input)[grepl("is_selected_", names(input))]
lapply(check_input,
function(ci){
updateCheckboxInput(session = session,
inputId = ci,
value = TRUE)
})
}
)
observeEvent(
input$btn_unselectAll,
{
check_input <- names(input)[grepl("is_selected_", names(input))]
lapply(check_input,
function(ci){
updateCheckboxInput(session = session,
inputId = ci,
value = FALSE)
})
}
)
observeEvent(
input$btn_restoreDefault,
{
check_input <- names(input)[grepl("is_selected_", names(input))]
lapply(check_input,
function(ci){
id <- as.numeric(sub("is_selected_", "", ci))
updateCheckboxInput(session = session,
inputId = ci,
value = id %% 2 == 1)
})
}
)
observeEvent(
input$btn_saveSelection,
{
check_input <- names(input)[grepl("is_selected_", names(input))]
id <- as.numeric(sub("is_selected_", "", check_input))
for (i in seq_along(check_input)){
SourceData$is_selected[SourceData$sample_id == id[i]] <-
input[[check_input[i]]]
}
# At this point, I would also save changes to the remote database.
DT::replaceData(proxy = dt_proxy,
data = prepareDataForDisplay(SourceData))
}
)
# Output elements -----------------------------------------------
output$value_check <-
renderPrint({
sort(names(input))
})
output$dt <-
DT::renderDataTable({
SourceData %>%
prepareDataForDisplay() %>%
DT::datatable(selection = "none",
escape = FALSE,
filter = "top",
class = "compact cell-border",
options = list(preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); } ')))
})
dt_proxy <- DT::dataTableProxy("dt")
})
# Run the application -----------------------------------------------
shinyApp(
ui = ui,
server = server
)
最佳答案
这是基于您的附录的解决方法(不确定您是否需要关于 btn_restoreDefault 和 btn_saveSelection 的更改)，但一般过程应该很清楚:
# Set up environment ------------------------------------------------
library(shiny)
library(DT)
library(magrittr)
# Example of data coming from the database. -------------------------
set.seed(pi^2)
SourceData <-
data.frame(sample_id = 1:25,
is_selected = sample(c(TRUE, FALSE), 25, replace = TRUE))
# Support Functions -------------------------------------------------
# These would exist, for example, in an internal package
shinyInput <- function (FUN, id_base, suffix, label = "", ...)
{
inputId <- paste0(id_base, suffix)
args <- list(...)
args <- c(list(label = label), args)
args <- lapply(args, function(a) rep(a, length.out = length(inputId)))
rv <- character(length(inputId))
for (i in seq_along(rv)) {
this_arg <- lapply(args, `[`, i)
ctrl <- do.call(FUN, c(list(inputId = inputId[i]), this_arg))
rv[i] <- as.character(ctrl)
}
rv
}
prepareDataForDisplay <- function(Data){
Data$is_selected <-
shinyInput(shiny::checkboxInput,
id_base = "is_selected_",
suffix = Data$sample_id,
value = Data$is_selected)
Data
}
# User Interface ----------------------------------------------------
ui <-
fluidPage(
verbatimTextOutput("value_check"),
actionButton(inputId = "btn_saveSelection",
label = "Save Selection"),
actionButton(inputId = "btn_selectAll",
label = "Select All"),
actionButton(inputId = "btn_unselectAll",
label = "Unselect All"),
actionButton(inputId = "btn_restoreDefault",
label = "Restore Default (select odd only)"),
DT::dataTableOutput("dt")
)
# Server ------------------------------------------------------------
server <-
shinyServer(function(input, output, session){
# Event Observers -----------------------------------------------
observeEvent(
input$btn_selectAll,
{
TmpData <- SourceData
TmpData$is_selected <- TRUE
replaceData(dt_proxy, prepareDataForDisplay(TmpData))
}
)
observeEvent(
input$btn_unselectAll,
{
TmpData <- SourceData
TmpData$is_selected <- FALSE
replaceData(dt_proxy, prepareDataForDisplay(TmpData))
}
)
observeEvent(
input$btn_restoreDefault,
{
replaceData(dt_proxy, prepareDataForDisplay(SourceData))
}
)
observeEvent(
input$btn_saveSelection,
{
check_input <- names(input)[grepl("is_selected_", names(input))]
id <- as.numeric(sub("is_selected_", "", check_input))
TmpData <- SourceData
for (i in seq_along(check_input)){
TmpData$is_selected[TmpData$sample_id == id[i]] <-
input[[check_input[i]]]
}
# At this point, I would also save changes to the remote database.
DT::replaceData(proxy = dt_proxy,
data = prepareDataForDisplay(TmpData))
}
)
# Output elements -----------------------------------------------
output$value_check <-
renderPrint({
sort(names(input))
})
output$dt <-
DT::renderDataTable({
SourceData %>%
prepareDataForDisplay() %>%
DT::datatable(selection = "none",
escape = FALSE,
filter = "top",
class = "compact cell-border",
options = list(preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); } ')))
})
dt_proxy <- DT::dataTableProxy("dt")
})
# Run the application -----------------------------------------------
shinyApp(
ui = ui,
server = server
)
关于在多页数据表中注册所有输入，我们在Stack Overflow上找到一个类似的问题： https://stackoverflow.com/questions/70393689/