【问题标题】:Adding a progress bar to indicate ggplotting progress in Shiny在 Shiny 中添加进度条以指示 ggplotting 进度
【发布时间】:2018-11-07 19:20:44
【问题描述】:

我的 Shiny 应用程序的主要目标是通过(交互式)ggplots 显示大量数据。有了足够的数据,显示图表所需的时间可能长达 10 秒左右,我想显示一个进度条来提供反馈。

我已经尝试了 withProgress 和 winProgressBar,但都没有反映 ggplots 出现所需的时间:两个进度条在显示实际图之前很久就消失了。

所以我的问题是:如何实现(任何类型的)进度条以反映 ggplots 出现在屏幕上所需的时间?

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

ui = fluidPage(
    mainPanel(
      uiOutput("plots")
    )
)

server = function(input, output) {

  #list of things I want to plot, which will be split over column wt
  plotlist = sort(unique(mtcars$wt))[1:4]

  observe({
    pb = winProgressBar(                                 #test 1: winProgressBar
      title = 'observe',                                 #test 1: winProgressBar
      label = 'plotting'                                 #test 1: winProgressBar
    )                                                    #test 1: winProgressBar
    message({                                            #test 1: winProgressBar

      withProgress(message = 'ggplotting', value = 0, {  #test 2: withProgress

        for (i in plotlist) local({

          nm <- i
          temp.data <- filter(mtcars, wt == plotlist[nm])

          plotAname  <- paste0("plotA", nm)
          output[[plotAname]] <- renderPlot(ggplot(temp.data, aes(x = mpg, y= cyl)) + geom_point())

          plotBname  <- paste0("plotB", nm)
          output[[plotBname]] <- renderPlot(ggplot(temp.data, aes(x = mpg, y= drat)) + geom_point())

          plotCname  <- paste0("plotC", nm)
          output[[plotCname]] <- renderPlot(ggplot(temp.data, aes(x = mpg, y= disp)) + geom_point())

          plotDname  <- paste0("plotD", nm)
          output[[plotDname]] <- renderPlot(ggplot(temp.data, aes(x = mpg, y= hp)) + geom_point())

          setWinProgressBar(pb, value = nm/10)         #test 1: winProgressBar
          incProgress(1/(length(plotlist)))            #test 2: withProgress
        }) #end of for()
      }) #end of withProgress                          #test 2: withProgress

    close(pb)                                          #test 1: winProgressBar
    }) #end of message                                 #test 1: winProgressBar
  }) #end of observe

  output$plots <- renderUI({

    withProgress(message = 'rendering', value = 0, {   #test 3: withProgress

      plot_output_list <- lapply(plotlist, function(i) { 

        incProgress(1/(length(plotlist)))              #test 3: withProgress

        #encompass everything in a div because lapply can only returns a single result per loop cycle. 
        div(style = "padding: 0px; margin: 0px;",
            div(style = "position:relative; margin-bottom: -5px; padding: 0px;",
                plotOutput(paste0("plotA", i))
            ),
            div(style = "position:relative; margin-bottom: -5px; padding: 0px;",
                plotOutput(paste0("plotB", i))
            ),
            div(style = "position:relative; margin-bottom: -5px; padding: 0px;",
                plotOutput(paste0("plotC", i))
            ),
            plotOutput(paste0("plotD", i))
        )
      }) #end of lapply
    }) #end of withProgress                          #test 3: withProgress
  }) #end of output$plots

}

shinyApp(ui = ui, server = server)

这个例子大约需要 4 秒来显示它的图。大约 1 秒后,所有三个测试进度条都已完成。

感谢您抽出宝贵时间完成此操作!如果我能提供任何澄清,请告诉我。

【问题讨论】:

  • 运行您的代码时,由于 winProgressBar 函数而出现错误。它似乎已从 utils 包中删除。
  • 这里没有错误!我目前正在运行 utils v3.5.1。您可以使用注释“test 1”注释掉任何行,它应该可以再次工作。
  • 仅供参考:我收到 utils 3.4.4 的错误。

标签: r ggplot2 shiny


【解决方案1】:

它实际上并不是您想要生成的进度条。但是您可以改为在横幅中显示加载消息,这就是我认为它在这里可能有用的原因。只需将以下代码-sn-p 复制到应用的 ui-part 中并根据需要调整颜色即可。

info_loading <- "Shiny is busy. Please wait."
your_color01 <- # define a color for the text
your_color02 <- # define a color for the background of the banner

tags$head(tags$style(type="text/css",
                                      paste0("
                                             #loadmessage {
                                             position: fixed;
                                             top: 0px;
                                             left: 0px;
                                             width: 100%;
                                             padding: 5px 0px 5px 0px;
                                             text-align: center;
                                             font-weight: bold;
                                             font-size: 100%;
                                             color: ", your_color01,";
                                             background-color: ", your_color02,";
                                             z-index: 105;
                                             }
                                             "))),
                 conditionalPanel(condition="$('html').hasClass('shiny-busy')",
                                  tags$div(info_loading,id="loadmessage"))

根据需要随时调整参数(例如顶部位置)。 您可能会进一步看到:shiny loading bar for htmlwidgets

【讨论】:

  • 感谢您的建议!您的解决方案适用于示例代码,并且大部分时间都适用于我的应用程序。它不起作用的一种情况是绘图列表增加时(在示例中,这将是绘图列表变长时)。在这些情况下,只有当用户向下滚动到将出现绘图的空间时才会出现 info_loading 消息……这与 tags$head 有关系吗?
  • 我不能在这里给你一个具体的答案,因为我以前从未遇到过这个问题。你的意思是它只在滚动时出现?或者它只是出现在屏幕顶部,因此看不到?您可以尝试调整横幅的位置参数。 tags$head 可能与这个问题有关,但我不确定哪个标签更适合这里。您可以使用不同的标签,看看会发生什么(请参阅:shiny.rstudio.com/articles/tag-glossary.html
  • 确实是position参数的原因!再次感谢:)
猜你喜欢
  • 2021-10-16
  • 2016-08-20
  • 2012-08-26
  • 1970-01-01
  • 1970-01-01
  • 1970-01-01
  • 2011-05-18
  • 2019-12-05
相关资源
最近更新 更多