---
title: "The Holiday-Volatility Paradox"
subtitle: "In small markets, more holidays correlate with higher traffic volatility (r = +0.48). In larger markets, the relationship flips — more holidays predict lower volatility. Remake of TidyTuesday 2024 · Week 52*"
description: "In small markets, more holidays correlate with higher traffic volatility (r = +0.48). In larger markets, the relationship flips — more holidays predict lower volatility. A faceted scatter plot with a sign-flip summary panel, built with ggplot2 in R as part of the #30DayChartChallenge 2026 — Day 17: Remake."
date: "2026-04-17"
author:
- name: "Steven Ponce"
url: "https://stevenponce.netlify.app"
citation:
url: "https://stevenponce.netlify.app/data_visualizations/30DayChartChallenge/2026/30dcc_2026_17.html"
categories: ["30DayChartChallenge", "2026"]
tags: [
"30DayChartChallenge",
"Relationships",
"Remake",
"Scatter Plot",
"Small Multiples",
"Patchwork",
"Correlation",
"Air Traffic",
"Holiday Patterns",
"Market Size",
"ggplot2",
"ggrepel",
"TidyTuesday"
]
image: "thumbnails/30dcc_2026_17.png"
format:
html:
toc: true
toc-depth: 5
code-link: true
code-fold: true
code-tools: true
code-summary: "Show code"
editor_options:
chunk_output_type: inline
execute:
freeze: true
cache: true
error: false
message: false
warning: false
eval: true
---
{#fig-1}
### [**Steps to Create this Graphic**]{.mark}
#### [1. Load Packages & Setup]{.smallcaps}
```{r}
#| label: load
#| warning: false
#| message: false
#| results: "hide"
## 1. LOAD PACKAGES & SETUP ----
suppressPackageStartupMessages({
pacman::p_load(
tidyverse, ggtext, showtext, patchwork,
janitor, scales, glue, ggrepel
)
})
### |- figure size ----
camcorder::gg_record(
dir = here::here("temp_plots"),
device = "png",
width = 12,
height = 10,
units = "in",
dpi = 320
)
# Source utility functions
suppressMessages(source(here::here("R/utils/fonts.R")))
source(here::here("R/utils/social_icons.R"))
source(here::here("R/utils/image_utils.R"))
source(here::here("R/themes/base_theme.R"))
```
#### [2. Read in the Data]{.smallcaps}
```{r}
#| label: read
#| include: true
#| eval: true
#| warning: false
tt <- tidytuesdayR::tt_load(2024, week = 52)
global_holidays_raw <- tt$global_holidays |> clean_names()
monthly_passengers_raw <- tt$monthly_passengers |> clean_names()
rm(tt)
```
#### [3. Examine the Data]{.smallcaps}
```{r}
#| label: examine
#| include: true
#| eval: true
#| results: 'hide'
#| warning: false
glimpse(global_holidays_raw)
glimpse(monthly_passengers_raw)
```
#### [4. Tidy Data]{.smallcaps}
```{r}
#| label: tidy
#| warning: false
monthly_passengers_clean <- monthly_passengers_raw |>
mutate(
date = ymd(paste(year, month, "01", sep = "-")),
total_passengers = coalesce(total, total_os)
)
monthly_holidays_clean <- global_holidays_raw |>
mutate(
year = year(date),
month = month(date)
) |>
group_by(iso3, year, month) |>
summarise(
holiday_count = n(),
public_holidays = sum(type == "Public holiday"),
.groups = "drop"
)
combined_data <- monthly_passengers_clean |>
left_join(monthly_holidays_clean, by = c("iso3", "year", "month"))
# Housekeeping
rm(global_holidays_raw, monthly_passengers_raw, monthly_holidays_clean, monthly_passengers_clean)
gc()
# Volatility summary by country ----
volatility_df <- combined_data |>
group_by(iso3) |>
summarise(
mean_traffic = mean(total_passengers, na.rm = TRUE),
sd_traffic = sd(total_passengers, na.rm = TRUE),
cv = sd_traffic / mean_traffic,
avg_holidays = mean(holiday_count, na.rm = TRUE),
total_observations = n(),
traffic_size = sum(total_passengers, na.rm = TRUE),
.groups = "drop"
) |>
filter(
complete.cases(cv, avg_holidays),
total_observations >= 12,
cv >= 0,
cv <= quantile(cv, 0.95, na.rm = TRUE)
) |>
mutate(
size_category = cut(
traffic_size,
breaks = quantile(traffic_size, probs = seq(0, 1, 0.25), na.rm = TRUE),
labels = c("Small", "Medium", "Large", "Very Large"),
include.lowest = TRUE
)
)
# Per-facet correlation values ----
cor_labels <- volatility_df |>
group_by(size_category) |>
summarise(
r = cor(avg_holidays, cv, use = "complete.obs"),
n_country = n(),
.groups = "drop"
) |>
mutate(
# Direction drives color encoding in strip + summary panel
direction = if_else(r > 0, "positive", "negative"),
label = glue("r = {sprintf('%+.2f', r)}\nn = {n_country}")
)
# Identify notable outliers per facet (top/bottom CV, only if genuinely extreme) ----
outlier_threshold <- 0.15
outliers_df <- volatility_df |>
left_join(
volatility_df |>
group_by(size_category) |>
summarise(med_cv = median(cv), .groups = "drop"),
by = "size_category"
) |>
group_by(size_category) |>
filter(
abs(cv - med_cv) >= outlier_threshold,
cv == max(cv) | cv == min(cv)
) |>
ungroup()
```
#### [5. Visualization Parameters]{.smallcaps}
```{r}
#| label: params
#| include: true
#| warning: false
### |- plot aesthetics ----
colors <- get_theme_colors(
palette = list(
positive = "#C0392B",
negative = "#2980B9",
neutral = "#7F8C8D",
point = "#34495E",
highlight = "#E67E22",
bg = "#F8F9FA"
)
)
### |- titles and caption ----
title_text <- str_glue(
"The Holiday-Volatility Paradox"
)
subtitle_text <- str_glue(
"In small markets, more holidays correlate with **higher** traffic volatility (r = +0.48).<br>
In larger markets, the relationship **flips** — more holidays predict **lower** volatility.<br>
<span style='color:#C0392B;'>● Positive correlation</span>
<span style='color:#2980B9;'>● Negative correlation</span>
*Remake of TidyTuesday 2024 · Week 52*"
)
caption_text <- create_dcc_caption(
dcc_year = 2026,
dcc_day = 17,
source_text = "Global Holidays and Travel · TidyTuesday 2024 Week 52"
)
### |- fonts ----
setup_fonts()
fonts <- get_font_families()
### |- base theme ----
base_theme <- create_base_theme(colors)
weekly_theme <- extend_weekly_theme(
base_theme,
theme(
# strip labels
strip.text = element_text(
family = fonts$text, size = 11, face = "bold",
margin = margin(b = 6)
),
# axes
axis.title = element_text(family = fonts$text, size = 9, color = "gray50"),
axis.text = element_text(family = fonts$text, size = 8, color = "gray40"),
axis.ticks = element_blank(),
# grid — horizontal only, very faint
panel.grid.major.y = element_line(color = "gray90", linewidth = 0.3),
panel.grid.major.x = element_blank(),
panel.grid.minor = element_blank(),
# panel spacing — more breathing room
panel.spacing.x = unit(2.0, "lines"),
panel.spacing.y = unit(1.8, "lines"),
# plot margins
plot.margin = margin(t = 20, r = 20, b = 10, l = 20)
)
)
theme_set(weekly_theme)
```
#### [6. Plot]{.smallcaps}
```{r}
#| label: plot
#| warning: false
### |- helper: strip color per facet ----
strip_labels <- cor_labels |>
mutate(
strip_color = if_else(direction == "positive",
colors$palette$positive,
colors$palette$negative
),
strip_text = glue("{size_category} Market"),
x_pos = -Inf,
y_pos = Inf
)
### |- main scatter plot (p_main) ----
p_main <- ggplot(volatility_df, aes(x = avg_holidays, y = cv)) +
# Geoms
geom_hline(
yintercept = median(volatility_df$cv),
linetype = "dashed",
color = colors$palette$neutral,
linewidth = 0.4,
alpha = 0.6
) +
geom_point(
color = colors$palette$point,
size = 2.8,
alpha = 0.75,
shape = 16
) +
geom_smooth(
aes(color = size_category),
method = "lm",
formula = y ~ x,
linewidth = 1,
se = TRUE,
alpha = 0.12
) +
geom_text_repel(
data = outliers_df,
aes(label = iso3),
size = 2.8,
color = colors$palette$highlight,
fontface = "bold",
max.overlaps = 3,
box.padding = 0.5,
segment.color = colors$palette$neutral,
segment.alpha = 0.5,
segment.size = 0.3,
seed = 123
) +
geom_text(
data = volatility_df |> filter(size_category == "Small"),
x = Inf, y = median(volatility_df$cv) + 0.025,
label = "industry median",
size = 2.5, color = colors$palette$neutral,
hjust = 1.05, vjust = -0.3, fontface = "italic"
) +
geom_text(
data = cor_labels,
aes(
x = Inf,
y = 0.62,
label = label,
color = direction
),
size = 3,
hjust = 1.1,
vjust = 1,
fontface = "bold",
inherit.aes = FALSE
) +
geom_label(
data = strip_labels,
aes(
x = x_pos,
y = y_pos,
label = strip_text,
fill = direction
),
hjust = -0.05,
vjust = 1.3,
size = 3.2,
fontface = "bold",
color = "white",
label.size = 0,
label.padding = unit(0.25, "lines"),
inherit.aes = FALSE
) +
# Scales
scale_color_manual(
values = c(
"Small" = colors$palette$positive,
"Medium" = colors$palette$negative,
"Large" = colors$palette$negative,
"Very Large" = colors$palette$negative
)
) +
scale_color_manual(
values = c(
"positive" = colors$palette$positive,
"negative" = colors$palette$negative,
"Small" = colors$palette$positive,
"Medium" = colors$palette$negative,
"Large" = colors$palette$negative,
"Very Large" = colors$palette$negative
)
) +
scale_fill_manual(
values = c(
"positive" = colors$palette$positive,
"negative" = colors$palette$negative
)
) +
scale_y_continuous(
breaks = seq(0, 0.75, by = 0.25),
limits = c(0, 0.75), # CV cannot be negative — floor at 0
labels = percent_format(accuracy = 1)
) +
scale_x_continuous(
breaks = seq(2, 8, by = 2),
expand = expansion(mult = c(0.05, 0.1))
) +
# Facet ---
facet_wrap(
~size_category,
nrow = 2,
scales = "free_x"
) +
# Labs
labs(
x = "Average Number of Holidays per Month",
y = "Coefficient of Variation in Traffic"
) +
# Theme
theme(
plot.title = element_text(
size = rel(2),
family = fonts$title,
face = "bold",
color = colors$title,
lineheight = 1.1,
margin = margin(t = 5, b = 5)
),
plot.subtitle = element_markdown(
size = rel(0.95),
family = fonts$text,
color = colors$subtitle,
lineheight = 1.4,
margin = margin(t = 5, b = 15)
),
strip.text = element_blank()
)
### |- summary panel: r values across market sizes (p_summary) ----
# Standalone panel
p_summary <- cor_labels |>
mutate(
size_category = factor(size_category, levels = c("Small", "Medium", "Large", "Very Large")),
x_num = as.numeric(size_category),
vjust_val = if_else(r > 0, -1.2, 2.0)
) |>
ggplot(aes(x = x_num, y = r, color = direction)) +
# Annotate
annotate(
"rect",
xmin = 0.5, xmax = 4.5,
ymin = 0, ymax = 0.55,
fill = colors$palette$positive,
alpha = 0.04
) +
# Geoms
geom_hline(
yintercept = 0,
linetype = "dashed",
color = colors$palette$neutral,
linewidth = 0.5
) +
geom_line(color = "#BBBBBB", linewidth = 0.8) +
geom_point(size = 6) +
geom_text(
aes(label = sprintf("%+.2f", r), vjust = vjust_val),
size = 3.2,
fontface = "bold"
) +
annotate(
"text",
x = 2.5, y = 0.62,
label = "← positive negative →",
size = 2.6,
color = colors$palette$neutral,
family = 'sans',
fontface = "italic",
hjust = 0.5
) +
# Scales
scale_color_manual(
values = c(
"positive" = colors$palette$positive,
"negative" = colors$palette$negative
),
guide = "none"
) +
scale_x_continuous(
breaks = 1:4,
labels = c("Small", "Medium", "Large", "Very\nLarge"),
expand = expansion(add = 0.5)
) +
scale_y_continuous(
limits = c(-0.45, 0.70),
breaks = seq(-0.4, 0.6, by = 0.2),
labels = function(x) sprintf("%+.1f", x)
) +
# Labs
labs(
x = "Market Size",
y = "Correlation (r)",
title = "The Sign Flip"
) +
# Theme
theme(
plot.margin = margin(t = 10, r = 18, b = 10, l = 18),
plot.title = element_text(
size = rel(1.1),
family = fonts$text,
face = "bold",
color = colors$title,
margin = margin(b = 10)
),
axis.text.x = element_text(
size = rel(0.78), color = "#555555",
margin = margin(t = 6)
),
axis.text.y = element_text(size = rel(0.78), color = "#555555"),
axis.title.x = element_text(
size = rel(0.85), color = "#444444",
margin = margin(t = 8)
),
axis.title.y = element_text(
size = rel(0.85), color = "#444444",
margin = margin(r = 8)
),
panel.grid.major.x = element_blank(),
panel.grid.major.y = element_line(color = "gray88", linewidth = 0.2),
panel.grid.minor = element_blank(),
axis.ticks = element_blank()
)
# Combined plots
p_right <- p_summary / plot_spacer() +
plot_layout(heights = c(1, 0.20))
# Left = evidence (2x2 scatter), Right = conclusion
p_final <-
(p_main | p_right) +
plot_layout(widths = c(2.4, 1.1)) +
plot_annotation(
title = title_text,
subtitle = subtitle_text,
caption = caption_text,
theme = theme(
plot.title = element_text(
size = rel(2),
family = fonts$title,
face = "bold",
color = colors$title,
lineheight = 1.1,
margin = margin(t = 5, b = 5)
),
plot.subtitle = element_markdown(
size = rel(0.95),
family = 'sans',
color = colors$subtitle,
lineheight = 1.4,
margin = margin(t = 5, b = 15)
),
plot.caption = element_markdown(
family = fonts$caption,
size = rel(0.65),
color = colors$caption,
linewidth = 1.3,
hjust = 0,
margin = margin(t = 15)
),
plot.margin = margin(15, 15, 10, 15)
)
)
```
#### [7. Save]{.smallcaps}
```{r}
#| label: save
#| warning: false
### |- plot image ----
save_plot_patchwork(
p_final,
type = "30daychartchallenge",
year = 2026,
day = 17,
width = 12,
height = 10
)
```
#### [8. Session Info]{.smallcaps}
::: {.callout-tip collapse="true"}
##### Expand for Session Info
```{r, echo = FALSE}
#| eval: true
#| warning: false
sessionInfo()
```
:::
#### [9. GitHub Repository]{.smallcaps}
::: {.callout-tip collapse="true"}
##### Expand for GitHub Repo
The complete code for this analysis is available in [`30dcc_2026_17.qmd`](https://github.com/poncest/personal-website/blob/master/data_visualizations/TidyTuesday/2026/30dcc_2026_17.qmd).
For the full repository, [click here](https://github.com/poncest/personal-website/).
:::
#### [10. References]{.smallcaps}
::: {.callout-tip collapse="true"}
##### Expand for References
1. **Data Sources:**
- TidyTuesday. (2024). *Global Holidays and Travel — Week 52* [Dataset].
https://github.com/rfordatascience/tidytuesday/tree/main/data/2024/2024-12-24
- WorldPop Hub. *Monthly passenger traffic data* [Dataset].
https://www.worldpop.org/
- Original submission: Ponce, S. (2024). *TidyTuesday 2024 Week 52*.
https://github.com/poncest/tidytuesday/tree/main/2024/Week_52
2. **Remake Methodology:**
- Switched from LOESS to linear smooth (`method = "lm"`) for analytical honesty with sparse panel data
- Removed size-encoded points to focus on a single visual story: correlation sign change across market size
- Restructured layout from single faceted plot to patchwork composition (evidence left, synthesis right) to eliminate coordinate system bleed
:::
#### [11. Custom Functions Documentation]{.smallcaps}
::: {.callout-note collapse="true"}
##### 📦 Custom Helper Functions
This analysis uses custom functions from my personal module library for efficiency and consistency across projects.
**Functions Used:**
- **`fonts.R`**: `setup_fonts()`, `get_font_families()` - Font management with showtext
- **`social_icons.R`**: `create_social_caption()` - Generates formatted social media captions
- **`image_utils.R`**: `save_plot()` - Consistent plot saving with naming conventions
- **`base_theme.R`**: `create_base_theme()`, `extend_weekly_theme()`, `get_theme_colors()` - Custom ggplot2 themes
**Why custom functions?**\
These utilities standardize theming, fonts, and output across all my data visualizations. The core analysis (data tidying and visualization logic) uses only standard tidyverse packages.
**Source Code:**\
View all custom functions → [GitHub: R/utils](https://github.com/poncest/personal-website/tree/master/R)
:::