How to save and load state with insertUI modules?

Question

I'm trying to save and load state of a shiny app using bookmarks. However, it doesn't work and I wonder whether it is because of inserting dynamic UI. If there are other ways to save and load dynamically rendered ui and resulting output, that would be great too. I don't know where to start and this is as far as I could come.

Simple example

library(shiny)

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

# Server logic
server <- function(input, output, session) {
  observeEvent(input$add, {
    insertUI(
      selector = "#add",
      where = "afterEnd",
      ui = textInput(paste0("txt", input$add),
                     "Insert some text")
    )
  })
}

# Complete app with UI and server components
shinyApp(ui, server, enableBookmarking = "server")

Complex example

library(shiny)

one_plotUI <- function(id) {
  ns <- NS(id)
  
  plotOutput(ns("plot"))
}

one_plot <- function(id, x, y, type, breaks, break_counts) {
  moduleServer(
    id,
    function(input, output, session) {
      
      output$plot <- renderPlot({
        if (type == "scatter") {
          plot(x, y)
        } else {
          if (breaks == "custom") {
            breaks <- break_counts
          }
          hist(x, breaks = breaks)
        }
      })
    }
  )
}

ui <- fluidPage(
  sidebarPanel(
    bookmarkButton(),
    selectInput("plotType", "Plot Type",
                c(Scatter = "scatter", Histogram = "hist")
    ),
    # Only show this panel if the plot type is a histogram
    conditionalPanel(
      condition = "input.plotType == 'hist'",
      selectInput(
        "breaks", "Breaks",
        c("Sturges", "Scott", "Freedman-Diaconis", "[Custom]" = "custom")
      ),
      # Only show this panel if Custom is selected
      conditionalPanel(
        condition = "input.breaks == 'custom'",
        sliderInput("breakCount", "Break Count", min = 1, max = 50, value = 10)
      )
    ),
    actionButton("make_plot", "Insert new plot")
  ),
  mainPanel(
    div(id = "add_here")
  )
)

server <- function(input, output) {
  x <- rnorm(100)
  y <- rnorm(100)
  counter_plots <- 1
  
  observeEvent(input$make_plot, {
    current_id <- paste0("plot_", counter_plots)
    # call the logic for one plot
    one_plot(id = current_id,
             x = x,
             y = y,
             type = input$plotType,
             breaks = input$breaks,
             break_counts = input$breakCount)
    # show the plot
    insertUI(selector = "#add_here",
             ui = one_plotUI(current_id))
    
    # update the counter
    counter_plots <<- counter_plots + 1
  })
}

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

user_11168766 · Answer

edit: Found another solution emulating what insertUI does but with renderUI:

library(shiny)
library(purrr)

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

# Server logic
server <- function(input, output, session) {
    
    input_contents <- reactive({reactiveValuesToList(input)})
    
    observeEvent(input$add, {
      # a new ui will be rendered with one extra input each time add button is pressed
      output$dynamic_ui <- renderUI({
            map(1:input$add, ~textInput(inputId = paste0("txt", .x), label = paste0("txt", .x) ))
          })
      #add the old values, otherwise all the inputs will be empty agin.
      input_contents() %>% 
        names() %>% 
        map(~ updateTextInput(session = session, inputId = .x, label = .x, value = input_contents()[[.x]]))
    })
}

# Complete app with UI and server components
shinyApp(ui, server, enableBookmarking = "server")

insertUI might be broken. The only way i could "fix" it was to drop function(request) of the ui, that caused that all the values in the inputs have to be saved between stances (in state$values$input_restore). Also a warning is showed in the console, but it doesn't affect the functionality.

library(shiny)
library(tidyverse)
library(stringr)

ui <- fluidPage(
    actionButton("add", "Add UI"),
    uiOutput('restored_ui'), #this is very important
    bookmarkButton()) 


# Server logic
server <- function(input, output, session) {
    
    counter <- reactiveValues()
    counter$n <- c(0) #This value is only used to initialize the object.
    total_ui_count <- reactiveValues()
    total_ui_count$info <- 0 #because input$add will reset to zero this will count the number of uis to remember.
    
    #When bookmark button is pressed
    onBookmark(function(state) {
        state$values$currentCounter <- counter$n
        state$values$input_restore <-  reactiveValuesToList(input)
        print(names(input) %>% str_subset('^txt'))
        
        state$values$total_uis_to_restore <- counter$n[[length(counter$n)]]
    })
    
    
    #rerender the previous outputs and their values 
    onRestore(function(state) {
        #restore values from previous state
        counter$n <- state$values$currentCounter
        vals <- state$values$input_restore
        print(str_subset(names(vals), '^txt.*$')) #for debugging
        
        total_ui_count$info <- state$values$total_uis_to_restore
        print(total_ui_count$info)
        
        #render back a ui with the previous values.
        output$restored_ui <-  renderUI({
            str_subset(names(vals), '^txt.*$') %>%
                sort(decreasing = TRUE) %>% #to avoid order reversal of the inputs
                map(~ textInput(.x, label = .x, value = vals[[.x]])) #render the last inputs
            
        })
        
    })
    
    
    observeEvent(input$add, {
        
        
        #input$add starts as 1 in the next state (because ui is not wrapped in function(request)) that's why total_ui_count is present
        counter$n <- c(counter$n, input$add + total_ui_count$info) 
        print(counter$n) #for debugging
        
        insertUI(
            selector = "#add",
            where = "afterEnd", 
            ui = textInput(inputId = paste0("txt", counter$n[[length(counter$n)]]),
                           label = "Insert some text")
            
        )})
    
    
    
}

# Complete app with UI and server components
shinyApp(ui, server, enableBookmarking = "server")

How to save and load state with insertUI modules?

1 Answers