在更改标签面板时显示Shiny正忙（或加载）

（问题描述后面的代码）

我正在使用Shiny制作一个Web应用程序，而我正在执行的一些R命令需要几分钟才能完成。 我发现我需要向用户提供Shiny正在工作的一些指示，或者他们会不断更改我在侧面板中提供的参数，这只会导致Shiny在初始运行完成后react native地重新启动计算。

于是，我创build了一个条件面板，显示一个“加载”消息（称为模态），其中包括以下条件（感谢Joe Cheng在Shiny Google小组的条件语句）：

# generateButton is the name of my action button loadPanel <- conditionalPanel("input.generateButton > 0 && $('html').hasClass('shiny-busy')"), loadingMsg) 

如果用户保持在当前选项卡上，则按预期工作。 但是，用户可以切换到另一个选项卡（可能包含一些需要运行一段时间的计算），但是加载面板会立即出现并消失，而R则在计算时突然消失，然后仅在它完成了。

由于这可能难以形象化，我提供了一些代码在下面运行。 你会注意到，点击button开始计算将产生一个很好的加载消息。 然而，当你切换到标签2，R开始运行一些计算，但没有显示加载消息（也许Shiny不注册为繁忙？）。 如果您再次按下button重新开始计算，加载屏幕将正确显示。

我希望切换到正在加载的选项卡时显示加载消息！

ui.R

 library(shiny) # Code to make a message that shiny is loading # Make the loading bar loadingBar <- tags$div(class="progress progress-striped active", tags$div(class="bar", style="width: 100%;")) # Code for loading message loadingMsg <- tags$div(class="modal", tabindex="-1", role="dialog", "aria-labelledby"="myModalLabel", "aria-hidden"="true", tags$div(class="modal-header", tags$h3(id="myModalHeader", "Loading...")), tags$div(class="modal-footer", loadingBar)) # The conditional panel to show when shiny is busy loadingPanel <- conditionalPanel(paste("input.goButton > 0 &&", "$('html').hasClass('shiny-busy')"), loadingMsg) # Now the UI code shinyUI(pageWithSidebar( headerPanel("Tabsets"), sidebarPanel( sliderInput(inputId="time", label="System sleep time (in seconds)", value=1, min=1, max=5), actionButton("goButton", "Let's go!") ), mainPanel( tabsetPanel( tabPanel(title="Tab 1", loadingPanel, textOutput("tabText1")), tabPanel(title="Tab 2", loadingPanel, textOutput("tabText2")) ) ) )) 

server.R

 library(shiny) # Define server logic for sleeping shinyServer(function(input, output) { sleep1 <- reactive({ if(input$goButton==0) return(NULL) return(isolate({ Sys.sleep(input$time) input$time })) }) sleep2 <- reactive({ if(input$goButton==0) return(NULL) return(isolate({ Sys.sleep(input$time*2) input$time*2 })) }) output$tabText1 <- renderText({ if(input$goButton==0) return(NULL) return({ print(paste("Slept for", sleep1(), "seconds.")) }) }) output$tabText2 <- renderText({ if(input$goButton==0) return(NULL) return({ print(paste("Multiplied by 2, that is", sleep2(), "seconds.")) }) }) }) 

Answer 1

通过Shiny Google小组 ，Joe Cheng将我指向shinyIncubator包，其中有一个正在实施的进度条function（在安装shinyIncubator包后请参阅?withProgress ）。

也许这个函数将会在未来添加到Shiny包中，但是现在这个function还是可以的。

例：

UI.R

 library(shiny) library(shinyIncubator) shinyUI(pageWithSidebar( headerPanel("Testing"), sidebarPanel( # Action button actionButton("aButton", "Let's go!") ), mainPanel( progressInit(), tabsetPanel( tabPanel(title="Tab1", plotOutput("plot1")), tabPanel(title="Tab2", plotOutput("plot2"))) ) )) 

SERVER.R

 library(shiny) library(shinyIncubator) shinyServer(function(input, output, session) { output$plot1 <- renderPlot({ if(input$aButton==0) return(NULL) withProgress(session, min=1, max=15, expr={ for(i in 1:15) { setProgress(message = 'Calculation in progress', detail = 'This may take a while...', value=i) print(i) Sys.sleep(0.1) } }) temp <- cars + matrix(rnorm(prod(dim(cars))), nrow=nrow(cars), ncol=ncol(cars)) plot(temp) }) output$plot2 <- renderPlot({ if(input$aButton==0) return(NULL) withProgress(session, min=1, max=15, expr={ for(i in 1:15) { setProgress(message = 'Calculation in progress', detail = 'This may take a while...', value=i) print(i) Sys.sleep(0.1) } }) temp <- cars + matrix(rnorm(prod(dim(cars))), nrow=nrow(cars), ncol=ncol(cars)) plot(temp) }) }) 

Answer 2

这是一个可能的解决scheme使用您的原始方法。

首先使用标签的标识符：

 tabsetPanel( tabPanel(title="Tab 1", loadingPanel, textOutput("tabText1")), tabPanel(title="Tab 2", loadingPanel, textOutput("tabText2")), id="tab" ) 

那么，如果你连接tabText1 input$tab ：

  output$tabText1 <- renderText({ if(input$goButton==0) return(NULL) input$tab return({ print(paste("Slept for", sleep1(), "seconds.")) }) }) 

当你从第一个标签页到第二个标签页时，你会看到它的作用。

更新

最干净的选项在于定义捕获活动标签集的react native对象。 只需在server.R中server.R ：

  output$activeTab <- reactive({ return(input$tab) }) outputOptions(output, 'activeTab', suspendWhenHidden=FALSE) 

有关说明，请参阅https://groups.google.com/d/msg/shiny-discuss/PzlSAmAxxwo/eGx187UUHvcJ 。

Answer 3

我认为最简单的select将使用shinysky包中的busyIndi​​cator函数。 有关更多信息，请点击此链接