Как показать прогрессбар в одной функции в блестящем?

Question

Вот пример. Индикатор выполнения просто перепрыгивает с 0% до 100% из-за одной функции getres(). Как плавно обозначить прогресс?

library("shiny")
library("shinyWidgets")
library("DESeq2")
library("airway")
data(airway)

getres <- function(eset){
  dds<-DESeqDataSet(eset, design = ~cell + dex)
  keep <- rowSums(counts(dds)) >= 10
  dds <- dds[keep,]
  dds <- DESeq(dds)
  res <- results(dds)
  return(res) 
}


ui <- fluidPage(
  tags$h1("Progress bar in Sweet Alert"),
  useSweetAlert(), # /!\ needed with 'progressSweetAlert'
  actionButton(
    inputId = "go",
    label = "Launch long calculation !"
  )
)

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

  observeEvent(input$go, {
    progressSweetAlert(
      session = session, id = "myprogress",
      title = "Work in progress",
      display_pct = TRUE, value = 0
    )
    for (i in seq_len(1)) {
      Sys.sleep(0.1)
      updateProgressBar(
        session = session,
        id = "myprogress",
        res<-getres(airway),
        value = i
      )
    }
    closeSweetAlert(session = session)
    sendSweetAlert(
      session = session,
      title =" Calculation completed !",
      type = "success"
    )
  })

}

shinyApp(ui = ui, server = server)

Answer 1

Мне не удалось запустить ваш пример, поскольку airway и DESeq2 недоступны для R 3.6+. НО есть интересный пакет, который я собираюсь попробовать под названием официант .

В пределах официант есть официантка который "позволит вам отображать полоски загрузки на весь экран или задавать только c элементов."

Существует отличное демо-приложение , где вы играете с другая функция.

Вот пример из документации!

library(shiny)
library(waiter)

ui <- navbarPage(
  "Waitress on nav",
  tabPanel(
    "home",
    use_waitress(),
    plotOutput("plot")
    )
)

server <- function(input, output){

  # now waitress ranges from 0 to 100
  waitress <- Waitress$new("nav", theme = "overlay", min = 0, max = 10)

  output$plot <- renderPlot({

    for(i in 1:10){
      waitress$inc(1) # increase by 10%
      Sys.sleep(.5)
    }

    hist(runif(100))
    waitress$close() # hide when done
    })

}

shinyApp(ui, server)

Надеюсь, это поможет или даст вам другие идеи!