我试图在我的桌面上本地运行一个闪亮的应用程序,我正在寻找一种方法来下载和上传书签状态作为 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")
这个问题也发布在这里