如何保存闪亮的应用程序会话内存？

Question

我有一个 Shiny 应用程序，它允许用户输入股票代码以生成 52 周范围图的列表。我希望能够将其用作监视列表，以便在输入代码后，该图将一直保留，直到将其删除。基本上我希望能够重新打开应用程序，而不必每次都重新输入监视列表中的所有代码。是否可以将这些信息保存在内存中？代码如下：

library(shiny)

ui <- fluidPage(
    tags$div(
        id = 'main',
        titlePanel("CyCap Watchlist", "Watchlist")
    ),
    fluidRow(
        column(3,
               id = "input",
               helpText("Input a stock symbol. Data will be collected from Yahoo Finance."),
               fluidRow(
                   column(9,
                          style = "padding-right: .2em;",
                          textInput("symb","Symbol", "SPY")
                   ),
                   column(2,
                          style = "padding-left: 0; top: 1.8em;",
                          actionButton("add", "", icon = icon("plus"), style = "background-color: #089f08e8; color: white;")
                   )
               ),
               dateRangeInput("dates","Date Range", start=Sys.Date()-365, end=Sys.Date()),
               br(),
        ),
        column(width=8, offset=1,
               id = "plotContainer",
               uiOutput("plots", style="display: flex; flex-direction: column; align-items: flex-start; flex-wrap: nowrap;")
        )
    )
)



library(shiny)
library(shinyjs)
library(ggplot2)
library(quantmod)
library(tibble)
library(RAmazonS3)


server <- function(input, output, session) {
    num <- 0L
    dataInput <- reactive({
        getSymbols(
            Symbols= input$symb, 
            src="yahoo", 
            from = input$dates[1], 
            to = input$dates[2],
            auto.assign = FALSE
        )
    })

    badf <- reactive({data.frame(dataInput())}) 

    baclosedf <- reactive({
        x <- subset(badf(), select=c(paste0(input$symb, ".Close")))
        x <- rownames_to_column(x, "Date")
    })

    output$plots <- renderUI({

        observeEvent(input$add, {
            num <<- num + 1
            id_add <- paste0(input$add, num)
            remove_id <- paste0("remove_", id_add)
            ele_id <- paste0("ele_", id_add)

            insertUI(
                selector = '#plots',
                where = "beforeEnd",
                ui = fluidRow(
                    id=ele_id,
                    plotOutput(id_add, width="85%", height="110px", inline=TRUE),
                    actionButton(remove_id, "", icon = icon("minus"), style="position: relative; top: -0.2em; background-color: #d54848; color: white;")
                )
            )

            local_symb <- isolate(input$symb)
            local_data <- isolate(baclosedf())

            output[[id_add]] <- renderPlot(
                ggplot(
                    data=local_data, 
                    mapping=aes(x="", y=local_data[, paste0(local_symb, ".Close")], group=1, size=5, height=1))+
                    geom_linerange(aes(ymin=min(local_data[, paste0(local_symb, ".Close")]),ymax=tail(local_data[, paste0(local_symb, ".Close")],n=1)),linetype="solid",color="red", size=3)+
                    geom_linerange(aes(ymin=tail(local_data[, paste0(local_symb, ".Close")], n=1)),ymax=max(local_data[, paste0(local_symb, ".Close")]),linetype="solid",color="forestgreen", size=3)+
                    geom_point(aes(y=min(local_data[, paste0(local_symb, ".Close")])),size=3,color="black")+
                    geom_point(aes(y=max(local_data[, paste0(local_symb, ".Close")])),size=3,color="black")+
                    geom_point(aes(y=tail(local_data[, paste0(local_symb, ".Close")], n=1)),size=3,color="black")+
                    scale_y_continuous(breaks = c(min(local_data[, paste0(local_symb, ".Close")]), tail(local_data[, paste0(local_symb, ".Close")], n=1), max(local_data[, paste0(local_symb, ".Close")])))+  
                    coord_flip()+
                    labs(x="", y="", title=local_symb)+ 
                    theme_bw()+
                    theme(axis.ticks = element_blank()),
                width=500, height=100
            )

            observeEvent(input[[remove_id]], {
                removeUI(
                    selector = paste0("#", ele_id)
                )

                num <<- num - 1
            })
        })

        if (num == 0) {
            shinyjs::show(id = "status")
        }
        else {
            shinyjs::hide(id = "status")
        }

    })

}



# Run the application 
shinyApp(ui = ui, server = server)

Answer 1

您可以创建要保存的输入对象列表（例如inputs = list(symbol=input$symb, dates=input$dates)，然后使用 saveRDS() 将该列表保存为 RDS 对象（R 自己的数据结构）：

saveRDS(inputs, "<filename>.rds")

稍后，您可以使用 readRDS() 将其加载回新会话：

inputs = readRDS("<filename>.rds")