用于整套反应性函数的闪亮的应用程序进度条

Question

我正在开发一个闪亮的应用程序，用户可以从下拉菜单中选择一个基因，点击提交按钮，然后显示该基因的一组不同的图表。生成所有这些图形的计算需要一些时间，我希望显示一个进度条或一些通知，说明它很忙，这样用户就可以远离submit按钮。

我发现withProgress()和闪闪发光，但是--如果我做对了--它们总是必须放在一个反应性函数中，然后显示这个函数的进度。但是，我有一整套不同的renderPlot()函数要处理，并希望显示所有这些函数的累积进度。

在搜索网页时，我还找到了包ShinySky，它似乎具有一个busyIndicator，它可以设置为在发亮时间超过一定时间的时间内打开。然而，当我试图安装它时，我收到了错误消息“软件包‘shinysky’是不可用的(对于RVersion3.3.1)”。

我使用带有时间延迟的nycflights13天气数据生成了一个小型虚拟应用程序，以说明更改输入后的情节刷新：

library(shiny)
library(nycflights13)

ui <- fluidPage(
  wellPanel(
    fluidRow(
      column(12, offset = 0,
        titlePanel("Look up airport weather data"))),
    fluidRow(
      column(3, offset = 0,
        selectizeInput(inputId = "airportName", label = "",
          choices = c("EWR", "JFK", "LGA")))),
    fluidRow(
      column(12, offset = 0,
        actionButton(inputId = "klickButton", label = "Submit")))),
  fluidRow(
    column(6, offset = 0,
      plotOutput(outputId = "windHist")),
    column(6, offset = 0,
      plotOutput(outputId = "windData"))),
  fluidRow(
    column(6, offset = 0,
      plotOutput(outputId = "precipData")),
    column(6, offset = 0,
      plotOutput(outputId = "tempData")))
)


server <- function(input, output) {
  wSubset <- eventReactive(input$klickButton, {
    subset(weather, weather$origin == input$airportName)})
  output$windHist <- renderPlot({
    Sys.sleep(1)
    hist(wSubset()$wind_dir)})
  output$windData <- renderPlot({
    Sys.sleep(1)
    plot(wSubset()$wind_speed, wSubset()$wind_gust)})
  output$precipData <- renderPlot({
    Sys.sleep(1)
    plot(wSubset()$humid, wSubset()$precip)})
  output$tempData <- renderPlot({
    Sys.sleep(1)
    plot(wSubset()$temp, wSubset()$dewp)})
}


shinyApp(ui = ui, server = server)

我正在寻找一种方式来显示一个进度条，当第一个函数在点击submit按钮后变得繁忙，并一直持续到所有的情节都完成为止。如果这变得太复杂，我也很高兴有任何其他方式告诉用户，某些事情实际上正在发生在后台，因此需要一些耐心。

Answer 1

这是解决这一问题的一种方法，但在每个情节上都有一个旋转器。它完全基于迪安·阿塔利的这解决方案。在单击Submit按钮之前，需要JS代码来隐藏旋转器。一旦按钮被点击，旋转器就会显示出来。将spinner.gif和JS代码放在www文件夹中。

spinnerManage.js

$(document).ready(function() {
            $('#klickButton').click(function() {
            $(".loading-spinner").show();
        });  
    });
    $(document).on("shiny:connected", function(e) {
            $(".loading-spinner").hide();
    });

app.R

library(shiny)
    library(nycflights13)

    mycss <- "
    .plot-container {
      position: relative;
    }
    .loading-spinner {
      position: absolute;
      left: 50%;
      top: 50%;
      z-index: -1;
      margin-top: -33px;  /* half of the spinner's height */
      margin-left: -33px; /* half of the spinner's width */
    }
    "

    ui <- fluidPage(
            tags$head(tags$style(HTML(mycss)),
                      includeScript("./www/spinnerManage.js")),
            wellPanel(
                    fluidRow(
                            column(12, offset = 0,
                                   titlePanel("Look up airport weather data"))),
                    fluidRow(
                            column(3, offset = 0,
                                   selectizeInput(inputId = "airportName", label = "",
                                                  choices = c("EWR", "JFK", "LGA")))),
                    fluidRow(
                            column(12, offset = 0,
                                   actionButton(inputId = "klickButton", label = "Submit")))),
            fluidRow(
                    column(6, offset = 0,
                           div(class = "plot-container",
                                       tags$img(src = "spinner.gif",
                                                class = "loading-spinner"),           
                           plotOutput(outputId = "windHist"))
                    ),
                    column(6, offset = 0,
                           div(class = "plot-container",
                               tags$img(src = "spinner.gif",
                                        class = "loading-spinner"),           
                               plotOutput(outputId = "windData"))
                           )),
            fluidRow(
                    column(6, offset = 0,
                           div(class = "plot-container",
                               tags$img(src = "spinner.gif",
                                        class = "loading-spinner"),           
                               plotOutput(outputId = "precipData"))
                           ),
                    column(6, offset = 0,
                           div(class = "plot-container",
                               tags$img(src = "spinner.gif",
                                        class = "loading-spinner"),           
                               plotOutput(outputId = "tempData"))
    ))
    )


    server <- function(input, output) {
            wSubset <- eventReactive(input$klickButton, {
                    subset(weather, weather$origin == input$airportName)})
            output$windHist <- renderPlot({
                    Sys.sleep(1)
                    hist(wSubset()$wind_dir)})
            output$windData <- renderPlot({
                    Sys.sleep(1)
                    plot(wSubset()$wind_speed, wSubset()$wind_gust)})
            output$precipData <- renderPlot({
                    Sys.sleep(1)
                    plot(wSubset()$humid, wSubset()$precip)})
            output$tempData <- renderPlot({
                    Sys.sleep(1)
                    plot(wSubset()$temp, wSubset()$dewp)})
    }


    shinyApp(ui = ui, server = server)