# Load required packages and specify a theme
# ----------------------------------------------------------------------------->
library(tidyverse);library(lubridate);library(ggpubr);library(showtext)
arrow <- arrow(type = "closed", length = unit(1, "mm"))
font <- "Asap"
my_gg_theme <- function() {
theme(
# Control legend appearance
legend.position = c(0.15, 0.85),
legend.key = element_rect(color = "#F9F9F9", size = 0.1),
legend.key.size = unit(3, "mm"),
legend.background = element_blank(),
legend.title = element_blank(),
legend.text = element_text(family = font, size = 6, color = "#F9F9F9"),
# Title and subtitle
plot.title = element_text(family = font, size = 21, color = "#F9F9F9", face = "bold", lineheight = 0.3),
plot.subtitle = element_text(family = font, size = 8, color = "#F9F9F9"),
plot.caption = element_text(family = font, size = 6, color = "#CCCCCC"),
# Control text appearance and spacing
axis.title.x = element_blank(),
axis.title.y = element_blank(),
axis.text.y = element_text(size = 5, color = "#F9F9F9", family = font, hjust = 0),
axis.text.x = element_text(size = 6, color = "#F9F9F9", family = font, hjust = 0.5),
# Grid, ticks and plot lines
axis.line = element_blank(),
axis.ticks.x = element_blank(),
panel.grid.major.x = element_blank(),
panel.grid.minor.x = element_blank(),
axis.ticks.y = element_blank(),
panel.grid.major.y = element_blank(),
panel.grid.minor.y = element_blank(),
panel.background = element_rect(fill = "#444444", color = NA),
plot.background = element_rect(fill = "#444444", color = NA),
plot.margin = unit(c(0,0,0,0), "mm")
)
}
# Load the data
# ----------------------------------------------------------------------------->
# The data was downloaded from seklima.met.no/observations [23.01.2025]
snow_oslo <-
read_delim("snow/oslo_snow.txt") %>%
mutate(date = dmy(date))
# Wrangle the data
# ----------------------------------------------------------------------------->
# Some dates are missing, usually outside of the winter season. We can fill in these missing dates
date_range <- seq(min(snow_oslo$date, na.rm=TRUE), max(snow_oslo$date, na.rm=TRUE), by = "1 day")
# Join with original data to fill in missing dates
snow_oslo_wrangled <-
tibble(date = date_range) %>%
left_join(snow_oslo, by = "date") %>%
mutate(
year = year(date),
day = yday(date)
) %>%
# For simplicity we create "synthetic" week numbers going from 1 to 52 for each year, and cap each year to contain 364 days
filter(day <= 364) %>%
select(date, year, day, snow_depth) %>%
mutate(week = ceiling(day / 7)) %>%
select(-day) %>%
# Now we calculate average for each week (by year)
group_by(year, week) %>%
mutate(avg_snow_depth = mean(snow_depth, na.rm = TRUE)) %>%
# Slice to get one value per week
slice(which.min(date)) %>%
ungroup() %>%
# For missing values impute to 0 (missing values are anyways outside of the winter season)
mutate(avg_snow_depth = ifelse(is.na(avg_snow_depth), 0, avg_snow_depth)) %>%
# We now wish to organize the data so that each row in the tile plot contains two years, from week 27 one year to week 26 the next year
# We add data for weeks 27 to 52 for 1959 (missing)
bind_rows(tibble(year = c(rep(1959, 26)), week = c(27:52), avg_snow_depth = NA)) %>%
arrange(year) %>%
mutate(
# Adjust year to reflect week 27 ("year 1") to week 26 ("year 2")
years = ifelse(week >= 27,
paste(year, year + 1, sep = "-"), # For weeks >= 27, the period is from year to next year
paste(year - 1, year, sep = "-")), # For weeks < 27, the period is from previous year to current year
# We call it the Julian week, after the Julian calendar
julian_week = ifelse(week >= 27, week - 26, week + 26)
) %>%
select(-c(year, week)) %>%
arrange(years, julian_week) %>%
# Indicate snow depth categories
mutate(snow_depth_cat =
case_when(
avg_snow_depth == 0 ~ "no snow",
avg_snow_depth > 0 & avg_snow_depth <= 5 ~ "1-5 cm",
avg_snow_depth > 5 & avg_snow_depth <= 10 ~ "6-10 cm",
avg_snow_depth > 10 & avg_snow_depth <= 15 ~ "11-15 cm",
avg_snow_depth > 15 & avg_snow_depth <= 20 ~ "16-20 cm",
avg_snow_depth > 20 & avg_snow_depth <= 25 ~ "21-25 cm",
avg_snow_depth > 25 & avg_snow_depth <= 30 ~ "26-30 cm",
avg_snow_depth > 30 & avg_snow_depth <= 40 ~ "31-40 cm",
avg_snow_depth > 40 ~ ">40 cm"
)
) %>%
mutate(snow_depth_cat = factor(snow_depth_cat,
levels = c("no snow", "1-5 cm", "6-10 cm", "11-15 cm", "16-20 cm", "21-25 cm", "26-30 cm", "31-40 cm", ">40 cm")))
# Plotting
# ----------------------------------------------------------------------------->
# Make a custom x-axis labeler (approximate!)
# We see that the first week runs from january first until january 7th, whereby week 2 starts. With 52 weeks, we have approximately 52/12 = 4.33 weeks per month
wpm <- 52/12
x_labels <- c("Aug", "Sep", "Oct", "Nov", "Dec", "Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul")
x_breaks <- c(wpm, wpm*2, wpm*3, wpm*4, wpm*5, wpm*6, wpm*7, wpm*8, wpm*9, wpm*10, wpm*11, wpm*12)
# Generating the lower left (LL) panel (tile plot)
# ----------------------------------------------->
p_LL <-
snow_oslo_wrangled %>%
mutate(start = case_when(years == "1959-1960" & julian_week == 28 ~ "First date with measurements >")) %>%
mutate(stop = case_when(years == "2024-2025" & julian_week == 30 ~ "< Date of data download")) %>%
ggplot(aes(x = julian_week, y = years, fill = snow_depth_cat)) +
geom_tile(color = "#444444", size = 0.1) +
scale_fill_manual(values = c("#444444", "#4ca6ff", "#66bfff", "#80d4ff", "#99e6ff", "#b2f2ff", "#ccfbff", "#e6ffff", "#FFFFFF"), na.value = "#444444", na.translate = F) +
my_gg_theme() +
coord_cartesian(clip = "off") +
scale_x_continuous(breaks = x_breaks, labels = x_labels, expand = c(0, 0)) +
geom_text(aes(label = start), hjust = 1, color = "#F9F9F9", family = font, size = 1.7, vjust = 0.5) +
geom_text(aes(label = stop), hjust = 0, color = "#F9F9F9", family = font, size = 1.7, position = position_nudge(x = 1), vjust = 0.3) +
guides(fill = guide_legend(override.aes = list(size = 4, linewidth = 0)))
# Generating the top left (TL) panel (visualizes which parts of the year have the most snow)
# ----------------------------------------------->
p_TL <-
snow_oslo_wrangled %>%
group_by(julian_week) %>%
summarise(avg_week = mean(avg_snow_depth, na.rm = TRUE)) %>%
mutate(snow_depth_cat = case_when(
avg_week == 0 ~ "no snow",
avg_week > 0 & avg_week <= 5 ~ "1-5 cm",
avg_week > 5 & avg_week <= 10 ~ "6-10 cm",
avg_week > 10 & avg_week <= 15 ~ "11-15 cm",
avg_week > 15 & avg_week <= 20 ~ "16-20 cm",
avg_week > 20 & avg_week <= 25 ~ "21-25 cm",
avg_week > 25 & avg_week <= 30 ~ "26-30 cm",
avg_week > 30 & avg_week <= 40 ~ "31-40 cm",
avg_week > 40 ~ ">40 cm"
)) %>%
mutate(snow_depth_cat = factor(snow_depth_cat, levels = c("no snow", "1-5 cm", "6-10 cm", "11-15 cm", "16-20 cm", "21-25 cm", "26-30 cm", "31-40 cm", ">40 cm"))) %>%
ggplot(aes(x = julian_week, y = avg_week, fill = snow_depth_cat)) +
geom_col(width = 0.75) +
my_gg_theme() +
theme(axis.text.y = element_blank(), axis.text.x = element_blank(), axis.title.x = element_blank(), legend.position = "none") +
scale_fill_manual(values = c("#4ca6ff", "#66bfff", "#80d4ff", "#99e6ff", "#b2f2ff", "#ccfbff", "#e6ffff", "#FFFFFF")) +
labs(
title = "Snow Depth in Oslo",
subtitle = "Blindern, 1960 to Jan 2025"
) +
annotate(geom = "text", label = "Weekly mean snow depth", family = font, size = 1.8, x = 25, y = 22, color = "#e6ffff", hjust = 1) +
geom_curve(aes(x = 25.4, xend = 28.2, y = 21.8, yend = 14.5), color = "#e6ffff", curvature = -0.2, arrow = arrow, size = 0.1)
# Now the lower right (LR) panel, showing max snow depth per winter season (bar plot)
# ----------------------------------------------->
p_LR <-
tibble(date = date_range) %>%
left_join(snow_oslo, by = "date") %>%
mutate(
year = year(date),
day = yday(date)
) %>%
# For simplicity we create "synthetic" week numbers going from 1 to 52 for each year, and cap each year to contain 364 days
filter(day <= 364) %>%
select(date, year, day, snow_depth) %>%
mutate(week = ceiling(day / 7)) %>%
select(-day) %>%
# Create year-spans like before so we capture the snow during the full winters
mutate(
# Adjust year to reflect week 27 ("year 1") to week 26 ("year 2")
years = ifelse(week >= 27,
paste(year, year + 1, sep = "-"), # For weeks >= 27, the period is from year to next year
paste(year - 1, year, sep = "-")
) # For weeks < 27, the period is from previous year to current year
) %>%
# Calculate sum of snow
group_by(years) %>%
summarise(max_snow = max(snow_depth, na.rm = TRUE)) %>%
ungroup() %>%
ggplot(aes(x = max_snow, y = years)) +
geom_col(fill = "#F9F9F9", width = 0.55) +
my_gg_theme() +
theme(axis.title.x = element_text(size = 5, color = "#F9F9F9", family = font, hjust = 0)) +
labs(x = "Max snow depth, mm")
# And finally an plot spacer for top right (TR)
# ----------------------------------------------->
library(png)
library(grid)
snowflake <- png::readPNG("snow/snowflake.png")
p_TR <-
ggplot() +
annotation_custom(rasterGrob(snowflake), xmin = -Inf, xmax = Inf, ymin = -Inf, ymax = Inf) +
my_gg_theme()
library(patchwork)
comp <-
p_TL + p_TR + p_LL + p_LR +
plot_layout(
ncol = 2,
nrow = 2,
heights = c(1, 13),
widths = c(5, 1)
) +
plot_annotation(
caption = "Data sourced from seklima.met.no/observations/ [23.01.2025]"
)
comp +
plot_annotation(
theme = theme(
plot.background = element_rect(fill = "#444444", color = NA),
plot.margin = unit(c(.2, .2, .2, .2), "cm"),
plot.caption = element_text(
family = font,
size = 6,
color = "#CCCCCC"
)
)
)
