从未来开始调用闪亮的JavaScript回调 [英] Calling a shiny JavaScript Callback from within a future

问题描述

闪亮时，可以从服务器的逻辑中调用用javascript编写的客户端回调。在 ui.R 中说，您有一些JavaScript，其中包括一个名为 setText 的函数：

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

然后在您的 server.R ，您可以调用 session $ sendCustomMessage（type ='foo'，'foo'）。

then in your server.R you can call session$sendCustomMessage(type='foo', 'foo').

假设我有一个长期运行的函数，该函数返回一些要绘制的数据。如果我正常执行此操作，则R线程在运行此功能时很忙，因此此时无法处理其他请求。能够使用Futures包运行此函数，以使其与代码异步运行，并异步调用回调，这将非常有用。但是，当我尝试执行此操作时似乎没有任何效果。

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.

很抱歉，如果不清楚。举一个简单的例子，在您取消注释试图在 server.R 中调用future的两行之前，下面的方法应该起作用。一旦取消注释这些行，就永远不会调用该回调。显然，在此示例的上下文中它实际上没有用，但是我认为它通常会非常有用。

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

推荐答案

这里是有关如何在闪亮的应用程序中使用将来的程序包的解决方案。
在运行计算密集型任务或等待sql查询完成时，可能会有多个会话，而没有会话阻塞另一个会话。我建议打开两个会话（只需在两个标签中打开 http://127.0.0.1:14072/ ），然后

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

这篇关于从未来开始调用闪亮的JavaScript回调的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！