rasynchronousshinymirai

Shiny make reactive() async with ExtendedTask and mirai


I have a simple shiny app where a dataset is created in a reactive() call and then plotted. As the data creation might take a while, I want it to be called async so that the session can be used otherwise. For this I want to use shiny::ExtendedTask() with mirai.

The official docs have examples where the task$invoke(...) is triggered by a button (eg inside a shiny::observeEvent()) but there are no examples for how I can structure this if my function is triggered inside a reactive().

Note that my actual use case reuses the resulting data in a couple of plots on the specific page.

Sync App MWE

The following is an MWE for a blocking app

library(shiny)
library(bslib)

create_data <- function(n) {
  Sys.sleep(2)
  data.frame(x = seq(n), y = rnorm(n))
}

ui <- page_fillable(
  card(
    card_header(span("To show reactive state, here is the current time ",
                     textOutput("current_time", inline = TRUE))),
    plotOutput("myplot")
  )
)

server <- function(input, output, session) {
  # note this reactive here should be put into an ExtendedTask
  data <- reactive({
    create_data(100)
  })
  
  output$myplot <- renderPlot({
    d <- data()
    plot(d$x, d$y)
  })

  
  # to show if the session is free: show current time
  output$current_time <- renderText({
    invalidateLater(1000, session)
    format(Sys.time(), "%H:%M:%S")
  })
  
}

shinyApp(ui, server)

Note how the time is not immediately shown because the create_data() function blocks the session.

Attempt for an async App

To show when the events are triggered, I move the content to a second navbar page. Therefore I expect the tasks to be triggered when the data is needed because the page is shown (eg reactive() and not observe() behavior).

My unsuccessful attempt is then the following (note how I trigger the task$invoke with an observe() this is the error but I do not know how I would trigger this with a reactive() or othwerwise.

library(shiny)
library(bslib)
library(mirai)

create_data <- function(n) {
  Sys.sleep(2)
  data.frame(x = seq(n), y = rnorm(n))
}
# small helper function for logging
flog <- function(m) cat(sprintf("INFO [%s] | %s\n", format(Sys.time(), "%Y-%m-%d %H:%M:%OS3"), m))

ui <- page_navbar(
  nav_panel("Empty Default"),
  nav_panel(
    "Same as Before",
    card_header(span("To show reactive state, here is the current time ",
                     textOutput("current_time", inline = TRUE))),
    plotOutput("myplot")
  )
)

server <- function(input, output, session) {
  # create the task
  task <- ExtendedTask$new(function(...) mirai(fun(n = n), fun = create_data, ...))
  
  # this is the error here: the observe is not triggered by the rendered plot but by observe => fires immediately
  observe({
    flog("Task Invoke")
    task$invoke(n = 100)
    flog("Task Invoke Done")
  })
  
  output$myplot <- renderPlot({
    flog("Task Result")
    data <- task$result()
    flog("Task Result Done")
    
    plot(data$x, data$y)
  })
  
  
  # to show if the session is free: show current time
  output$current_time <- renderText({
    invalidateLater(1000, session)
    format(Sys.time(), "%H:%M:%S")
  })
}

shinyApp(ui, server)

Solution

  • You can put the task invocation into a reactive() of its own to trigger it lazily. The result is cached and never invalidated so it will only run once. Then just depend on that reactive in the output:

    library(shiny)
    library(bslib)
    library(mirai)
    
    create_data <- function(n) {
      Sys.sleep(2)
      data.frame(x = seq(n), y = rnorm(n))
    }
    
    infof <- function(...) {
      timestamp <- format(Sys.time(), "%Y-%m-%d %H:%M:%OS3")
      cat(sprintf("INFO [%s] | %s\n", timestamp, sprintf(...)))
    }
    
    ui <- page_navbar(
      nav_panel("Empty Default"),
      nav_panel(
        "Same as Before",
        card_header(span("To show reactive state, here is the current time ",
                         textOutput("current_time", inline = TRUE))),
        plotOutput("myplot")
      )
    )
    
    server <- function(input, output, session) {
      infof("Session started")
    
      task <- ExtendedTask$new(function(...) mirai(fun(n = n), fun = create_data, ...))
    
      # Reactive to invoke task lazily. The result is cached and never invalidated.
      invoke_task <- reactive({ infof("Task invoked"); task$invoke(n = 100) })
      data <- reactive({ invoke_task(); infof("Task %s", task$status()); task$result() })
      
      output$myplot <- renderPlot({
        infof("Plot requested")
        d <- data()
        infof("Plot rendered") # otherwise there is a graphics error
        plot(d$x, d$y)
      })
      
      
      # to show if the session is free: show current time
      output$current_time <- renderText({
        invalidateLater(1000, session)
        format(Sys.time(), "%H:%M:%S")
      })
    }
    
    shinyApp(ui, server)
    

    Which produces:

    log showing task invocation after plot request