并行渲染与承诺混淆

Parallel rendering with promises confusion

提问人：akshay bholee 提问时间：8/24/2022 更新时间：8/24/2022 访问量：58

问：

我已经尝试了这个有和没有未来的例子，我删除了 10 秒的等待时间。通常，并行性应该比没有未来的并行性更快，但事实并非如此。

这是没有 future 的脚本运行的 reactlog：enter image description here

这是带有未来的脚本的 reactlog：enter image description here

您将看到，与没有未来的并行运行的相比，在并行运行的上渲染花费了更多时间。渲染未来又花了 1 秒钟。我对此感到困惑。我想在我的大应用程序上实现它，但似乎我还不明白它是如何工作的要点。

你能帮我理解为什么与另一个相比，未来的渲染速度更慢吗？

这是 future 的脚本：

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

plan(multisession)

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 <- 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))
       
        list(
          trendy_tbl
          , ggplo1
          , paste0('time: ', round(Sys.time() - start_time), ' сек.')
        )
      }
      
      # Returning future
      future({
        dat_func()
      })
    })
  
  output$trend_tbl <- renderDT({dt_trend() %>% then(~.[[1]])})
  output$trend_plotly <- renderPlot({dt_trend() %>% then(~.[[2]])})
  output$trends_time <- renderText({dt_trend() %>% then(~.[[3]])})
  
}


shinyApp(ui, server)

这是没有未来的脚本，运行速度更快：

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) {

  observeEvent(
    input$run_trends,{
      start_time <- Sys.time()
      dt <- data.table(x = rnorm(100), y = rnorm(100))
      output$trend_tbl <- renderDT({head(dt, 10)})
      output$trend_plotly <- renderPlot({ggplot(dt) + geom_point(aes(x=x,y=y))})
      output$trends_time <- renderText({paste0('time: ', round(Sys.time() - start_time), ' сек.')})
    })
  
}

shinyApp(ui, server)
R 闪亮 承诺 并行处理

评论

答：

1赞 starja 8/24/2022 #1

这是因为启动了一个新的 R 进程，在该进程中评估其代码。这需要一些时间，在你的示例中，这比仅仅将其保留在执行闪亮应用的主 R 进程中要花费更多的时间。future

我稍微更改了您的示例，以显示使用可以节省时间的地方。当单击时，它会执行两个 s，其中每个 s 都有一个 .没有的版本需要 10 秒，而并行版本要快一点（至少在我的系统上）。futureeventReactiveactionButtonSys.sleep(5)future

承诺的文档提到了以下内容：

虽然承诺可以对 Shiny 应用程序的可伸缩性产生巨大影响，但它们对单个会话的延迟影响相对较小。[...]Promise 只会帮助防止其他会话因一个会话的计算而减慢速度。（例外情况是，如果 Shiny 应用程序有几个不同的长计算，这些计算彼此之间不太依赖，那么您可以使用异步编程来利用一点并行性。[...])

因此，如果使用有意义，您应该测试您的用例。promises

单个进程（我更改了类似于版本的结构）：promises

library(shiny)
library(DT)
library(ggplot2)
library(data.table)

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

server <- function(input, output, session) {
  
  dt_trend <- eventReactive(
    input$run_trends,
    {
      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(5)
      list(
        trendy_tbl
        , ggplo1
        , paste0('time: ', round(Sys.time() - start_time, 5), ' сек.')
      )
    })
  
  dt_trend_2 <- eventReactive(
    input$run_trends,
    {
      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(5)
      list(
        trendy_tbl
        , ggplo1
        , paste0('time: ', round(Sys.time() - start_time, 5), ' сек.')
      )
    })
  
  output$trend_tbl <- renderDT({dt_trend()[[1]]})
  output$trend_plotly <- renderPlot({dt_trend_2()[[2]]})
  
}

shinyApp(ui, server)

promises版本：

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

plan(multisession)

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

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(5)
        list(
          trendy_tbl
          , ggplo1
          , paste0('time: ', round(Sys.time() - start_time, 5), ' сек.')
        )
      }
      
      # Returning future
      future({
        dat_func()
      })
    })
  
  dt_trend_2 <- 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(5)
        list(
          trendy_tbl
          , ggplo1
          , paste0('time: ', round(Sys.time() - start_time, 5), ' сек.')
        )
      }
      
      # Returning future
      future({
        dat_func()
      })
    })
  
  output$trend_tbl <- renderDT({dt_trend() %>% then(~.[[1]])})
  output$trend_plotly <- renderPlot({dt_trend_2() %>% then(~.[[2]])})
  
}


shinyApp(ui, server)

评论

0赞 akshay bholee 8/24/2022
谢谢starja的澄清。还有一件事。如果我将应用程序发布到 shinyapps.io 服务器，此功能是否正常工作，或者我必须在 shinyapps.io 服务器上进行一些配置？
0赞 starja 8/24/2022
我不知道。我可以想象（至少对于免费用户）它不起作用，我发现例如：github.com/rstudio/rsconnect/issues/488

上一个：ggplotly 显示 ggplot 分区统计图丑陋

下一个：运行有承诺的闪亮模块