Open mikkmart opened 1 month ago
I think by design Shiny ExtendedTask currently tries to avoid this: https://shiny.posit.co/r/articles/improve/nonblocking/#multiple-invocations
It's possible to work around by not using ExtendedTask, in the manner of: https://shikokuchuo.net/mirai/dev/articles/shiny.html#advanced-non-promise-example-generative-art for example.
The equivalent code is shown below. I've lengthened the sleeps and specified 2 daemons (persistent background processes) so you can see it more clearly - if you click a few times in succession, you'll see the results update 2 at a time.
library(shiny)
library(bslib)
library(mirai)
ui <- page_sidebar(
sidebar = sidebar(
sliderInput("mean", "Mean", -2, 2, 0),
actionButton("simulate", "Simulate", class = "btn-primary")
),
span("Simulations launched: ", textOutput("simulation_count", inline = TRUE)),
verbatimTextOutput("results")
)
server <- function(input, output, session) {
# a bit of boilerplate to set up a mirai queue
q <- list()
poll_for_results <- reactiveVal(FALSE)
# each button click launches a mirai and adds it to the queue
observeEvent(input$simulate, {
q[[length(q) + 1L]] <<- mirai({ Sys.sleep(3); rnorm(5, m) }, m = input$mean)
poll_for_results(TRUE)
})
output$simulation_count <- renderText(input$simulate)
results <- reactiveVal(list())
# if queue is not empty, check for results
observe({
req(poll_for_results())
invalidateLater(millis = 100)
if (length(q)) {
if (!unresolved(q[[1L]])) {
result <- list(q[[1L]][])
results(c(results(), result))
q[[1L]] <<- NULL
}
} else {
poll_for_results(FALSE)
}
})
output$results <- renderPrint(str(results()))
}
app <- shinyApp(ui, server)
with(daemons(2), runApp(app))
You can also achieve this by creating a single ExtendedTask per simulation. I didn't document this pattern as I was worried it would be too confusing, but it's proving to be useful in some of the apps we've built internally.
library(shiny)
library(bslib)
library(mirai)
ui <- page_sidebar(
sidebar = sidebar(
sliderInput("mean", "Mean", -2, 2, 0),
actionButton("simulate", "Simulate", class = "btn-primary")
),
span("Simulations launched: ", textOutput("simulation_count", inline = TRUE)),
verbatimTextOutput("results")
)
server <- function(input, output, session) {
observeEvent(input$simulate, {
simulation <- ExtendedTask$new(function(m) {
mirai({ Sys.sleep(5); rnorm(5, m) }, m = m)
})
simulation$invoke(input$mean)
observeEvent(simulation$result(), {
result <- list(simulation$result())
results(c(results(), result))
})
})
output$simulation_count <- renderText(input$simulate)
results <- reactiveVal(list())
output$results <- renderPrint(str(results()))
}
shinyApp(ui, server)
I know it's weird to see nested observeEvent
like this, but when dynamically creating stuff like this I often use this pattern.
I trust that @shikokuchuo's solution will work as well, so maybe it's a matter of which one feels more intuitive to you.
Oh that's great! I'm all in favour of using ExtendedTask as they make use of the event-driven promises that we put together for mirai
(and you @jcheng5 had a key role in designing).
Just a minimal modification to your example, but highlighting that as mirai()
has a ...
argument, it's even more convenient to use in the context of ExtendedTask. By defining the anonymous function with ...
, these arguments are passed straight through, and then you just invoke it with named arguments (here m = input$mean
).
library(shiny)
library(bslib)
library(mirai)
ui <- page_sidebar(
sidebar = sidebar(
sliderInput("mean", "Mean", -2, 2, 0),
actionButton("simulate", "Simulate", class = "btn-primary")
),
span("Simulations launched: ", textOutput("simulation_count", inline = TRUE)),
verbatimTextOutput("results")
)
server <- function(input, output, session) {
observeEvent(input$simulate, {
simulation <- ExtendedTask$new(
function(...) mirai({ Sys.sleep(5); rnorm(5, m) }, ...)
)
simulation$invoke(m = input$mean)
observeEvent(simulation$result(), {
result <- list(simulation$result())
results(c(results(), result))
})
})
output$simulation_count <- renderText(input$simulate)
results <- reactiveVal(list())
output$results <- renderPrint(str(results()))
}
shinyApp(ui, server)
I’d like to use a single
ExtendedTask
object to launch multiple simulations to be executed in parallel, allowing the user to tweak parameters and launch new simulations while others are still running.Here’s a toy example of the use-case, where currently simulation executions are enqueued: