调整闪亮进度条的大小并将其居中

Question

我正在使用一个 Shiny 应用程序，我需要在其中计算进程，并且在执行计算进度时，我使用 progressBar 来显示进程。

问题是进度条太小了，显示的方式我不喜欢。

所以，我在想也许有一种方法可以使用 Shiny 模态来实现进度条（有一个名为 modalDialog 的函数）。

我的想法是，当用户运行计算时，将打开一个显示progressBar 的模式。

这是进度代码：

withProgress(message = 'Runing GSVA', value = 0, {
    incProgress(1, detail = "This may take a while...")
    functionToGenerate()
  })

有什么想法吗？

Answer 1

我建议自定义通知的 CSS 类： 如果您检查通知器的元素，您会发现它具有“闪亮通知”类。因此，您可以使用tags$style() 覆盖该类的某些属性。在下面的示例中（对于模板：请参阅?withProgress），我决定调整 height+width 以使其更大，top+left 使其居中。

ui <- fluidPage(
  tags$head(
    tags$style(
      HTML(".shiny-notification {
              height: 100px;
              width: 800px;
              position:fixed;
              top: calc(50% - 50px);;
              left: calc(50% - 400px);;
            }
           "
      )
    )
  ),
  plotOutput("plot")
)

server <- function(input, output) {
  output$plot <- renderPlot({
    withProgress(message = 'Calculation in progress',
                 detail = 'This may take a while...', value = 0, {
                   for (i in 1:15) {
                     incProgress(1/15)
                     Sys.sleep(0.25)
                   }
                 })
    plot(cars)
  })
}

runApp(shinyApp(ui, server), launch.browser = TRUE)

Answer 2

您好，我在 shinyWidgets 包中编写了一个进度条功能，您可以将其放在模态中，但与 shiny::showModal 一起使用会很棘手，因此您可以像下面这样手动创建自己的模态。需要编写更多代码，但运行良好。

library("shiny")
library("shinyWidgets")

ui <- fluidPage(
  actionButton(inputId = "go", label = "Launch long calculation"), #, onclick = "$('#my-modal').modal().focus();"

  # You can open the modal server-side, you have to put this in the ui :
  tags$script("Shiny.addCustomMessageHandler('launch-modal', function(d) {$('#' + d).modal().focus();})"),
  tags$script("Shiny.addCustomMessageHandler('remove-modal', function(d) {$('#' + d).modal('hide');})"),

  # Code for creating a modal
  tags$div(
    id = "my-modal",
    class="modal fade", tabindex="-1", `data-backdrop`="static", `data-keyboard`="false",
    tags$div(
      class="modal-dialog",
      tags$div(
        class = "modal-content",
        tags$div(class="modal-header", tags$h4(class="modal-title", "Calculation in progress")),
        tags$div(
          class="modal-body",
          shinyWidgets::progressBar(id = "pb", value = 0, display_pct = TRUE)
        ),
        tags$div(class="modal-footer", tags$button(type="button", class="btn btn-default", `data-dismiss`="modal", "Dismiss"))
      )
    )
  )
)

server <- function(input, output, session) {

  value <- reactiveVal(0)

  observeEvent(input$go, {
    shinyWidgets::updateProgressBar(session = session, id = "pb", value = 0) # reinitialize to 0 if you run the calculation several times
    session$sendCustomMessage(type = 'launch-modal', "my-modal") # launch the modal
    # run calculation
    for (i in 1:10) {
      Sys.sleep(0.5)
      newValue <- value() + 1
      value(newValue)
      shinyWidgets::updateProgressBar(session = session, id = "pb", value = 100/10*i)
    }
    Sys.sleep(0.5)
    # session$sendCustomMessage(type = 'remove-modal', "my-modal") # hide the modal programmatically
  })

}

shinyApp(ui = ui, server = server)