Create Loading Messages That Will Change Based on Loading Time of Plot in a Shiny App

Create loading messages that will change based on loading time of plot in a shiny app

Here is a way to get such a result:

Sample Image

File myloader.html, to put in the app folder:

<div class="myloader">
<h1>
<span></span>
</h1>
</div>

File myloader.css, to put in the www subfolder:

.myloader {
text-align:center;
align-items: center;
}

.myloader > h1 {
display: flex;
justify-content: center;
color: blue;
}

.myloader > h1 > span::before {
content: "";
animation-name: animate;
animation-duration: 6s;
animation-direction: normal;
animation-fill-mode: forwards;
padding-left: 10px;
}

@keyframes animate {
0% {
content: "Analyzing, please wait...";
}
100% {
content: "Almost there!";
}
}

And the Shiny app:

library(shiny)
library(shinycustomloader)

ui <- fluidPage(
actionButton("go", "Go"),
withLoader(
plotOutput("plot"),
type = "html",
loader = "myloader"
)
)

server <- function(input, output) {
output$plot <- renderPlot({
input$go
x <- NULL
for(. in 1:30000){
x <- c(x, runif(1))
}
plot(x)
})
}

shinyApp(ui, server)


EDIT

A stylish one:

Sample Image

@font-face {
font-family: Origin;
src: url(https://s3-us-west-2.amazonaws.com/s.cdpn.io/4273/origin-extrabold-webfont.woff);
}

.myloader {
align-items: center;
background-color: #222;
height: 400px;
}

.myloader > h1 {
position: absolute;
top: 50%;
left: 30%;
display: flex;
justify-content: center;
font-family: Origin, Helvetica Light, sans-serif;
color: rgb(255, 242, 181);
background-image: linear-gradient(
rgb(255, 242, 181) 28%,
rgb(77, 77, 77) 40%,
rgb(255, 242, 181) 54%
);
-webkit-background-clip: text;
letter-spacing: 0.5rem;
}

.myloader > h1 > span::before {
content: "";
animation-name: animate;
animation-duration: 10s;
animation-direction: normal;
animation-fill-mode: forwards;
padding-left: 10px;
}

@keyframes animate {
0% {
content: "Analyzing";
}
10% {
content: "Analyzing.";
}
20% {
content: "Analyzing..";
}
30% {
content: "Analyzing...";
}
40% {
content: "Analyzing....";
}
50% {
content: "Analyzing.....";
}
60% {
content: "Analyzing......";
}
70% {
content: "Analyzing.......";
}
80% {
content: "Analyzing........";
}
90% {
content: "Analyzing.........";
}
100% {
content: "Almost there!";
}
}

R shiny: display loading... message while function is running

I'm already using a simpler and more reliable way than the one I posted before.

A combination of

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

with

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

Example:

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() is not required, but it's a good practice to keep all the styles inside head tag.

Is it possible to have a loading bar or spinner with the real time that job takes to be run in shiny?

Most of these packages don't need to pre calculate the time it is going to take for spinner to run.

Here is an example with shinycssloaders.

library(shiny)
library(DT)
library(ggplot2)

new_choices <- setNames(names(mtcars), names(mtcars))

ui <- fluidPage(

# Application title
titlePanel("Shiny app"),

sidebarLayout(
sidebarPanel(

tabsetPanel(
tabPanel("Selection",
selectInput("x_axis", "Choose x axis",
choices = new_choices),

selectInput("y_axis", "Choose y axis",
choices = new_choices),

hr(),
),

tabPanel("Titles",
hr(),

textInput(inputId = "title", "You can write the title:", value = "This is the title"),
textInput(inputId = "xlab", "You can re-name the x-axis:", value = "x-axis...."),
textInput(inputId = "ylab", "You can re-name the y-axis:", value = "y-axis ...."),

),


tabPanel("Calculations",
hr(),

checkboxInput("log2", "Do the log2 transformation", value = F),
checkboxInput("sqrt", "Calculate the square root", value = F),

)

),
actionButton(inputId = "drawplot", label = "Show the plot")

),

mainPanel(
shinycssloaders::withSpinner(plotOutput("plot")),
)
)
)

server <- function(input, output, session) {

data <- reactive({
mtcars
})


filtered_data <- reactive({
data <- data()
if(input$log2){
data <- log2(data+1)
}
if(input$sqrt){
data <- sqrt(data)
}
return(data)

})


v <- reactiveValues()
observeEvent(input$drawplot, {

v$plot <- ggplot() +
geom_point(data = filtered_data(),
aes_string(x = input$x_axis, y = input$y_axis)) +
xlab(input$xlab) +
ylab(input$ylab) +
ggtitle(input$title)

})


output$plot <- renderPlot({
if (is.null(v$plot)) return()
v$plot
})


}

shinyApp(ui, server)

Sample Image

How to display a Please wait nessage in the output of Shiny app

For such cases you can use shinycssloaders. It is simple to apply around any output.

Here's a simple application from it's help page :

library(shiny)

ui <- fluidPage(
actionButton("go", "Go"),
shinycssloaders::withSpinner(
plotOutput("plot")
)
)
server <- function(input, output) {
output$plot <- renderPlot({
input$go
Sys.sleep(1.5)
plot(runif(10))
})
}
shinyApp(ui, server)

Show that Shiny is busy (or loading) when changing tab panels

Via the Shiny Google group, Joe Cheng pointed me to the shinyIncubator package, where there is a progress bar function that is being implemented (see ?withProgress after installing the shinyIncubator package).

Maybe this function will be added to the Shiny package in the future, but this works for now.

Example:

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

Temporary Shiny Loading error: filter_impl

This happens because when the app starts, it takes some time to process your renderUI() function. During this time, input$school is empty and thus the error. You can correct this using validate() and need(). Read here for learning more about validate and general error handling in shiny. Corrected code:

require(ggplot2)
require(dplyr)
require(shiny)

##Section 1 ____________________________________________________
#load your data or create a data table as follows:
schools <- structure(list(school_name = c("Berkeley Terrace", "Grove Street School",
"Madison At Chancellor South", "Mt. Vernon Avenue School", "Thurgood Marshall School"
), district_name = c("Irvington Township", "Irvington Township",
"Irvington Township", "Irvington Township", "Irvington Township"
), Percent_Black_Students = c(0.755364806866953, 0.903292181069959,
0.813953488372093, 0.857913669064748, 0.824644549763033), Percent_Black_Teachers = c(1,
1, 1, 1, 1), Percent_Latinx_Students = c(0.233905579399142, 0.088477366255144,
0.176079734219269, 0.12589928057554, 0.163507109004739), Percent_Latinx_Teachers = c(0,
0, 0, 0, 0), Percent_White_Students = c(0, 0, 0, 0.00539568345323741,
0.0023696682464455), Percent_White_Teachers = c(0, 0, 0, 0, 0
)), class = "data.frame", row.names = c(NA, -5L))

##Section 2 ____________________________________________________
#set up the user interface
ui = shinyUI(
fluidPage( #allows layout to fill browser window
titlePanel("Why does the error flash and then go away?"),
sidebarPanel( #designates location of following items
htmlOutput("school_selector")
),

mainPanel(
plotOutput("plot1") #put plot item in main area

# Output: HTML table with requested number of observations ----
# tableOutput("view")

)
) )

##Section 3 ____________________________________________________
#server controls what is displayed by the user interface
server = shinyServer(function(input, output) {

output$school_selector = renderUI({#creates County select box object called in ui

data_available <- schools
#creates a reactive list of available x based on the y selection made

selectInput(inputId = "school", #name of input
label = "School:", #label displayed in ui
choices = unique(data_available), #calls list of available counties
selected = "Madison At Chancellor South")
})

output$plot1 = renderPlot({ #creates a the plot to go in the mainPanel

# add validate here
validate(
need(input$school != "", "No school selected") # display custom message in need
)

focal.school <- schools %>% filter(school_name == input$school)

ggplot(focal.school, aes(x=input$school, y=Percent_Black_Students)) +
geom_point()
})

})#close the shinyServer

shinyApp(ui = ui, server = server)

It is good practice to always include necessary validate() statements in your shiny code.

Adding a progress bar to indicate ggplotting progress in Shiny

It's not actually a progress bar as you'd like to generate. But you can display a loading message within a banner instead, which is why I suppose it could be useful here. Just copy the following code-snippet into the ui-part of your app and adjust the colors as needed.

info_loading <- "Shiny is busy. Please wait."
your_color01 <- # define a color for the text
your_color02 <- # define a color for the background of the banner

tags$head(tags$style(type="text/css",
paste0("
#loadmessage {
position: fixed;
top: 0px;
left: 0px;
width: 100%;
padding: 5px 0px 5px 0px;
text-align: center;
font-weight: bold;
font-size: 100%;
color: ", your_color01,";
background-color: ", your_color02,";
z-index: 105;
}
"))),
conditionalPanel(condition="$('html').hasClass('shiny-busy')",
tags$div(info_loading,id="loadmessage"))

Don't hesitate to adjust the parameters (e.g. top position) as needed.
You may further see: shiny loading bar for htmlwidgets



Related Topics



Leave a reply



Submit