Last active
January 23, 2024 11:15
-
-
Save hypebright/64e1206a516ef9223c872f6b614c8c5c to your computer and use it in GitHub Desktop.
Small demo to use background processes in Shiny apps with callR
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| library(shiny) | |
| library(callr) | |
| ui <- fluidPage( | |
| titlePanel('Using callR in Shiny'), | |
| actionButton('start_job', 'Start Expensive Job'), | |
| tableOutput('result_table') | |
| ) | |
| server <- function(input, output, session) { | |
| # initiate reactive values | |
| check_finished <- reactiveValues(value = FALSE) | |
| result <- reactiveValues(data = NULL) | |
| # set whatever arguments you want to use | |
| some_argument <- 'virginica' | |
| # callR demonstration | |
| observeEvent(input$start_job, { | |
| result$data <- | |
| callr::r_bg( | |
| func = | |
| function(my_argument) { | |
| # long computation | |
| Sys.sleep(10) | |
| # using your supplied argument to demonstrate how to use arguments in background process | |
| iris <- subset(iris, Species == my_argument) | |
| # the result | |
| return(iris) | |
| }, | |
| supervise = TRUE, args = list(my_argument = some_argument) | |
| ) | |
| check_finished$value <- TRUE | |
| }) | |
| # this part can be useful if you want to update your UI during the process | |
| # think about doing an expensive calculation and showing preliminary results | |
| # not a requirement to have, but it shows some extended capabilities of using callR | |
| observe({ | |
| if (check_finished$value == TRUE) { | |
| # this will invalidate every second | |
| invalidateLater(millis = 1000) | |
| # do something while waiting | |
| print(paste0('Still busy at ', Sys.time())) | |
| # whenever the background job is finished the value of is_alive() will be FALSE | |
| if (result$data$is_alive() == FALSE) { | |
| print('Finished!') | |
| check_finished$value <- FALSE | |
| output$result_table <- renderTable(result$data$get_result()) | |
| } | |
| } | |
| }) | |
| } | |
| shinyApp(ui = ui, server = server) |
@hypebright Could you add another input/output to this example, so user can play with it while the background task is running? That would better highlight the non-blocking pattern showed here and how cool it is :)
@DivadNojnarg true! This example doesn't do justice to the value of async. I have a better example in this repo, specifically this script 🚀
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
@hypebright Could you add another input/output to this example, so user can play with it while the background task is running? That would better highlight the non-blocking pattern showed here and how cool it is :)