渲染在闪亮的应用程序中异步绘制图块

时间:2019-06-27 17:15:25

标签: r asynchronous shiny promise plotly

在闪亮的应用程序中,我可以一次绘制几个绘图,但只有在计算所有绘图后才渲染。例如,如果渲染9个地块中的8个需要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 个答案:

答案 0 :(得分:1)

您可以结合使用renderUIreactiveValues来跟踪计算顺序。

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)

答案 1 :(得分:1)

@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并显示其输出。从执行runApp()开始,整个过程需要20秒钟以上的时间。

要异步调用两个图,我们使用Futures和Promise程序包。

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