Elasticities of \(\lambda\): making them comparable across models
To make the elasticities of the original model comparable with those of the aggregated models, we transform the original elasticity matrix to the aggregated stage structure as
\[ \mathbf{E}^{\mathrm{true}}_{\mathrm{agg}} = \mathbf{P}\, \mathbf{E}\!\bigl(\mathbf{A}\bigr)\, \mathbf{P}^{\top}, \]
where \(\mathbf{E}\!\bigl(\mathbf{A}\bigr)\) is the
elasticity of \(\lambda\) with respect
to the entries of the original projection matrix \(\mathbf{A}\), and \(\mathbf{P}\) is the partitioning matrix
induced by groups. Elasticities for each aggregated model
are then computed directly from its aggregated population projection
matrix, and the results for all models are plotted together.
# Partitioning matrix induced by the stage groups
# This matrix is constructed internally by mpm_aggregate(),
# but we reproduce it here because it can be used to map quantities
# from the original stage space to the aggregated space.
P <- mpm_partition(groups=groups, n=nrow(matA))
# Elasticity matrices in aggregated space (k x k) for each model
E_A <- mpm_elasticity(matA=matA,framework="lambda")$elasticity
E_list <- list(
"Original" = P %*% E_A %*% t(P),
"Agg lambda + standard" = mpm_elasticity(matA=m1$A,framework="lambda")$elasticity,
"Agg lambda + elasticity" = mpm_elasticity(matA=m2$A,framework="lambda")$elasticity,
"Agg R0 + standard" = mpm_elasticity(matA=m3$A,framework="lambda")$elasticity,
"Agg R0 + elasticity" = mpm_elasticity(matA=m4$A,framework="lambda")$elasticity
)
# Build a long data.frame for all nonzero entries (row-major order)
to_long <- function(M, model_name) {
idx <- which(M != 0, arr.ind = TRUE)
data.frame(
model = model_name,
row = idx[, 1],
col = idx[, 2],
entry = paste(idx[, 1], idx[, 2], sep = ","),
elasticity = M[idx],
stringsAsFactors = FALSE
)
}
elast_df <- do.call(rbind, Map(to_long, E_list, names(E_list)))
# Keep positive values for log scale
elast_df <- elast_df[elast_df$elasticity > 0, ]
# Row-major ordering: row 1 entries first, row 2 second, rows 3+ third, etc.
elast_df <- elast_df[order(elast_df$row, elast_df$col), ]
models_order <- names(E_list)
entries <- unique(elast_df$entry)
# Create matrix for barplot: rows = models (5), cols = entries
elast_mat <- sapply(models_order, function(m) {
elast_df$elasticity[elast_df$model == m]
})
elast_mat <- t(elast_mat)
rownames(elast_mat) <- models_order
colnames(elast_mat) <- entriesPlot elasticities of \(\lambda\) by matrix entry
Each x-axis category corresponds to a matrix entry \([i,j]\) that is nonzero in at least one of the five populationb projection matrices. Within each category, elasticities are shown for the original model and the four aggregated models.
Figure 1. Elasticities of \(\lambda\) with respect to matrix
entries.
Bars are grouped by matrix entry, with colors indicating the different
five models. Because elasticities sum to 1 within each matrix, the
figure illustrates how the influence on \(\lambda\) is distributed across
life-history components. The models shown in the legend correspond to
those described in Table 1.
# Build biologically meaningful entry labels
# Build (row, col) vectors in the exact column order of elast_mat
rc <- do.call(rbind, strsplit(colnames(elast_mat), ","))
r_vec <- as.integer(rc[, 1])
c_vec <- as.integer(rc[, 2])
make_entry_label <- function(r, c) {
if (r == 1) {
bquote(F[1, .(c)])
} else if (r == 2) {
bquote(C[2, .(c)])
} else {
bquote(U[.(r), .(c)])
}
}
entry_labels <- mapply(make_entry_label, r_vec, c_vec, SIMPLIFY = FALSE)
# Colors by model
# Same colors as the vital-rate plot for consistency
cols <- c("#1b9e77", "#d95f02", "#7570b3", "#e7298a", "#66a61e")
# Leave room for left legend and long x labels
op <- par(mar = c(7, 6, 4, 2))
bp <- barplot(
elast_mat,
beside = TRUE,
log = "y",
col = cols,
border = NA,
ylab = expression("Elasticity of " * lambda * " (log scale)"),
xaxt = "n",
space = c(0.2, 1) # ← this is the key line
)
axis(
side = 1,
at = colMeans(bp),
labels = entry_labels,
las = 2,
cex.axis = 0.9
)
legend(
"topleft",
legend = c(
"Original",
expression(paste("Agg ", lambda, " + standard")),
expression(paste("Agg ", lambda, " + elasticity")),
expression(paste("Agg ", R[0], " + standard")),
expression(paste("Agg ", R[0], " + elasticity"))
),
fill = cols,
bty = "n",
inset = 0.02
)
How to read Figure 1. Each x-axis label corresponds to a vital rate represented by a matrix entry \([i,j]\). Fertility rates \(F[i,j]\) describe sexual reproduction, representing the contribution of individuals in stage \(i\) to seedling production over the projection interval. Clonal reproduction rates \(C[i,j]\) represent the contribution of individuals in stage \(i\) to the production of suckers over the projection interval. Survival and transition probabilities \(U[i,j]\) give the probability that an individual in stage \(i\) survives and transitions to stage \(j\) over the projection interval.
