I have recently written a Shiny app that takes user data input, does some analysis on it, and then displays the results, including graphs. These graphs take a while to render, so I am using withSpinner to inform the users that Shiny is busy and to be patient and wait for the graphs to appear. The graphs are displayed within boxes that have titles informing the users what the graphs show.
What gets displayed to the users depends on the data they provide to the app (how many items of data are provided in their input file) and also which options they choose from within the app (using checkboxes).
The withSpinner function works well for the graphs when wrapped around plotOutput and called from within ui (see line 38 of the example code below).
However, to use this approach for all graphs would require me to know how many items of data the users are likely to provide and then want to view. I would like to just automatically produce a graph, with a spinner, for each data item, without knowing how many there are in advance.
Placing withSpinner within the server doesn’t work at all (lines 58-65), which makes sense. However, if I use it in the ui around the uiOutput object for all of the boxes and graphs (line 29), the spinner only shows until the boxes are rendered – the graphs then appear about a minute later…
Please can you help me to work out how to get the spinners to show until the graphs are rendered? Thank you for any help you can give!
library(shiny)
library(shinydashboard)
library(shinyjs)
library(shinycssloaders)
library(survival)
ui <- dashboardPage(
skin = "blue",
dashboardHeader(title = "My App"),
dashboardSidebar(
sidebarMenu(
useShinyjs(),
id = "tabs",
menuItem("User Choice", tabName = "uChoice", icon = icon("sliders-h"))
)
),
dashboardBody(
id = "dashboardBody",
tabItems(
tabItem(
tabName = "uChoice",
h2("You have a choice"),
# Check boxes to select choice
fluidRow(
uiOutput("userChoiceCheckbox")
),
fluidRow(
# Only show the data graphs that the user has chosen to look at
withSpinner(uiOutput('chosenGraphs'), type=4)
# this spinner only shows until the box containing the graph is rendered
),
fluidRow(
# Always show lung graph
box(
title = paste("Here's the lung graph"),
width = 12,
height="50px",
withSpinner(plotOutput("lungGraph"), type=4)
# This spinner shows until the graph is plotted
)
)
)
)
)
)
server <- function(input, output, session) {
output$userChoiceCheckbox <- renderUI({
column(6, checkboxGroupInput(inputId = "choices", label = "Which graph(s) would you like to view?", choices = c("Lung", "PBC")))
})
output$chosenGraphs <- renderUI({
lapply(input$choices, function(x) {
box(
title = paste("Graph for", x,"cancer"),
width = 12,
renderPlot({
withSpinner(
# This spinner doesn't seem to work at all
plotOutput({
Sys.sleep(2)
plot(survfit(Surv(time, status) ~ 1, data = eval(as.symbol(tolower(x)))),
xlab = "Days",
ylab = "Overall survival probability")
})
)
})
)
})
})
output$lungGraph <- renderPlot(
plot(survfit(Surv(time, status) ~ 1, data = lung),
xlab = "Days",
ylab = "Overall survival probability")
)
}
shinyApp(ui, server)
In case you didn't find an answer, I couldn't add a single spinner per plot but the whole renderUI region can be wrapped by withSpinner() if you add it after the lapply().
In your case it would be something like this:
output$chosenGraphs <- renderUI({
lapply(input$choices, function(x) {
box(
title = paste("Graph for", x,"cancer"),
width = 12,
renderPlot({
plotOutput({
Sys.sleep(2)
plot(survfit(Surv(time, status) ~ 1, data = eval(as.symbol(tolower(x)))),
xlab = "Days",
ylab = "Overall survival probability")
})
})
)
}) %>% withSpinner()
})
I need an interactive plot with two sliders, and I want the plot to be updated smoothly as I slide, without releasing mouse button. Do you know of any other solution in R which is able to do that?
I found a nice library manipulate (see example below), but the plot is only updated after releasing mouse button, so I have to stop sliding to see updated plot (which makes the experience not smooth). I want the plot to be updated during sliding already.
library(manipulate)
manipulate(curve(amp*sin(freq*x), xlim = c(0,10), ylim =c(-1,1)), amp = slider(0.1,1), freq = slider(0.1,10))
PS: I am used to just base graphics library, so I prefer simple solutions using that; but if there's no other way, ggplot/lattice is good as well :-))
I appreciate you were looking for a answer in base R, however shiny is typically a good choice for interactive plots in R.
The following code should achieve your desired output (and you do not have to release the mouse button for the plot to update):
library(shiny)
ui <- fluidPage(
# Sidebar with a slider input
sidebarLayout(
sidebarPanel(
sliderInput(
inputId = "amp",
label = "Amp:",
min = 0.1,
max = 1,
value = 0.5
),
sliderInput(
inputId = "freq",
label = "Freq:",
min = 0.1,
max = 10,
value = 0.5
)
),
# Show a plot
mainPanel(
plotOutput("plot")
)
)
)
# Define server logic
server <- function(input, output) {
output$plot <- renderPlot({
amp <- input$amp
freq <- input$freq
curve(amp * sin(freq * x), xlim = c(0, 10), ylim = c(-1, 1))
})
}
# Run the application
shinyApp(ui = ui, server = server)
I am trying to add graph for the output which i have generated using shiny. I am getting error for graph generation. Can someone please have a look and assist. The bar graph parameters are calculation based outputs generated from calculations.
server
output$graph<- renderPlotly({
plotly( x= c(as.numeric(input$contract), round(frateperton()), differencerate()),
y= c('Contract Rate', 'ZBC Rate', 'Difference'),
name = "Zero Based Rate Chart",
type = "bar")
})
UI
plotlyOutput("graph"),
First of all, two remarks on your post :
it is not reproducible, see here to learn what a reproducible example is and how to make one
clearly you haven't searched enough. Typing "r shiny plotly output" in any search engine gives several potential solutions (here for example).
To avoid duplicated posts, please consider these two points next time.
Now, here's the answer (using iris data since your example is not reproducible):
library(shiny)
library(plotly)
ui <- fluidPage(
selectInput("choice", "Choose", choices = names(iris), selected = NULL),
plotlyOutput("graph")
)
server <- function(input, output, session){
output$graph <- renderPlotly({
plot_ly(iris, x = ~get(input$choice), y = ~Sepal.Length, type = 'scatter', mode = 'markers')
})
}
shinyApp(ui, server)
I am facing the same issue as mentioned in
R/Shiny plots do not show in the browser
But in my case reactivePlot() is not working.It shows
error i.e "reactivePlot is deprecated. Please use renderPlot instead."
The code doesn't throw any error. It works fine. Issue is only with displaying plotly graph in the browser. I tried it on all browser, graph is displayed on viewer pane instead of the browser, although If I plot other chart like barplot it easily get displayed on the browser.
I am not able to resolve the issue!! Help me out!!
Thanks in advance!!!!
Just an example that how it solved my problem.
ui <- dashboardPage(
dashboardHeader(title = "Basic dashboard"),
dashboardSidebar(),
dashboardBody(
fluidRow(
box(plotlyOutput("plot1", height = "400px", width = "600px"))
)
)
)
server <- function(input, output) {
set.seed(100)
d <- diamonds[sample(nrow(diamonds), 1000), ]
output$plot1 <- renderPlotly({
plot_ly(d, x = ~carat, y = ~price, color = ~carat,
size = ~carat, text = ~paste("Clarity: ", clarity))
})
}
shinyApp(ui = ui, server = server)
I solved the problem using plotly() in the UI and renderPlotly() in the server.
I've been working on an animated slider project in Shiny and I nearly have what I am after, but not quite. Instead of displaying each successive graph in the animated sequence, it appears to be showing the graph with all of the data (non sequenced). I'm not quite sure where my error is but I suspect it is in the reactive function call or the renderPlot function call in the server section. I've tried searching the Web and I've tried placing different code blocks in different locations but I can not seem to get the animation to work in Shiny. Eventually I want to change the numeric months (1,2,3...) to date objects for more clarity but I'll tackle that one after the animation is working.
Please note - I HAVE been able to get a successful motion chart for this data using googleVic, gvisMotionChart and Shiny but I found with that approach I do not have control of the bubble chart colors or the bubble size (I want a constant size that is much smaller than google's bubble chart default size due to overlap). So, I am hoping to accomplish this animation with R's base graphics or with ggplot.
Here is small set of data to represent what I am using:
d1 <- data.table( id = 1:21,
Region = rep(c("R1","R2","R3"), each=7),
Month = 1,
Spend = round(runif(21,100,500)),
Age = round(runif(21,72,100)),
Color = rep(c("#E69F00","#D55E00","#009E73"),each=7))
d2 <- copy(d1)
d2[,Month:=Month+1][,Age:=Age+1][,Spend:=Spend+round(runif(21,0,4))]
d3 <- copy(d2)
d3[,Month:=Month+1][,Age:=Age+1][,Spend:=Spend+round(runif(21,0,4))]
d4 <- copy(d3)
d4[,Month:=Month+1][,Age:=Age+1][,Spend:=Spend+round(runif(21,0,4))]
d5 <- copy(d4)
d5[,Month:=Month+1][,Age:=Age+1][,Spend:=Spend+round(runif(21,0,4))]
d6 <- copy(d5)
d6[,Month:=Month+1][,Age:=Age+1][,Spend:=Spend+round(runif(21,0,4))]
d7 <- copy(d6)
d7[,Month:=Month+1][,Age:=Age+1][,Spend:=Spend+round(runif(21,0,4))]
d8 <- copy(d7)
d8[,Month:=Month+1][,Age:=Age+1][,Spend:=Spend+round(runif(21,0,4))]
dat <- rbindlist(list(d1,d2,d3,d4,d5,d6,d7,d8))
Here is an animated GIF to show what the animation would look like with base graphics
saveGIF({
for(i in 1:8){
plot(dat[Month==i,Age],dat[Month==i,Spend],col=dat[Month==i,Color],
pch=16, xlim=c(min(dat$Age)*.95,max(dat$Age)*1.1),
ylim=c(min(dat$Spend)*.95,max(dat$Spend)*1.1),
xlab="Age in Months",ylab="Dollars", las=1, cex.axis=.7)
legend("topright",inset=.05,c("Reg 1","Reg 2","Reg 3"),
pch=16,col=c("#E69F00","#D55E00","#009E73"),
cex=.8)
ani.pause()
}
}, interval = 0.25, ani.width = 750, ani.height = 550)
This is my current nonworking Shiny code
library(shiny)
library(ggplot2)
# Shiny app with slider and animation
# ui section
ui = fluidPage(
# Title
titlePanel("Spend vs Age by Region"),
# Sidebar with slider and controls for animation
sidebarLayout(
# sidebar with slider
sidebarPanel(
# Slider with looping
sliderInput("theMonth", "Month", 1, 8, 1, step = 1,
animate=animationOptions(interval=1000, loop = T,
playButton = T, pauseButton = T))
),
# Show the animated graph
mainPanel(
plotOutput(outputId="case_age_plot")
)
)
)
# server section
server = function(input, output) {
# Reactive expression to create data frame and graph
aniGraph <- reactive({
# subset the data frame into the portion that has the data for the
# graph in the animation sequence
dat[Month==input$theMonth,]
# create the graph
plot(dat[,Age],dat[,Spend],col=dat[,Color],
pch=16, xlim=c(min(dat$Age)*.95,max(dat$Age)*1.1),
ylim=c(min(dat$Spend)*.95,max(dat$Spend)*1.1),
xlab="Age in Months",ylab="Dollars", las=1, cex.axis=.7)
legend("topright",inset=.05,c("Reg 1","Reg 2","Reg 3"),
pch=16,col=c("#E69F00","#D55E00","#009E73"),cex=.8)
})
# Show the graph
output$case_age_plot <- renderPlot({
aniGraph()
})
}
# run the app
runApp(list(ui = ui, server = server))
If anyone has a solution or thoughts I would be grateful.
the problem was that you didn't save the subset of dat. I slightly modified your code to get the same animation as in gif animation.
library(shiny)
library(ggplot2)
# Shiny app with slider and animation
# ui section
ui = fluidPage(
# Title
titlePanel("Spend vs Age by Region"),
# Sidebar with slider and controls for animation
sidebarLayout(
# sidebar with slider
sidebarPanel(
# Slider with looping
sliderInput("theMonth", "Month", 1, 8, 1, step = 1,
animate=animationOptions(interval=1000, loop = T,
playButton = T, pauseButton = T))
),
# Show the animated graph
mainPanel(
plotOutput(outputId="case_age_plot")
)
)
)
# server section
server = function(input, output) {
# Reactive expression to create data frame and graph
aniGraph <- reactive({
# subset the data frame into the portion that has the data for the
# graph in the animation sequence
# Save subset of 'dat' and pass it to the plot
dat_sub <- dat[Month==input$theMonth,]
# create the graph
plot(dat_sub[,Age],dat_sub[,Spend],col=dat_sub[,Color],
pch=16, xlim=c(min(dat$Age)*.95,max(dat$Age)*1.1),
ylim=c(min(dat$Spend)*.95,max(dat$Spend)*1.1),
xlab="Age in Months",ylab="Dollars", las=1, cex.axis=.7)
legend("topright",inset=.05,c("Reg 1","Reg 2","Reg 3"),
pch=16,col=c("#E69F00","#D55E00","#009E73"),cex=.8)
})
# Show the graph
output$case_age_plot <- renderPlot({
aniGraph()
})
}
# run the app
runApp(list(ui = ui, server = server))
I wanted my graph to just animate without a slider. With a duckduck search I found Dan Mohamed's article at https://nhsrcommunity.com/animating-a-graph-over-time-in-shiny/ which pointed me to reactiveTimer(). Here is a condensed version of my implementation.
propagator <- 0
ui <- fluidPage( . . . )
server <- function(input, output) {
autoInvalidate <- reactiveTimer()
observe( {autoInvalidate()} )
output$orb <- renderPlot({
autoInvalidate()
propagator <<- propagator + 1
. . .
})
}