I was wanting to make an animated ggplot of daily values for countries over the course of a year. I was able to do that thanks to some helpful questions/answers here.
While the code below successfully makes a gif, the changes/transitions when countries move up or down/overtake one another is very abrupt (i.e instantaneous). It is not smooth like the examples in the linked post.
I'm not entirely sure why this is happening and would really appreciate some help. Thanks in advance to anyone who is able to provide some insight. Code is below.
library(tidyverse)
library(ggplot2)
library(gganimate)
library(gifski)
library(png)
# Generate some fake data
n=365
df <- data.frame(country_name = rep(c("Country_1","Country_2","Country_3","Country_4","Country_5"), n, replace=FALSE),
date = rep(seq.Date(as.Date("2021-01-01"), as.Date("2021-12-31"), "day"),each=5), # each is number of countries
incidents=sample(1:100, size = 25, replace=TRUE
))
# Make cumulative number of events
df = df %>%
group_by(country_name) %>%
arrange(date) %>%
mutate(cumulative_incidents = cumsum(incidents)) %>%
ungroup()
# create integer rankings (I thought the *1 would make things smoother)
df = df %>%
group_by(date) %>%
mutate(rank = min_rank(-cumulative_incidents *1),
Value_rel = cumulative_incidents/cumulative_incidents[rank==1],
Value_lbl = paste0(" ",round(cumulative_incidents/1e9))) %>%
ungroup()
# make the static plot
my_plot = ggplot(df, aes(-rank,Value_rel, fill = country_name)) +
geom_col(width = 0.8, position="identity") +
coord_flip() +
geom_text(aes(-rank,y=0,label = country_name,hjust=0)) +
geom_text(aes(-rank,y=Value_rel,label = cumulative_incidents, hjust=0)) +
theme_minimal() +
theme(legend.position = "none",axis.title = element_blank()) +
# animate along Year
transition_states(date,4,1)
# animate the plot
animate(my_plot, 100, fps = 25, duration = 20, width = 800, height = 600)
The temporal resolution of your data is very high, you have 365 timepoints, but only 500 frames in your animation. These smooth switches therefore happen within 500 / 365 = ~1.4 frames and aren't visible.
Either make your animation much longer, reduce the time resolution of the data, or manually code in transitions. For example, here's what happens if we give data only once a month:
df2 <- filter(df, date %in% seq(min(date), max(date), 'week'))
my_plot <- ggplot(df2, aes(-rank,Value_rel, fill = country_name)) +
geom_col(width = 0.8, position="identity") +
coord_flip() +
geom_text(aes(-rank,y=0,label = country_name,hjust=0)) +
geom_text(aes(-rank,y=Value_rel,label = cumulative_incidents, hjust=0)) +
theme_minimal() +
theme(legend.position = "none",axis.title = element_blank()) +
# animate along Year
transition_states(date, transition_length = 10, state_length = 1)
animate(my_plot, fps = 25, duration = 20, width = 800, height = 600)
Related
This is where I get my dataset and c
board_game_original<- read.csv("https://raw.githubusercontent.com/bryandmartin/STAT302/master/docs/Projects/project1_bgdataviz/board_game_raw.csv")
#tidy up the column of mechanic and category with cSplit function
library(splitstackshape)
mechanic <- board_game$mechanic
board_game_tidy <- cSplit(board_game,splitCols=c("mechanic","category"), sep = ",", direction = "long")
I am trying to make the graph more organized by ordering the bar by the values of the bar on the y-axis. I tried using the reorder function but still does not work. Does anyone have any suggestions? I am quite new to R and hope to learn more!
library(ggplot2)
average_complexity <- board_game_tidy %>%
filter(yearpublished >= 1950, users_rated >= 25, average_complexity>0 ) %>%
select(average_complexity)
category_complexity_graph <- ggplot(data=board_game_tidy, aes(x = reorder(category, -average_complexity), y = average_complexity, na.rm = TRUE)) +
geom_bar(stat = "identity", na.rm = TRUE, color="white",fill="sky blue") +
ylim(0,5) +
theme_bw() +
ggtitle("Which category of board games has the highest level of average complexity") +
xlab("category of board games") +
ylab("average complexity of the board game") +
theme(axis.text.x = element_text(size=5, angle = 45)) +
theme(plot.title = element_text(hjust = 0.5))
category_complexity_graph
Here's the graph I plot:
"Category" is a categorical variable and "average complexity" is a continuous variable.
I was trying to answer the question "which category has the highest average complexity?" but this graph looks messy and any suggestion of cleaning it up would be appreciated as well! Thank you all
Maybe this is what you are looking for. The issue is not about reordering, the issue is about preparing your data. (; Put differently the reordering by the average does not give you a nice plot, because you have multiple obs. per category and more importantly a different number of obs. per category. When you do a barplot with this dataset all these obs. get stacked, i.e. your plot is show the sum of average complexities. Hence, to achieve your desired result your have to first summarise your dataset by category. After doing so, your reordering code works and gives you a nice plot.
However, I would suggest to flip the axes which makes the labels easier to read:
board_game_original<- read.csv("https://raw.githubusercontent.com/bryandmartin/STAT302/master/docs/Projects/project1_bgdataviz/board_game_raw.csv")
#tidy up the column of mechanic and category with cSplit function
library(splitstackshape)
board_game <- board_game_original
mechanic <- board_game$mechanic
board_game_tidy <- cSplit(board_game,splitCols=c("mechanic","category"), sep = ",", direction = "long")
library(ggplot2)
library(dplyr)
# Summarise your dataset
board_game_tidy1 <- board_game_tidy %>%
as_tibble() %>%
filter(yearpublished >= 1950, users_rated >= 25, average_complexity > 0, !is.na(category)) %>%
group_by(category) %>%
summarise(n = n(), average_complexity = mean(average_complexity, na.rm = TRUE))
ggplot(data=board_game_tidy1, aes(x = reorder(category, average_complexity), y = average_complexity, na.rm = TRUE)) +
geom_bar(stat = "identity", na.rm = TRUE, color="white",fill="sky blue") +
ylim(0,5) +
theme_bw() +
ggtitle("Which category of board games has the highest level of average complexity") +
xlab("category of board games") +
ylab("average complexity of the board game") +
#theme(axis.text.x = element_text(size=5, angle = 45)) +
theme(plot.title = element_text(hjust = 0.5)) +
coord_flip()
Using the code from this answer, How to make dots in gganimate appear and not transition, as a MWE, say we have this gganimate:
library(ggplot2)
library(gganimate)
a <- ggplot(airquality, aes(Day, Temp,
group = interaction(Month, Day))) +
geom_point(color = 'red', size = 1) +
transition_time(Month) +
shadow_mark(colour = 'black', size = 0.75) +
enter_fade()
animate(a, nframes = 100)
or
animate(a, fps=5)
Is it possible to control the speed of each Month (time element)? For example, display Month 5 very quickly, ..., Month 9 very slowly.
This is my rudimentary try by making a helper column which can be used as our transition_time to show how we can have different time step but desired labels.
You can later spend some more time to make a better *timestep columns which is more sophisticated and precisely meets your needs.
The main idea/point here is that we can use functions on the frame_time to get the labels as needed while the transition_time can be manipulated.
library(ggplot2)
library(gganimate)
library(dplyr)
g <- airquality %>%
group_by(Month) %>%
mutate(timestep = if_else(Month==5, ((1:n())-1)/2 + Month, 15 + Month)) %>%
ggplot(aes(Day, Temp, group = interaction(Month, Day))) +
geom_point(color = 'red', size = 1) +
transition_time(timestep) +
shadow_mark(colour = 'black', size = 0.75) +
enter_fade() +
labs(title = 'Month: {if_else(frame_time<21,5, ceiling(frame_time-15))}')
animate(g, nframes = 100)
Created on 2019-06-02 by the reprex package (v0.3.0)
Goal
I would like to zoom in on the GDP of Europe throughout the years. The phantastic ggforce::facet_zoom allows this for static plots (i.e., for one specific year) very easily.
Moving scales, however, prove harder than expected. gganimate seems to take the x-axis limits from the first frame (year == 1952) and continute until the end of the animation. This related, but code-wise outdated question did not yield an answer, unfortunately. Neither + coord_cartesian(xlim = c(from, to)), nor facet_zoom(xlim = c(from, to)) seems to be able to influence the facet_zoom window beyond static limits.
Is there any way to make gganimate 'recalculate' the facet_zoom scales for every frame?
Ideal result
First frame
Last frame
Current code
library(gapminder)
library(ggplot2)
library(gganimate)
library(ggforce)
p <- ggplot(gapminder, aes(gdpPercap, lifeExp, size = pop, color = continent)) +
geom_point() + scale_x_log10() +
facet_zoom(x = continent == "Europe") +
labs(title = "{frame_time}") +
transition_time(year)
animate(p, nframes = 30)
I don't think it's possible quite yet with the current dev version of gganimate as of Dec 2018; there seem to be some bugs which prevent facet_zoom from playing nice with gganimate. Fortunately, I don't think a workaround is too painful.
First, we can tween to fill in the intermediate years:
# Here I tween by fractional years for more smooth movement
years_all <- seq(min(gapminder$year),
max(gapminder$year),
by = 0.5)
gapminder_tweened <- gapminder %>%
tweenr::tween_components(time = year,
id = country,
ease = "linear",
nframes = length(years_all))
Then, adopting your code into a function that takes a year as input:
render_frame <- function(yr) {
p <- gapminder_tweened %>%
filter(year == yr) %>%
ggplot(aes(gdpPercap, lifeExp, size = pop, color = continent)) +
geom_point() +
scale_x_log10(labels = scales::dollar_format(largest_with_cents = 0)) +
scale_size_area(breaks = 1E7*10^0:3, labels = scales::comma) +
facet_zoom(x = continent == "Europe") +
labs(title = round(yr + 0.01) %>% as.integer)
# + 0.01 above is a hack to override R's default "0.5 rounds to the
# closest even" behavior, which in this case gives more frames
# (5 vs. 3) to the even years than the odd years
print(p)
}
Finally, we can save an animation by looping through through the years (which in this case include fractional years):
library(animation)
oopt = ani.options(interval = 1/10)
saveGIF({for (i in 1:length(years_all)) {
render_frame(years_all[i])
print(paste0(i, " out of ",length(years_all)))
ani.pause()}
},movie.name="facet_zoom.gif",ani.width = 400, ani.height = 300)
or, alternatively, using gifski for a smaller file <2MB:
gifski::save_gif({ for (i in 1:length(years_all) {
render_frame(years_all[i])
print(paste0(i, " out of ",length(years_all)))
}
},gif_file ="facet_zoom.gif", width = 400, height = 300, delay = 1/10, progress = TRUE)
(When I have more time, I'll try to remove the distracting changes in the legends by using manually specified breaks.)
Utilising this example from the package's wiki on Github:
airq <- airquality
airq$Month <- format(ISOdate(2004,1:12,1),"%B")[airq$Month]
ggplot(airq, aes(Day, Temp, group = Month)) +
geom_line() +
geom_segment(aes(xend = 31, yend = Temp), linetype = 2, colour = 'grey') +
geom_point(size = 2) +
geom_text(aes(x = 31.1, label = Month), hjust = 0) +
transition_reveal(Month, Day) +
coord_cartesian(clip = 'off') +
labs(title = 'Temperature in New York', y = 'Temperature (°F)') +
theme_minimal() +
theme(plot.margin = margin(5.5, 40, 5.5, 5.5))
Produces something like:
I wanted to know if there is any way to define pausing in the animation at specific points. For e.g. at Day 10, then 20, then when the animation is finished, before looping again. geom_reveal has no state_length or transition_length arguments available so I'm not sure if this is possible.
Edit: the package author mentions it's possible on twitter but I don't know what 'reveal timing' argument he is referring to.
From OP:
Edit: the package author mentions it's possible [to do this] but I don't
know what 'reveal timing' argument he is referring to.
On Twitter, Thomas Lin Pedersen was referring to how the transition_reveal line is driving the frames of the animation. So we can feed it one variable to be the "heartbeat" of the animation, while leaving the original variables for the plots.
My first approach was to make a new variable, reveal_time, which would be the heartbeat. I would increment it more at pause points, so that the animation would spend more time on those data points. Here I did that by adding 10 at the pause point days, and only 1 on other days.
library(dplyr)
airq_slowdown <- airq %>%
group_by(Month) %>%
mutate(show_time = case_when(Day %in% c(10,20,31) ~ 10,
TRUE ~ 1),
reveal_time = cumsum(show_time)) %>%
ungroup()
Then I fed that into the animation, changing the source data frame and the transition_reveal line.
library(gganimate)
a <- ggplot(airq_slowdown, aes(Day, Temp, group = Month)) +
geom_line() +
geom_segment(aes(xend = 31, yend = Temp), linetype = 2, colour = 'grey') +
geom_point(size = 2) +
geom_text(aes(x = 31.1, label = Month), hjust = 0) +
transition_reveal(reveal_time) + # Edit, previously had (Month, reveal_time)
coord_cartesian(clip = 'off') +
labs(title = 'Temperature in New York', y = 'Temperature (°F)') +
theme_minimal() +
theme(plot.margin = margin(5.5, 40, 5.5, 5.5))
animate(a, nframe = 50)
But when I did that, I realized that it wasn't pausing -- it was just slowing down the tweening. Sort of a "bullet time" effect -- cool but not quite what I was looking for.
So my second approach was to actually copy the paused lines of the animation. By doing so, there would be no tweening and there would be real pauses:
airq_pause <- airq %>%
mutate(show_time = case_when(Day %in% c(10,20,31) ~ 10,
TRUE ~ 1)) %>%
# uncount is a tidyr function which copies each line 'n' times
uncount(show_time) %>%
group_by(Month) %>%
mutate(reveal_time = row_number()) %>%
ungroup()
You can use the end_pause argument of the animate function:
library(gganimate)
library(animation)
animation <- barplot + transition_reveal(anho)
#barplot built in ggplot2
animate(animation, end_pause = 10, width=1000, height=600,fps = 5)
How do I stop the Y-axis changing during an animation?
The graph I made is at http://i.imgur.com/EKx6Tw8.gif
The idea is to make an animated heatmap of population and income each year. The problem is the y axis jumps to include 0 or not include the highest value sometime. How do you solidly set the axis values? I know this must be a common issue but I can't find the answer
The code to recreate it is
library(gapminder)
library(ggplot2)
library(devtools)
install_github("dgrtwo/gganimate")
library(gganimate)
library(dplyr)
mydata <- dplyr::select(gapminder, country,continent,year,lifeExp,pop,gdpPercap)
#bin years into 5 year bins
mydata$lifeExp2 <- as.integer(round((mydata$lifeExp-2)/5)*5)
mydata$income <- cut(mydata$gdpPercap, breaks=c(0,250,500,750,1000,1500,2000,2500,3000,3500,4500,5500,6500,7500,9000,11000,21000,31000,41000, 191000),
labels=c(0,250,500,750,1000,1500,2000,2500,3000,3500,4500,5500,6500,7500,9000,11000,21000,31000,41000))
sizePer <- mydata%>%
group_by(lifeExp2, income, year)%>%
mutate(popLikeThis = sum(pop))%>%
group_by(year)%>%
mutate(totalPop = sum(as.numeric(pop)))%>%
mutate(per = (popLikeThis/totalPop)*100)
sizePer$percent <- cut(sizePer$per, breaks=c(0,.1,.3,1,2,3,5,10,20,Inf),
labels=c(0,.1,.3,1,2.0,3,5,10,20))
saveGIF({
for(i in c(1997,2002,2007)){
print(ggplot(sizePer %>% filter(year == i),
aes(x = lifeExp2, y = income)) +
geom_tile(aes(fill = percent)) +
theme_bw()+
theme(legend.position="top", plot.title = element_text(size=30, face="bold",hjust = 0.5))+
coord_cartesian(xlim = c(20,85), ylim = c(0,21)) +
scale_fill_manual("%",values = c("#ffffcc","#ffeda0","#fed976","#feb24c","#fd8d3c","#fc4e2a","#e31a1c","#bd0026","#800026"),drop=FALSE)+
annotate(x=80, y=3, geom="text", label=i, size = 6) +
annotate(x=80, y=1, geom="text", label="#iamreddave", size = 5) +
ylab("Income") + # Remove x-axis label
xlab("Life Expenctancy")+
ggtitle("Worldwide Life Expectancy and Income")
)}
}, interval=0.7,ani.width = 900, ani.height = 600)
Solution:
Adding scale_y_discrete(drop = F) to the ggplot call. Answered by #bdemarest in comments.