1

I'm using shiny apps in a automatized workflow, and therefore I want to be able to save the bookmark locally, and when opening the app in a future session, automatically restore the last saved bookmark (if available). I have two issues:

  1. (major): the app currently does what I want, it automatically restores the last bookmark saved (if available). BUT when a bookmark gets restored the plot gets continuously updated. Probably I'm not getting the reactivity of the code right. Thanks!
  2. (minor): ideally I would overwrite the saved bookmark, as I always just need the last one saved, so the saved files do not pile up over time. For now I only figured out how to retrieve the last one saved, which is ok, but I am happy to get suggestions on how to maybe do this.

To reproduce the 1. issue, run the shiny app and click the bookmark button, than close the app, and then run it again.


library("shiny")
library("shinyjs")
library("tidyverse")

## module to do something with the data
shinyModuleUserInterface <- function(id, label) {
  ns <- NS(id) 
  tagList(
    titlePanel("Track of individual"),
    selectInput(inputId = ns("indv"), label = "Select indivdual", 
                choices = c("A","B","C"), selected="A"),
    plotOutput(ns("plot"))
  )
}

shinyModule <- function(input, output, session) { 
  ns <- session$ns 
  dataTrk <- data.frame(indv=rep(c("A","B","C"), each=4), 
                        x=c(1,4,2,6,9,5,3,8,9,4,3,7),
                        y=c(7,5,9,3,1,2,6,4,9,5,1,6))
  output$plot <- renderPlot({
    plot(y~x, dataTrk[dataTrk$indv==input$indv,], type="l")
  })
}

## function to get the last bookmark saved
get_last_bookmark <- function(){
  list.files(path = 'shiny_bookmarks/') %>% 
    map_df(., ~paste0('shiny_bookmarks/', .x) %>%
             file.info) %>%
    slice_max(atime) %>%
    rownames()
}
get_last_bookmark <- possibly(get_last_bookmark, otherwise = '') #avoid empty folder error

## main app code
ui <- function(request) { 
  fluidPage(
    useShinyjs(),
    shinyModuleUserInterface("shinyModule"),
    bookmarkButton()
  )
}

server <- function(input, output, session) {
  
  callModule(shinyModule,"shinyModule")
  
  onBookmarked(function(state){
    # avoid showing popup message window as I just want the bookmark to be saved locally
  })
  
  ## below my intention is: check if there is a stored bookmark available, if yes, restore the last bookmark
  observeEvent(req(get_last_bookmark() !=""), {
    sessionName <- get_last_bookmark() %>% str_sub(17, -1)
    restoreURL  <- paste0(session$clientData$url_protocol, "//",
                          session$clientData$url_hostname, ":",
                          session$clientData$url_port, "/?_state_id_=",
                          sessionName)
    # redirect user to restoreURL
    shinyjs::runjs(sprintf("window.location = '%s';", restoreURL))
  }, once = TRUE)
}

shinyApp(ui, server,enableBookmarking="server")
AnneScharf
  • 13
  • 3

1 Answers1

0

The problem with the above code is, that shinyjs::runjs(sprintf("window.location = '%s';", restoreURL)) triggers a new shiny session once a bookmark is found but it doesn't check whether the running session already was restored from that bookmark (so we end up in a restoring loop). Please check my modified req call in the upper observeEvent.

The lower observeEvent deletes the bookmark file and folder after it was restored (referring to the initial answer)

2. Edit:

This is a more robust approach which is moving the latest bookmark always into the same folder:

library(fs)
library(shiny)
library(tidyverse)

## module to do something with the data
shinyModuleUserInterface <- function(id, label) {
  ns <- NS(id)
  tagList(
    titlePanel("Track of individual"),
    selectInput(
      inputId = ns("indv"),
      label = "Select indivdual",
      choices = c("A", "B", "C"),
      selected = "A"
    ),
    plotOutput(ns("plot"))
  )
}

shinyModule <- function(input, output, session) {
  ns <- session$ns
  dataTrk <- data.frame(
    indv = rep(c("A", "B", "C"), each = 4),
    x = c(1, 4, 2, 6, 9, 5, 3, 8, 9, 4, 3, 7),
    y = c(7, 5, 9, 3, 1, 2, 6, 4, 9, 5, 1, 6)
  )
  output$plot <- renderPlot({
    plot(y ~ x, dataTrk[dataTrk$indv == input$indv, ], type = "l")
  })
}

## main app code
ui <- function(request) {
  fluidPage(shinyModuleUserInterface("shinyModule"),
            bookmarkButton())
}

server <- function(input, output, session) {
  observeEvent(session, {
    if(file_exists(path("shiny_bookmarks/latest/input.rds")) && is.null(parseQueryString(session$clientData$url_search)$`_state_id_`)){
      updateQueryString(queryString = "?_state_id_=latest")
      session$reload() 
    }
  }, once = TRUE)
  
  callModule(shinyModule, "shinyModule")

  onBookmarked(function(url) {
    # avoid showing popup message window as I just want the bookmark to be saved locally
    # we could use urltools::url_parse(url)$parameter instead of sub()
    if(!dir_exists("shiny_bookmarks/latest")){
      dir_create("shiny_bookmarks/latest")
    }
    file_move(path = path("shiny_bookmarks", parseQueryString(sub("^.*\\?", "", url))$`_state_id_`, "input.rds"), new_path = path("shiny_bookmarks/latest/input.rds"))
    dir_delete(path("shiny_bookmarks", parseQueryString(sub("^.*\\?", "", url))$`_state_id_`))
  })
}

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

Edit:

This avoids using shinyjs by using updateQueryString:

library(shiny)
library(tidyverse)

## module to do something with the data
shinyModuleUserInterface <- function(id, label) {
  ns <- NS(id)
  tagList(
    titlePanel("Track of individual"),
    selectInput(
      inputId = ns("indv"),
      label = "Select indivdual",
      choices = c("A", "B", "C"),
      selected = "A"
    ),
    plotOutput(ns("plot"))
  )
}

shinyModule <- function(input, output, session) {
  ns <- session$ns
  dataTrk <- data.frame(
    indv = rep(c("A", "B", "C"), each = 4),
    x = c(1, 4, 2, 6, 9, 5, 3, 8, 9, 4, 3, 7),
    y = c(7, 5, 9, 3, 1, 2, 6, 4, 9, 5, 1, 6)
  )
  output$plot <- renderPlot({
    plot(y ~ x, dataTrk[dataTrk$indv == input$indv, ], type = "l")
  })
}

## function to get the last bookmark saved
get_last_bookmark <- function() {
  list.files(path = 'shiny_bookmarks/') %>%
    map_df(., ~ paste0('shiny_bookmarks/', .x) %>%
             file.info) %>%
    slice_max(atime) %>%
    rownames()
}
get_last_bookmark <- possibly(get_last_bookmark, otherwise = '') #avoid empty folder error

## main app code
ui <- function(request) {
  fluidPage(shinyModuleUserInterface("shinyModule"),
            bookmarkButton())
}

server <- function(input, output, session) {
  callModule(shinyModule, "shinyModule")
  
  onBookmarked(function(state) {
    # avoid showing popup message window as I just want the bookmark to be saved locally
  })
  
  observeEvent(req(get_last_bookmark() != "" && is.null(parseQueryString(session$clientData$url_search)$`_state_id_`)), {
    bookmarkName <- basename(get_last_bookmark())
    updateQueryString(queryString = paste0("?_state_id_=", bookmarkName))
    session$reload()
  }, once = TRUE)
  
  # also see ?onRestored()
  observeEvent(session$clientData$url_search, {
    if (!is.null(parseQueryString(session$clientData$url_search)$`_state_id_`)) {
      if (basename(get_last_bookmark()) == parseQueryString(session$clientData$url_search)$`_state_id_`) {
        fs::dir_delete(get_last_bookmark())
      }
    }
  }, once = TRUE)
}

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

Initial answer using shinyjs:

library("shiny")
library("shinyjs")
library("tidyverse")

## module to do something with the data
shinyModuleUserInterface <- function(id, label) {
  ns <- NS(id)
  tagList(
    titlePanel("Track of individual"),
    selectInput(
      inputId = ns("indv"),
      label = "Select indivdual",
      choices = c("A", "B", "C"),
      selected = "A"
    ),
    plotOutput(ns("plot"))
  )
}

shinyModule <- function(input, output, session) {
  ns <- session$ns
  dataTrk <- data.frame(
    indv = rep(c("A", "B", "C"), each = 4),
    x = c(1, 4, 2, 6, 9, 5, 3, 8, 9, 4, 3, 7),
    y = c(7, 5, 9, 3, 1, 2, 6, 4, 9, 5, 1, 6)
  )
  output$plot <- renderPlot({
    plot(y ~ x, dataTrk[dataTrk$indv == input$indv, ], type = "l")
  })
}

## function to get the last bookmark saved
get_last_bookmark <- function() {
  list.files(path = 'shiny_bookmarks/') %>%
    map_df(., ~ paste0('shiny_bookmarks/', .x) %>%
             file.info) %>%
    slice_max(atime) %>%
    rownames()
}
get_last_bookmark <-
  possibly(get_last_bookmark, otherwise = '') #avoid empty folder error

## main app code
ui <- function(request) {
  fluidPage(useShinyjs(),
            shinyModuleUserInterface("shinyModule"),
            bookmarkButton())
}

server <- function(input, output, session) {
  callModule(shinyModule, "shinyModule")
  
  onBookmarked(function(state) {
    # avoid showing popup message window as I just want the bookmark to be saved locally
  })
  
  observeEvent(req(get_last_bookmark() != "" && is.null(parseQueryString(session$clientData$url_search)$`_state_id_`)), {
    sessionName <- get_last_bookmark() %>% str_sub(17,-1)
    restoreURL  <- paste0(
      session$clientData$url_protocol, "//",
      session$clientData$url_hostname, ":",
      session$clientData$url_port, "/?_state_id_=",
      sessionName
    )
    # redirect user to restoreURL
    shinyjs::runjs(sprintf("window.location = '%s';", restoreURL))
  }, once = TRUE)

  # also see ?onRestored()
  observeEvent(session$clientData$url_search, {
    if (!is.null(parseQueryString(session$clientData$url_search)$`_state_id_`)) {
      if (basename(get_last_bookmark()) == parseQueryString(session$clientData$url_search)$`_state_id_`) {
        fs::dir_delete(get_last_bookmark())
      }
    }
  }, once = TRUE)
}

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

Deleting the bookmark files might lead to:

Error in RestoreContext initialization: Bookmarked state directory does not exist. if the old bookmarking query string is still present in the browsers address bar.

As an alternative to the above approach please check the libraries library(shinyStore) or library(shinyStorePlus) which use the browsers localStorage to restore shiny inputs.

Please also check my earlier answer here.

Here is another related question and here a related GitHub issue.

ismirsehregal
  • 30,045
  • 5
  • 31
  • 78