整套反應函數的閃亮應用進度條

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)