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)
})
})
Shiny can not display different webGLOutput on different tab panels?
You appear to be using shinyRGL. Don't use it, rgl has what you need. Here's an example that works for me:
ui.R:
library(shiny)
shinyUI(fluidPage(
mainPanel(
tabsetPanel(
tabPanel("red",
rglwidgetOutput('thewidget1')),
tabPanel("green",
rglwidgetOutput('thewidget2'))
))
))
server.R:
library(shiny)
library(rgl)
options(rgl.useNULL = TRUE)
shinyServer(function(input, output, session) {
x <- rnorm(100)
y <- 2*rnorm(100)
z <- 10*rnorm(100)
open3d()
plot3d(x, y, z, col = "red")
scene1 <- scene3d()
plot3d(z, y, x, col = "green")
scene2 <- scene3d()
rgl.close()
save <- options(rgl.inShiny = TRUE)
on.exit(options(save))
output$thewidget1 <- renderRglwidget(
rglwidget(scene1)
)
output$thewidget2 <- renderRglwidget(
rglwidget(scene2)
)
})
By the way, we would have got here a lot sooner if you had posted a reproducible example as requested.
Show text in shiny app when tabpanel is clean and hide it when output is displayed
Here is my take on the example shiny app:
library(shiny)
library(shinyjs)
# Define UI for application that draws a histogram
ui <- fluidPage(
useShinyjs(),
# Application title
titlePanel("Old Faithful Geyser Data"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
sliderInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = 30),
actionButton("submit", "Show plot")
),
# Show a plot of the generated distribution
mainPanel(
tabsetPanel(
tabPanel(
"Plot",
uiOutput("help_text"),
plotOutput("distPlot")
)
)
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
output$help_text <- renderUI({
HTML("<b>Click 'Show plot' to show the plot.</b>")
})
plot_data <- eventReactive(input$submit, {
hide("help_text")
# generate bins based on input$bins from ui.R
x <- faithful[, 2]
bins <- seq(min(x), max(x), length.out = input$bins + 1)
# draw the histogram with the specified number of bins
hist(x, breaks = bins, col = 'darkgray', border = 'white')
})
output$distPlot <- renderPlot({
plot_data()
})
}
# Run the application
shinyApp(ui = ui, server = server)
Shiny Plotly Plot stuck when switching tabs quickly
This looks like a bug on Plotly side to me. If you dont assign a starting width, the plot will be 100px wide. Changing the width of the div to 100% doesnt really do much.
You could include some Javascript to resize the plot every time the Tab is clicked, or you could deactivate all Tab buttons as long as shiny is busy.
With the resize method, the plots will be redrawn every time you hit the Tab, and after changing the window size, they resize normally again. I also tried to use the redraw, relayout methods of Plotly without success.
So, I would prefer the 2nd option, to disable the Tabs while the app is busy, but that doesnt really answer your question, so i commented out the JavaScript.
time_waste<- function(magnitude) {
y<-0
for(i in 1:magnitude) {
y<- y + rnorm(1,0,1)
}
return(abs(y))
}
## Resize plot p1 at every Tab click.
js <- HTML("
$(document).on('shiny:value', function() {
$('#tabset li a').on('click',function() {
Plotly.Plots.resize('p1');
});
});
"
)
## Deactivate all Buttons as long as shiny is busy
# js <- HTML('
# $(document).on("shiny:busy", function() {
# var inputs = document.getElementsByTagName("a");
# console.log(inputs);
# for (var i = 0; i < inputs.length; i++) {
# inputs[i].disabled = true;
# }
# });
#
# $(document).on("shiny:idle", function() {
# var inputs = document.getElementsByTagName("a");
# console.log(inputs);
# for (var i = 0; i < inputs.length; i++) {
# inputs[i].disabled = false;
# }
# });'
# )
ui <- fluidPage(
## Include JavaScript to the HTML
tags$head(tags$script(js)),
sidebarLayout(
sidebarPanel(width = 3,
fluidRow(
column(4,
numericInput(
inputId = "magnitude",
label = "magnitude",
value = 1000000
)))),
mainPanel(width = 8,
tabsetPanel(id = "tabset",
tabPanel("Plot1", plotlyOutput("p1", height = "700px")),
tabPanel("Plot2", plotlyOutput("p2", height = "700px"))))
)
)
server<- function(input, output, session) {
y <- reactive({
rep(time_waste(time_waste(input$magnitude)),3)
})
output$p1 <- renderPlotly({
plot_ly(x = c("giraffes", "orangutans", "monkeys"),
y = y(),name = "SF Zoo",type = "bar")
})
output$p2<- renderPlotly({
plot_ly(x = c("giraffes", "orangutans", "monkeys"),
y = y(), name = "SF Zoo",type = "bar")
})
}
shinyApp(ui, server)
shiny - automatically jump into new appended tab
The problem was with the way your tab_id's where set. there must have been some clash.
library(shiny)
library(leaflet)
library(shinydashboard)
pts <- data.frame(
id= letters[seq( from = 1, to = 10 )],
x = rnorm(10, mean = -93.625),
y = rnorm(10, mean = 42.0285)
)
# Define UI
ui <- fluidPage(
tabsetPanel(id='my_tabsetPanel',
tabPanel('Map1',
leafletOutput('map1')
)
)
)
server <- function(input, output, session) {
output$map1 <- renderLeaflet({
leaflet() %>%
addTiles() %>%
setView(-93.65, 42.0285, zoom = 6)
})
observe({
input$my_tabsetPanel
tab1 <- leafletProxy('map1', data = pts) %>%
clearMarkers() %>%
addCircleMarkers(lng = ~x, lat = ~y, radius = 4, layerId = ~id)
})
observeEvent(input$map1_marker_click, {
tab_title <- input$map1_marker_click[1]
appendTab(inputId = "my_tabsetPanel",
tabPanel(
tab_title, #paste0("tab_",tab_title),
value = paste0("tab_",tab_title),
fluidRow(
box('test')
#tags$b("some text")
)))
updateTabsetPanel(session, "my_tabsetPanel", selected = paste0("tab_",tab_title))
})
}
shinyApp(ui = ui, server = server)
changing the tab in the shiny
For completeness, here's a example using the awesome fullPage library mentioned in the comments:
# Dependencies install
# install.packages("remotes")
# remotes::install_github("RinteRface/fullPage")
library(shiny)
library(fullPage)
options <- list(
sectionsColor = c('#f2f2e2', '#f2f2f2', '#f2f2f2'),
parallax = TRUE
)
ui <- fullPage(
menu = c("Full Page" = "tab1","Sections" = "tab2","Image" = "tab3"),
opts = options,
fullSection(
center = TRUE,
menu = "tab1",
tags$h1("fullPage.js meets Shiny")
),
fullSection(
menu = "tab2",
fullRow(
fullColumn(
sliderInput(inputId = "bins",
label = "Number of bins:",
min = 1,
max = 50,
value = 30)
),
fullColumn(
plotOutput(outputId = "distPlot")
)
)
),
fullSectionImage(
menu = "tab3",
img = "https://blog.hubspot.com/hubfs/Smiling%20Leo%20Perfect%20GIF.gif"
)
)
server <- function(input, output){
output$distPlot <- renderPlot({
x <- faithful$waiting
bins <- seq(min(x), max(x), length.out = input$bins + 1)
hist(x, breaks = bins, col = "#75AADB", border = "white",
xlab = "Waiting time to next eruption (in mins)",
main = "Histogram of waiting times")
})
}
shinyApp(ui, server)
Although the fullpage.js library that it is used allow some configuration to use left/right keys to navigate, the shiny wrapper library above doesn't seem to expose that setting - I could only disable/enable the keyboard, but not choose direction.
R shiny: display “loading…” message while table is being rendered
Look for the recalculating class instead:
ui <- fluidPage(
actionButton('reload', 'reload'),
dataTableOutput('dtable_out'),
conditionalPanel("$('#dtable_out').hasClass('recalculating')",
tags$div('Loading ... ')
)
)
server <- function(input, output, session) {
output$dtable_out <- renderDataTable({
input$reload
Sys.sleep(2)
data.frame(a=1:10, b=letters[1:10])
})
}
runApp(list(ui=ui, server=server))
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.
How to prevent user from doing anything on shiny app when app is busy
After analyzing yours answers and think more about it, I think I found the simpliest solution.
On "shiny busy" event, I display a div in the conditional panel which is 100% of the screen and on first plan, so it prevents any click on the inputs / outputs behind it. When the app is not busy anymore, the panel disappear. The panel is transparent so the user doesn't see it.
Also, it enables me to disable all inputs and output without being dependant of a timer, only on if the app is busy or not.
library(shiny)
ui <- fluidPage(
# spinner css
tags$head(
tags$style(HTML("
#loadmessage {
position:fixed; z-index:8; top:50%; left:50%; padding:10px;
text-align:center; font-weight:bold; color:#000000; background-color:#CCFF66;
}
.loader {
position:fixed; z-index:8; border:16px solid #999999;
border-top: 16px solid #8B0000; border-radius: 50%;
width: 120px; height: 120px; top:45%; left:45%;
animation: spin 2s linear infinite;
}
.prevent_click{
position:fixed;
z-index:9;
width:100%;
height:100vh;
background-color: transpare'nt;
}
@keyframes spin {
0% { transform: rotate(0deg); }
100% { transform: rotate(360deg); }
}"))
),
# display load spinner when shiny is busy
conditionalPanel(
condition = "$(\'html\').hasClass(\'shiny-busy\')",
tags$div(class = "loader"),
tags$div(class = "prevent_click")
),
actionButton(
inputId = "increment",
label = "Increment"
),
textOutput("result"),
actionButton(
inputId = "busy",
label = "Busy app"
)
)
server <- function(input, output, session) {
rv <- reactiveValues(counter = 0)
#increment counter
observeEvent(input$increment,{
rv$counter = rv$counter + 1
})
#display incremented counter
output$result <- renderText({
rv$counter
})
observeEvent(input$busy, {
Sys.sleep(5)
# during this time, the user should not be able to do anything on the app
})
}
shinyApp(ui = ui, server = server)
Related Topics
How to Create Datatable with Complex Header in R Shiny
R: Robust Se's and Model Diagnostics in Stargazer Table
Linear Regression and Storing Results in Data Frame
Visualise Distances Between Texts
How to Call External R Script from R Markdown (.Rmd) in Rstudio
Excel Cell Coloring Using Xlsx
How to Split a Data Frame by Rows, and Then Process the Blocks
Filter One Selectinput Based on Selection from Another Selectinput
Arrange Plots in a Layout Which Cannot Be Achieved by 'Par(Mfrow ='
Factor Order Within Faceted Dotplot Using Ggplot2
Distance of Point Feature to Nearest Polygon in R
Using Grid and Ggplot2 to Create Join Plots Using R
Create a 24 Hour Vector with 5 Minutes Time Interval in R
Difference Between Read.Csv() and Read.Csv2() in R
Ggplot2 Avoid Boxes Around Legend Symbols
Warning in Install.Packages:Installation of Package 'Tidyverse' Had Non-Zero Exit Status