全套反应功能的闪亮应用程序进度条

Question

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

我在 Shiny 中找到了 withProgress() 和 Progress 对象，但是——如果我做对了——它们总是必须放在一个反应​​函数中，然后显示该函数的进度。但是，我有一整套不同的 renderPlot() 函数要处理，并且想显示所有这些函数的累积进度。

在网上搜索时，我还发现了 ShinySky 包，它似乎有一个 busyIndi​​cator，可以设置为在 Shiny 忙碌超过一定时间时打开。但是，我在尝试安装时收到错误消息“package ‘shinysky’ is not available (for R version 3.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)

我正在寻找一种显示进度条的方法，该进度条在第一个函数在点击提交按钮后变得繁忙时开始，并一直持续到完成所有绘图。如果这变得太复杂，我也很乐意通过任何其他方式告诉用户后台确实发生了某些事情，因此需要一些耐心。

Answer 1

这是解决此问题的一种方法，但在每个图上都有一个微调器。它完全基于 Dean Atali 的this 解决方案。需要 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)