Рендеринг сюжетных графиков асинхронно в блестящем приложении - PullRequest
1 голос
/ 27 июня 2019

В блестящем приложении я отрисовываю сразу несколько сюжетных графиков, но они отрисовывают только после того, как все они рассчитаны. Например, если рендеринг 8 из 9 сюжетов занимает 8 секунд, а рендеринг 9-го занимает 15 секунд, первые 8 сюжетов появятся только после рендеринга 9-го (через 15 секунд вместо 8). Смотрите пример ниже.

box_plot1 появляется только тогда, когда box_plot2 отображается. Я немного поиграл с блестящими обещаниями, но пока не нашел решения.

MWE:

library(shinydashboard)
library(plotly)

header <- dashboardHeader(
  title = ""
)

body <- dashboardBody(
  fluidRow(
    column(width = 6,
           box(width = NULL, solidHeader = TRUE,
               plotly::plotlyOutput("box_plot1")
           )
    ),
    column(width = 6,
           box(width = NULL, solidHeader = TRUE,
               plotly::plotlyOutput("box_plot2")
           )
    )
  )
)

ui <- dashboardPage(
  header,
  dashboardSidebar(disable = TRUE),
  body
)

server <- function(input, output, session) {

  output$box_plot1 <- plotly::renderPlotly({
    p <- plot_ly(ggplot2::diamonds, x = ~cut, y = ~price, color = ~clarity, type = "box") %>%
      layout(boxmode = "group")

    p
  })

  output$box_plot2 <- plotly::renderPlotly({

    for (i in 1:3) {
      print(i)
      Sys.sleep(1)
    }

    plot_ly(ggplot2::diamonds, y = ~price, color = ~cut, type = "box")
  })
}

shinyApp(ui = ui, server = server)

Ответы [ 2 ]

1 голос
/ 27 июня 2019

Ответ @DSGym работает для показа одного графика за другим, но он по-прежнему не работает асинхронно. На самом деле, если у вас есть график, для визуализации которого требуется много времени, или фрейм данных, для расчета которого требуется много времени, нам нужно выполнять эти операции асинхронно. В качестве примера рассмотрим это обычное блестящее приложение без асинхронной поддержки,

library(shinydashboard)
library(plotly)
library(future)
library(promises)

plan(multisession)

header <- dashboardHeader(
  title = ""
)

body <- dashboardBody(
  fluidRow(
    column(width = 6,
           box(width = NULL, solidHeader = TRUE,
               plotly::plotlyOutput("box_plot1")
           )
    ),
    column(width = 6,
           box(width = NULL, solidHeader = TRUE,
               plotly::plotlyOutput("box_plot2")
           )
    )
  )
)

ui <- dashboardPage(
  header,
  dashboardSidebar(disable = TRUE),
  body
)

server <- function(input, output, session) {

  output$box_plot1 <- plotly::renderPlotly({

      for (i in 1:10) {
        print(i)
        Sys.sleep(1)
      }

      plot_ly(ggplot2::diamonds, x = ~cut, y = ~price, color = ~clarity, type = "box") %>%
        layout(boxmode = "group")
  })

  output$box_plot2 <- plotly::renderPlotly({


      for (i in 11:20) {
        print(i)
        Sys.sleep(1)
      }

      plot_ly(ggplot2::diamonds, y = ~price, color = ~cut, type = "box")


  })
}

shinyApp(ui = ui, server = server)

Каждый график считается до 10 и показывает его результат. Вся операция занимает более 20 секунд с момента выполнения runApp().

Для асинхронного вызова обоих графиков мы используем пакет фьючерсов и обещаний.

library(shinydashboard)
library(plotly)
library(future)
library(promises)

plan(multisession)

header <- dashboardHeader(
  title = ""
)

body <- dashboardBody(
  fluidRow(
    column(width = 6,
           box(width = NULL, solidHeader = TRUE,
               plotly::plotlyOutput("box_plot1")
           )
    ),
    column(width = 6,
           box(width = NULL, solidHeader = TRUE,
               plotly::plotlyOutput("box_plot2")
           )
    )
  )
)

ui <- dashboardPage(
  header,
  dashboardSidebar(disable = TRUE),
  body
)

server <- function(input, output, session) {

  output$box_plot1 <- plotly::renderPlotly({
    future({
      for (i in 1:10) {
        print(i)
        Sys.sleep(1)
      }

      plot_ly(ggplot2::diamonds, x = ~cut, y = ~price, color = ~clarity, type = "box") %>%
        layout(boxmode = "group")
    })
  })

  output$box_plot2 <- plotly::renderPlotly({

    future({
      for (i in 11:20) {
        print(i)
        Sys.sleep(1)
      }

      plot_ly(ggplot2::diamonds, y = ~price, color = ~cut, type = "box")
    })

  })
}

shinyApp(ui = ui, server = server)

Теперь, несмотря на то, что оба графика насчитывают до 10, графики выполняются асинхронно. Общее время загрузки участков уменьшено до 20 секунд.

Однако оба графика по-прежнему загружаются вместе. Это из-за врожденного цикла промывки в блестящем. Следовательно, даже если мы выполняем графики асинхронно, все графики всегда будут загружаться одновременно.

Подробнее об этом можно прочитать здесь: https://rstudio.github.io/promises/articles/shiny.html

1 голос
/ 27 июня 2019

Вы можете использовать renderUI в сочетании с reactiveValues, которые отслеживают порядок расчетов.

library(shinydashboard)
library(plotly)

header <- dashboardHeader(
    title = ""
)

body <- dashboardBody(
    fluidRow(
        column(width = 6,
               uiOutput("plot1")
        ),
        column(width = 6,
               uiOutput("plot2")
        )
    )
)

ui <- dashboardPage(
    header,
    dashboardSidebar(disable = TRUE),
    body
)

server <- function(input, output, session) {

    rv <- reactiveValues(val = 0)


    output$plot1 <- renderUI({

        output$box_plot1 <- plotly::renderPlotly({

            for (i in 3:5) {
                print(i)
                Sys.sleep(1)
            }

            p <- plot_ly(ggplot2::diamonds, x = ~cut, y = ~price, color = ~clarity, type = "box") %>%
                layout(boxmode = "group")
            rv$val <- 1
            p
        })

        return(
            tagList(
                box(width = NULL, solidHeader = TRUE,
                    plotly::plotlyOutput("box_plot1")
                )
            )
        )

    })



    output$plot2 <- renderUI({

        if(rv$val == 0) {
            return(NULL)
        }

        output$box_plot2 <- plotly::renderPlotly({

            for (i in 1:3) {
                print(i)
                Sys.sleep(1)
            }

            plot_ly(ggplot2::diamonds, y = ~price, color = ~cut, type = "box")
        })

        return(
            tagList(
                box(width = NULL, solidHeader = TRUE,
                    plotly::plotlyOutput("box_plot2")
                )
            )
        )

    })



}

shinyApp(ui = ui, server = server)
...