Используйте будущее и обещайте внутри реактивного R блестящий

Question

У меня есть вопрос относительно R shiny и, в частности, о способе повышения производительности моего блестящего приложения. Я использую некоторые SQL-запросы, выполнение которых занимает довольно много времени, а также некоторый сюжет, для отображения которого требуется время. Я знаю, что можно использовать а также но я не могу понять, как использовать их в реактивных выражениях.

Ниже я покажу вам действительно простой пример:

      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 не поддерживает неблокирующие обещания внутри сеанса.

Пожалуйста, прочтите это внимательно.

Вот как применить описанный выше обходной путь к вашему коду:

      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)