Создать индикатор прогресса в модальном режиме в блестящем приложении, которое закрывается автоматически

Question

Я работаю над блестящим приложением, которое требует много времени для выполнения вычислений, я хочу иметь модальный индикатор выполнения, который автоматически закрывается, как только все вычисления работают.

Идеальное решение будет иметь две функции

1. Охватывает большую часть экрана и не позволяет пользователю взаимодействовать с приложением
2. Закрывается автоматически, как только он заканчивает делать вычисления

Я нашел это решениев следующем вопросе:

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)

Это решает проблему 1, но я должен нажать на отклонить, чтобы увидеть результаты

Answer 1

Не полный ответ, просто ответ на дополнительные запросы CSS.Вы можете изменить CSS, чтобы панель заполняла всю страницу.

.shiny-notification {
  height: 100%;
  width: 100%; 
  top: 0;
  left: 0;
  position:fixed;
  font-size: 250%;
  text-align: center;
  background-color: rgba(0, 0, 0, 0.7);
  color: white;
}

Answer 2

Оригинал progressbar в shiny - это именно то, что вам нужно.

Но я использую css, чтобы progessbar отображался в центре экрана.

Вы можете найти детали использования индикатора выполнения в блестящем здесь .

library("shiny")

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

  # css to center the progress bar
  tags$head(
    tags$style(
      HTML(".shiny-notification {
           height: 100px;
           width: 800px;
           position:fixed;
           top: calc(50% - 50px);
           left: calc(50% - 400px);
           font-size: 250%;
           text-align: center;
           }
           "
      )
    )
  )
)

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

  value <- reactiveVal(0)

  observeEvent(input$go, {
    withProgress(message = 'Calculation in progress', value = 0,detail="0%", {
      # run calculation
      for (i in 1:10) {
        Sys.sleep(0.5)
        newValue <- value() + 1
        value(newValue)
        incProgress(1/10,detail = paste0(i*10,"%"))
      }
      Sys.sleep(0.5)
    })
  })

}

shinyApp(ui = ui, server = server)