Based on responses, I didn't see a particularly simple approach. Below is a working solution with a few extras, including multiple columns with selectInputs and some convenience functions for creating JavaScript code for selectizing the selectInputs and keeping them selectized when the page changes. These are based on a lot of great solutions from @StephaneLaurent on other StackOverflow posts.
In this solution, an observer stores every selectInput selection in a reactiveValues object, and an observeEvent() responds to page changes and updates all selectInputs with those stored values.
library(shiny)
library(DT)
library(glue)
# Function to selectize one or more input ids. Optionally include some parameters
# to pass into selectize().
# "in_function" determines whether to return a function or only code which can be
# inserted in another function with make_js()
selectize_ids <- function(ids, options_list = NULL, in_function = T) {
opts_string <- ""
if(!is.null(options_list)) {
my_values <- unlist(options_list)
is_char <- which(sapply(options_list, is.character))
if(length(is_char) > 0) my_values[is_char] <- glue::glue("'{my_values[is_char]}'")
opts_string <- paste(sapply(names(my_values), function(x) glue::glue("{x}: {my_values[x]}")), collapse = ", ")
opts_string <- paste0("{", opts_string, "}")
}
tmp <- paste0("$('#", ids, "')")
tmp <- glue::glue("{tmp}.selectize({opts_string});")
if(!in_function) return(tmp)
c(
"function(settings){",
paste0(" ", tmp),
"}"
)
}
# Create a javascript function by adding ... to body and optionally including
# function arguments
make_js <- function(..., args = NULL) {
args_txt <- paste(args, collapse = ",")
body_txt <- paste(unlist(list(...)), collapse = "\n ")
glue::glue(
"function({args_txt}) {{
{body_txt}
}}"
)
}
shinyApp(
ui = fluidPage(
div(style = "display: none;", selectInput(inputId = "dummy", label = NULL, choices = 1:2)),
DT::dataTableOutput("mytable")
),
server = function(input, output, session) {
# Vector of selectInput ids
selectinput_ids <- paste0(rep(c("tableinput_Col1_", "tableinput_Col2_"), each = 20), 1:20)
names(selectinput_ids) <- selectinput_ids
# Initial list of all selectInput selections
selectinput_list_init <- lapply(selectinput_ids, function(id) "a")
# Dataframe for DT::datatable() containing selectInputs
df <- data.frame(
Col1 = sapply(1:20, function(i) {
id <- paste0("tableinput_Col1_", i)
as.character(selectInput(
inputId = id,
label = NULL,
choices = c("a", "b", "c"),
selected = "a"
))
}),
Col2 = sapply(1:20, function(i) {
id <- paste0("tableinput_Col2_", i)
as.character(selectInput(
inputId = id,
label = NULL,
choices = c("a", "b", "c"),
selected = "a"
))
})
)
# reactiveValues object to store all selectInput selections
rv <- reactiveValues(
selectinput_list = selectinput_list_init
)
# Render datatable. Includes JavaScript for selectizing and binding/unbinding selectInputs
output$mytable <- DT::renderDataTable({
DT::datatable(
data = df,
selection = "none",
rownames = F,
escape = F,
options = list(
initComplete = JS(selectize_ids(selectinput_ids)),
preDrawCallback = JS("function() { Shiny.unbindAll(this.api().table().node()); }"),
drawCallback = JS(make_js(
"Shiny.bindAll(this.api().table().node());",
selectize_ids(selectinput_ids, in_function = F)
))
)
)
})
# Observe changes in all selectInputs and store in reactiveValues object
observe({
rv$selectinput_list <- lapply(selectinput_ids, function(id) input[[id]])
})
# Observe page change and update all selectInputs with last selections.
# Use higher priority so this executes before previous observer
observeEvent(input$mytable_state$start, {
for(id in names(rv$selectinput_list)) {
updateSelectInput(inputId = id, selected = rv$selectinput_list[[id]])
}
}, priority = 10)
}
)