Changes in age-structure over four decades were a key determinant of population growth rate in a long-lived mammal

This markdown file is split in to the following sections:

  1. Load and explore data from "Jackson_etal_data.RData" and "Jackson_etal_simulationdata.RData", and the packages/functions used in analyses
  2. Explore changes in age-structure through time
  3. Generate annual matrix population models (MPMs) between 1970-2014
  4. Calculate population growth rates under different scenarios
  5. Assess the contributions of the age-structure and projection matrix
  6. Assess the contributions of survival and birth

Please ensure that the working directory is set to the Jackson_etal_analyses/ zipped folder if you wish to carry out analyses, which is the supplementary data file for the current manuscript which can be found in the Dryad data repository under Jackson et al. 2020 with the DOI doi:10.5061/dryad.m905qftwx. Furthermore, please ensure that you have installed the packages below before proceeding.

1. Loading packages, functions, and data

1a. Packages an versions

R version 3.6.2 (2019-12-12)

require(tidyverse)     # version 1.3.0
require(gridExtra)     # version 2.3
require(popbio)        # version 2.7
require(expm)          # version 0.999.4
require(viridis)       # version 0.5.1

1b. Functions

Source the les_ele function, which generates the components of the annual MPM from elephant demographic data, including the:

  • Leslie projection matrix of age-specific fertility and survival, \(\textbf{A}_t\)
  • Population vector of the starting age-structure, \(\textbf{n}_t\)
source("les_ele.R")
les_ele <- function(fitted_data,timeseries_data,year){
  
  ## Current year 
  crr_year = year
  fyear = fitted_data[which(fitted_data$year == crr_year),]
  
  #########################
  ## PROJECTION MATRIX A ##
  #########################
  
  ## BUILD A LESLIE MATRIX UNDER THE FORMATION OF CASWELL, 2001 (2.9) 
  lm = matrix(nrow = nrow(fyear), ncol = nrow(fyear), 0)
  delta = row(lm) - col(lm)
  
  lm[1,] = fyear$Fert
  capsurv = length(fyear$Surv)
  lm[delta == 1] = fyear$Surv[1:capsurv-1]
  
  ############################
  ## NT0 from starting year ##
  ############################
  # Population composition at starting year
  
  ages = unique(fyear$age)
  n_t0 = vector()
  for(i in 1:length(ages)){
    crr = ages[i]
    n_t0[i] = nrow(timeseries_data[which(timeseries_data$year == crr_year & timeseries_data$age == crr),]) 
  }
  
  return(list("projection_matrix" = lm, "NT0" = n_t0))
}

1c. Data

load("Jackson_etal_data.RData", verbose = TRUE)
## Loading objects:
##   fit_year
##   ts_dat
##   fit_sim
load("Jackson_etal_simulationdata.RData", verbose = TRUE)
## Loading objects:
##   AD_sum
##   coef_sum
##   coef_sum_pf

The three data files included in Jackson_etal_data.RData:

fit_year

Fitted age-specific demographic data for each year

## Rows: 3,266
## Columns: 4
## Groups: age [71]
## $ age  <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ year <dbl> 1970, 1971, 1972, 1973, 1974, 1975, 1976, 1977, 1978, 1979, 1980…
## $ Fert <dbl> 4.853949e-06, 4.911486e-06, 5.203463e-06, 5.723128e-06, 5.738070…
## $ Surv <dbl> 0.8703051, 0.8681035, 0.8680805, 0.8730743, 0.8694870, 0.8717534…
  • $age - age in years (0-70)
  • $year - year of the study (1970-2014)
  • $Fert - predicted fertility
  • $Surv - predicted survival
ts_dat

Time-series data

## Rows: 44,842
## Columns: 3
## $ indv <int> 1095, 1095, 1095, 1095, 1095, 1095, 1095, 1095, 1095, 1095, 1095…
## $ age  <dbl> 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18…
## $ year <dbl> 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003…
  • $indv - individual
  • $age - age in years (0-70)
  • $year - year of the study (1970-2014)
fit_sim

Fitted age-specific demographic data for each year, repeated over posterior simulations incorporating uncertainty in the initial vital rate models from posterior simulation.

## Rows: 3,266,000
## Columns: 5
## $ age  <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
## $ year <dbl> 1970, 1971, 1972, 1973, 1974, 1975, 1976, 1977, 1978, 1979, 1980…
## $ sim  <dbl> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1…
## $ Fert <dbl> 4.046085e-06, 2.878105e-06, 2.470718e-06, 2.386800e-06, 1.856978…
## $ Surv <dbl> 0.8930413, 0.8840356, 0.8932566, 0.8891898, 0.8851339, 0.8841238…
  • $age - age in years (0-70)
  • $year - year of the study (1970-2014)
  • $sim - posterior simulation run (1-1000)
  • $Fert - predicted fertility
  • $Surv - predicted survival

There are a further three data files included in Jackson_etal_simulationdata.RData:

AD_sum

Data of annual population growth rates under different scenarios incorporating the observed age-structure and projection matrix (as outlined below), summarised over posterior simulation iterations.

## Rows: 90
## Columns: 4
## Groups: year [45]
## $ year       <int> 1970, 1970, 1971, 1971, 1972, 1972, 1973, 1973, 1974, 1974…
## $ param_comb <chr> "A_av:N_av", "At:Nt", "A_av:N_av", "At:Nt", "A_av:N_av", "…
## $ lwr        <dbl> -0.0038426040, -0.0092606628, -0.0038426040, -0.0069672349…
## $ upr        <dbl> 0.004832567, 0.009112652, 0.004832567, 0.011982729, 0.0048…
  • $year - year of the study (1970-2014)
  • $param_comb - character vector of the parameter combinations in the model
  • $lwr - the lower bound (90% limit) of posterior simulations for realised annual population growth rate
  • $upr - the upper bound (90% limit) of posterior simulations for realised annual population growth rate
coef_sum

The contributions of age-structure, projection matrix, and their interaction, to annual short-term population growth rates, summarised over posterior simulation iterations.

## Rows: 135
## Columns: 5
## Groups: year [45]
## $ year    <int> 1970, 1970, 1970, 1971, 1971, 1971, 1972, 1972, 1972, 1973, 1…
## $ term    <fct> A, N, AN, A, N, AN, A, N, AN, A, N, AN, A, N, AN, A, N, AN, A…
## $ mn_cont <dbl> 0.0172340928, -0.0158130150, -0.0019218279, 0.0135750273, -0.…
## $ lwr     <dbl> 0.0072937736, -0.0179018118, -0.0074523673, 0.0034073173, -0.…
## $ upr     <dbl> 0.0271549031, -0.0137390386, 0.0030962718, 0.0238196074, -0.0…
  • $sim - posterior simulation run (1-1000)
  • $year - year of the study (1970-2014)
  • $term - model term (A - projection matrix, N- age-structure, AN - age-structure projection matrix combination)
  • $mn_cont - the mean contribution (model coefficient/effect size) to annual population growth rate over posterior simulations
  • $lwr - the lower bound (90% limit) of posterior simulations for contributions to population growth rate
  • $upr - the upper bound (90% limit) of posterior simulations for contributions to population growth rate
coef_sum_pf

The contributions of survival, birth rates, and age-structure to annual short-term population growth rates, summarised over posterior simulation iterations.

## Rows: 90
## Columns: 5
## Groups: year [45]
## $ year    <int> 1970, 1970, 1971, 1971, 1972, 1972, 1973, 1973, 1974, 1974, 1…
## $ term    <chr> "f", "p", "f", "p", "f", "p", "f", "p", "f", "p", "f", "p", "…
## $ mn_cont <dbl> 0.0153195280, 0.0019233126, 0.0131666429, 0.0004135262, 0.013…
## $ lwr     <dbl> 0.007453166, -0.004067652, 0.005194947, -0.005408293, 0.00578…
## $ upr     <dbl> 2.366444e-02, 7.186947e-03, 2.184838e-02, 5.728235e-03, 2.145…
  • $sim - posterior simulation run (1-1000)
  • $year - year of the study (1970-2014)
  • $term - model term (p- survival, f- birth rates and N- age-structure)
  • $mn_cont - the mean contribution (model coefficient/effect size) to annual population growth rate over posterior simulations
  • $lwr - the lower bound (90% limit) of posterior simulations for contributions to population growth rate
  • $upr - the upper bound (90% limit) of posterior simulations for contributions to population growth rate

2. Exploring age-structure through time

Using the timeseries data we can explore the age-structure in each year, presented in Fig. 1

age_str <- ts_dat %>% filter(age < 50, year >= 1970, year <= 2014) %>%
  mutate(age_class = age - (age %% 5)) %>% 
  group_by(year) %>% 
  mutate(tot = n()) %>% ungroup() %>% 
  group_by(year, age_class) %>% 
  summarise(num = n(), prop = num/tot[1])

3. Generating MPMs between 1970-2014

First, we use fit_year and ts_dat data within the les_ele function to generate:

for each year, \(t\), of the study.

years <- 1970:2014
projection_matrices <- list()
starting_agestructure <- list()

for(i in 1:length(years)){
  
  crr_year = years[i]
  crr_mod = les_ele(fitted_data = fit_year, timeseries_data = ts_dat, year = crr_year)
  
  projection_matrices[[i]] = crr_mod$projection_matrix
  starting_agestructure[[i]] = crr_mod$NT0
  
}

Now we have a list of projection matrices and a list of starting age-structures across the years of the study. Here I show the first 5 (1970-1974) as an example of how these look:

str(projection_matrices[1:5]) # projection matrices
## List of 5
##  $ : num [1:71, 1:71] 4.85e-06 8.70e-01 0.00 0.00 0.00 ...
##  $ : num [1:71, 1:71] 4.91e-06 8.68e-01 0.00 0.00 0.00 ...
##  $ : num [1:71, 1:71] 5.20e-06 8.68e-01 0.00 0.00 0.00 ...
##  $ : num [1:71, 1:71] 5.72e-06 8.73e-01 0.00 0.00 0.00 ...
##  $ : num [1:71, 1:71] 5.74e-06 8.69e-01 0.00 0.00 0.00 ...
str(starting_agestructure[1:5]) # age structures
## List of 5
##  $ : int [1:71] 28 31 20 19 23 18 12 14 14 17 ...
##  $ : int [1:71] 18 24 31 20 19 23 18 11 14 14 ...
##  $ : int [1:71] 31 12 23 30 20 19 23 18 11 14 ...
##  $ : int [1:71] 49 19 11 23 30 20 18 22 18 10 ...
##  $ : int [1:71] 32 36 19 11 23 30 20 17 22 18 ...

3a. Average environment projection model

Next, to assess the contribution of environment (projection matrix) and age-structure on population growth rate we need to generate an average environment model, which includes:

  • Average environment projection matrix, \(\overline{\textbf{A}}\)
  • Average environment age-structure \(\overline{\textbf{n}}\)

This is the mean projection matrix over the study period, and the stable age distribution associated with it, calculated using the popbio::stable.stage function.

average_matrix <- Reduce("+", projection_matrices[which(years == 1970):length(years)])/ 
  length(which(years == 1970):length(years)) # mean projection matrix
average_nt0 <- (stable.stage(average_matrix))* # right eignevector of average matrix, calculated using popbio
  mean(unlist(lapply(starting_agestructure[which(years == 1970):length(years)],FUN = sum)))

4. Calculate population growth rates under different scenarios

Now to explore the contribution of age-structure we calculate the short-term population growth rate, \(\lambda\), in each year, \(t\), described in equations 3-6 of the manuscript, and using all pairwise combinations of \(\textbf{A}_t\), \(\overline{\textbf{A}}\), \(\textbf{n}_t\), and \(\overline{\textbf{n}}\):

We first initialise the data, which we will fill with the different \(\lambda\) values, where the suffix "_av" is the average environment, and "t" is the observed model term.

AD_data <- expand.grid(A_text = c("A_av","At"), 
                          N_text = c("N_av","Nt"),
                          year = years,  
                          lambda_realised = NA) %>% 
  mutate(A = ifelse(A_text == "A_av",0,1), 
         N = ifelse(N_text == "N_av",0,1), 
         AN = A*N, year_f =  factor(year))

glimpse(AD_data)
## Rows: 180
## Columns: 8
## $ A_text          <fct> A_av, At, A_av, At, A_av, At, A_av, At, A_av, At, A_a…
## $ N_text          <fct> N_av, N_av, Nt, Nt, N_av, N_av, Nt, Nt, N_av, N_av, N…
## $ year            <int> 1970, 1970, 1970, 1970, 1971, 1971, 1971, 1971, 1972,…
## $ lambda_realised <lgl> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, N…
## $ A               <dbl> 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1,…
## $ N               <dbl> 0, 0, 1, 1, 0, 0, 1, 1, 0, 0, 1, 1, 0, 0, 1, 1, 0, 0,…
## $ AN              <dbl> 0, 0, 0, 1, 0, 0, 0, 1, 0, 0, 0, 1, 0, 0, 0, 1, 0, 0,…
## $ year_f          <fct> 1970, 1970, 1970, 1970, 1971, 1971, 1971, 1971, 1972,…

Then we go through and calculate \(\lambda\) for each scenario in each year

for(i in 1:nrow(AD_data)){
  
  crr_row = AD_data[i,]
  
  # current projection matrix
  if(crr_row$A_text == "A_av"){crr_A = average_matrix}
    else{crr_A = projection_matrices[[which(years == crr_row$year)]]}
  
  # current starting age-structure
  if(crr_row$N_text == "N_av"){crr_N = average_nt0}
    else{crr_N = starting_agestructure[[which(years == crr_row$year)]]}
  
  # calculate one-step ahead realised lambda
  n_t = (crr_A %*% crr_N)
  AD_data[i,"lambda_realised"] = sum(n_t)/sum(crr_N)
  
}

Here we present the \(\lambda(\textbf{A}_t, \textbf{n}_t)\) and \(\lambda(\overline{\textbf{A}}, \overline{\textbf{n}})\) population growth rates. All population growth rates described in equations 3-6 are presented in Fig. S4.

lambda_dat <- AD_data %>% mutate(param_comb = paste0(A_text,":",N_text))
lamb <- filter(lambda_dat, param_comb %in% c("At:Nt", "A_av:N_av") == T)
plasma_cols <- viridis::plasma(10)

5. Assess the contributions of the age-structure and projection matrix

Using an ANOVA decomposition with a linear model, we assess the contributions of the environment (projection matrix) and age-structure on population growth rates compared to the average environment.

We use the natural log-transformed population growth rate in the variance decomposition:

And for the ANOVA. This assesses the change in \(\lambda\) associated with addition of the observed projection matrix \(\textbf{A}_t\), where A = 1, and the observed age-structure \(\textbf{n}_t\), where N = 1, for each year of the study (interaction with the year)

AD_mod <- lm(log(lambda_realised) ~ 1 + A:year_f + N:year_f + AN:year_f, data = AD_data) 
formula(AD_mod)
## log(lambda_realised) ~ 1 + A:year_f + N:year_f + AN:year_f

The intercept here is the average environment popualtion growth rate \(\lambda(\overline{\textbf{A}}, \overline{\textbf{n}})\) and the three terms denote the contribution of adding \(\textbf{A}_t\) and \(\textbf{n}_t\), as well as any remainder contribution that is present in the observed population growth rate \(\lambda(\textbf{A}_t, \textbf{n}_t)\). This is the analysis captured in equation 7 of the manuscript:

\(\ln \lambda(\textbf{A}_t, \textbf{n}_t) = \ln \lambda(\overline{\textbf{A}}, \overline{\textbf{n}}) + \Delta\textbf{A}_t + \Delta\textbf{n}_t + \Delta\textbf{A}_tx\Delta\textbf{n}_t\)

Now lets take a look at these contributions.

mod_coef <- coef(AD_mod)
coef_dat <- data.frame(year = 1970:2014, 
                       cont = c(mod_coef[grep("A[:]", names(mod_coef))], 
                                mod_coef[grep("[:]N", names(mod_coef))],
                                mod_coef[grep("[:]AN", names(mod_coef))]),
                       term = c(rep("A", 45), rep("N", 45), rep("AN",45)),
                       Intercept = coef(AD_mod)["(Intercept)"])
year_dat <- coef_dat %>% group_by(year) %>% summarise(pred_lambda = sum(cont) + Intercept[1])
coef_dat$term <- factor(coef_dat$term, levels = c("A", "N", "AN"))

5a. The contributions of age-structure and projection matrix incorporating uncertainty from the vital rate models.

Now, to incorporate the uncertainty of these contribution estimates from the initial vital rate models, we repeat the calculation of population growth rates and the ANOVA, but over 1000 simulation runs from posterior simulation of the vital rate models. We will not run this here due to the computational requirements. Instead, here you have the code to run this and calculate population growth rates and assess contributions from the fit_sim data object. We also have the AD_sum and coef_sum result objects, which we use to make the figures in the manuscript.

### 5a.i. Generating the parts of the simulation experiment

n <- 1000 # simulation runs
delta <- row(average_matrix) - col(average_matrix) # delta matrix to recreate A[t]

# Data to store the results
AD_fill <- expand.grid(A_text = c("A_av","At"), 
                       N_text = c("N_av","Nt"),
                       year = years, 
                       lambda_realised = NA) %>% 
  mutate(A = ifelse(A_text == "A_av",0,1), 
         N = ifelse(N_text == "N_av",0,1), 
         AN = A*N, year_f =  factor(year))

AD_sim <- expand.grid(sim = seq_len(n), 
                      A_text = c("A_av","At"), 
                      N_text = c("N_av","Nt"),
                      year = years, 
                      lambda_realised = NA) %>% 
  mutate(A = ifelse(A_text == "A_av",0,1), 
         N = ifelse(N_text == "N_av",0,1), 
         AN = A*N, year_f =  factor(year))

coef_sim <- expand.grid(sim = seq_len(n), 
                        year = 1970:2014, 
                        cont = NA, 
                        term = c("A","N","AN"))

### 5a.ii. Running through simulations and repeating decomposition
for(i in seq_len(n)){
  
  # current simulation
  crr_sim = i
  
  #________________________________________________________
  ## 1. Generating model parameters
  
  # current fitted data
  crr_fit = dplyr::filter(fit_sim, sim == crr_sim)
  
  # Average environment model parameters
  fit_av = crr_fit %>% group_by(age) %>% 
    summarise(f = mean(Fert),
              p = mean(Surv))
  
  # Create average age-structure based on average f and p in the simulation
  av_A = average_matrix*0
  av_p_mat = fit_av$p[1:((nrow(fit_av)) - 1)]
  av_A[delta == 1] = av_p_mat
  av_A[1,] = fit_av$f # here don't separate fertility and survival 
  
  av_N = (popbio::stable.stage(av_A))* 
    mean(unlist(lapply(starting_agestructure[which(years == 1970):length(years)],FUN = sum)))
  
  #________________________________________________________
  ## 2. Calculate lambda for each scenario
  
  for(j in 1:nrow(AD_fill)){
    
    crr_row = AD_fill[j,]
    
    # current Projection matrix
    if(crr_row$A_text == "A_av"){
      crr_p = fit_av$p
      crr_f = fit_av$f}
    else{crr_p = (crr_fit %>% filter(year == crr_row$year) %>%
                    group_by(age) %>% 
                    summarise(p = mean(Surv)))$p
         crr_f = (crr_fit %>% filter(year == crr_row$year) %>%
               group_by(age) %>% 
               summarise(f = mean(Fert)))$f}
    
    # current starting age-structure
    if(crr_row$N_text == "N_av"){crr_N = av_N}
    else{crr_N = starting_agestructure[[which(years == crr_row$year)]]}
    
    # create the matrix from each component
    crr_A = average_matrix*0
    
    # put in your new values
    crr_p_mat = crr_p[1:((length(crr_p)) - 1)]
    crr_A[delta == 1] = crr_p_mat
    crr_A[1,] = crr_f
    
    # calculate one-steap ahead realised lambda
    n_t = (crr_A %*% crr_N)
    AD_fill[j,"lambda_realised"] = sum(n_t)/sum(crr_N)
  }
  
  #________________________________________________________
  ## 3. ANOVA decomposition
  
  AD_mod = lm(log(lambda_realised) ~ 1 + A:year_f + N:year_f + AN:year_f, data = AD_fill) 
  mod_coef = coef(AD_mod)
  
  #________________________________________________________
  ## 4. Storing data
  
  AD_sim[which(AD_sim$sim == crr_sim), "lambda_realised"] = AD_fill$lambda_realised
  coef_sim[which(coef_sim$sim == crr_sim), "cont"] = c(mod_coef[grep("A[:]", names(mod_coef))], 
                                                       mod_coef[grep("[:]N", names(mod_coef))],
                                                       mod_coef[grep("[:]AN", names(mod_coef))])
  
  cat('\r',"Your Job is",round(i/n, 3) * 100,"% Complete")
}

Now in figure 2, using the results in AD_sum and coef_sum, we plot out the annual population growth rates and the contributions, but incorporating uncertainty from the posterior simulations. The lines are the mean value with 90% confidence intervals from the posterior simulations.

6. Decomposing the projection matrix in to survival and birth contributions

Finally, we follow the same workflow as in the previous analyses, but this time extend to include the separate contribution of each element of the environmental component, the survival \(\textbf{p}_t\) and birth \(\textbf{f}_t\) probability. We first calculated average environment terms separately for survival and birth (rather than for \(\textbf{A}_t\) as a whole).

First step is to initialise variance decomposition data and average environment model terms.

# VD data set up
AD_data_p_f <- expand.grid(p_text = c("p_av","pt"), 
                              f_text = c("f_av","ft"), 
                              N_text = c("N_av","Nt"),
                              year = years,  lambda_realised = NA) %>% 
  mutate(p = ifelse(p_text == "p_av",0,1),
         f = ifelse(f_text == "f_av",0,1), 
         N = ifelse(N_text == "N_av",0,1), 
         pFN = p*f*N, year_f =  factor(year))
glimpse(AD_data_p_f)
## Rows: 360
## Columns: 10
## $ p_text          <fct> p_av, pt, p_av, pt, p_av, pt, p_av, pt, p_av, pt, p_a…
## $ f_text          <fct> f_av, f_av, ft, ft, f_av, f_av, ft, ft, f_av, f_av, f…
## $ N_text          <fct> N_av, N_av, N_av, N_av, Nt, Nt, Nt, Nt, N_av, N_av, N…
## $ year            <int> 1970, 1970, 1970, 1970, 1970, 1970, 1970, 1970, 1971,…
## $ lambda_realised <lgl> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, N…
## $ p               <dbl> 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1,…
## $ f               <dbl> 0, 0, 1, 1, 0, 0, 1, 1, 0, 0, 1, 1, 0, 0, 1, 1, 0, 0,…
## $ N               <dbl> 0, 0, 0, 0, 1, 1, 1, 1, 0, 0, 0, 0, 1, 1, 1, 1, 0, 0,…
## $ pFN             <dbl> 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0,…
## $ year_f          <fct> 1970, 1970, 1970, 1970, 1970, 1970, 1970, 1970, 1971,…
# Average environment terms
delta <- row(average_matrix) - col(average_matrix) # delta matrix to recreate At
# Divide by S to get back to birth in order to split it out
f_av <- (fit_year %>% group_by(age) %>% summarise(f = mean(Fert)/mean(Surv)))$f 
p_av <- (fit_year %>% group_by(age) %>% summarise(p = mean(Surv)))$p

Then we calculate the population growth rate, but this time adding in \(\textbf{p}_t\) and \(\textbf{f}_t\) separately, to the average terms.

for(i in 1:nrow(AD_data_p_f)){
  
  crr_row = AD_data_p_f[i,]

  # current SURVIVAL
  if(crr_row$p_text == "p_av"){crr_p = p_av}
  else{crr_p = (fit_year %>% filter(year == crr_row$year) %>%
                  group_by(age) %>% 
                  summarise(p = mean(Surv)))$p}
  
  # current FERTILITY - f = birth*p 
  if(crr_row$f_text == "f_av"){crr_f = f_av} 
  else{crr_f = (fit_year %>% filter(year == crr_row$year) %>%
                  group_by(age) %>%
                  summarise(f = mean(Fert)/mean(Surv)))$f}
  
  # current starting age-structure
  if(crr_row$N_text == "N_av"){crr_N = average_nt0}
  else{crr_N = starting_agestructure[[which(years == crr_row$year)]]}
  
  # create the matrix from each component
  crr_A = average_matrix*0
  
  # put in your new values
  crr_p_mat = crr_p[1:((length(crr_p)) - 1)]
  crr_A[delta == 1] = crr_p_mat
  crr_A[1,] = crr_f*crr_p
  
  # calculate one-steap ahead realised lambda
  n_t = (crr_A %*% crr_N)
  AD_data_p_f[i,"lambda_realised"] = sum(n_t)/sum(crr_N)
  
}

And now we repeat the ANOVA, calculating the effect of adding in observed terms for \(\textbf{p}_t\), \(\textbf{f}_t\) and \(\textbf{n}_t\), and including only interaction terms between survival/birth and age-structure, described in equation 8:

\(\ln \lambda(\textbf{A}_t, \textbf{n}_t) = \ln \lambda(\overline{\textbf{A}}, \overline{\textbf{n}}) + \Delta\textbf{p}_t + \Delta\textbf{f}_t + \Delta\textbf{n}_t + \Delta\textbf{p}_tx\Delta\textbf{n}_t + \Delta\textbf{f}_tx\Delta\textbf{n}_t\)

AD_mod_pf <- lm(log(lambda_realised) ~ 1 + (p + f + N + p:N + f:N):year_f, data = AD_data_p_f)
formula(AD_mod_pf)
## log(lambda_realised) ~ 1 + (p + f + N + p:N + f:N):year_f

Here we assess the contributions of survival and birth to population growth rates:

mod_coef <- coef(AD_mod_pf)
coef_dat_pf <- data.frame(year = 1970:2014, 
                       cont = c(mod_coef[grep("p[:]year", names(mod_coef))], 
                                mod_coef[grep("f[:]year", names(mod_coef))],
                                mod_coef[grep("p[:]N[:]year", names(mod_coef))],
                                mod_coef[grep("f[:]N[:]year", names(mod_coef))]),
                       term = c(rep("p", length(1970:2014)), rep("f", length(1970:2014)), 
                                rep("pN",length(1970:2014)),
                                rep("fN",length(1970:2014))),
                       Intercept = coef(AD_mod_pf)["(Intercept)"])
year_dat <- coef_dat_pf %>% group_by(year) %>% summarise(pred_lambda = sum(cont) + Intercept[1])
plasma_cols <- viridis::plasma(10)
codat <- filter(coef_dat_pf, term %in% c("p", "f") == T)

6a. Effects of survival and birth incorporating vital rate uncertainity

Finally, we plot out figure 3, in which we explore the contributions to population growth rates but incorporating uncertainty in the vital rates from posterior simulation. First you have the code to calculate population growth rates and perform the ANOVA for each simulation run.

### 6a.i. Generating the parts of the simulation experiment
AD_fill_pf <- expand.grid(p_text = c("p_av","pt"), 
                           f_text = c("f_av","ft"), 
                           N_text = c("N_av","Nt"),
                           year = years,  lambda_realised = NA) %>% 
  mutate(p = ifelse(p_text == "p_av",0,1),
         f = ifelse(f_text == "f_av",0,1), 
         N = ifelse(N_text == "N_av",0,1), 
         pFN = p*f*N, year_f =  factor(year))
glimpse(AD_fill_pf)


AD_sim_pf <- expand.grid(sim = seq_len(n),
                           p_text = c("p_av","pt"), 
                           f_text = c("f_av","ft"), 
                           N_text = c("N_av","Nt"),
                           year = years,  lambda_realised = NA) %>% 
  mutate(p = ifelse(p_text == "p_av",0,1),
         f = ifelse(f_text == "f_av",0,1), 
         N = ifelse(N_text == "N_av",0,1), 
         pFN = p*f*N, year_f =  factor(year))

coef_sim_pf <- expand.grid(sim = seq_len(n), 
                        year = 1970:2014, 
                        cont = NA, 
                        term = c("p","f","N"))

### 6a.ii. Running through simulations and repeating decomposition
for(i in seq_len(n)){
  
  # current simulation
  crr_sim = i
  
  #________________________________________________________
  ## 1. Generating model parameters
  
  # current fitted data
  crr_fit = dplyr::filter(fit_sim, sim == crr_sim)

  # Average environment vital rates divide by S to get back to birth in order to split it out
  f_av = (crr_fit %>% group_by(age) %>% summarise(f = mean(Fert)/mean(Surv)))$f 
  p_av = (crr_fit %>% group_by(age) %>% summarise(p = mean(Surv)))$p
  
  # Create average age-structure based on average f and p in the simulation
  av_A = average_matrix*0
  av_p_mat = p_av[1:((length(p_av)) - 1)]
  av_A[delta == 1] = av_p_mat
  av_A[1,] = f_av*p_av
  
  av_N = (popbio::stable.stage(av_A))* 
    mean(unlist(lapply(starting_agestructure[which(years == 1970):length(years)],FUN = sum)))
  
  #________________________________________________________
  ## 2. Calculate lambda for each scenario
  
  for(j in 1:nrow(AD_fill_pf)){
    
    crr_row = AD_fill_pf[j,]
    
    # current SURVIVAL
    if(crr_row$p_text == "p_av"){crr_p = p_av}
    else{crr_p = (crr_fit %>% filter(year == crr_row$year) %>%
                    group_by(age) %>% 
                    summarise(p = mean(Surv)))$p}
    
    # current FERTILITY - f = birth*p 
    if(crr_row$f_text == "f_av"){crr_f = f_av} 
    else{crr_f = (crr_fit %>% filter(year == crr_row$year) %>%
                    group_by(age) %>%
                    summarise(f = mean(Fert)/mean(Surv)))$f}
    
    # current starting age-structure
    if(crr_row$N_text == "N_av"){crr_N = av_N}
    else{crr_N = starting_agestructure[[which(years == crr_row$year)]]}
    
    # create the matrix from each component
    crr_A = average_matrix*0
    
    # put in your new values
    crr_p_mat = crr_p[1:((length(crr_p)) - 1)]
    crr_A[delta == 1] = crr_p_mat
    crr_A[1,] = crr_f*crr_p
    
    # calculate one-steap ahead realised lambda
    n_t = (crr_A %*% crr_N)
    AD_fill_pf[j,"lambda_realised"] = sum(n_t)/sum(crr_N)
  }
  
  #________________________________________________________
  ## 3. ANOVA decomposition
  AD_mod_pf = lm(log(lambda_realised) ~ 1 + (p + f + N + p:N + f:N):year_f, 
                  data = AD_fill_pf)
  mod_coef_pf = coef(AD_mod_pf)
  
  #________________________________________________________
  ## 4. Storing data
  AD_sim_pf[which(AD_sim_pf$sim == crr_sim), "lambda_realised"] = AD_fill_pf$lambda_realised
  coef_sim_pf[which(coef_sim_pf$sim == crr_sim), "cont"] = c(mod_coef_pf[grep("p[:]year", names(mod_coef_pf))], 
                                                       mod_coef_pf[grep("f[:]year", names(mod_coef_pf))],
                                                       mod_coef_pf[grep("^N[:]year", names(mod_coef_pf))])
  
  cat('\r',"Your Job is",round(i/n, 3) * 100,"% Complete")

}