r - 如何让 UI 响应 for 循环中的 react 值？

Question

我正在制作一个 Shiny 的应用程序，它从文件中读取，进行一些处理，并在 UI 中生成一个表格。问题是文件可能很大，分析很慢，所以处理表可能需要很长时间(经常是几分钟，也可能是半小时)。我想显示一个部分表，并在每次计算新行时添加到它，以便用户可以看到生成的数据。

我正在使用响应值来存储数据以制作表格，然后使用 renderTable() 渲染表格

下面是问题的说明(出于清洁原因，这不是我的实际代码，但它可以作为说明)

library(shiny)

ui <- fluidPage(
  titlePanel("title"),
  sidebarLayout(
    sidebarPanel(
      actionButton(inputId = "button", label = "make table")
    ),
    mainPanel(
      uiOutput("table")
    )
  )
)

makeTable <- function(rv){
  data = c(1:10)
  withProgress({
    for(i in 1:5){
      d = runif(10)
      data = rbind(data, d)
      Sys.sleep(1)
      rv$table = data
      incProgress(1/5)
    }
  })
  rv$table = data
}

server <- function(input, output){
  rv = reactiveValues(table = c())

  observeEvent(input$button, {
    makeTable(rv)
  })

  output$table = renderTable(
    rv$table
  )
}

shinyApp(ui, server)

我放置了 sys.sleep(1) 以便在 5 秒内构建表。目前，尽管 rv$data = data 出现在 for 循环中，但在整个事情完成之前不会显示该表。有没有办法修改上面的代码，以便每秒添加表的行(由 for 循环的每次迭代生成)，而不是最后添加？

编辑:我应该清楚地表明文件被快速读入(在按下生成表按钮之前)，较长的部分是 for 循环内的处理(这取决于文件的大小)。我在读取或写入文件时没有遇到问题 - 我想知道是否有办法在 for 循环中分配 rv$table = data ，并在循环仍在运行时将更改反射(reflect)在 UI 中(并且在一般来说，如何使循环中的任意 UI 和响应值以这种方式运行)

Answer 1

我会将处理部分从您 Shiny 的应用程序中分离出来，以使其保持响应(R 是单线程的)。

这是一个在通过 library(callr) 创建的后台 R 进程中连续写入文件的示例.然后您可以通过 reactiveFileReader 读取文件的当前状态。 .

编辑:如果你想以 session 方式开始文件处理，只需放置 r_bg()调用server功能(见我的评论)。此外，当前的处理是按行进行的。在您的实际代码中，您应该考虑改为批量处理数据(n 行，对您的代码来说是合理的)

library(shiny)
library(callr)

processFile <- function(){

  filename <- "output.txt"

  if(!file.exists(filename)){
    file.create(filename)
  }

  for(i in 1:24){
    d = runif(1)
    Sys.sleep(.5)
    write.table(d, file = filename, append = TRUE, row.names = FALSE, col.names = FALSE)
  }

  return(NULL)
}


# start background R session ----------------------------------------------
rx <- r_bg(processFile)


# create shiny app --------------------------------------------------------

ui <- fluidPage(
  titlePanel("reactiveFileReader"),
  sidebarLayout(
    sidebarPanel(
    ),
    mainPanel(
      uiOutput("table")
    )
  )
)

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

  # rx <- r_bg(processFile) # if you want to start the file processing session-wise

  readOutput <- function(file){
    if(file.exists(file)){
      tableData <- tryCatch({read.table(file)}, error=function(e){e}) 
      if (inherits(tableData, 'error')){
        tableData = NULL
      } else {
        tableData
      }
    } else {
      tableData = NULL
    }
  }

  rv <- reactiveFileReader(intervalMillis = 100, session, filePath = "output.txt", readFunc = readOutput)

  output$table = renderTable({
    rv()
  })

  session$onSessionEnded(function() {
    file.remove("output.txt")
  })

}

shinyApp(ui, server)

作为一种替代方法，我推荐使用库(ipc)，它可以让您在 R 进程之间建立持续的通信。另请查看我的答案 here在异步进度条上。

结果使用 library(callr) :



结果使用 library(promises) : (@antoine-sac 的代码) - 阻止 Shiny session





编辑:这是利用 library(ipc) 的另一种方法
这避免了使用 reactiveFileReader因此代码中不需要文件处理:

library(shiny)
library(ipc)
library(future)
library(data.table)
plan(multiprocess)

ui <- fluidPage(

  titlePanel("Inter-Process Communication"),

  sidebarLayout(
    sidebarPanel(
      textOutput("random_out"),
      p(),
      actionButton('run', 'Start processing')
    ),

    mainPanel(
      tableOutput("result")
    )
  )
)

server <- function(input, output) {

  queue <- shinyQueue()
  queue$consumer$start(100)

  result_row <- reactiveVal()

  observeEvent(input$run,{
    future({
      for(i in 1:10){
        Sys.sleep(1)
        result <- data.table(t(runif(10, 1, 10)))
        queue$producer$fireAssignReactive("result_row", result)
      }
    })

    NULL
  })

  resultDT <- reactiveVal(value = data.table(NULL))

  observeEvent(result_row(), {
    resultDT(rbindlist(list(resultDT(), result_row())))
  })

  random <- reactive({
    invalidateLater(200)
    runif(1)
  })

  output$random_out <- renderText({
    paste("Something running in parallel", random())
  })

  output$result <- renderTable({
    req(resultDT())
  })
}

shinyApp(ui = ui, server = server)

为了为 future 的读者清理我与@antoine-sac 的讨论:
在我的机器上使用他的代码，我确实经历了长时间运行的代码( sleep 时间)和阻塞的 UI 之间的直接互连:



然而，这样做的原因并不是因为根据操作系统或 @antoine-sac 所说的使用 docker fork 更昂贵 - 问题是缺乏可用的 worker 。如 ?multiprocess 中所述:

workers: A positive numeric scalar or a function specifying the maximum number of parallel futures that can be active at the same time before blocking.

默认值由 availableCores() 确定- 虽然在 Windows 机器上 plan(multiprocess)默认为多 session 评估。

因此，讨论是由缺乏配置和由于底层硬件而使用的不同默认值引发的。

这是重现 gif 的代码(基于 @antoine-sac 的第一个贡献):

library(shiny)
library(future)
library(promises)
plan(multiprocess)
# plan(multiprocess(workers = 10))

ui <- fluidPage(
  titlePanel("title"),
  sidebarLayout(
    sidebarPanel(
      p(textOutput("random")),
      p(numericInput("sleep", "Sleep time", value = 5)),
      p((actionButton(inputId = "button", label = "make table"))),
      htmlOutput("info")
    ),
    mainPanel(
      uiOutput("table")
    )
  )
)

makeTable <- function(nrow, input){
  filename <- tempfile()
  file.create(filename)
  for (i in 1:nrow) {
    future({
      # expensive operation here
      Sys.sleep(isolate(input$sleep))
      matrix(c(i, runif(10)), nrow = 1)
    }) %...>%
      as.data.frame() %...>%
      readr::write_csv(path = filename, append = TRUE)
  }

  reactiveFileReader(intervalMillis = 100, session = NULL,
                     filePath = filename,
                     readFunc = readr::read_csv, col_names = FALSE)
}

server <- function(input, output, session){
  timingInfo <- reactiveVal()
  output$info <- renderUI({ timingInfo() })

  output$random <- renderText({
    invalidateLater(100)
    paste("Something running in parallel: ", runif(1))
  })

  table_reader <- eventReactive(input$button, {
    start <- Sys.time()
    result <- makeTable(10, input)
    end <- Sys.time()
    duration <- end-start
    duration_sleep_diff <- duration-input$sleep
    timingInfo(p("start:", start, br(), "end:", end, br(), "duration:", duration, br(), "duration - sleep", duration_sleep_diff))
    return(result)
  })
  output$table = renderTable(table_reader()()) # nested reactives, double ()
}

shinyApp(ui, server)