当更改选项卡面板时，显示SHINY正忙(或正在加载) [英] Show that Shiny is busy (or loading) when changing tab panels

问题描述

(代码跟随在问题描述之后)

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

因此，我创建了一个条件面板，它显示一条"正在加载"消息(称为模式)，其中包含以下内容(感谢条件语句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."))
    })
  })
})

推荐答案

通过Shiny Google group，Joe Cheng将我指向shinyIncubator包，其中有一个正在实现的进度条功能(请参阅安装shinyIncubator包后的?withProgress)。

也许将来会将此函数添加到闪亮的包中，但此功能目前有效。

示例：

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

服务器.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)
  })
})

这篇关于当更改选项卡面板时，显示SHINY正忙(或正在加载)的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！