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.)
Related
So I have the following code which produces:
The issue here is twofold:
The group bar chart automatically places the highest value on the top (i.e. for avenue 4 CTP is on top), whereas I would always want FTP to be shown first then CTP to be shown after (so always blue bar then red bar)
I need all of the values to scale to 100 or 100% for their respective group (so for CTP avenue 4 would have a huge bar graph but the other avenues should be extremely tiny)
I am new to 'R'/Stack overflow so sorry if anything is wrong/you need more but any help is greatly appreciated.
library(ggplot2)
library(tidyverse)
library(magrittr)
# function to specify decimals
specify_decimal <- function(x, k) trimws(format(round(x, k), nsmall=k))
# sample data
avenues <- c("Avenue1", "Avenue2", "Avenue3", "Avenue4")
flytip_amount <- c(1000, 2000, 1500, 250)
collection_amount <- c(5, 15, 10, 2000)
# create data frame from the sample data
df <- data.frame(avenues, flytip_amount, collection_amount)
# got it working - now to test
df3 <- df
SumFA <- sum(df3$flytip_amount)
df3$FTP <- (df3$flytip_amount/SumFA)*100
df3$FTP <- specify_decimal(df3$FTP, 1)
SumCA <- sum(df3$collection_amount)
df3$CTP <- (df3$collection_amount/SumCA)*100
df3$CTP <- specify_decimal(df3$CTP, 1)
# Now we have percentages remove whole values
df2 <- df3[,c(1,4,5)]
df2 <- df2 %>% pivot_longer(-avenues)
FTGraphPos <- df2$name
ggplot(df2, aes(x = avenues, fill = as.factor(name), y = value)) +
geom_col(position = "dodge", width = 0.75) + coord_flip() +
labs(title = "Flytipping & Collection %", x = "ward_name", y = "Percentageperward") +
geom_text(aes(x= avenues, label = value), vjust = -0.1, position = "identity", size = 5)
I have tried the above and I have looked at lots of tutorials but nothing is exactly precise to what I need of ensuring the group bar charts puts the layers in the same order despite amount and scaling to 100/100%
As Camille notes, to handle ordering of the categories in a plot, you need to set them as factors, and then use functions from the forcats package to handle the order. Here I am using fct_relevel() (note that it will automatically convert character variables to factors).
Your numeric values are in fact set to character, so they need to be set to numeric for the chart to make sense.
To cover point #2, I'm using group_by() to calculate percentages within each name.
I have also fixed the labels so that they are properly dodged along with the bar chart. Also, note that you don't need to call ggplot2 or magrittr if you are calling tidyverse - those packages come along with it already.
df_plot <- df2 |>
mutate(name = fct_relevel(name, "CTP"),
value = as.numeric(value)) |>
group_by(name) |>
mutate(perc = value / sum(value)) |>
ungroup()
ggplot(df_plot, aes(x = value, y = avenues, fill = name)) +
geom_col(position = "dodge", width = 0.75) +
geom_text(aes(label = value), position = position_dodge(width = 0.75), size = 5) +
labs(title = "Flytipping & Collection %", x = "Percentageperward", y = "ward_name") +
guides(fill = guide_legend(reverse = TRUE))
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)
Hi I want to draw the space between two lines with red and blue( representing the anomalies), but I don't succeed to make it. Only blue anomaly is drawn.
Here is my code :
library(RCurl)
t <- getURL("https://raw.githubusercontent.com/vladamihaesei/weather_covid/master/Tab/UVanomaly.csv")## if can not download it, try manually
t <- read.csv(text =t)
head(t)
ggplot(t, aes(x=data, y=uv1920)) +
geom_line(aes(y = uv1920)) +
geom_line(aes(y = uv01_19)) +
geom_ribbon(data=subset(t, uv1920 <= uv01_19),
aes(ymin=uv1920,ymax=uv01_19), fill="blue") +
#scale_y_continuous(expand = c(0, 0), limits=c(0,20)) +
#scale_x_continuous(expand = c(0, 0), limits=c(0,5)) +
scale_x_date(date_breaks = "2 weeks", date_labels = "%d%b")+
scale_fill_manual(values=c("red","blue"))
One approach to get the space between the lines filled may look like so.
The basic idea is to split the data in periods which can be mapped on the group aes.
Unfortunately this is not a perfect solution. As you can see we get gaps at the intersection points. I've done something similar lately with a lot of manual work to fill the gaps but far less intersection points. Maybe someone else has a more general and feasible solution to tackle this issue.
t <- read.csv("https://raw.githubusercontent.com/vladamihaesei/weather_covid/master/Tab/UVanomaly.csv")
library(ggplot2)
library(dplyr)
t1 <- t %>%
mutate(date = as.Date(data1),
diff = uv1920 <= uv01_19,
period = cumsum(diff != lag(diff, default = TRUE)))
t1 %>%
ggplot(aes(x=date)) +
geom_line(aes(y = uv1920)) +
geom_line(aes(y = uv01_19)) +
geom_ribbon(aes(ymin =uv1920, ymax=uv01_19, group = period, fill = diff)) +
scale_x_date(date_breaks = "2 weeks", date_labels = "%d%b")+
scale_fill_manual(values=c("red","blue"))
Here is a reproducible example of a static plot, which I want to animate (I want to show how a MCMC sampler behaves).
library(tidyverse)
library(gganimate)
set.seed(1234)
plot_data <- tibble(x=cumsum(rnorm(100)),
y=cumsum(rnorm(100)),
time=1:length(x))
ggplot(data=plot_data,
aes(x=y, y=x)) +
geom_point() + geom_line()
What I'd like to see is the points being visible when they are drawn and a bit faded (i.e. alpha goes from e.g. 1 to 0.3) afterwards, while there would be a line that only shows the recent history (and ideally fades showing the most recent history the least faded and more than a few steps back totally disappearing).
The following achieves more or less what I want for my points (so in a sense I just want to add fading lines to this connecting the last few points - points fading more slowly across some frames would be even nicer):
ggplot(data=plot_data,
aes(x=y, y=x)) +
geom_point() +
transition_time(time) +
shadow_mark(past = T, future=F, alpha=0.3)
What I am struggling with is how to add two different behaviors for two geoms e.g. point and line. E.g. in the below the points disappear (I don't want them to) and the lines do not fade (I want them to).
p <- ggplot(data=plot_data,
aes(x=y, y=x)) +
geom_point() +
transition_time(time) +
shadow_mark(past = T, future=F, alpha=0.3)
p + geom_line() +
transition_reveal(along = time) +
shadow_mark(past = T, future=F, alpha=0.3)
I had trouble using the built-in shadow_* functions to control more than one behavior at a time; it seemed to just apply the most recent one. (Using gganimate 1.0.3.9000)
One way to get around this is to calculate the transitions manually. For instance, we could copy the data 100 times, one copy for each frame, and then specify the alpha for our points layer and the alpha for our segment layer separately.
plot_data %>%
uncount(100, .id = "frame") %>%
filter(time <= frame) %>%
arrange(frame, time) %>%
group_by(frame) %>%
mutate(x_lag = lag(x),
y_lag = lag(y),
tail = last(time) - time,
# Make the points solid for 1 frame then alpha 0.3
point_alpha = if_else(tail == 0, 1, 0.3),
# Make the lines fade out over 20 frames
segment_alpha = pmax(0, (20-tail)/20)) %>%
ungroup() %>%
ggplot(aes(x=y, y=x, xend = y_lag, yend = x_lag, group = time)) +
geom_segment(aes(alpha = segment_alpha)) +
geom_point(aes(alpha = point_alpha)) +
scale_alpha(range = c(0,1)) +
guides(alpha = F) +
transition_manual(frame)
(For this render, I wrapped it in animate( [everything above], width = 600, height = 400, type = "cairo"))
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)