How to bookmark and restore dynamically added modules?

user_13874036 0
Viewed 290

I am trying to save and restore an app that uses modules which render UI outputs dynamically.

I hoped the bookmarking function would work with the app and I added the bookmarkButton and enabled bookmarking using enableBookmarking = "server". I've also made the ui a function. I learned that bookmarking works with modules, but I'm unable to find a way to get it working with dynamically created UI inputs and outputs. Only the last input and output are restored. The others are not restored.

Example app:

library(shiny)

histogramUI <- function(id) {
  tagList(
    fluidRow(column( 4, selectInput(NS(id, "var"), "Variable", choices = names(mtcars)),
    numericInput(NS(id, "bins"), "bins", value = 10, min = 1)),
    column(8, plotOutput(NS(id, "hist"))))
  )
}


histogramServer <- function(id) {
  moduleServer(id, function(input, output, session) {
    data <- reactive(mtcars[[input$var]])
    output$hist <- renderPlot({
      hist(data(), breaks = input$bins, main = input$var)
    }, res = 96)
  })
}

ui <- function(request){
  fluidPage(
    bookmarkButton(),
    actionButton("add", "Add"),
    div(id = "add_here")
    )
  }

server <- function(input, output, session) {
  
  
  observeEvent(input$add, {
    histogramServer(paste0("hist_", input$add))
    insertUI(selector = "#add_here", ui = histogramUI(paste0("hist_", input$add)))
  })
  
  
}

shinyApp(ui, server, enableBookmarking = "server")

Only the last input and plot output are restored:

enter image description here

shiny r
2 Answers

One would expect all module instances to be restored, but as you pointed out, only the last one is restored due to addbutton restoration.
As a workaround, you could store the module instances list stored in state$exclude with onBookmark and re-create the instances of the module with onRestore.
histogramUI was modified in order to accept var,bins as new parameters for creation of the modules.
Another important point is to use setBookmarkExclude so that the add button doesn't create the last module at restoration. As the button isn't anymore bookmarked, it's value should be also be saved with onBookmark.

Try:

library(shiny)


histogramUI <- function(id,var,bins) {
  tagList(
    fluidRow(column( 4, selectInput(NS(id, "var"), "Variable", choices = names(mtcars),selected=var),
                     numericInput(NS(id, "bins"), "bins", value = bins, min = 1)),
             column(8, plotOutput(NS(id, "hist"))))
  )
}


histogramServer <- function(id) {
  moduleServer(id, function(input, output, session) {
    data <- reactive(mtcars[[input$var]])
    output$hist <- renderPlot({
      hist(data(), breaks = input$bins, main = input$var)
    }, res = 96)
  })
  
}


ui <- function(request){
  fluidPage(
    bookmarkButton(),
    actionButton("add", "Add Histogram"),
    div(id = "add_here")
  )
}

server <- function(input, output, session) {
  
  add_id <- reactiveVal(0)  # To save 'add' button state
  setBookmarkExclude('add') # Don't add new module at restoration
  
  observeEvent(input$add, {
    histogramServer(paste0("hist_", input$add+add_id()))
    insertUI(selector = "#add_here", ui = histogramUI(paste0("hist_", input$add+add_id()),'mpg',10))
  })
  
  
  onBookmark(function(state) { 
    modules <- state$exclude
    state$values$modules <- modules[grepl("hist",modules)] # only 'hist' (without 'add')
    state$values$add <- state$input$add + add_id() # add button state
  })
  
  onRestore(function(state){
    # Restore 'add' last state
    add_id(state$values$add)

    # Restore 'hist' modules
    modules <- state$values$modules
    if (length(modules)>0) {
      for (i in 1:(length(modules))) {
          histogramServer(modules[i])
          insertUI(selector = "#add_here", ui = histogramUI(modules[i],paste0(modules[i],"-var"),paste0(modules[i],"-bin")))
      }
    }
  })
  
}

shinyApp(ui, server, enableBookmarking = "server")
user_135133280

Another way to do it:

library(shiny); library(purrr)

histogramUI <- function(id) {
    ns <- NS(id)
    tagList(
        fluidRow(column( 4, selectInput(ns("var"), "Variable", choices = names(mtcars)),
                         numericInput(ns("bins"), "bins", value = 10, min = 1)),
                 column(8, plotOutput(ns("hist"))))
    )
}

histogramServer <- function(id) {
    moduleServer(id, function(input, output, session) {
        vals <- reactiveValuesToList(input)
        
        data <- reactive(mtcars[[input$var]])
        output$hist <- renderPlot({
            hist(data(), breaks = input$bins, main = input$var)
        }, res = 96)
        
        #to avoid inputs resetting after adding another.
        if(length(vals) != 0) {
            updateSelectInput(session, 'var', "Variable", choices = names(mtcars), selected = vals$var)
            updateNumericInput(session, 'bins', "bins", value = input$bins, min = 1,)
        } 
    })
}

ui <- function(request){
    fluidPage(
        bookmarkButton(),
        actionButton("add", "Add"),
        uiOutput('histogram_module') 
    )
}

server <- function(input, output, session) {
    
    observeEvent(input$add, {
        #the server module
        map(1:input$add, ~histogramServer(paste0("hist_", .x)))
        #the ui module
        output$histogram_module <- renderUI({ map(1:input$add, ~histogramUI(id = paste0("hist_", .x))) })
    })
}

shinyApp(ui, server, enableBookmarking = "server")
user_111687660
Related