【发布时间】: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 的错误。