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

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

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

htmlwidgets的闪亮加载栏

2 个答案: