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 = '.'))
  })

})

此代码可以插入任何标准的闪亮应用程序进行测试。

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

当变量都非常小时（如真/假状态，没问题），但我的应用程序可以处理数十万个数据点的数十个文件，每个文件大约需要20秒才能保存。这将导致一个场景，其中每次更改ANY变量，如果不是半小时，则导致许多分钟的保存循环。显然很荒谬。

我考虑将之前的reactiveValuesToList与新的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)逐项进行比较，以确定哪些已更改，并保存该更改，但比较时间也过长。比较我的12GB笔记本电脑上2个数据帧的大约30个数据帧是否大约需要1秒，如果你需要做几十个，仍然太多了。使用这种方法，每次按下应用程序中的任何按钮都会导致每分钟等待一分钟或几分钟......

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

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

{{1}}

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)

编辑：这是一个更复杂的例子，其中观察到的输入列表每5秒更新一次。更新功能仅取决于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样式查看输入和值列表，并使用另一个listapply为该列表创建观察者。然而，不是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中的反应变量和输入：保存所有内容，但不是每次都保存

2 个答案: