showcase - Mostrar que Shiny está ocupado(o cargando) al cambiar los paneles de pestañas

shiny server

Question

(El código sigue después de la descripción del problema)

Estoy trabajando en la creación de una aplicación web con Shiny, y algunos de los comandos R que estoy ejecutando tardan minutos en completarse. Descubrí que debo proporcionar al usuario alguna indicación de que Shiny está funcionando, o cambiarán continuamente los parámetros que proporciono en el panel lateral, lo que hace que Shiny reinicie de forma reactiva los cálculos una vez que se completa la ejecución inicial.

Entonces, creé un panel condicional que muestra un mensaje "Cargando" (denominado modal) con lo siguiente (gracias a Joe Cheng en el grupo Shiny Google para la declaración condicional):

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

Esto funciona según lo previsto si el usuario permanece en la pestaña actual. Sin embargo, el usuario puede cambiar a otra pestaña (que puede contener algunos cálculos que deben ejecutarse durante un tiempo), pero el panel de carga aparece y desaparece inmediatamente, todo mientras R resuelve los cálculos y luego refresca el contenido solo después de se hace.

Como esto puede ser difícil de visualizar, proporcioné un código para ejecutar a continuación. Notarás que al hacer clic en el botón para comenzar los cálculos, se genera un bonito mensaje de carga. Sin embargo, cuando cambia a la pestaña 2, R comienza a ejecutar algunos cálculos, pero no muestra el mensaje de carga (¿tal vez Shiny no se registra como ocupado?). Si reinicia los cálculos presionando nuevamente el botón, la pantalla de carga se mostrará correctamente.

¡Quiero que aparezca el mensaje de carga al cambiar a una pestaña que se está cargando!

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

servidor.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

A través del grupo Shiny Google , Joe Cheng me señaló el paquete shinyIncubator , donde hay una función de barra de progreso que se está implementando (ver ?withProgress después de instalar el paquete shinyIncubator ).

Tal vez esta función se agregará al paquete Shiny en el futuro, pero esto funciona por ahora.

Ejemplo:

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

Aquí hay una posible solución usando su enfoque original.

Primero use un identificador para las pestañas:

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

Luego, si conecta tabText1 para input$tab :

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

Verás que funciona cuando pasas de la primera pestaña a la segunda.

Actualizar

Una opción más limpia consiste en definir un objeto reactivo que capture el tabset activo. Simplemente escribe esto en cualquier lugar del server.R :

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

Consulte https://groups.google.com/d/msg/shiny-discuss/PzlSAmAxxwo/eGx187UUHvcJ para obtener una explicación.

Answer 3

Creo que la opción más fácil sería usar la función busyIndicator en el paquete shinysky. Para más información siga este link