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)
My example dataframe:
sample1 <- seq(100,157, length.out = 50)
sample2 <- seq(113, 167, length.out = 50)
sample3 <- seq(95,160, length.out = 50)
sample4 <-seq(88, 110, length.out = 50)
df <- as.data.frame(cbind(sample1, sample2, sample3, sample4))
I have managed to create histograms for these four variables, which share the same y-axis. Now I need an overlay normal curve. Based on previous posts, I've managed a density curve, but this is not what I want. This comes close, but I'd like a smooth line...
This is my current code for plotting:
df <- as.data.table(df)
new.df<-melt(df,id.vars="sample")
names(new.df)=c("sample","type","value")
cdat <- ddply(new.df, "type", summarise, value.mean=mean(value))
ggplot(data = new.df,aes(x=value)) +
geom_histogram(aes(x = value), bins = 15, colour = "black", fill = "gray") +
facet_wrap(~ type) + geom_density(aes(x = value),alpha=.2, fill="#FF6666") +
geom_vline(data=cdat, aes(xintercept=value.mean),
linetype="dashed", size=1, colour="black") +
theme_classic() +
theme(text = element_text(size = 15), element_line(size = 0.5),aspect.ratio = 0.75 )
And I found the following code, which I hoped would do the trick, but this gives me nothing:
stat_function(fun = dnorm, args = list(mean = mean(df$value), sd = sd(df$value)))
Unfortunately, stat_function doesn't play nicely with facets: it overlays the same function on each facet without taking account of the faceting variable.
One of the most common reasons I see for people posting ggplot questions on Stack Overflow is that they get lost while trying to coerce ggplot to do too much of their data manipulation. Functions like geom_smooth and geom_function are useful helpers for common tasks, but if you want to do something that is complex or uncommon, it is best to produce the data you want to plot, then plot it.
In fact, the main author of ggplot2 recommends this approach for a very similar problem to yours in this thread, saying:
I think you are better off generating the data outside of ggplot2 and then plotting it. See https://speakerdeck.com/jennybc/row-oriented-workflows-in-r-with-the-tidyverse to get started.
Hadley Wickham, 26 April 2018
So here's one way of doing that using tidyverse. You create a data frame of the dnorm for each sample and plot these using plain old geom_line.
Note that your histograms are counts, so you either need to change them to density, or multiply the dnorm output by the number of observations * the binwidth, otherwise you will just get an apparently "flat" line on the x axis, since the dnorm values will all be so small in relation to the counts:
library(plyr)
library(dplyr)
library(tidyr)
library(ggplot2)
dfn <- df %>%
pivot_longer(everything()) %>%
ddply("name", function(x) {
xvar <- seq(min(x$value), max(x$value), length.out = 100)
data.frame(value = xvar,
y = 5 * nrow(x) * dnorm(xvar, mean(x$value), sd(x$value)))
})
df %>%
pivot_longer(everything()) %>%
group_by(name) %>%
mutate(mean = mean(value), sd = sd(value)) %>%
ggplot(aes(value)) +
geom_histogram(aes(x = value), binwidth = 5,
colour = "black", fill = "gray") +
facet_wrap(~ name) +
geom_vline(aes(xintercept = mean),
linetype = "dashed", size=1, colour="black") +
geom_line(data = dfn, aes(y = y)) +
theme_classic() +
theme(text = element_text(size = 15), element_line(size = 0.5),
aspect.ratio = 0.75 )
Created on 2020-12-07 by the reprex package (v0.3.0)
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)
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)