Dimostrare che Shiny è occupato (o di carico) quando si cambia pannelli scheda

Question

(codice segue dopo la descrizione del problema)

Sto lavorando sulla creazione di un web app con lucido, e alcune delle R comandi che sto eseguendo richiedere alcuni minuti completare. Ho scoperto che ho bisogno di fornire all'utente indicazioni che Shiny stia funzionando, o cambieranno continuamente i parametri che fornisco nel pannello laterale, il che fa in modo che Shiny riavvii i calcoli in modo reattivo una volta completata la corsa iniziale.

Così, ho creato un pannello condizionale che mostra un messaggio "Loading" (indicato come un modale) con il seguente (grazie a Joe Cheng sul gruppo Shiny Google per l'istruzione condizionale):

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

Funziona come previsto se l'utente rimane nella scheda corrente. Tuttavia, l'utente può passare a un'altra scheda (che può contenere alcuni calcoli che devono essere eseguiti per un po 'di tempo), ma il pannello di caricamento appare e scompare immediatamente, mentre R si allontana dai calcoli e quindi aggiorna il contenuto solo dopo è fatta.

Poiché questo potrebbe essere difficile da visualizzare, ho fornito un codice per eseguire di seguito. Si noterà che facendo clic sul pulsante per avviare i calcoli si produrrà un messaggio di caricamento piacevole. Tuttavia, quando si passa alla scheda 2, R inizia a eseguire alcuni calcoli, ma non riesce a mostrare il messaggio di caricamento (forse Shiny non si registra come occupato?). Se si ricominciano i calcoli premendo nuovamente il pulsante, la schermata di caricamento apparirà correttamente.

Desidero visualizzare il messaggio di caricamento quando si passa a una scheda in fase di caricamento!

ui.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.")) 
    }) 
    }) 
}) 

Answer 1

Via del Shiny Google group, Joe Cheng mi ha segnalato il pacchetto shinyIncubator, dove v'è una funzione di barra di avanzamento che è in corso di implementazione (vedere ?withProgress dopo l'installazione del pacchetto shinyIncubator).

Forse questa funzione verrà aggiunta al pacchetto Shiny in futuro, ma questo funziona per ora.

Esempio:

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) 
    }) 
}) 

Answer 2

Ecco una possibile soluzione usando il vostro approccio originale.

Primo utilizzo un identificatore per le schede:

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

Quindi, se ci si connette tabText1 a input$tab:

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

vedrete che funziona quando si va dalla prima scheda per il il secondo.

Aggiornamento

Un'opzione più pulita consiste nel definire un oggetto reattivo di prendere il tabset attiva. Basta scrivere questo ovunque nel server.R:

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

Vedi https://groups.google.com/d/msg/shiny-discuss/PzlSAmAxxwo/eGx187UUHvcJ qualche spiegazione.

Answer 3

Penso che l'opzione più semplice sarebbe utilizzare la funzione busyIndicator nel pacchetto shinysky. Per ulteriori informazioni seguire questo link