r - 在响应式(Reactive) R shiny 中使用 future 和 promise

Question

我有一个关于 R shiny 的问题，尤其是关于提高我的 shiny 应用程序性能的方法。我正在使用一些需要很长时间才能运行的 SQL 查询以及一些需要时间才能显示的图。我知道可以使用 future 和 promises 但我不知道如何在响应式(Reactive)表达式中使用它们。

我在下面向您展示了一个非常简单的示例:

library(shiny)
library(ggplot2)
library(plotly)
library(dplyr)

ui <- fluidPage(
  selectInput("id1", "Choose:", choices = unique(as.character(iris$Species))),
  dataTableOutput("my_data"),
  plotlyOutput("my_plot")
)

server <- function(input, output, session) {
  
  output$my_data <- renderDataTable({
    iris %>% filter(Species == input$id1)
  })
  
  data_to_plot <- reactive({
    Sys.sleep(10)
    res <- ggplot(iris %>% filter(Species == input$id1), aes(x=Sepal.Length)) + geom_histogram()
    return(res)
  })
  
  output$my_plot <- renderPlotly({
    ggplotly(data_to_plot())
  })
  
  
  
}

shinyApp(ui, server)

在这种情况下，我们可以看到应用程序在显示整个应用程序之前等待绘图部分结束计算。但是，即使带有绘图的部分尚未完成计算，我也希望数据表显示出来。

非常感谢您的帮助!

Answer 1

官方 Shiny 不支持 session 内非阻塞 promise 。

请阅读this仔细。

以下是如何将上述解决方法应用到您的代码中:

library(shiny)
library(ggplot2)
library(plotly)
library(dplyr)
library(promises)
library(future)

plan(multisession)

ui <- fluidPage(
  selectInput("id1", "Choose:", choices = unique(as.character(iris$Species))),
  dataTableOutput("my_data"),
  plotlyOutput("my_plot")
)

server <- function(input, output, session) {
  
  output$my_data <- renderDataTable({
    iris %>% filter(Species == input$id1)
  })
  
  data_to_plot <- reactiveVal()
  
  observe({
    # see: https://cran.r-project.org/web/packages/promises/vignettes/shiny.html
    # Shiny-specific caveats and limitations
    idVar <- input$id1
    
    # see https://github.com/rstudio/promises/issues/23#issuecomment-386687705
    future_promise({
      Sys.sleep(10)
      ggplot(iris %>% filter(Species == idVar), aes(x=Sepal.Length)) + geom_histogram()
      }) %...>%
      data_to_plot() %...!%  # Assign to data
      (function(e) {
        data(NULL)
        warning(e)
        session$close()
      }) # error handling
    
    # Hide the async operation from Shiny by not having the promise be
    # the last expression.
    NULL
  })
  
  output$my_plot <- renderPlotly({
    req(data_to_plot())
    ggplotly(data_to_plot())
  })
  
}

shinyApp(ui, server)