Afficher une barre de chargement dans R shiny lors du sourcing d'un script.

Question

J'ai une application brillante, qui permet à l'utilisateur de rafraîchir les données dans le front-end via un bouton, et affiche les données. Mon app.R est le suivant :

library(shiny)
file_name <- "sample.csv"
bkg_color <- "red"

# Define UI for application
ui <- fluidPage(
  actionButton("refresh", "", icon("refresh") ),
  tableOutput("table"),
  uiOutput("slider")
)

# Define server logic required
server <- function(input, output, session) {
  observeEvent(input$refresh,{
    source("updatedata.R")
    showModal(modalDialog(
      title = "", 
      "Data refreshed", 
      easyClose = TRUE,
      footer = NULL
    ))
  })
  # observe the raw file, and refresh if there is change every 5 seconds
  raw <- reactivePoll(5000, session, 
                          checkFunc = function(){
                            if (file.exists(file_name))
                              file.info(file_name)$mtime[1]
                            else
                              ""
                          }, 
                          valueFunc = function(){
                           read.csv(file_name)
                          })
output$table <- renderTable(raw())      
output$slider <- renderUI({
    req(raw())
    tagList(
      # styling slider bar
      tags$style(HTML(paste0(".js-irs-0 .irs-single, .js-irs-0 .irs-bar-edge, .js-irs-0 .irs-bar {background: ",
                            bkg_color,";border-top: ",bkg_color,";border-bottom: ",bkg_color,"; border: ",bkg_color,"}"))),
      sliderInput("date","", 
                  min = min(raw()$v1), 
                  max = max(raw()$v1), 
                  value = max(raw()$v1))
    )

  })

}

# Run the application 
shinyApp(ui = ui, server = server)

J'ai aussi un autre updatedata.R script qui effectue la mise à jour des données, comme ci-dessous :

file_name <- "sample.csv"
temp <- data.frame(v1 =runif(10, min = 0, max = 100), v2 = Sys.time() )
write.csv(x =temp, file = file_name,row.names = FALSE )
Sys.sleep(10)

Chaque fois que l'utilisateur clique sur le bouton d'actualisation de l'interface, les données sont mises à jour. Une fois le rafraîchissement des données terminé, une fenêtre d'invite indique que les données ont été rafraîchies. Mon problème est que je voudrais aussi avoir une indication pendant que les données sont rafraîchies. J'ai essayé avec shinycssloaders et a utilisé withSpinner(tableOutput("table")) mais cela ne répond pas à mes besoins. Y a-t-il une option que je peux explorer ?

Answer 1

Voici une solution pour mesurer l'avancement de chaque ligne de la source et informer de la ligne en cours d'évaluation. En supposant que votre updatedata.R fichier :

file_name <- "sample.csv"
temp <- data.frame(v1 =runif(10, min = 0, max = 100), v2 = Sys.time() )
write.csv(temp,file_name,row.names = FALSE )
Sys.sleep(10)

L'application Shiny utilisera withProgress() y incProgress à l'intérieur de la boucle - Comme dans le exemple et imprime la ligne de la source qui est évaluée. La source est évaluée ligne par ligne dans la boucle en utilisant la méthode suivante eval(parse( text = l[i] ))

library(shiny)
file_name <- "sample.csv"
bkg_color <- "red"

# Define UI for application
ui <- fluidPage(
  actionButton("refresh", "", icon("refresh") ),
  tableOutput("table"),
  uiOutput("slider")
)

# Define server logic required
server <- function(input, output, session) {
  observeEvent(input$refresh,{

    l <- readLines("~/Documents/eclipse_projects/stackoverflow/updatedata.R")
    n <- length(l)
    withProgress(message = 'Making plot', value = 0, {
      for (i in 1:n) {
        eval(parse(text=l[i]))
        incProgress(1/n, detail = paste("Doing part", l[i]))
      }
    })
    showModal(modalDialog(
      title = "", 
      "Data refreshed", 
      easyClose = TRUE,
      footer = NULL
    ))
  })
  # observe the raw file, and refresh if there is change every 5 seconds
  raw <- reactivePoll(5000, session, 
                      checkFunc = function(){
                        if (file.exists(file_name))
                          file.info(file_name)$mtime[1]
                        else
                          ""
                      }, 
                      valueFunc = function(){
                        read.csv(file_name)
                      })
  output$table <- renderTable(raw())      
  output$slider <- renderUI({
    req(raw())
    tagList(
      # styling slider bar
      tags$style(HTML(paste0(".js-irs-0 .irs-single, .js-irs-0 .irs-bar-edge, .js-irs-0 .irs-bar {background: ",
                             bkg_color,";border-top: ",bkg_color,";border-bottom: ",bkg_color,"; border: ",bkg_color,"}"))),
      sliderInput("date","", 
                  min = min(raw()$v1), 
                  max = max(raw()$v1), 
                  value = max(raw()$v1))
    )

  })

}

# Run the application 
shinyApp(ui = ui, server = server)    

Alternativement, vous pouvez mettre incProgress() dans votre source (dans la boucle ou entre les lignes). Amusez-vous bien sur