1

我试图在我的桌面上本地运行一个闪亮的应用程序，我正在寻找一种方法来下载和上传书签状态作为 rds 文件，而不是复制和粘贴 URL。我已经尝试过解决方法，但它们不如使用闪亮的书签功能和特性有用。这是一个具有书签功能的示例应用程序。我正在尝试将其转换为可以下载和上传 rds 文件以保存和恢复状态的应用程序。任何帮助将不胜感激。

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")

这个问题也发布在这里

4

0 回答 0