在多页数据表中注册所有输入
Posted
技术标签:
【中文标题】在多页数据表中注册所有输入【英文标题】：Register all inputs inside a multi-page data table 【发布时间】：2022-01-20 09:50:22 【问题描述】：我有一个数据表，我在其中添加了复选框，供我的用户选择各种选项。不幸的是，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
)
【问题讨论】：
我猜你已经意识到了这一点，但是你可以解决这个问题，因为你知道输入的初始状态。你可以例如初始化一个响应式data.frame 并将其与输入同步以供下游使用。
我的应用程序的早期版本实际上就是这样做的。但后来我遇到了保存选择、更新响应式data.frame 的问题，这会提示重新绘制 DataTable 对象（慢）等。如果我无法为此获得令人满意的解决方案，最终的解决方法可能是只需设置选项pageLength = nrow(X)
您可以避免通过replaceData 重新渲染表格，参见例如this.
replaceData 是我使用的，因为我没有使用反应式data.frame。我对反应性data.frame 和replaceData 不能混合的理解是否不正确？
如果您愿意，我可以将我正在尝试做的全部范围的一个小例子串起来。对于手头的问题，感觉不是很 MWE。
【参考方案1】：
这是基于您的附录的解决方法（不确定您是否需要对 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
)
【讨论】：
以上是关于在多页数据表中注册所有输入的主要内容，如果未能解决你的问题，请参考以下文章