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

Question

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

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

目前有一些与问题相关但没有满意答案的问题： here, here 例如。

有没有一种方法可以实现在计算之上进行的柱状图，独立和连续，固定数量时间（或者可能在模仿栏的弹出窗口中插入栏的动画？）

谢谢

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

Answer 1

不是一个完整的答案，因为我的建议是使用 progress bars，但我希望它能有所帮助。

这里有一种使用 shinyjs 包的 javascript 来触发点击滑块动画按钮的方法：

library(shiny)
library(shinyjs)

jscode <- "
  shinyjs.play = function() {
    $('.slider-animate-button').trigger('click');
  }
"

ui <- fluidPage(
  useShinyjs(),
  extendShinyjs(text = jscode),
  sliderInput("slider", label = "", width = '600px',
              min = 0,
              max = 20,
              value = 0,
              step = 1,
              animate = animationOptions(
                interval = 100,
                playButton = "Play",
                pauseButton = "Pause"
              )
  )
)

server <- function(input, output,session) {
  observe( {
    js$play()
  })
}

shinyApp(ui, server)

请注意，js 代码引用了 slider-animate-button class，因此它会触发应用中的每个滑块动画选项。

Answer 2

感谢@GyD 的回答，我现在提出一个改进的解决方案（我承认它有一些 hack）。此处通过所需持续时间的 sys.sleep 来模拟长时间计算。您会看到在 'sleep' 期间仍然有滑块移动。我将动画滑块放入 RenderUI 以便我们可以控制速度：

library(shiny); library(shinyjs); library(shinyWidgets) jscode <- " shinyjs.play = function() { $('.slider-animate-button').trigger('click'); } " ui <- fluidPage( tags$head(tags$style(HTML('.irs-from, .irs-to, .irs-min, .irs-max, .irs-grid-text, .irs-grid-pol, .irs-slider {visibility:hidden !important;}'))), useShinyjs(), extendShinyjs(text = jscode), numericInput("seconds", "how many seconds your calculation will last?", value=6), uiOutput("UI"), actionButton("go", "Compute")) server <- function(input, output,session) { disable("slider") observeEvent(input$go, priority=10, { js$play() Sys.sleep(input$seconds) # simulate computation showNotification("Computation finished!", type="error")}) output$UI = renderUI({ sliderInput("slider", label = "", width = '300px',min = 0,max = 100,value = 0,step = 1, post="% done", animate = animationOptions( interval = (as.numeric(input$seconds)*8), playButton = "", pauseButton = ""))})} shinyApp(ui, server)

滑块真的很像条形，不是吗？

Answer 3

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

我对它的看法使用与 Shiny 相同的 Bootstrap 3 progress bars。出于懒惰，我还利用了 Shiny 的进度条 CSS 类（top bar 样式），因此这将与 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)

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

How to set up an independent progress bar

r

progress

shiny