用於htmlwidgets的閃亮加載欄

Question

在R/Shiny中，我正在通過各種軟件包製作一些相當詳細的htmlwidgets以進入閃亮的應用程序，並且通常可能需要很長時間才能呈現。

我想創建一個加載欄或使用加載gif讓用戶知道它正在加載...並耐心等待加載。

以下是使用dygraphs包，需要相當長的一段，一旦你開始，包括越來越多的數據，即移動滑塊越來越高......和加載時間需要更長的時間和更長......

加載的例子

我不能確定如何將進度指示器（http://shiny.rstudio.com/articles/progress.html）這個......但我願意就展示負載指示其他建議...

# load libraries 
require(dygraphs) 
require(shiny) 
require(xts) 

# create a simple app 
runApp(list(
    ui = bootstrapPage(
    sliderInput('n', '10 to the power x', min=2,max=7,value=2), 
    dygraphOutput('plot1') 
), 
    server = function(input, output) { 
    output$plot1 <- renderDygraph({ 
     v <- 10^(input$n) 
     out <- dygraph(xts(rnorm(v),Sys.time()+seq(v))) %>% 
     dyRangeSelector() 
     return(out) 
    }) 
    } 
)) 

*編輯*

我嘗試下面的基礎上在他的評論從@Carl建議....但它似乎沒有工作......請看下面......

# load libraries 
require(dygraphs) 
require(shiny) 
require(shinydashboard) 
require(xts) 

# create a simple app 
ui <- dashboardPage(title='Loading graphs', 
       dashboardHeader(
       title = 'Loading Graphs' 
      ), 
       dashboardSidebar(
       sliderInput('n', '10 to the power x', min=2,max=7,value=2) 
      ), 
       dashboardBody(
       tags$head(tags$style(type="text/css", " 
      #loadmessage { 
       position: fixed; 
       top: 0px; 
       left: 0px; 
       width: 100%; 
       padding: 5px 0px 5px 0px; 
       text-align: center; 
       font-weight: bold; 
       font-size: 100%; 
       color: #000000; 
       background-color: #CCFF66; 
       z-index: 105; 
      } 
      ")), 
       dygraphOutput('plot1'), 
       conditionalPanel(condition="$('html').hasClass('shiny-busy')", 
           tags$div("Loading...",id="loadmessage")) 
      ) 
) 
server <- function(input, output) { 
    output$plot1 <- renderDygraph({ 
    v <- 10^(input$n) 
    out <- dygraph(xts(rnorm(v),Sys.time()+seq(v))) %>% 
     dyRangeSelector() 
    return(out) 
    }) 
} 

shinyApp(ui=ui,server=server) 

也不做了以下內容：

# load libraries 
require(dygraphs) 
require(shiny) 
require(shinydashboard) 
require(xts) 

# create a simple app 
ui <- dashboardPage(title='Loading graphs', 
       dashboardHeader(
       title = 'Loading Graphs' 
      ), 
       dashboardSidebar(
       sliderInput('n', '10 to the power x', min=2,max=7,value=2) 
      ), 
       dashboardBody(
       tags$head(tags$style(HTML(" 
.progress-striped .bar { 
    background-color: #149bdf; 
    background-image: -webkit-gradient(linear, 0 100%, 100% 0, color-stop(0.25, rgba(255, 255, 255, 0.6)), color-stop(0.25, transparent), color-stop(0.5, transparent), color-stop(0.5, rgba(255, 255, 255, 0.6)), color-stop(0.75, rgba(255, 255, 255, 0.6)), color-stop(0.75, transparent), to(transparent)); 
    background-image: -webkit-linear-gradient(45deg, rgba(255, 255, 255, 0.6) 25%, transparent 25%, transparent 50%, rgba(255, 255, 255, 0.6) 50%, rgba(255, 255, 255, 0.6) 75%, transparent 75%, transparent); 
    background-image: -moz-linear-gradient(45deg, rgba(255, 255, 255, 0.6) 25%, transparent 25%, transparent 50%, rgba(255, 255, 255, 0.6) 50%, rgba(255, 255, 255, 0.6) 75%, transparent 75%, transparent); 
    background-image: -o-linear-gradient(45deg, rgba(255, 255, 255, 0.6) 25%, transparent 25%, transparent 50%, rgba(255, 255, 255, 0.6) 50%, rgba(255, 255, 255, 0.6) 75%, transparent 75%, transparent); 
    background-image: linear-gradient(45deg, rgba(255, 255, 255, 0.6) 25%, transparent 25%, transparent 50%, rgba(255, 255, 255, 0.6) 50%, rgba(255, 255, 255, 0.6) 75%, transparent 75%, transparent); 
    -webkit-background-size: 40px 40px; 
    -moz-background-size: 40px 40px; 
     -o-background-size: 40px 40px; 
      background-size: 40px 40px; 
}"))), 
       dygraphOutput('plot1') 

      ) 
) 

server <- function(input, output) { 
    output$plot1 <- renderDygraph({ 
    v <- 10^(input$n) 
    withProgress(message = 'Making plot', value = 1, { 
     out <- dygraph(xts(rnorm(v),Sys.time()+seq(v))) %>% 
     dyRangeSelector() 
    }) 
    return(out) 
    }) 
} 

shinyApp(ui=ui,server=server) 

* EDIT2 *

能像解決這個問題，可以用嗎？

How to display busy image when actual image is loading in client machine

Answer 1

的方法之一，利用第一個鏈接後它做的事:(如前所述，這仍然有一個很大的滯後時間）：

require(dygraphs) 
require(shiny) 
require(xts) 

runApp(list(
    ui = bootstrapPage(
     sliderInput('n', '10 to the power x', min=2,max=7,value=2), 
     dygraphOutput('plot1') 
    ), 
    server = function(input, output) { 
     output$plot1 <- renderDygraph({ 

      progress <- shiny::Progress$new() 
      on.exit(progress$close()) 

      progress$set(message = 'Generating plot') 

      v <- 10^(input$n) 
      out <- dygraph(xts(rnorm(v),Sys.time()+seq(v))) %>% 
       dyRangeSelector() 


      return(out) 
     }) 
    } 
)) 

我一直在想出這個現在已經有一段時間了，因爲我有類似的問題。對於這種特殊情況，我認爲圖形渲染需要約7-8秒的時間，而在瀏覽器上顯示的圖形需要約20秒（當滑塊爲6時）（或任何導致圖形生成後的延遲） 。您可以在plot命令之後添加for循環以及Sys.sleep以確認此操作。

我們還可以包含一個進度指示條（如here），這可以用for循環來完成，但這也會延遲繪圖的顯示。

require(dygraphs) 
require(shiny) 
require(xts) 

runApp(list(
    ui = bootstrapPage(
     sliderInput('n', '10 to the power x', min=2,max=7,value=2), 
     dygraphOutput('plot1') 
    ), 
    server = function(input, output, session) { 
     output$plot1 <- renderDygraph({ 

      n1 <- input$n 
      n2 <- ifelse(n1 < 5, n1, ifelse(n1 < 6, n1*5, n1*10)) 

      progress <- shiny::Progress$new(session, min=1, max=n2) 
      on.exit(progress$close()) 

      progress$set(message = 'Generating plot') 

      v <- 10^(n1) 
      out <- dygraph(xts(rnorm(v),Sys.time()+seq(v))) %>% 
       dyRangeSelector() 

      for (i in 1:n2) { 
       progress$set(value = i) 
       Sys.sleep(0.25) 
      } 

      return(out) 
     }) 
    } 
)) 

Answer 2

嗨，你可以使用JavaScript Events in Shiny與事件shiny:busy和shiny:idle，但也許有一個更好的辦法...嘗試：

# load libraries 
require(dygraphs) 
require(shiny) 
require(shinydashboard) 
require(xts) 

# create a simple app 
ui <- dashboardPage(
    title = 'Loading graphs', 
    dashboardHeader(title = 'Loading Graphs'), 
    dashboardSidebar(sliderInput(
    'n', 
    '10 to the power x', 
    min = 2, 
    max = 7, 
    value = 2 
)), 
    dashboardBody(
    tags$head(
     tags$style(
     type = "text/css", 
     " 
     #loadmessage { 
     position: fixed; 
     top: 70px; 
     left: 0px; 
     width: 100%; 
     padding: 5px 0px 5px 0px; 
     text-align: center; 
     font-weight: bold; 
     font-size: 100%; 
     color: #000000; 
     background-color: #CCFF66; 
     z-index: 105; 
     } 
     " 
    ) 
    ), 
    dygraphOutput('plot1'), 
    # conditionalPanel(condition="$('html').hasClass('shiny-busy')", 
    #     tags$div("Loading...",id="loadmessage")) 
    tags$div("Loading...", id = "loadmessage"), 
    tags$script(
     HTML(
     "$(document).on('shiny:busy', function(event) { 
      $('#loadmessage').css('display', 'inline'); 
     }); 
     $(document).on('shiny:idle', function(event) { 
      $('#loadmessage').css('display', 'none'); 
     }); 
     " 
    ) 
    ) 
) 
) 
server <- function(input, output) { 
    output$plot1 <- renderDygraph({ 
    v <- 10^(input$n) 
    Sys.sleep(2) 
    out <- dygraph(xts(rnorm(v), Sys.time() + seq(v))) %>% 
     dyRangeSelector() 
    return(out) 
    }) 
} 

shinyApp(ui = ui, server = server)