注意：我已经阅读了在Shiny Googlegroups和这里在SO上关于这个主题的几乎所有讨论。
我需要一个指示器来显示Shiny服务器正在忙碌。我尝试过shiny-incubator，但问题是我无法设置进度条的最大值。
我不想要像这样的东西：https://shiny.rstudio.com/gallery/progress-bar-example.html
我需要的是：
更新2018年：目前有一个很好的包可以帮助您显示加载器：shinycssloaders（来源：https://github.com/andrewsali/shinycssloaders）
我也一直在寻找这个功能。大多数人建议使用条件面板如下：
conditionalPanel(
condition="!($('html').hasClass('shiny-busy'))",
img(src="images/busy.gif")
)
你可以随时增加自己的控制并在ui.R中像这样创建条件处理（也许取决于更多内容）：
你总是可以给自己更多控制，并在ui.R中创建条件处理（也许要依赖更多的东西），如下所示：
div(class = "busy",
p("Calculation in progress.."),
img(src="images/busy.gif")
)
这里有一些 JavaScript 处理显示和隐藏该 div 的操作：
setInterval(function(){
if ($('html').attr('class')=='shiny-busy') {
$('div.busy').show()
} else {
$('div.busy').hide()
}
},100)
通过一些额外的CSS，您可以确保动画忙碌图像获得固定位置，始终可见。
在上述任何情况下，我发现“shiny-busy”状态有些不精确和不可靠：当计算仍在进行时，div会显示一小段时间，然后消失...我找到了一个不太优美的解决方案来解决这个问题，至少在我的应用程序中是如此。请随意尝试并且也许有人可以给出为什么以及如何解决该问题的见解。
在您的server.R中，您需要添加两个reactiveValues：
shinyServer(function(input, output, session) {
# Reactive Value to reset UI, see render functions for more documentation
uiState <- reactiveValues()
uiState$readyFlag <- 0
uiState$readyCheck <- 0
然后，在您的 renderPlot 函数中（或其他进行计算的输出函数中），您可以使用这些反应式值重新设置函数：
output$plot<- renderPlot({
if (is.null(input$file)){
return()
}
if(input$get == 0){
return()
}
uiState$readyFlag
# DIRTY HACK:
# Everytime "Get Plot" is clicked we get into this function
# In order for the ui to be able show the 'busy' indicator we
# somehow need to abort this function and then of course seamlessly
# call it again.
# We do this by using a reactive value keeping track of the ui State:
# renderPlot is depending on 'readyFlag': if that gets changed somehow
# the reactive programming model will call renderPlot
# If readyFlag equals readyCheck we exit the function (= ui reset) but in the
# meantime we change the readyFlag, so the renderHeatMap function will
# immediatly be called again. At the end of the function we make sure
# readyCheck gets the same value so we are back to the original state
isolate({
if (uiState$readyFlag == uiState$readyCheck) {
uiState$readyFlag <- uiState$readyFlag+1
return(NULL)
}
})
isolate({plot <- ...})
# Here we make sure readyCheck equals readyFlag once again
uiState$readyCheck <- uiState$readyFlag
return(plot)
})
或者，您可以使用shinycssloaders软件包https://github.com/andrewsali/shinycssloaders
library(shiny)
library(dplyr)
library(shinycssloaders)
ui <- fluidPage(
actionButton("plot","plot"),
plotOutput("Test") %>% withSpinner(color="#0dc5c1")
)
server <- function(input, output, session) {
data <- eventReactive(input$plot,{
rnorm(1:100000)
})
output$Test <- renderPlot({
plot(data())
})
}
shinyApp(ui = ui, server = server)
Using waiter
library(shiny)
library(waiter)
ui <- fluidPage(
use_waiter(),
actionButton("plot","plot"),
plotOutput("Test")
)
server <- function(input, output, session) {
w <- Waiter$new(id = "Test")
data <- eventReactive(input$plot,{
w$show()
rnorm(1:100000)
})
output$Test <- renderPlot({
plot(data())
})
}
shinyApp(ui = ui, server = server)
我发现使用fadeIn()而不是show()可以减轻这种闪烁的情况：
setInterval(function(){
if ($('html').attr('class')=='shiny-busy') {
setTimeoutConst = setTimeout(function(){
$('#loading-page').fadeIn(500);
}, delay);
} else {
clearTimeout(setTimeoutConst );
$('#loading-page').hide();
}
},10)
if( ($('html').attr('class')=='shiny-busy') ){
setTimeout(function() {
if ($('html').attr('class')=='shiny-busy') {
if($('#textit').html()!='Waiting...' ){
$('div.busy1').show()
}
if($('#textit').html()=='Waiting...'){
$('div.busy2').show()
}
}
},1000)
} else {
$('div.busy1').hide()
$('div.busy2').hide()
}
},100)
withSpinner（plotOutput（“Test”））。 - KaterenderUI({ withProgress(..., {plotOutput(...) %>% shinycssloaders::withSpinner()})})中也是如此。 - Brian D