Calling a shiny JavaScript Callback from within a future

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)
      #})
    })
})

Grindstone

I doubt you will get anywhere with this without folding in some multiprocessor library. But FWIW, if you change to plan(lazy) and add a value(f) after you define f (in the ouputt$plot reactive, it works. – Spikenard

Hi Mike, thanks for your reply! Sorry it's been ages. I agree that what you say works, but using value(f) doesn't solve my problem in this case, because then the thread stays locked up until f evaluates anyway. – Grindstone

Are there any multiprocessor libraries you know of that would achieve this? I.e. spawn some kind of child process and then exit the main thread, and the child process then calls back to the javascript code whenever it has finished executing? That's what I want to achieve, and I thought it might be possible with the futures package, but am happy to try other packages! – Grindstone

Yeah, R is pretty hopelessly single threaded internally. – Spikenard

I can look into it. Hong Ooi is the guy to ask :). As he is a colleage of mine I can do that. – Spikenard

That would be great if you both have the time. I'm currently running the function incrementally, and after each couple of iterations pinging the partial data back to the client (thereby exiting the R thread), the client then waits a bit to keep the thread free for a bit, then hits R with the partial data and asks it to do the next few iterations. It "works" in the sense that it sort of allows multiple users to connect, and the user can also hit "Stop" half way through, but the code is a horrible mess, and pinging data back and forth seems bad. – Grindstone

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()
  })
}

Luciana

Hey, thanks so much for this. I'm not sure I 100% understand what's actually going on, but I copied and pasted in and it's working! For me, the ignoreInit=TRUE argument gets ignored (and throws an error), although it's in the docs so maybe I just need an update or something. Commenting out that line, everything seems to work really nicely, thanks! – Grindstone

Glad I could help. The ignoreInit=TRUE argument is not really necessary because of ingnoreNULL=TRUE and input$start_proc_future=0 when starting the app. Still, it would be interesting to find out why you are getting an error. I am using R version 3.3.3, shinyjs_0.9, future_1.4.0, shiny_1.0.0. If you have any questions, don't hesitate to ask. – Sealer

This was extremely helpful - thanks! I have tried to simplify and generalize your approach in this answer – Shellfish

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.

Shellfish

This looks really nice - thanks! Your example works nicely for me. However, I've just tried it where the fakeDataProcessing function is actually a function from an installed package. That function calls functions which are internal to that package, and for some reason, this gets me to a could not find function error. Are my installed packages not transferred to the future environment? Is there a way round this? – Grindstone

I stumbled on your post on the futures issues page and was so surprised to see my own answer referenced. Yes, I am also struggling with how globals are handled in future. – Shellfish

Yeah, I found that issue after commenting here. The suggested fix on that issue works for me, although in some cases I also had to store the function locally. I.e. functionName <- packageName:::functionName and then later future({functionName #Workaround as in issue; #do stuff}) – Grindstone

Now I've got the workaround from that issue working, this works so nicely, and is really easy to use! I've removed all your testit stuff and all the debugging stuff for my purposes, and so have startAsyncDataLoad and checkAsyncDataLoaded and that's basically it. Really easy way to get async code in R shiny. Thanks! – Grindstone

Answer 3

One admittedly complicated workaround to the single-threaded nature of R within Shiny apps is to do the following:

1. 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).
2. 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".
3. Use Shiny's invalidateLater() function to check for the presence of that output file.
4. Load the output file into the Shiny session workspace.
5. Finally, trash collect by deleting the generated output file after loading.

I hope this helps.

Crocoite

Yeah, I've considered doing this too, thanks! What I really want to do is splinter off an R process which then calls back to the javascript callback using session$sendCutomMessage but can't get it working unfortunately. That way instead of creating a file, I'm sending the data back to the client. – Grindstone

The problem with that is that the future package isn't letting you get around R's single-threaded blocking issue. You can still use Shiny's sendCustomMessage function with my process splintering suggestion. Just trigger it after the invalidateLater invocation finally finds the splintered process' result. By the way, I recommend that if you do end up going with process splintering, you also include temp directory cleanup in a session$onSessionEnded call, so that when the Shiny session ends, the corresponding files in the temp directory are always deleted. Maybe just once, in lieu of step 5. – Crocoite

Okay, but it's not possible for the splintered off R process to just call the session$sendCustomMessage itself? That way I don't need the invalidateLater stuff. I don't necessarily need the main R function to pick up again, since the client can handle that (I can send required data back directly from the splintered process in the custom message, if this is possible). – Grindstone

Since the splintered R process would be an R environment completely separate from that of the Shiny app, the concern is that calling session$sendCustomMessage would not impact the client javascript generated by the Shiny app. There may be a way to have one running R session impact another, but you still run into the problem of interacting with not just another R session, but with a user-specific sub-session running within the master R Shiny session that originally triggered the splintered R script run. In my humble opinion, you'll have a better time of using invalidateLater instead of sCM. – Crocoite