Parallel rendering with promises confusion

Question

I have tried this example with and without the future and I removed the wait time of 10 seconds. Normally the parallelism should have been quicker than the one without future but it's not the case.

This is the reactlog for the script run without future:

This is the reactlog for the script with the future:

You will see that it took more time to render on the one which is running in parallel compared to the one without future. It took 1 second more to render with the future. I am confused about this. I wanted to implement this on my big application but it seems I don't get the gist yet of how it is working.

Can you help me understand why the rendering is slower with the future compared to the other one?

this is the script with 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)

This the script without future which run faster:

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)

user_12647315 · Answer

It is because future starts a new R process in which its code is evaluated. This takes some time, in your example more time than just keeping it in the main R process in which the shiny app is executed.

I've changed your example a little bit to show where the use of future can save time. It executes two eventReactives when the actionButton is clicked where each has a Sys.sleep(5). The version without future needs 10s, whereas the parallel version is a little bit faster (at least on my system).

The documentation of promises mentions the following:

While promises can make a huge difference in the scalability of a Shiny app, they make relatively little difference in the latency of a single session. [...] Promises will just help prevent other sessions from being slowed down by one session’s computations. (The exception to this is if the Shiny app has several distinct long computations that don’t depend very much on each other—then you could use asynchronous programming to exploit a little parallelism.[...])

So you should test for your usecase if using promises makes sense.

Single process (I've changed the structure similar to the promises version):

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 version:

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)

Parallel rendering with promises confusion

1 Answers