如何使用 .rda 文件恢复闪亮的应用程序？

Question

我有一个示例应用程序，允许用户在闪亮的应用程序中执行某些操作，然后为状态添加书签。我了解状态文件存储在 shiny_bookmarks 文件夹中。通常，我会复制带有书签的服务器 URL 并恢复应用程序。但我想知道是否可以上传 rds 文件并恢复书签应用的状态。

shiny_bookmarks 文件夹创建带有 .rds 文件的文件夹。我的目标是通过加载 .rds 文件来恢复应用的状态。

理想情况下，我想将 rds 和其他文件捆绑到一个 rda 文件中，然后使用 fileInput 上传 rda 文件。我认为 rda 文件会更好，因为它们可以保存多个对象。

对于下面的示例应用程序，我将 rda fileInput 作为占位符。我一直在尝试使用保存在 shiny_bookmarks 文件夹中的文件来恢复应用程序，但我不确定如何去做，因为到目前为止我找不到太多文档。

屏幕截图：shiny_bookmarks 文件夹

屏幕截图：书签文件夹中的 .rds 文件

示例应用：

library(shiny)

ui <- function(request){fluidPage(
  sidebarLayout(
    sidebarPanel(
      fileInput("data", "Choose CSV File", accept = ".csv"),
      checkboxInput("header", "Header", TRUE),
      fileInput("file1", "Choose RDA File", accept = ".rda"),
      bookmarkButton()
    ),
    mainPanel(
      tableOutput("data_head"),
      tableOutput("contents"),
      selectInput("select", "Select Variable", choices = NULL, selected = NULL),
      plotOutput("boxplot")
    )
  )
)
}

server <- function(input, output) {
  
 dataset <- reactive({
    file <- input$data
    ext <- tools::file_ext(file$datapath)
    
    req(file)
    validate(need(ext == "csv", "Please upload a csv file"))
    
    my_data  <- read.csv(file$datapath, header = input$header)
    
    my_data
  })
  
  output$data_head <- renderTable({
    head(dataset())
  })
  
  output$boxplot <- renderPlot({
    req(dataset())
    req(input$select)
     boxplot(dataset()[[input$select]], horizontal = TRUE)
  })
  
  observeEvent(input$data, {
   req(dataset())
    updateSelectInput(session = getDefaultReactiveDomain(), "select", label = "Select Variable", choices = c("", names(dataset())))
  })
  
  
  output$out <- renderText({
    if (input$caps)
      toupper(input$txt)
    else
      input$txt
  })
  
  output$contents <- renderTable({
    file <- input$file1
    ext <- tools::file_ext(file$datapath)
    
    req(file)
    validate(need(ext == "rds", "Please upload a RDA file"))
    
    readRDS(file$datapath)
  })
}

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

来自基础 R 的示例 csv 数据：

write.csv("attitude", "attitude.csv")

应用截图：

我在这个post 和这个github repo 中找到了一个潜在的解决方法，但他们不使用书签。也许他们的解决方案可能更简单，但我正在努力将其与我的示例应用程序集成。

Answer 1

编辑：使用updateQueryString 更新网址位置栏的功能找到了代理解决方案。基本上我所做的就是在 ui 中添加一个 selectInput，显示之前保存的所有书签，让用户选择一个来恢复。

使用 rds 文件实现还原有一些限制。第一个是 input.rds（书签创建的文件）只显示输入的名称和值而不是类型，所以无法判断值是否对应于actionButton 或textInput。即使我们实现了一个识别每种类型的系统，像updateActionButton 这样的一些函数也没有value 参数，所以它的值几乎永远不会是正确的。

library(shiny)
library(tidyverse)


get_last_bookmark <- function(){
  list.files(path = 'shiny_bookmarks/') %>% #path to every folder containing bookmarked data.
    map_df(., ~paste0('shiny_bookmarks/', .x) %>%
             file.info ) %>% 
    slice_max(atime) %>%
    rownames()
}

get_last_bookmark <- possibly(get_last_bookmark, otherwise = '') #avoid empty folder error 


ui <- function(request){fluidPage(
  sidebarLayout(
    sidebarPanel(
      fileInput("data", "Choose CSV File", accept = ".csv"),
      checkboxInput("header", "Header", TRUE),
      fileInput("file1", "Choose RDA File", accept = ".rda"),
      bookmarkButton(),
      verbatimTextOutput('last_dir'),
      br(),
      selectInput('select_state', 'Select Bookmark Folder To Restore', choices = list.files(path = 'shiny_bookmarks/'),selected = get_last_bookmark() %>% str_sub(17, -1)),
      actionButton('dorestore', 'Restore it!')
    ),
    mainPanel(
      tableOutput("data_head"),
      tableOutput("contents"),
      selectInput("select", "Select Variable", choices = NULL, selected = NULL),
      plotOutput("boxplot")
    )
  )
)
}

server <- function(input, output, session) {
  
  output$last_dir <- renderText({
    
    paste0('The last bookmark is stored in: ', get_last_bookmark())
    
  })
  
  
  
  
  onBookmark(function(state){
    
    output$last_dir <- renderText({
      paste0('The last bookmark is stored in: ', get_last_bookmark())
    })
    
    updateSelectInput(session = session, 'select_state', choices = list.files(path = 'shiny_bookmarks/'), selected = get_last_bookmark() %>% str_sub(17, -1) )
    
    
    state$values$input_value_to_restore <- input$select
  })
  
  onBookmarked(function(state){
    #avoid showing message window
  })
  
  observeEvent(input$dorestore, {
    updateQueryString(queryString = paste0('?_state_id_=', input$select_state), session = session)
    session$reload()
  })
  
  dataset <- reactive({
    file <- input$data
    ext <- tools::file_ext(file$datapath)
    
    req(file)
    validate(need(ext == "csv", "Please upload a csv file"))
    
    my_data  <- read.csv(file$datapath, header = input$header)
    
    my_data
  })
  
  output$data_head <- renderTable({
    head(dataset())
  })
  
  output$boxplot <- renderPlot({
    req(dataset())
    req(input$select)
    boxplot(dataset()[[input$select]], horizontal = TRUE)
  })
  
  observeEvent(input$data, { #this will cause input$select to reset when the app restores because of the way shiny restores the app. 
    req(dataset())
      updateSelectInput(session = getDefaultReactiveDomain(), "select", label = "Select Variable", choices = c("", names(dataset())))
  })
  
  
  #avoid the dynamic parts of the app to reset
  onRestored(function(state) {
    
    updateSelectInput(session, 'select', selected = state$values$input_value_to_restore)
    
  })
  
  output$out <- renderText({
    if (input$caps)
      toupper(input$txt)
    else
      input$txt
  })
  
  output$contents <- renderTable({
    file <- input$file1
    ext <- tools::file_ext(file$datapath)
    
    req(file)
    validate(need(ext == "rds", "Please upload a RDA file"))
    
    readRDS(file$datapath)
  })
}

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

此应用程序将读取最后创建的带有书签数据的文件夹，并 在名为“Rds From Last State”的选项卡中打印其内容

library(shiny)
library(tidyverse)

ui <- function(request){fluidPage(
    sidebarLayout(
        sidebarPanel(
            fileInput("data", "Choose CSV File", accept = ".csv"),
            checkboxInput("header", "Header", TRUE),
            fileInput("file1", "Choose RDS File", accept = ".rds"),
            bookmarkButton()
        ),
        mainPanel(
            tabsetPanel(
                tabPanel('Tables',
                    tableOutput("data_head"),
                    tableOutput("contents"),
                    selectInput("select", "Select Variable", choices = NULL, selected = NULL),
                    plotOutput("boxplot")),
                tabPanel('Rds From Last State', 
                     verbatimTextOutput('bookmark_rds'))
        )
        )
    )
)
}

server <- function(input, output) {
    
    dataset <- reactive({
        file <- input$data
        ext <- tools::file_ext(file$datapath)
        
        req(file)
        validate(need(ext == "csv", "Please upload a csv file"))
        
        my_data  <- read.csv(file$datapath, header = input$header)
        
        my_data
    })
    
    output$data_head <- renderTable({
        head(dataset())
    })
    
    output$boxplot <- renderPlot({
        req(dataset())
        boxplot(dataset(), main = input$select, horizontal = TRUE)
    })
    
    observeEvent(input$data, {
        req(dataset())
        updateSelectInput(session = getDefaultReactiveDomain(), "select", label = "Select Variable", choices = c("", names(dataset())))
    })
    
    
    output$out <- renderText({
        if (input$caps)
            toupper(input$txt)
        else
            input$txt
    })
    
    output$contents <- renderTable({
        file <- input$file1
        ext <- tools::file_ext(file$datapath)
        
        req(file)
        validate(need(ext == "rds", "Please upload a RDS file"))
        
        readRDS(file$datapath)
    })
    
    
    rds_directory <- reactiveValues()
    
    
    
    onRestore(function(state) {
        #The last modified folder inside the bookmarks directory will contain the latest values to restore.
        last_bookmark_dir <- 
        list.files(path = 'shiny_bookmarks/') %>% #path to every folder containing bookmarked data.
            map_df(., ~paste0('shiny_bookmarks/', .x) %>%
                       file.info ) %>% 
            slice_max(atime) %>% rownames()
        
        print(paste('Last bookmark dir:', last_bookmark_dir))
        
        print(list.files(last_bookmark_dir))
        
        rds_directory$rds <- last_bookmark_dir %>%
                                list.files %>%
                                str_subset('\\.rds') %>% #subset all the .rds files
                                {paste0(last_bookmark_dir, '/', .)} %>% map(~ readRDS(.x))
        
        print(rds_directory$rds)
    })
    
    output$bookmark_rds <- renderPrint({
        req(rds_directory$rds) #If there's no bookmark this chunk won't execute
        
        
            map(rds_directory$rds, ~ .x) 
        
    })
    
    
}

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