Question

我正在制作一个闪亮的应用程序，它可以从文件中读取，进行一些处理并在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 =数据出现在for循环内，但直到整个过程完成后才显示该表。有没有一种方法可以修改上面的代码，以便每秒添加表行（由for循环的每次迭代生成），而不是在最后添加所有行？

编辑：我应该明确指出，文件被快速读入（在按下make table按钮之前），其中很长的一部分是for循环内的处理（取决于文件的大小）。我没有读取或写入文件的麻烦-我想知道是否有一种方法可以在for循环内分配rv $ table = data，并在循环仍在运行时将更改反映在UI中（以及一般而言，如何使循环中的任意UI和反应性值具有这种行为）

Answer 1

您需要异步功能。自v1.1+起，它就具有光泽。

promises软件包（已随shiny提供）提供了一个简单的API，可以在闪亮的环境中运行异步操作，并且设计为可以与reactives一起很好地使用。

https://rstudio.github.io/promises/articles/shiny.html

编辑：从@ismirsehregal改编的代码，经过重构，现在使用futures处理并行处理和异步结果。

library(shiny)
library(future)
plan(multiprocess)

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

makeTable <- function(nrow){
  filename <- tempfile()
  file.create(filename)
  future({
    for (i in 1:nrow) {
        # expensive operation here
        Sys.sleep(1)
        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){

  table_reader <- eventReactive(input$button, makeTable(10))
  output$table = renderTable(table_reader()()) # nested reactives, double ()
}

shinyApp(ui, server)

Answer 2

我会从闪亮的应用程序中分离处理部分，以使其保持响应状态（R为单线程）。

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

编辑：如果要按会话开始文件处理，只需将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编码）-阻止了闪亮的会话

编辑：这是利用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)

要整理我与@ antoine-sac的讨论，以供将来的读者参考：在使用他的代码的机器上，我的确在长时间运行的代码（睡眠时间）和被阻止的UI之间经历了直接的互连：

但是，这样做的原因并不是分叉成本更高，具体取决于操作系统还是使用@ antoine-sac所述的docker-问题是缺少可用的工人。如?multiprocess中所述：

workers：正数标量或指定函数的函数可同时激活的最大并行期货数量在阻止之前。

默认值是通过availableCores()确定的-尽管在Windows计算机上，plan(multiprocess)默认为多会话评估。

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

以下是用于复制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)

如何使UI响应for循环中的反应性值？

2 个答案: