1

I have built a shiny app having multiple tabs and tried to save the state of the app and restore it but I am not getting result as I expected. Following is the example code I have used to save and restore. file will stored in .rds format.

library(shinydashboard)
library(shinyWidgets)
library(plotly)
library(DT)
library(corrr)
library(dplyr)
library(Robyn)
library(qgraph)
library(shinyjs)
library(utils)
library(tools)
library(stringi)

ui <- function(request){fluidPage(
  useShinyjs(),
  titlePanel("APP"),
  useShinydashboard(),
  fileInput(
    "file",
    "Choose CSV File",
    accept = c("text/csv",
               "text/comma-separated-values,text/plain",
               ".csv")
  ),
  checkboxInput("header",
                "Header",
                value = TRUE),
  radioButtons(
    "disp",
    "Display",
    choices = c(Head = "head",
                All = "all"),
    selected = "head"
  ),
  fileInput("restore_bookmark", 
            "Restore Session", 
            multiple = FALSE 
            #accept = ".rds"),
  ),
  #  SIDEBAR --------------------------------------------------------
  navlistPanel(
    widths = c(2,10),
    #  Input data ---------------------------------------------------
    tabPanel('Input data',
             fluidRow(
               box(width = 12,
                   dataTableOutput('table'),
                   title = 'Raw data'),
               box(width = 6,
                   dataTableOutput('miss'),
                   title = 'Missing percentage table'),
               box(width = 6,
                   dataTableOutput('dtype'),
                   title = 'Datatype')
             )
    ),
    #  Basic EDA ----------------------------------------------------
    tabPanel('Basic EDA',
             fluidRow(
               column(width = 7,
                      box(
                        width = NULL,
                        plotlyOutput('correlation',
                                     height = 450),
                        title = 'Correlation plot',
                        style = 'overflow-y:scroll; max-height: 600px'
                      ),
                      box(
                        width = NULL,
                        selectInput(
                          inputId = 'x_axis',
                          label = 'X-axis',
                          'Names',
                          multiple = FALSE
                        ),
                        selectInput(
                          inputId = 'y_axis',
                          label = 'Y-axis',
                          'Names',
                          multiple = FALSE
                        )
                      )
               ),
               column(width = 5,
                      box(
                        width = NULL,
                        plotOutput('network',
                                   height = 250),
                        title = 'Correlation network',
                        sliderInput('netslider',
                                    'Min corr',
                                    min = 0,
                                    max = 1,
                                    value = 0.3)
                      ),
                      box(
                        width = NULL,
                        plotlyOutput('scatter',
                                     height = 300),
                        title = 'Scatter plot'
                      )
               )
             ),
             actionButton("save_inputs", 
                          'Save Session', 
                          icon = icon("download"))
    )
  )
)}

server <- function(input, output, session) {
  #  Session saving --------------------------------------------------
  latestBookmarkURL <- reactiveVal()
  
  onBookmarked(
    fun = function(url) { #url
      latestBookmarkURL(parseQueryString(url))
    }
  )
  
  onRestored(function(state) {
    showNotification(paste("Restored session:",
                           basename(state$dir)),
                     duration = 10,
                     type = "message")
  })
  observeEvent(input$save_inputs, {
    showModal(modalDialog(
      title = "Session Name",
      textInput("session_name", 
                "Please enter a session name (optional):"),
      footer = tagList(
        modalButton("Cancel"),
        downloadButton("download_inputs", "OK")
      )
    ))
  }, ignoreInit = TRUE)
  # SAVE SESSION ---------------------------------------------------------------
  output$download_inputs <- downloadHandler(
    filename = function() {
      removeModal()
      session$doBookmark()
      
      if (input$session_name != "") {
        
        tmp_session_name <- sub("\\.rds$", "", input$session_name)
        tmp_session_name <- stri_replace_all(tmp_session_name, "", regex = "[^[:alnum:]]")
        tmp_session_name <- paste0(tmp_session_name, ".rds")
        print(tmp_session_name)
      } else {
        paste(req(latestBookmarkURL()), "rds", sep = ".")
        
      }
    },
    print(latestBookmarkURL()),
    
    content = function(file) {
      file.copy(from = file.path(
        ".",
        "shiny_bookmarks",
        req(latestBookmarkURL()),
        "input.rds"
        #paste0(ses_name(),'.rds')
      ),
      to = file)
      
    }
  )
  # LOAD SESSION ---------------------------------------------------------------
  observeEvent(input$restore_bookmark, {
      sessionName <- file_path_sans_ext(input$restore_bookmark$name)
      print(sessionName)
      targetPath <- file.path(".", "shiny_bookmarks", sessionName, "input.rds")
      print(targetPath)
      restoreURL <- paste0(session$clientData$url_protocol, "//", 
                           session$clientData$url_hostname, ":", 
                           session$clientData$url_port, 
                           session$clientData$url_pathname, 
                           "?_state_id_=", 
                           sessionName)
      
      print(restoreURL)
      # redirect user to restoreURL
      runjs(sprintf("window.location = '%s';", restoreURL))
      
      print(sprintf("window.location = '%s';", restoreURL))
      })
    
  
    
    dataset <- reactive({
      read.csv("./Dataset/data.csv")
    })
    observe(
      output$table <- DT::renderDataTable({
        if (input$disp == 'head') {
          head(dataset())
        }
        else{
          dataset()
        }
      })
    )
    # Missing percentage table ---------------------------------------
    output$miss <- renderDataTable({
      miss_dataframe = data.frame(names(dataset()),
                                  (colMeans(is.na(dataset())))*100)
      setNames(miss_dataframe,c("Variable","Missing percentage"))
    })
    
    # Datatype table -------------------------------------------------
    output$dtype <- renderDataTable({
      dtype_dataframe = data.frame(names(dataset()),
                                   sapply(dataset(),class))
      setNames(dtype_dataframe,c('Variables','Data type'))
    })
    # Correlation plot -----------------------------------------------------------
    sub_dataset <- reactive({
      subset(dataset(),
             select = sapply(dataset(),
                             class) != 'character',
             drop = TRUE)
    })
    output$correlation <- renderPlotly({
      cor_sub <- cor(sub_dataset())
      plot_ly(x = names(sub_dataset()),
              y = names(sub_dataset()),
              z = cor_sub,
              type = 'heatmap',
              colors = colorRamp(c("red", "green")),
              zmin = -1,
              zmax = 1,
              width = 600,
              height = 500) %>%
        layout(title = paste('Correlation plot'))
    })
    # Correlation network --------------------------------------------
    output$network <- renderPlot({
      qgraph(cor(sub_dataset()),
             shape = 'ellipse',
             overlay = TRUE,
             layout = 'spring',
             minimum = input$netslider,
             vsize = 8,
             labels = TRUE,
             nodeNames = colnames(sub_dataset()),
             details = T,
             legend = T,
             legend.cex = 0.4, 
             GLratio = 1.3,
             label.prop = 1.5
      )
    })
    # scatter plot ---------------------------------------------------------------
    observe({
      updateSelectInput(inputId = "x_axis",choices = names(dataset()))
      updateSelectInput(inputId = "y_axis",choices = names(dataset()))
    })
    
    x_axis <- reactive({
      dataset()[,input$x_axis]
    })
    y_axis <- reactive({
      dataset()[,input$y_axis]
    })
    
    output$scatter <- renderPlotly({
      plot_ly(dataset(), x = x_axis(),
              y = y_axis(),
              type = 'scatter',
              mode = 'markers') %>% 
        layout(title = paste("Scatter plot"))
    })

}
enableBookmarking(store = 'server')
shinyApp(ui = ui, server = server)

I have taken this save and restore technique from this link. please give any suggestions.

Here is the output of dput(head(read.csv("./Dataset/data.csv")))

structure(list(Date = c("2020-01-01", "2020-01-02", "2020-01-03", 
"2020-01-04", "2020-01-05", "2020-01-06", "2020-01-07", "2020-01-08", 
"2020-01-09", "2020-01-10"), CRM_web_visits = c(72531L, 74512L, 
102819L, 79954L, 36726L, 35314L, 32973L, 67710L, 56590L, 236847L
), DIRECT.NOSOURCE._web_visits = c(170419L, 201539L, 182053L, 
174788L, 169971L, 191405L, 205873L, 198961L, 199704L, 235057L
), DISPLAY_ad_spend = c(5974.94, 6791.05, 6475.65, 6977.87, 7184.88, 
7282.68, 6990.11, 7184.7, 7310.45, 7381.47), DISPLAY_impression = c(5195802L, 
6419806L, 6851564L, 7465473L, 8542588L, 8856138L, 9563437L, 9741881L, 
10102445L, 10764759L), EARNEDSOCIAL_web_visits = c(8468L, 13646L, 
17214L, 15885L, 16675L, 12983L, 12985L, 18746L, 19377L, 42041L
), ORGANICSEARCH_web_visits = c(161203L, 228753L, 228830L, 223210L, 
219383L, 228044L, 228522L, 262009L, 239033L, 250576L), OTHERS_web_visits = c(709L, 
1561L, 1698L, 1541L, 1448L, 1685L, 1838L, 2060L, 2213L, 2400L
), PAIDSEARCH_ad_spend = c(83432.41, 103529.01, 102688.27, 109478.01, 
109835.46, 102679.45, 106726.33, 145900.64, 149793.69, 135749.34
), PAIDSEARCH_impression = c(9614558L, 10974797L, 11177990L, 
12129001L, 11936305L, 11635109L, 11320728L, 12709154L, 13554402L, 
13776665L), PAIDSOCIAL_ad_spend = c(11538.3, 8512.8, 8805.4, 
11433.27, 11323.38, 11344.67, 11273.9, 11785.63, 11559.53, 18486.82
), PAIDSOCIAL_impression = c(12212695L, 8692666L, 8456129L, 9878943L, 
10315930L, 11530289L, 10552150L, 10546136L, 8784657L, 12968591L
), PARTNERSHIPMARKETING_ad_spend = c(63636.11, 6130.62, 8362.65, 
6208.49, 6114.99, 5079.42, 9484.97, 22930.46, 10150.6, 22321.9
), PARTNERSHIPMARKETING_click = c(72785L, 119086L, 113134L, 92235L, 
92232L, 81516L, 96305L, 126095L, 130431L, 249288L), REFERRINGSITES_web_visits = c(7955L, 
12286L, 13948L, 12509L, 10906L, 11595L, 11818L, 13143L, 13179L, 
17014L), Overall_Revenue = c(941026.4, 1293915.56, 1485440.42, 
1395251.29, 1358603.2, 1342233.84, 1385053.29, 1883013.32, 1438745.75, 
3017775.46)), row.names = c(NA, 10L), class = "data.frame")

thanks in advance

  • Could you please elaborate on what isn't working as expected? Furthermore, your example isn't reproducible. Please share the output of `dput(read.csv("./Dataset/data.csv"))` or `dput(head(read.csv("./Dataset/data.csv")))`. – ismirsehregal Nov 10 '22 at 08:25
  • Thank for the reply @ismirsehregal, I can able to save the state of the app but when I restore it, it's giving message as `Restored session` but I didn't get the app as in saved state. For example : while saving, variable what I had selected to get a graph is not displaying in restoring session. – user19579193 Nov 11 '22 at 07:16

1 Answers1

3

Well, you deleted (or didn't copy) the dir.create and file.copy calls in the observeEvent(input$restore_bookmark, [...] from my original answer. They are mandatory for this to work.

Furthermore I added an id to your navlistPanel so its state can be bookmarked and your updateSelectInput(inputId = "x_axis" ... is overwriting the restored bookmark state for your selectInputs - you might want to change the logic, so that is is used only if the session wasn't restored - check ?onRestore.

library(shiny)
library(shinydashboard)
library(shinyWidgets)
library(plotly)
library(DT)
library(corrr)
library(dplyr)
library(Robyn)
library(qgraph)
library(shinyjs)
library(utils)
library(tools)
library(stringi)

ui <- function(request){fluidPage(
  useShinyjs(),
  titlePanel("APP"),
  useShinydashboard(),
  fileInput(
    "file",
    "Choose CSV File",
    accept = c("text/csv",
               "text/comma-separated-values,text/plain",
               ".csv")
  ),
  checkboxInput("header",
                "Header",
                value = TRUE),
  radioButtons(
    "disp",
    "Display",
    choices = c(Head = "head",
                All = "all"),
    selected = "head"
  ),
  fileInput("restore_bookmark", 
            "Restore Session", 
            multiple = FALSE 
            #accept = ".rds"),
  ),
  #  SIDEBAR --------------------------------------------------------
  navlistPanel(
    id = "navlistPanelID",
    widths = c(2,10),
    #  Input data ---------------------------------------------------
    tabPanel('Input data',
             fluidRow(
               box(width = 12,
                   dataTableOutput('table'),
                   title = 'Raw data'),
               box(width = 6,
                   dataTableOutput('miss'),
                   title = 'Missing percentage table'),
               box(width = 6,
                   dataTableOutput('dtype'),
                   title = 'Datatype')
             )
    ),
    #  Basic EDA ----------------------------------------------------
    tabPanel('Basic EDA',
             fluidRow(
               column(width = 7,
                      box(
                        width = NULL,
                        plotlyOutput('correlation',
                                     height = 450),
                        title = 'Correlation plot',
                        style = 'overflow-y:scroll; max-height: 600px'
                      ),
                      box(
                        width = NULL,
                        selectInput(
                          inputId = 'x_axis',
                          label = 'X-axis',
                          choices = NULL,
                          multiple = FALSE
                        ),
                        selectInput(
                          inputId = 'y_axis',
                          label = 'Y-axis',
                          choices = NULL,
                          multiple = FALSE
                        )
                      )
               ),
               column(width = 5,
                      box(
                        width = NULL,
                        plotOutput('network',
                                   height = 250),
                        title = 'Correlation network',
                        sliderInput('netslider',
                                    'Min corr',
                                    min = 0,
                                    max = 1,
                                    value = 0.3)
                      ),
                      box(
                        width = NULL,
                        plotlyOutput('scatter',
                                     height = 300),
                        title = 'Scatter plot'
                      )
               )
             ),
             actionButton("save_inputs", 
                          'Save Session', 
                          icon = icon("download"))
    )
  )
)}

server <- function(input, output, session) {
  #  Session saving --------------------------------------------------
  latestBookmarkURL <- reactiveVal()
  
  onBookmarked(
    fun = function(url) { #url
      latestBookmarkURL(parseQueryString(url))
    }
  )
  
  onRestored(function(state) {
    showNotification(paste("Restored session:",
                           basename(state$dir)),
                     duration = 10,
                     type = "message")
  })
  observeEvent(input$save_inputs, {
    showModal(modalDialog(
      title = "Session Name",
      textInput("session_name", 
                "Please enter a session name (optional):"),
      footer = tagList(
        modalButton("Cancel"),
        downloadButton("download_inputs", "OK")
      )
    ))
  }, ignoreInit = TRUE)
  # SAVE SESSION ---------------------------------------------------------------
  output$download_inputs <- downloadHandler(
    filename = function() {
      removeModal()
      session$doBookmark()
      
      if (input$session_name != "") {
        
        tmp_session_name <- sub("\\.rds$", "", input$session_name)
        tmp_session_name <- stri_replace_all(tmp_session_name, "", regex = "[^[:alnum:]]")
        tmp_session_name <- paste0(tmp_session_name, ".rds")
        print(tmp_session_name)
      } else {
        paste(req(latestBookmarkURL()), "rds", sep = ".")
        
      }
    },
    print(latestBookmarkURL()),
    
    content = function(file) {
      file.copy(from = file.path(
        ".",
        "shiny_bookmarks",
        req(latestBookmarkURL()),
        "input.rds"
        #paste0(ses_name(),'.rds')
      ),
      to = file)
      
    }
  )
  # LOAD SESSION ---------------------------------------------------------------
  observeEvent(input$restore_bookmark, {
    sessionName <- file_path_sans_ext(input$restore_bookmark$name)
    print(sessionName)
    targetPath <- file.path(".", "shiny_bookmarks", sessionName, "input.rds")
    
    print(targetPath)
    restoreURL <- paste0(session$clientData$url_protocol, "//", 
                         session$clientData$url_hostname, ":", 
                         session$clientData$url_port, 
                         session$clientData$url_pathname, 
                         "?_state_id_=", 
                         sessionName)
    
    print(restoreURL)
    if (!dir.exists(dirname(targetPath))) {
      dir.create(dirname(targetPath), recursive = TRUE)
    }
    
    file.copy(
      from = input$restore_bookmark$datapath,
      to = targetPath,
      overwrite = TRUE
    )
    
    restoreURL <- paste0(session$clientData$url_protocol, "//", session$clientData$url_hostname, ":", session$clientData$url_port, session$clientData$url_pathname, "?_state_id_=", sessionName)
    
    # redirect user to restoreURL
    runjs(sprintf("window.location = '%s';", restoreURL))
    
    print(sprintf("window.location = '%s';", restoreURL))
  })
  
  
  
  dataset <- reactive({
    # read.csv("./Dataset/data.csv")
    structure(list(Date = c("2020-01-01", "2020-01-02", "2020-01-03",
                            "2020-01-04", "2020-01-05", "2020-01-06", "2020-01-07", "2020-01-08",
                            "2020-01-09", "2020-01-10"), CRM_web_visits = c(72531L, 74512L,  102819L,
                                                                            79954L, 36726L, 35314L, 32973L, 67710L, 56590L, 236847L ),
                   DIRECT.NOSOURCE._web_visits = c(170419L, 201539L, 182053L,  174788L,
                                                   169971L, 191405L, 205873L, 198961L, 199704L, 235057L ), DISPLAY_ad_spend =
                     c(5974.94, 6791.05, 6475.65, 6977.87, 7184.88,  7282.68, 6990.11, 7184.7,
                       7310.45, 7381.47), DISPLAY_impression = c(5195802L,  6419806L, 6851564L,
                                                                 7465473L, 8542588L, 8856138L, 9563437L, 9741881L,  10102445L, 10764759L),
                   EARNEDSOCIAL_web_visits = c(8468L, 13646L,  17214L, 15885L, 16675L,
                                               12983L, 12985L, 18746L, 19377L, 42041L ), ORGANICSEARCH_web_visits =
                     c(161203L, 228753L, 228830L, 223210L,  219383L, 228044L, 228522L, 262009L,
                       239033L, 250576L), OTHERS_web_visits = c(709L,  1561L, 1698L, 1541L,
                                                                1448L, 1685L, 1838L, 2060L, 2213L, 2400L ), PAIDSEARCH_ad_spend =
                     c(83432.41, 103529.01, 102688.27, 109478.01,  109835.46, 102679.45,
                       106726.33, 145900.64, 149793.69, 135749.34 ), PAIDSEARCH_impression =
                     c(9614558L, 10974797L, 11177990L,  12129001L, 11936305L, 11635109L,
                       11320728L, 12709154L, 13554402L,  13776665L), PAIDSOCIAL_ad_spend =
                     c(11538.3, 8512.8, 8805.4,  11433.27, 11323.38, 11344.67, 11273.9,
                       11785.63, 11559.53, 18486.82 ), PAIDSOCIAL_impression = c(12212695L,
                                                                                 8692666L, 8456129L, 9878943L,  10315930L, 11530289L, 10552150L, 10546136L,
                                                                                 8784657L, 12968591L ), PARTNERSHIPMARKETING_ad_spend = c(63636.11,
                                                                                                                                          6130.62, 8362.65,  6208.49, 6114.99, 5079.42, 9484.97, 22930.46, 10150.6,
                                                                                                                                          22321.9 ), PARTNERSHIPMARKETING_click = c(72785L, 119086L, 113134L,
                                                                                                                                                                                    92235L,  92232L, 81516L, 96305L, 126095L, 130431L, 249288L),
                   REFERRINGSITES_web_visits = c(7955L,  12286L, 13948L, 12509L, 10906L,
                                                 11595L, 11818L, 13143L, 13179L,  17014L), Overall_Revenue = c(941026.4,
                                                                                                               1293915.56, 1485440.42,  1395251.29, 1358603.2, 1342233.84, 1385053.29,
                                                                                                               1883013.32, 1438745.75,  3017775.46)), row.names = c(NA, 10L), class =
                "data.frame")
  })
  observe(
    output$table <- DT::renderDataTable({
      if (input$disp == 'head') {
        head(dataset())
      }
      else{
        dataset()
      }
    })
  )
  # Missing percentage table ---------------------------------------
  output$miss <- renderDataTable({
    miss_dataframe = data.frame(names(dataset()),
                                (colMeans(is.na(dataset())))*100)
    setNames(miss_dataframe,c("Variable","Missing percentage"))
  })
  
  # Datatype table -------------------------------------------------
  output$dtype <- renderDataTable({
    dtype_dataframe = data.frame(names(dataset()),
                                 sapply(dataset(),class))
    setNames(dtype_dataframe,c('Variables','Data type'))
  })
  # Correlation plot -----------------------------------------------------------
  sub_dataset <- reactive({
    subset(dataset(),
           select = sapply(dataset(),
                           class) != 'character',
           drop = TRUE)
  })
  output$correlation <- renderPlotly({
    cor_sub <- cor(sub_dataset())
    plot_ly(x = names(sub_dataset()),
            y = names(sub_dataset()),
            z = cor_sub,
            type = 'heatmap',
            colors = colorRamp(c("red", "green")),
            zmin = -1,
            zmax = 1,
            width = 600,
            height = 500) %>%
      layout(title = paste('Correlation plot'))
  })
  # Correlation network --------------------------------------------
  output$network <- renderPlot({
    qgraph(cor(sub_dataset()),
           shape = 'ellipse',
           # overlay = TRUE,
           layout = 'spring',
           minimum = input$netslider,
           vsize = 8,
           labels = TRUE,
           nodeNames = colnames(sub_dataset()),
           details = T,
           legend = T,
           legend.cex = 0.4, 
           GLratio = 1.3,
           label.prop = 1.5
    )
  })
  # scatter plot ---------------------------------------------------------------
  
  isBookmarkedSession <- reactiveVal(FALSE)
  onRestore(function(state) {
    isBookmarkedSession(TRUE)
    updateSelectInput(inputId = "x_axis", choices = names(dataset()), selected = state$input$x_axis)
    updateSelectInput(inputId = "y_axis", choices = names(dataset()), selected = state$input$y_axis) 
  })
  
  observe({
    if(!isBookmarkedSession()){
      updateSelectInput(inputId = "x_axis", choices = names(dataset()))
      updateSelectInput(inputId = "y_axis", choices = names(dataset())) 
    }
  })
  
  output$scatter <- renderPlotly({
    req(dataset(), input$x_axis, input$y_axis)
    plot_ly(dataset(), x = ~ get(input$x_axis),
            y = ~ get(input$y_axis),
            type = 'scatter',
            mode = 'markers') %>% 
      layout(title = paste("Scatter plot"))
  })
  
}
enableBookmarking(store = 'server')
shinyApp(ui = ui, server = server)
ismirsehregal
  • 30,045
  • 5
  • 31
  • 78
  • Thanks for the clear explanation, can you please explain more on how can I change the logic in onRestored() that should trigger the restored session results first. – user19579193 Nov 14 '22 at 11:52
  • @user19579193 you'll need to update the selectInputs on the server side via `onRestore`, as you don't provide any `choices` in the UI (Thus restoring isn't working right away). Please see my edit. – ismirsehregal Nov 15 '22 at 08:44
  • Thanks @ismirsehregal, Here the dataset, correlation plot, network plot are generating with the usual code, How can we restore them from the session itself?. please guide me on that. – user19579193 Nov 18 '22 at 09:25
  • @user19579193 I'm not sure what you are referring to. Please ask a follow-up question and link it here. – ismirsehregal Nov 18 '22 at 09:57
  • Here when we restore, variables for x-axis and y-axis are restoring and based on that it plots scatter plot. But in the first tab before restoring session we are going to see all the results. Can we do that should give results after restoring? – user19579193 Nov 18 '22 at 13:51