Question

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

tags$script('
    Shiny.addCustomMessageHandler("setText", function(text) {
        document.getElementById("output").innerHTML = text;
    })          
')

然后在您的server.R中，您可以致电session$sendCustomMessage(type='foo', 'foo')。

假设我有一个长时间运行的函数，它会返回一些数据进行绘图。如果我这样做，R线程在运行此函数时很忙，因此在这段时间内无法处理其他请求。能够使用期货包运行此函数非常有用，因此它可以与代码异步运行，并且异步调用回调。但是，当我尝试这只是似乎没有工作。

对不起，如果不是很清楚。作为一个简单的示例，以下内容应该有效，直到您取消注释尝试在server.R中调用future的两行。一旦取消注释这些行，就不会调用回调。显然它在这个例子的上下文中并没有实际用处，但我认为它一般非常有用。

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

Answer 1

以下是如何在闪亮的应用中使用未来包的解决方案。当运行计算密集型任务或等待sql查询完成时，可能有多个会话没有会话阻塞另一个会话。我建议打开两个会话（只需在两个选项卡中打开http://127.0.0.1:14072/）并使用按钮来测试功能。

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

Answer 2

我重新安排了AndréleBlond的excellent answer并且做了一个要点，展示了一个通用的异步任务处理器，可以单独使用，也可以使用Shiny：FutureTaskProcessor.R

请注意，它包含两个文件：FutureProcessor.R，它是独立的异步任务处理程序，app.R是一个闪亮的应用程序，显示在Shiny中使用异步处理程序。

Answer 3

对于Shiny应用程序中R的单线程特性，一个无可否认复杂的解决方法是执行以下操作：

Splinter off off外部R进程（运行另一个R脚本）闪亮的应用程序目录，或从中可访问的任何目录来自R内部的闪亮会话（我之前尝试过这种分裂，它有效。）
配置该脚本以将其结果输出到临时目录（假设您在基于Unix的系统上运行Shiny）并为输出文件提供唯一的文件名（最好在当前会话的命名空间中命名（即“/”） tmp / [SHINY SESSION HASH ID] _example_output_file.RData“。
使用Shiny的invalidateLater（）函数检查是否存在该输出文件。
将输出文件加载到Shiny会话工作区。
最后，通过在加载后删除生成的输出文件来收集垃圾。

我希望这会有所帮助。

从未来内部调用闪亮的JavaScript回调

3 个答案: