web-dev-qa-db-fra.com

R brillant: affiche le message "chargement ..." pendant l'exécution de la fonction

J'utilise le package Shiny GUI R. Je cherche un moyen d'afficher un message comme "chargement ..." après avoir appuyé sur l'actionButton. La fonction prend plusieurs minutes pour s'exécuter, je dois donc informer l'utilisateur que le bouton a effectivement déclenché un événement. Maintenant, le code server.R ressemble à ceci:

DATA <- reactive({
  if(input$DownloadButton>0) {
    RunDownload()
  } else {
    NULL
  }
})

output$Download <- renderText({
  if(NROW(DATA())>0) {
    paste0(Sys.time(),": ",NROW(DATA()), " items downloaded")
  } else {
    ''
  }
})

actionButton() est une fonction qui télécharge des données depuis Internet. input$DownloadButton Est actionButton. Ainsi, après avoir appuyé sur le bouton, l'utilisateur attend plusieurs minutes et ne voit alors qu'un message indiquant que le téléchargement a réussi. Je voudrais afficher un message "Loading ..." juste après avoir appuyé sur l'actionButton, puis un autre message comme paste0(Sys.time(),": ",NROW(DATA()), " items downloaded") lorsque l'exécution se termine.

rshiny
43
user1603038

J'utilise déjà un moyen plus simple et plus fiable que celui que j'ai publié auparavant.

Une combinaison de

tags$style(type="text/css", "
           #loadmessage {
             position: fixed;
             top: 0px;
             left: 0px;
             width: 100%;
             padding: 5px 0px 5px 0px;
             text-align: center;
             font-weight: bold;
             font-size: 100%;
             color: #000000;
             background-color: #CCFF66;
             z-index: 105;
           }
  ")

avec

conditionalPanel(condition="$('html').hasClass('shiny-busy')",
                 tags$div("Loading...",id="loadmessage")
)

Exemple:

runApp(list(
  ui = pageWithSidebar(
      headerPanel("Test"),
         sidebarPanel(
           tags$head(tags$style(type="text/css", "
             #loadmessage {
               position: fixed;
               top: 0px;
               left: 0px;
               width: 100%;
               padding: 5px 0px 5px 0px;
               text-align: center;
               font-weight: bold;
               font-size: 100%;
               color: #000000;
               background-color: #CCFF66;
               z-index: 105;
             }
          ")),
           numericInput('n', 'Number of obs', 100),
           conditionalPanel(condition="$('html').hasClass('shiny-busy')",
                            tags$div("Loading...",id="loadmessage"))
         ),
         mainPanel(plotOutput('plot'))
  ),
  server = function(input, output) {
    output$plot <- renderPlot({ Sys.sleep(2); hist(runif(input$n)) })
  }
))

tags $ head () n'est pas requis, mais c'est une bonne pratique de garder tous les styles à l'intérieur de la balise head.

32
user1603038

Très simplement, vous pouvez utiliser les fonctions brillantes intégrées showModal() au début de la fonction et removeModal() à la fin. Si vous supprimez le pied de page, il est impossible de cliquer sur ce modal.

Exemple:

observeEvent(input$button, {
     showModal(modalDialog("Doing a function", footer=NULL))
     #Do the stuff here....
     #...
     #...
     #Finish the function
     removeModal()
})
4
moman822

J'ai résolu le problème en ajoutant le code suivant à sidebarPanel ():

HTML('<script type="text/javascript">
        $(document).ready(function() {
          $("#DownloadButton").click(function() {
            $("#Download").text("Loading...");
          });
        });
      </script>
')
4
user1603038

Vous pouvez utiliser ShinyJS: https://github.com/daattali/shinyjs

Lorsque vous appuyez sur l'actionButton, vous pouvez facilement basculer un composant de texte affichant "chargement ...", et lorsque le calcul est terminé, vous pouvez ensuite basculer ce composant sur masqué.

3
zhanxw

J'ai trouvé une solution qui me convient. J'utilise le modal Bootstrap. Il est affiché au début de l'exécution de la fonction et est de nouveau masqué à la fin.

modalBusy <- fonction (id, titre, ...) {

 msgHandler =  singleton(tags$head(tags$script('Shiny.addCustomMessageHandler("jsCode",
                                            function(message) {
                                              console.log(message)
                                              eval(message.code);
                                            });'
                                            )
                                )
                      )

 label_id = paste(id, "label", sep='-')
 modal_tag <- div(id=id, 
               class="modal hide fade", 
               "aria-hidden"=FALSE, 
               "aria-labelledby"=label_id, 
               "role"="dialog", 
               "tabindex"="-1",
               "data-keyboard"=FALSE,
               "data-backdrop"="static")
 header_tag <- div(class="modal-header",
                h3(id=label_id, title))
 body_tag <- div(class="modal-body",
              Row(...))   
 footer_tag <- div(class="modal-footer")
 modal_tag <- tagAppendChildren(modal_tag, header_tag, body_tag, footer_tag)
 tagList(msgHandler, modal_tag) 
}

Pour le montrer et le cacher utilisez les fonctions

showModal <- function(id,session) {
  session$sendCustomMessage(type="jsCode",
                            list(code= paste("$('#",id,"').modal('show')"
                                             ,sep="")))
}

hideModal <- function(id,session) {
  session$sendCustomMessage(type="jsCode",
                            list(code= paste("$('#",id,"').modal('hide')"
                                             ,sep="")))
}

Appelez la fonction showModal avant votre fonction Call et la fonction hideModal après!

J'espère que cela t'aides.

Seb

2
Seb