I am interested in having a spinner or a loading bar in my Shiny app. I have found and I have tried these packages: shinycssloaders, waiter, shinycustomloader, shinybusy but the way that most of the people implement the spinners or loading bars is including 1) a for loop or 2) suspending the execution for a time interval (sys.sleep) for some seconds.
1)
withProgress(message = 'Making plot', value = 0, {
# Number of times we'll go through the loop
n <- 10
for (i in 1:n) {
# Increment the progress bar, and update the detail text.
incProgress(1/n, detail = paste("Loading", i*10, "%"))
# Pause for 0.1 seconds to simulate a long computation.
Sys.sleep(0.5)
}
v$plot <- myplot()
Sys.sleep(3)
plot()
However, the way that it is being executed is: first it spends some time to execute the for loop or the sys.sleep (with the time that you have decided or the number of items that you want to put in the loop) and LATER, it shows the plot (and the plot it will take the time that it needs to show it).
I have been trying to find (with no success) if there is a way to do the same thing but instead of putting/selecting a specific time, using the amount of time that the plot/table is going to spend to be shown.
Does anyone know if this is possible with Shiny?
Just in case someone wants one example to work with, here it is one (although it is pretty fast, because it doesn't use an huge dataframe. The idea is that the plot will take more time to be shown).
library(shiny)
library(magrittr)
library(DT)
library(shinybusy)
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(
plotOutput("plot"),
)
)
)
server <- function(input, output, session) {
data <- reactive({
mtcars
})
filtered_data <- reactive({
data <- data()
if(input$log2 == TRUE){
data <- log2(data 1)
}
if(input$sqrt == TRUE){
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)
Thanks very much in advance
Regards
CodePudding user response：
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)
CodePudding user response：
You do not need to have a for loop at all for the progress bar. The way it works is that every command is like a black box, so checking within a function call what the function does and give feedback e.g.: if you create a data frame and where the data frame is in its creation is not possible. What you could do though is to divide your functions into smaller functions and call them then like:
withProgress(message = 'Making plot', value = 0, {
incProgress(1/5, detail = paste("Here we go!"))
doLogTransform(...)
incProgress(1/5, detail = paste("Done with the log"))
doSqurt(...)
incProgress(1/5, detail = paste("Done with the log"))
p <- ggplot2::ggplot(...) # your generic plot
incProgress(1/5, detail = paste("Done with the plot"))
p <- p labs(...) # your axis labels
incProgress(1/5, detail = paste("Done with cosmetics"))
...
}
With that approach you seperate every step of your plot building into smaller chunks and you have a progress bar update in between.
Here your adapted code:
library(shiny)
library(magrittr)
library(DT)
library(shinybusy)
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(
plotOutput("plot"),
)
)
)
server <- function(input, output, session) {
data <- reactive({
mtcars
})
filtered_data <- reactive({
data <- data()
if(input$log2 == TRUE){
data <- log2(data 1)
}
if(input$sqrt == TRUE){
data <- sqrt(data)
}
return(data)
})
v <- reactiveValues()
observeEvent(input$drawplot, {
shiny::withProgress(
message = "Let's plot",
value = 0,
{
cool_data = filtered_data()
shiny::incProgress(
amount = 1/5,
message = "transformation done")
v$plot <- ggplot2::ggplot(
data = cool_data,
mapping = ggplot2::aes_string(
x = input$x_axis,
y = input$y_axis
)
)
shiny::incProgress(
amount = 1/5,
message = "generating plot done")
v$plot <- v$plot ggplot2::geom_point()
shiny::incProgress(
amount = 1/5,
message = "adding points done")
v$plot <- v$plot xlab(input$xlab)
ylab(input$ylab)
ggtitle(input$title)
shiny::incProgress(
amount = 1/5,
message = "prettifying plot done")
}
)
})
output$plot <- renderPlot({
if (is.null(v$plot)) return()
v$plot
})
}
shinyApp(ui, server)