web-dev-qa-db-fra.com

Montrer que Shiny est occupé (ou en cours de chargement) lors du changement de panneaux à onglets

(Le code suit après la description du problème)

Je travaille sur la création d'une application Web avec Shiny, et certaines des commandes R que j'exécute prennent quelques minutes. J'ai trouvé que je dois fournir à l'utilisateur une indication que Shiny fonctionne, ou ils changeront continuellement les paramètres que je fournis dans le panneau latéral, ce qui oblige Shiny à redémarrer réactivement les calculs une fois l'exécution initiale terminée.

J'ai donc créé un panneau conditionnel qui affiche un message de "chargement" (appelé modal) avec ce qui suit (merci à Joe Cheng du groupe Shiny Google pour l'instruction conditionnelle):

# generateButton is the name of my action button
loadPanel <- conditionalPanel("input.generateButton > 0 && $('html').hasClass('shiny-busy')"),
                              loadingMsg)

Cela fonctionne comme prévu si l'utilisateur reste sur l'onglet actuel. Cependant, l'utilisateur peut basculer vers un autre onglet (qui peut contenir certains calculs qui doivent être exécutés pendant un certain temps), mais le panneau de chargement apparaît et disparaît immédiatement, tout pendant que R s'éloigne des calculs, puis actualise le contenu uniquement après c'est fait.

Comme cela peut être difficile à visualiser, j'ai fourni du code à exécuter ci-dessous. Vous remarquerez que cliquer sur le bouton pour démarrer les calculs produira un joli message de chargement. Cependant, lorsque vous passez à l'onglet 2, R commence à exécuter certains calculs, mais ne parvient pas à afficher le message de chargement (peut-être que Shiny ne s'enregistre pas comme étant occupé?). Si vous redémarrez les calculs en appuyant à nouveau sur le bouton, l'écran de chargement s'affichera correctement.

Je veux que le message de chargement apparaisse lors du passage à un onglet en cours de chargement!

i.R

library(shiny)

# Code to make a message that shiny is loading
# Make the loading bar
loadingBar <- tags$div(class="progress progress-striped active",
                       tags$div(class="bar", style="width: 100%;"))
# Code for loading message
loadingMsg <- tags$div(class="modal", tabindex="-1", role="dialog", 
                       "aria-labelledby"="myModalLabel", "aria-hidden"="true",
                       tags$div(class="modal-header",
                                tags$h3(id="myModalHeader", "Loading...")),
                       tags$div(class="modal-footer",
                                loadingBar))
# The conditional panel to show when shiny is busy
loadingPanel <- conditionalPanel(paste("input.goButton > 0 &&", 
                                       "$('html').hasClass('shiny-busy')"),
                                 loadingMsg)

# Now the UI code
shinyUI(pageWithSidebar(
  headerPanel("Tabsets"),
  sidebarPanel(
    sliderInput(inputId="time", label="System sleep time (in seconds)", 
                value=1, min=1, max=5),
    actionButton("goButton", "Let's go!")
  ),

  mainPanel(
    tabsetPanel(
      tabPanel(title="Tab 1", loadingPanel, textOutput("tabText1")), 
      tabPanel(title="Tab 2", loadingPanel, textOutput("tabText2")) 
    )
  )
))

server.R

library(shiny)

# Define server logic for sleeping
shinyServer(function(input, output) {
  sleep1 <- reactive({
    if(input$goButton==0) return(NULL)
    return(isolate({
      Sys.sleep(input$time)
      input$time
    }))
  })

  sleep2 <- reactive({
    if(input$goButton==0) return(NULL)
    return(isolate({
      Sys.sleep(input$time*2)
      input$time*2
    }))
  })

  output$tabText1 <- renderText({
    if(input$goButton==0) return(NULL)
    return({
      print(paste("Slept for", sleep1(), "seconds."))
    })
  })

  output$tabText2 <- renderText({
    if(input$goButton==0) return(NULL)
    return({
      print(paste("Multiplied by 2, that is", sleep2(), "seconds."))
    })
  })
})
rshiny
38
ialm

Via le Shiny Google group , Joe Cheng m'a pointé vers le package shinyIncubator , où une fonction de barre de progression est en cours d'implémentation (voir ?withProgress après avoir installé le package shinyIncubator).

Peut-être que cette fonction sera ajoutée au package Shiny à l'avenir, mais cela fonctionne pour l'instant.

Exemple:

UI.R 

library(shiny)
library(shinyIncubator)

shinyUI(pageWithSidebar(
  headerPanel("Testing"),
  sidebarPanel(
    # Action button
    actionButton("aButton", "Let's go!")
  ),

  mainPanel(
    progressInit(),
    tabsetPanel(
      tabPanel(title="Tab1", plotOutput("plot1")),
      tabPanel(title="Tab2", plotOutput("plot2")))
  )
))

SERVER.R 

library(shiny)
library(shinyIncubator)

shinyServer(function(input, output, session) {
  output$plot1 <- renderPlot({
    if(input$aButton==0) return(NULL)

    withProgress(session, min=1, max=15, expr={
      for(i in 1:15) {
        setProgress(message = 'Calculation in progress',
                    detail = 'This may take a while...',
                    value=i)
        print(i)
        Sys.sleep(0.1)
      }
    })
    temp <- cars + matrix(rnorm(prod(dim(cars))), nrow=nrow(cars), ncol=ncol(cars))
    plot(temp)
  })

  output$plot2 <- renderPlot({
    if(input$aButton==0) return(NULL)

    withProgress(session, min=1, max=15, expr={
      for(i in 1:15) {
        setProgress(message = 'Calculation in progress',
                    detail = 'This may take a while...',
                    value=i)
        print(i)
        Sys.sleep(0.1)
      }
    })
    temp <- cars + matrix(rnorm(prod(dim(cars))), nrow=nrow(cars), ncol=ncol(cars))
    plot(temp)
  })
})
19
ialm

Voici une solution possible en utilisant votre approche originale.

Utilisez d'abord un identifiant pour les onglets:

tabsetPanel(
  tabPanel(title="Tab 1", loadingPanel, textOutput("tabText1")), 
  tabPanel(title="Tab 2", loadingPanel, textOutput("tabText2")),
  id="tab"
)

Ensuite, si vous vous connectez tabText1 à input$tab:

  output$tabText1 <- renderText({
    if(input$goButton==0) return(NULL)
    input$tab
    return({
      print(paste("Slept for", sleep1(), "seconds."))
    })
  })

vous verrez que cela fonctionne lorsque vous passez du premier onglet au second.

Mise à jour

Une option la plus propre consiste à définir un objet réactif capturant le jeu de tabulations actif. Écrivez simplement ceci n'importe où dans server.R:

  output$activeTab <- reactive({
    return(input$tab)
  })
  outputOptions(output, 'activeTab', suspendWhenHidden=FALSE)

Voir https://groups.google.com/d/msg/shiny-discuss/PzlSAmAxxwo/eGx187UUHvcJ pour une explication.

8
Stéphane Laurent

Je pense que l'option la plus simple serait d'utiliser la fonction busyIndicator dans le paquet shinysky. Pour plus d'informations, suivez ceci lien

4
SBista