Question

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

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

目前有一些与此问题有关的问题，但没有令人满意的答案：例如here，here。

有没有办法实现一个在计算之上进展的栏，独立和连续，在一段固定的时间内（或者插入一个动画的弹出一个模仿酒吧的栏？）

由于

修改：我尝试使用动画sliderInput模仿进度条，但我无法找到以编程方式触发动画的方法......

Answer 1

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

我对它的看法使用Shiny使用的Bootstrap 3 progress bars。出于懒惰，我还利用了Shiny的进度条CSS类（顶级栏式），因此这将与Shiny的进度条冲突。理想情况下，它是一个具有自己风格的小部件。

我使用了jQuery＆＃39; 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)

Answer 2

不是一个完整的答案，因为我的建议是使用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类，因此它将触发应用程序中的每个滑块动画选项。

Answer 3

感谢@GyD 的答案，我现在提出一个改进的解决方案（我承认有一些黑客攻击）。这里通过期望持续时间的sys.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)

滑块真的看起来像一个吧，不是吗？

如何设置独立的进度条

3 个答案: