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

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.