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

问题描述

在 Shiny 中，可以从服务器的逻辑调用用 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屋！