crew + ExtendedTask while keeping track of who requested each result

app.R

library(shiny)
library(crew)
library(promises)
library(bslib)

run_task <- function(model, n, delay_secs) {
  Sys.sleep(delay_secs)
  model(n)
}

distUI <- function(id, model, label, n) {
  ns <- NS(id)
  card(
    strong(paste0(label, "(n=", n, ")")),
    actionButton(ns("resample"), "Resample"),
    plotOutput(ns("plot"), height="300px")
  )
}

distServer <- function(id, controller, model, n, delay_secs) {
  moduleServer(
    id,
    function(input, output, session) {
      extended_task <- ExtendedTask$new(function(x) x)
      
      observe({
        req(!is.null(input$resample))
        
        task <- controller$push(command = run_task(model, n, delay_secs), data = list(
          run_task = run_task,
          model = model,
          n = n,
          delay_secs = delay_secs
        ))
        controller$promise(mode="one") # seems to be necessary to get execution to start
        extended_task$invoke(as.promise(task) %...>% { .$result[[1]] })
      })
      
      output$plot <- renderPlot({
        input$resample
        str(extended_task$result())
        hist(extended_task$result())
      })
    }
  )
}

controller <- crew::crew_controller_local(workers = 4, seconds_idle = 10)

ui <- page_sidebar(fillable = FALSE,
  sidebar = sidebar(
    # distUI("one", runif, "runif", 100)
    selectInput("dist", "Distribution", list(
      "Uniform (runif)" = "runif",
      "Normal (rnorm)" = "rnorm",
      "Exponential (rexp)" = "rexp"
    )),
    numericInput("n", "Sample size (n)", 100),
    actionButton("add", "Add", class="btn-primary"),
    hr(),
    numericInput("delay_secs", "Seconds to take (for debugging)", 2),
  ),
  layout_columns(id = "results", col_widths = 2, fillable = FALSE)
)

server <- function(input, output, session) {
  distfunc <- reactive({
    switch(input$dist,
      runif = runif,
      rnorm = rnorm,
      rexp = rexp,
      req(FALSE)
    )
  })
  
  distlabel <- reactive({
    switch(input$dist,
      runif = "Uniform",
      rnorm = "Normal",
      rexp = "Exponential",
      req(FALSE)
    )
  })
  
  observeEvent(input$add, {
    id <- paste0("panel_", sample.int(99999999, 1))
    insertUI("#results", where = "beforeEnd", distUI(
      id, distfunc(), distlabel(), input$n
    ))
    distServer(id, controller, distfunc(), input$n, input$delay_secs)
  })
}

shinyApp(ui, server)