How do I combine geom_smooth(method = "lm) function with gganimate()'s transition_layers, so that, as the individual bars drift/grow upwards, the linear line of geom_smooth appears, like so: Example of desired appearance of geom_smooth line The only difference is that in my case, instead of the points, the bars would drift upwards as the line appears.
The bars current work well, appearing by drifting upwards, made possible by using the transition_layers function of gganimate.
However, I can't figure out how to add the geom_smooth line, so it appears as the bars grow upwards. Right now, the line appears just at the end, as seen below.
See below for the current look of the animation.
Here is a simple reprex of my problem:
#Df for reprex
library(ggplot2)
library(tidyverse)
year <- as.numeric(c(1996:2002,
1996:2002,
1996:2002))
c <- c(39, 40, 67, 80, 30, 140, 90, 23, 100, 123,
140, 1, 2, 1, 13, 3, 3, 30, 1, 3, 3)
df <- data.frame(year, c) %>%
select(year, c) %>%
arrange(year)
#Static plot
(static_plot <- ggplot(data = df) +
geom_bar(data = df %>% filter(year == 1996), stat="identity", position ="stack",
aes(x = year, y = c)) +
geom_bar(data = df %>% filter(year == 1997), stat="identity", position ="stack",
aes(x = year, y = c)) +
geom_bar(data = df %>% filter(year == 1998), stat="identity", position ="stack",
aes(x = year, y = c)) +
geom_bar(data = df %>% filter(year == 1999), stat="identity", position ="stack",
aes(x = year, y = c)) +
geom_bar(data = df %>% filter(year == 2000), stat="identity", position ="stack",
aes(x = year, y = c)) +
geom_bar(data = df %>% filter(year == 2001), stat="identity", position ="stack",
aes(x = year, y = c)) +
geom_bar(data = df %>% filter(year == 2002), stat="identity", position ="stack",
aes(x = year, y = c)) +
labs(y = "year",
x = "c",
title = "Reprex") +
geom_smooth(df, mapping = aes(x = year, y = c), method = "lm",
colour = "black", se = F)
)
#Animation
library(gganimate)
anim <- static_plot +
transition_layers(layer_length = 1, transition_length = 1) +
enter_drift(x_mod = 0, y_mod = -max(df$c))
animate(anim, fps = 10, duration = 10,
width = 600, height = 500, renderer = gifski_renderer())
Here's an approach where the data is replicated and then filtered so each version shows progressively more years.
library(dplyr); library(tidyr)
animate(
df %>%
count(year, wt = c, name = "c") %>% # Aggregate for each year's total
uncount(7, .id = "year_disp") %>% # Make 7 copies, one for each year
arrange(year_disp, year) %>%
mutate(year_disp = year_disp + min(df$year) - 1) %>%
filter(year <= year_disp) %>% # Only keep years up to "year_disp"
ggplot(aes(year, c)) +
geom_col(aes(group = year)) + # "group" here connects each year to itself between frames
geom_smooth(method = "lm", se = F) +
transition_states(year_disp) +
enter_drift(y_mod = -max(df$c)),
fps = 10, duration = 10,
width = 600, height = 500, renderer = gifski_renderer())
The geom-line is calculated in the end and hence it appears only at the end. After each calculation of geom-bar, you have to calculate the geom-line as well, so that the line appears simultaneously with the Bars growing.
geom_bar(data = df %>% filter(year == 1997), stat="identity", position ="stack",
aes(x = year, y = c)) +
geom_line(filter(df, year %in% c(1996, 1997)), mapping = aes(x = year, y = lm),
colour = "black")
Do this for all the years and you should be getting the expected result!
Related
I have the following data:
library(ggplot2)
library(gganimate)
library(tidyverse)
createData<- function(vintage, id){#create data
# Generate a sequence of dates from 2010-01-01 to 2025-12-31 with a quarterly frequency
Dates <- seq(from = as.Date("2010-01-01"), to = as.Date("2025-12-31"), by = "quarter")
RLG<- cumsum(sample(c(-1, 1), 64, TRUE))
df<- data.frame( Dates,RLG, vintage,id)
return(df)
}
#createData
df<- createData("2018-01-01",1) %>%
rbind(createData("2019-01-01",2))%>%
rbind(createData("2020-01-01",3)) %>%
rbind(createData("2021-01-01",4))%>%
rbind(createData("2022-01-01",5))%>%
rbind(createData("2023-01-01",6))%>%
rbind(createData("2024-01-01",7))%>%
rbind(createData("2025-01-01",8))
Which I use to make the following chart:
options(gganimate.nframes = 8*length(unique(df$vintage)), gganimate.res = 30)
p<- ggplot(df) +
aes(x = Dates, y = RLG, group = as.Date(vintage), colour = "RLG") +
geom_line()+
scale_y_continuous(labels = \(x) paste0(x, "%"))+
theme(axis.title = element_blank(),legend.position="none")+
transition_time(id)+
exit_fade(alpha = 0.5)+
shadow_mark(alpha = 0.2)
animate(p, end_pause = 30)
I would like to add a geom_rect which goes from vintage to max(Dates). At each frame, vintage will increase, so the geom_rect will shrink slightly. How can I do this without interfering with the shadow_mark and exit_fades which I am applying to the lines?
If you mean something like a progress bar you could do it like so:
create an DF for the geom which is a subset of the original
df_geom <- df |>
mutate(vintage = as.Date(vintage)) |>
group_by(id) |>
slice(n())
Use geom_segment with the DF from above.
If you want to leave shadow_mark in you can do shadow_mark(exclude_layer = 2).
p <- ggplot(df) +
aes(x = Dates, y = RLG, group = as.Date(vintage), colour = RLG) +
geom_line()+
scale_y_continuous(labels = \(x) paste0(x, "%"))+
theme(axis.title = element_blank(),legend.position="none") +
geom_segment(
data = df_geom,
mapping = aes(x=vintage, xend=Dates,
y = 18, yend = 18),
size = 10, alpha =.4, color ='lightblue'
) +
transition_time(id)+
exit_fade(alpha = 0.5)
# shadow_mark(alpha = 0.2)
animate(p)
My data like this,but draw plot x axis is
12_01 12_10 12_11 12_12 12_2
I want to like
12_01 12_02 12_03...... 12_12
How can do it?
thanks!
df=data.frame(year=12,
month=1:12,
g=c(10,20,14,15,11:18))
df2 <- df %>%
arrange(month) %>%
unite(year_month,year,month) %>%
group_by(year_month)
ggplot(df2 , aes(x = year_month, y =g,group = 1))+
geom_line() +
geom_point(shape = 22, size = 2, fill = "white")
You could manage this by converting year_month into a factor; or alternatively using {lubridate}...
library(dplyr)
library(tidyr)
library(ggplot2)
library(stringr)
df=data.frame(year=12,
month=1:12,
g=c(10,20,14,15,11:18))
df2 <- df %>%
arrange(month) %>%
unite(year_month,year,month) %>%
mutate(year_month = factor(year_month, levels = paste0("12_", 1:12))) %>%
group_by(year_month)
ggplot(df2 , aes(x = year_month, y =g,group = 1))+
geom_line() +
geom_point(shape = 22, size = 2, fill = "white")
Alternatively with lubridate if you want to preserve the variable as a date object:
df2 <- df %>%
arrange(month) %>%
unite(year_month,year,month) %>%
mutate(year_month = ym(year_month)) %>%
group_by(year_month)
ggplot(df2 , aes(x = year_month, y =g,group = 1))+
geom_line() +
geom_point(shape = 22, size = 2, fill = "white")+
scale_x_date(date_labels = "%y_%m",
date_breaks = "1 month")
Created on 2022-03-18 by the reprex package (v2.0.1)
Why not make them into actual dates?
df %>%
arrange(month) %>%
mutate(date = as.Date(paste(paste0(20, year), month, 1, sep = '-'))) %>%
ggplot(aes(x = date, y =g,group = 1))+
geom_line() +
geom_point(shape = 22, size = 2, fill = "white")
My recommdation is to create a date variable in you dataframe and use that in the x axis, that way is more flexible de axis label configuration, via scale_x_date().
Look at two options:
library(dplyr)
library(ggplot2)
library(lubridate)
df <- data.frame(year = 12, month = 1:12, g = c(10, 20, 14, 15 , 11:18))
df2 <- df %>%
mutate(
date = make_date(year + 2000, month, "01")
)
ggplot(df2, aes(x = date, y = g)) +
geom_line() +
geom_point(shape = 22, size = 2, fill = "white") +
scale_x_date(labels = ~format(., '%m_%y'))
ggplot(df2, aes(x = date, y = g)) +
geom_line() +
geom_point(shape = 22, size = 2, fill = "white") +
scale_x_date(labels = ~format(., '%b %y'))
Created on 2022-03-18 by the reprex package (v2.0.1)
I am trying to draw separate line segments for each of the countries (A, B, C) in the plot.
I used the variable country for the group argument (as the docs suggest), but that does not work. The line is still a continuous line connecting all the text labels, but I need 3 separate lines to be drawn, one for each country, connecting the 3 text labels across the years.
library(dplyr)
library(ggplot2)
df_p <- data.frame(
year = rep(2019:2021, each = 3),
country = rep(LETTERS[1:3], 3),
var_a = c(1,6,10,2,5,7,3,7,9),
var_b = c(2,8,14,4,9,15,2,9,19)
)
df_p %>% arrange(country, year) %>%
ggplot(aes(x = var_a, y = var_b, color = country)) +
geom_text(aes(label = year)) +
geom_segment(
aes(
xend = c(tail(var_a, n = -1), NA),
yend = c(tail(var_b, n = -1), NA),
group = country
),
arrow = arrow(type = "open", length = unit(0.15, "inches"))
)
I think you just need geom_path instead of geom_segment.
Try this:
df_p %>% arrange(country, year) %>%
ggplot(aes(x = var_a, y = var_b, color = country)) +
geom_text(aes(label = year)) +
geom_path(
aes(
group = country
),
arrow = arrow(type = "open", length = unit(0.15, "inches"))
)
Another possible solution with geom_polygon() without showing the direction of the connections:
Sample data:
df_p <- data.frame(
year = rep(2019:2021, each = 3),
country = rep(LETTERS[1:3], 3),
var_a = c(1,6,10,2,5,7,3,7,9),
var_b = c(2,8,14,4,9,15,2,9,19)
)
Sample code:
library(dplyr)
library(ggplot2)
df_p %>%
arrange(country, year) %>%
ggplot(aes(x = var_a, y = var_b, group = country)) +
geom_point(aes(colour = country, shape = country), size = 4) +
geom_line(aes(colour = country), size = 1)+
geom_text(aes(label = year)) +
geom_polygon(
aes(
fill= country), alpha = .4)+
labs(x="Variable B",y="Variable A")+
theme_bw()
Output:
I have the following code
library(tibble)
library(tidyr)
library(dplyr)
library(ggplot2)
test <- tibble(
cat1 = c(rep('foo',6),rep('bar',6)),
cat2 = rep(c('g1','g2','g3','g4','g5','g6'), 2),
zoom = rnorm(12, 0, 10),
zaps = rnorm(12, 5, 10),
buzz = rnorm(12, -5, 10)
) %>% pivot_longer(c(zoom,zaps,buzz),names_to = 'cat3', values_to='value')
test2 <- inner_join(test, summarise(group_by(test, cat1, cat2), agg = sum(value)))
ggplot(test2, aes(x = cat1, y = value, fill = cat3, label = as.integer(value))) +
geom_bar(stat = 'identity', position = 'stack') +
geom_text(position = position_stack(vjust = 0.5), size = 3, color = "#555555") +
geom_errorbar(aes(ymin = agg, ymax = agg)) +
facet_grid(~ cat2)
which produces the following chart:
I like this and I am mostly happy with it, but I would love to include a sum total label for each column (the same value as the horizontal black line) somewhere in the column, ideally either at the bottom above/below the x axis labels or above the top edge of the plot below the g1,g2...
Can I do this by changing the displayed labels soo foo in g1 would be 'foo\n8' ? or is there a generic way to tell ggplot to put a number above the bar/foo labels in the plot or above the top edge of the top column component?
You may try this way. Please let me know if I miss something or I'm wrong with your purpose.
df2 %>%
group_by(cat1, cat2) %>%
mutate(n = sum(as.integer(value))) %>%
rowwise %>%
mutate(cat1 = paste0(c(cat1, n), collapse = "\n")) %>%
ggplot(aes(x = cat1, y = value, fill = cat3, label = as.integer(value))) +
geom_bar(stat = 'identity', position = 'stack') +
geom_text(position = position_stack(vjust = 0.5), size = 3, color = "#555555") +
geom_errorbar(aes(ymin = agg, ymax = agg)) +
facet_wrap(~ cat2, scales = "free_x", ncol = 6)
When plotting a bar chart with monthly data, ggplot shortens the distance between February and March, making the chart look inconsistent
require(dplyr)
require(ggplot2)
require(lubridate)
## simulating sample data
set.seed(.1073)
my_df <- data.frame(my_dates = sample(seq(as.Date('2010-01-01'), as.Date('2016-12-31'), 1), 1000, replace = TRUE))
### aggregating + visualizing counts per month
my_df %>%
mutate(my_dates = round_date(my_dates, 'month')) %>%
group_by(my_dates) %>%
summarise(n_row = n()) %>%
ggplot(aes(x = my_dates, y = n_row))+
geom_bar(stat = 'identity', color = 'black',fill = 'slateblue', alpha = .5)+
scale_x_date(date_breaks = 'months', date_labels = '%y-%b') +
theme(axis.text.x = element_text(angle = 60, hjust = 1))
I would keep the dates as dates rather than factors. Yes, factors will keep the bars uniform in size but you'll have to remember to join in any months that are missing so that blank months aren't skipped and factors are easy to get out of order. I would recommend adjusting your aesthetics to reduce the effect that the black outline has on the gap between February and March.
Here are two examples:
Adjust the outline color to be white. This will reduce the contrast and makes the gap less noticible.
Set the width to 20 (days).
As an aside, you don't need to summarize the data, you can use floor_date() or round_date() in an earlier step and go straight into geom_bar().
dates <- seq(as.Date("2010-01-01"), as.Date("2016-12-31"), 1)
set.seed(.1073)
my_df <-
tibble(
my_dates = sample(dates, 1000, replace = TRUE),
floor_dates = floor_date(my_dates, "month")
)
ggplot(my_df, aes(x = floor_dates)) +
geom_bar(color = "white", fill = "slateblue", alpha = .5)
ggplot(my_df, aes(x = floor_dates)) +
geom_bar(color = "black", fill = "slateblue", alpha = .5, width = 20)
using some parts from IceCream's answer you can try this.
Of note, geom_col is now recommended to use in this case.
my_df %>%
mutate(my_dates = factor(round_date(my_dates, 'month'))) %>%
group_by(my_dates) %>%
summarise(n_row = n()) %>%
ungroup() %>%
mutate(my_dates_x = as.numeric(my_dates)) %>%
mutate(my_dates_label = paste(month(my_dates,label = T), year(my_dates))) %>%
{ggplot(.,aes(x = my_dates_x, y = n_row))+
geom_col(color = 'black',width = 0.8, fill = 'slateblue', alpha = .5) +
scale_x_continuous(breaks = .$my_dates_x, labels = .$my_dates_label) +
theme(axis.text.x = element_text(angle = 60, hjust = 1))}
You can convert it to a factor variable to use as the axis, and fix the formatting with a label argument to scale_x_discrete.
library(dplyr)
library(ggplot2)
my_df %>%
mutate(my_dates = factor(round_date(my_dates, 'month'))) %>%
group_by(my_dates) %>%
summarise(n_row = n()) %>%
ggplot(aes(x = my_dates, y = n_row))+
geom_bar(stat = 'identity', color = 'black',fill = 'slateblue', alpha = .5)+
scale_x_discrete(labels = function(x) format(as.Date(x), '%Y-%b'))+
theme(axis.text.x = element_text(angle = 60, hjust = 1))
Edit: Alternate method to account for possibly missing months which should be represented as blank spaces in the plot.
library(dplyr)
library(ggplot2)
library(lubridate)
to_plot <-
my_df %>%
mutate(my_dates = round_date(my_dates, 'month'),
my_dates_ticks = interval(min(my_dates), my_dates) %/% months(1))
to_plot %>%
group_by(my_dates_ticks) %>%
summarise(n_row = n()) %>%
ggplot(aes(x = my_dates_ticks, y = n_row))+
geom_bar(stat = 'identity', color = 'black',fill = 'slateblue', alpha = .5)+
scale_x_continuous(
breaks = unique(to_plot$my_dates_ticks),
labels = function(x) format(min(to_plot$my_dates) + months(x), '%y-%b'))+
theme(axis.text.x = element_text(angle = 60, hjust = 1))