Question

应该可以使用R包future和promises通过Shiny应用程序触发异步（长时间运行）处理，而不会冻结应用程序的其余部分，而异步进程在另一个R中运行过程

见：

https://cran.r-project.org/web/packages/promises/vignettes/intro.html
https://cran.r-project.org/web/packages/promises/vignettes/overview.html
https://cran.r-project.org/web/packages/promises/vignettes/futures.html
https://cran.r-project.org/web/packages/promises/vignettes/shiny.html

我在基于R脚本的环境中使用它，但是当我实现一个带有2个函数的简单闪亮应用程序时，无法使其工作。＆＃34;非异步＆＃34;在async函数运行时，函数总是被阻塞，但情况并非如此。

我在包promises的GitHub回购中发布了相同的问题：https://github.com/rstudio/promises/issues/23

我在这里发帖，希望有人可以提供帮助。

问题是：

您能否看一下下面发布的闪亮应用示例，让我知道为什么异步处理会阻止该应用？（它不应该阻止）。
理想情况下，您是否可以提供一个具有非阻塞异步和正常功能的应用程序的小示例（在异步运行时可以访问）？

环境

Mac OS 10.12

$ R --version
R version 3.4.3 (2017-11-30) -- "Kite-Eating Tree"

remove.packages("future")
remove.packages("promises")
remove.packages("shiny")

install.packages("future")
install.packages("devtools")
devtools::install_github("rstudio/promises")
devtools::install_github("rstudio/shiny")

> packageVersion("future")
[1] ‘1.8.1’
> packageVersion("promises")
[1] ‘1.0.1’
> packageVersion("shiny")
[1] ‘1.0.5.9000’

关于闪亮软件包版本的一个问题，https://rstudio.github.io/promises/articles/intro.html说它应该是＆gt; = 1.1，但即使使用devtools安装，版本仍然是1.0.5 ....这是一个问题还是文档中有拼写错误？

首先，您可以使用带有Shiny输出的promises。如果您使用的是异步兼容版本的Shiny（版本＆gt; = 1.1），则所有内置的renderXXX函数都可以处理常规值或承诺。

问题示例

我已经实现了这个简单闪亮的应用程序，其灵感来自上面提到的URL中的示例。闪亮的应用程序有2个＆＃34;部分＆＃34;：

一个按钮，用于触发＆＃34;长时间运行＆＃34;异步处理。这是由函数read_csv_async模拟的，它休眠几秒钟，将csv文件读入数据帧。然后将df渲染到按钮下方。
一个应该随时工作的简单功能（包括触发异步处理时）：它包含一个滑块，用于定义要生成的多个随机值。然后我们渲染这些值的直方图。

问题是在执行异步处理时会阻止第二个功能（直方图更新）。

global.R

library("shiny")
library("promises")
library("dplyr")
library("future")

# path containing all files, including ui.R and server.R
setwd("/path/to/my/shiny/app/dir")   

plan(multiprocess)

# A function to simulate a long running process
read_csv_async = function(sleep, path){
      log_path = "./mylog.log"
      pid = Sys.getpid()
      write(x = paste(format(Sys.time(), "%Y-%m-%d %H:%M:%OS"), "pid:", pid, "Async process started"), file = log_path, append = TRUE)
      Sys.sleep(sleep)
      df = read.csv(path)
      write(x = paste(format(Sys.time(), "%Y-%m-%d %H:%M:%OS"), "pid:", pid, "Async process work completed\n"), file = log_path, append = TRUE)
      df
}

ui.R

fluidPage(
  actionButton(inputId = "submit_and_retrieve", label = "Submit short async analysis"),
  br(),
  br(),
  tableOutput("user_content"),

  br(),
  br(),
  br(),
  hr(),

  sliderInput(inputId = "hist_slider_val",
              label = "Histogram slider",
              value = 25, 
              min = 1,
              max = 100),

  plotOutput("userHist")
)

server.R

function(input, output){
    # When button is clicked
    # load csv asynchronously and render table
    data_promise = eventReactive(input$submit_and_retrieve, {
        future({ read_csv_async(10, "./data.csv") }) 
    })
   output$user_content <- renderTable({
     data_promise() %...>% head(5)
    })


  # Render a new histogram 
  # every time the slider is moved
  output$userHist = renderPlot({
    hist(rnorm(input$hist_slider_val))
  })
}

data.csv

Column1,Column2
foo,2
bar,5
baz,0

谢谢！

Answer 1

所以这种行为是正常的，请参阅https://github.com/rstudio/promises/issues/23

的软件包开发人员的响应

<强>要点：

在闪亮的应用中，一个R进程可以由多个用户共享。如果一个用户提交长时间运行的任务，则阻止共享相同底层R进程的所有其他用户。 promises的目标是避免这种情况。因此promises将阻止＆＃34;用户会话之间的阻塞＆＃34;在一个R流程中但不在单个＆＃34;用户会话中＃34;。

该软件包的作者提到尚未不支持此功能，如果有足够的人要求，可能会添加该功能。如果您正在寻找此问题，请转到GitHub问题并与原始问题一样 - 这是衡量新功能的兴趣所在。

谢谢！

Answer 2

由于有关会话期间响应能力强的这个或类似问题是frequently asked on stackoverflow，我认为值得一提的解决方法郑乔在GitHub issue创建的@Raphvanns中提供：

如果您确实必须有这种行为，那么有一种工作方法   周围。您可以从Shiny会话中“隐藏”异步操作   （允许会话继续其事件循环）不返回   您的观察者/反应性代码中的诺言链。本质上   异步操作变成了“一劳永逸”。您需要连接一个   承诺处理程序有一些副作用；在下面的示例中，我将   成功完成后会创建一个reactVal。

对此方法有一些警告：


通过此操作，您可以天生就开放自己参加比赛   条件。即使在这个非常简单的示例中，用户也可以点击   多次提交按钮；如果长期运行的任务非常   变量运行时，您可能最终会返回多个结果，   但是出故障了或者，如果您在promise中引用input值   处理程序，他们可能会选择提交后设置的值   按钮被点击了！

您还会丢失自动半透明   表示输出无效（尽管在I下方   在reactiveVal的开头至少使observeEvent无效。

因此，上述示例代码的解决方案可以是这样的：

library("shiny")
library("promises")
library("dplyr")
library("future")

# path containing all files, including ui.R and server.R
# setwd("/path/to/my/shiny/app/dir")

write.csv(data.frame(stringsAsFactors=FALSE,
                     Column1 = c("foo", "bar", "baz"),
                     Column2 = c(2, 5, 0)
), file = "./data.csv")

onStop(function() {
  file.remove("./data.csv")
})

plan(multiprocess)

# A function to simulate a long running process
read_csv_async = function(sleep, path){
  log_path = "./mylog.log"
  pid = Sys.getpid()
  write(x = paste(format(Sys.time(), "%Y-%m-%d %H:%M:%OS"), "pid:", pid, "Async process started"), file = log_path, append = TRUE)
  Sys.sleep(sleep)
  df = read.csv(path)
  write(x = paste(format(Sys.time(), "%Y-%m-%d %H:%M:%OS"), "pid:", pid, "Async process work completed\n"), file = log_path, append = TRUE)
  df
}

ui <- fluidPage(
  textOutput("parallel"),
  sliderInput(inputId = "hist_slider_val",
              label = "Histogram slider",
              value = 25, 
              min = 1,
              max = 100),
  plotOutput("userHist"),
  actionButton(inputId = "submit_and_retrieve", label = "Submit short async analysis"),
  tableOutput("user_content")
)

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

  data_promise <- reactiveVal()

  # When button is clicked
  # load csv asynchronously and render table
  observeEvent(input$submit_and_retrieve, {
    future({ read_csv_async(10, "./data.csv") }) %...>% data_promise()
    return(NULL) # hide future
  })

  output$user_content <- renderTable({
    req(data_promise())
    head(data_promise(), 5)
  })

  # Render a new histogram 
  # every time the slider is moved
  output$userHist = renderPlot({
    hist(rnorm(input$hist_slider_val))
  })

  output$parallel <- renderText({
    invalidateLater(300)
    paste("Something running in parallel:", Sys.time())
  })

}

shinyApp(ui = ui, server = server)

请注意return(NULL)调用中的observeEvent以隐藏未来。这样，长时间运行的过程将不再阻止其他反应堆的执行。

异步进程阻止R Shiny app

环境

问题示例

2 个答案: