htmlwidgets 的闪亮加载栏答案

【问题标题】：shiny loading bar for htmlwidgetshtmlwidgets 的闪亮加载栏
【发布时间】：2016-11-15 07:52:12
【问题描述】：

在 R/Shiny 中，我正在制作一些非常详细的 htmlwidget，以通过各种包进入闪亮的应用程序，并且通常需要很长时间才能渲染。

我想创建一个加载栏或使用加载 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 在他的 cmets 中的建议尝试了以下操作....但它似乎不起作用...请参阅以下内容...

# 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

【问题讨论】：

这就是您要找的东西？ stackoverflow.com/questions/17325521/…
感谢您的建议，已编辑问题以显示我的尝试，但它看起来不像它的工作......
我猜shinydashboard 使用的类名称与基类 shiny 不同，所以不是 shiny-busy，它可能是 shinydashboard-busy 之类的其他东西，但我可能错了
查看源代码后，shinydashboard 似乎没有 HTML“忙碌”类，因此您需要一种不同的方法。也许shinyjs 的东西是要走的路：github.com/daattali/shinyjs#usage-dashboard
如果您提供一个工作示例作为答案，我将非常乐意看看......

标签： r shiny

【解决方案1】：

您好，您可以将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)

【讨论】：

刚刚尝试将其复制并粘贴到 RStudio 的控制台中，但我认为加载消息不起作用。
您使用哪个版本的shiny？我的是0.13.2。您可以将Sys.sleep(2) 放入renderDygraph 以确保看到加载消息
嗨，是的，我也在 0.13.2 上......所以使用您更新的代码，其中包含 Sys.sleep(2)，我可以看到加载消息，但是当滑块移动到4 或更高仍然有很长的延迟不显示加载消息
我认为这是因为 shiny 不再忙，但是浏览器仍然忙于渲染 dygraph 并显示曲线..
感谢您提供的信息，您对如何在浏览器准备好显示 dygraph 之前显示加载标志有什么建议吗？

【解决方案2】：

使用第一个链接帖子的方法之一：（如前所述，这仍然有很大的滞后时间）：

 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)
         })
     }
 ))

【讨论】：