The Ocean Has a Memory

Daily temperature profiles reveal persistent seasonal stratification and depth-dependent thermal behavior — surface-to-deep differences reach ~11°C in late summer before the water column mixes flat in winter.

Seven years of daily coastal ocean temperature data from a Nova Scotia monitoring station were examined through two complementary lenses: a depth × day-of-year heatmap revealing the recurring seasonal stratification pattern, and a derived thermocline time series showing where temperature changes most rapidly in the water column. Surface-to-deep differences reach ~11°C in late summer before winter mixing collapses the gradient.

Figure 1: Two-panel visualization titled ‘The Ocean Has a Memory.’ Top panel: a heatmap showing multi-year average daily ocean temperature by depth (2m to 40m) and day of year at a Nova Scotia coastal monitoring station. Cold blue tones dominate winter and deeper depths; warm yellow tones appear at the surface from June through September, with stratification clearly visible as shallower depths warm faster. Bottom panel: a time series from 2018 to 2026 showing thermocline depth — the point of steepest temperature gradient — which shoals to 5–10 metres each summer and deepens or disappears in winter when the water column mixes. Scatter points at low opacity show daily variability; a loess smooth highlights the repeating annual pattern. An annotation notes that the thermocline shoals to approximately 5–10 metres in late summer as surface waters warm.

Steps to Create this Graphic

1. Load Packages & Setup

```{r}
#| label: load
#| warning: false
#| message: false      
#| results: "hide"     

## 1. LOAD PACKAGES & SETUP ----
suppressPackageStartupMessages({
if (!require("pacman")) install.packages("pacman")
pacman::p_load(
    tidyverse, ggtext, showtext, janitor,      
    scales, glue, skimr, patchwork, lubridate    
    )
})

### |- 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

```{r}
#| label: read
#| include: true
#| eval: true
#| warning: false

tt <- tidytuesdayR::tt_load(2026, week = 13)
ocean_temperature <- tt$ocean_temperature |> clean_names()
ocean_temperature_deployments <- tt$ocean_temperature_deployments|> clean_names()
rm(tt)
```

3. Examine the Data

```{r}
#| label: examine
#| include: true
#| eval: true
#| results: 'hide'
#| warning: false

glimpse(ocean_temperature)
glimpse(ocean_temperature_deployments)
```

4. Tidy Data

```{r}
#| label: tidy
#| warning: false

### |-  shared date components ----
ocean_temp_clean <- ocean_temperature |>
    filter(!is.na(mean_temperature_degree_c)) |>
    mutate(
        year = year(date),
        month = month(date),
        doy = yday(date),
        depth = factor(
            sensor_depth_at_low_tide_m,
            levels = c(2, 5, 10, 15, 20, 30, 40)
        )
    )

### |-  Panel 1: Heatmap data ----
heatmap_data <- ocean_temp_clean |>
    summarise(
        mean_temp = mean(mean_temperature_degree_c, na.rm = TRUE),
        .by = c(doy, sensor_depth_at_low_tide_m)
    ) |>
    mutate(
        depth_label = factor(
            paste0(sensor_depth_at_low_tide_m, "m"),
            levels = paste0(c(2, 5, 10, 15, 20, 30, 40), "m")
        )
    )

month_starts <- c(1, 32, 60, 91, 121, 152, 182, 213, 244, 274, 305, 335)
month_labels <- c("Jan", "Feb", "Mar", "Apr", "May", "Jun",
                  "Jul", "Aug", "Sep", "Oct", "Nov", "Dec")

temp_limits <- c(
    floor(min(heatmap_data$mean_temp, na.rm = TRUE)),
    ceiling(max(heatmap_data$mean_temp, na.rm = TRUE))
)

# Punchline metric
peak_gap <- ocean_temp_clean |>
    filter(month %in% 7:9, sensor_depth_at_low_tide_m %in% c(2, 40)) |>
    summarise(
        mean_t = mean(mean_temperature_degree_c, na.rm = TRUE),
        .by = sensor_depth_at_low_tide_m
    ) |>
    summarise(gap = round(diff(mean_t))) |>
    pull(gap) |>
    abs()

### |-  Panel 2: Thermocline depth over time ----
thermocline_data <- ocean_temp_clean |>
    select(date, doy, year, month, sensor_depth_at_low_tide_m, mean_temperature_degree_c) |>
    arrange(date, sensor_depth_at_low_tide_m) |>
    group_by(date) |>
    filter(n() >= 2) |>
    mutate(
        depth_lag   = lag(sensor_depth_at_low_tide_m),
        temp_lag    = lag(mean_temperature_degree_c),
        delta_depth = sensor_depth_at_low_tide_m - depth_lag,
        delta_temp  = mean_temperature_degree_c - temp_lag,
        gradient    = abs(delta_temp / delta_depth)
    ) |>
    filter(!is.na(gradient)) |>
    slice_max(gradient, n = 1, with_ties = FALSE) |>
    ungroup() |>
    filter(gradient >= 0.05)

thermocline_monthly <- thermocline_data |>
    summarise(
        median_depth = median(sensor_depth_at_low_tide_m, na.rm = TRUE),
        n_days = n(),
        .by = c(year, month)
    ) |>
    mutate(date_mid = ymd(paste(year, month, "15"))) |>
    filter(n_days >= 5)
```

5. Visualization Parameters

```{r}
#| label: params
#| include: true
#| warning: false

### |-  plot aesthetics ----
colors <- get_theme_colors(
    palette = list(
        temp_low   = "#0d2b52",
        temp_mid   = "#2a9db5",
        temp_high  = "#f7d03c",
        thermo     = "#c9581a",
        thermo_pt  = "#e07b39",
        neutral    = "gray50",
        text_dark  = "#1a1a1a"
    )
)

### |- titles and caption ----
title_text <- str_glue("The Ocean Has a Memory")

subtitle_text <- str_glue(
    "Daily temperature profiles reveal persistent seasonal stratification and<br>",
    "depth-dependent thermal behavior — surface-to-deep differences reach<br>",
    "~{peak_gap}°C in late summer before the water column mixes flat in winter."
)

caption_text <- create_social_caption(
    tt_year     = 2026,
    tt_week     = 13,
    source_text = "Centre for Marine Applied Research · Nova Scotia Open Data Portal"
)

### |- fonts ----
setup_fonts()
fonts <- get_font_families()

### |-  plot theme ----
base_theme <- create_base_theme(colors)

weekly_theme <- extend_weekly_theme(
    base_theme,
    theme(
        panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        panel.border = element_blank(),
        axis.ticks = element_blank(),
        axis.text = element_text(family = fonts$text, size = 9, color = "gray40"),
        axis.title = element_text(family = fonts$text, size = 10, color = "gray30"),
        strip.text = element_text(family = fonts$text, size = 8, color = "gray30"),
        
        legend.position = "bottom", 
        legend.title = element_text(family = fonts$text, size = 8.5, color = "gray30"),
        legend.text = element_text(family = fonts$text, size = 7.5, color = "gray40"),
        legend.key.height = unit(0.35, "cm"),
        legend.key.width = unit(1.8, "cm"),
        
        plot.title = element_text(
            family = fonts$title, face = "bold", size = 20,
            color = colors$palette$text_dark, margin = margin(b = 6)
        ),
        plot.subtitle = element_markdown(
            family = 'sans', size = 12, color = "gray35",
            lineheight = 1.4, margin = margin(b = 18)
        ),
        plot.caption = element_markdown(
            family = fonts$text, size = 7, color = "gray55",
            margin = margin(t = 12)
        ),
        plot.margin = margin(16, 20, 12, 20)
    )
)

theme_set(weekly_theme)
```

6. Plot

```{r}
#| label: plot
#| warning: false

### |-  Panel 1: heatmap ----
p1 <- ggplot(
  heatmap_data,
  aes(x = doy, y = depth_label, fill = mean_temp)
  ) +
  # Geoms
  geom_tile(width = 1, height = 1) +
  scale_fill_gradientn(
    colors = c(
      colors$palette$temp_low,
      "#1a6e8a",
      colors$palette$temp_mid,
      "#d4a827",
      colors$palette$temp_high
    ),
    limits = temp_limits,
    oob = scales::squish,
    name = "Mean Temperature (°C)",
    guide = guide_colorbar(
      title.position = "top",
      title.hjust    = 0.5,
      barwidth       = 15,
      barheight      = 0.5
    )
  ) +
  scale_x_continuous(
    breaks = month_starts,
    labels = month_labels,
    expand = c(0, 0)
  ) +
  scale_y_discrete(limits = rev) +
  labs(
    x        = NULL,
    y        = "Sensor Depth",
    subtitle = "**Multi-year average** daily temperature by depth and day of year"
  ) +
  theme(
    plot.subtitle = element_markdown(
      family = 'sans', size = 12, color = "gray40",
      margin = margin(b = 8)
    ),
    axis.title.y = element_text(margin = margin(r = 8)),
    legend.margin = margin(t = 4, b = 10)
  )

### |-  Panel 2: Thermocline depth ----

p2 <- ggplot(
  thermocline_monthly,
  aes(x = date_mid, y = median_depth)
) +
  geom_hline(
    yintercept = c(2, 5, 10, 15, 20, 30, 40),
    color      = "gray88",
    linewidth  = 0.3,
    linetype   = "dashed"
  ) +
  geom_point(
    aes(size = n_days),
    color = colors$palette$thermo_pt,
    alpha = 0.10,
    shape = 16
  ) +
  geom_smooth(
    method    = "loess",
    span      = 0.2,
    se        = FALSE,
    color     = colors$palette$thermo,
    linewidth = 1.5
  ) +
  annotate(
    "text",
    x          = as.Date("2024-01-01"), 
    y          = 9.5,
    label      = "Thermocline shoals to ~5–10 m\nin late summer as surface waters warm",
    size       = 2.8,
    color      = colors$palette$thermo,
    hjust      = 0,
    lineheight = 1.25
  ) +
  scale_y_reverse(
    breaks = c(2, 5, 10, 15, 20, 30, 40),
    labels = paste0(c(2, 5, 10, 15, 20, 30, 40), " m"),
    limits = c(44, 0),
    sec.axis = dup_axis(
      labels = paste0(c(2, 5, 10, 15, 20, 30, 40), " m"),
      name   = NULL
    )
  ) +
  scale_x_date(
    date_breaks = "1 year",
    date_labels = "%Y",
    expand      = c(0.02, 0)
  ) +
  scale_size_continuous(range = c(1, 3.5), guide = "none") +
  labs(
    x        = NULL,
    y        = "Thermocline Depth\n(metres, increasing downward)",
    subtitle = "**Thermocline position** — depth of steepest daily temperature gradient (≥ 0.05 °C/m)"
  ) +
  theme(
    plot.subtitle = element_markdown(
      family = 'sans', size = 14, color = "gray40",
      margin = margin(b = 8)
    ),
    axis.title.y = element_text(margin = margin(r = 8), lineheight = 1.2),
    axis.text.y.left = element_blank(),
    axis.title.y.left = element_blank(),
    axis.text.y.right = element_text(
      family = fonts$text, size = 8, color = "gray40",
      margin = margin(l = 6)
    )
  )

### |-  Combined plot ----
combined_plot <- p1 / p2 +
    plot_layout(heights = c(1.4, 1)) &                   
    theme(plot.margin = margin(10, 20, 10, 20))

combined_plot <- combined_plot +
    plot_annotation(
        title = title_text,
        subtitle = subtitle_text,
        caption = caption_text,
        theme = theme(
            plot.title = element_text(
                family = fonts$title, face = "bold", size = 28,
                color = colors$palette$text_dark, margin = margin(b = 6)
            ),
            plot.subtitle = element_markdown(
                family = 'sans', size = 12, color = "gray35",
                lineheight = 1.4, margin = margin(b = 20)
            ),
            plot.caption = element_markdown(
                family = fonts$caption, size = 9, color = "gray55",
                margin = margin(t = 14),
                lineheight = 1.3,
            ),
            plot.margin = margin(20, 24, 14, 24)
        )
    )

combined_plot
```

7. Save

```{r}
#| label: save
#| warning: false

### |-  plot image ----  
save_plot_patchwork(
  plot = combined_plot, 
  type = "tidytuesday", 
  year = 2026, 
  week = 13, 
  width  = 12,
  height = 10
  )
```

8. Session Info

TipExpand for Session Info

R version 4.3.1 (2023-06-16 ucrt)
Platform: x86_64-w64-mingw32/x64 (64-bit)
Running under: Windows 11 x64 (build 26100)

Matrix products: default


locale:
[1] LC_COLLATE=English_United States.utf8 
[2] LC_CTYPE=English_United States.utf8   
[3] LC_MONETARY=English_United States.utf8
[4] LC_NUMERIC=C                          
[5] LC_TIME=English_United States.utf8    

time zone: America/New_York
tzcode source: internal

attached base packages:
[1] stats     graphics  grDevices utils     datasets  methods   base     

other attached packages:
 [1] here_1.0.2      patchwork_1.3.2 skimr_2.2.2     glue_1.8.0     
 [5] scales_1.4.0    janitor_2.2.1   showtext_0.9-7  showtextdb_3.0 
 [9] sysfonts_0.8.9  ggtext_0.1.2    lubridate_1.9.5 forcats_1.0.1  
[13] stringr_1.6.0   dplyr_1.2.0     purrr_1.2.1     readr_2.2.0    
[17] tidyr_1.3.2     tibble_3.2.1    ggplot2_4.0.2   tidyverse_2.0.0
[21] pacman_0.5.1   

loaded via a namespace (and not attached):
 [1] tidyselect_1.2.1   farver_2.1.2       S7_0.2.0           fastmap_1.2.0     
 [5] gh_1.4.1           digest_0.6.39      timechange_0.4.0   lifecycle_1.0.5   
 [9] rsvg_2.6.2         magrittr_2.0.3     compiler_4.3.1     rlang_1.1.7       
[13] tools_4.3.1        yaml_2.3.12        knitr_1.51         labeling_0.4.3    
[17] htmlwidgets_1.6.4  bit_4.6.0          curl_7.0.0         xml2_1.5.2        
[21] camcorder_0.1.0    repr_1.1.7         RColorBrewer_1.1-3 tidytuesdayR_1.2.1
[25] withr_3.0.2        grid_4.3.1         gitcreds_0.1.2     cli_3.6.4         
[29] rmarkdown_2.30     crayon_1.5.3       ragg_1.5.0         generics_0.1.4    
[33] otel_0.2.0         rstudioapi_0.18.0  tzdb_0.5.0         commonmark_2.0.0  
[37] splines_4.3.1      parallel_4.3.1     ggplotify_0.1.3    yulab.utils_0.2.4 
[41] base64enc_0.1-6    vctrs_0.7.1        Matrix_1.5-4.1     jsonlite_2.0.0    
[45] litedown_0.9       gridGraphics_0.5-1 hms_1.1.4          bit64_4.6.0-1     
[49] systemfonts_1.3.2  magick_2.8.6       gifski_1.32.0-2    codetools_0.2-19  
[53] stringi_1.8.7      gtable_0.3.6       pillar_1.11.1      rappdirs_0.3.4    
[57] htmltools_0.5.9    R6_2.6.1           httr2_1.2.2        textshaping_1.0.4 
[61] rprojroot_2.1.1    lattice_0.21-8     vroom_1.7.0        evaluate_1.0.5    
[65] markdown_2.0       gridtext_0.1.6     snakecase_0.11.1   Rcpp_1.1.1        
[69] svglite_2.1.3      nlme_3.1-162       mgcv_1.8-42        xfun_0.56         
[73] fs_1.6.7           pkgconfig_2.0.3   

9. GitHub Repository

TipExpand for GitHub Repo

The complete code for this analysis is available in tt_2026_13.qmd.

For the full repository, click here.

10. References

TipExpand for References

1. Data Source:
   • TidyTuesday 2026 Week 12: One Million Digits of Pi

11. Custom Functions Documentation

Note📦 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