0

I have a Shiny app with a DT datatable which includes selectInputs. If I make a selection on page 1, change the page, and come back to page 1, the selection is reset. How can I keep my selections after changing the page?

EDIT

Setting server = FALSE works in this example, but I need to use server-side processing in my real app for other reasons (e.g., using DT::datatableProxy() and DT::replaceData()), so I need to keep the default server = TRUE.

library(shiny)
library(DT)

shinyApp(
  ui = fluidPage(
    DT::dataTableOutput("mytable")
  ),
  server = function(input, output, session) {
    df <- data.frame(
      Col1 = sapply(1:20, function(i) as.character(selectInput(
        inputId = paste0("input", i),
        label = NULL,
        choices = letters[1:3]
      )))
    )
    output$mytable <- DT::renderDataTable({
      DT::datatable(
        data = df,
        selection = "none",
        rownames = F,
        escape = F
      )
    })
  }
)
Ben Ernest
  • 445
  • 3
  • 14
  • 1
    Doesn't it work with `server=FALSE`? – Stéphane Laurent Aug 12 '23 at 14:57
  • @StéphaneLaurent Sorry I didn't specify. I updated my question to include needing to keep server-side processing. – Ben Ernest Aug 12 '23 at 15:32
  • 1
    Looks terrifcly hard then. – Stéphane Laurent Aug 12 '23 at 15:45
  • @StéphaneLaurent thanks anyway. I was hoping to avoid having to observe page changes and update the selectInputs with saved values, but I may have to do that to get the desired behavior. I am doing something similar elsewhere in my real app, so it may not be too much of a stretch actually. I'll update once I have a working solution. – Ben Ernest Aug 12 '23 at 15:51
  • @BenErnest How do you access the inputs from the table on the server side in this scenario? `input$input1` returns `NULL`, which surprises me. – Phil Aug 12 '23 at 17:12
  • 1
    @Phil see https://stackoverflow.com/questions/74615616/shiny-dt-datatable-selectinput-with-reactive-data. You need to include JavaScript snippets in the DT::datatable() options list to bind and unbind the inputs. I didn't include that here for simplicity. – Ben Ernest Aug 12 '23 at 17:42

2 Answers2

1

EDIT: This answer is insufficient. It only works on the first selection, but subsequent inputs are not observed by the app. I think the issue is with the JS function that only listens once to any change to the dropdowns, but I'm not familiar enough with JS to solve the issue. I'm leaving it here with the hope that someone can solve the issue.


I'm assuming you already know how to implement this, but I'm answering just in case someone else runs into a similar problem:

library(shiny)
library(DT)

shinyApp(
  ui = fluidPage(
    DT::dataTableOutput("mytable")
  ),
  server = function(input, output, session) {        
    r <- reactiveValues(df = NULL, inputs = NULL)
    
    output$mytable <- DT::renderDataTable({
      DT::datatable(
        data = r$df,
        selection = "none",
        rownames = F,
        escape = F,
        options = list(preDrawCallback = JS("function() {Shiny.unbindAll(this.api().table().node());}"), 
                       drawCallback = JS("function() {Shiny.bindAll(this.api().table().node());}"))
      )
    })
    
    observe({
      r$inputs <- lapply(1:20, function(i) {
        if (is.null(input[[paste0("input", i)]])) {
          letters[1]
        } else {
          input[[paste0("input", i)]]
        }
    })
      
      r$df <- data.frame(
        Col1 = sapply(1:20, function(i) as.character(selectInput(
          inputId = paste0("input", i),
          label = NULL,
          choices = letters[1:3],
          selected = r$inputs[i]
        )))
      )
    })
  }
)
Phil
  • 7,287
  • 3
  • 36
  • 66
  • thanks. Will add to the conversation later on. In my real app I am keeping track of all selectInput selections in a reactiveValues object which triggers updates in another table which also has selectInputs. Will grab some of the code to share. – Ben Ernest Aug 12 '23 at 19:47
0

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)

  }
)


Ben Ernest
  • 445
  • 3
  • 14