Calling a shiny JavaScript Callback from within a future - r

Question

In shiny, it is possible to call client-side callbacks written in javascript from the server's logic. Say in ui.R you have some JavaScript including a function called setText:
tags$script('
Shiny.addCustomMessageHandler("setText", function(text) {
document.getElementById("output").innerHTML = text;
})
')
then in your server.R you can call session$sendCustomMessage(type='foo', 'foo').
Suppose I have a long-running function which returns some data to plot. If I do this normally, the R thread is busy while running this function, and so can't handle additional requests in this time. It would be really useful to be able to run this function using the futures package, so that it runs asynchronously to the code, and call the callback asyncronously. However, when I tried this is just didn't seem to work.
Sorry if this isn't very clear. As a simple example, the following should work until you uncomment the two lines trying to invoke future in server.R. Once those lines are uncommented, the callback never gets called. Obviously it's not actually useful in the context of this example, but I think it would be very useful in general.
ui.R:
library(shiny)
shinyUI(fluidPage(
sidebarLayout(
sidebarPanel(
sliderInput("max",
"Max random number:",
min = 1,
max = 50,
value = 30)
),
mainPanel(
verbatimTextOutput('output'),
plotOutput('plot')
)
),
tags$script('
Shiny.addCustomMessageHandler("setText", function(text) {
document.getElementById("output").innerHTML = text;
})
')
))
server.R:
library(shiny)
library(future)
plan(multiprocess)
shinyServer(function(input, output, session) {
output$plot <- reactive({
max <- input$max
#f <- future({
session$sendCustomMessage(type='setText', 'Please wait')
Sys.sleep(3)
x <- runif(1,0,max)
session$sendCustomMessage(type='setText', paste('Your random number is', x))
return(NULL)
#})
})
})

Answer 1

Here is a solution on how you could use the future package in a shiny app.
It is possible to have multiple sessions with no session blocking another session when running a computationally intensive task or waiting for a sql query to be finished. I suggest to open two sessions (just open http://127.0.0.1:14072/ in two tabs) and play with the buttons to test the functionality.
run_app.R:
library(shiny)
library(future)
library(shinyjs)
runApp(host = "127.0.0.1", port = 14072, launch.browser = TRUE)
ui.R:
ui <- fluidPage(
useShinyjs(),
textOutput("existsFutureData"),
numericInput("duration", "Duration", value = 5, min = 0),
actionButton("start_proc", h5("get data")),
actionButton("start_proc_future", h5("get data using future")),
checkboxInput("checkbox_syssleep", label = "Use Sys.sleep", value = FALSE),
h5('Table data'),
dataTableOutput('tableData'),
h5('Table future data'),
dataTableOutput('tableFutureData')
)
server.R:
plan(multiprocess)
fakeDataProcessing <- function(duration, sys_sleep = FALSE) {
if(sys_sleep) {
Sys.sleep(duration)
} else {
current_time <- Sys.time()
while (current_time + duration > Sys.time()) { }
}
return(data.frame(test = Sys.time()))
}
#fakeDataProcessing(5)
############################ SERVER ############################
server <- function(input, output, session) {
values <- reactiveValues(runFutureData = FALSE, futureDataLoaded = 0L)
future.env <- new.env()
output$existsFutureData <- renderText({ paste0("exists(futureData): ", exists("futureData", envir = future.env)," | futureDataLoaded: ", values$futureDataLoaded) })
get_data <- reactive({
if (input$start_proc > 0) {
shinyjs::disable("start_proc")
isolate({ data <- fakeDataProcessing(input$duration) })
shinyjs::enable("start_proc")
data
}
})
observeEvent(input$start_proc_future, {
shinyjs::disable("start_proc_future")
duration <- input$duration # This variable needs to be created for use in future object. When using fakeDataProcessing(input$duration) an error occurs: 'Warning: Error in : Operation not allowed without an active reactive context.'
checkbox_syssleep <- input$checkbox_syssleep
future.env$futureData %<-% fakeDataProcessing(duration, sys_sleep = checkbox_syssleep)
future.env$futureDataObj <- futureOf(future.env$futureData)
values$runFutureData <- TRUE
check_if_future_data_is_loaded$resume()
},
ignoreNULL = TRUE,
ignoreInit = TRUE
)
check_if_future_data_is_loaded <- observe({
invalidateLater(1000)
if (resolved(future.env$futureDataObj)) {
check_if_future_data_is_loaded$suspend()
values$futureDataLoaded <- values$futureDataLoaded + 1L
values$runFutureData <- FALSE
shinyjs::enable("start_proc_future")
}
}, suspended = TRUE)
get_futureData <- reactive({ if(values$futureDataLoaded > 0) future.env$futureData })
output$tableData <- renderDataTable(get_data())
output$tableFutureData <- renderDataTable(get_futureData())
session$onSessionEnded(function() {
check_if_future_data_is_loaded$suspend()
})
}

Answer 2

I retooled André le Blond's excellent answer to and made a gist showing a generic asynchronous task processor which can be used either by itself or with Shiny: FutureTaskProcessor.R
Note it contains two files: FutureProcessor.R which is the stand alone asynchronous task handler and app.R which is a Shiny App showing use of the async handler within Shiny.

Answer 3

One admittedly complicated workaround to the single-threaded nature of R within Shiny apps is to do the following:
Splinter off an external R process (run another R script located in
the Shiny app directory, or any directory accessible from within the
Shiny session) from within R (I've tried this splintering before,
and it works).
Configure that script to output its results to a temp directory (assuming you're running Shiny on a Unix-based system) and give the output file a unique filename (preferably named within the namespace of the current session (i.e. "/tmp/[SHINY SESSION HASH ID]_example_output_file.RData".
Use Shiny's invalidateLater() function to check for the presence of that output file.
Load the output file into the Shiny session workspace.
Finally, trash collect by deleting the generated output file after loading.
I hope this helps.