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

Question

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

我的计算需要一段时间，比如 30 秒

我能够提前评估计算所需的确切时间

然而，计算是在一个块中，不能分成小部分，我可以用来手动增加进度条，将其视为一个大型模型拟合过程。

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

有没有办法在计算之上实现一个进度条， 独立 和 连续 , 一段固定的时间(或者可能在模仿栏的弹出窗口中插入栏的动画？)

谢谢

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

Answer 1

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

我对它的看法使用相同的 Bootstrap 3 progress bars Shiny 使用的那个。出于懒惰，我还利用了 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)