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)
Related
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)
I am plotting the number of covid19 PCR in the towns of my province. The problem its that many town haven´t any PCR positive. I need a way to plot only the towns with at least 1+ PCR.
This is my code:
library(tidyverse)
library('data.table')
dfcsv1 <- read.csv("https://dadesobertes.gva.es/datastore/dump/ee17a346-a596-4866-a2ac-a530eb811737?bom=True",
encoding = "UTF-8", header = TRUE, sep = ",")
colnames(dfcsv1) <- c("code","code2","Municipio", "PCR", "TasaPCR", "PCR14",
"TasaPCR14", "Muertos", "TasaMuertos")
dfcsv1$TasaMuertos = as.numeric(gsub(",","\\.",dfcsv1$TasaMuertos))
dfcsv1$TasaPCR = as.numeric(gsub(",","\\.",dfcsv1$TasaPCR))
dfcsv1$TasaPCR14 = as.numeric(gsub(",","\\.",dfcsv1$TasaPCR14))
dfcsv1 %>%
mutate(Municipio = fct_reorder(Municipio, PCR14)) %>%
ggplot(aes(x=Municipio, y=PCR14, fill =TasaPCR14)) +
geom_bar(stat="identity", width=0.6) +
coord_flip() +
geom_text(data=dfcsv1, aes(y=PCR14,label=PCR14),vjust=1)+
scale_fill_gradient(low="steelblue", high="red")
As others have said in the comments, you need to filter out the PCR14 that is greater than 0 before reordering the factor levels. However, you will also need to remove the data parameter from geom_text, otherwise all those factor levels come back and you will have a big mess. It's already a bit crowded with the zero levels removed.
I think you should also change the vjust to an hjust to put the text in a nicer position since you have flipped the coordinates, with a compensating increase in the (flipped) y axis range to accommodate it:
dfcsv1 %>%
filter(PCR14 > 0) %>%
mutate(Municipio = fct_reorder(Municipio, PCR14)) %>%
ggplot(aes(x = Municipio, y = PCR14, fill = TasaPCR14)) +
geom_bar(stat = "identity", width = 0.6) +
coord_flip() +
geom_text(aes(y = PCR14,label = PCR14), hjust= -0.5) +
scale_fill_gradient(low = "steelblue", high = "red") +
ylim(c(0, 45))
Incidentally, it looks a lot better with the ones removed too:
dfcsv1 %>%
filter(PCR14 > 1) %>%
mutate(Municipio = fct_reorder(Municipio, PCR14)) %>%
ggplot(aes(x=Municipio, y=PCR14, fill =TasaPCR14)) +
geom_bar(stat="identity", width=0.6) + coord_flip() +
geom_text(aes(y=PCR14,label=PCR14),hjust=-0.5)+
scale_fill_gradient(low="steelblue", high="red") +
ylim(c(0, 45))
As a general rule, regardless of the type of plot or whether you are using ggplot , lattice or the base plot function, subsetting should happen first.
plot(x[y>0] , y[y>0])
The rest is aesthetics.
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)
Let's say I have the following graph:
library(ggplot2)
library(ggthemes)
library(extrafont)
charts.data <- read.csv("copper-data-for-tutorial.csv")
p1 <- ggplot() + geom_line(aes(y = export, x = year, colour = product),
data = charts.data, stat="identity")
p1
I'm looking for a general strategy (or perhaps a library) that "builds up" ggplots one line at a time. So the output would consist of two images, one with just the red line, and the next with the red and the blue line, to be used as adjacent slides in, say, a powerpoint presentation.
The key is filter for copper only in one, then to use ylim in both to keep the transition from one graph to the next smooth.
# copper only
df %>%
filter(product == "copper") %>%
ggplot() +
geom_line(aes(y = export, x = year, colour = product),
stat = "identity") +
ylim(0, 16000)
# both
df %>%
ggplot() +
geom_line(aes(y = export, x = year, colour = product),
stat = "identity") +
ylim(0, 16000)
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)