Site icon R-bloggers

Calendar Plots With ggplot2

[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.
    Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.
  • Exit mobile version