使用平行包有光泽

我正在为我创建的模拟器创建一个闪亮的应用程序.为了加速模拟,我使用并行包.

我的应用程序在没有并行化我的代码时工作正常,尽管它很慢.但是,当我并行化时,我收到以下错误:

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.)

这是我的ui.R和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())
  })})
})

我想重申,当我不使用parSapply()而是使用replicate()时,代码可以正常工作.问题不在于其他功能,例如simulate_bitcoin_Twoway().

最佳答案
由于你没有提供MCVE,它比其他任何东西都更加疯狂.

调用clusterExport时,可以在群集上分配响应变量. parSapply在集群上执行simulate_bitcoin_Twoway,为每个工作人员提供单独的环境,而不包含反应块.由于无功值需要反应上下文,因此整个操作失败.

为了解决这个问题,我会尝试在本地评估反应式表达式并分配返回值:

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

如果上面不起作用,您可以尝试依赖于反应值,但在隔离块内的集群上进行评估.

编辑:

这是一个完整的工作示例:

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

请注意clusterExport的envir参数.默认情况下,clusterExport在全局环境中进行搜索,其中闭包中定义的变量不可见.

转载注明原文:使用平行包有光泽 - 代码日志