Code
load("data/wt.growth.array.RData")Purpose: construct an individual based model to simulate how fish move to track temperature-based growth opportunities across a habitat network, the resulting effects on growth, and the implications for long-term population dynamics.
Source dependencies
Load pre-calculated growth
load("data/wt.growth.array.RData")Configuration options
abiotic_only: fish can only sense temperature-dependent GP, regardless of which habitat is occupieddensity_current: fish sense density-dependent GP in current habitat, and compare to abiotic (temp-based) GP in the alternative habitatdensity_all: fish can sense density-dependent GP in all habitatsSenstive parameters:
Notes:
sense_environment == "density_all", the density used for the alternative patch is the current pre-movement density (i.e., what the fish can observe before anyone decides to move that day). This is the most tractable approximation — computing post-movement density would require solving a joint decision problem.move_threshold = Inf to formally unify all three strategies under one mechanism, rather than branching by strategy label — keeps the code cleaner if we expand to more strategies later.To do:
Three movement strategies are simulated: fish that remain year-round in the warm patch (resident_warm), fish that remain year-round in the cold patch (resident_cold), and fish that choose the better-growing patch each day (optimal_mover). Ration sizes match the unequal-ration scenario above.
Configuration notes:
Misc. objects
waterTemps <- cbind("pid" = seq(1, length(seq(0.1, 25, 0.1))),"WT" = seq(0.1, 25, 0.1))
rations <- seq(0.001, 0.4, 0.001)
weights <- seq(0.25, 1500, 0.25)Configure and initialize fish
# Configuration options:
move_stochastic <- "prob" # individual movement stochasticity: options = "none", "prob", "indiv"
food_densdepen <- "hyperbolic" # density dependence: options = "fullerton", "hyperbolic
sense_environment <- "density_current" # how omniscient are fish to temperature and density-dependent growth across the habitat patches?
# - "abiotic_only" = Omniscient to abiotic (temp-based) GP only...this is how it currently is.
# - "density_current" = Sense density dependent GP in current habitat, and compare to abiotic GP in the alternative habitat (perhaps the most biologically realistic)
# - "density_all" = Omniscient to density dependent GP in all habitats
# misc. parameters
n_fish_per_strat <- 50 # fish per strategy
start_wt <- 0.5 # initial weight (g)
wt_sd <- 0.05 # SD of starting weight
MaxDensity4Growth <- 50 # growth is not depressed further above this density (currently this is arbitary)
movecost_c <- 0.025 # movement cost allometric function: `c` = scaling constant; `
movecost_b <- 0.6 # movement cost allometric function `a` = decay exponent (higher = steeper drop-off)
sigma_bold <- 0.002 # SD of boldness distribution, for dispersal propensity (g/g/d units)
tau <- 0.001 # sensitivity to growth difference (for probabilistic/softmax variation in movement)
T1_mort <- 30 # temperature (°C) at which daily survival from thermal stress = 0.1
T9_mort <- 25.8 # temperature (°C) at which daily survival from thermal stress = 0.9
K9_starv <- 0.55 # relative condition (W_current/W_peak) at which starvation survival = 0.9
K1_starv <- 0.45 # relative condition at which starvation survival = 0.1
K_warm <- K_cold <- 500 # For hyperbolic reduction, strength of density dependence/half-saturation density: fish density at which ration is halved
# Fullerton has movement cost coded slightly differently, where movement cost is a function of the instantaneous growth rate, distance moved, and a constant...rather than simply a fixed cost as is the case here. But because we only have two patches that are spatially implicit, we can ignore this more complex parameterization...at least for now.
# ration_warm = 0.10, ration_cold = 0.07 (defined in "Unequal ration" section above)
# Lookup sequences — identical to the axes of the wt.growth array
wt_seq_ibm <- waterTemps[, "WT"] # seq(0.1, 25, 0.1), 250 values
ra_seq_ibm <- rations # seq(0.001, 0.4, 0.001), 151 values
# set.seed(7843)
# initialize fish
fish_pop <- bind_rows(
tibble(strategy = "resident_warm", patch = "warm",
weight = pmax(min(weights), rnorm(n_fish_per_strat, start_wt, wt_sd))),
tibble(strategy = "resident_cold", patch = "cold",
weight = pmax(min(weights), rnorm(n_fish_per_strat, start_wt, wt_sd))),
# optimal movers are randomly placed into either warm or cold patches
tibble(strategy = "optimal_mover", patch = sample(c("warm", "cold"), size = n_fish_per_strat, replace = TRUE), #"warm",
weight = pmax(min(weights), rnorm(n_fish_per_strat, start_wt, wt_sd)))) %>%
mutate(pid = row_number(),
# ration = if_else(patch == "warm", ration_warm, ration_cold),
# Rations are calculated in the loop as functions of temperature and body size
cmax_allometric = NA,
pcmax_baseline = NA,
pcmax_adjusted = NA,
pcmax_adjusted_dd = NA,
func_temp = NA,
ration = NA,
# Individual movement threshold — drawn once, fixed for life
# Positive = reluctant to move (needs a clear advantage)
# Negative = bold/prone to move (moves even when slightly disadvantaged)
move_threshold = c(rep(Inf, n_fish_per_strat*2), # residents never move
rnorm(n_fish_per_strat, mean = 0, sd = sigma_bold)),
peak_weight = weight, # track historical max weight for condition factor
age_days = 0L, # age in days, incremented each iteration independent of d
prob_surv = 1, survive = 1) %>%
group_by(patch) %>% mutate(density = n()) %>% ungroup()
fish_pop# A tibble: 150 × 16
strategy patch weight pid cmax_allometric pcmax_baseline pcmax_adjusted
<chr> <chr> <dbl> <int> <lgl> <lgl> <lgl>
1 resident_wa… warm 0.451 1 NA NA NA
2 resident_wa… warm 0.448 2 NA NA NA
3 resident_wa… warm 0.541 3 NA NA NA
4 resident_wa… warm 0.431 4 NA NA NA
5 resident_wa… warm 0.435 5 NA NA NA
6 resident_wa… warm 0.461 6 NA NA NA
7 resident_wa… warm 0.465 7 NA NA NA
8 resident_wa… warm 0.539 8 NA NA NA
9 resident_wa… warm 0.481 9 NA NA NA
10 resident_wa… warm 0.508 10 NA NA NA
# ℹ 140 more rows
# ℹ 9 more variables: pcmax_adjusted_dd <lgl>, func_temp <lgl>, ration <lgl>,
# move_threshold <dbl>, peak_weight <dbl>, age_days <int>, prob_surv <dbl>,
# survive <dbl>, density <int>
For each day of year, optimal movers compare the bioenergetics growth rate at both patches — the vectorised equivalent of calling fncGrowthPossible() for each fish — and switch only when the movement-cost-penalised gain in the alternative patch exceeds staying (but this may differ among individuals depending on how movement stochasticity is configured). Warm and cold patch residents stay in their pre-defined patch. fncGrowthFish() then looks up the actual growth rate for every fish at their current patch, weight, and ration, and weights are updated accordingly.
n_days <- nrow(habitat_df) # number of days in the simulation
n_fish <- nrow(fish_pop) # number of fish in the simulation
fish_pop_init <- fish_pop # snapshot of full population before any mortality
# Pre-allocate storage (rows = fish pid, columns = days)
# Rows are indexed by fish pid (1:n_fish), which is stable even as fish die.
# Dead fish slots remain NA for all days after death.
ggd_matrix <- matrix(NA_real_, nrow = n_fish, ncol = n_days) # standardized growth rates experienced
gd_matrix <- matrix(NA_real_, nrow = n_fish, ncol = n_days) # absolute growth rates
temp_matrix <- matrix(NA_real_, nrow = n_fish, ncol = n_days) # water temps experienced
patch_matrix <- matrix(NA_character_, nrow = n_fish, ncol = n_days) # patch occupied
mass_matrix <- matrix(NA_real_, nrow = n_fish, ncol = n_days) # weight/mass trajectories
surv_matrix <- matrix(NA_integer_, nrow = n_fish, ncol = n_days) # survived (1) or died (0) each day
pcmax_base_matrix <- matrix(NA_integer_, nrow = n_fish, ncol = n_days) # baseline P_Cmax threshold
pcmax_adj_matrix <- matrix(NA_integer_, nrow = n_fish, ncol = n_days) # P_Cmax adjusted for temperature dependence
pcmax_adjdd_matrix <- matrix(NA_integer_, nrow = n_fish, ncol = n_days) # P_Cmax adjusted for tempderature and density dependence
func_temp_matrix <- matrix(NA_integer_, nrow = n_fish, ncol = n_days) # Temperature dependence function
ration_matrix <- matrix(NA_integer_, nrow = n_fish, ncol = n_days) # ration size/consumption in g/d/d
condition_matrix <- matrix(NA_real_, nrow = n_fish, ncol = n_days) # relative condition (W_current / W_peak)
age_matrix <- matrix(NA_real_, nrow = n_fish, ncol = n_days) # age
switches <- integer(n_fish) # count patch switches per fish (indexed by pid)
for (d in 1:n_days) {
t <- habitat_df$dayofsim[d] # day of simulation
fish_pop$age_days <- fish_pop$age_days + 1L # increment age for all living fish
# 1. GET/FIND PATCH TEMPERATURE AND RATION -----------------------------------------------------
# Temperature indices for this day — shared by all fish
T_warm <- get_patchtemp(t, "warm") # get warm patch temp on day t
T_cold <- get_patchtemp(t, "cold") # get cold patch temp on day t
wt_idx_warm <- which.min(abs(wt_seq_ibm - T_warm)) # water temp index for warm patch on day t
wt_idx_cold <- which.min(abs(wt_seq_ibm - T_cold)) # water temp index for cold patch on day t
# Ration indices for this day - shared by all fish
# R_warm <- get_patchration(t, "warm")
# R_cold <- get_patchration(t, "cold")
# ra_idx_warm <- which.min(abs(ra_seq_ibm - R_warm)) # ration index for warm patch on day t
# ra_idx_cold <- which.min(abs(ra_seq_ibm - R_cold)) # ration index for cold patch on day t
# Calculate habitat, temperature, and body size dependent rations following convo. with Jonny
fish_pop <- fish_pop %>%
mutate(func_temp = ifelse(patch == "warm", fncTempDepend(T_warm), fncTempDepend(T_cold)),
pcmax_baseline = ifelse(patch == "warm", get_patchpcmax(t, "warm"), get_patchpcmax(t, "cold")),
pcmax_adjusted = ifelse(func_temp < pcmax_baseline, func_temp, pcmax_baseline),
cmax_allometric = fncAllomCmax(weight)
# ration = cmax_allometric * pcmax_adjusted
)
# 2. CHOOSE PATCH: OPTIMAL MOVERS ---------------------------------------------------------------
# Mirrors fncGrowthPossible() logic, vectorized across all movers at once.
# Patch choice senses baseline temperature and ration, but not density
mover_rows <- which(fish_pop$strategy == "optimal_mover") # get row indices for optimal movers
if (length(mover_rows) > 0) {
# Mass indices for each mover (clamped to array bounds)
ma_idx_vec <- pmax(1L, pmin(4500L, round(fish_pop$weight[mover_rows]))) # get row index for current mass
## 2.A.
in_warm <- fish_pop$patch[mover_rows] == "warm" # is the fish in warm patch? T/F
move_cost_vec <- fncMoveCost_allometric(fish_pop$weight[mover_rows], c = movecost_c, b = movecost_b) # calculate size-dependent cost of movement
# Pre-compute each mover's hypothetical ration in BOTH patches for patch choice sensing.
# This initial step is done without accounting for the effect of density on p_cmax/ration
# pcmax scalars are day-level constants; cmax_allometric is already in fish_pop from step 1.
pcmax_warm_adj <- min(fncTempDepend(T_warm), get_patchpcmax(t, "warm"))
pcmax_cold_adj <- min(fncTempDepend(T_cold), get_patchpcmax(t, "cold"))
ra_warm_vec <- fish_pop$cmax_allometric[mover_rows] * pcmax_warm_adj
ra_cold_vec <- fish_pop$cmax_allometric[mover_rows] * pcmax_cold_adj
ra_idx_warm_vec <- pmax(1L, pmin(400L, map_int(ra_warm_vec, ~which.min(abs(ra_seq_ibm - .x)))))
ra_idx_cold_vec <- pmax(1L, pmin(400L, map_int(ra_cold_vec, ~which.min(abs(ra_seq_ibm - .x)))))
if (sense_environment == "abiotic_only") {
### 2.A.1. Individuals sense only temperature-based growth potential across all habitats
g_warm_vec <- wt.growth[cbind(wt_idx_warm, ra_idx_warm_vec, ma_idx_vec)]
g_cold_vec <- wt.growth[cbind(wt_idx_cold, ra_idx_cold_vec, ma_idx_vec)]
g_stay <- ifelse(in_warm, g_warm_vec, g_cold_vec) # growth if staying in current patch
g_move_net <- ifelse(in_warm, g_cold_vec - move_cost_vec, g_warm_vec - move_cost_vec) # growth if moving to alternate patch
} else if (sense_environment == "density_current") {
### 2.A.2. Individuals sense density-dependent GP in current habitat, abiotic GP in alternative habitat
# Density-adjusted individual rations for each patch (hyperbolic: Cmax * P_cmax * (K / (K + N)))
# Adjust P_Cmax by density to effects of body size on the density penalty
n_warm <- sum(fish_pop$patch == "warm")
n_cold <- sum(fish_pop$patch == "cold")
ra_warm_dd_vec <- fish_pop$cmax_allometric[mover_rows] * pcmax_warm_adj * (K_warm / (K_warm + n_warm - 1))
ra_cold_dd_vec <- fish_pop$cmax_allometric[mover_rows] * pcmax_cold_adj * (K_cold / (K_warm + n_cold - 1))
ra_idx_warm_dd_vec <- pmax(1L, pmin(400L, map_int(ra_warm_dd_vec, ~which.min(abs(ra_seq_ibm - .x)))))
ra_idx_cold_dd_vec <- pmax(1L, pmin(400L, map_int(ra_cold_dd_vec, ~which.min(abs(ra_seq_ibm - .x)))))
# Warm fish sense dd-adjusted warm / abiotic cold; cold fish sense abiotic warm / dd-adjusted cold
g_warm_vec <- wt.growth[cbind(wt_idx_warm, ifelse(in_warm, ra_idx_warm_dd_vec, ra_idx_warm_vec), ma_idx_vec)]
g_cold_vec <- wt.growth[cbind(wt_idx_cold, ifelse(in_warm, ra_idx_cold_vec, ra_idx_cold_dd_vec), ma_idx_vec)]
g_stay <- ifelse(in_warm, g_warm_vec, g_cold_vec)
g_move_net <- ifelse(in_warm, g_cold_vec - move_cost_vec, g_warm_vec - move_cost_vec)
} else if (sense_environment == "density_all") {
### 2.A.3. Individuals sense density-dependent GP across all habitats
# Density-adjusted individual rations for each patch (hyperbolic: Cmax * P_cmax * (K / (K + N)))
# Adjust P_Cmax by density to effects of body size on the density penalty
n_warm <- sum(fish_pop$patch == "warm")
n_cold <- sum(fish_pop$patch == "cold")
ra_warm_dd_vec <- fish_pop$cmax_allometric[mover_rows] * pcmax_warm_adj * (K_warm / (K_warm + n_warm - 1))
ra_cold_dd_vec <- fish_pop$cmax_allometric[mover_rows] * pcmax_cold_adj * (K_cold / (K_warm + n_cold - 1))
ra_idx_warm_dd_vec <- pmax(1L, pmin(400L, map_int(ra_warm_dd_vec, ~which.min(abs(ra_seq_ibm - .x)))))
ra_idx_cold_dd_vec <- pmax(1L, pmin(400L, map_int(ra_cold_dd_vec, ~which.min(abs(ra_seq_ibm - .x)))))
# Both patches sensed with density-adjusted individual rations
g_warm_vec <- wt.growth[cbind(wt_idx_warm, ra_idx_warm_dd_vec, ma_idx_vec)]
g_cold_vec <- wt.growth[cbind(wt_idx_cold, ra_idx_cold_dd_vec, ma_idx_vec)]
g_stay <- ifelse(in_warm, g_warm_vec, g_cold_vec)
g_move_net <- ifelse(in_warm, g_cold_vec - move_cost_vec, g_warm_vec - move_cost_vec)
}
prev_patch <- fish_pop$patch[mover_rows]
## 2.B. Impose stochasticity in movement
if (move_stochastic == "none") {
### 2.B.1. Deterministic: All movers do the same thing
# Update patch based on whether moving is beneficial.
# 1. If fish in is warm patch and growth potential of moving exceeds growth potential of staying, move to cold.
# 2. If fish in is cold patch and growth potential of moving exceeds growth potential of staying, move to warm.
fish_pop$patch[mover_rows] <- case_when(
in_warm & g_move_net > g_stay ~ "cold",
!in_warm & g_move_net > g_stay ~ "warm",
TRUE ~ fish_pop$patch[mover_rows]
)
} else if (move_stochastic == "prob") {
### 2.B.2. Probabilistic (softmax) rule: Instead of a hard threshold, fish switch with a probability that increases with the growth advantage. One parameter: τ (sensitivity; small = nearly deterministic, large = nearly random).
# Use cost-adjusted net growth rates: staying is free, moving incurs move_cost_vec.
# g_stay = growth in current patch (no cost)
# g_move_net = growth in alternate patch - move_cost_vec
# Re-map to warm/cold perspective for fncMoveSoftmax:
gwarm_eff <- ifelse(in_warm, g_stay, g_move_net) # effective growth if occupying warm patch
gcold_eff <- ifelse(in_warm, g_move_net, g_stay) # effective growth if occupying cold patch
p_warm <- fncMoveSoftmax(gwarm = gwarm_eff, gcold = gcold_eff, tau = tau) # calculate probability of selecting warm habitat
choose_warm <- runif(length(mover_rows)) < p_warm # choose warm if p_warm exceeds a random number between 0 and 1
fish_pop$patch[mover_rows] <- if_else(choose_warm, "warm", "cold") # update patch
} else if (move_stochastic == "indiv") {
### 2.B.3. Individual-level movement threshold: each fish has a unique threshold for movement, representing individual variation in boldness/dispersal propensity
fish_pop$patch[mover_rows] <- case_when(
in_warm & (g_move_net - g_stay) > fish_pop$move_threshold[mover_rows] ~ "cold",
!in_warm & (g_move_net - g_stay) > fish_pop$move_threshold[mover_rows] ~ "warm",
TRUE ~ prev_patch) #fish_pop$patch[mover_rows])
}
# Tally switches (indexed by pid so counts remain correct as fish die)
switched <- fish_pop$patch[mover_rows] != prev_patch
switches[fish_pop$pid[mover_rows]] <- switches[fish_pop$pid[mover_rows]] + as.integer(switched)
} # end patch choice
# Recompute func_temp and pcmax_adjusted based on post-choice patch.
# Required because some fish may have switched patches during step 2;
# step 1 values reflect the pre-choice patch and would be stale for switchers.
fish_pop <- fish_pop %>%
mutate(
func_temp = ifelse(patch == "warm", fncTempDepend(T_warm), fncTempDepend(T_cold)),
pcmax_baseline = ifelse(patch == "warm", get_patchpcmax(t, "warm"), get_patchpcmax(t, "cold")),
pcmax_adjusted = ifelse(func_temp < pcmax_baseline, func_temp, pcmax_baseline)
)
# 3. UPDATE HABITAT QUALITY (DENSITY-DEPENDENT RATION) -----------------------------------------
# Update density after fish have moved
fish_pop <- fish_pop %>% group_by(patch) %>% mutate(density = n()) %>% ungroup()
if (food_densdepen == "fullerton") {
### 3a. Fullerton approach
# get density effect on ration
fdens <- fdens_raw <- fish_pop$density # get fish "density" per patch (here, simply abundance b/c space is not specified)
fdens[fdens > MaxDensity4Growth] <- MaxDensity4Growth # high densities cap out at MaxDensity4Growth
density.effect <- fncRescale((1 - c(fdens, 0.01, MaxDensity4Growth)), c((0.5),1)) # calculate density effect scalar
density.effect <- density.effect[-c(length(density.effect), (length(density.effect) - 1))] # remove the last 2 temporary values
# update ration in patches to account for density dependence in food availability
fish_pop <- fish_pop %>% mutate(ration = ration * density.effect)
} else if (food_densdepen == "hyperbolic") {
### 3b. Hyperbolic reduction approach — scale each fish's individual P_Cmax by density, then calculate ration as C_max * P_Cmax
fish_pop <- fish_pop %>%
mutate(
k = if_else(patch == "warm", K_warm, K_cold),
pcmax_adjusted_dd = pcmax_adjusted * (k / (k + density - 1)),
ration = cmax_allometric * pcmax_adjusted_dd
) %>%
select(-k)
}
# 4. GROW FISH (WISCONSIN BIOENERGETICS) -------------------------------------------------------
# Growth lookup for all fish via fncGrowthFish. Growth in g/g/d
growth_df <- fncGrowthFish(NA, as.data.frame(fish_pop), t)
# Store experienced rates before weight update.
# All indexing uses fish pid (rows 1:n_fish) so slots remain stable as fish die.
temp_matrix[fish_pop$pid, d] <- growth_df$WT.actual
ggd_matrix[fish_pop$pid, d] <- growth_df$growth # growth in g/g/d
gd_matrix[fish_pop$pid, d] <- growth_df$growth * fish_pop$weight # growth in g/d
# Update weight: W_{t+1} = W_t + (growth_rate * W_t)
fish_pop$weight <- fish_pop$weight + (growth_df$growth * fish_pop$weight)
# Update peak weight: ratchet up only, never down
fish_pop$peak_weight <- pmax(fish_pop$peak_weight, fish_pop$weight)
# 5. SURVIVAL BASED ON FISH WEIGHT AND GROWTH --------------------------------------------------
# Weight and growth dependent -- growth effect depends on range of growth rates experienced on any given day
# surv.list <- fncSurvive(growth_df)
# growth_df <- growth_df %>%
# mutate(prob_surv = surv.list[[1]],
# survive = surv.list[[2]])
# Weight and growth dependent -- growth effect is rescaled to a specific range
p_sg <- fncSurviveSimp(growth_df)[[1]] # fncSurviveSimp(growth_df)[[1]]
# Temperature-dependent survival: multiplied with size/growth probability so both act simultaneously
p_temp <- fncSurviveTemp(growth_df$WT.actual, T1 = T1_mort, T9 = T9_mort)
# Condition-based (starvation) survival: relative condition = current / peak weight
condition <- fish_pop$weight / fish_pop$peak_weight
p_starv <- fncSurviveStarve(condition, K9 = K9_starv, K1 = K1_starv)
# Age-based survival (senescence): survival probability declines past 5 years old, fish older than 8 have ~0 chance of survival.
p_age <- fncSurviveAge(fish_pop$age_days / 365)
# Calculate combined daily survival rate
prb.srv <- pmin(p_sg * p_temp * p_starv * p_age, 1)
# Minimum weight floor: fish that drop below hatch weight die immediately (backstop)
prb.srv[fish_pop$weight < start_wt] <- 0
survivors <- rbinom(n = nrow(growth_df), size = 1, prob = prb.srv)
growth_df <- growth_df %>%
mutate(prob_surv = prb.srv,
survive = survivors)
# Weight dependent only --- the issue with this is that basically nobody dies. See GrowthScapes working notes in OneNote
# surv.list <- fncSurviveSimp(growth_df)
# growth_df <- growth_df %>%
# mutate(prob_surv = surv.list[[1]],
# survive = surv.list[[2]])
# 6. STORE RESULTS AND REMOVE NON-SURVIVORS ----------------------------------------------------
# Primary: Store updated weight, patch, and survival outcome for this day
mass_matrix[fish_pop$pid, d] <- fish_pop$weight
patch_matrix[fish_pop$pid, d] <- fish_pop$patch
surv_matrix[fish_pop$pid, d] <- growth_df$survive
age_matrix[fish_pop$pid, d] <- fish_pop$age_days/365 # store age in years
# Secondary: store bioenergetics inputs
pcmax_base_matrix[fish_pop$pid, d] <- fish_pop$pcmax_baseline
pcmax_adj_matrix[fish_pop$pid, d] <- fish_pop$pcmax_adjusted
pcmax_adjdd_matrix[fish_pop$pid, d] <- fish_pop$pcmax_adjusted_dd
func_temp_matrix[fish_pop$pid, d] <- fish_pop$func_temp
ration_matrix[fish_pop$pid, d] <- fish_pop$ration
condition_matrix[fish_pop$pid, d] <- condition
# Remove non-survivors — only living fish carry forward to next iteration
fish_pop <- fish_pop[growth_df$survive == 1, ]
# exit loop if all fish have died
if (nrow(fish_pop) == 0) break
}Collate results into long tibbles and summarized tibbles
# assign DOY column names
colnames(mass_matrix) <- as.character(habitat_df$dayofsim)
colnames(patch_matrix) <- as.character(habitat_df$dayofsim)
colnames(temp_matrix) <- as.character(habitat_df$dayofsim)
colnames(ggd_matrix) <- as.character(habitat_df$dayofsim)
colnames(surv_matrix) <- as.character(habitat_df$dayofsim)
colnames(age_matrix) <- as.character(habitat_df$dayofsim)
colnames(pcmax_base_matrix) <- as.character(habitat_df$dayofsim)
colnames(pcmax_adj_matrix) <- as.character(habitat_df$dayofsim)
colnames(pcmax_adjdd_matrix) <- as.character(habitat_df$dayofsim)
colnames(func_temp_matrix) <- as.character(habitat_df$dayofsim)
colnames(ration_matrix) <- as.character(habitat_df$dayofsim)
colnames(condition_matrix) <- as.character(habitat_df$dayofsim)
# Convert weight matrix to long format, join with patch matrix
# Use fish_pop_init to label rows — fish_pop at this point only contains survivors
mass_long <- as_tibble(mass_matrix) %>%
bind_cols(fish_pop_init %>% select(pid, strategy)) %>%
pivot_longer(-c(pid, strategy), names_to = "dayofsim", values_to = "weight") %>%
mutate(dayofsim = as.integer(dayofsim)) %>%
left_join(
as_tibble(patch_matrix) %>%
bind_cols(fish_pop_init %>% select(pid)) %>%
pivot_longer(-pid, names_to = "dayofsim", values_to = "patch") %>%
mutate(dayofsim = as.integer(dayofsim)),
by = c("pid", "dayofsim")
) %>%
left_join(habitat_df %>% select(dayofsim, date), by = "dayofsim")
# Convert temp matrix to long format
temp_long <- as_tibble(temp_matrix) %>%
bind_cols(fish_pop_init %>% select(pid, strategy)) %>%
pivot_longer(-c(pid, strategy), names_to = "dayofsim", values_to = "temp") %>%
mutate(dayofsim = as.integer(dayofsim)) %>%
left_join(habitat_df %>% select(dayofsim, date), by = "dayofsim")
# convert standardized growth rate matrix to long format
ggd_long <- as_tibble(ggd_matrix) %>%
bind_cols(fish_pop_init %>% select(pid, strategy)) %>%
pivot_longer(-c(pid, strategy), names_to = "dayofsim", values_to = "ggd") %>%
mutate(dayofsim = as.integer(dayofsim)) %>%
left_join(habitat_df %>% select(dayofsim, date), by = "dayofsim")
# convert survival matrix to long format (1 = survived, 0 = died, NA = already dead)
surv_long <- as_tibble(surv_matrix) %>%
bind_cols(fish_pop_init %>% select(pid, strategy)) %>%
pivot_longer(-c(pid, strategy), names_to = "dayofsim", values_to = "survived") %>%
mutate(dayofsim = as.integer(dayofsim)) %>%
left_join(habitat_df %>% select(dayofsim, date), by = "dayofsim")
# convert baseline P_Cmax matrix to long format
pcmax_base_long <- as_tibble(pcmax_base_matrix) %>%
bind_cols(fish_pop_init %>% select(pid, strategy)) %>%
pivot_longer(-c(pid, strategy), names_to = "dayofsim", values_to = "pcmax_base") %>%
mutate(dayofsim = as.integer(dayofsim)) %>%
left_join(habitat_df %>% select(dayofsim, date), by = "dayofsim")
# convert temp-adjusted P_Cmax matrix to long format
pcmax_adj_long <- as_tibble(pcmax_adj_matrix) %>%
bind_cols(fish_pop_init %>% select(pid, strategy)) %>%
pivot_longer(-c(pid, strategy), names_to = "dayofsim", values_to = "pcmax_adj") %>%
mutate(dayofsim = as.integer(dayofsim)) %>%
left_join(habitat_df %>% select(dayofsim, date), by = "dayofsim")
# convert temp and density adjusted matrix to long format
pcmax_adjdd_long <- as_tibble(pcmax_adjdd_matrix) %>%
bind_cols(fish_pop_init %>% select(pid, strategy)) %>%
pivot_longer(-c(pid, strategy), names_to = "dayofsim", values_to = "pcmax_adjdd") %>%
mutate(dayofsim = as.integer(dayofsim)) %>%
left_join(habitat_df %>% select(dayofsim, date), by = "dayofsim")
# convert survival matrix to long format (1 = survived, 0 = died, NA = already dead)
func_temp_long <- as_tibble(func_temp_matrix) %>%
bind_cols(fish_pop_init %>% select(pid, strategy)) %>%
pivot_longer(-c(pid, strategy), names_to = "dayofsim", values_to = "func_temp") %>%
mutate(dayofsim = as.integer(dayofsim)) %>%
left_join(habitat_df %>% select(dayofsim, date), by = "dayofsim")
# convert survival matrix to long format (1 = survived, 0 = died, NA = already dead)
ration_long <- as_tibble(ration_matrix) %>%
bind_cols(fish_pop_init %>% select(pid, strategy)) %>%
pivot_longer(-c(pid, strategy), names_to = "dayofsim", values_to = "ration") %>%
mutate(dayofsim = as.integer(dayofsim)) %>%
left_join(habitat_df %>% select(dayofsim, date), by = "dayofsim")
condition_long <- as_tibble(condition_matrix) %>%
bind_cols(fish_pop_init %>% select(pid, strategy)) %>%
pivot_longer(-c(pid, strategy), names_to = "dayofsim", values_to = "condition") %>%
mutate(dayofsim = as.integer(dayofsim)) %>%
left_join(habitat_df %>% select(dayofsim, date), by = "dayofsim")
age_long <- as_tibble(age_matrix) %>%
bind_cols(fish_pop_init %>% select(pid, strategy)) %>%
pivot_longer(-c(pid, strategy), names_to = "dayofsim", values_to = "age") %>%
mutate(dayofsim = as.integer(dayofsim)) %>%
left_join(habitat_df %>% select(dayofsim, date), by = "dayofsim")
# bind all individual data
ibm_long <- mass_long %>%
left_join(temp_long %>% select(-date), by = c("pid", "strategy", "dayofsim")) %>%
left_join(ggd_long %>% select(-date), by = c("pid", "strategy", "dayofsim")) %>%
left_join(surv_long %>% select(-date), by = c("pid", "strategy", "dayofsim")) %>%
left_join(pcmax_base_long %>% select(-date), by = c("pid", "strategy", "dayofsim")) %>%
left_join(pcmax_adj_long %>% select(-date), by = c("pid", "strategy", "dayofsim")) %>%
left_join(pcmax_adjdd_long %>% select(-date), by = c("pid", "strategy", "dayofsim")) %>%
left_join(func_temp_long %>% select(-date), by = c("pid", "strategy", "dayofsim")) %>%
left_join(ration_long %>% select(-date), by = c("pid", "strategy", "dayofsim")) %>%
left_join(condition_long %>% select(-date), by = c("pid", "strategy", "dayofsim")) %>%
left_join(age_long %>% select(-date), by = c("pid", "strategy", "dayofsim"))
# summarize by strategy
ibm_summary <- ibm_long %>%
group_by(strategy, dayofsim, date) %>%
summarise(
mean_weight = mean(weight, na.rm = TRUE),
sd_weight = sd(weight, na.rm = TRUE),
mean_temp = mean(temp, na.rm = TRUE),
sd_temp = sd(temp, na.rm = TRUE),
mean_ggd = mean(ggd, na.rm = TRUE),
sd_ggd = sd(ggd, na.rm = TRUE),
prop_warm = mean(patch == "warm", na.rm = TRUE),
n_alive = sum(survived, na.rm = TRUE),
mean_pcmax_bas = mean(pcmax_base, na.rm = TRUE),
sd_pcmax_base = sd(pcmax_base, na.rm = TRUE),
mean_pcmax_adj = mean(pcmax_adj, na.rm = TRUE),
sd_pcmax_adj = sd(pcmax_adj, na.rm = TRUE),
mean_pcmax_adjdd = mean(pcmax_adjdd, na.rm = TRUE),
sd_pcmax_adjdd = sd(pcmax_adjdd, na.rm = TRUE),
mean_func_temp = mean(func_temp, na.rm = TRUE),
sd_func_temp = sd(func_temp, na.rm = TRUE),
mean_ration = mean(ration, na.rm = TRUE),
sd_ration = sd(ration, na.rm = TRUE),
mean_condition = mean(condition, na.rm = TRUE),
sd_condition = sd(condition, na.rm = TRUE),
# mean_age = mean(age, na.rm = TRUE),
# sd_age = sd(age, na.rm = TRUE),
.groups = "drop"
)
ibm_summary# A tibble: 11,691 × 23
strategy dayofsim date mean_weight sd_weight mean_temp sd_temp mean_ggd
<chr> <int> <date> <dbl> <dbl> <dbl> <dbl> <dbl>
1 optimal… 1 2024-05-01 0.534 0.0533 13.0 3.28 0.0728
2 optimal… 2 2024-05-02 0.597 0.0366 13.3 3.34 0.0740
3 optimal… 3 2024-05-03 0.641 0.0391 13.5 3.34 0.0726
4 optimal… 4 2024-05-04 0.685 0.0408 13.4 3.40 0.0707
5 optimal… 5 2024-05-05 0.733 0.0441 13.6 3.50 0.0689
6 optimal… 6 2024-05-06 0.783 0.0481 13.8 3.50 0.0674
7 optimal… 7 2024-05-07 0.834 0.0519 13.9 3.55 0.0659
8 optimal… 8 2024-05-08 0.890 0.0560 14.2 3.60 0.0646
9 optimal… 9 2024-05-09 0.946 0.0598 14.3 3.65 0.0631
10 optimal… 10 2024-05-10 1.00 0.0633 14.5 3.65 0.0618
# ℹ 11,681 more rows
# ℹ 15 more variables: sd_ggd <dbl>, prop_warm <dbl>, n_alive <int>,
# mean_pcmax_bas <dbl>, sd_pcmax_base <dbl>, mean_pcmax_adj <dbl>,
# sd_pcmax_adj <dbl>, mean_pcmax_adjdd <dbl>, sd_pcmax_adjdd <dbl>,
# mean_func_temp <dbl>, sd_func_temp <dbl>, mean_ration <dbl>,
# sd_ration <dbl>, mean_condition <dbl>, sd_condition <dbl>
Ration size by weight: points should generally track allometric scaling of Cmax (halved to account for baseline/treshold P_Cmax, dashed line). Noise is due to variation in temperature and density. This looks fine…points fall away from 0.5xC_max during very cold periods when temperature restricts physiological capacity. The three separate “cliffs” show that you get the same behavior at the end of the year when temps are limited but fish have attained different mean body sizes depending on their life-history strategy
constants <- fncReadConstants()
xs <- seq(from = min(ibm_long$weight, na.rm = TRUE), to = max(ibm_long$weight, na.rm = TRUE), length.out = 100)
ys <- constants$Consumption$CA * (xs ^ constants$Consumption$CB)
p1 <- ggplot() +
geom_point(data = ibm_long %>% filter(survived == 1) %>% group_by(dayofsim, patch) %>% mutate(density = n()) %>% ungroup(),
aes(x = weight, y = ration, color = strategy)) +
# geom_line(aes(x = xs, y = ys), linetype = "dashed", color = "grey40") +
geom_line(aes(x = xs, y = ys*0.5), linetype = "dashed", color = "black") +
theme_bw() + theme(legend.position = "top") +
ylab("Ration size (g/g/d)") + xlab("Fish mass (g)")
p2 <- ggplot() +
geom_point(data = ibm_long %>% filter(survived == 1) %>% group_by(dayofsim, patch) %>% mutate(density = n()) %>% ungroup(),
aes(x = weight, y = ration, color = temp)) +
# geom_line(aes(x = xs, y = ys), linetype = "dashed", color = "grey40") +
geom_line(aes(x = xs, y = ys*0.5), linetype = "dashed", color = "black") +
theme_bw() + theme(legend.position = "top") +
ylab("Ration size (g/g/d)") + xlab("Fish mass (g)")
egg::ggarrange(p2, p1, nrow = 1)
f(T) should perfectly track the temperature dependence function b/c it is only based on temperature and constants that are common to all individuals
ggplot() +
geom_point(data = ibm_long %>% filter(survived == 1), aes(x = temp, y = func_temp, color = weight)) +
# geom_line(aes(x = xs, y = ys), linetype = "dashed", color = "grey40") +
# geom_line(aes(x = xs, y = ys*0.5), linetype = "dashed", color = "red") +
theme_bw() +
ylab("f(Temperature)") + xlab("Temperature (deg. C)")
P_Cmax by temp: points should perfect track the temperature dependence function, but max out at the threshold P_Cmax set in each habitat.
ggplot() +
geom_point(data = ibm_long %>% filter(survived == 1), aes(x = temp, y = pcmax_adj, color = weight)) +
geom_abline(slope = 0, intercept = 0.5, color = "grey40", linetype = "dashed") +
# geom_line(aes(x = xs, y = ys), linetype = "dashed", color = "grey40") +
# geom_line(aes(x = xs, y = ys*0.5), linetype = "dashed", color = "red") +
theme_bw() +
ylab("Temperature adjusted P_Cmax") + xlab("Temperature (deg. C)")
Now show P_cmax adjusted by both temperature and density: points should generally track temperature-dependence function, capped at baseline/threshold P_Cmax. Noise is due to variation in body size and density. Smaller fish feeding at higher densities typically experience more food limitation…this appears to occur more commonly in the warm habitat during late spring.
p1 <- ggplot() +
geom_point(data = ibm_long %>% filter(survived == 1) %>% group_by(dayofsim, patch) %>% mutate(density = n()) %>% ungroup(),
aes(x = temp, y = pcmax_adjdd, color = weight)) +
geom_abline(slope = 0, intercept = 0.5, color = "grey40", linetype = "dashed") +
# geom_line(aes(x = xs, y = ys), linetype = "dashed", color = "grey40") +
# geom_line(aes(x = xs, y = ys*0.5), linetype = "dashed", color = "red") +
theme_bw() + ylim(0.07, 0.5) + theme(legend.position = "top") +
ylab("Temperature and density adjusted P_Cmax") + xlab("Temperature (deg. C)")
p2 <- ggplot() +
geom_point(data = ibm_long %>% filter(survived == 1) %>% group_by(dayofsim, patch) %>% mutate(density = n()) %>% ungroup(),
aes(x = temp, y = pcmax_adjdd, color = density)) +
geom_abline(slope = 0, intercept = 0.5, color = "grey40", linetype = "dashed") +
# geom_line(aes(x = xs, y = ys), linetype = "dashed", color = "grey40") +
# geom_line(aes(x = xs, y = ys*0.5), linetype = "dashed", color = "red") +
theme_bw() + ylim(0.07, 0.5) + theme(legend.position = "top") +
ylab("Temperature and density adjusted P_Cmax") + xlab("Temperature (deg. C)")
p3 <- ggplot() +
geom_point(data = ibm_long %>% filter(survived == 1) %>% group_by(dayofsim, patch) %>% mutate(density = n()) %>% ungroup(),
aes(x = temp, y = pcmax_adjdd, color = patch)) +
geom_abline(slope = 0, intercept = 0.5, color = "grey40", linetype = "dashed") +
# geom_line(aes(x = xs, y = ys), linetype = "dashed", color = "grey40") +
# geom_line(aes(x = xs, y = ys*0.5), linetype = "dashed", color = "red") +
theme_bw() + ylim(0.07, 0.5) + theme(legend.position = "top") +
ylab("Temperature and density adjusted P_Cmax") + xlab("Temperature (deg. C)")
p4 <- ggplot() +
geom_point(data = ibm_long %>% filter(survived == 1) %>% group_by(dayofsim, patch) %>% mutate(density = n()) %>% ungroup(),
aes(x = temp, y = pcmax_adjdd, color = dayofsim)) +
geom_abline(slope = 0, intercept = 0.5, color = "grey40", linetype = "dashed") +
# geom_line(aes(x = xs, y = ys), linetype = "dashed", color = "grey40") +
# geom_line(aes(x = xs, y = ys*0.5), linetype = "dashed", color = "red") +
theme_bw() + ylim(0.07, 0.5) + theme(legend.position = "top") +
ylab("Temperature and density adjusted P_Cmax") + xlab("Temperature (deg. C)")
egg::ggarrange(p1, p2, p3, p4, nrow = 2, ncol = 2)
Weight trajectories by strategy (ribbon = ±1 SD across individuals).
I wonder how realistic overwinter mass losses are…
p1 <- ibm_summary %>%
ggplot() +
geom_rect(data = summer_shading,
aes(xmin = xmin, xmax = xmax, ymin = ymin, ymax = ymax),
fill = "grey", alpha = 0.3, inherit.aes = FALSE) +
geom_ribbon(aes(x = date, color = strategy, fill = strategy, ymin = mean_weight - sd_weight, ymax = mean_weight + sd_weight),
alpha = 0.15, color = NA) +
geom_line(aes(x = date, color = strategy, fill = strategy, y = mean_weight)) +
scale_color_manual(values = c(resident_warm = "red",
resident_cold = "blue",
optimal_mover = "darkgreen")) +
scale_fill_manual(values = c(resident_warm = "red",
resident_cold = "blue",
optimal_mover = "darkgreen")) +
theme_bw() + theme(panel.grid = element_blank()) +
xlab("Date") + ylab("Mean weight ± SD (g)")
p2 <- mass_long %>%
ggplot() +
geom_rect(data = summer_shading,
aes(xmin = xmin, xmax = xmax, ymin = ymin, ymax = ymax),
fill = "grey", alpha = 0.3, inherit.aes = FALSE) +
geom_line(aes(x = date, y = weight, color = strategy, group = pid), alpha = 0.5) +
scale_color_manual(values = c(resident_warm = "red",
resident_cold = "blue",
optimal_mover = "darkgreen")) +
theme_bw() + theme(panel.grid = element_blank()) +
xlab("Date") + ylab("Individual weight (g)")
ggpubr::ggarrange(p1, p2, nrow = 1, common.legend = TRUE)
Now zoom into the beginning of the simulation, to look growth trajectories of early recruits
p1 <- ibm_summary %>%
filter(date <= min(date) + days(100)) %>%
ggplot() +
geom_ribbon(aes(x = date, color = strategy, fill = strategy, ymin = mean_weight - sd_weight, ymax = mean_weight + sd_weight),
alpha = 0.15, color = NA) +
geom_line(aes(x = date, color = strategy, fill = strategy, y = mean_weight)) +
scale_color_manual(values = c(resident_warm = "red",
resident_cold = "blue",
optimal_mover = "darkgreen")) +
scale_fill_manual(values = c(resident_warm = "red",
resident_cold = "blue",
optimal_mover = "darkgreen")) +
theme_bw() + theme(panel.grid = element_blank()) +
xlab("Date") + ylab("Mean weight ± SD (g)") +
geom_abline(slope = 0, intercept = 0, linetype = "dashed")
p2 <- mass_long %>%
filter(date <= min(date) + days(100)) %>%
ggplot() +
geom_line(aes(x = date, y = weight, color = strategy, group = pid), alpha = 0.5) +
scale_color_manual(values = c(resident_warm = "red",
resident_cold = "blue",
optimal_mover = "darkgreen")) +
theme_bw() + theme(panel.grid = element_blank()) +
xlab("Date") + ylab("Individual weight (g)") +
geom_abline(slope = 0, intercept = 0, linetype = "dashed")
ggpubr::ggarrange(p1, p2, nrow = 1, common.legend = TRUE)
Now just look at warm residents
p1 <- ibm_summary %>%
filter(strategy == "resident_warm", !is.na(mean_weight)) %>%
ggplot() +
# geom_rect(data = summer_shading,
# aes(xmin = xmin, xmax = xmax, ymin = ymin, ymax = ymax),
# fill = "grey", alpha = 0.3, inherit.aes = FALSE) +
geom_ribbon(aes(x = date, color = strategy, fill = strategy, ymin = mean_weight - sd_weight, ymax = mean_weight + sd_weight),
alpha = 0.15, color = NA) +
geom_line(aes(x = date, color = strategy, fill = strategy, y = mean_weight)) +
scale_color_manual(values = c(resident_warm = "red",
resident_cold = "blue",
optimal_mover = "darkgreen")) +
scale_fill_manual(values = c(resident_warm = "red",
resident_cold = "blue",
optimal_mover = "darkgreen")) +
theme_bw() + theme(panel.grid = element_blank()) +
xlab("Date") + ylab("Mean weight ± SD (g)")
p2 <- mass_long %>%
filter(strategy == "resident_warm", !is.na(weight)) %>%
ggplot() +
# geom_rect(data = summer_shading,
# aes(xmin = xmin, xmax = xmax, ymin = ymin, ymax = ymax),
# fill = "grey", alpha = 0.3, inherit.aes = FALSE) +
geom_line(aes(x = date, y = weight, color = strategy, group = pid), alpha = 0.5) +
scale_color_manual(values = c(resident_warm = "red",
resident_cold = "blue",
optimal_mover = "darkgreen")) +
theme_bw() + theme(panel.grid = element_blank()) +
xlab("Date") + ylab("Individual weight (g)")
ggpubr::ggarrange(p1, p2, nrow = 1, common.legend = TRUE)
Plot daily counts of survivors and overall survival by strategy (plots are the same, survival is standardized by number of initial fish per strategy)
ibm_summary %>%
ggplot() +
geom_rect(data = summer_shading,
aes(xmin = xmin, xmax = xmax, ymin = ymin, ymax = ymax),
fill = "grey", alpha = 0.3, inherit.aes = FALSE) +
geom_line(aes(x = date, y = n_alive / n_fish_per_strat, color = strategy)) +
scale_color_manual(values = c(resident_warm = "red",
resident_cold = "blue",
optimal_mover = "darkgreen")) +
scale_y_continuous(limits = c(0, NA)) +
labs(
x = "Date",
y = "Proportion alive",
color = "Strategy",
title = "Cumulative survival by strategy"
) +
theme_bw() + theme(panel.grid = element_blank())
# ggpubr::ggarrange(p1, p2, common.legend = TRUE)Summarize survival outcomes by strategy:
ibm_summary %>%
filter(dayofsim == n_days) %>%
mutate(survive_rate = n_alive / n_fish_per_strat) %>%
select(strategy, n_alive, survive_rate)# A tibble: 3 × 3
strategy n_alive survive_rate
<chr> <int> <dbl>
1 optimal_mover 0 0
2 resident_cold 0 0
3 resident_warm 0 0
Interpretation below is based on past model runs with different parameterization/configuration. But what is consistent across runs is that (1) summer is a challenging time for survival in the warm habitat, (2) winter/spring is challenges survival in the cold habitat, and (3) movers always have the highest survival.
sense_environment appears to have a large effect on survival outcomes, but doesn’t change overall patterns described above.
resident_warm has the lowest overall survival, consistent with it being the poorest-growing strategy.
resident_warm mortality coincides with slower/negative growth in mid-summer, which is exactly what the function should be responding to.resident_cold has moderate overall survival. Survival declines the early part of the year when growth is negative and fish are small. Very little mortality occurs during the summer, consistent with theory on the role of perennially cold habitat providing summer refugia. By the end of the year, most fish have escaped the survival bottleneck associated with small body sizeoptimal_mover has the highest overall survival (~96%), reflecting its growth advantage keeping individual survival probabilities near 1.0 most of the year.When are fish dying and how large are they/how fast are they growing relative to the survivor mean?
n_days <- ncol(mass_matrix)
# Per-fish fate summary (used for panel C)
fish_fate <- fish_pop_init %>%
mutate(
survived = if_else(!is.na(mass_matrix[pid, n_days]), "Survived", "Died"),
days_alive = rowSums(!is.na(mass_matrix))
)
# fish_fate %>% count(strategy, survived)strategy_order <- c("resident_warm", "resident_cold", "optimal_mover")
# Panels A & B: compare dying fish to surviving fish on the same day
# -----------------------------------------------------------------------
# Dying fish: weight and growth rate on their day of death (survived == 0)
death_records <- ibm_long %>%
filter(survived == 0) %>%
select(pid, strategy, date, dayofsim, weight, ggd) %>%
mutate(fate = "Died")
# Death days across all strategies
death_days <- death_records %>% distinct(dayofsim)
# Surviving fish (those alive at end): weight and growth on those same death days
survivor_pids <- fish_fate %>% filter(survived == "Survived") %>% pull(pid)
survivor_records <- ibm_long %>%
filter(pid %in% survivor_pids) %>%
inner_join(death_days, by = "dayofsim") %>%
select(pid, strategy, dayofsim, weight, ggd) %>%
mutate(fate = "Survived")
# Mean of ALL survivors (across strategies) on each death day
survivor_means <- survivor_records %>%
group_by(dayofsim) %>%
summarise(mean_wt_surv = mean(weight, na.rm = TRUE),
mean_ggd_surv = mean(ggd, na.rm = TRUE),
.groups = "drop")
# Difference: dying fish value minus all-survivor mean on same day
df_diff <- death_records %>%
left_join(survivor_means, by = "dayofsim") %>%
mutate(
wt_diff = weight - mean_wt_surv,
ggd_diff = ggd - mean_ggd_surv,
strategy = factor(strategy, levels = strategy_order)
)
# -----------------------------------------------------------------------
p_wt <- ggplot(df_diff, aes(x = strategy, y = wt_diff)) +
geom_hline(yintercept = 0, linetype = "dashed", color = "grey50") +
geom_boxplot(width = 0.4, outlier.shape = NA, fill = "grey") +
geom_jitter(width = 0.15, size = 2, alpha = 0.7) +
labs(x = NULL, y = "Weight difference (g)",
title = "Dying fish wt. minus mean survivor wt. (same day)") +
theme_bw() + theme(panel.grid = element_blank())
p_ggd <- ggplot(df_diff, aes(x = strategy, y = ggd_diff)) +
geom_hline(yintercept = 0, linetype = "dashed", color = "grey50") +
geom_boxplot(width = 0.4, outlier.shape = NA, fill = "grey") +
geom_jitter(width = 0.15, size = 2, alpha = 0.7) +
labs(x = NULL, y = "Growth rate difference (g/g/d)",
title = "Dying fish growth minus mean survivor growth (same day)") +
theme_bw() + theme(panel.grid = element_blank())
p_days <- ggplot() +
geom_rect(data = summer_shading,
aes(ymin = xmin, ymax = xmax, xmin = ymin, xmax = ymax),
fill = "grey", alpha = 0.3, inherit.aes = FALSE) +
geom_jitter(data = death_records,
aes(x = strategy, y = date, color = strategy),
width = 0.15, size = 2.5, alpha = 0.8) +
scale_x_discrete(limits = strategy_order) +
labs(x = NULL, y = "Day of death (day of year)",
title = "When did non-survivors die?") +
theme_bw() + theme(legend.position = "none", panel.grid = element_blank()) +
scale_color_manual(values = c(resident_warm = "red",
resident_cold = "blue",
optimal_mover = "darkgreen"))
egg::ggarrange(p_wt, p_ggd, p_days, ncol = 1)
Yes, overall, the survival module is behaving correctly: it’s largely selecting against small, slow-growing fish in a biologically interpretable way.
resident_warm fish that die in summer are smaller and actively losing mass relative to the population-wide survivor mean on those same days. The tight clustering near zero for resident_cold and optimal_mover reflects that deaths in those strategies tend to occur early in the year when fish are small and the all-strategy survivor mean hasn’t yet diverged much.
Timing of deaths (panel C) also makes biological sense: + resident_cold deaths cluster early when fish are small and baseline survival is lowest, and fish are also experiencing negative growth due to low temps + optimal_mover deaths also cluster early for the same reasons + resident_warm deaths cluster mid-summer as the warm patch becomes suboptimal. Likely not as much early season mortality b/c growth potential is just a bit higher
Now, let’s investigate the context of optimal_mover mortalities. Where and when to they occur and what are the thermal and growth conditions that they experienced?
mover_deaths <- ibm_long %>%
filter(strategy == "optimal_mover", survived == 0) %>%
select(pid, date, dayofsim, patch, weight, ggd)
dayofsim_max <- max(mover_deaths$dayofsim) + 10
temps <- habitat_df %>%
filter(dayofsim <= dayofsim_max) %>%
select(dayofsim, date, temp_warm, temp_cold) %>%
pivot_longer(c(temp_warm, temp_cold), names_to = "patch", values_to = "temp") %>%
mutate(patch = if_else(patch == "temp_warm", "warm", "cold"))
p_temp <- ggplot(temps, aes(x = date, y = temp, color = patch)) +
geom_line(linewidth = 0.8) +
geom_rug(
data = mover_deaths, aes(x = date, color = patch),
sides = "b", linewidth = 1.2, length = unit(0.06, "npc"), inherit.aes = FALSE
) +
scale_color_manual(values = c(warm = "tomato", cold = "steelblue")) +
labs(x = NULL, y = "Temperature (°C)", color = "Patch",
title = "Optimal mover mortality: patch context and timing") +
theme_bw() + theme(axis.text.x = element_blank(), axis.ticks.x = element_blank())
p_death <- ggplot(mover_deaths, aes(x = date, y = ggd, color = patch, size = weight)) +
geom_hline(yintercept = 0, linetype = "dashed", color = "grey50") +
geom_point(alpha = 0.85) +
scale_color_manual(values = c(warm = "tomato", cold = "steelblue")) +
scale_size_continuous(range = c(3, 8), name = "Weight (g)") +
labs(x = "Date", y = "Growth rate at death (g/g/d)", color = "Patch") +
theme_bw()
egg::ggarrange(p_temp, p_death, ncol = 1, heights = c(1, 1.2))
The early cluster of deaths is dominated by warm-patch fish with negative growth rates and small body sizes — these fish are actively losing mass and dying. Temperatures in both patches are essentially identical and near-zero during this period, so the warm patch offers no thermal advantage, but movers are nonetheless ending up there and dying. The one cold-patch early death follows the same pattern.
The two late deaths (days ~123–133) are different in character: both have positive growth rates and are much larger, suggesting they’re stochastic rather than condition-driven mortality.
The key diagnostic question this raises: why are movers preferentially occupying the warm patch in early winter when temperatures are identical and growth is negative in both? That points to investigating the patch-choice logic at low temperatures — the growth potential lookup may not be differentiating between patches when temperatures are near-flat, leading to essentially arbitrary placement. This makes sense, especially when combined with the softmax/probabilistic stochasticity in patch choice…fish won’t switch patches if the growth advantage is tiny…so they stay in the warm habitat where densities are ~high and
Now, look at how the mechanisms of survival manifest over time, for each strategy.
# Build survival probability components for all fish across all alive days
all_surv_df <- tibble(
pid = rep(fish_pop_init$pid, n_days),
dayofsim = rep(1:n_days, each = nrow(fish_pop_init)),
condition = as.vector(condition_matrix),
temp = as.vector(temp_matrix),
weight = as.vector(mass_matrix),
growth = as.vector(ggd_matrix),
age = as.vector(age_matrix)
) |>
filter(!is.na(condition)) |>
left_join(fish_pop_init |> select(pid, strategy), by = "pid") |>
mutate(
p_temp = fncSurviveTemp(temp, T1 = T1_mort, T9 = T9_mort),
p_starv = fncSurviveStarve(condition, K9 = K9_starv, K1 = K1_starv),
p_sg = fncSurviveFixed(pick(weight, growth))[[1]],
p_age = fncSurviveAge(age)
) |>
left_join(habitat_df |> select(dayofsim, date), by = "dayofsim") |>
pivot_longer(c(p_temp, p_starv, p_sg, p_age),
names_to = "source", values_to = "p_survive") |>
mutate(
source = recode(source,
p_temp = "Temperature (p_temp)",
p_starv = "Starvation (p_starv)",
p_sg = "Size/growth (p_sg)",
p_age = "Age (p_age)"),
strategy = factor(strategy,
levels = c("resident_warm", "resident_cold", "optimal_mover"))
)
mycols <- brewer.pal(4, "Set2")
surv_source_colors <- c(
"Temperature (p_temp)" = mycols[1],
"Starvation (p_starv)" = mycols[2],
"Size/growth (p_sg)" = mycols[3],
"Age (p_age)" = mycols[4]
)
# Individual fish: one line per fish per mortality source, faceted by strategy
# all_surv_df |>
# ggplot(aes(x = date, y = p_survive, color = source,
# group = interaction(pid, source))) +
# geom_rect(data = summer_shading,
# aes(xmin = xmin, xmax = xmax, ymin = -Inf, ymax = Inf),
# fill = "grey", alpha = 0.3, inherit.aes = FALSE) +
# geom_line(alpha = 0.2, linewidth = 0.3) +
# scale_color_manual(values = surv_source_colors) +
# #scale_y_continuous(limits = c(0, 1)) +
# facet_wrap(~strategy, nrow = 3, scales = "free_y") +
# theme_bw() + theme(panel.grid = element_blank()) +
# xlab("Date") + ylab("Daily survival probability") +
# labs(title = "Mortality sources by strategy — individual fish",
# color = "Mortality source")
# Group means: daily mean per mortality source, faceted by strategy
all_surv_df |>
group_by(strategy, date, source) |>
summarise(mean_p = mean(p_survive), .groups = "drop") |>
ggplot(aes(x = date, y = mean_p, color = source)) +
geom_rect(data = summer_shading,
aes(xmin = xmin, xmax = xmax, ymin = -Inf, ymax = Inf),
fill = "grey", alpha = 0.3, inherit.aes = FALSE) +
geom_line(linewidth = 0.9) +
scale_color_manual(values = surv_source_colors) +
#scale_y_continuous(limits = c(0, 1)) +
facet_wrap(~strategy, nrow = 3, scales = "free_y") +
theme_bw() + theme(panel.grid = element_blank()) +
xlab("Date") + ylab("Mean daily survival probability") +
labs(title = "Mortality sources by strategy — group means",
color = "Mortality source")
p_starv) is almost entirely responsible for warm resident mortality during summer. It remains at 1.0 through spring (fish growing well, condition = 1.0), then collapses rapidly in late June as the warm patch temperatures drive up metabolic costs faster than fish consume food — condition drops below K9=0.50 and p_starv crashes to ~0.35 within a matter of days.
p_temp) plays almost no role. Because the warm patch peaks at 25°C — just below the T9 threshold of 25.8°C — p_temp barely budges from 1.0 throughout the survival window.p_starv, p_sg stays flat at ~1.0 throughout — by the time summer arrives, warm residents have grown large enough that size/growth survival is essentially at its ceiling.p_sg, drives mortality among new recruits. p_starv drives mortality during subsequent winters. p_temp plays almost no role as temperatures in the cold habitat never approach lethal limitsCondition/starvation is a one of the primary drivers or survival. Plot relative condition over time, for each strategy.
ibm_summary |>
# filter(strategy != "resident_warm") |> # warm residents extinct early — plot separately
ggplot(aes(x = date, color = strategy, fill = strategy)) +
geom_rect(data = summer_shading,
aes(xmin=xmin, xmax=xmax, ymin=-Inf, ymax=Inf),
fill="grey", alpha=0.3, inherit.aes=FALSE) +
geom_ribbon(aes(ymin = mean_condition - sd_condition,
ymax = mean_condition + sd_condition),
alpha = 0.15, color = NA) +
geom_line(aes(y = mean_condition)) +
geom_hline(yintercept = c(0.50, 0.30), linetype="dashed", alpha=0.5) +
annotate("text", x = as.Date("2024-06-01"), y = 0.51, hjust=0,
label="K9 = 0.50", size=3, alpha=0.7) +
annotate("text", x = as.Date("2024-06-01"), y = 0.31, hjust=0,
label="K1 = 0.30", size=3, alpha=0.7) +
scale_color_manual(values=c(resident_warm = "red", resident_cold="blue", optimal_mover="darkgreen")) +
scale_fill_manual(values=c(resident_warm = "red", resident_cold="blue", optimal_mover="darkgreen")) +
scale_y_continuous(limits=c(0,1)) +
theme_bw() + theme(panel.grid=element_blank()) +
xlab("Date") + ylab("Relative condition (W / W_peak)") +
labs(title="Mean condition ± SD by strategy over time",
subtitle="Dashed lines = starvation anchor points (K9, K1); shaded = June–Aug",
color="Strategy", fill="Strategy")
Optimal movers and cold residents maintain relatively high condition, and we only see mass loss during the winter when very cold temperatures limit physiological capacity. Neither strategy every approaches the starvation anchor points, meaning that the starvation mechanism is correctly not firing during ~normal seasonal weight loss. In contrast, condition for warm residents declines steeply during the first summer, when food limitations (threshold P_cmax) are insufficient to meet temperature-driven physiological demands.
Plot histograms of maximum age by strategy
max_age_df <- ibm_long |>
dplyr::filter(survived == 1) |>
dplyr::group_by(strategy, pid) |>
dplyr::summarize(max_age = max(age), .groups = "drop")
strategy_colors <- c(resident_warm = "red", resident_cold = "blue", optimal_mover = "darkgreen")
ggplot(max_age_df, aes(x = max_age, fill = strategy)) +
geom_histogram(binwidth = 0.25, color = "white", linewidth = 0.2) +
scale_fill_manual(values = strategy_colors) +
facet_wrap(~ strategy, ncol = 1, scales = "free_y") +
theme_bw() + theme(panel.grid = element_blank(), legend.position = "none") +
xlab("Maximum age (years)") + ylab("Number of fish") +
labs(title = "Maximum age by strategy")
Plot weight at age
ibm_long %>% filter(age %in% c(0:10)) %>%
ggplot(aes(x = age, y = weight, color = strategy, fill = strategy, group = pid)) +
geom_line() +
scale_color_manual(values=c(resident_warm = "red", resident_cold="blue", optimal_mover="darkgreen")) +
scale_fill_manual(values=c(resident_warm = "red", resident_cold="blue", optimal_mover="darkgreen")) +
labs(title = "Individual weight-at-age by strategy", x = "Age (years)", y = "Weight (g)", color="Strategy", fill="Strategy") +
theme_bw() + theme(panel.grid=element_blank())
Plot abundance through time
ibm_summary %>%
ggplot() +
geom_rect(data = summer_shading,
aes(xmin = xmin, xmax = xmax, ymin = ymin, ymax = ymax),
fill = "grey", alpha = 0.3, inherit.aes = FALSE) +
geom_line(aes(x = date, y = n_alive, color = strategy)) +
scale_color_manual(values = c(resident_warm = "red",
resident_cold = "blue",
optimal_mover = "darkgreen")) +
scale_y_continuous(limits = c(0, NA)) +
labs(
x = "Date",
y = "Number alive",
color = "Strategy",
title = "Population size by strategy"
) +
theme_bw() + theme(panel.grid = element_blank())
Plot biomass through time as abundance * mean weight
ibm_summary %>%
ggplot() +
geom_rect(data = summer_shading,
aes(xmin = xmin, xmax = xmax, ymin = ymin, ymax = ymax),
fill = "grey", alpha = 0.3, inherit.aes = FALSE) +
geom_line(aes(x = date, y = (n_alive*mean_weight)/1000, color = strategy)) +
scale_color_manual(values = c(resident_warm = "red",
resident_cold = "blue",
optimal_mover = "darkgreen")) +
scale_y_continuous(limits = c(0, NA)) +
labs(
x = "Date",
y = "Biomass (kg)",
color = "Strategy",
title = "Biomass by strategy"
) +
theme_bw() + theme(panel.grid = element_blank())
Patch occupancy for optimal movers — proportion in warm patch through the year.
move_stochastic = "prob", movers only really start to pile into the warm habitat during the shoulder seasons when benefits of warm habitat far exceed the cold habitat.move_stochastic = "Indiv", …sense_environment = "density_current" or sense_environment = "density_all", movers bounce rapidly between the two habitats as they chase the apparently better habitat, but then experience reduced growth due to strong density dependence. This appears to be driven by fact that most movers are doing the same thing.ibm_summary %>%
filter(strategy == "optimal_mover") %>%
ggplot(aes(x = date, y = prop_warm)) +
geom_line() +
geom_hline(yintercept = 0.5, linetype = "dashed", color = "gray50") +
theme_bw() +
xlab("Date") + ylab("Proportion of optimal movers in warm patch")
ibm_summary %>%
filter(strategy == "optimal_mover", date < as.Date("2024-12-31")) %>%
ggplot(aes(x = date, y = prop_warm)) +
geom_line() +
geom_hline(yintercept = 0.5, linetype = "dashed", color = "gray50") +
theme_bw() +
xlab("Date") + ylab("Proportion of optimal movers in warm patch")
Build a long-form patch history for optimal movers:
patch_long <- as_tibble(patch_matrix) |>
bind_cols(fish_pop_init |> select(pid, strategy)) |>
pivot_longer(-c(pid, strategy), names_to = "day", values_to = "patch") |>
mutate(dayofsim = as.integer(sub("V", "", day))) |>
left_join(habitat_df |> select(dayofsim, date), by = "dayofsim") |>
filter(!is.na(patch)) |>
select(-day)
mover_patch <- patch_long |> filter(strategy == "optimal_mover")Plot 1 — Raster of all optimal movers. Each row is one fish, each column is a day, fill = patch. Fish are ordered by their overall proportion of time in the warm patch. Synchronised individuals will produce horizontal bands switching at the same time; independent movers will produce a noisier mosaic.
At seasonal and annual timescales, fish show similar movement patterns–tracking the primary gradient in growth potential and it shifts seasonally between warm and cold patches. But we also see individual variation at finer timescales, driven by stochasticity from the softmax patch selection function. Another observation is that the allometric scaling of the cost of movement appears to be working as expected. Early in the simulation, small fish switch infrequently (only when the benefit of switching is very large). But later on, larger fish switch more frequently, navigating smaller magnitude differences in density-dependent growth potential.
# Order fish by proportion of time spent in warm patch
pid_order <- mover_patch |>
group_by(pid) |>
summarise(prop_warm = mean(patch == "warm"), .groups = "drop") |>
arrange(prop_warm)
mover_patch |>
mutate(pid = factor(pid, levels = pid_order$pid)) |>
ggplot(aes(x = date, y = pid, fill = patch)) +
geom_rect(data = summer_shading,
aes(xmin = xmin, xmax = xmax, ymin = -Inf, ymax = Inf),
fill = "grey", alpha = 0.4, inherit.aes = FALSE) +
geom_tile() +
scale_fill_manual(values = c(warm = "#d95f02", cold = "#1f78b4")) +
theme_bw() +
theme(panel.grid = element_blank(),
axis.text.y = element_blank(),
axis.ticks.y = element_blank()) +
xlab("Date") + ylab("Individual fish (ordered by % time in warm)") +
labs(title = "Patch occupancy — all optimal movers",
subtitle = "Shaded = June–Aug; fish ordered bottom-to-top by increasing warm-patch use",
fill = "Patch")
# mover_patch |>
# filter(date < as.Date("2024-06-01")) %>%
# mutate(pid = factor(pid, levels = pid_order$pid)) |>
# ggplot(aes(x = date, y = pid, fill = patch)) +
# # geom_rect(data = summer_shading,
# # aes(xmin = xmin, xmax = xmax, ymin = -Inf, ymax = Inf),
# # fill = "grey", alpha = 0.4, inherit.aes = FALSE) +
# geom_tile() +
# scale_fill_manual(values = c(warm = "#d95f02", cold = "#1f78b4")) +
# theme_bw() +
# theme(panel.grid = element_blank(),
# axis.text.y = element_blank(),
# axis.ticks.y = element_blank()) +
# xlab("Date") + ylab("Individual fish (ordered by % time in warm)") +
# labs(title = "Patch occupancy — zoomed to first month of simulation",
# subtitle = "Shaded = June–Aug; fish ordered bottom-to-top by increasing warm-patch use",
# fill = "Patch")Plot 2 — Individual traces for 10 randomly sampled movers. Patch is encoded as a binary y-position (warm = 1, cold = 0) with a small per-fish y-offset to separate overlapping lines. A fish that moves independently of its peers will switch at a different time from the others.
set.seed(4921)
sample_pids <- sample(unique(mover_patch$pid), 10)
mover_patch |>
filter(pid %in% sample_pids) |>
mutate(patch_y = if_else(patch == "warm", 1, 0),
pid_label = factor(pid)) |>
ggplot(aes(x = date, y = patch_y, color = pid_label, group = pid_label)) +
geom_rect(data = summer_shading,
aes(xmin = xmin, xmax = xmax, ymin = -Inf, ymax = Inf),
fill = "grey", alpha = 0.3, inherit.aes = FALSE) +
geom_step(alpha = 0.8, linewidth = 0.6) +
scale_y_continuous(breaks = c(0, 1), labels = c("Cold", "Warm")) +
theme_bw() + theme(panel.grid = element_blank()) +
xlab("Date") + ylab("Patch") +
labs(title = "Patch occupancy — 10 randomly sampled optimal movers",
subtitle = "Each line is one fish; divergence between lines = independent decision-making",
color = "Fish ID")
Plot 3 — Switch event timing. For each fish, record every day a patch switch occurs and plot as a rug. Vertical clustering = synchronised switching; diffuse scatter = independent behaviour.
switch_events <- mover_patch |>
arrange(pid, date) |>
group_by(pid) |>
mutate(switched = patch != lag(patch)) |>
filter(switched) |>
ungroup()
switch_events |>
mutate(to_patch = patch) |>
ggplot(aes(x = date, y = factor(pid))) +
geom_rect(data = summer_shading,
aes(xmin = xmin, xmax = xmax, ymin = -Inf, ymax = Inf),
fill = "grey", alpha = 0.3, inherit.aes = FALSE) +
geom_point(aes(color = to_patch), size = 1.2, alpha = 0.7) +
scale_color_manual(values = c(warm = "#d95f02", cold = "#1f78b4")) +
theme_bw() +
theme(panel.grid = element_blank(),
axis.text.y = element_blank(),
axis.ticks.y = element_blank()) +
xlab("Date") + ylab("Individual fish") +
labs(title = "Patch switch events — optimal movers",
subtitle = "Each dot = a switch; colour = destination patch. Vertical alignment = synchronised switching",
color = "Destination")
Fish are generally acting similarly at seasonal and annual timescales, but on any given day fish are largely acting independently. To introduce additional variation in movement strategies, consider the following:
tau, the sensitivity to growth differences specified by the softmax function (steepness). Increasing tau would make all fish more randomly noisy in their decisions (similar to if we add simple random variation) but also may have the unintended consequence of making fish more reluctant to move (i.e., fish need a larger growth benefit to initiate a movement). But tau also applies identically to every fish…so any reduced synchrony in movement decisions would be entirely stochastic, rather than biologically meaningful individual variationmove_stochastic = "indiv" with sigma_bold is the mechanism for this. Each fish draws a fixed movement threshold from a distribution, so some fish are consistently “bold” (move even when the gain is marginal) and others are consistently “reluctant” (only move when the growth advantage is large). That creates genuine individual variation in movement decisions that persists through time — not just day-to-day noise.Temperature experienced by optimal movers
p1 <- ibm_summary %>%
filter(strategy == "optimal_mover") %>%
ggplot(aes(x = date, color = strategy, fill = strategy)) +
geom_ribbon(aes(ymin = mean_temp - sd_temp, ymax = mean_temp + sd_temp),
alpha = 0.15, color = NA) +
geom_line(aes(y = mean_temp)) +
scale_color_manual(values = c(resident_warm = "red",
resident_cold = "blue",
optimal_mover = "darkgreen")) +
scale_fill_manual(values = c(resident_warm = "red",
resident_cold = "blue",
optimal_mover = "darkgreen")) +
theme_bw() + #ylim(0,10000) +
xlab("Date") + ylab("Mean experienced temperature (deg. C)")
p2 <- temp_long %>%
filter(strategy == "optimal_mover") %>%
ggplot(aes(x = date, y = temp, color = strategy, group = pid)) +
geom_line(alpha = 0.5) +
scale_color_manual(values = c(resident_warm = "red",
resident_cold = "blue",
optimal_mover = "darkgreen")) +
theme_bw() + #ylim(0,10000) +
xlab("Date") + ylab("Individual experienced temperature (deg. C)")
ggpubr::ggarrange(p1, p2, nrow = 1, common.legend = TRUE)
Experienced standardized growth rates over time, by strategy.
p1 <- ibm_summary %>%
# filter(strategy == "optimal_mover") %>%
ggplot(aes(x = date, color = strategy, fill = strategy)) +
geom_ribbon(aes(ymin = mean_ggd - sd_ggd, ymax = mean_ggd + sd_ggd),
alpha = 0.15, color = NA) +
geom_line(aes(y = mean_ggd)) +
scale_color_manual(values = c(resident_warm = "red",
resident_cold = "blue",
optimal_mover = "darkgreen")) +
scale_fill_manual(values = c(resident_warm = "red",
resident_cold = "blue",
optimal_mover = "darkgreen")) +
theme_bw() + #ylim(0,10000) +
geom_abline(slope = 0, intercept = 0, linetype = "dashed") +
xlab("Date") + ylab("Mean growth rate (g/g/d)")
p2 <- ggd_long %>%
ggplot(aes(x = date, y = ggd, color = strategy, group = pid)) +
geom_line(alpha = 0.5) +
scale_color_manual(values = c(resident_warm = "red",
resident_cold = "blue",
optimal_mover = "darkgreen")) +
theme_bw() + #ylim(0,10000) +
xlab("Date") + ylab("Individual growth rate (g/g/d)")
ggpubr::ggarrange(p1, p2, nrow = 1, common.legend = TRUE)
Compile end of simulation results
fish_results <- fish_pop %>%
mutate(
final_weight = mass_matrix[, n_days],
n_switches = switches
# boldness = move_threshold # positive = shy, negative = bold
)
fish_results %>%
group_by(strategy) %>%
summarise(mean_wt = round(mean(final_weight), 1),
mean_switches = round(mean(n_switches), 1))Plot only if move_stochastic = "indiv"
if (move_stochastic == "indiv") {
movers <- fish_results %>% filter(strategy == "optimal_mover")
# Panel A: boldness vs final weight
p_wt <- ggplot(movers, aes(x = boldness, y = final_weight)) +
geom_point(alpha = 0.6) +
geom_smooth(method = "lm", se = TRUE, color = "steelblue", linewidth = 0.8) +
geom_vline(xintercept = 0, linetype = "dashed", color = "grey50") +
annotate("text", x = 0.006, y = min(movers$final_weight) + 5,
label = "shy →", hjust = 0, size = 3.5, color = "grey40") +
annotate("text", x = -0.006, y = min(movers$final_weight) + 5,
label = "← bold", hjust = 1, size = 3.5, color = "grey40") +
labs(x = "Boldness (move_threshold)", y = "Final weight (g)",
title = "A: Boldness vs. end-of-season weight")
# Panel B: boldness vs number of patch switches
p_sw <- ggplot(movers, aes(x = boldness, y = n_switches)) +
geom_point(alpha = 0.6) +
geom_smooth(method = "lm", se = TRUE, color = "tomato", linewidth = 0.8) +
geom_vline(xintercept = 0, linetype = "dashed", color = "grey50") +
labs(x = "Boldness (move_threshold)", y = "No. patch switches",
title = "B: Boldness vs. switching frequency")
# Panel C: switching frequency vs final weight
p_sw_wt <- ggplot(movers, aes(x = n_switches, y = final_weight)) +
geom_point(alpha = 0.6) +
geom_smooth(method = "lm", se = TRUE, color = "mediumpurple", linewidth = 0.8) +
labs(x = "No. patch switches", y = "Final weight (g)",
title = "C: Switching frequency vs. end-of-season weight")
cowplot::plot_grid(p_wt, p_sw, p_sw_wt, ncol = 1)
}