Zhengquan Zhou

[Blog] From Spawning to Settlement: Cultivating Sea Urchin Larvae

2026-01-09T00:00:00+09:00

This post followed sea urchins from induced spawning through fertilization, larval development, metamorphosis, and juvenile formation under controlled temperature and salinity treatments. The post documents each stage of the cultivation process, highlighting both experimental techniques and organismal responses.

Inducing spawning

Adult purple sea urchins (Heliocidaris crassispina) were induced to spawn using potassium chloride (KCl) injection, a standard method for stimulating gamete release.

A sterile syringe was used to inject approximately 1 mL of 1.0 M KCl solution into the coelomic cavity through the peristomial membrane.

Within minutes, individuals began releasing gametes:

Females released clouds of orange eggs into filtered seawater
Males released white sperm directly into dry containers to maintain concentration

Figure 1. Adult sea urchins releasing gametes following KCl injection.

Egg collection and washing

Eggs were gently collected using wide-bore pipettes to avoid mechanical damage.

To remove debris and excess coelomic fluid, eggs were washed three times with filtered seawater:

Eggs allowed to settle by gravity
Supernatant carefully removed
Fresh filtered seawater added

This ensured high-quality eggs for fertilization.

Figure 2. Collected eggs after washing in filtered seawater.

Fertilization

Concentrated sperm was diluted in seawater to create a working sperm solution.

A small volume of diluted sperm was added dropwise to the egg suspension while gently swirling.

Successful fertilization was confirmed by the appearance of a fertilization membrane around eggs within several minutes.

Figure 3. Fertilized eggs with visible fertilization envelopes.

Early embryonic development

Following fertilization, embryos were maintained in gently aerated culture vessels under defined:

Temperature treatments
Salinity treatments

Cleavage occurred rapidly and synchronously, with embryos progressing through a series of well-defined developmental stages from early cell division to gastrulation (Figure 4).

Figure 4. Early embryonic development stages. (A) Two-cell stage shortly after the first cleavage division, showing two equal-sized blastomeres within the fertilization envelope. (B) Four-cell stage following the second cleavage, with blastomeres arranged symmetrically. (C) Eight-cell stage as continued cleavage increases cell number and reduces individual cell size. (D) Sixteen-cell stage, marking the transition toward more compact cellular organization. (E) Blastula stage, characterized by a spherical embryo with a developing blastocoel and a smooth outer cell layer. (F) Gastrula stage, showing clear morphological differentiation and the onset of gastrulation with tissue invagination.

Two-arm larval stage

After several days, larvae developed characteristic skeletal arms, marking the planktonic feeding stage.

Figure 5. Two-arm pluteus larvae during early development.

Six-arm larval stage

With continued growth and feeding, larvae extended additional arms and increased in size.

Figure 6. Six-arm larvae showing advanced skeletal development.

Metamorphosis

Settlement and metamorphic transition

Competent larvae eventually settled onto suitable surfaces and initiated metamorphosis.

This process involved:

Loss of larval arms
Formation of radial symmetry
Development of juvenile structures

Figure 7. Metamorphic transition from larva to juvenile.

Abnormal metamorphosis under thermal and salinity stress

Under combined temperature and salinity treatments, a subset of larvae exhibited abnormal or incomplete metamorphosis (Figure 8). These individuals showed disrupted morphological transitions, including irregular body shapes, partial reabsorption of larval structures, and malformed juvenile features.

Such abnormalities suggest that environmental stress during early development can interfere with the tightly regulated processes of settlement and tissue reorganization, potentially reducing post-settlement survival and recruitment success.

Figure 8. Abnormal metamorphic development under combined temperature and salinity treatments. Larvae exposed to elevated temperature and altered salinity showed incomplete or abnormal metamorphic transitions. In this image, two individuals appear to be partially fused, suggesting strong developmental disturbance under stress conditions.

Juvenile sea urchins

Following metamorphosis, individuals developed into benthic juveniles with visible spines and test structure.

Figure 9. Newly formed juvenile sea urchins.

Experimental significance

Tracking individuals from fertilization through juvenile stages allows assessment of:

Developmental sensitivity to temperature elevation
Impacts of salinity stress on growth and survival
Carry-over effects across life stages

These early-life responses play a crucial role in shaping population resilience under increasing climate extremes.

Final reflections

Culturing sea urchins across complete developmental cycles provides direct insight into how environmental stress influences:

Developmental timing
Morphological integrity
Settlement success

The images presented here reflect both the technical process and the biological consequences of climate-driven stressors.

END

Copyright notice:
© 2026 Zhengquan Zhou. All images and figures presented in this blog are the intellectual property of the author and are protected by copyright. Unauthorized reproduction or distribution is prohibited without written permission. Academic and educational use is permitted with proper citation of this page.

[Blog] Spatial and Thermal-Stress Dynamics of Native and Introduced Bivalves in the Eastern Scheldt

2025-12-20T00:00:00+09:00

This post documents an end-to-end R workflow that combines long-term benthic surveys (Eastern Scheldt) with mesocosm survival experiments to compare a native cockle and an introduced Manila clam under compound thermal and salinity stress.

Overview

Core components of the pipeline:

Filter large adults to reduce early-life stochasticity and emphasize habitat-integrated survival signals.
Map adult spatial distributions (Google satellite basemap) with fixed abundance classes.
Estimate adult habitat intensity using abundance-weighted KDE.
Quantify temporal persistence (years occupied) per station.
Track abundance-weighted centroid shifts through time.
Model abundance vs. summer thermal extremes using Gamma GLMs.
Derive a compound-stress establishment window from mesocosm survival data.

Project assets (figures + code):

Full workflow script: run_all_bothSpecies.R

Data background

Long-term benthic monitoring in the Eastern Scheldt (Rijkswaterstaat / WMR; curated by Troost et al.) has tracked abundance and distributions of bivalves since 1990. This workflow focuses on 2014–2021, when:

R. philippinarum is fully established across the system,
Temperature records enable explicit quantification of summer heat extremes,
A subset of 111 monitoring stations contains adult individuals of both species, providing a habitat-controlled comparison.

Two focal species:

Native cockle (Cerastoderma edule)
Introduced Manila clam (Ruditapes philippinarum)

Why focus on large adults

Juveniles and larvae are strongly influenced by hydrodynamic transport, storms, and settlement pulses, so their spatial patterns can be noisy and weakly related to habitat quality. By contrast, large adults:

survive ≥ 1–2 winters,
integrate multiple seasons of environmental filtering,
provide stable, interpretable spatial signals.

Size and age class definitions

Cockle (Cerastoderma edule) — age classes

Class	Meaning
1j	1-year-old juvenile
2j	2-year-old
mj	>2-year adult
nb	age undetermined

Large adults = 2j + mj (rare 0j recruits are merged into 1j).

Manila clam (Ruditapes philippinarum) — size classes

Thresholds changed through time:

Years	Small	Large
2014–2017	<1.5 cm	>1.5 cm
2018–2021	<2.0 cm	>2.0 cm

To keep consistency, large adults are identified as “grt” across years (2016 excluded for size-based inference).

Outputs (figures)

Figure 1. Spatial distribution of large adults for native cockles and introduced Manila clams (six abundance classes).

Figure 2. Adult habitat intensity of large adults (KDE weighted by abundance) for both species.

Figure 3. Temporal persistence of large adults (years occupied) for both species.

Figure 4. Abundance-weighted centroid shifts through time (point size indicates total annual abundance).

Figure 5. Mesocosm system used to simulate compound heatwave × salinity stress.

Figure 6. Species survival difference under compound stress, highlighting an establishment window favoring the introduced clam.

Figure 7. Adult abundance vs. summer thermal extremes (daily temperature sum above the 90th percentile), matched to next-year survey abundance.

Tutorial: reproduce the full pipeline (with complete R code)

This section rewrites the full run_all_bothSpecies.R pipeline as a step-by-step tutorial. You can copy/paste sections into an R script or run them interactively.

Files used (expected in your working directory):

Data can be found at this Github repository: bivalve_thermal_thresholds
Field survey data: WMR_WOTdata_OS1421_20221121.xlsx (sheet: data_OS1421)
Temperature data: schiphol70yrs.csv
Mesocosm survival data: sr_2sp.csv

Tip: Run everything at once via:

source("run_all_bothSpecies.R")

0) Setup

Libraries + helper functions

library(readxl)
library(tidyr)
library(dplyr)
library(ggplot2)
library(ggmap)
library(ggrepel)
library(lubridate)
library(patchwork)
library(viridis)
library(zoo)
library(raster)

# simple SE function
std_error <- function(x) sd(x) / sqrt(length(x))

Google Maps basemap (API key)

# Google API key (kept out of script)
google_key <- Sys.getenv("GOOGLE_MAPS_API_KEY")
if (identical(google_key, "") || is.na(google_key)) {
  stop("Please set GOOGLE_MAPS_API_KEY in your environment (e.g. in .Renviron).")
}
register_google(key = google_key)

1) Load and process field data

Load WMR survey data

df.shell <- read_excel("WMR_WOTdata_OS1421_20221121.xlsx", sheet = "data_OS1421")
df.nz    <- df.shell[df.shell$N_m2 != 0, ]

colnames(df.nz)[1] <- "project_id"
colnames(df.nz)[3] <- "station_id"

Subset large adult classes

df.grt <- subset(df.nz, Class %in% c("2j", "mj", "grt"))

Identify year × station entries where both species co-occur

df.grt$year_station <- paste(df.grt$Year,
                             df.grt$station_id,
                             df.grt$Longitude,
                             df.grt$Latitude,
                             sep = "_")

ys_list <- unique(df.grt$year_station)

# this follows your original approach (using an empty template)
df_ysNeo <- df.grt[-(1:1842), ]

for (i in ys_list) {
  df_ys <- df.grt[df.grt$year_station == i, ]
  if (is.element("Cerastoderma edule", df_ys$Species) &&
      is.element("Ruditapes philippinarum", df_ys$Species)) {
    df_ysNeo <- rbind(df_ysNeo, df_ys)
  }
}

Aggregate adult abundance per year × station × species

df_ysNeo$lbs <- paste(df_ysNeo$year_station, df_ysNeo$Species, sep = "_")

lbs_sum <- aggregate(df_ysNeo$N_m2, list(df_ysNeo$lbs), sum)
colnames(lbs_sum) <- c("lbs", "abun")

lbs_sum <- separate(
  lbs_sum,
  col  = lbs,
  into = c("year", "station_id", "longitude", "latitude", "species"),
  sep  = "_"
)

lbs_sum$longitude <- as.numeric(lbs_sum$longitude)
lbs_sum$latitude  <- as.numeric(lbs_sum$latitude)
lbs_sum$year      <- as.numeric(lbs_sum$year)

write.csv(lbs_sum, "lbs_sum.csv", row.names = FALSE)

Prepare a clean adult dataset for mapping

df_adults <- df.grt %>%
  filter(Species %in% c("Cerastoderma edule", "Ruditapes philippinarum")) %>%
  mutate(
    Species = factor(
      Species,
      levels = c("Cerastoderma edule", "Ruditapes philippinarum"),
      labels = c("Native: Cerastoderma edule",
                 "Introduced: Ruditapes philippinarum")
    )
  )

2) Abundance map (both species, 6 classes)

Basemap

bb <- make_bbox(
  lon  = df_adults$Longitude,
  lat  = df_adults$Latitude,
  f    = 0.05
)

base_map <- get_map(
  location = bb,
  source   = "google",
  maptype  = "satellite",
  zoom     = 10
)

Plot

# ---- 6-class abundance scheme (locked-in) ----
df_adults <- df_adults %>%
  mutate(AbundClass = cut(
    N_m2,
    breaks = c(0, 25, 100, 400, 800, 1200, Inf),
    labels = c("0–25", "26–100", "101–400",
               "401–800", "801–1200", ">1200"),
    right  = TRUE
  ))

size_values <- c(2.5, 5, 7.5, 10, 12.5, 15)

p_abund_both <- ggmap(base_map) +
  geom_point(
    data = df_adults,
    aes(x = Longitude, y = Latitude, size = AbundClass),
    shape  = 21,
    fill   = "orange",
    color  = "black",
    alpha  = 0.85,
    stroke = 0.7
  ) +
  scale_size_manual(
    name   = "Adult abundance
(ind. m⁻²)",
    values = size_values
  ) +
  facet_wrap(~ Species) +
  labs(
    title = "Spatial distribution of large adults",
    x = "Longitude (°E)",
    y = "Latitude (°N)"
  ) +
  theme_minimal(base_size = 14) +
  theme(
    strip.text   = element_text(face = "bold", size = 13),
    axis.title.x = element_text(face = "bold"),
    axis.title.y = element_text(face = "bold"),
    panel.grid   = element_blank(),
    legend.position = "right"
  )

p_abund_both

ggsave(
  "abundance_bothSpecies_google_6classes.png",
  p_abund_both,
  width = 11, height = 5, dpi = 300
)

3) Habitat intensity map (KDE intensity, both species)

p_int_both <- ggmap(base_map) +
  stat_density_2d(
    data = df_adults,
    aes(x = Longitude, y = Latitude,
        fill  = after_stat(level),
        alpha = after_stat(level),
        weight = N_m2),
    geom    = "polygon",
    colour  = NA,
    bins    = 8
  ) +
  scale_fill_viridis(
    option = "C",
    name   = "Adult habitat
intensity"
  ) +
  scale_alpha(range = c(0.2, 0.8), guide = "none") +
  facet_wrap(~ Species) +
  labs(
    title = "Adult habitat intensity (large size classes)",
    x = "Longitude (°E)",
    y = "Latitude (°N)"
  ) +
  theme_minimal(base_size = 14) +
  theme(
    strip.text   = element_text(face = "bold", size = 13),
    axis.title.x = element_text(face = "bold"),
    axis.title.y = element_text(face = "bold"),
    panel.grid   = element_blank(),
    legend.position = "right"
  )

p_int_both

ggsave(
  "habitat_intensity_bothSpecies_google.png",
  p_int_both,
  width = 11, height = 5, dpi = 300
)

4) Abundance ~ tempSum regression plots (both species)

# ---- Load temperature data ----
all_70year <- read.csv("schiphol70yrs.csv", header = TRUE)

lbs_sum_corr <- lbs_sum
lbs_sum_corr$label1 <- paste0(lbs_sum_corr$year, "_", lbs_sum_corr$species)

spsYrmean <- aggregate(abun ~ label1, data = lbs_sum_corr, FUN = mean)
spsYrSe   <- aggregate(abun ~ label1, data = lbs_sum_corr, FUN = std_error)
spsYrSd   <- aggregate(abun ~ label1, data = lbs_sum_corr, FUN = sd)
spsYrlnth <- aggregate(abun ~ label1, data = lbs_sum_corr, FUN = length)

spsYrmean <- separate(spsYrmean, label1, into = c("year", "sps"), "_")
colnames(spsYrmean)[3] <- "abun_mean"

spsYrSe   <- separate(spsYrSe,   label1, into = c("year", "sps"), "_")
colnames(spsYrSe)[3]   <- "abun_se"

spsYrlnth <- separate(spsYrlnth, label1, into = c("year", "sps"), "_")
colnames(spsYrlnth)[3] <- "station_reps"

df_spsAT <- spsYrmean

df_spsAT$abun_se      <- spsYrSe$abun_se

df_spsAT$station_reps <- spsYrlnth$station_reps

# ---- Temperature time series ----
temp_70year <- all_70year[!is.na(all_70year$YYYYMMDD), c(1, 12, 14)]
temp_70year$TN <- temp_70year$TN / 10
temp_70year$TX <- temp_70year$TX / 10

temp_70year$date <- as.Date(as.character(temp_70year$YYYYMMDD),
                            format = "%Y%m%d")

temp_70year <- temp_70year %>%
  mutate(date = ymd(date)) %>%
  mutate(
    year  = year(date),
    month = month(date),
    day   = day(date)
  )

temp1421 <- temp_70year[temp_70year$year >= 2013 & temp_70year$year <= 2022, ]

# 90th percentile threshold
thr_90 <- quantile(temp1421$TX, probs = 0.9, na.rm = TRUE)  # ~23.7 °C

temp30h <- temp1421[temp1421$TX >= thr_90, ]

temp30h$TX30diff <- temp30h$TX - thr_90

sumYear30h <- aggregate(TX30diff ~ year, data = temp30h, sum)

sY30h      <- aggregate(TX30diff ~ year, data = temp30h, length)

sY30h_se   <- aggregate(TX30diff ~ year, data = temp30h, std_error)

sumYear30h$duration   <- sY30h$TX30diff
sumYear30h$stad_error <- sY30h_se$TX30diff
sumYear30h$year_match <- sumYear30h$year + 1

# ---- Match summer temp sums to next-year abundance ----
df_spsAT$TX30diff <- sumYear30h$TX30diff[match(df_spsAT$year, sumYear30h$year_match)]
df_spsAT$duration <- sumYear30h$duration[match(df_spsAT$year, sumYear30h$year_match)]
df_spsAT$TX30diff_se <- sumYear30h$stad_error[match(df_spsAT$year, sumYear30h$year_match)]

df_spsAT$year        <- as.numeric(df_spsAT$year)
df_spsAT$abun_mean   <- as.numeric(df_spsAT$abun_mean)
df_spsAT$abun_se     <- as.numeric(df_spsAT$abun_se)
df_spsAT$TX30diff    <- as.numeric(df_spsAT$TX30diff)
df_spsAT$TX30diff_se <- as.numeric(df_spsAT$TX30diff_se)

df_spsAT_ce <- df_spsAT[df_spsAT$sps == "Cerastoderma edule", ]
df_spsAT_rp <- df_spsAT[df_spsAT$sps == "Ruditapes philippinarum", ]

# ---- Gamma GLMs ----
glm_model_ce <- glm(abun_mean ~ TX30diff,
                    data   = df_spsAT_ce,
                    family = Gamma(link = "log"))

glm_model_rp <- glm(abun_mean ~ TX30diff,
                    data   = df_spsAT_rp,
                    family = Gamma(link = "log"))

coef_intercept_ce <- round(coef(glm_model_ce)[1], 3)
coef_slope_ce     <- round(coef(glm_model_ce)[2], 3)

coef_intercept_rp <- round(coef(glm_model_rp)[1], 3)
coef_slope_rp     <- round(coef(glm_model_rp)[2], 3)

glm_summary_ce <- summary(glm_model_ce)
t_value_ce     <- round(glm_summary_ce$coefficients[2, "t value"], 3)
p_value_ce     <- round(glm_summary_ce$coefficients[2, "Pr(>|t|)"], 4)

glm_summary_rp <- summary(glm_model_rp)
t_value_rp     <- round(glm_summary_rp$coefficients[2, "t value"], 3)
p_value_rp     <- round(glm_summary_rp$coefficients[2, "Pr(>|t|)"], 4)

# ---- Regression plots ----
plot1 <- ggplot(df_spsAT_ce, aes(x = TX30diff, y = abun_mean)) +
  geom_point(size = 4, color = "#0072B2") +
  geom_errorbar(aes(ymin = abun_mean - abun_se,
                    ymax = abun_mean + abun_se),
                width = 1.0, color = "#0072B2") +
  geom_errorbarh(aes(xmin = TX30diff - TX30diff_se,
                     xmax = TX30diff + TX30diff_se),
                 height = 1.0, color = "#0072B2") +
  geom_smooth(aes(group = 1),
              method = "glm",
              method.args = list(family = Gamma(link = "log")),
              se = TRUE, linetype = "dashed",
              color = "#0072B2", alpha = 0.2) +
  geom_text_repel(aes(label = year),
                  size = 5, fontface = "bold",
                  box.padding = 0.5, point.padding = 0.6,
                  max.overlaps = Inf) +
  labs(
    x = "Daily Temp. Sum > 90th percentile (°C)",
    y = expression(bold("Mean abundance (ind./m"^2*")"))
  ) +
  annotate("text", x = -Inf, y = Inf,
           label = paste0("y == e^(", coef_intercept_ce, " + ", coef_slope_ce, " * x)"),
           hjust = -0.1, vjust = 1.5, size = 5,
           color = "#0072B2", parse = TRUE) +
  annotate("text", x = -Inf, y = Inf,
           label = paste0("italic(t) == ", t_value_ce),
           hjust = -0.25, vjust = 4.5, size = 4,
           color = "#0072B2", parse = TRUE) +
  annotate("text", x = -Inf, y = Inf,
           label = paste0("italic(p) == ", p_value_ce),
           hjust = -0.20, vjust = 5.1, size = 4,
           color = "#0072B2", parse = TRUE) +
  theme_bw() +
  theme(
    panel.border = element_rect(color = "black", fill = NA, linewidth = 1.5),
    axis.title.x = element_text(size = 14, face = "bold", color = "black"),
    axis.title.y = element_text(size = 14, face = "bold", color = "black"),
    axis.text.x  = element_text(size = 12, face = "bold", color = "black"),
    axis.text.y  = element_text(size = 12, face = "bold", color = "black")
  )

plot2 <- ggplot(df_spsAT_rp, aes(x = TX30diff, y = abun_mean)) +
  geom_point(size = 4, color = "#D55E00") +
  geom_errorbar(aes(ymin = abun_mean - abun_se,
                    ymax = abun_mean + abun_se),
                width = 1.0, color = "#D55E00") +
  geom_errorbarh(aes(xmin = TX30diff - TX30diff_se,
                     xmax = TX30diff + TX30diff_se),
                 height = 1.0, color = "#D55E00") +
  geom_smooth(aes(group = 1),
              method = "glm",
              method.args = list(family = Gamma(link = "log")),
              se = TRUE, linetype = "dashed",
              color = "#D55E00", alpha = 0.2) +
  geom_text_repel(aes(label = year),
                  size = 5, fontface = "bold",
                  box.padding = 0.5, point.padding = 0.6,
                  max.overlaps = Inf) +
  labs(
    x = "Daily Temp. Sum > 90th percentile (°C)",
    y = expression(bold("Mean abundance (ind./m"^2*")"))
  ) +
  annotate("text", x = -Inf, y = Inf,
           label = paste0("y == e^(", coef_intercept_rp, " + ", coef_slope_rp, " * x)"),
           hjust = -0.1, vjust = 1.5, size = 5,
           color = "#D55E00", parse = TRUE) +
  annotate("text", x = -Inf, y = Inf,
           label = paste0("italic(t) == ", t_value_rp),
           hjust = -0.25, vjust = 4.5, size = 4,
           color = "#D55E00", parse = TRUE) +
  annotate("text", x = -Inf, y = Inf,
           label = paste0("italic(p) == ", p_value_rp),
           hjust = -0.20, vjust = 5.1, size = 4,
           color = "#D55E00", parse = TRUE) +
  theme_bw() +
  theme(
    panel.border = element_rect(color = "black", fill = NA, linewidth = 1.5),
    axis.title.x = element_text(size = 14, face = "bold", color = "black"),
    axis.title.y = element_text(size = 14, face = "bold", color = "black"),
    axis.text.x  = element_text(size = 12, face = "bold", color = "black"),
    axis.text.y  = element_text(size = 12, face = "bold", color = "black")
  )

combined_plot <- plot1 + plot2 + plot_layout(ncol = 2)

combined_plot

ggsave(
  "twoSps_tempSum.png",
  combined_plot,
  width = 16, height = 6, units = "in", dpi = 300
)

5) Centroid shift (clean, both species, global abundance scale)

centroids <- df_adults %>%
  group_by(Species, Year) %>%
  summarise(
    mean_lon   = weighted.mean(Longitude, N_m2, na.rm = TRUE),
    mean_lat   = weighted.mean(Latitude, N_m2, na.rm = TRUE),
    total_abun = sum(N_m2, na.rm = TRUE),
    .groups    = "drop"
  ) %>%
  arrange(Species, Year)

segments <- centroids %>%
  group_by(Species) %>%
  summarise(
    x_start = first(mean_lon),
    y_start = first(mean_lat),
    x_end   = last(mean_lon),
    y_end   = last(mean_lat),
    .groups = "drop"
  ) %>%
  rowwise() %>%
  mutate(
    dx   = x_end - x_start,
    dy   = y_end - y_start,
    frac = 0.9,
    x_end_short = x_start + frac * dx,
    y_end_short = y_start + frac * dy
  ) %>%
  ungroup()

centroids_plot <- centroids %>%
  mutate(
    SizeClass = cut(
      total_abun,
      breaks = c(0, 25, 100, 400, 800, 1200, 5000, Inf),
      labels = c(
        "0–25",
        "26–100",
        "101–400",
        "401–800",
        "801–1200",
        "1201–5000",
        ">5000"
      ),
      right = TRUE
    ),
    SizeClass = factor(
      SizeClass,
      levels = c(
        "0–25",
        "26–100",
        "101–400",
        "401–800",
        "801–1200",
        "1201–5000",
        ">5000"
      )
    )
  )

size_vals_cent <- c(
  "0–25"       = 2.5,
  "26–100"     = 4.0,
  "101–400"    = 6.0,
  "401–800"    = 8.0,
  "801–1200"   = 10.0,
  "1201–5000"  = 12.0,
  ">5000"      = 15.0
)

p_centroid_clean <- ggplot() +
  geom_segment(
    data = segments,
    aes(x = x_start, y = y_start,
        xend = x_end_short, yend = y_end_short,
        color = Species),
    arrow     = arrow(type = "closed", length = unit(0.35, "cm")),
    linewidth = 2.2
  ) +
  geom_point(
    data = centroids_plot,
    aes(x = mean_lon, y = mean_lat, size = SizeClass),
    shape = 21,
    fill  = "orange",
    color = "black",
    alpha = 0.95,
    stroke = 0.7
  ) +
  geom_text_repel(
    data = centroids_plot,
    aes(x = mean_lon, y = mean_lat, label = Year),
    size = 3.5,
    max.overlaps   = Inf,
    box.padding    = 0.25,
    point.padding  = 0.25
  ) +
  scale_size_manual(
    name   = "Total adult abundance
(ind. m⁻² per year)",
    values = size_vals_cent
  ) +
  scale_color_manual(
    name = "Species",
    values = c(
      "Native: Cerastoderma edule"          = "#0072B2",
      "Introduced: Ruditapes philippinarum" = "#D55E00"
    )
  ) +
  facet_wrap(~ Species, scales = "free") +
  labs(
    title = "Range centroid shifts of large adults (abundance-weighted)",
    x     = "Longitude (°E)",
    y     = "Latitude (°N)"
  ) +
  theme_bw(base_size = 14) +
  theme(
    strip.text       = element_text(size = 13, face = "bold"),
    axis.title       = element_text(face = "bold"),
    panel.grid.minor = element_blank(),
    legend.position  = "bottom",
    legend.box       = "vertical"
  )

p_centroid_clean

ggsave(
  "centroid_shift_clean_bothSpecies_globalScale_8classes.png",
  p_centroid_clean,
  width = 10, height = 6, dpi = 300
)

6) Temporal persistence map (both species)

df_persist <- df.grt %>%
  filter(Species %in% c("Cerastoderma edule", "Ruditapes philippinarum")) %>%
  group_by(Species, station_id, Longitude, Latitude) %>%
  summarise(
    years_present = n_distinct(Year),
    .groups = "drop"
  ) %>%
  mutate(
    Species = factor(
      Species,
      levels = c("Cerastoderma edule", "Ruditapes philippinarum"),
      labels = c("Native: Cerastoderma edule",
                 "Introduced: Ruditapes philippinarum")
    )
  )

df_persist <- df_persist %>%
  mutate(
    PersistClass = cut(
      years_present,
      breaks = c(0, 1, 3, 5, 9),
      labels = c("1 year", "2–3 years", "4–5 years", "6–9 years"),
      right = TRUE
    )
  )

persist_sizes <- c(
  "1 year"     = 3,
  "2–3 years"  = 6,
  "4–5 years"  = 9,
  "6–9 years"  = 12
)

p_persist <- ggmap(base_map) +
  geom_point(
    data = df_persist,
    aes(x = Longitude, y = Latitude, size = PersistClass),
    shape = 21,
    fill  = "orange",
    color = "black",
    alpha = 0.9,
    stroke = 0.7
  ) +
  scale_size_manual(
    name   = "Temporal persistence
(years with large adults)",
    values = persist_sizes
  ) +
  facet_wrap(~ Species) +
  labs(
    title = "Temporal persistence of large adults (2014–2022)",
    x = "Longitude (°E)",
    y = "Latitude (°N)"
  ) +
  theme_bw(base_size = 14) +
  theme(
    strip.text       = element_text(size = 13, face = "bold"),
    axis.title       = element_text(face = "bold"),
    panel.grid.minor = element_blank(),
    legend.position  = "bottom",
    legend.box       = "horizontal"
  )

p_persist

ggsave(
  "temporal_persistence_bothSpecies_google.png",
  p_persist,
  width = 11, height = 5, dpi = 300
)

7) Establishment window plot (mesocosm survival differences)

Summary helper

summarySE = function(data=NULL, measurevar,
                     groupvars=NULL, na.rm=FALSE,
                     conf.interval=.95, .drop=TRUE) {
  library(plyr)

  # if na.rm==TRUE, don't count NAs
  length2 = function (x, na.rm=FALSE) {
    if (na.rm) sum(!is.na(x))
    else length(x)
  }

  # for each group's data frame, return N, mean, sd
  datac = ddply(data, groupvars,
                .drop = .drop, .fun = function(xx, col) {
                  c(N = length2(xx[[col]], na.rm = na.rm),
                    mean = mean(xx[[col]], na.rm = na.rm),
                    sd = sd(xx[[col]], na.rm = na.rm))
                },
                measurevar)

  datac <- rename(datac, c("mean" = measurevar))

  datac$se <- datac$sd / sqrt(datac$N)

  ciMult <- qt(conf.interval/2 + .5, datac$N-1)
  datac$ci <- datac$se * ciMult

  return(datac)
}

Load and prepare mesocosm survival data

df = read.csv('sr_2sp.csv')
df$date = as.POSIXct(as.character(df$date), format = '%Y%m%d')
df$mr = 1 - df$sr

df$salinity[df$salinity == '5']  = '5 PSU'
df$salinity[df$salinity == '10'] = '10 PSU'
df$salinity[df$salinity == '20'] = '20 PSU'
df$salinity[df$salinity == '30'] = '30 PSU'
df$salinity = factor(df$salinity, levels = c('5 PSU', '10 PSU', '20 PSU', '30 PSU'))

df$sp_code = df$species
df$species[df$species == 'CE'] = 'C. edule'
df$species[df$species == 'RP'] = 'R. philippinarum'

# subset

dfce = df[df$sp_code == 'CE', ]
dfrp = df[df$sp_code == 'RP', ]

# summary

dfce_summ = summarySE(data = dfce, measurevar = 'sr',
                      groupvars = c('date', 'salinity', 'treatment'),
                      na.rm = TRUE)

dfrp_summ = summarySE(data = dfrp, measurevar = 'sr',
                      groupvars = c('date', 'salinity', 'treatment'),
                      na.rm = TRUE)

df_summ = summarySE(data = df, measurevar = 'sr',
                    groupvars = c('species', 'date', 'salinity', 'treatment'),
                    na.rm = TRUE)

df_summ$sp_ht = paste(df_summ$species, df_summ$treatment, sep = '_')

df_neo = df_summ[, c(1,2,3,4,6)]

df_wide = pivot_wider(df_neo, names_from = "treatment", values_from = "sr")

df_order = df_wide[order(df_wide$species, df_wide$salinity, df_wide$date),]

df_order$C = na.locf(df_order$C)
df_order$H = na.locf(df_order$H)
df_order$Sdiff = df_order$C - df_order$H # optional

# add data categories

plb = c(rep('Phase 1', 5), rep('Phase 2', 5), rep('Phase 3', 5), rep('Phase 4', 5), rep('Phase 5', 5))

df_order$phase = rep(plb, 8)

dsb = paste0('D', 1:25)

df_order$days = rep(dsb, 8)

df_order$days = factor(df_order$days, levels = c(paste0('D', 1:25)))

df_order$salinity = factor(df_order$salinity, levels = c('30 PSU', '20 PSU', '10 PSU', '5 PSU'))

# subset by species

df_odce = df_order[df_order$species == 'C. edule', ]

df_odrp = df_order[df_order$species == 'R. philippinarum', ]

df_odce1 = df_odce[seq(5,100, by = 5),]

df_odrp1 = df_odrp[seq(5,100, by = 5),]

Plot WINDOW (survival-difference surface)

par(mar = c(5,5,4,4),font.axis = 2)
Lraster = raster(array(NA,dim = c(100,100)))

df_odrp$svDiff = df_odrp$H - df_odce$H

df_Diff = df_odrp

df_Diff = df_Diff[,-c(1, 4:6)]

X3 = tapply(df_Diff$svDiff, list(df_Diff$days, df_Diff$salinity), identity)

X3 = X3[nrow(X3):1, ]

sr3 = raster(X3)

sr31 = resample(sr3, Lraster)

sr31[sr31 > 1] = 1
sr31[sr31 < 0] = 0

breakpoints = c(seq(0, 0.7, 0.1), 0.9)

colBW = c(viridis::viridis(10)[3:10], "#FDE725FF")

Phase1 = 53.2
Phase2 = 121.6
Phase3 = 192.6
Phase4 = 276.3
Phase5 = 370.7

png('diff_mRateWINDOW.png',width = 8, height = 6, units='in', res = 300)

plot(sr31, axes = FALSE, box = FALSE, legend = FALSE,
     col = colBW, breaks = breakpoints, zlim = c(0.0,0.9))

plot(rasterToPolygons(sr31), add = TRUE,
     border = adjustcolor("black",alpha.f=0.1) , lwd=1)

axis(side = 1, at = seq(0.125,0.875,length.out = 4), labels = c(30,20,10,5), cex.axis =0.9, pos=-0.01)

axis(side = 2, at = seq(0.1,0.9,length.out = 5), labels = c(Phase1, Phase2, Phase3, Phase4, Phase5), cex.axis =0.9, pos=-0.01)

axis(side = 1, line = 1.5, at = 0.5, labels = 'Salinity stress (PSU)', tick = FALSE, cex.axis = 1.4, pos = -0.08, font = 2)

axis(side = 2, line = 1.5, at = 0.5, labels = 'Accumulated thermal stress (°C)', tick = FALSE, cex.axis = 1.4, pos = -0.1, font = 2)

plot(sr31, axes = FALSE, box = FALSE,
     col = colBW, breaks = breakpoints, zlim = c(0, 0.9),
     legend.width=1.5, legend.shrink=1,
     axis.args=list(at=seq(0.0, 0.9, 0.1),
                    labels=seq(0.0, 0.9, 0.1),
                    cex.axis=0.95, srt = 35),
     legend.args=list(text= expression(bold('Species survival difference')), side=2, font=2, line=1.5, cex=1),
     legend.only=TRUE, horizontal = FALSE)

dev.off()

Citation

Zhou et al. (2025). Compound extreme events reshuffle the stacked odds in the gamble between native and introduced bivalves. Global Ecology and Conservation. DOI

Usage and permissions

All scripts, analyses, and derived figures are intended for academic and non-commercial research use only. Commercial use or public redistribution requires explicit written permission from the authors. Additional restrictions may apply to the original monitoring dataset curated by Rijkswaterstaat / WMR.

Please cite the original publication when using any part of this work.

[Blog] Sea Urchin Movement Model (Lévy Walk + Chemical Cue Targeting)

2025-11-27T00:00:00+09:00

This post documents an R simulation for sea urchin foraging: a Lévy-walk–style search that switches to directed movement when the animal enters a chemical-cue detection radius around food sources. The output is an animated GIF that tracks the path and the cue “rings”.

Overview

The core idea is:

The urchin explores with random steps drawn from a heavy-tailed step-length distribution (a Lévy-like rule).
When it approaches a food source (within a detection radius), it moves toward the food.
Once it reaches food, it stops (in this implementation).

In this demo:

Four food sources are placed at the corners of the arena.
Each food source has a dashed circle showing its detection radius.
When the urchin path intersects a detection circle, the model transitions into cue-following.

R code (complete)

Libraries

# Load necessary libraries
library(ggplot2)
library(ggforce)
library(ggimage)
library(gganimate)
library(scales)

Helper functions

Distance calculation

# Function to calculate distance between two points
calculate_distance <- function(x1, y1, x2, y2) {
  sqrt((x2 - x1)^2 + (y2 - y1)^2)
}

Line–circle intersection (cue detection)

This checks whether a movement segment crosses a food-source detection circle.

# Function to check if a line segment intersects with a circle
line_circle_intersection <- function(x1, y1, x2, y2, cx, cy, r) {

  dx <- x2 - x1
  dy <- y2 - y1
  fx <- x1 - cx
  fy <- y1 - cy

  a <- dx^2 + dy^2
  b <- 2 * (fx * dx + fy * dy)
  c <- fx^2 + fy^2 - r^2

  discriminant <- b^2 - 4 * a * c

  if (discriminant >= 0) {
    t1 <- (-b + sqrt(discriminant)) / (2 * a)
    t2 <- (-b - sqrt(discriminant)) / (2 * a)

    if ((t1 >= 0 && t1 <= 1) || (t2 >= 0 && t2 <= 1)) {
      return(TRUE)
    }
  }

  return(FALSE)
}

Lévy-walk movement with cue-following + stopping

Mechanism:

Find the closest food source.
If distance is larger than the detection threshold:
- take a Lévy-like random step (heavy-tailed step length + random angle).
If within detection radius:
- move directly toward the food.
- if the path intersects the cue circle, snap to the food and stop.

simulate_urchin_movement_towards_food_stopping <- function(
  num_steps,
  alpha,
  food_points,
  start_x = 0,
  start_y = 0,
  distance_thresholds = 5
) {

  x <- numeric(num_steps + 1)
  y <- numeric(num_steps + 1)

  x[1] <- start_x
  y[1] <- start_y

  reached_food <- FALSE

  for (i in 2:(num_steps + 1)) {

    if (!reached_food) {

      closest_distance_to_food <- Inf
      closest_food_index <- 0

      # find closest food
      for (j in 1:nrow(food_points)) {

        food_x <- food_points[j, "x"]
        food_y <- food_points[j, "y"]

        direction_x <- food_x - x[i - 1]
        direction_y <- food_y - y[i - 1]
        distance_to_food <- sqrt(direction_x^2 + direction_y^2)

        if (distance_to_food < closest_distance_to_food) {
          closest_distance_to_food <- distance_to_food
          closest_food_index <- j
        }
      }

      # far from food -> Lévy-like random step
      if (closest_distance_to_food > distance_thresholds) {

        step_length <- abs(rnorm(1, mean = 0, sd = 1))^(-1 / alpha)
        step_angle  <- runif(1, 0, 2 * pi)

        new_x <- x[i - 1] + step_length * cos(step_angle)
        new_y <- y[i - 1] + step_length * sin(step_angle)

        # keep inside arena bounds
        x[i] <- pmin(300, pmax(-300, new_x))
        y[i] <- pmin(300, pmax(-300, new_y))

      } else {

        # within cue radius -> move toward food
        food_x <- food_points[closest_food_index, "x"]
        food_y <- food_points[closest_food_index, "y"]

        # if the segment intersects the cue circle, snap to food and stop
        if (line_circle_intersection(
              x[i - 1], y[i - 1],
              food_x, food_y,
              food_x, food_y,
              distance_thresholds
            )) {

          x[i] <- food_x
          y[i] <- food_y
          reached_food <- TRUE

        } else {

          unit_direction_x <- (food_x - x[i - 1]) / closest_distance_to_food
          unit_direction_y <- (food_y - y[i - 1]) / closest_distance_to_food

          new_x <- x[i - 1] + unit_direction_x
          new_y <- y[i - 1] + unit_direction_y

          x[i] <- pmin(300, pmax(-300, new_x))
          y[i] <- pmin(300, pmax(-300, new_y))
        }
      }

    } else {
      # already reached food -> stop
      x[i] <- x[i - 1]
      y[i] <- y[i - 1]
    }
  }

  return(data.frame(x = x, y = y, step = 1:(num_steps + 1)))
}

Parameters and run

# Parameters for simulation
num_steps <- 3000  # Number of steps for the simulation
alpha <- 1.5       # Levy distribution parameter (alpha > 1 for heavy-tailed distribution)

food_locations <- data.frame(
  x = c(-200, -200, 200, 200),  # X-coordinates of the food points
  y = c(-200, 200, 200, -200)   # Y-coordinates of the food points
)

distance_thresholds <- 100

# Simulate sea urchin movement with stopping condition
urchin_movement_stopping <- simulate_urchin_movement_towards_food_stopping(
  num_steps,
  alpha,
  food_locations,
  distance_thresholds = distance_thresholds
)

Plot + animate (gganimate)

Notes

Put your urchin PNG (e.g., sea_urchin2.png) in the working directory, or provide a full path. Download a sample image from here.
The output GIF is saved as output.gif.

# Create ggplot object for initial plot with food points and sea urchin movement
sea_urchin_image <- "sea_urchin2.png"  # Replace with your image file path

p <- ggplot() +
  geom_rect(
    data = food_locations,
    aes(xmin = x - 0.25, xmax = x + 0.25, ymin = y - 0.25, ymax = y + 0.25),
    fill = "blue"
  ) +
  geom_line(
    data = urchin_movement_stopping,
    aes(x = x, y = y),
    color = "blue",
    alpha = 0.3
  ) +
  geom_point(
    data = food_locations,
    aes(x = x, y = y),
    shape = 17,
    size = 5,
    color = "green"
  ) +
  geom_image(
    data = urchin_movement_stopping,
    aes(x = x, y = y, image = sea_urchin_image),
    size = 0.15
  ) +
  lapply(distance_thresholds, function(threshold) {
    geom_circle(
      data = food_locations,
      aes(x0 = x, y0 = y, r = threshold),
      inherit.aes = FALSE,
      color = "black",
      linetype = "dashed",
      alpha = 0.5
    )
  }) +
  labs(
    x = "X-axis",
    y = "Y-axis",
    title = "Sea Urchin Searching for Chemical Cue and Food"
  ) +
  transition_reveal(step) +
  theme_bw() +
  xlim(-300, 300) +
  ylim(-300, 300) +
  coord_fixed()

p

# Render and save animation
animation <- gganimate::animate(
  p,
  renderer = gganimate::gifski_renderer(),
  width = 800,
  height = 600
)

gganimate::anim_save("output.gif", animation)

Limitations (current implementation)

Fixed duration: the simulation runs for a fixed num_steps and then ends, even if no food is reached.
Idealized behavior: cue-following is simplified; real urchin movement can be affected by currents, substrate complexity, and multiple sensory cues.
Single stopping rule: once food is reached, the urchin stops. You could extend this to allow continued foraging among multiple patches.

[Note] Ridgeline Plots in R (ggridges)

2023-06-15T00:00:00+09:00

Ridgeline plots are a clean way to compare distributions of a continuous variable across multiple groups. This note introduces the ggridges package and shows practical options for shaping, spacing, and coloring ridgelines in ggplot2.

Ridgeline plots (also called joy plots) visualize multiple density curves stacked along a categorical axis. They are especially useful when you want to compare how distributions shift or differ across groups (e.g., treatments, sites, time points).

In ggridges, two commonly used geoms are:

geom_density_ridges() (open ridges)
geom_density_ridges2() (closed ridges)

Package setup

# install.packages("ggridges")
library(ggridges)

# install.packages("ggplot2")
library(ggplot2)

We use a small example dataset from diamonds:

df <- diamonds[1:100, c("color", "depth")]

1) Basic ridgeline plots

geom_density_ridges()

ggplot(df, aes(x = depth, y = color)) +
  geom_density_ridges()

Figure 1. Ridgeline plot created using geom_density_ridges().

geom_density_ridges2()

geom_density_ridges2() produces a similar plot but with closed ridges.

ggplot(df, aes(x = depth, y = color)) +
  geom_density_ridges2()

Figure 2. Ridgeline plot created using geom_density_ridges2().

2) Key parameters

Tail trimming: rel_min_height

rel_min_height controls how much of the density tail is removed. Smaller values keep more of the tail; larger values trim more aggressively.

ggplot(df, aes(x = depth, y = color)) +
  geom_density_ridges(rel_min_height = 0.005)

Figure 3. Low trimming (more tails kept).

ggplot(df, aes(x = depth, y = color)) +
  geom_density_ridges(rel_min_height = 0.5)

Figure 4. Strong trimming (tails cut earlier).

Ridge spacing: scale

scale controls how much the ridges overlap/stack. Smaller values are more compact; larger values spread ridges vertically.

ggplot(df, aes(x = depth, y = color)) +
  geom_density_ridges(scale = 1)

Figure 5. Compact ridge spacing.

ggplot(df, aes(x = depth, y = color)) +
  geom_density_ridges(scale = 10)

Figure 6. Expanded ridge spacing.

Alternative statistic: stat = “binline”

You can switch the statistic used for the ridge geometry.

ggplot(df, aes(x = depth, y = color)) +
  geom_density_ridges(stat = "binline")

Figure 7. Ridgeline plot using stat = "binline".

3) Styling and colors

Single fill color and transparency

ggplot(df, aes(x = depth, y = color)) +
  geom_density_ridges(fill = "lightblue", alpha = 0.5)

Figure 8. Uniform fill color with transparency.

Line style (color, linetype, linewidth)

ggplot(df, aes(x = depth, y = color)) +
  geom_density_ridges(fill = "white",
                      color = 4,
                      linetype = 2,
                      lwd = 1.5)

Figure 9. Customized ridge outline style.

Fill by category

Map fill to the category variable to color each ridge group.

ggplot(df, aes(x = depth, y = color, fill = color)) +
  geom_density_ridges()

Figure 10. Fill mapped to category (color).

To set exact colors, use scale_fill_manual():

ggplot(df, aes(x = depth, y = color, fill = color)) +
  geom_density_ridges() +
  scale_fill_manual(values = c("red","orange","yellow","green","cyan","blue","purple"))

Figure 11. Manual fill palette using scale_fill_manual().

Gradient fill along the x-axis

Use a gradient fill mapped to the x-value:

ggplot(df, aes(x = depth, y = color, fill = stat(x))) +
  geom_density_ridges_gradient() +
  scale_fill_viridis_c(name = "Depth", option = "C")

Figure 12. Gradient fill using geom_density_ridges_gradient().

Quantile-based coloring

You can color ridge segments by quantile ranges using stat_density_ridges() with ECDF.

ggplot(df, aes(x = depth, y = color, fill = stat(quantile))) +
  stat_density_ridges(quantile_lines = FALSE,
                      calc_ecdf = TRUE,
                      geom = "density_ridges_gradient") +
  scale_fill_brewer(name = "")

Figure 13. Quantile-based fill using ECDF.

Highlight distribution tails

This approach can highlight tails by choosing quantiles (e.g., 5% and 95%) and assigning different colors.

ggplot(df, aes(x = depth, y = color, fill = stat(quantile))) +
  stat_density_ridges(quantile_lines = TRUE,
                      calc_ecdf = TRUE,
                      geom = "density_ridges_gradient",
                      quantiles = c(0.05, 0.95)) +
  scale_fill_manual(name = "Prob.",
                    values = c("#E2FFF2", "white", "#B0E0E6"),
                    labels = c("(0, 5%]", "(5%, 95%]", "(95%, 1]"))

Figure 14. Tail highlighting using selected quantiles.

Notes

For very small sample sizes, density shapes can be unstable; use more data if possible.
If ridges overlap too much, reduce scale or increase the y-axis spacing (or use fewer groups).
When using gradient or quantiles, keep legends simple so the plot stays readable.

[Note] Rolling Window Analysis in R

2023-06-01T00:00:00+09:00

Rolling window analysis is a flexible approach for summarizing relationships in time-ordered or gradient-based data by computing statistics within sliding windows. This note demonstrates a custom implementation in R using the smoking dataset to explore how average weekday smoking amounts vary with age.

Rolling window analysis is a way to summarize data by computing statistics within fixed-length windows that slide across an ordered variable. It is useful for checking whether the relationship between a response and an explanatory variable is stable across the range of the data.

Figure 1. A conceptual figure demonstrating the rolling-window method.

Two key parameters define this method:

Step size: how far the window moves each iteration
Window size: how much data each window contains (its span)

Common statistics include mean, standard deviation, and variance.

The zoo package provides rollapply() for rolling calculations, but writing custom code can be more flexible for specific analysis needs.

In this example, we use the smoking dataset from the openintro package to explore the relationship between weekday smoking amount and age.

Dataset documentation:
https://rdrr.io/cran/openintro/man/smoking.html

Data sorting

We first remove missing values and sort the data by age in ascending order.

library(openintro)

data(smoking)

dt = smoking[order(smoking$age), ]
dt = dt[!is.na(dt$amt_weekdays), ]

We visualize the raw relationship:

plot(dt$amt_weekdays ~ dt$age)

Figure 2. Scatter plot of weekday smoking amount versus age.

Parameter setting

Next, we define the rolling window parameters and prepare a dataframe to store summarized results.

step.age = 0.1     # step size
window.age = 10    # window size

min.age = min(dt$age)
max.age = max(dt$age)

wm.df = data.frame(wm.age = numeric(0),
                   wm.amt_wk = numeric(0))

Writing the loop

The rolling window algorithm computes statistics inside each window, then shifts forward by the step size.

Here we compute the mean age and the mean weekday smoking amount within each window.

i = 0
n_step = (max.age - min.age - window.age) / step.age

for (i in 0:n_step) {

  filter.age = dt$age >= (min.age + i * step.age) &
               dt$age <= (min.age + i * step.age + window.age)

  sub.dt = dt[filter.age, ]

  wm.age = mean(sub.dt$age)
  wm.amt_wk = mean(sub.dt$amt_weekdays)

  wm.dt = list(wm.age, wm.amt_wk)
  wm.df = rbind(wm.df, wm.dt)

  i + 1
}

colnames(wm.df) = c('m.age', 'm.amt_wk')

Plotting

We plot raw data by gender, then overlay the rolling window averages.

library(scales)

filter_f = dt$gender == 'Female'
filter_m = dt$gender == 'Male'

dt$color = as.character(dt$gender)
dt$color[dt$color == 'Female'] = 'pink'
dt$color[dt$color == 'Male'] = 'light blue'

plot(dt$age[filter_m], dt$amt_weekdays[filter_m],
     xlim = c(15, 95), ylim = c(0, 55),
     xaxt = "none", yaxt = "none",
     xlab = "", ylab = "",
     pch = 16,
     col = alpha(unique(dt$color[filter_m]), 0.5),
     tcl = 0.3)

points(dt$age[filter_f], dt$amt_weekdays[filter_f],
       pch = 16,
       col = alpha(unique(dt$color[filter_f]), 0.5))

points(wm.df$m.age, wm.df$m.amt_wk,
       pch = 21, bg = '#FF0033', cex = 2.5)

axis(1, seq(15, 95, 5), las = 1, font = 2)
axis(2, seq(0, 55, 5), las = 2, font = 2)

mtext(side = 1, line = 2, "Age", font = 2)
mtext(side = 2, line = 2, "Number of cigarettes/day", font = 2)
mtext(side = 3, line = 1, "Age dependence of smoking amounts",
      col = "blue", font = 3)

abline(v = c(62.5, 82.5), lwd = 1.2, lty = 2)

legend('topleft',
       legend = c('Female', 'Male', 'Summarized data'),
       pch = 16,
       col = c('pink', 'lightblue', 'red'))

Figure 3. The rolling window averages.

Interpretation

The rolling window summary suggests:

Ages 20–60: weekday smoking increases with age
Ages 60–80: weekday smoking decreases with age
After ~85: weekday smoking drops sharply

This pattern is difficult to see from raw scatter points alone but becomes clear after rolling window smoothing.

[Note] Handling Date-Time Data in R with as.POSIXct()

2023-05-20T00:00:00+09:00

Short note on handling time-series data in R using POSIXct and ggplot2.

Time-series data are common in ecological experiments, such as hourly temperature records or interannual biomass variation.

In base R, time data are mainly represented in three formats:

Date: number of days since 1970-01-01
POSIXct: number of seconds since 1970-01-01 (UTC-based)
POSIXlt: list-based structure storing date, time, and timezone

Time objects are usually created by converting character strings using:

as.Date()
as.POSIXct()
as.POSIXlt()
strptime()

The lubridate package also provides convenient tools.

This note focuses on the basic usage of as.POSIXct().

Basic syntax

as.POSIXct(x, tz = "", format = "", origin = "", ...)

Arguments:

x: object to convert (usually a character string)
tz: timezone (default is system timezone)
format: string format specification
origin: starting date for numeric time values

Example 1: Simple conversion

t1 = '2022-02-22 22:22:22'
class(t1)

t1 = as.POSIXct(t1)
class(t1)

Example 2: Specify format

t2 = '2022/02/22T22:22:22'
t2 = as.POSIXct(t2, format = '%Y/%m/%dT%H:%M:%S')
t2

Common format symbols:

%y two-digit year
%Y four-digit year
%m month
%d day
%b abbreviated month
%B full month name
%a abbreviated weekday
%A full weekday

Example 3: Timezones

library(lubridate)

t3 <- as.POSIXct('2022-02-23 23:23:23', tz = 'UTC')
t3

t4 <- as.POSIXct('2022-02-24 01:00:00', tz = 'America/New_York')
t4

with_tz(t4, 'GMT')

Example 4: UNIX time origin

t5 = 1645564942
as.POSIXct(t5, origin = '1970-01-01')
as.POSIXct(t5, origin = '1980-01-01')

Plotting date-time data with ggplot2

library(ggplot2)
library(scales)

set.seed(2022)

a = 4
b = 7
amp = 2
n = 7 * 24 * 4

t = seq(0, 2*pi, , n)
h.norm = rnorm(n)

h.temp = a*sin(b*t + 1.5*pi) + h.norm*amp + 25

dt = seq.POSIXt(
  as.POSIXct("2022-02-01 00:00:00"),
  as.POSIXct("2022-02-07 23:45:00"),
  tz = "Europe/Berlin",
  by = "15 min"
)

df.temp = data.frame(datetime = dt, temptr = h.temp)

ggplot(df.temp, aes(x = datetime, y = temptr)) +
  geom_line(size = 1.5, col = "red") +
  xlab("Measuring time") +
  ylab("Measured temperature (°C)") +
  ylim(15, 35) +
  scale_x_datetime(
    labels = date_format("%m/%d/%y"),
    breaks = date_breaks("1 day")
  ) +
  ggtitle("Air temperature variation") +
  theme(
    plot.title = element_text(size = 20, face = "bold", hjust = 0.5),
    axis.title = element_text(size = 15, face = "bold"),
    axis.text = element_text(size = 12, face = "bold")
  )

Zhengquan Zhou

[Blog] From Spawning to Settlement: Cultivating Sea Urchin Larvae

Inducing spawning

Egg collection and washing

Fertilization

Early embryonic development

Two-arm larval stage

Six-arm larval stage

Metamorphosis

Settlement and metamorphic transition

Abnormal metamorphosis under thermal and salinity stress

Juvenile sea urchins

Experimental significance

Final reflections

END

[Blog] Spatial and Thermal-Stress Dynamics of Native and Introduced Bivalves in the Eastern Scheldt

Overview

Data background

Why focus on large adults

Size and age class definitions

Cockle (Cerastoderma edule) — age classes

Manila clam (Ruditapes philippinarum) — size classes

Outputs (figures)

Tutorial: reproduce the full pipeline (with complete R code)

0) Setup

Libraries + helper functions

Google Maps basemap (API key)

1) Load and process field data

Load WMR survey data

Subset large adult classes

Identify year × station entries where both species co-occur

Aggregate adult abundance per year × station × species

Prepare a clean adult dataset for mapping

2) Abundance map (both species, 6 classes)

Basemap

Plot

3) Habitat intensity map (KDE intensity, both species)

4) Abundance ~ tempSum regression plots (both species)

5) Centroid shift (clean, both species, global abundance scale)

6) Temporal persistence map (both species)

7) Establishment window plot (mesocosm survival differences)

Summary helper

Load and prepare mesocosm survival data

Plot WINDOW (survival-difference surface)

Citation

Usage and permissions

[Blog] Sea Urchin Movement Model (Lévy Walk + Chemical Cue Targeting)

Overview

R code (complete)

Libraries

Helper functions

Distance calculation

Line–circle intersection (cue detection)

Lévy-walk movement with cue-following + stopping

Parameters and run

Plot + animate (gganimate)

Limitations (current implementation)

Further reading

[Note] Ridgeline Plots in R (ggridges)

Package setup

1) Basic ridgeline plots

geom_density_ridges()

geom_density_ridges2()

2) Key parameters

Tail trimming: rel_min_height

Ridge spacing: scale

Alternative statistic: stat = “binline”

3) Styling and colors

Single fill color and transparency

Line style (color, linetype, linewidth)

Fill by category

Gradient fill along the x-axis

Quantile-based coloring

Highlight distribution tails

Notes

Further reading

[Note] Rolling Window Analysis in R

Data sorting

Parameter setting

Writing the loop