## ----setup, include=FALSE----------------------------------------------------- knitr::opts_chunk$set( collapse = TRUE, comment = "#>" ) ## ----projection matrix, echo=FALSE, out.width="50%", fig.cap=" "------------- knitr::include_graphics("figures/Slide2.PNG") ## ----lambda-r0-figure, echo=FALSE, out.width="90%", fig.cap="Figure 1. Interpretation of λ and R0 frameworks"---- knitr::include_graphics("figures/Slide1.PNG") ## ----------------------------------------------------------------------------- library(mpmaggregate) library(expm) library(knitr) library(kableExtra) ## ----table-preserved, echo=FALSE, results='asis'------------------------------ preserved_tbl <- data.frame( Framework = c("lambda", "lambda", "R0", "R0"), Criterion = c("standard", "elasticity-consistent", "standard", "elasticity-consistent"), Preserved = c( "λ (stable growth rate)
Stable stage distribution
Interstage flow matrix", "λ (stable growth rate)
Stable stage distribution
Reproductive values
Elasticities of λ
Generation time (T_a)", "R₀ (net reproductive rate)
Cohort stable stage distribution
Cohort interstage flow matrix", "R₀ (net reproductive rate)
Cohort stable stage distribution
Cohort reproductive values
Elasticities of R₀
Cohort generation time (T_c)" ), check.names = FALSE ) knitr::kable( preserved_tbl, format = "html", escape = FALSE, align = c("l", "l", "l"), col.names = c("Framework", "Criterion", "Consistent Demographic Quantities"), caption = paste0( "Table 1. Demographic quantities that remain consistent under ", "mpm_aggregate() in the λ and R₀ frameworks ", "for both the standard and elasticity-consistent aggregation criteria. ", "Under the λ framework, aggregation maintains consistency in stable ", "growth properties, whereas under the R₀ framework it maintains ", "consistency in cohort-based reproductive quantities. ", "Interstage flow weights the columns of A by their respective ", "stable stage densities (Yokomizo et al. 2024). ", "Here, “cohort” denotes the R₀-framework analogues of the ", "corresponding λ-framework demographic quantities. ", "Notice the symmetry between the λ and R₀ frameworks." ) ) |> kable_styling( full_width = FALSE, bootstrap_options = c("striped", "condensed") ) |> column_spec(3, width = "7cm") |> row_spec(0, extra_css = "border-bottom: 2px solid black;") |> footnote( general_title = "", general = paste0( "

", "", "Note. mpm_aggregate() retains the projection ", "interval of the original matrix population model.", "

" ), footnote_as_chunk = TRUE, escape = FALSE ) ## ----------------------------------------------------------------------------- # Example matrices used in the general-to-general MPM aggregation examples below #population projection matrix for Sclerocarya birrea #MatrixID = 247940 # Not run: requires Rcompadre and internet access #these matrices can be retrieved with: #library(Rcompadre) #compadre <- cdb_fetch("compadre") #mpm <- compadre[compadre$MatrixID == 247940, ] #A <- matA(mpm)[[1]] #U <- matU(mpm)[[1]] #F <- matF(mpm)[[1]] A <- matrix( c(0.0, 0.0000, 12.46, 0.4, 0.9160, 0.00, 0.0, 0.0371, 0.99), nrow = 3, byrow = TRUE ) #survival/transitions matrix U <- matrix( c(0.0, 0.0000, 0.00, 0.4, 0.9160, 0.00, 0.0, 0.0371, 0.99), nrow = 3, byrow = TRUE ) #reproduction matrix F <- matrix( c(0.0, 0.0000, 12.46, 0.0, 0.0000, 0.00, 0.0, 0.0000, 0.00), nrow = 3, byrow = TRUE ) # Stage aggregation used in later examples: # group vegetative + reproductive stages together, # leaving the seedling stage separate groups <- list( c(1), c(2,3) ) ## ----------------------------------------------------------------------------- # General-to-general MPM aggregation # in the lambda framework, standard aggregation res_lambda_std <- mpm_aggregate( matA = A, groups = groups, framework = "lambda", criterion = "standard" ) # Aggregated projection matrix res_lambda_std$matA_agg # Effectiveness of aggregation res_lambda_std$effectiveness # ---- Check: lambda consistency ---- # Expected spectral_radius(A) # Lambda of aggregated model spectral_radius(res_lambda_std$matA_agg) # ---- Check: stable stage distribution consistency ---- # P is the partitioning matrix that groups stages P <- mpm_partition(groups=groups,n=3) # w is the stable stage distribution w <- stable_stage(A=A) # Expected c(P%*%w) # stable stage distribution of aggregated model w_agg <-stable_stage(res_lambda_std$matA_agg) w_agg # ---- Check: interstage flows consistency ---- # Expected P%*%A%*%diag(w)%*%t(P) # Interstage flows of aggregated model res_lambda_std$matA_agg%*%diag(w_agg) ## ----------------------------------------------------------------------------- # General-to-general MPM aggregation # in the lambda framework, elasticity-consistent aggregation res_lambda_el <- mpm_aggregate( matA = A, matF = F, matU = U, groups = groups, framework = "lambda", criterion = "elasticity" ) # Aggregated matrix res_lambda_el$matA_agg # Effectiveness of aggregation res_lambda_el$effectiveness # ---- Check: lambda consistency ---- # Expected spectral_radius(A) # Lambda of aggregated model spectral_radius(res_lambda_el$matA_agg) # ---- Check: stable stage distribution consistency ---- # P is the partitioning matrix P <- mpm_partition(groups=groups,n=3) # w us the stable stage distribution w <- stable_stage(A=A) # Expected c(P%*%w) # Stable stage distribution of aggregated model stable_stage(res_lambda_el$matA_agg) # ---- Check: reproductive values consistency ---- # v is reproductive values (dominant left eigenvector) v = reproductive_values(A) # Expected c(solve(P%*%diag(w)%*%t(P))%*%P%*%(w*v)) # Reproductive values of aggregated model reproductive_values(res_lambda_el$matA_agg) # ---- Check: elasticities consistency ---- # Elasticity matrix EA <- mpm_elasticity(matA=A,framework="lambda")$elasticity # Expected P%*%EA%*%t(P) # Elasticities of aggregated model mpm_elasticity(matA=res_lambda_el$matA_agg,framework="lambda")$elasticity # ---- Check: generation time consistency ---- # Expected generation_time(matF=F,matU=U,framework="lambda")$generation_time # Generation time from aggregated model generation_time(matF=res_lambda_el$matF_agg, matU=res_lambda_el$matU_agg, framework="lambda")$generation_time ## ----------------------------------------------------------------------------- # General-to-general MPM aggregation # in the R0 framework, standard aggregation res_R0_std <- mpm_aggregate( matU = U, matF = F, groups = groups, framework = "R0", criterion = "standard" ) # Aggregated projection matrix res_R0_std$matA_agg # Effectiveness of aggregation res_R0_std$effectiveness # ---- Check: R0 consistency ---- # Expected spectral_radius(F%*%solve(diag(3)-U)) # R0 from aggregated matrix spectral_radius(res_R0_std$matF_agg%*%solve(diag(2)-res_R0_std$matU_agg)) # ---- Check: cohort stable stage distribution consistency ---- # w is the cohort stable stage distribution from a next generation matrix w <- stable_stage(solve(diag(3)-U)%*%F) # Expected for consistency c(P%*%stable_stage(solve(diag(3)-U)%*%F)) # Aggregated cohort stable stage distribution w_agg <- stable_stage(solve(diag(2)-res_R0_std$matU_agg)%*%res_R0_std$matF_agg) w_agg # ---- Check: cohort interstage flows consistency ---- # Expected P%*%A%*%diag(w)%*%t(P) # Aggregated interstage flows res_R0_std$matA_agg%*%diag(w_agg) ## ----------------------------------------------------------------------------- # General-to-general MPM aggregation # in the R0 framework, elasticity-consistent aggregation res_R0_el <- mpm_aggregate( matU = U, matF = F, groups = groups, framework = "R0", criterion = "elasticity" ) # Aggregated projection matrix res_R0_el$matA_agg # Effectiveness of aggregation res_R0_el$effectiveness # ---- Check: R0 consistency ---- # Expected R0 R0 <- spectral_radius(F%*%solve(diag(3)-U)) R0 # R0 from the aggregated model spectral_radius(res_R0_el$matF_agg%*%solve(diag(2)-res_R0_el$matU_agg)) # ---- Check: cohort stable stage distribution consistency ---- # Get partitioning matrix P <- mpm_partition(groups=groups,n=3) # Construct cohort projection matrix Aref = F + U*R0 # Cohort stable stage distribution w <- stable_stage(A=Aref) # Expected for consistency c(P%*%w) # Aggregated cohort projection matrix Aref_agg = res_R0_el$matF_agg+ R0*res_R0_el$matU_agg # Aggregated cohort stable stage distribution stable_stage(Aref_agg) # ---- Check: cohort reproductive values consistency ---- v = reproductive_values(Aref) # Expected c(solve(P%*%diag(w)%*%t(P))%*%P%*%(w*v)) # Cohort reproductive values for aggregated matrix reproductive_values(Aref_agg) # ---- Check: elasticities of R0 consistency ---- # Here elasticities are normalized to sum to 1 # Original elasticities EA <- mpm_elasticity(matF=F,matU=U,framework="R0")$elasticity # Expected for consistency P%*%EA%*%t(P) # Elasticities of R0 from aggregated matrix mpm_elasticity(matF=res_R0_el$matF_agg,matU=res_R0_el$matU_agg,framework="R0")$elasticity # ---- Check: cohort generation time consistency ---- # Expected (from original model) generation_time(matF=F,matU=U,framework="R0")$generation_time # Cohort generation time from aggregated model generation_time(matF = res_R0_el$matF_agg, matU = res_R0_el$matU_agg, framework="R0")$generation_time ## ----table-leslie-preserved, echo=FALSE, results='asis'----------------------- preserved_leslie_tbl <- data.frame( Framework = c("lambda", "lambda", "R0", "R0"), Criterion = c("standard", "elasticity-consistent", "standard", "elasticity-consistent"), Preserved = c( "λ (stable growth rate)
Stable age distribution
Interstage flow matrix of A^k", "λ (stable growth rate)
Stable age distribution
Reproductive values
Elasticities of λ^k with respect to the entries of A^k
Generation time (T_a) of A^k", "R₀ (net reproductive rate)
Cohort stable age distribution
consistent of A_k", "R₀ (net reproductive rate)
Cohort stable age distribution
Cohort reproductive values
Elasticities of R₀ with respect to A_k
Cohort generation time (T_c) for A_k" ), check.names = FALSE ) knitr::kable( preserved_leslie_tbl, format = "html", escape = FALSE, align = c("l", "l", "l"), col.names = c("Framework", "Criterion", "Consistent Demographic Quantities"), caption = paste0( "Table 2. Summary of the demographic properties that remain consistent under ", "leslie_aggregate() when reducing a Leslie matrix from dimensionality ", "n to m. The quantities the remain consistent depend on both the demographic framework ", "(long-term growth under λ or lifetime reproductive output under ", "R₀) and the aggregation criterion (standard versus ", "elasticity-consistent). The integer k = n/m defines the ", "temporal rescaling by aggregating a Leslie model. Quantities in the ", "λ framework are defined for A^k, ", "while cohort quantities in the R₀ framework are defined for ", "A_k^†. Notice the structural symmetry ", "between the λ and R₀ frameworks." ) ) |> kable_styling( full_width = FALSE, bootstrap_options = c("striped", "condensed") ) |> column_spec(3, width = "7cm") |> row_spec(0, extra_css = "border-bottom: 2px solid black;") |> footnote( general_title = "", general = paste0( "

", "", "Note. Aggregation with leslie_aggregate() ", "changes the projection interval from Δt to kΔt.
", "^† A_k denotes the k-step-ahead projection matrix ", "in the R₀ framework.

" ), footnote_as_chunk = TRUE, escape = FALSE ) ## ----------------------------------------------------------------------------- # New example used for Leslie-to-Leslie aggregation # These matrices replace the earlier example matrices (A, U, F) # Leslie population projection matrix for Pimephales promelas (MatrixID = 248187) # Not run: requires Rcompadre and internet access # Matrices can be retrieved with: # library(Rcompadre) # comadre <- cdb_fetch("comadre",version = "4.23.3.1") # mpm <- comadre[comadre$MatrixID == 248187, ] # A <- matA(mpm)[[1]] # U <- matU(mpm)[[1]] # F <- matF(mpm)[[1]] # Leslie population projection matrix A <- rbind( c(0.00, 0.00, 6.00, 62.50), c(0.50, 0.00, 0.00, 0.00), c(0.00, 0.18, 0.00, 0.00), c(0.00, 0.00, 0.12, 0.00) ) # Reproduction matrix F <- rbind( c(0.00, 0.00, 6.00, 62.50), c(0.00, 0.00, 0.00, 0.00), c(0.00, 0.00, 0.00, 0.00), c(0.00, 0.00, 0.00, 0.00) ) # Survival/transition matrix U <- rbind( c(0.00, 0.00, 0.00, 0.00), c(0.50, 0.00, 0.00, 0.00), c(0.00, 0.18, 0.00, 0.00), c(0.00, 0.00, 0.12, 0.00) ) # Partitioning matrix used for the aggregation examples below # (first two age classes combined, last two combined) # In practice this matrix is constructed automatically inside leslie_aggregate() # It is reproduced here only to verify the aggregation results. P <- rbind( c(1,1,0,0), c(0,0,1,1) ) # Dimensions used in the aggregation examples n <- 4 # dimensionality of the original matrix A m <- 2 # dimensionality of the aggregated matrix k <- n / m #(also constructed automatically) ## ----------------------------------------------------------------------------- # Leslie-to-Leslie MPM aggregation # in the lambda framework, standard aggregation res_leslie_lambda_std <- leslie_aggregate( matA = A, ngroups = 2, framework = "lambda", criterion = "standard" ) # Aggregated Leslie matrix res_leslie_lambda_std$matAk_agg # Effectiveness of aggregation res_leslie_lambda_std$effectiveness # ---- Check: lambda consistency ---- # Expected lambda spectral_radius(A)^k # Lambda of aggregated model spectral_radius(res_leslie_lambda_std$matAk_agg) # ---- Check: stable age distribution consistency ---- # Stable age distribution w <- leslie_stable_age(A=A) # Expected c(P%*%w) # Aggregated stable age distribution w_agg <-leslie_stable_age(res_leslie_lambda_std$matAk_agg) w_agg # ---- Check: interstage flow consistency ---- # Expected P%*%(A%^%k)%*%diag(w)%*%t(P) # Interstage flows from aggregated model res_leslie_lambda_std$matAk_agg%*%diag(w_agg) ## ----------------------------------------------------------------------------- # Leslie-to-Leslie MPM aggregation # in the lambda framework, elasticity-consistent aggregation res_leslie_lambda_el <- leslie_aggregate( matA = A, ngroups = 2, framework = "lambda", criterion = "elasticity" ) # Aggregated Leslie matrix res_leslie_lambda_el$matAk_agg # Effectiveness of aggregation res_leslie_lambda_el$effectiveness # get aggregated F and U F_agg <-matrix(0,2,2) F_agg[1,] <- res_leslie_lambda_el$matAk_agg[1,] U_agg <- res_leslie_lambda_el$matAk_agg U_agg[1,] <-0 # ---- Check: lambda consistency ---- # Expected spectral_radius(A)^k # Lambda for aggregated model spectral_radius(res_leslie_lambda_el$matAk_agg) # ---- Check: stable age distribution consistency ---- # Stable age distribution w <- leslie_stable_age(A=A) # Expected c(P%*%w) # Stable age distribution of aggregated odel w_agg <-leslie_stable_age(res_leslie_lambda_el$matAk_agg) w_agg # ---- Check: reproductive values consistency ---- # Get reproductive values v <- leslie_reproductive_values(A=A) # Expected c(solve(P%*%diag(w)%*%t(P))%*%P%*%(v*w)) # Reproductive values of aggregated model leslie_reproductive_values(A=res_leslie_lambda_el$matAk_agg) # ---- Check: elasticities consistency ---- # Get elasticities of lambda^k EA <- mpm_elasticity(A%^%k,framework="lambda")$elasticity # Expected P%*%EA%*%t(P) # Elasticities of lambda^k for aggregated model mpm_elasticity(res_leslie_lambda_el$matAk_agg,framework="lambda")$elasticity # ---- Check: generation time consistency ---- # Survival/transition matrix U_k <- U%^%k # Reproduction matrix F_k <- A%^%k - U_k # Expected generation time generation_time(matF=F_k,matU=U_k,framework="lambda")$generation_time # Generation time of aggregated model generation_time(matF=F_agg,matU=U_agg,framework="lambda")$generation_time ## ----------------------------------------------------------------------------- # Leslie-to-Leslie MPM aggregation # in the R0 framework, standard aggregation res_leslie_R0_std <- leslie_aggregate( matA = A, ngroups = 2, framework = "R0", criterion = "standard" ) # Aggregated Leslie matrix res_leslie_R0_std$matAk_agg # Effectiveness of aggregation res_leslie_R0_std$effectiveness # get F and U for aggregated matrix F_agg <- matrix(0,2,2) F_agg[1,] <- res_leslie_R0_std$matAk_agg[1,] U_agg <- res_leslie_R0_std$matAk_agg U_agg[1,] <- 0 # ---- Check: generation time consistency ---- # Expected R0 <- spectral_radius(F%*%solve(diag(4)-U)) R0 # R0 for aggregated model spectral_radius(F_agg%*%solve(diag(2)-U_agg)) # ---- Check: cohort stable age distribution consistency ---- # Standardized cohort projection matrix A_ref <- (F + U*R0)/R0 # Standardized cohort projection matrix for aggregated model A_ref_agg <- (F_agg + U_agg*R0)/R0 # w is the stable age distribution w <- leslie_stable_age(A=A_ref) # Expected c(P%*%w) # Stable age distribution for aggregated model w_agg <-leslie_stable_age(A_ref_agg) w_agg # ---- Check: cohort interstage flows consistency ---- # Survival/transition matrix (k steps ahead) U_k <- U%^%k # Reproduction matrix (k steps ahead) F_k <- A%^%k - U_k # A projection matrix (k steps ahead) A_k <- F_k + U_k # Expected P%*%A_k%*%diag(w)%*%t(P) # Interstage flows for aggregated model (F_agg + U_agg)%*%diag(w_agg) ## ----------------------------------------------------------------------------- # Leslie-to-Leslie MPM aggregation # in the R0 framework, elasticity-consistent aggregation res_leslie_R0_el <- leslie_aggregate( matA = A, ngroups = 2, framework = "R0", criterion = "elasticity" ) # Aggregated Leslie matrix res_leslie_R0_el$matAk_agg # Effectiveness of aggregation res_leslie_R0_el$effectiveness # Get F and U for aggregated matrix F_agg <- matrix(0,2,2) F_agg[1,] <- res_leslie_R0_el$matAk_agg[1,] U_agg <- res_leslie_R0_el$matAk_agg U_agg[1,] <- 0 # ---- Check: R0 consistency ---- # Expected R0 <- spectral_radius(F%*%solve(diag(4)-U)) R0 # R0 of aggregated model spectral_radius(F_agg%*%solve(diag(2)-U_agg)) # ---- Check: cohort stage age distribution consistency ---- # Standardized cohort projection matrix A_ref <- (F + U*R0)/R0 # Standardized cohort projection matrix for aggregated model A_ref_agg <- (F_agg + U_agg*R0)/R0 # Cohort stable age distribution w <- leslie_stable_age(A=A_ref) # Expected c(P%*%w) # Cohort stage age distribution for aggregated model w_agg <-leslie_stable_age(A_ref_agg) w_agg # ---- Check: cohort reproductive values consistency ---- # Cohort reproductive values v <- leslie_reproductive_values(A_ref) # Expected c(solve(P%*%diag(w)%*%t(P))%*%P%*%(v*w)) # Cohort reproductive values of aggregated model leslie_reproductive_values(A_ref_agg) # ---- Check: elasticities of R0 consistency ---- # These elasticities are normalized to sum to 1 # Survival/transition matrix (k steps ahead) U_k <- U%^%k # Reproduction matrix (k steps ahead) F_k <- A%^%k - U_k # Cohort projection matrix (k steps ahead) A_k <- F_k + U_k # Elasticity of R0 (normalized to sum to 1) EA <- mpm_elasticity(matF=F_k,matU=U_k,framework="R0")$elasticity # Expected P%*%EA%*%t(P) # Elasticity of R0 for the aggregated model mpm_elasticity(matF=F_agg,matU=U_agg,framework="R0")$elasticity # ---- Check: cohort generation time consistency ---- # Expected generation_time(matF=F_k, matU = U_k, framework="R0")$generation_time # Generation time of aggregated model generation_time(matF=F_agg,matU=U_agg, framework="R0")$generation_time