I have a shiny app that uses a function to generate N number of plots (in this example 10).

Rather than use a map to create all 10 charts at the same time, below I am trying to use the futures package to render each plot one by one as they are ready.

library(shiny)
library(plotly)
library(purrr)
library(future)
library(promises)

# Enable parallel processing
plan(multisession)

# Generate 10 titles
titles <- paste0("Chart", 1:10)

# Create the list of lists
charts <- map(titles, ~ list(title = .x)) %>%
  setNames(titles)

chart_func <- function(title) {
  Sys.sleep(runif(1, 0.5, 2))  # Simulate some computation time
  plotly::plot_ly() %>%
    layout(
      title = title
    )
}

ui <- fluidPage(
  actionButton("make_plots", "Make Plots"),
  uiOutput("all_plots")
)

server <- function(input, output, session) {
  
  # Define plot names
  plot_names <- names(charts)
  
  # Render the UI with placeholders for all plots
  output$all_plots <- renderUI({
    purrr::map(plot_names, ~tags$div(class = "single-plot", plotlyOutput(.x)))
  })
  

  # Generate plots asynchronously upon button click
  observeEvent(input$make_plots, {
    
    map(charts, function(chart) {
      future({
        chart_func(chart$title)
      }, seed = TRUE) %...>% { result ->
        output[[chart$title]] <- renderPlotly({
          result
        })
      }
    })
    
  })
}

shinyApp(ui, server)

This code is close but I am getting errors and unsure what to try next. I know that method chaining is correct I just need some help with the output.

I have a shiny app that uses a function to generate N number of plots (in this example 10).

Rather than use a map to create all 10 charts at the same time, below I am trying to use the futures package to render each plot one by one as they are ready.

library(shiny)
library(plotly)
library(purrr)
library(future)
library(promises)

# Enable parallel processing
plan(multisession)

# Generate 10 titles
titles <- paste0("Chart", 1:10)

# Create the list of lists
charts <- map(titles, ~ list(title = .x)) %>%
  setNames(titles)

chart_func <- function(title) {
  Sys.sleep(runif(1, 0.5, 2))  # Simulate some computation time
  plotly::plot_ly() %>%
    layout(
      title = title
    )
}

ui <- fluidPage(
  actionButton("make_plots", "Make Plots"),
  uiOutput("all_plots")
)

server <- function(input, output, session) {
  
  # Define plot names
  plot_names <- names(charts)
  
  # Render the UI with placeholders for all plots
  output$all_plots <- renderUI({
    purrr::map(plot_names, ~tags$div(class = "single-plot", plotlyOutput(.x)))
  })
  

  # Generate plots asynchronously upon button click
  observeEvent(input$make_plots, {
    
    map(charts, function(chart) {
      future({
        chart_func(chart$title)
      }, seed = TRUE) %...>% { result ->
        output[[chart$title]] <- renderPlotly({
          result
        })
      }
    })
    
  })
}

shinyApp(ui, server)

This code is close but I am getting errors and unsure what to try next. I know that method chaining is correct I just need some help with the output.

• r
• shiny
• parallel-processing

1 Answer 1

To unblock the session calculating the plots you'll need to wrap the future with shiny::ExtendedTask(). Using future or future_promise without ExtendedTask will only unblock concurrent shiny sessions - please see this related but closed issue.

Please check ?shiny::ExtendedTask:

The ExtendedTask class allows you to have an expensive operation that is started by a reactive effect, and whose (eventual) results can be accessed by a regular observer, calc, or output; but during the course of the operation, the current session is completely unblocked, allowing the user to continue using the rest of the app while the operation proceeds in the background.

Applied to your example:

library(shiny)
library(plotly)
library(purrr)
library(future)
library(promises)
library(bslib)

# Enable parallel processing
plan(multisession)

# Generate 10 titles
titles <- paste0("Chart", 1:10)

# Create the list of lists
charts <- map(titles, ~ list(title = .x)) %>%
  setNames(titles)

chart_func <- function(title) {
  Sys.sleep(runif(1, 0.5, 2))  # Simulate some computation time
  plotly::plot_ly(type = "scatter", mode = "markers") %>%
    layout(
      title = title
    )
}

ui <- fluidPage(
  input_task_button("make_plots", "Make Plots"),
  uiOutput("all_plots")
)

server <- function(input, output, session) {
  # Define plot names
  plot_names <- names(charts)
  
  compute_plot <- ExtendedTask$new(function(chart) {
    future_promise({
      list(title = chart$title, plotly_obj = chart_func(chart$title))
    }, seed = TRUE)
  }) |> bind_task_button("make_plots")
  
  # Render the UI with placeholders for all plots
  output$all_plots <- renderUI({
    purrr::map(plot_names, ~tags$div(class = "single-plot", plotlyOutput(.x)))
  })
  
  # Generate plots asynchronously upon button click
  observeEvent(input$make_plots, {
    map(charts, function(chart) {
      compute_plot$invoke(chart)
    })
  })
  
  observeEvent(compute_plot$result(), {
    output[[compute_plot$result()$title]] <- renderPlotly({
      isolate(compute_plot$result()$plotly_obj)
    })
  })
}

shinyApp(ui, server)

Please also check this related article.