Traffic Through Time: Weekday Routines, Weekend Variations

Exploring traffic dynamics on the A64 road, this analysis reveals stark contrasts between weekday rush hour plateaus and weekend midday peaks, highlighting how traffic volume shifts with daily routines and leisure patterns.

About the Data

The dataset for this week explores National Highways Traffic Flow, focusing on vehicle speed and size information collected in May 2021. This data originates from the National Highways API, which monitors traffic on motorways and major A roads across England. The dataset specifically covers four road sensors along the A64 road, recording variables such as vehicle size categories, speed ranges, and average speeds. Key questions include whether vehicle speeds vary by day or time, the time of day large vehicles are most active, and whether smaller vehicles tend to travel faster. Curated by Nicola Rennie, this dataset provides an opportunity to practice data tidying and visualization. For data access, you can use the tidytuesdayR package or directly read the data from GitHub.

Summary of Findings:

The traffic volume patterns on the A64 road exhibit distinct differences between weekdays and weekends. On weekdays, traffic peaks between 8–9 AM, coinciding with morning rush hours, and then plateaus at a steady level until the evening (around 7 PM) before declining. In contrast, weekends show a different pattern, with traffic gradually rising to a peak during midday (around noon) and then declining, without the characteristic morning and evening rush hour peaks. Additionally, the overall traffic volume is notably lower on weekends compared to weekdays. This consistent pattern is observed across all four sensor locations, indicating a uniform trend in traffic behavior along the A64 road.

Figure 1: This graphic depicts the daily traffic volume patterns on the A64 road across four sensor sites over the course of a week in May 2021. The x-axis represents the time of day, marking the endpoint of each 15-minute interval, while the y-axis indicates the number of vehicles recorded during each interval. The four columns correspond to the four sensor sites, and the seven rows represent the days of the week, starting from Sunday to Saturday. Within each facet, individual line graphs illustrate the traffic volume trends for each date, with an overlaid smoother showing the overall trend throughout the day. This visualization highlights temporal traffic patterns and variations across different days and sensor locations.

How I made this graphic?

Loading required libraries, data import & creating custom functions.

# Data Import and Wrangling Tools
library(tidyverse)            # All things tidy

# Final plot tools
library(scales)               # Nice Scales for ggplot2
library(fontawesome)          # Icons display in ggplot2
library(ggtext)               # Markdown text support for ggplot2
library(showtext)             # Display fonts in ggplot2
library(colorspace)           # Lighten and Darken colours
library(patchwork)            # Compiling Plots

a64_traffic <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/main/data/2024/2024-12-03/A64_traffic.csv')

Visualization Parameters

# Font for titles
font_add_google("Offside",
  family = "title_font"
) 

# Font for the caption
font_add_google("Saira Extra Condensed",
  family = "caption_font"
) 

# Font for plot text
font_add_google("Rajdhani",
  family = "body_font"
) 

showtext_auto()

mypal <- c("#418FDEFF", "#003DA5FF", "#D50032FF")

# A base Colour
bg_col <- "#FFFFFF"
seecolor::print_color(bg_col)

# Colour for highlighted text
text_hil <- mypal[2]
seecolor::print_color(text_hil)

# Colour for the text
text_col <- darken(mypal[2], 0.4)
seecolor::print_color(text_col)


# Define Base Text Size
bts <- 90 

# Caption stuff for the plot
sysfonts::font_add(
  family = "Font Awesome 6 Brands",
  regular = here::here("docs", "Font Awesome 6 Brands-Regular-400.otf")
)
github <- "&#xf09b"
github_username <- "aditya-dahiya"
xtwitter <- "&#xe61b"
xtwitter_username <- "@adityadahiyaias"
social_caption_1 <- glue::glue("<span style='font-family:\"Font Awesome 6 Brands\";'>{github};</span> <span style='color: {text_hil}'>{github_username}  </span>")
social_caption_2 <- glue::glue("<span style='font-family:\"Font Awesome 6 Brands\";'>{xtwitter};</span> <span style='color: {text_hil}'>{xtwitter_username}</span>")

# Add text to plot--------------------------------------------------------------
plot_title <- "Traffic Flow on the A64:\nWeekdays' Hustle, Weekends' Ease"

plot_subtitle <- " Traffic patterns on the A64 road vary significantly between weekdays and weekends, with weekday traffic peaking during morning rush hours and plateauing through the day, while weekend traffic peaks around midday and shows lower overall volumes. This trend is consistent across all four sensor locations."

plot_caption <- paste0(
  "**Data:** National Highways API, Nicola Rennie", 
  " |  **Code:** ", 
  social_caption_1, 
  " |  **Graphics:** ", 
  social_caption_2
  )

rm(github, github_username, xtwitter, 
   xtwitter_username, social_caption_1, 
   social_caption_2)

Exploratory Data Analysis and Wrangling

# a64_traffic |> 
#   summarytools::dfSummary() |> 
#   summarytools::view()

temp_names <- a64_traffic$Name |> unique()

rawdf <- a64_traffic |> 
  janitor::clean_names() |> 
  mutate(
    report_day = wday(report_date, label = T, abbr = F),
    weekend = if_else(
      report_day %in% c("Saturday", "Sunday"),
      "Weekend",
      "Weekdays"
    )
  ) |> 
  mutate(
    name = case_when(
      name == temp_names[1] ~ "Norton-on-Derwent (east)",
      name == temp_names[2] ~ "Between B1249 and A1039",
      name == temp_names[3] ~ "Near York (north)",
      name == temp_names[4] ~ "Between B1261 and Filey",
    )
  ) |> 
  select(total_volume, time_period_ending, report_date,
         weekend, report_day, name) |> 
  mutate(name = str_wrap(name, 20))

The Base Plot

g <- rawdf |> 
  ggplot(
    mapping = aes(
      x = time_period_ending
    )
  ) +
  geom_line(
    mapping = aes(
      y = total_volume, 
      group = report_date
    ),
    alpha = 0.5,
    linewidth = 0.2
  ) +
  geom_smooth(
    mapping = aes(
      y = total_volume, 
      colour = weekend
    ),
    span = 0.2,
    se = FALSE,
    linewidth = 1,
    alpha = 0.5
  ) +
  paletteer::scale_color_paletteer_d("nbapalettes::sixers_retro") +
  scale_x_time(
    breaks = c(
      hms("08:00:00"),
      hms("14:00:00"),
      hms("20:00:00")
    ),
    labels = label_time(format = "%I %p")
  ) +
  coord_cartesian(
    clip = "off"
  ) +
  labs(
    title = plot_title,
    subtitle = str_wrap(plot_subtitle, 120),
    caption = plot_caption,
    y = "Number of vehicles in each 15 min. interval",
    x = "Time of the day"
  ) +
  facet_grid(
    report_day ~ name
  ) +
  theme_minimal(
    base_family = "body_font",
    base_size = bts
  ) +
  theme(
    # Overall
    text = element_text(
      colour = text_col,
      lineheight = 0.3,
      hjust = 0.5
    ),
    legend.position = "none",
    plot.title.position = "plot",
    
    # Facet
    strip.text.x = element_text(
      family = "caption_font",
      colour = text_col,
      margin = margin(0,0,0,0, "mm")
    ),
    strip.text.y = element_text(
      family = "caption_font",
      colour = text_col,
      size = 1 * bts,
      margin = margin(0,0,0,5, "mm")
    ),
    
    # Axes
    axis.text = element_text(
      colour = text_col,
      margin = margin(0,0,0,0, "mm"),
      size = 0.5 * bts
    ),
    axis.title = element_text(
      margin = margin(0,0,0,0, "mm"),
      colour = text_col
    ),
    axis.ticks = element_blank(),
    axis.ticks.length = unit(0, "mm"),
    
    # Panels
    panel.grid = element_line(
      colour = "grey80",
      linewidth = 0.2
    ),
    panel.grid.minor = element_blank(),
    panel.spacing.x = unit(5, "mm"),
    panel.spacing.y = unit(2, "mm"),
    panel.background = element_rect(
      fill = "transparent",
      colour = "transparent"
    ),
    
    # Labels
    plot.title = element_text(
      size = 2 * bts,
      colour = text_hil,
      face = "bold",
      hjust = 0.5,
      family = "title_font",
      margin = margin(0,0,5,0, "mm")
    ),
    plot.subtitle = element_text(
      size = bts,
      hjust = 0.5,
      family = "caption_font",
      margin = margin(0,0,5,0, "mm")
    ),
    plot.caption = element_textbox(
      hjust = 0.5,
      colour = text_hil,
      family = "caption_font",
      margin = margin(3,0,-10,0, "mm")
    )
  )

ggsave(
  filename = here::here(
    "data_vizs",
    "tidy_nh_uk_traffic.png"
  ),
  plot = g,
  width = 400,
  height = 500,
  units = "mm",
  bg = bg_col
)

Savings the thumbnail for the webpage

# Saving a thumbnail

library(magick)
# Saving a thumbnail for the webpage
image_read(here::here("data_vizs", 
                      "tidy_nh_uk_traffic.png")) |> 
  image_resize(geometry = "x400") |> 
  image_write(
    here::here(
      "data_vizs", 
      "thumbnails", 
      "tidy_nh_uk_traffic.png"
    )
  )

Session Info

# Data Import and Wrangling Tools
library(tidyverse)            # All things tidy

# Final plot tools
library(scales)               # Nice Scales for ggplot2
library(fontawesome)          # Icons display in ggplot2
library(ggtext)               # Markdown text support for ggplot2
library(showtext)             # Display fonts in ggplot2
library(colorspace)           # Lighten and Darken colours
library(patchwork)            # Compiling Plots


sessioninfo::session_info()$packages |> 
  as_tibble() |> 
  select(package, 
         version = loadedversion, 
         date, source) |> 
  arrange(package) |> 
  janitor::clean_names(
    case = "title"
  ) |> 
  gt::gt() |> 
  gt::opt_interactive(
    use_search = TRUE
  ) |> 
  gtExtras::gt_theme_espn()

Table 1: R Packages and their versions used in the creation of this page and graphics