Shiny with animated scatterplot in R base graphics or ggplot possible? - r

Question

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.

Answer 1

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

Answer 2

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