Wilson’s Promontory Lighthouse - 085096 - BOM
Detecting extreme weather events for Australian fur seal population on West Moncoeur Island
Milan Sojitra
2025-06-19
- 1 Breeding Season & Colony Information
- 2 Import and Process BOM Weather Data
- 3 Calculate Extreme Weather Indices
- 4 Save daily weather data
# Load essential libraries
library(tidyverse) # for data wrangling and plotting
library(data.table) # for fast data import
library(weathermetrics) # for humidity and temperature calculations
library(openxlsx2) # for Excel output
library(zoo) # for date utilities
library(HeatStress) # for WBGT calculations
library(heatwaveR) # for extreme event detection1 Breeding Season & Colony Information
# Study species and colony details
colony_name <- "West Moncoeur Island"
colony_lat <- -39.2309
colony_lon <- 146.5060
# Define breeding season
monitoring_months <- c("10", "11","12", "1") # October to January
start_month <- 10 # Used to calculate 'season' by year crossing - actual start of the breeding season
start_season <- 1989 # First monitored breeding season
last_season <- 2022 # Last monitored breeding season2 Import and Process BOM Weather Data
2.1 Synoptic Data
Hourly Observations (1 to 24 observations per day)
# Import and summarise BOM synoptic data (hourly observations)
bom_syno <- fread("BOM/Synoptic/HC06D_Data_085096_9999999910800646.txt") %>%
dplyr::select(year = 'Year',
month = 'Month',
day = 'Day',
hour = 'Hour',
air_temperature = 'Air temperature in Degrees C',
dewpoint_temperature = 'Dew point temperature in Degrees C',
wetbulb_temperature = 'Wet bulb temperature in Degrees C',
wind_speed = 'Wind speed measured in km/h',
sea_level_pressure = 'Mean sea level pressure in hPa',
) %>%
dplyr::mutate(date = make_date(year, month, day),
season = if_else(month(date) >= start_month, year(date), year(date) - 1)
) %>%
dplyr::mutate(across(c(air_temperature, dewpoint_temperature, wetbulb_temperature,
wind_speed, sea_level_pressure), as.numeric)) %>%
dplyr::group_by(season, date, year, month, day) %>%
dplyr::summarise(air_temperature = if_else(any(!is.na(air_temperature)), mean(air_temperature, na.rm = TRUE), NA_real_),
dewpoint_temperature= if_else(any(!is.na(dewpoint_temperature)),mean(dewpoint_temperature, na.rm = TRUE), NA_real_),
wetbulb_temperature = if_else(any(!is.na(wetbulb_temperature)), max(wetbulb_temperature, na.rm = TRUE), NA_real_),
wind_speed_mean = if_else(any(!is.na(wind_speed)), mean(wind_speed, na.rm = TRUE), NA_real_),
wind_speed_max = if_else(any(!is.na(wind_speed)), max(wind_speed, na.rm = TRUE), NA_real_),
sea_level_pressure = if_else(any(!is.na(sea_level_pressure)), mean(sea_level_pressure, na.rm = TRUE), NA_real_),
.groups = "drop"
)2.2 BOM Daily data
# Import daily observations
bom_daily <- fread("BOM/Daily/DC02D_Data_085096_9999999910804711.txt") %>%
dplyr::select(year = 'Year',
month = 'Month',
day = 'Day',
air_temperature_min = 'Minimum temperature in 24 hours before 9am (local time) in Degrees C',
air_temperature_max = 'Maximum temperature in 24 hours after 9am (local time) in Degrees C',
precipitation = 'Precipitation in the 24 hours before 9am (local time) in mm',
gust_speed = 'Speed of maximum wind gust in km/h',
gust_direction = 'Direction of maximum wind gust in degrees',
solar_exposure = 'Total daily global solar exposure - derived from satellite data in kWh.m-2'
) %>%
dplyr::mutate(date = make_date(year, month, day),
season = if_else(month(date) >= start_month, year(date), year(date) - 1),
solar_radiation = solar_exposure * 1000 / 24 # Convert kWh/m² to W/m²
) %>%
dplyr::select(season, date, year, month, day, everything())
# Merge with synoptic data
bom_daily <- merge(bom_daily, bom_syno,
by = c("season", "date", "year", "month", "day"),
all = TRUE
)2.3 CAWCR Wave data
# Calculate the circular mean of directional data (in degrees)
# This function returns the mean direction of angular values (e.g. wave or wind direction), accounting for circularity (i.e. wrap-around at 360°).
circ_mean <- function(x) {
# Remove NAs
x <- x[!is.na(x)]
if (length(x) == 0) {
return(NA_real_)
}
# Convert to radians
radians <- x * pi / 180
# Compute mean of sine and cosine
mean_sin <- mean(sin(radians))
mean_cos <- mean(cos(radians))
# Compute mean angle in degrees
mean_angle <- atan2(mean_sin, mean_cos) * 180 / pi
# Ensure 0–360
if (mean_angle < 0) mean_angle + 360 else mean_angle
}
# Import CAWCR wave energy data for the focal colony
cawcr_wave <- fread("CAWCR_Wave_Hindcast/CAWCR_Waves.csv") %>%
dplyr::filter(colony_name == "West Moncoeur Island") %>%
dplyr::group_by(year, month, day) %>%
dplyr::summarise(wave_energy_max = max(wave_energy, na.rm = TRUE),
wave_direction = circ_mean(wave_direction),
.groups = "drop"
) %>%
dplyr::mutate(date = make_date(year, month, day)) %>%
dplyr::select(date, wave_energy_max, wave_direction)
# Merge wave data with daily BOM data
bom_daily <- left_join(bom_daily, cawcr_wave, by = "date")2.4 BARRA2 Solar data
# Import solar radiation estimates from BARRA2 reanalysis
barra2_solar <- fread("BARRA2_Solar/BARRA_Shortwave_Radiation_daily.csv") %>%
dplyr::filter(colony_name == "West Mancoeur Island") %>%
dplyr::mutate(date = as.Date(time)) %>%
dplyr::select(date, solar_radiation_barra = rsds)
# Combine BARRA2 and BOM solar radiation (prefer BOM where available)
bom_daily <- bom_daily %>%
left_join(barra2_solar, by = "date") %>%
dplyr::mutate(solar_radiation = coalesce(solar_radiation, solar_radiation_barra),
wind_speed_mean_ms = wind_speed_mean / 3.6 # Convert wind speed from km/h to m/s
) %>%
dplyr::select(-solar_radiation_barra, -solar_exposure)2.5 Calculate WBGT
# Calculate WBGT using the Liljegren method (requires radiation, temperature, humidity, and wind)
wbgt_result <- wbgt.Liljegren(tas = bom_daily$air_temperature,
dewp = bom_daily$dewpoint_temperature,
wind = bom_daily$wind_speed_mean_ms,
radiation = bom_daily$solar_radiation,
dates = bom_daily$date,
lon = colony_lon,
lat = colony_lat,
noNAs = TRUE,
swap = TRUE,
hour = FALSE
)
# Add WBGT to the daily weather dataset
bom_daily$wbgt <- wbgt_result$data2.6 Calculate apparent temperature
Version including the effects of temperature, humidity, wind, and radiation:
AT = Ta + 0.348×e − 0.70×ws + 0.70×Q/(ws + 10) − 4.25 where: Ta = Dry bulb temperature (°C) e = Water vapour pressure (hPa) [humidity] ws = Wind speed (m/s) at an elevation of 10 meters Q = Net radiation absorbed per unit area of body surface (w/m2) The vapour pressure can be calculated from the temperature and relative humidity using the equation:
e = rh / 100 × 6.105 × exp ( 17.27 × Ta / ( 237.7 + Ta ) ) where: rh = Relative Humidity [%]
# Calculate relative humidity from temperature and dew point
bom_daily$relative_humidity <- dewp2hurs(tas = bom_daily$air_temperature,
dewp = bom_daily$dewpoint_temperature
)
# Define apparent temperature function (includes temperature, humidity, wind, and radiation)
calc_apparent_temp <- function(Ta, rh, ws, Q) {
e <- rh / 100 * 6.105 * exp(17.27 * Ta / (237.7 + Ta)) # Water vapour pressure (hPa)
AT <- Ta + 0.348 * e - 0.70 * ws + 0.70 * Q / (ws + 10) - 4.25
return(AT)
}
# Apply the formula to all rows
bom_daily$apparent_temperature <- calc_apparent_temp(Ta = bom_daily$air_temperature,
rh = bom_daily$relative_humidity,
ws = bom_daily$wind_speed_mean_ms,
Q = bom_daily$solar_radiation
)2.7 Finalise Dataset and Generate Summary
# Ensure date is in Date format and remove duplicate rows (if any)
bom_daily <- bom_daily %>%
dplyr::mutate(date = as.Date(date)) %>%
dplyr::distinct(date, .keep_all = TRUE) %>%
dplyr::select(season, date, year, month, day,
air_temperature_min, air_temperature_max,
precipitation,
wind_speed_max, wind_speed_mean, gust_speed,
wetbulb_temperature, wbgt, apparent_temperature,
wave_energy_max, wave_direction) %>%
dplyr::arrange(date) %>%
as.data.frame()
# Summary for number of missing values per weather variable, grouped by season to identify starting point of climatology baseline
bom_daily %>%
group_by(season) %>%
summarise(
across(
.cols = -c(date, year, month, day),
.fns = ~ sum(is.na(.))
),
.groups = "drop"
) %>%
DT::datatable(
options = list(
pageLength = 20,
scrollX = TRUE)
)The climatology period used to calculate percentile thresholds will be based on the full extent of our available dataset. For example, for extreme weather indices that rely on maximum wave energy, the climatology will be calculated from the 1979 season through to the final monitoring season for the focal population, which is the 2022 season. Only seasons with no more than approximately 10% missing daily data (i.e., at least around 330 days of data per season) will be included to ensure reliability.
By applying consistent criteria for data completeness, we minimise bias and ensure that the percentile thresholds truly reflect the local climatological context. Furthermore, using an extended climatology period enhances the robustness of extreme event detection, providing a solid foundation for comparative analysis across years and for assessing long-term trends.
3 Calculate Extreme Weather Indices
3.1 Extreme High Temperature Indices
3.1.1 Warm days
Days with daily maximum temperature > 90th percentile
# Calculate
warm_days <- detect_event(ts2clm(data = bom_daily,
x = date,
y = air_temperature_max,
pctile = 90,
climatologyPeriod = c("1970-05-01", "2023-04-30"),
windowHalfWidth = 5),
# These arguments are passed to detect_event(), not ts2clm()
minDuration = 1,
maxGap = 0,
x = date,
y = air_temperature_max,
coldSpells = FALSE)
# Add a new column to daily weather data
bom_daily <- bom_daily %>%
dplyr::mutate(
warm_day = ifelse(
warm_days$climatology$event[match(date,
warm_days$climatology$date)] == TRUE,
warm_days$climatology$air_temperature_max[match(date,
warm_days$climatology$date)],
ifelse(!is.na(air_temperature_max), 0, NA)
)
)
# Plot above/below threshold values during monitoring period
ggplot(bom_daily %>% filter(month %in% monitoring_months, season >= start_season),
aes(x = as.factor(season), y = na_if(warm_day, 0))) +
geom_point(color = "#003161") +
labs(
x = "Season",
y = "Maximum temperature (°C)",
title = "Warm day temperature during monitoring period"
) +
theme_classic() +
scale_y_continuous(breaks = scales::pretty_breaks(n = 10)) +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
3.1.2 Warm nights
Days with daily minimum temperature > 90th percentile
# Calculate
warm_nights <- detect_event(ts2clm(data = bom_daily,
x = date,
y = air_temperature_min,
pctile = 90,
climatologyPeriod = c("1970-05-01", "2023-04-30"),
windowHalfWidth = 5),
# These arguments are passed to detect_event(), not ts2clm()
minDuration = 1,
maxGap = 0,
x = date,
y = air_temperature_min,
coldSpells = FALSE)
# Add a new column to daily weather data
bom_daily <- bom_daily %>%
dplyr::mutate(
warm_night = ifelse(
warm_nights$climatology$event[match(date,
warm_nights$climatology$date)] == TRUE,
warm_nights$climatology$air_temperature_min[match(date,
warm_nights$climatology$date)],
ifelse(!is.na(air_temperature_min), 0, NA)
)
)
# Plot above/below threshold values during monitoring period
ggplot(bom_daily %>% filter(month %in% monitoring_months, season >= start_season),
aes(x = as.factor(season), y = na_if(warm_night, 0))) +
geom_point(color = "#003161") +
labs(
x = "Season",
y = "Minimum temperature (°C)",
title = "Warm night temperature during monitoring period"
) +
theme_classic() +
scale_y_continuous(breaks = scales::pretty_breaks(n = 10)) +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
3.1.3 Atmospheric Heatwave
In the context of the Bureau of Meteorology (BOM) in Australia, A heatwave is when the maximum and minimum temperatures are unusually hot over 3 days. This is compared to the local climate and past weather. The definition focuses on both day and night temperatures being significantly hotter than the usual climate for that location and time of year.
So according to the definition of heatwave, we would have to calculate two threshold (both max temp during the day and min temp at night), and if both thresholds are met (are above 90th percentile) then we can consider it a heatwave.
# First threshold - we are interested in days when max temperature is above 90th percentile for at least 3 consecutive days
max_temp_thresh <- ts2clm(data = bom_daily,
x = date,
y = air_temperature_max,
pctile = 90,
climatologyPeriod = c("1970-05-01", "2023-04-30"),
windowHalfWidth = 5)
# Second threshold based on min temperature
min_temp_thresh <- detect_event(ts2clm(data = bom_daily,
x = date,
y = air_temperature_min,
pctile = 90,
climatologyPeriod = c("1970-05-01", "2023-04-30"),
windowHalfWidth = 5),
# These arguments are passed to detect_event(), not ts2clm()
minDuration = 3,
maxGap = 0,
x = date,
y = air_temperature_min,
protoEvents = TRUE,
coldSpells = FALSE)
# Detect/calculate events using the two pre-calculated thresholds
heatwave <- detect_event(data = max_temp_thresh,
x = date,
y = air_temperature_max,
minDuration = 3,
maxGap = 1,
threshClim2 = min_temp_thresh$event,
minDuration2 = 3,
maxGap2 = 1)
# Add a new column to daily weather data
bom_daily <- bom_daily %>%
dplyr::mutate(
heatwave = ifelse(
heatwave$climatology$event[match(date,
heatwave$climatology$date)] == TRUE,
heatwave$climatology$air_temperature_max[match(date,
heatwave$climatology$date)],
ifelse(!is.na(air_temperature_max), 0, NA)
)
)
# View just a few metrics
DT::datatable(heatwave$event %>%
dplyr::select(event_no, duration, date_start, date_peak, intensity_cumulative_abs, rate_onset, rate_decline))# Bubble plot all the detected events
ggplot(data = heatwave$event, aes(x = date_peak, y = intensity_max)) +
geom_point(aes(size = intensity_cumulative), shape = 21, fill = "salmon", alpha = 0.8) +
labs(x = NULL,
y = "Maximum Intensity [°C] ",
size = "Cumulative Intensity [°C x days]") +
scale_size_continuous(range = c(1, 10),
guide = guide_legend(title.position = "top", direction = "horizontal")) +
theme_classic() +
theme(legend.position = "bottom")
3.2 Extreme Low Temperature Indices
3.2.1 Cool days
Days with maximum temperature < 10th percentile
# Calculate
cool_days <- detect_event(ts2clm(data = bom_daily,
x = date,
y = air_temperature_max,
pctile = 10,
climatologyPeriod = c("1970-05-01", "2023-04-30"),
windowHalfWidth = 5),
# These arguments are passed to detect_event(), not ts2clm()
minDuration = 1,
maxGap = 0,
x = date,
y = air_temperature_max,
coldSpells = TRUE)
# Add a new column to daily weather data
bom_daily <- bom_daily %>%
dplyr::mutate(
cool_day = ifelse(
cool_days$climatology$event[match(date, cool_days$climatology$date)] == TRUE,
air_temperature_max - cool_days$climatology$thresh[match(date, cool_days$climatology$date)],
ifelse(!is.na(air_temperature_max), 0, NA)
))
# Plot above/below threshold values during monitoring period
ggplot(bom_daily %>% filter(month %in% monitoring_months, season >= start_season),
aes(x = as.factor(season), y = na_if(cool_day, 0))) +
geom_point(color = "#003161") +
labs(
x = "Season",
y = "Maximum temperature below threshold (°C)",
title = "Cool day temperature during monitoring period"
) +
theme_classic() +
scale_y_continuous(breaks = scales::pretty_breaks(n = 10)) +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
3.2.2 Cool nights
Days with minimum temperature < 10th percentile
# Calculate
cool_nights <- detect_event(ts2clm(data = bom_daily,
x = date,
y = air_temperature_min,
pctile = 10,
climatologyPeriod = c("1970-05-01", "2023-04-30"),
windowHalfWidth = 5),
# These arguments are passed to detect_event(), not ts2clm()
minDuration = 1,
maxGap = 0,
x = date,
y = air_temperature_min,
coldSpells = TRUE)
# Add a new column to daily weather data
bom_daily <- bom_daily %>%
dplyr::mutate(
cool_night = ifelse(
cool_nights$climatology$event[match(date, cool_nights$climatology$date)] == TRUE,
air_temperature_min - cool_nights$climatology$thresh[match(date, cool_nights$climatology$date)],
ifelse(!is.na(air_temperature_min), 0, NA)
))
# Plot above/below threshold values during monitoring period
ggplot(bom_daily %>% filter(month %in% monitoring_months, season >= start_season),
aes(x = as.factor(season), y = na_if(cool_night, 0))) +
geom_point(alpha = 0.6, color = "#003161") +
labs(
x = "Season",
y = "Minimum temperature below threshold (°C)",
title = "Cool night temperature during monitoring period"
) +
theme_classic() +
scale_y_continuous(breaks = scales::pretty_breaks(n = 10)) +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
3.2.3 Atmospheric Coldwave
Using a reverse definition of heatwave, we can define a coldwave as a period of at least 3 consecutive days when both minimum and maximum temperature are below the 10th percentile.
# First threshold - we are interested in nights when min temperature is below 10th percentile for at least 3 consecutive days
min_temp_thresh <- ts2clm(data = bom_daily,
x = date,
y = air_temperature_min,
pctile = 10,
climatologyPeriod = c("1970-05-01", "2023-04-30"),
windowHalfWidth = 5)
# Second threshold based on max temperature
max_temp_thresh <- detect_event(ts2clm(data = bom_daily,
x = date,
y = air_temperature_max,
pctile = 10,
climatologyPeriod = c("1970-05-01", "2023-04-30"),
windowHalfWidth = 5),
# These arguments are passed to detect_event(), not ts2clm()
minDuration = 3,
maxGap = 0,
x = date,
y = air_temperature_max,
protoEvents = TRUE,
coldSpells = TRUE)
# Detect/calculate events using the two pre-calculated thresholds
coldwave <- detect_event(data = min_temp_thresh,
x = date,
y = air_temperature_min,
minDuration = 3,
maxGap = 1,
threshClim2 = max_temp_thresh$event,
minDuration2 = 3,
maxGap2 = 1,
joinAcrossGaps = TRUE,
coldSpells = TRUE)
# Add a new column to daily weather data
bom_daily <- bom_daily %>%
dplyr::mutate(
coldwave = ifelse(
coldwave$climatology$event[match(date, coldwave$climatology$date)] == TRUE,
air_temperature_min - coldwave$climatology$thresh[match(date, coldwave$climatology$date)],
ifelse(!is.na(air_temperature_min), 0, NA)
))
# View just a few metrics
DT::datatable(coldwave$event %>%
dplyr::select(event_no, duration, date_start, date_peak, intensity_cumulative_abs, rate_onset, rate_decline))# Bubble plot all the detected events
ggplot(data = coldwave$event, aes(x = date_peak, y = intensity_max)) +
geom_point(aes(size = intensity_cumulative), shape = 21, fill = "salmon", alpha = 0.8) +
labs(x = NULL,
y = "Maximum Intensity [°C]",
size = "Cumulative Intensity [°C x days]") +
scale_size_continuous(range = c(1, 10),
guide = guide_legend(title.position = "top", direction = "horizontal")) +
theme_classic() +
theme(legend.position = "bottom")
3.3 Extreme Precipitation Indices
3.3.1 Wet, Heavy, and Very Heavy Rain Days
Wet day = daily precipitation ≥ 1 mm Heavy rain = daily precipitation ≥ 10 mm Very heavy rain = daily precipitation ≥ 30 mm
# Categorise rainfall days based on thresholds (leave as NA if no data)
bom_daily <- bom_daily %>%
dplyr::mutate(wet_day = if_else(is.na(precipitation), NA_real_,
if_else(precipitation >= 1, precipitation, 0)),
heavy_rain_day = if_else(is.na(precipitation), NA_real_,
if_else(precipitation >= 10, precipitation, 0)),
very_heavy_rain_day = if_else(is.na(precipitation), NA_real_,
if_else(precipitation >= 30, precipitation, 0))
)
# Plot rainfall types during monitoring period
ggplot(bom_daily %>% dplyr::filter(month %in% monitoring_months, season >= start_season),
aes(x = as.factor(season))
) +
geom_bar(aes(y = wet_day, fill = "Wet day"), stat = "identity") +
geom_bar(aes(y = heavy_rain_day, fill = "Heavy rain day"), stat = "identity") +
geom_bar(aes(y = very_heavy_rain_day, fill = "Very heavy rain day"), stat = "identity") +
scale_fill_manual(values = c("Wet day" = "#96C9F4",
"Heavy rain day" = "#3FA2F6",
"Very heavy rain day" = "#0F67B1")
) +
labs(x = "Season",
y = "Precipitation (mm)",
title = "Extreme precipitation days during monitoring period"
) +
theme_classic() +
theme(
axis.text.x = element_text(angle = 45, hjust = 1),
legend.position = "bottom",
legend.title = element_blank()
)
3.3.2 Extremely wet day precipitation
When daily precipitation > 99th percentile
# Assign threshold
ewdp_climatology <- ts2clm(data = bom_daily,
x = date,
y = precipitation,
pctile = 99,
climatologyPeriod = c("1970-05-01", "2023-04-30"),
windowHalfWidth = 5)
# Detect the events in a time series
ewdp <- detect_event(data = ewdp_climatology,
x = date,
y = precipitation,
minDuration = 1,
maxGap = 0,
coldSpells = FALSE
)
# Add a new column to daily weather data
bom_daily <- bom_daily %>%
dplyr::mutate(
ewdp = ifelse(
ewdp$climatology$event[match(date,
ewdp$climatology$date)] == TRUE,
ewdp$climatology$precipitation[match(date,
ewdp$climatology$date)],
ifelse(!is.na(precipitation), 0, NA)
)
)
# Plot above/below threshold values during monitoring period
ggplot(bom_daily %>% filter(month %in% monitoring_months, season >= start_season),
aes(x = as.factor(season), y = na_if(ewdp, 0))) +
geom_point(alpha = 0.6, color = "#003161") +
labs(
x = "Season",
y = "Precipitation (mm)",
title = "Extremely wet day precipitation during monitoring period"
) +
theme_classic() +
scale_y_continuous(breaks = scales::pretty_breaks(n = 10)) +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
3.3.3 Very wet day precipitation
When daily precipitation > 95th percentile
# Assign threshold
vwdp_climatology <- ts2clm(data = bom_daily,
x = date,
y = precipitation,
pctile = 95,
climatologyPeriod = c("1970-05-01", "2023-04-30"),
windowHalfWidth = 5)
# Detect the events in a time series
vwdp <- detect_event(data = vwdp_climatology,
x = date,
y = precipitation,
minDuration = 1,
maxGap = 0,
coldSpells = FALSE
)
# Add a new column to daily weather data
bom_daily <- bom_daily %>%
dplyr::mutate(
vwdp = ifelse(
vwdp$climatology$event[match(date,
vwdp$climatology$date)] == TRUE,
vwdp$climatology$precipitation[match(date,
vwdp$climatology$date)],
ifelse(!is.na(precipitation), 0, NA)
)
)
# Plot above/below threshold values during monitoring period
ggplot(bom_daily %>% filter(month %in% monitoring_months, season >= start_season),
aes(x = as.factor(season), y = na_if(vwdp, 0))) +
geom_point(alpha = 0.6, color = "#003161") +
labs(
x = "Season",
y = "Precipitation (mm)",
title = "Very wet day precipitation during monitoring period"
) +
theme_classic() +
scale_y_continuous(breaks = scales::pretty_breaks(n = 10)) +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
3.4 Extreme Wind Index
Note: When wind speed data unavailable or missing then gust speed data was used
3.4.1 Extreme wind
Sustained gale force winds – 63 km/h or more
OR
Damaging winds are wind gusts – 90 km/h or more, except In Tasmania where they are issued for gusts of 80 km/h or more in easterlies and 100 km/h or more in westerlies.
# Set a threshold
extreme_wind <- exceedance(data = bom_daily,
x = date,
y = wind_speed_max,
threshold = 63,
minDuration = 1,
maxGap = 0,
below = FALSE)
# Add a new column to daily weather data
bom_daily <- bom_daily %>%
dplyr::mutate(
extreme_wind_day = ifelse(
extreme_wind$threshold$exceedance[match(date,
extreme_wind$threshold$date)] == TRUE,
extreme_wind$threshold$wind_speed_max[match(date,
extreme_wind$threshold$date)],
ifelse(!is.na(wind_speed_max), 0, NA)
)
)
# Plot above/below threshold values during monitoring period
ggplot(bom_daily %>% filter(month %in% monitoring_months, season >= start_season),
aes(x = as.factor(season), y = na_if(extreme_wind_day, 0))) +
geom_point(alpha = 0.6, color = "#003161") +
labs(
x = "Season",
y = "Wind speed (km/h)",
title = "Extreme wind speed during monitoring period"
) +
theme_classic() +
scale_y_continuous(breaks = scales::pretty_breaks(n = 10)) +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
3.5 Extreme Wave Index
3.5.1 Extreme wave energy
Days when maximum wave energy > 90th percentile
# Calculate
extreme_wave_energy <- detect_event(ts2clm(data = bom_daily,
x = date,
y = wave_energy_max,
pctile = 90,
climatologyPeriod = c("1979-05-01", "2023-04-30"),
windowHalfWidth = 5),
# These arguments are passed to detect_event(), not ts2clm()
minDuration = 1,
maxGap = 0,
x = date,
y = wave_energy_max,
coldSpells = FALSE)
# Add a new column to daily weather data
bom_daily <- bom_daily %>%
dplyr::mutate(
extreme_wave_energy_day = ifelse(
extreme_wave_energy$climatology$event[match(date,
extreme_wave_energy$climatology$date)] == TRUE,
extreme_wave_energy$climatology$wave_energy_max[match(date,
extreme_wave_energy$climatology$date)],
ifelse(!is.na(wave_energy_max), 0, NA)
)
)
# Plot above/below threshold values during monitoring period
ggplot(bom_daily %>% filter(month %in% monitoring_months, season >= start_season),
aes(x = as.factor(season), y = na_if(extreme_wave_energy_day, 0))) +
geom_point(alpha = 0.6, color = "#003161") +
labs(
x = "Season",
y = "Wave energy (kW/m)",
title = "Extreme wave enegy during monitoring period"
) +
theme_classic() +
scale_y_continuous(breaks = scales::pretty_breaks(n = 10)) +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
3.6 Heat Stress Indices
3.6.1 Extreme WBT
Days when daily wet bulb temperature > 90th percentile
# Calculate
extreme_wbt <- detect_event(ts2clm(data = bom_daily,
x = date,
y = wetbulb_temperature,
pctile = 90,
climatologyPeriod = c("1972-05-01", "2023-04-30"),
windowHalfWidth = 5),
# These arguments are passed to detect_event(), not ts2clm()
minDuration = 1,
maxGap = 0,
x = date,
y = wetbulb_temperature,
coldSpells = FALSE)
# Add a new column to daily weather data
bom_daily <- bom_daily %>%
dplyr::mutate(
extreme_wbt_day = ifelse(
extreme_wbt$climatology$event[match(date,
extreme_wbt$climatology$date)] == TRUE,
extreme_wbt$climatology$wetbulb_temperature[match(date,
extreme_wbt$climatology$date)],
ifelse(!is.na(wetbulb_temperature), 0, NA)
)
)
# Plot above/below threshold values during monitoring period
ggplot(bom_daily %>% filter(month %in% monitoring_months, season >= start_season),
aes(x = as.factor(season), y = na_if(extreme_wbt_day, 0))) +
geom_point(alpha = 0.6, color = "#003161") +
labs(
x = "Season",
y = "WBT (°C)",
title = "Extreme WBT during monitoring period"
) +
theme_classic() +
scale_y_continuous(breaks = scales::pretty_breaks(n = 10)) +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
3.6.2 Extreme WBGT
Days when daily WBGT > 90th percentile
# Calculate
extreme_wbgt <- detect_event(ts2clm(data = bom_daily,
x = date,
y = wbgt,
pctile = 90,
climatologyPeriod = c("1979-05-01", "2023-04-30"),
windowHalfWidth = 5),
# These arguments are passed to detect_event(), not ts2clm()
minDuration = 1,
maxGap = 0,
x = date,
y = wbgt,
coldSpells = FALSE)
# Add a new column to daily weather data
bom_daily <- bom_daily %>%
dplyr::mutate(
extreme_wbgt_day = ifelse(
extreme_wbgt$climatology$event[match(date,
extreme_wbgt$climatology$date)] == TRUE,
extreme_wbgt$climatology$wbgt[match(date,
extreme_wbgt$climatology$date)],
ifelse(!is.na(wbgt), 0, NA)
)
)
# Plot above/below threshold values during monitoring period
ggplot(bom_daily %>% filter(month %in% monitoring_months, season >= start_season),
aes(x = as.factor(season), y = na_if(extreme_wbgt_day, 0))) +
geom_point(alpha = 0.6, color = "#003161") +
labs(
x = "Season",
y = "WBGT (°C)",
title = "Extreme WBGT during monitoring period"
) +
theme_classic() +
scale_y_continuous(breaks = scales::pretty_breaks(n = 10)) +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
3.6.3 Extreme AT
Days when daily apparent temperature > 90th percentile
# Calculate
extreme_at <- detect_event(ts2clm(data = bom_daily,
x = date,
y = apparent_temperature,
pctile = 90,
climatologyPeriod = c("1979-05-01", "2023-04-30"),
windowHalfWidth = 5),
# These arguments are passed to detect_event(), not ts2clm()
minDuration = 1,
maxGap = 0,
x = date,
y = apparent_temperature,
coldSpells = FALSE)
# Add a new column to daily weather data
bom_daily <- bom_daily %>%
dplyr::mutate(
extreme_at_day = ifelse(
extreme_at$climatology$event[match(date,
extreme_at$climatology$date)] == TRUE,
extreme_at$climatology$apparent_temperature[match(date,
extreme_at$climatology$date)],
ifelse(!is.na(apparent_temperature), 0, NA)
)
)
# Plot above/below threshold values during monitoring period
ggplot(bom_daily %>% filter(month %in% monitoring_months, season >= start_season),
aes(x = as.factor(season), y = na_if(extreme_at_day, 0))) +
geom_point(alpha = 0.6, color = "#003161") +
labs(
x = "Season",
y = "AT (°C)",
title = "Extreme AT during monitoring period"
) +
theme_classic() +
scale_y_continuous(breaks = scales::pretty_breaks(n = 10)) +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
3.7 Wind Chill Index
3.7.1 Extreme wind chill days
Days when daily apparent temperature < 10th percentile
# Calculate number of days below 10th percentile apparent temperature
extreme_wind_chill <- detect_event(ts2clm(data = bom_daily,
x = date,
y = apparent_temperature,
pctile = 10,
climatologyPeriod = c("1979-05-01", "2023-04-30"),
windowHalfWidth = 5),
# These arguments are passed to detect_event(), not ts2clm()
minDuration = 1,
maxGap = 0,
x = date,
y = apparent_temperature,
coldSpells = TRUE)
# Add a new column to daily weather data
bom_daily <- bom_daily %>%
dplyr::mutate(
extreme_wind_chill_day = ifelse(
extreme_wind_chill$climatology$event[match(date, extreme_wind_chill$climatology$date)] == TRUE,
apparent_temperature - extreme_wind_chill$climatology$thresh[match(date, extreme_wind_chill$climatology$date)],
ifelse(!is.na(apparent_temperature), 0, NA)
))
# Plot above/below threshold values during monitoring period
ggplot(bom_daily %>% filter(month %in% monitoring_months, season >= start_season),
aes(x = as.factor(season), y = na_if(extreme_wind_chill_day, 0))) +
geom_point(alpha = 0.6, color = "#003161") +
labs(
x = "Season",
y = "Apparent temperature below threshold (°C)",
title = "Extreme wind chill during monitoring period"
) +
theme_classic() +
scale_y_continuous(breaks = scales::pretty_breaks(n = 10)) +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
4 Save daily weather data
# Assign colony name to each record
bom_daily <- bom_daily %>%
dplyr::mutate(colony_name = "West Moncoeur Island") %>%
dplyr::select(colony_name,
season, date,
warm_day, warm_night, heatwave,
cool_day, cool_night, coldwave,
wet_day, heavy_rain_day, very_heavy_rain_day, ewdp, vwdp,
extreme_wind_day,
extreme_wbt_day, extreme_wbgt_day, extreme_at_day,
extreme_wind_chill_day,
extreme_wave_energy_day, wave_direction
)
# Save the cleaned and annotated data to an Excel file
write_xlsx(bom_daily,
file = "Breeding_colony_ewes/West_Moncoeur_ewes.xlsx",
col_names = TRUE,
row_names = FALSE
)
# View dataset summary
summary(bom_daily)## colony_name season date warm_day
## Length:20210 Min. :1969 Min. :1970-01-01 Min. : 0.000
## Class :character 1st Qu.:1983 1st Qu.:1983-11-01 1st Qu.: 0.000
## Mode :character Median :1996 Median :1997-08-31 Median : 0.000
## Mean :1996 Mean :1997-08-31 Mean : 2.512
## 3rd Qu.:2010 3rd Qu.:2011-07-01 3rd Qu.: 0.000
## Max. :2024 Max. :2025-05-01 Max. :42.000
## NA's :220
## warm_night heatwave cool_day cool_night
## Min. : 0.00 Min. : 0.0000 Min. :-3.56350 Min. :-6.6371
## 1st Qu.: 0.00 1st Qu.: 0.0000 1st Qu.: 0.00000 1st Qu.: 0.0000
## Median : 0.00 Median : 0.0000 Median : 0.00000 Median : 0.0000
## Mean : 1.65 Mean : 0.1469 Mean :-0.07106 Mean :-0.1116
## 3rd Qu.: 0.00 3rd Qu.: 0.0000 3rd Qu.: 0.00000 3rd Qu.: 0.0000
## Max. :27.10 Max. :36.7000 Max. : 0.00000 Max. : 0.0000
## NA's :353 NA's :220 NA's :220 NA's :353
## coldwave wet_day heavy_rain_day very_heavy_rain_day
## Min. :-6.27480 Min. : 0.000 Min. : 0.000 Min. : 0.0000
## 1st Qu.: 0.00000 1st Qu.: 0.000 1st Qu.: 0.000 1st Qu.: 0.0000
## Median : 0.00000 Median : 0.000 Median : 0.000 Median : 0.0000
## Mean :-0.01432 Mean : 2.937 Mean : 1.918 Mean : 0.5262
## 3rd Qu.: 0.00000 3rd Qu.: 2.600 3rd Qu.: 0.000 3rd Qu.: 0.0000
## Max. : 0.70770 Max. :123.200 Max. :123.200 Max. :123.2000
## NA's :353 NA's :217 NA's :217 NA's :217
## ewdp vwdp extreme_wind_day extreme_wbt_day
## Min. : 0.0000 Min. : 0.000 Min. : 0.00 Min. : 0.000
## 1st Qu.: 0.0000 1st Qu.: 0.000 1st Qu.: 0.00 1st Qu.: 0.000
## Median : 0.0000 Median : 0.000 Median : 0.00 Median : 0.000
## Mean : 0.4777 Mean : 1.323 Mean : 12.64 Mean : 1.799
## 3rd Qu.: 0.0000 3rd Qu.: 0.000 3rd Qu.: 0.00 3rd Qu.: 0.000
## Max. :123.2000 Max. :123.200 Max. :146.20 Max. :27.000
## NA's :217 NA's :217 NA's :343 NA's :1260
## extreme_wbgt_day extreme_at_day extreme_wind_chill_day
## Min. : 0.00 Min. : 0.000 Min. :-18.946
## 1st Qu.: 0.00 1st Qu.: 0.000 1st Qu.: 0.000
## Median : 0.00 Median : 0.000 Median : 0.000
## Mean : 1.76 Mean : 2.638 Mean : -0.311
## 3rd Qu.: 0.00 3rd Qu.: 0.000 3rd Qu.: 0.000
## Max. :27.51 Max. :47.444 Max. : 0.000
## NA's :3736 NA's :3736 NA's :3736
## extreme_wave_energy_day wave_direction
## Min. : 0.000 Min. : 0.1392
## 1st Qu.: 0.000 1st Qu.:181.0028
## Median : 0.000 Median :235.2480
## Mean : 8.692 Mean :207.4673
## 3rd Qu.: 0.000 3rd Qu.:246.6427
## Max. :329.200 Max. :359.1711
## NA's :3287 NA's :3287