R Shiny promise/future blocks process

问题

I cannot figure out the fault in my script's logic that causes Shiny process blocking despite trying to use async future + promises strategy.

I have this (simplified) server script. It works in principle, but I don't experience parallelization. I simulate 2 simultaneous triggering and the second triggering event waits until the first one resolves.

Can you please indicate what is wrong here? I have read several manuals, but I still find it hard to nail down the logic.

Minimal Example, a one-file Shiny app:

## 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'))

回答1:

Try this:

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]]})

}

The key ideas are:

Make sure you use shiny version > 1.1.0 (April 2018) which introduced async support.
do NOT use future::value as it blocks and waits for the future, precisely what we want to avoid.
instead, return the future in a reactive. In this case, this means using eventReactive instead of observeEvent.
Access the value of the future via the reactive. Note that your reactive value is now a future! This means you need to use future handlers to use the value. (*)
You can also return a future in any renderXXX function. Useful for example if you have large time-consuming plots.

(*) In practice, this means you need to do

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

where then is from the promises package and [[ is the subsetting function from base R (x[[i]] is actually semantic sugar for`[[`(x, i) !).

In your example, you basically compute everything in a single future in dt_trend. You may want to consider using multiple small futures instead. You can load the data in a reactive with a future, then keep the output code in your renderXXX functions, wrapped in a future if needed.

There is a good vignette on using promises with shiny available by running vignette("shiny", package = "promises")(**). It is also available online on cran or on the rstudio blog.

(**) If you installed promises with install_github("rstudio/promises"), you most likely have to re-install with build_vignettes = TRUE first.

来源：https://stackoverflow.com/questions/57694226/r-shiny-promise-future-blocks-process

标签

Shiny

promise