Created
July 9, 2022 11:15
-
-
Save AlbertRapp/9a33fcc4bcb10bd9f25d704c03893832 to your computer and use it in GitHub Desktop.
NYC flights calendar plot
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
library(tidyverse) | |
color_palette <- thematic::okabe_ito(8) | |
flights <- nycflights13::flights | |
counts <- flights %>% | |
mutate( | |
date = lubridate::make_date(year = year, month = month, day = day) | |
) %>% | |
count(date) %>% | |
mutate( | |
day = lubridate::mday(date), | |
month = lubridate::month(date, label = T, abbr = F, locale = 'en_US.UTF-8'), | |
wday = lubridate::wday(date, label = T, locale = 'en_US.UTF-8'), | |
week = stringi::stri_datetime_fields(date)$WeekOfMonth | |
) | |
schedueled_color <- color_palette[2] | |
nudge_labels <- 0.25 | |
font_family <- 'Fira Sans' | |
labels_color <- 'grey30' | |
labels_size <- 3 | |
wday_labels_size <- 3.5 | |
bar_width_cm <- 15 | |
bar_height_cm <- 0.3 | |
bar_labels_size <- 11 | |
month_size <- 12 | |
counts %>% | |
ggplot(aes(wday, 5 - week)) + | |
geom_tile( | |
aes(fill = n), | |
col = labels_color | |
) + | |
geom_text( | |
aes(label = day), | |
nudge_x = nudge_labels, | |
nudge_y = nudge_labels, | |
col = labels_color, | |
size = labels_size, | |
family = font_family | |
) + | |
geom_text( | |
data = counts %>% filter(month %in% c('October', 'November', 'December')), | |
aes(y = -0.75, label = wday), | |
col = labels_color, | |
size = wday_labels_size, | |
family = font_family | |
) + | |
facet_wrap(vars(month), ncol = 3) + | |
coord_equal(expand = F, ylim = c(-1.75, 4.5)) + | |
scale_fill_gradient( | |
high = schedueled_color, | |
low = colorspace::lighten(schedueled_color, 0.9), | |
) + | |
theme_void() + | |
theme( | |
text = element_text(color = labels_color, family = font_family), | |
plot.title = element_text(size = 24, margin = margin(t = 0.25, b = 0.25, unit = 'cm')), | |
plot.subtitle = element_text(size = 16, margin = margin(b = 0.5, unit = 'cm')), | |
plot.caption = element_text(size = 10, margin = margin(b = 0.25, unit = 'cm')), | |
plot.background = element_rect(fill = 'white', colour = NA), | |
legend.position = 'top', | |
legend.text = element_text(size = bar_labels_size), | |
legend.title = element_text(size = 14), | |
strip.text = element_text( | |
hjust = 0, | |
size = month_size, | |
margin = margin(b = 0.25, unit = 'cm') | |
) | |
) + | |
guides( | |
fill = guide_colorbar( | |
barwidth = unit(bar_width_cm, 'cm'), | |
barheight = unit(bar_height_cm, 'cm'), | |
title.position = 'top', | |
title.hjust = 0, | |
title.vjust = 0, | |
frame.colour = labels_color | |
) | |
) + | |
labs( | |
title = 'On Saturdays, less flights leave NYC', | |
subtitle = 'Based on 336,776 schedueled flights in 2013', | |
fill = 'No. of schedueled flights', | |
caption = 'Data: {nycflights13} R package | Graphic: Albert Rapp @rappa753' | |
) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment