Shiny Bookmarking Issue with RenderUI

Question

I have written this code in order to bookmark inputs from dynamically created elements.

As you can see i have managed to do it with the first table (output$othertable) but no with the output$ratings. Is this because of the renderUI?

I found this https://github.com/rstudio/shiny/pull/2139 so i installed the latest package in order to overcome this.

Unfortunately this was not the solution.

Any ideas??

library(shiny)
library(shinydashboard)
library(htmlwidgets) 
library(data.table) 

ui <- function(request){dashboardPage(

  skin="blue",

  dashboardHeader(
    title="sth",
    titleWidth = 300),

  dashboardSidebar(
    width = 300,
    sidebarMenu(
      menuItem(
        "Gathering Information",
        tabName = "gatheringinformation",
        icon=icon("github")
      )
      )),


  dashboardBody(

      tabItem(tabName = "gatheringinformation",
              h2("Gathering Information"),

              bookmarkButton(),
              fluidRow(
                box(
                  width = 4, 
                  title = "Inputs",
                  status= "primary",
                  solidHeader = TRUE,
                  h5("Please specify the number of alternatives, criteria and experts"),

                  numericInput("alternatives", h3("Alternatives"), 
                               value = "1"),
                  numericInput("criteria", h3("Criteria"), 
                               value = "1"),
                  numericInput("experts", h3("Experts"), 
                               value = "1")  
                ),

      box(title = "Alternatives", 
          width = 4,
          status = "primary", 
          solidHeader = TRUE,
          collapsible = TRUE,
          div(style = 'overflow-x: scroll'),
          splitLayout(tableOutput("othertable"))

      ),

      box(title = "View Data", 
          width = 12,
          status = "primary", 
          solidHeader = TRUE,
          collapsible = TRUE,
          div(style = 'overflow-x: scroll'),
          splitLayout(uiOutput("ratings"))

      ))


                        )))}
              ####################################
              ############   SERVER   ############
              ####################################

server <- function(input, output, session) {


  onBookmark(function(state) {
    for (i in 1:input$alternatives){
      state$values$alternativestable[i] <- input[[paste0("data_alternatives_r",i,"c1")]]}
    for (i in 1:input$criteria){
      state$values$criteriatable[i] <- input[[paste0("data_criteria_r",i,"c1")]]}

    someData <- rep(NaN, input$alternatives*input$criteria*input$experts);  
    state$values$viewdatatable<-array(someData, c(input$alternatives, input$criteria, input$experts))

    for (i in 1:input$experts){
      for (m in 1:input$criteria){
        for (n in 1:input$alternatives){
          state$values$viewdatatable[n,m,i] <- input[[paste0("t",i,"r",n,"c",m)]]
          l<-state$values$viewdatatable[n,m,i]<-input[[paste0("t1r1c1")]]
        }}
    }
  })

  onRestore(function(state) {

    for (i in 1:input$alternatives){
      Y <- state$values$alternativestable[i]
      updateNumericInput(session, paste0("data_alternatives_r",i,"c1"), value = Y)
    }

    for (i in 1:input$experts){
      for (m in 1:input$criteria){
        for (n in 1:input$alternatives){
          Y <- state$values$viewdatatable[n,m,i]
          updateNumericInput(session, paste0("t",i,"r",n,"c",m), value = Y)

        }}}



  })

  isolate({
    output$othertable <- 
      renderTable({
        text.inputs.col1 <- paste0("<input id='data_alternatives_r", 1:input$alternatives, "c", 1, "' class='shiny-bound-input' type='text' value=''>")
        df_data_alternatives <- data.frame(text.inputs.col1)
        colnames(df_data_alternatives) <- paste0("Alternatives")
        df_data_alternatives
      },sanitize.text.function = function(x) x)})
  isolate({
  output$ratings <- renderUI({lapply(1:input$experts,function(j){
    renderTable({
      num.inputs.col1 <- paste0("<input id='t",j, "r", 1:input$alternatives, "c", 1, "' class='shiny-bound-input' type='number' value='1'>")
      #num.inputs.col2 <- paste0("<input id='t",j, "r", 1:input$alternatives, "c", 2, "' class='shiny-bound-input' type='number' value='1'>")
      df <- data.frame(num.inputs.col1)
      if (input$criteria >= 2){
        for (i in 2:input$criteria){
          num.inputs.coli <- paste0("<input id='t",j, "r", 1:input$alternatives, "c", i, "' class='shiny-bound-input' type='number' value='1'>")
          df <- cbind(df,num.inputs.coli)
        }
      }
      colnames(df) <- paste0("Criteria ",as.numeric(1:input$criteria))
      rownames(df) <- paste0("Alternative ",as.numeric(1:input$alternatives))
      df
    },align = 'c',rownames = TRUE,caption = paste("Expert " ,j), caption.placement = getOption("xtable.caption.placement", "top"), sanitize.text.function = function(x) x)})})
})
}
# Run the application 
shinyApp(ui = ui, server = server,enableBookmarking = "url")

Answer 1

After some testing I found that delaying the call to updateNumericInput did the trick. The numericInput elements are apparently not rendered by the time the corresponding update function is called. This means that part of the state will be lost.

I used shinyjs::delay around the onRestore callback function that restores the ui based on the state. The callback will wait for 200 milliseconds before firing updateNumericInput

## in server - onRestore
shinyjs::delay(200, {

  for (i in 1:input$experts){
    for (m in 1:input$criteria){
      for (n in 1:input$alternatives){
        Y <- state$values$viewdatatable[n,m,i]
        updateNumericInput(session, paste0("t",i,"r",n,"c",m), value = Y)

      }}}
})

It seems this gives renderUI enough time to render the table before updateNumericInputgets called. If you rty to apply this fix, don't forget to use shinyjs::useShinyjs() somewhere in the ui.