I have a datatable in which I've added checkboxes for my users to select various options. Unfortunately, the only inputs that shiny seems to see are ones that have been displayed in the table. So if I have multiple pages, I'm only able to see the first 10 inputs.
In the example below, I've printed all of the inputs that I can see registered above the datatable object. At the moment, I only see the first 10 inputs (A - J). I'd like to be able to see all 26 when the table first loads (without having to toggle through the pages).
In my actual application, I have multiple columns of checkboxes, so row selection wouldn't be sufficient. Any tips or suggestions on how to register all 26 inputs at once?
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()); } ')))
})
})
)
ADDENDUM
This next example is a bit more complex, but illustrates a bit more of the motivation for the question. It seems the biggest issue is that I would like to utilize buttons such as "select all." Additionally, I'm not processing any actions immediately when a box is interacted with. Instead, the user makes their selections, and the selections are not saved until the "Save Selections" button is clicked.
What is happening is I click on the "Select All" button, and it checks all of the boxes for inputs that have been drawn already. If I've only viewed the first page of the table, it updates only those inputs, and none of the inputs on the next few pages. This is really the behavior I need to change.
# 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
)
CodePudding user response：
Here is a workaround based on your addendum (not sure if you need the changes regarding btn_restoreDefault and btn_saveSelection), but the general procedure should be clear:
# 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
)