Calendar Plots With ggplot2

Albert Rapp

1 week ago

[This article was first published on Albert Rapp, and kindly contributed to R-bloggers]. (You can report issue about the content on this page here)

Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.

< section id="load-the-tidyverse-and-take-a-look-at-our-data" class="level2">

Load the tidyverse and take a look at our data

library(tidyverse)
flights <- nycflights13::flights
flights
## # A tibble: 336,776 × 19
##     year month   day dep_time sched_dep_time dep_delay arr_time sched_arr_time
##    <int> <int> <int>    <int>          <int>     <dbl>    <int>          <int>
##  1  2013     1     1      517            515         2      830            819
##  2  2013     1     1      533            529         4      850            830
##  3  2013     1     1      542            540         2      923            850
##  4  2013     1     1      544            545        -1     1004           1022
##  5  2013     1     1      554            600        -6      812            837
##  6  2013     1     1      554            558        -4      740            728
##  7  2013     1     1      555            600        -5      913            854
##  8  2013     1     1      557            600        -3      709            723
##  9  2013     1     1      557            600        -3      838            846
## 10  2013     1     1      558            600        -2      753            745
## # ℹ 336,766 more rows
## # ℹ 11 more variables: arr_delay <dbl>, carrier <chr>, flight <int>,
## #   tailnum <chr>, origin <chr>, dest <chr>, air_time <dbl>, distance <dbl>,
## #   hour <dbl>, minute <dbl>, time_hour <dttm>

< section id="count-flights-per-date" class="level2">

Count flights per date

From the first three columns we can easily create a date and then count how often each date appears

date_counts <- flights |> 
  mutate(
    date = make_date(
      year = year, month = month, day = day
    )
  ) |> 
  count(date) 
date_counts
## # A tibble: 365 × 2
##    date           n
##    <date>     <int>
##  1 2013-01-01   842
##  2 2013-01-02   943
##  3 2013-01-03   914
##  4 2013-01-04   915
##  5 2013-01-05   720
##  6 2013-01-06   832
##  7 2013-01-07   933
##  8 2013-01-08   899
##  9 2013-01-09   902
## 10 2013-01-10   932
## # ℹ 355 more rows

< section id="get-days-of-the-month-week-day-week-of-month" class="level2">

Get days of the month, week day, week of month

date_counts_w_labels <- date_counts |> 
  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
  )
date_counts_w_labels
## # A tibble: 365 × 6
##    date           n   day month   wday   week
##    <date>     <int> <int> <ord>   <ord> <int>
##  1 2013-01-01   842     1 January Tue       1
##  2 2013-01-02   943     2 January Wed       1
##  3 2013-01-03   914     3 January Thu       1
##  4 2013-01-04   915     4 January Fri       1
##  5 2013-01-05   720     5 January Sat       1
##  6 2013-01-06   832     6 January Sun       2
##  7 2013-01-07   933     7 January Mon       2
##  8 2013-01-08   899     8 January Tue       2
##  9 2013-01-09   902     9 January Wed       2
## 10 2013-01-10   932    10 January Thu       2
## # ℹ 355 more rows

< section id="create-first-faceted-plot" class="level2">

Create first faceted plot

labels_color <- 'grey30'

date_counts_w_labels |> 
  ggplot(aes(wday, 5 - week)) +
  geom_tile(
    aes(fill = n), 
    col = labels_color
  ) +
  facet_wrap(vars(month), ncol = 3)

< section id="make-shapes-square-ish" class="level2">

Make shapes square-ish

labels_color <- 'grey30'

date_counts_w_labels |> 
  ggplot(aes(wday, 5 - week)) +
  geom_tile(
    aes(fill = n), 
    col = labels_color
  ) +
  facet_wrap(vars(month), ncol = 3) +
  coord_equal(expand = FALSE)

< section id="make-nicer-color" class="level2">

Make nicer color

labels_color <- 'grey30'
schedueled_color <- '#009E73'

date_counts_w_labels |> 
  ggplot(aes(wday, 5 - week)) +
  geom_tile(
    aes(fill = n), 
    col = labels_color
  ) +
  facet_wrap(vars(month), ncol = 3) +
  coord_equal(expand = FALSE) +
  scale_fill_gradient(
    high = schedueled_color, 
    low = colorspace::lighten(schedueled_color, 0.9),
  )

< section id="remove-grid-lines" class="level2">

Remove grid lines

labels_color <- 'grey30'
schedueled_color <- '#009E73'

date_counts_w_labels |> 
  ggplot(aes(wday, 5 - week)) +
  geom_tile(
    aes(fill = n), 
    col = labels_color
  ) +
  facet_wrap(vars(month), ncol = 3) +
  coord_equal(expand = FALSE) +
  scale_fill_gradient(
    high = schedueled_color, 
    low = colorspace::lighten(schedueled_color, 0.9),
  ) +
  theme_void()

< section id="add-titles-caption-and-subtitle" class="level2">

Add titles, caption, and subtitle

labels_color <- 'grey30'
schedueled_color <- '#009E73'

date_counts_w_labels |> 
  ggplot(aes(wday, 5 - week)) +
  geom_tile(
    aes(fill = n), 
    col = labels_color
  ) +
  facet_wrap(vars(month), ncol = 3) +
  coord_equal(expand = FALSE) +
  scale_fill_gradient(
    high = schedueled_color, 
    low = colorspace::lighten(schedueled_color, 0.9),
  ) +
  theme_void() +
  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: Dr. Albert Rapp'
  )

< section id="move-legend-to-top" class="level2">

Move legend to top

labels_color <- 'grey30'
schedueled_color <- '#009E73'

date_counts_w_labels |> 
  ggplot(aes(wday, 5 - week)) +
  geom_tile(
    aes(fill = n), 
    col = labels_color
  ) +
  facet_wrap(vars(month), ncol = 3) +
  coord_equal(expand = FALSE) +
  scale_fill_gradient(
    high = schedueled_color, 
    low = colorspace::lighten(schedueled_color, 0.9),
  ) +
  theme_void() +
  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: Dr. Albert Rapp'
  ) +
  theme(
    legend.position = 'top'
  )

< section id="style-legend" class="level2">

Style legend

labels_color <- 'grey30'
schedueled_color <- '#009E73'
bar_width_cm <- 15
bar_height_cm <- 0.3

date_counts_w_labels |> 
  ggplot(aes(wday, 5 - week)) +
  geom_tile(
    aes(fill = n), 
    col = labels_color
  ) +
  facet_wrap(vars(month), ncol = 3) +
  coord_equal(expand = FALSE) +
  scale_fill_gradient(
    high = schedueled_color, 
    low = colorspace::lighten(schedueled_color, 0.9),
  ) +
  theme_void() +
  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: Dr. Albert Rapp'
  ) +
  theme(
    legend.position = 'top'
  ) +
  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
    )
  )

< section id="style-texts-spacing" class="level2">

Style texts & spacing

labels_color <- 'grey30'
schedueled_color <- '#009E73'
bar_width_cm <- 15
bar_height_cm <- 0.3
_family <- 'Fira Sans'
bar_labels_size <- 11
month_size <- 12

date_counts_w_labels |> 
  ggplot(aes(wday, 5 - week)) +
  geom_tile(
    aes(fill = n), 
    col = labels_color
  ) +
  facet_wrap(vars(month), ncol = 3) +
  coord_equal(expand = FALSE) +
  scale_fill_gradient(
    high = schedueled_color, 
    low = colorspace::lighten(schedueled_color, 0.9),
  ) +
  theme_void() +
  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: Dr. Albert Rapp'
  ) +
  theme(
    legend.position = 'top',
    text = element_text(
      color = labels_color, 
      family = _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')
    ),
    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
    )
  )

< section id="add-text-labels-into-the-boxes" class="level2">

Add text labels into the boxes

labels_color <- 'grey30'
schedueled_color <- '#009E73'
bar_width_cm <- 15
bar_height_cm <- 0.3
_family <- 'Fira Sans'
bar_labels_size <- 11
month_size <- 12
nudge_labels <- 0.25
labels_size <- 3

date_counts_w_labels |> 
  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 = _family
  ) +
  facet_wrap(vars(month), ncol = 3) +
  coord_equal(expand = FALSE) +
  scale_fill_gradient(
    high = schedueled_color, 
    low = colorspace::lighten(schedueled_color, 0.9),
  ) +
  theme_void() +
  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: Dr. Albert Rapp'
  ) +
  theme(
    legend.position = 'top',
    text = element_text(
      color = labels_color, 
      family = _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')
    ),
    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
    )
  )

< section id="add-weekday-labels-back-in" class="level2">

Add Weekday labels back in

labels_color <- 'grey30'
schedueled_color <- '#009E73'
bar_width_cm <- 15
bar_height_cm <- 0.3
_family <- 'Fira Sans'
bar_labels_size <- 11
month_size <- 12
nudge_labels <- 0.25
labels_size <- 3

date_counts_w_labels |> 
  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 = _family
  ) +
  facet_wrap(vars(month), ncol = 3) +
  coord_equal(expand = FALSE) +
  scale_fill_gradient(
    high = schedueled_color, 
    low = colorspace::lighten(schedueled_color, 0.9),
  ) +
  theme_void() +
  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: Dr. Albert Rapp'
  ) +
  theme(
    legend.position = 'top',
    text = element_text(
      color = labels_color, 
      family = _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')
    ),
    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')
    ),
    axis.text.x = element_text(
      margin = margin(t = -0.6, b = 0.3, 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
    )
  )

To leave a comment for the author, please follow the link and comment on their blog: Albert Rapp.

R-bloggers.com offers daily e-mail updates about R news and tutorials about learning R and many other topics. Click here if you're looking to post or find an R/data-science job.