更新

Question

（问题描述后的代码如下）

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

所以，我创建了一个条件面板，显示一条带有以下内容的“正在加载”消息（称为模态）（感谢Shiny Google小组中Joe Cheng的条件声明）：

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

如果用户仍在当前选项卡上，则此操作正常。但是，用户可以切换到另一个选项卡（可能包含一些需要运行一段时间的计算），但加载面板会立即显示并消失，而R会在计算结果时突然显示，然后仅在之后刷新内容它完成了。

由于这可能难以想象，我在下面提供了一些代码。您会注意到单击按钮开始计算将产生一个很好的加载消息。但是，当您切换到选项卡2时，R开始运行一些计算，但无法显示加载消息（可能Shiny没有注册为忙？）。如果再次按下按钮重新开始计算，则加载屏幕将正确显示。

我希望在切换到正在加载的标签时显示加载消息！

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 group，Joe Cheng向我指出了shinyIncubator包，其中有一个正在实施的进度条功能（安装?withProgress后请参阅shinyIncubator包）。

将来可能会将此功能添加到Shiny包中，但现在可以使用。

示例：

<强> 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

这是使用您原始方法的可能解决方案。

首先使用选项卡的标识符：

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."))
    })
  })

当你从第一个标签转到第二个标签时，你会看到它有效。

更新

最干净的选项包括定义捕获活动tabset的反应对象。只需在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

我认为最简单的选择是在shinysky包中使用 busyIndicator 功能。有关详细信息，请参阅此link

在更改选项卡面板时显示Shiny正忙（或加载）

3 个答案:

更新