时间戳

首页 > 解决方案 > R Shiny Promise/Future Blocks 进程

r - R Shiny Promise/Future Blocks 进程

问题描述

future尽管尝试使用 async +promises策略，但我无法弄清楚我的脚本逻辑中导致 Shiny 进程阻塞的错误。

我有这个（简化的）服务器脚本。它原则上有效，但我没有体验并行化。我模拟 2 个同时触发，第二个触发事件等到第一个触发事件解决。

你能指出这里有什么问题吗？我已经阅读了几本手册，但我仍然很难确定逻辑。

最小示例，一个单文件 Shiny 应用程序：

## load libs

library(shiny)
library(DT)
library(ggplot2)

ui <- navbarPage(
     tabPanel(
          "Новостные тренды"
          , sidebarLayout(
               sidebarPanel(
                    br()
                    , actionButton(
                         "run_trends"
                         , label = "run"
                         , style="color: #fff; background-color: #337ab7; border-color: #2e6da4"
                    )
                    , br()
               )
               , mainPanel(
                    textOutput("trends_time")
                    , br()
                    , br()
                    , plotOutput('trend_plotly')
                    , br()
                    , p("results")
                    , br()
                    , DTOutput('trend_tbl')
                    , br()
                    , br()
               )
          )
     )
)

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

     dt_trend <- observeEvent(
          input$run_trends,
          {

               ## load libs

               library(data.table)
               library(ggplot2)
               library(promises)
               library(future)

               plan(multiprocess)

               dat_func <- function()
               {

                    start_time <- Sys.time()

                    dt <- data.table(x = rnorm(100), y = rnorm(100))

                    trendy_tbl <- head(dt, 10)

                    ggplo1 <- ggplot(dt) + geom_point(aes(x=x,y=y))

                    Sys.sleep(10)

                    list(
                         trendy_tbl
                         , ggplo1
                         , paste0('time: ', round(Sys.time() - start_time), ' сек.')
                    )
               }

               f <- future({
                    dat_func()
               })

               #res <- future::value(f)

               output$trend_tbl <- renderDT({future::value(f)[[1]]})

               output$trend_plotly <- renderPlot({future::value(f)[[2]]})

               output$trends_time <- renderText({future::value(f)[[3]]})

          })

}



# Return a Shiny app object
shinyApp(ui = ui, server = server, options = list(port = 4600, host = '0.0.0.0'))

标签： rshinypromise

解决方案

尝试这个：

library(data.table)
library(ggplot2)
library(promises)
library(future)

plan(multiprocess)

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

     dt_trend <- eventReactive(
          input$run_trends,
          {
               dat_func <- function() {

                    start_time <- Sys.time()
                    dt <- data.table(x = rnorm(100), y = rnorm(100))
                    trendy_tbl <- head(dt, 10)
                    ggplo1 <- ggplot(dt) + geom_point(aes(x=x,y=y))
                    Sys.sleep(10)
                    list(
                         trendy_tbl
                         , ggplo1
                         , paste0('time: ', round(Sys.time() - start_time), ' сек.')
                    )
               }

               # Returning future
               future({
                    dat_func()
               })
     })

     output$trend_tbl <- renderDT({dt_trend()[[1]]})
     output$trend_plotly <- renderPlot({dt_trend()[[2]]})
     output$trends_time <- renderText({dt_trend()[[3]]})

}

关键思想是：

  • 确保使用shiny引入异步支持的 > 1.1.0（2018 年 4 月）版本。
  • 不要使用future::value它，因为它会阻塞并等待未来，这正是我们想要避免的。
  • 相反，在 a 中返回未来reactive。在这种情况下，这意味着使用eventReactive而不是observeEvent。
  • 通过反应式访问未来的价值。请注意，您的反应价值现在是未来！这意味着您需要使用未来的处理程序来使用该值。(*)
  • 您还可以在任何renderXXX函数中返回未来。例如，如果您有大量耗时的图，则很有用。

(*) 在实践中，这意味着你需要做

renderDT(dt_trend() %>% then(~.[[1]]))
# or 
renderDT(dt_trend() %>...% `[[`(1))

wherethen来自promises包，[[是来自基础 R 的子集函数（x[[i]]实际上是语义糖`[[`(x, i)！）。

在您的示例中，您基本上在单个futurein 中计算所有内容dt_trend。您可能要考虑使用多个小型期货。您可以将数据加载到具有未来的反应式中，然后将输出代码保留在您的函数中，如果需要，可以renderXXX将其包装在 a 中。future

有一个很好的小插曲，通过运行vignette("shiny", package = "promises")(**) 使用带有闪亮可用的承诺。它也可以在cran或rstudio 博客上在线获得。

(**) 如果您使用 安装了 Promise install_github("rstudio/promises")，您很可能必须先重新安装build_vignettes = TRUE。

推荐阅读