The scenario I'm emulating with the below minimal example is allowing a user to engage with a Shiny App (click the numericInput control and see server-side events occur) while a long-running download is occurring (simulated with Sys.sleep(10) within downloadHandler).
In a synchronous setting, when the "Download" button is clicked, the user can still interact with UI elements, but other Shiny calculations (in this case, renderText), get put in a queue. I'd like the asynchronous setting, where the download occurs in the background, and users can still interact with the UI elements and get desired output (e.g. renderText).
I'm using callr::r_bg() to achieve asynchronicity within Shiny, but the issue is that my current code of the downloadHandler is incorrect (mtcars should be getting downloaded, but the code is unable to complete the download, 404 error message), I believe it's due to the specific way in which downloadHandler expects the content() function to be written, and the way I've written callr::r_bg() is not playing nicely with that. Any insights would be appreciated!
Reference:
https://www.r-bloggers.com/2020/04/asynchronous-background-execution-in-shiny-using-callr/
Minimal Example:
library(shiny)
ui <- fluidPage(
downloadButton("download", "Download"),
numericInput("count",
NULL,
1,
step = 1),
textOutput("text")
)
server <- function(input, output, session) {
long_download <- function(file) {
Sys.sleep(10)
write.csv(mtcars, file)
}
output$download <- downloadHandler(
filename = "data.csv",
content = function(file) {
x <- callr::r_bg(
func = long_download,
args = list(file)
)
return(x)
}
)
observeEvent(input$count, {
output$text <- renderText({
paste(input$count)
})
})
}
shinyApp(ui, server)
I figured out a solution, and learned the following things:
Because downloadHandler doesn't have a traditional input$X, it can be difficult to include reactivity in the traditional way. The workaround was to present the UI as a hidden downlodButton masked by an actionButton which the user would see. Reactivity was facilitated in the following process: user clicks actionButton -> reactive updates -> when the reactive finishes (reactive()$is_alive() == FALSE), use shinyjs::click to initiate the downloadHandler
Instead of placing the callr function within the downloadHandler, I kept the file within the content arg. There seems to be some difficulties with scoping because the file needs to be available within the content function environment
I'm using a reactive function to track when the background job (the long-running computation) is finished to initiate the download using the syntax: reactive()$is_alive()
The invalidateLater() and toggling of a global variable (download_once) is important to prevent the reactive from constantly activating. Without it, what will happen is your browser will continually download files ad infinitum -- this behavior is scary and will appear virus-like to your Shiny app users!
Note that setting global variables is not a best practice for Shiny apps (will think of a better implementation)
Code Solution:
library(shiny)
library(callr)
library(shinyjs)
ui <- fluidPage(
shinyjs::useShinyjs(),
#creating a hidden download button, since callr requires an input$,
#but downloadButton does not natively have an input$
actionButton("start", "Start Long Download", icon = icon("download")),
downloadButton("download", "Download", style = "visibility:hidden;"),
p("You can still interact with app during computation"),
numericInput("count",
NULL,
1,
step = 1),
textOutput("text"),
textOutput("did_it_work")
)
long_job <- function() {
Sys.sleep(5)
}
server <- function(input, output, session) {
#start async task which waits 5 sec then virtually clicks download
long_run <- eventReactive(input$start, {
#r_bg by default sets env of function to .GlobalEnv
x <- callr::r_bg(
func = long_job,
supervise = TRUE
)
return(x)
})
#desired output = download of mtcars file
output$download <- downloadHandler(filename = "test.csv",
content = function(file) {
write.csv(mtcars, file)
})
#output that's meant to let user know they can still interact with app
output$text <- renderText({
paste(input$count)
})
download_once <- TRUE
#output that tracks progress of background task
check <- reactive({
invalidateLater(millis = 1000, session = session)
if (long_run()$is_alive()) {
x <- "Job running in background"
} else {
x <- "Async job in background completed"
if(isTRUE(download_once)) {
shinyjs::click("download")
download_once <<- FALSE
}
invalidateLater(millis = 1, session = session)
}
return(x)
})
output$did_it_work <- renderText({
check()
})
}
shinyApp(ui, server)
Thanks #latlio for your great answer. I think it cloud be easily improved.
invalidateLater should be used very carefully and only WHEN needed. I use invalidateLater only once and moved it to the logical part where we are waiting for the result. Thus we are NOT invalidating the reactivity infinitely.
library(shiny)
library(callr)
library(shinyjs)
ui <- fluidPage(
shinyjs::useShinyjs(),
#creating a hidden download button, since callr requires an input$,
#but downloadButton does not natively have an input$
actionButton("start", "Start Long Download", icon = icon("download")),
downloadButton("download", "Download", style = "visibility:hidden;"),
p("You can still interact with app during computation"),
numericInput("count",
NULL,
1,
step = 1),
textOutput("text"),
textOutput("did_it_work")
)
long_job <- function() {
Sys.sleep(5)
}
server <- function(input, output, session) {
#start async task which waits 5 sec then virtually clicks download
long_run <- eventReactive(input$start, {
#r_bg by default sets env of function to .GlobalEnv
x <- callr::r_bg(
func = long_job,
supervise = TRUE
)
return(x)
})
#desired output = download of mtcars file
output$download <- downloadHandler(filename = "test.csv",
content = function(file) {
write.csv(mtcars, file)
})
#output that's meant to let user know they can still interact with app
output$text <- renderText({
paste(input$count)
})
#output that tracks progress of background task
check <- reactive({
if (long_run()$is_alive()) {
x <- "Job running in background"
invalidateLater(millis = 1000, session = session)
} else {
x <- "Async job in background completed"
shinyjs::click("download")
}
return(x)
})
output$did_it_work <- renderText({
check()
})
}
shinyApp(ui, server)
I would like to execute a very expensive function (called 'never_ending_calc' in the below example) in a separate R session in a shiny app. I already prepared the below code, it works fine, but my parent R session waits on the result of the promise object and this uses lots of resources.
If you check the task manager while the below test application is running, you will see that the parent R session uses one CPU thread on maximum capacity while just simply waiting on the results of the promise object.
How can I evaluate a promise in a way which does not use the resources of the parent R session? (It is also ok if I loose the connection between these two sessions.)
I tried the followings (none of them worked):
use different 'plan'
send a custom message (like a warning) from function 'never_ending_calc' on its first row to somehow stop the parent session to wait on the promise object
Here is the example:
library(shiny)
library(future)
library(promises)
library(future.callr)
never_ending_calc <- function(){
K = 1
for (i in 1:20){
K = K + i
Sys.sleep(5)
}
return(K)
}
ui <- fluidPage(
# App title ----
titlePanel("Test app"),
# Sidebar layout with input and output definitions ----
sidebarLayout(
# Sidebar panel ----
sidebarPanel(
# action button to start the long test calculation ----
actionButton(inputId = "start_test",
label = "Start test run")
),
mainPanel()
)
)
server <- function(input, output) {
observeEvent(input$start_test, {
# start execute the long calculation in another separate R session
future::plan(future.callr::callr)
long_calculation_future <<- future::future({
never_ending_calc()
})
promises::then(long_calculation_future,
onFulfilled = NULL,
onRejected = function(error){NULL})
future::plan(future::sequential)
# return NULL to keep the shiny app reactive
NULL
})
}
shinyApp(ui, server)
Im trying to develop a simple shiny app that prints the latest EUR price
library(shiny)
ui <- basicPage(
verbatimTextOutput(outputId = "roll", placeholder = TRUE)
)
server <- function(input, output) {
Rblpapi::blpConnect()
last_print <- reactiveVal(value = 1)
Rblpapi::subscribe(securities = "EUR Curncy", fields = "LAST_PRICE", fun = function(x) last_print(x))
output$roll <- renderPrint({
last_print()$data$LAST_PRICE
})
}
shinyApp(ui = ui, server = server)
If you dont have access to Rblpapi, think of subscribe as a function that creates a subscription to a data, and calls fun every time the data is updated.
When you run the app, nothing happens, though if you debug it, you see last_print is being updated.
I know Im messing up with the reactive paradigm in Shiny, but I just cant get my head around of what would the pattern to use.
Any stub function to replace Rblpapi::subscribe for people without Bloomberg to be able to test and help would be very appreciated also.
I have configuration options for a shiny app that are behind a panel. Moreover, the configuration options are generated server side using uiOutput/renderUI.
Shiny defers evaluation of items that are not in the currently selected panel, but sometimes it's desirable to force evaluation. Is it possible to force server side evaluation?
Here's an example:
library(shiny)
ui <- fluidPage(
tabsetPanel(tabPanel("Main",
plotOutput("dots")),
tabPanel("Settings",
uiOutput("even.or.odd")
)
)
)
server <- function(input, output) {
output$dots <- renderPlot({
plot(seq(ifelse(input$even, 0, 1), 20, 2))
})
output$even.or.odd <- renderUI(checkboxInput('even', "Even?",TRUE))
}
shinyApp(ui = ui, server = server)
Or from RStudio do runGist('https://gist.github.com/dkulp2/d897c21dfd1a20f9531b6454ea02a533')
This fails on startup because input$even is undefined until the "Settings" panel is revealed. (And then the app works fine.) Is there some way to cause Shiny to evaluate the even.or.odd function without revealing the panel?
You can force execution of hidden output objects by setting suspendWhenHidden = FALSE with outputOptions
outputOptions(output, "even.or.odd", suspendWhenHidden = FALSE)
The help page for runApp says:
Runs a Shiny application. This function normally does not return;
interrupt R to stop the application (usually by pressing Ctrl+C or
Esc).
Does "normally" mean "always"? Is there any way to add an "exit" button and return a value to the R session that called runApp? Even if it's a hack, this would be convenient functionality. I've tried some searching but haven't found anything. I've also looked at the source for runApp, the last line is return(.globals$retval), so it looks like there should be a way.
Can I set .globals$retval directly and then call some kind of interrupt? Is there a function in the shiny package that does this?
There is a stopApp function that stops the running app and returns an optional value:
myValue <- runApp(list(
ui = bootstrapPage(
numericInput('n', 'Number of obs', 100),
actionButton("myBtn", "Press ME!"),
plotOutput('plot')
),
server = function(input, output, session) {
output$plot <- renderPlot({ hist(runif(input$n)) });
observe({
if(input$myBtn > 0){
stopApp(7)
}
})
}
))
On stopping:
> myValue
[1] 7