闪亮的应用程序不反映更新RData文件中的更改

M.Q*_*sim 4 r shiny

我每天通过我的闪亮应用程序的cron作业更新我的RData文件.但是,闪亮的应用程序不会在大多数情况下选择更新并继续显示旧RData文件中的旧数据.

这是最小可重复的例子.从我的桌面执行data_processing.R时,它工作正常.但是,当它在Rshiny服务器上完成时,闪亮的应用程序不会读取更新的日期和时间戳.

data_processing.R

rm(list=ls())
df <- iris
data_update_date_time <- Sys.time()
save.image("working_dataset.RData", compress = TRUE)
Run Code Online (Sandbox Code Playgroud)

server.R

load("working_dataset.RData")

function(input, output, session) {

  # Combine the selected variables into a new data frame
  selectedData <- reactive({
    df[, c(input$xcol, input$ycol)]
  })

  clusters <- reactive({
    kmeans(selectedData(), input$clusters)
  })

  output$plot1 <- renderPlot({
    palette(c("#E41A1C", "#377EB8", "#4DAF4A", "#984EA3",
              "#FF7F00", "#FFFF33", "#A65628", "#F781BF", "#999999"))

    par(mar = c(5.1, 4.1, 0, 1))
    plot(selectedData(),
         col = clusters()$cluster,
         pch = 20, cex = 3)
    points(clusters()$centers, pch = 4, cex = 4, lwd = 4)
  })

  ## Data update date and time stamp
  output$update_date_time <- renderPrint(data_update_date_time)

}
Run Code Online (Sandbox Code Playgroud)

ui.R

pageWithSidebar(
  headerPanel('Iris k-means clustering'),
  sidebarPanel(
    selectInput('xcol', 'X Variable', names(iris)),
    selectInput('ycol', 'Y Variable', names(iris),
                selected=names(iris)[[2]]),
    numericInput('clusters', 'Cluster count', 3,
                 min = 1, max = 9),
    br(),
    h4("Date update date time"),
    textOutput("update_date_time")
  ),
  mainPanel(
    plotOutput('plot1')
  )
)
Run Code Online (Sandbox Code Playgroud)

谢谢你抽出宝贵的时间.

Gre*_*lia 7

编辑

实际上reactiveFileReader,在shiny包中调用的函数完全符合您的要求:定期检查文件"上次修改"时间或大小是否已更改并相应地重新读取.但是,此功能只能在server上下文中使用,因此对于连接到您的应用的每个用户,该文件至少会被读取一次.我的答案中的选项3和4没有这些低效率.

这里的原始答案

首先,闪亮没有办法跟踪文件变化AFAIK.您的实现.RData每次都会重新加载文件

  1. shiny-server 通过bash或重新启动
  2. 全局变量重新加载,因为应用程序在某些时候变得空闲.

当满足第二个条件时,没有办法说出来.因此,我主张使用以下四种选项之一.从易于分类你更好地了解你的闪亮!.

选项1:将load语句放在服务器中

这里,只要新用户与应用程序连接,就会重新加载图像.但是,如果您的.RData文件很大,这可能会降低您的应用速度.如果速度不是问题,我会选择这个解决方案,因为它简单而干净.

# server.R
function(input, output, session) {
  load("working_dataset.RData")
  ...
}
Run Code Online (Sandbox Code Playgroud)

每当用户刷新页面时,也会重新读取数据(F5)

选项2:每当要重新导入数据时,重新启动shiny-server

(另见@shosacos答案).这会强制.Rdata重新加载文件.

$ sudo systemctl restart shiny-server
Run Code Online (Sandbox Code Playgroud)

同样,这可能会降低您的制作流程,具体取决于您的应用的复杂程度.这种方法的一个优点是,如果加载数据,您还可以使用导入的数据来构建uiglobal.R.(我假设你没有给出你给的代码).

选项3:根据"最后修改"导入

这里的想法是检查.RData用户连接到应用程序时是否已更改.为此,您必须使用包含上次导入版本的时间戳的"全局"变量.以下代码未经测试,但应该让您了解如何实现此功能.

# server.R
last_importet_timestamp <- reactiveVal("")

function(input,output,session){
  current_timestamp <- file.info(rdata_path)$mtime 

  if(last_importet_timestamp() != current_timestamp){
    # use parent.frame(2) to make data available in other sessions
    load(rdata_path, envir = parent.fame(2))
    # update last_importet_timestamp
    last_importet_timestamp(current_timestamp) 
  }

  ...
}
Run Code Online (Sandbox Code Playgroud)

速度方面,这应该比前两个版本更有效.每个时间戳永远不会导入数据一次(除非闪亮的服务器重新启动或变为空闲).

方案4:进口"反应"

基本上,与选项3相同,但文件将每隔50ms检查一次更改.以下是此方法的完整工作示例.请注意,除非检测到"上次修改"的更改,否则不会加载数据,因此产生的开销也不会太差.

library(shiny)

globalVars <- reactiveValues()

rdata_path = "working_dataset.RData"

server <- function(input, output, session){
  observe({
    text = input$text_in
    save(text = text, file = rdata_path, compress = TRUE)
  })
  observe({
    invalidateLater(50, session)
    req(file.exists(rdata_path))
    modified <- file.info(rdata_path)$mtime
    imported <- isolate(globalVars$last_imported)
    if(!identical(imported, modified)){
      tmpenv <- new.env()
      load(rdata_path, envir = tmpenv)
      globalVars$workspace <- tmpenv
      globalVars$last_imported <- modified
    }
  })
  output$text_out <- renderText({
    globalVars$workspace$text
  })
}

ui <- fluidPage(
  textInput("text_in", "enter some text to save in Rdata", "default text"),
  textOutput("text_out")
)

shinyApp(ui, server)
Run Code Online (Sandbox Code Playgroud)

如果您发现使用起来不方便globalVars$workspace$text,可以直接with访问内容globalVars$workspace.

  output$text_out <- renderText({
    with(globalVars$workspace, {
      paste(text, "suffix")
    })
  })
Run Code Online (Sandbox Code Playgroud)