我的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秒钟后结束。
感谢您抽出宝贵的时间来完成此工作!如果可以提供任何说明,请告诉我。
答案 0 :(得分:0)
实际上并不是您想要生成的进度条。但是您可以改为在横幅内显示加载消息,这就是为什么我认为它在这里可能有用的原因。只需将以下代码段复制到应用的ui部分中,然后根据需要调整颜色即可。
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