How to save and restore bookmark state using rds file instead of copying and pasting url? - r

Question

I'm trying to run a shiny app locally on my desktop and I'm looking for a way to download and upload the bookmark state as an rds file instead of copying and pasting a url. I've tried workarounds but they are not as helpful as using shiny's bookmark functions and features. Here is an example app which has the bookmark function. I'm trying to convert this into an app that can download and upload rds file to save and restore the state. Any help will be greatly appreciated.
library(shiny)
library(janitor)
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)
})
}
tableUI <- function(id,var,bins) {
tagList(
fluidRow(column( 4, selectInput(NS(id, "var"), "Variable", choices = names(mtcars),selected=var),
column(8, tableOutput(NS(id, "tab")))))
)
}
tableServer <- function(id) {
moduleServer(id, function(input, output, session) {
data <- reactive(mtcars[[input$var]])
output$tab <- renderTable({
tabyl(data(), main = input$var)
})
})
}
boxUI <- function(id,var) {
tagList(
fluidRow(column( 4, selectInput(NS(id, "var2"), "Variable", choices = names(mtcars),selected=var),
column(8, plotOutput(NS(id, "box"))))
))
}
boxServer <- function(id) {
moduleServer(id, function(input, output, session) {
data <- reactive(mtcars[[input$var2]])
output$box <- renderPlot({
boxplot(data(), main = input$var2)
})
})
}
ui <- function(request){
fluidPage(
bookmarkButton(),
actionButton("add", "Add Histogram"),
actionButton("add2", "Add Boxplot"),
actionButton("add3", "Add Table"),
div(id = "add_here")
)
}
server <- function(input, output, session) {
setBookmarkExclude(c('add','add2','add3'))
add_id <- reactiveVal(0)
add2_id <- reactiveVal(0)
add3_id <- reactiveVal(0)
observeEvent(input$add, {
bins <- 10
histogramServer(paste0("hist_", input$add+add_id()))
insertUI(selector = "#add_here", ui = histogramUI(paste0("hist_", input$add+add_id()),input$var,bins))#}
})
observeEvent(input$add2, {
boxServer(paste0("box_", input$add2+add2_id())) #changed add_id() to add2_id()
insertUI(selector = "#add_here", ui = boxUI(paste0("box_", input$add2+add2_id()), input$var2))
})
observeEvent(input$add3, {
tableServer(paste0("tab_", input$add3+add3_id()))
insertUI(selector = "#add_here", ui = tableUI(paste0("tab_", input$add3+add3_id()), input$var))
})
onBookmark(function(state) {
state$values$modules <- state$exclude
state$values$add <- state$input$add + add_id()
state$values$add2 <- state$input$add2 + add2_id()
state$values$add3 <- state$input$add3 + add3_id()
})
onRestore(function(state){
add_id(state$values$add)
add2_id(state$values$add2)
add3_id(state$values$add3)
modules <- state$values$modules
if (length(modules)>1) {
for (i in 1:(length(modules))) {
if (substr(modules[i],1,4)=='hist') {
histogramServer(modules[i])
insertUI(selector = "#add_here", ui = histogramUI(modules[i],paste0(modules[i],"-var"),paste0(modules[i],"-bin")))
}
if (substr(modules[i],1,3)=='box') {
boxServer(modules[i])
insertUI(selector = "#add_here", ui = boxUI(modules[i],paste0(modules[i],"-var")))
}
if (substr(modules[i],1,3)=='tab') {
tableServer(modules[i])
insertUI(selector = "#add_here", ui = tableUI(modules[i],paste0(modules[i],"-var")))
}
}
}
})
}
shinyApp(ui, server, enableBookmarking = "server")
This question is also posted here