Note : I have read almost all the discussions on this object in shiny googlegroups and here in SO.
I need an indicator that shows the shiny server is busy. I have tried shiny-incubator, however, the problem is that I can't set a max for progress bar.
I don't want something like this : https://shiny.rstudio.com/gallery/progress-bar-example.html
What I need is something that:
shows a busy indicator message and bar (i.e just a simple animated bar, do not need to show a filling bar) as long as the server is calculating
it is shown in no matter which tab you are viewing. (not only in the related tab, but on top of the tabset)
Update 2018: Currently there is a great package to help you display loaders: shinycssloaders (source: https://github.com/andrewsali/shinycssloaders)
I've been looking for this as well. Most people suggest a conditional panel like so:
conditionalPanel(
condition="!($('html').hasClass('shiny-busy'))",
img(src="images/busy.gif")
)
You could always give yourself more control and create the conditional handling (maybe depending on more stuff) like this in your ui.R:
div(class = "busy",
p("Calculation in progress.."),
img(src="images/busy.gif")
)
where some JavaScript handles the showing and hiding of that div:
setInterval(function(){
if ($('html').attr('class')=='shiny-busy') {
$('div.busy').show()
} else {
$('div.busy').hide()
}
},100)
with some extra css you could make sure your animated busy image gets a fixed postion where it will always be visible.
In any of the above cases i found that the "shiny-busy" condition is somewhat imprecise and unreliable: the div shows for a split second and disappears while computations are still going on...
I found a dirty solution to fix that problem, at least in my apps. Feel free to try it out and maybe someone could give an insight to how and why this solves the issue.
In your server.R you'll need to add two reactiveValues:
shinyServer(function(input, output, session) {
# Reactive Value to reset UI, see render functions for more documentation
uiState <- reactiveValues()
uiState$readyFlag <- 0
uiState$readyCheck <- 0
then, in your renderPlot function (or other output function where computations go on), you use these reactive values to reset the function:
output$plot<- renderPlot({
if (is.null(input$file)){
return()
}
if(input$get == 0){
return()
}
uiState$readyFlag
# DIRTY HACK:
# Everytime "Get Plot" is clicked we get into this function
# In order for the ui to be able show the 'busy' indicator we
# somehow need to abort this function and then of course seamlessly
# call it again.
# We do this by using a reactive value keeping track of the ui State:
# renderPlot is depending on 'readyFlag': if that gets changed somehow
# the reactive programming model will call renderPlot
# If readyFlag equals readyCheck we exit the function (= ui reset) but in the
# meantime we change the readyFlag, so the renderHeatMap function will
# immediatly be called again. At the end of the function we make sure
# readyCheck gets the same value so we are back to the original state
isolate({
if (uiState$readyFlag == uiState$readyCheck) {
uiState$readyFlag <- uiState$readyFlag+1
return(NULL)
}
})
isolate({plot <- ...})
# Here we make sure readyCheck equals readyFlag once again
uiState$readyCheck <- uiState$readyFlag
return(plot)
})
Alternatively, you can use shinycssloaders package https://github.com/andrewsali/shinycssloaders
library(shiny)
library(dplyr)
library(shinycssloaders)
ui <- fluidPage(
actionButton("plot","plot"),
plotOutput("Test") %>% withSpinner(color="#0dc5c1")
)
server <- function(input, output, session) {
data <- eventReactive(input$plot,{
rnorm(1:100000)
})
output$Test <- renderPlot({
plot(data())
})
}
shinyApp(ui = ui, server = server)
Using waiter
library(shiny)
library(waiter)
ui <- fluidPage(
use_waiter(),
actionButton("plot","plot"),
plotOutput("Test")
)
server <- function(input, output, session) {
w <- Waiter$new(id = "Test")
data <- eventReactive(input$plot,{
w$show()
rnorm(1:100000)
})
output$Test <- renderPlot({
plot(data())
})
}
shinyApp(ui = ui, server = server)
I found using fadeIn() as opposed to show() helps mitigate this blinking occurence:
setInterval(function(){
if ($('html').attr('class')=='shiny-busy') {
setTimeoutConst = setTimeout(function(){
$('#loading-page').fadeIn(500);
}, delay);
} else {
clearTimeout(setTimeoutConst );
$('#loading-page').hide();
}
},10)
The busy div also appears for split seconds for the latest versions of shiny, even though no apparent calculations are going on (it was not an issue in older versions). Shiny seems to be regularly in its busy-mode for a short time. As a solution (complementing the above discussion), one can include another 2nd delayed validation of the shiny-busy html class for the conditional handling. The JavaScript-part would look something like that (example also includes check for two different div.busy-states depending on the reactive textit):
if( ($('html').attr('class')=='shiny-busy') ){
setTimeout(function() {
if ($('html').attr('class')=='shiny-busy') {
if($('#textit').html()!='Waiting...' ){
$('div.busy1').show()
}
if($('#textit').html()=='Waiting...'){
$('div.busy2').show()
}
}
},1000)
} else {
$('div.busy1').hide()
$('div.busy2').hide()
}
},100)
Related
I am trying to render icons in my shiny dashboard based on a particular condition. Below is the code I am using to get the if else working . Since my code base is too big to share I am just posting the code for that particular portion:
output$cost_compare <-renderUI( ifelse(
last_week$cost < kpi_table$cost,
as.character(icon("angle-up")),
as.character(icon("angle-down"))
))
compareCostUI <- function(id) {
ns <- NS(id)
( uiOutput(ns("cost_compare")))
}
And I am using this in the ui inside a descriptionblock. Below is the code for it
descriptionBlock(
number = compareCostUI("pacing"))
What I am missing here due to which I can see the icon rendered
Ignore my last comment:
Using renderText is what you want to use if you are passing html strings to the UI. Returning character values in renderUI returns literal strings. Seems unintuitive.
I'm not sure if your compareCostUI function is causing any issues and I also didn't know the namespace of descriptionBlock but I made a small reproducible example of rendering an icon.
I'm also assuming that your two values last_week and kpi_table are reactive in some way? otherwise the output$cost_compare would actually never update.
ui <- shinyUI(
fluidPage(
actionButton("Press","press", icon = icon("refresh")),
uiOutput("cost_compare")
)
)
server <- function(input, output, session) {
output$cost_compare <- renderText({
if(input$Press%%2==0){
condition <- T
} else{
condition <-F
}
ifelse(condition,
as.character(icon("angle-up")), as.character(icon("angle-down")))
}
)
}
shinyApp(ui, server)
To all R Shiny experts: Which of the following three server functions would you rate first, second and third - and why?
I had an intensive discussion today about which of the three solutions comes closest to "best practice" Shiny app design. (While they all three work the same.)
For example, version C seems odd to me since overwriting render functions conditionally is unnecessary (since conditional output rendering is what these functions were made for).
The original app contains much more logic when dealing with input values, of course. I simplified the example to make the differences obvious.
library(shiny)
ui <- fluidPage(
shiny::radioButtons(
inputId = "some_input",
label = "Please choose:",
choices = c("something", "nothing")
),
shiny::textOutput(
outputId = "some_output"
)
)
# version A: all logic within rendering function
server <- function(input, output, session) {
output$some_output <- shiny::renderText({
if(input$some_input == "something"){
# imagine some complex logic here
"some value was chosen"
} else {
NULL
}
})
}
# version B: most logic within input observer,
# using reactive session userData
server <- function(input, output, session) {
session$userData$memory <- shiny::reactiveValues(
"stored_value" = NULL
)
output$some_output <- shiny::renderText({
session$userData$memory$stored_value
})
shiny::observeEvent({
input$some_input
}, {
if(input$some_input == "something"){
# imagine some complex logic here
session$userData$memory$stored_value <- "some value was chosen"
} else {
session$userData$memory$stored_value <- NULL
}
})
}
# version C: all logic within observer,
# setting the rendering function conditionally
server <- function(input, output, session) {
shiny::observeEvent({
input$some_input
}, {
if(input$some_input == "something"){
# imagine some complex logic here
output$some_output <- shiny::renderText({ "some value was chosen" })
} else {
output$some_output <- shiny::renderText({ NULL })
}
})
}
shinyApp(ui = ui, server = server)
I am by no means a Shiny expert but as "best" isn't defined, I figured I would give my opinion based on the apps I've created (no documentation provided to support).
Order from best to worst:
A
B
C
Reasoning:
C: although having output$some_output in multiple places works, it is never good practice to do this and just creates confusion in the code
B: the observeEvent is repetitive as the renderText() is designed to observe when a reactive variable gets changed. I know you have a more complicated app but storing to reactiveValues in this example is over the top without gaining any benefit.
A: Very simple, basic code that works seamlessly. You could also argue you could take the if statement out of the renderText() and wrap it in a reactive() to keep it cleaner but they accomplish the same thing.
I'd be curious if anyone would do time studies or has some actual documentation to back up a "best" to "worst".
At the moment I am attempting the following: import a file in Rshiny, give it a number (interactive), and then move on to the next file. This part works fine. However, I would also like to store the data of every iteration, and then show it on the user interface.
However, it is not working. So I guess something is not right with the reactivity, but I am not sure how to fix it.
ui<-fluidPage(
mainPanel(
radioButtons(inputId="score",label="Give a score",choices=c(1:9),selected=1),
actionButton(inputId="new","Next file"),
tableOutput("savdat")
)
)
server<-function(input,output){
NoFiles<-length(list.files())
Here an empty reactive data.frame
outputdata<-reactive(data.frame("file"="file","score"="score"))
filename<-eventReactive(input$new,{
WhichFile<-sample(1:NoFiles,1)
filename<-list.files()[WhichFile]
return(filename)
})
scores<-eventReactive(input$new,{
return(input$score)
})
Then I would like to append the previous values of the outputdata, with the new values. But it is not working
outputdata<-eventReactive(input$new,{
rbind(outputdata(),filename(),scores())
})
output$savdat<-renderTable(outputdata())
}
shinyApp(ui, server)
Any advice would be welcome
It appears you want the reactivity to occur each time you click on the 'Next file' button. I rewrote your code to respond just once, using 'ObserveEvent', each time the 'Next file' button is clicked. The 2nd challenge is permitting values to persist upon each reactive event. While there are multiple ways to handle this, I chose an expedient technique, the '<<-' assignment statement, to permit the variable 'output data' to persist (this is generally not a good programming technique). Because the variable 'outputdata' exists in all environments, you'll need to wipe your environment each time you want to run this program.
Here's my rewrite using the same ui you created:
ui<-fluidPage(
mainPanel(
radioButtons(inputId="score",label="Give a score",choices=c(1:9),selected=1),
actionButton(inputId="new","Next file"),
tableOutput("savdat")
)
)
server<-function(input,output){
NoFiles<-length(list.files())
setupData <- function(filename,score) {
data <- data.frame(filename,score,stringsAsFactors = FALSE)
return(data)
}
observeEvent (input$new, {
WhichFile<-sample(1:NoFiles,1)
filename<-list.files()[WhichFile]
if (!exists(c('outputdata'))) {
score <- input$score
outputdata <<- data.frame (filename,score,stringsAsFactors = FALSE)
}
else {
outputdata <<- rbind(outputdata,setupData(filename,input$score))
}
# Show the table
output$savdat<-renderTable(outputdata)
})
}
shinyApp(ui, server)
Let's say I have created 10 selectInput dropdowns for a multi plot export and these selectInputs are called "xaxis_1", "xaxis_2", ..... , "xaxis_10"
for a single 1 I can write:
if(!is.null(input$xaxis_1)) { .... do stuff } to stop it running export when the user hasn't entered any name, and presses submit, to avoid crashes.
A bit more general you can check this:
if(!is.null(input[[paste('xaxis', i, sep = '_')]])) { ...}
how can you write it elegantly so that 1 line of code checks whether ANY of the 1:10 input[[...]] is empty, i.e. NULL?
The nr of inputs depends on how many plots the user wants to export per file, so all is build with lapply(1:input$nrofplots, function(i) { .... } renderUI structure, and my if statement needs to have the same flexibility of 1:n
In a situation like below in the image, pressing Initiate export should give a sweetalert (got that covered) saying there is at least 1 value missing
Here a snippet I used in the UI side to validate the user's inputs.
library(shiny)
library(shinyjs)
ui <- fluidPage(
useShinyjs(), # Set up shinyjs
numericInput('axis1','Val 1',1),
numericInput('axis2','Val 2',1),
numericInput('axis3','Val 3',1),
actionButton('Go','Plot')
)
server <- function(input, output, session) {
#Try 1, space, AAA and check what shiny will return
observe(print(input$axis1))
observe({
All_Inputs <- vapply(paste0('axis',1:3),
function(x){isTruthy(input[[x]])},
logical(1))
All_InputsCP <- all(All_Inputs)
shinyjs::toggleState(id="Go", condition = All_InputsCP) #This is to make the button Go able or disable according to condition All_InputsCP #
})
}
shinyApp(ui, server)
I hope it helps.
I'm having trouble creating a sequence of events in a Shiny app. I know there are other ways of handling parts of this issue (with JS), and also different Shiny functions I could use to a similar end (e.g. withProgress), but I'd like to understand how to make this work with reactivity.
The flow I hope to achieve is as follows:
1) user clicks action button, which causes A) a time-consuming calculation to begin and B) a simple statement to print to the UI letting the user know the calculation has begun
2) once calculation returns a value, trigger another update to the previous text output alerting the user the calculation is complete
I've experimented with using the action button to update the text value, and setting an observer on that value to begin the calculation (so that 1B runs before 1A), to ensure that the message isn't only displayed in the UI once the calculation is complete, but haven't gotten anything to work. Here is my latest attempt:
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
actionButton("run", "Pull Data")
mainPanel(
textOutput("status")
)
)
)
server <- function(input, output, session) {
# slow function for demonstration purposes...
test.function <- function() {
for(i in seq(5)) {
print(i)
Sys.sleep(i)
}
data.frame(a=c(1,2,3))
}
report <- reactiveValues(
status = NULL,
data = NULL
)
observeEvent(input$run, {
report$status <- "Pulling data..."
})
observeEvent(report$status == "Pulling data...", {
report$data <- test.function()
})
observeEvent(is.data.frame(report$data), {
report$status <- "Data pull complete"
}
)
observe({
output$status <- renderText({report$status})
})
}
Eventually, I hope to build this into a longer cycle of calculation + user input, so I'm hoping to find a good pattern of observers + reactive elements to handle this kind of ongoing interaction. Any help is appreciated!