Using parallel package in shiny

Question

I am creating a shiny app for a simulator I have created. In order to speed up the simulations, I use the parallel package.

My app works fine when not parallelizing my code, though it's slow. However, when I parallelize, I get the following error:

Error in checkForRemoteErrors(val) : 
  3 nodes produced errors; first error: Operation not allowed without an active reactive context. (You tried to do something that can only be done from inside a reactive expression or observer.)

Here are abridged versions of my ui.R and server.R:

ui.R

library(shiny)

shinyUI(fluidPage(
  titlePanel("Simulator"),

  fluidRow(
    column(6,
           fluidRow(
             column(5,
                    helpText("Choose 9 bitcoins for firm 1"),
                    selectizeInput("firm1bit1", label = "Bitcoin 1:",
                                   choices = data$bitcoin, options = 
                                     list(maxOptions = 7)),
                    selectizeInput("firm1bit2", label = "Bitcoin 2:",
                                   choices = data$bitcoin, options =
                                     list(maxOptions = 7)),
                    selectizeInput("firm1bit3", label = "Bitcoin 3:",
                                   choices = data$bitcoin, options = 
                                     list(maxOptions = 7)),
                    selectizeInput("firm1bit4", label = "Bitcoin 4:",
                                   choices = data$bitcoin, options =
                                     list(maxOptions = 7)),
                    selectizeInput("firm1bit5", label = "Bitcoin 5:",
                                   choices = data$bitcoin, options = 
                                     list(maxOptions = 7)),
                    selectizeInput("firm1bit6", label = "Bitcoin 6:",
                                   choices = data$bitcoin, options = 
                                     list(maxOptions = 7)),
                    selectizeInput("firm1bit7", label = "Bitcoin 7:",
                                   choices = data$bitcoin, options =
                                     list(maxOptions = 7)),
                    selectizeInput("firm1bit8", label = "Bitcoin 8:",
                                   choices = data$bitcoin, options =
                                     list(maxOptions = 7)),
                    selectizeInput("firm1bit9", label = "Bitcoin 9:",
                                   choices = data$bitcoin, options =
                                     list(maxOptions = 7)),
                    helpText("Choose the maximum number of transactions for firm 1"),
                    selectizeInput("firm1transacts", label = "Firm 1 maximum number of transactions:", 
                                   choices = data$max_transactions, options =
                                     list(maxOptions = 7))
             ),
             column(5,
                    helpText("Choose 9 bitcoins for firm 2"),
                    selectizeInput("firm2bit1", label = "Bitcoin 1:",
                                   choices = data$bitcoin, options = 
                                     list(maxOptions = 7)),
                    selectizeInput("firm2bit2", label = "Bitcoin 2:",
                                   choices = data$bitcoin, options =
                                     list(maxOptions = 7)),
                    selectizeInput("firm2bit3", label = "Bitcoin 3:",
                                   choices = data$bitcoin, options = 
                                     list(maxOptions = 7)),
                    selectizeInput("firm2bit4", label = "Bitcoin 4:",
                                   choices = data$bitcoin, options =
                                     list(maxOptions = 7)),
                    selectizeInput("firm2bit5", label = "Bitcoin 5:",
                                   choices = data$bitcoin, options = 
                                     list(maxOptions = 7)),
                    selectizeInput("firm2bit6", label = "Bitcoin 6:",
                                   choices = data$bitcoin, options = 
                                     list(maxOptions = 7)),
                    selectizeInput("firm2bit7", label = "Bitcoin 7:",
                                   choices = data$bitcoin, options =
                                     list(maxOptions = 7)),
                    selectizeInput("firm2bit8", label = "Bitcoin 8:",
                                   choices = data$bitcoin, options =
                                     list(maxOptions = 7)),
                    selectizeInput("firm2bit9", label = "Bitcoin 9:",
                                   choices = data$bitcoin, options =
                                     list(maxOptions = 7)),
                    helpText("Choose the maximum number of transactions for firm 2"),
                    selectizeInput("firm2transacts", label = "Firm 2 maximum number of transactions:", 
                                   choices = data$max_transactions, options =
                                     list(maxOptions = 7))
             ),
             submitButton("Simulate")
           ))
  )
))

server.R

cl <- makeCluster(detectCores()-1, 'PSOCK')

shinyServer(function(input, output, session){

  firm1bits <- reactive({c(input$firm1bit1, input$firm1bit2, input$firm1bit3,
                            input$firm1bit4, input$firm1bit5, input$firm1bit6,
                            input$firm1bit7, input$firm1bit8, input$firm1bit9)})
  firm2bits <- reactive({c(input$firm2bit1, input$firm2bit2, input$firm2bit3,
                            input$firm2bit4, input$firm2bit5, input$firm2bit6,
                            input$firm2bit7, input$firm2bit8, input$firm2bit9)})
  firm1max <- reactive({input$firm1transacts})
  firm2max <- reactive({input$firm2transacts})

  reactive({clusterExport(cl, varlist=c("firm1bits", "firm2bits", "firm1max",
                                        "firm2max"))})
  gameResults <- reactive({parSapply(cl, 1:1000, function(i){
    simulate_bitcoin_Twoway(firm1bits(), firm2bits(), firm1max(), firm2max())
  })})
})

I want to reiterate that the code works when I do not use parSapply() and instead use replicate(). The problem is not in other functions, such as simulate_bitcoin_Twoway().

Answer 1

I had the exact same issue, though I am using the doParallel and foreach packages. I did not explicitly define any reactive values in my application, but I was referencing input within the foreach block, which of course is a reactive value by default.

After trying many different things, I found the easiest solution to be that I can simply include an isolate statement inside the foreach. However, since isolate makes it so that there is no dependency of those variables on anything outside of the foreach loop, we will need to export both the input vector, as well as the isolate function itself. In your situation, you would also need to export all reactive values as well.

The code that was giving me the error

Operation not allowed without an active reactive context

looked like this:

  optiResults<-foreach(i=seq(1,3),
  .combine = rbind,
  ) %dopar% {
    print("hello")
    rv = input$power
    thingy = data.frame(matrix(0,1,2))
  }

The simple solution was to do this this:

  optiResults<-foreach(i=seq(1,3),
  .combine = rbind,
  .export = c("isolate","input")
  ) %dopar% {
    print("hello")
    isolate({
    rv = input$power
    thingy = data.frame(matrix(0,1,2))
    })
  }

Answer 2

Since you didn't provide the MCVE it is more a wild guess than anything else.

When you call clusterExport you distribute reactive variables over the cluster. parSapply executes simulate_bitcoin_Twoway on the cluster with separate environment for each worker without enclosing reactive block. Since reactive values require reactive context a whole operation fails.

To deal with this problem I would try to evaluate reactive expressions locally and distribute returned values:

gameResults <- reactive({
    firm1bits_v <- firm1bits()
    firm2bits_v <- firm2bits()
    firm1max_v <- firm1max()
    firm2max_v <- firm2max()

    clusterExport(cl, varlist=c(
        "firm1bits_v", "firm2bits_v", "firm1max_v", "firm2max_v"))

    parSapply(cl, 1:1000, function(i ){
        simulate_bitcoin_Twoway(firm1bits_v, firm2bits_v, firm1max_v, firm2max_v)
    })
})

If above doesn't work you can try to take dependency on reactive values but evaluate on the cluster inside isolate block.

Edit:

Here is a full working example:

library(shiny)
library(parallel)
library(ggplot2)

cl <- makeCluster(detectCores()-1, 'PSOCK')
sim <- function(x, y, z) {
    c(rnorm(1, mean=x), rnorm(1, mean=y), rnorm(1, mean=z))
}

shinyApp(
    ui=shinyUI(bootstrapPage(
        numericInput("x", "x", 10, min = 1, max = 100),
        numericInput("y", "y", 10, min = 1, max = 100),
        numericInput("z", "z", 10, min = 1, max = 100),
        plotOutput("plot")
    )),

    server=shinyServer(function(input, output, session){
        output$plot <- renderPlot({
            x <- input$x
            y <- input$y
            z <- input$z
            clusterExport(
               cl, varlist=c("x", "y", "z", "sim"),
               envir=environment())

            mat <- t(parSapply(cl, 1:1000, function(i) {
                sim(x, y, z)
            }))
            ggplot(
                as.data.frame(mat),
                aes(x=V1, y=V2, col=cut(V3, breaks=10))) + geom_point()
        })
    })
)

Please note envir parameter for clusterExport. By default clusterExport is searching in a global environment where variable defined in closure are not visible.