如何设置一个独立的进度条

age*_*nis 5 r progress shiny

我试图在我闪亮的应用程序中的计算过程中包含一个进度条。我的问题描述:

  • 我的计算需要一段时间,比如 30 秒
  • 我能够提前评估计算所需的确切时间
  • 然而,计算是在一个块中,不能分成我可以用来手动增加进度条的小部分,将其视为一个大型模型拟合过程。

目前有一些与该问题相关的问题,但没有令人满意的答案: 例如herehere

有没有一种方法可以实现一个在计算之上独立连续地在固定时间内进行的条形图(或者可能在模拟条形图的弹出窗口中插入条形图的动画?)

谢谢

编辑:我试图用动画模拟进度条sliderInput,但我找不到如何以编程方式触发动画...

gre*_*g L 3

我认为当 Shiny 发布其异步支持时,这会容易得多。但目前,它必须是一个自定义的客户端 JavaScript 解决方案。

我的看法是使用与 Shiny 相同的Bootstrap 3 进度条。出于懒惰,我还利用了Shiny的进度条CSS类(顶部栏样式),所以这会与Shiny的进度条发生冲突。理想情况下,它是一个具有自己的样式的小部件。

我使用 jQuery 的animate来设置固定持续时间内进度条的宽度。animate有一些开箱即用的好选项,例如缓动。我还默认让进度条在 100% 之后徘徊,认为服务器最好明确关闭进度条,以防时间不准确。

library(shiny)

progressBarTimer <- function(top = TRUE) {
  progressBar <- div(
    class = "progress progress-striped active",
    # disable Bootstrap's transitions so we can use jQuery.animate
    div(class = "progress-bar", style = "-webkit-transition: none !important;
              transition: none !important;")
  )

  containerClass <- "progress-timer-container"

  if (top) {
    progressBar <- div(class = "shiny-progress", progressBar)
    containerClass <- paste(containerClass, "shiny-progress-container")
  }

  tagList(
    tags$head(
      tags$script(HTML("
        $(function() {
          Shiny.addCustomMessageHandler('progress-timer-start', function(message) {
            var $progress = $('.progress-timer-container');
            var $bar = $progress.find('.progress-bar');
            $bar.css('width', '0%');
            $progress.show();
            $bar.animate({ width: '100%' }, {
              duration: message.duration,
              easing: message.easing,
              complete: function() {
                if (message.autoClose) $progress.fadeOut();
              }
            });
          });

          Shiny.addCustomMessageHandler('progress-timer-close', function(message) {
            var $progress = $('.progress-timer-container');
            $progress.fadeOut();
          });
        });
      "))
    ),

    div(class = containerClass, style = "display: none;", progressBar)
  )
}

startProgressTimer <- function(durationMsecs = 2000, easing = c("swing", "linear"),
                               autoClose = FALSE, session = getDefaultReactiveDomain()) {
  easing <- match.arg(easing)
  session$sendCustomMessage("progress-timer-start", list(
    duration = durationMsecs,
    easing = easing,
    autoClose = autoClose
  ))
}

closeProgressTimer <- function(session = getDefaultReactiveDomain()) {
  session$sendCustomMessage("progress-timer-close", list())
}

ui <- fluidPage(
  numericInput("seconds", "how many seconds your calculation will last?", value = 6),
  progressBarTimer(top = TRUE),
  actionButton("go", "Compute")
)

server <- function(input, output, session) {
  observeEvent(input$go, {
    startProgressTimer(input$seconds * 1000, easing = "swing")
    Sys.sleep(input$seconds) # simulate computation
    closeProgressTimer()
    showNotification("Computation finished!", type = "error")
  })
}

shinyApp(ui, server)
Run Code Online (Sandbox Code Playgroud)