logo标签列表

闪亮的加载条用于htmlwidgets

rshiny
3
在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)

* 编辑2 *

类似于这个问题的解决方案是否可用？

如何在客户端加载实际图像时显示忙碌图像

1
这是你要找的吗？https://dev59.com/f2Qm5IYBdhLWcg3wyhnk - Carl
感谢您的建议，我已经编辑了问题以展示我的尝试，但似乎并没有起作用... - h.l.m
我猜shinydashboard使用的类名与基本的shiny不同，所以它可能不是shiny-busy，而是其他类似于shinydashboard-busy的名称，但我可能错了。 - Carl
在查看源代码后，似乎 shinydashboard 没有 HTML 的 "busy" 类，因此您需要采用不同的方法。也许使用 shinyjs 是解决问题的方法：https://github.com/daattali/shinyjs#usage-dashboard - Carl
如果您提供一个可行的示例作为答案，我将非常乐意查看。 - h.l.m
@Sumedh 是的，我非常感兴趣。 - h.l.m
2个回答
3

你可以使用Shiny中的JavaScript事件，其中包括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的控制台中复制粘贴这段代码，但是加载信息好像没有起作用。 - h.l.m
你使用的 shiny 版本是哪个？我的是 0.13.2。你可以在 renderDygraph 中加入 Sys.sleep(2) 来确保看到加载消息。 - Victorp
嗨，是的，我正在使用0.13.2版本，所以使用了您更新的代码，其中包含Sys.sleep(2)，我可以看到加载消息，但当滑块移动到4或更高时，仍然存在长时间的延迟，无法显示加载消息。 - h.l.m
我认为这是因为 shiny 不再繁忙，但浏览器仍在忙于渲染 dygraph 并显示曲线。 - Victorp
1
谢谢您提供的信息，您有什么建议可以在浏览器准备好显示dygraph之前显示加载标志吗？ - h.l.m
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秒才能呈现图形，并且在滑块为6时需要大约20秒才能在浏览器上显示图形（或者生成图形后导致延迟的任何内容）。 您可以在绘图命令后添加for循环以及Sys.sleep来确认这一点。

我们还可以包括一个进度指示器栏（如此处），这可以通过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)
         })
     }
 ))
网页内容由stack overflow 提供, 点击上面的
可以查看英文原文，
原文链接