1

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

1
  • 1
    For future readers: Here you can find a related answer. Jul 14, 2021 at 9:18

0

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Browse other questions tagged or ask your own question.