整套反应函数的闪亮应用进度条

Question

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

我在withProgress（）和Progress对象中发现了Shiny，但是 - 如果我得到了正确的结果 - 那些必须放在一个反应​​函数中，然后显示该函数的进度。但是，我有一整套不同的renderPlot（）函数需要处理，并且想显示所有这些函数的累计进度。

当在网上搜索时，我还发现了ShinySky软件包，它似乎有一个busyIndi​​cator，可以在Shiny忙于一定时间以上时打开它。但是，当我尝试安装它时，我收到了错误消息“软件包shinysky”不可用（对于R版本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) 

我正在寻找一种方法来显示一个进度条当第一个函数在点击提交按钮后忙时开始，直到所有图都完成。如果这太复杂了，我也很高兴用任何其他方法告诉用户someting实际上发生在后台，因此要求有一定的耐心。

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)