R Shiny 中的反应变量和输入：保存所有内容，但不是每次都保存

Question

我正在将功能写入我闪亮的应用程序，以自动备份用户所做的一切，以防应用程序崩溃、断电或任何其他形式的故障。

我当时的设想是这样的：在一个有数百个输入、输出和反应值的应用程序中，我想编写一个通用函数来保存它们中的每一个，因为在值更改的任何地方添加一个保存代码行将是太多的工作，并且容易导致错误.到目前为止，这使我观察到一种反应值的列表：

使用 reactiveValuesToList(input) 或对来自

的所有值使用相同的方法

values <- reactiveValues(values)

所以，我得到了这段代码：

observeEvent(reactiveValuesToList(input), { 
## set your output directory here to save in
## Shorten the list to only apply save RDS to the one that has changed.... 
  lapply(names(reactiveValuesToList(input)), function(item) {
    saveRDS(input[[item]], paste("Test", "values", item, "rds", sep = '.'))
  })

})

此代码可以插入任何标准的 shiny App 进行测试。

好的是，只要列表中的任何内容发生变化，此代码就会保存所有内容，但这也是问题所在。如果 100 个变量中有 1 个发生变化，此代码会将所有 100 个变量保存到用户为此分配的文件夹中。

当变量都非常小时（如 True/False 状态，没问题），但我的应用程序例如处理几十个 1-5000 万数据点的文件，每个文件大约需要 20 秒保存。这将导致这样一种情况，即任何变量的 EACH 更改，如果不是半小时，也会导致许多分钟的保存循环。显然是可笑的。

我考虑过将以前的reactiveValuesToList与新的进行比较，一项一项地确定哪个发生了变化，然后保存那个，但是比较时间也太长了。在我的 12GB 笔记本电脑上比较 2 个约 3000 万值的数据帧是否需要大约 1 秒，如果你必须做几十个的话，仍然太多了。使用这种方法，每次在应用程序中的任何位置单击按钮都会导致一分钟或几分钟的等待时间，每次...

所以，我正在寻找一个解决方案，Shiny 会很快知道 reactiveValue/input/outputs 列表中最后更改的项目是什么，并且只保存该变量。

一个可以在每次更改时保存所有内容的工作测试应用程序。

library(shiny) 

rm(list = ls(), envir = globalenv())              ## to prevent cross over from old runs

ui <- dashboardPage(
  dashboardHeader(title = "Dummy App"),
  dashboardSidebar(
    sidebarMenu(id = "tabs",
                menuItem("Page", tabName = "page1", icon = icon("pie-chart"))
    ) ),
  dashboardBody(
    tabItems(

      tabItem(tabName = 'page1',
              fluidRow(
                uiOutput("BatchName"),

                actionButton(inputId = "button1", label = "button"),
                br(),
                verbatimTextOutput("testing")
              )))))



server <- function(input, output, session) {
  values <- reactiveValues(pressed = F)

  output$BatchName <- renderUI({ textInput(inputId ="BatchName", label = NULL , placeholder = "start") })

  observeEvent(input$button1, { 
  outputOptions(output, "BatchName", suspendWhenHidden = FALSE)  ## without this line updating elements on page 2 and higher doesn't work as they are suspenWhenHidden = True by default
  updateTextInput(session, inputId = "BatchName", value = "Updated") 
  values$pressed <- !values$pressed
  })

  observeEvent(reactiveValuesToList(input), { 
    ## set your output directory here to save in
    ## Shorten the list to only apply save RDS to the one that has changed.... 
    lapply(names(reactiveValuesToList(input)), function(item) {
      print(item)
      saveRDS(input[[item]], paste("Test", "values", item, "rds", sep = '.'))
      if (values$pressed == T) { 
      output$testing <- renderText({'saving'}) } else {
        output$testing <- renderText({'saved?'}) }
        })
      })
  }
shinyApp(ui, server)

Answer 1

这是一个为每个输入创建一个单独的观察者的模式。但是，函数 create_observers 要求您明确发送要观察的所有值的列表，这对于动态创建输入的大型应用程序可能不方便。

create_observers <- function(names, input){
  lapply(names, function(item){   
    observeEvent({input[[item]]},{
      message("observing ", item)
      saveRDS(input[[item]], paste("Test", "values", item, "rds", sep = '.'))
    })
  })
}


server <- function(input, output, session){
  create_observers(c("text", "slider"), input)
}

ui <- fluidPage(
  textInput("text", "text"),
  sliderInput("slider", "slider", 0, 1, .5, .1)
)

shinyApp(ui, server)

EDIT ：这是一个更复杂的示例，其中观察到的输入列表每 5 秒更新一次。 update函数只依赖于names(input)，所以处理时间应该不会太长。

server <- function(input, output, session){
  inputNames <- reactiveVal()

  observe({
    invalidateLater(5000)
    message("update observers")

    isolate({
      input_names <- names(input)
      new_inputs <- setdiff(input_names, inputNames())
      create_observers(new_inputs, input)
      inputNames(input_names)
    })
  })
}

ui <- fluidPage(
  textInput("text", "text"),
  sliderInput("slider", "slider", 0, 1, .5, .1)
)

shinyApp(ui, server)

Answer 2

@gregor de cillia，这是我自己同时建造的。在 lapply 样式中查看输入和值列表，并使用另一个列表应用该列表的观察者。不过，还不能 100% 确定这是否在所有正确的地方都有隔离物。它有一些 if 语句与用户首先必须选择一个文件夹，然后我的应用程序在其中设置备份子文件夹这一事实有关。

  observe({
    lapply(c('input', 'values'), function(x) { 
      req(values$OutputDir)
      # req(values$BatchName)
      if (dir.exists(values$OutputDir)) {
  observe({ lapply(names(reactiveValuesToList(eval(parse(text = x)))), function(item) { 
    isolate({ values[[paste("itemlist", x, sep = '.')]]<- isolate(names(reactiveValuesToList(eval(parse(text = x))))) })
  })  }) 
      } })
  })

  observe({
    lapply(c('input', 'values'), function(x) { 
      req(values$OutputDir)
      # req(values$BatchName)
      if (dir.exists(values$OutputDir)) {
       observe( { lapply(isolate(values[[paste("itemlist", x, sep = '.')]]) , function(item){
            observeEvent(input[[item]], { 
              if (values$useAutoSave == T) {
                setwd(values$OutputDir)
                print(paste("saving ", paste("TestBatch", x, item, 'rds', sep = '.')))
                # print(eval(parse(text = x))[[item]])
              saveRDS(eval(parse(text = x))[[item]], paste("TestBatch", x, item, 'rds', sep = '.'))
                } })
          })  }) 
        }  }) })

R Shiny 中的反应变量和输入：保存所有内容，但不是每次都保存

Reactive variables and input in R Shiny: Save everything, but not every time

r

save

shiny

reactive