## ----setup, include = FALSE--------------------------------------------------- knitr::opts_chunk$set(echo = TRUE) library(aae.pop) library(scales) ## ----------------------------------------------------------------------------- popmat <- rbind( c(0, 0, 2, 4, 7), # reproduction from 3-5 year olds c(0.25, 0, 0, 0, 0), # survival from age 1 to 2 c(0, 0.45, 0, 0, 0), # survival from age 2 to 3 c(0, 0, 0.70, 0, 0), # survival from age 3 to 4 c(0, 0, 0, 0.85, 0) # survival from age 4 to 5 ) ## ----------------------------------------------------------------------------- demostoch_mask <- all_classes(popmat) # affects all classes demostoch_fn <- function(x) { rpois(length(x), lambda = x) } ## ----------------------------------------------------------------------------- demostoch <- demographic_stochasticity( masks = demostoch_mask, funs = demostoch_fn ) ## ----dev = "png", fig.alt = "Line plot showing 100 simulated trajectories initialised with the same initial conditions. Lines are variable due to demographic stochasticity and range from slightly increasing trajectories to complete extinction."---- # create population dynamics object popdyn <- dynamics(popmat, demostoch) # simulate population dynamics sims <- simulate(popdyn, nsim = 100) # plot the population trajectories plot(sims, col = alpha("#2171B5", 0.4)) ## ----------------------------------------------------------------------------- reproduction_mask <- reproduction(popmat, dims = 3:5) # only ages 3-5 reproduce reproduction_fn <- function(x) { rpois(length(x), lambda = x) } ## ----------------------------------------------------------------------------- transition_mask <- transition(popmat) # all classes this time transition_fn <- function(x) { # add a random deviation to x deviation <- runif(length(x), min = -0.1, max = 0.1) x <- x + deviation # make sure the result isn't negative or greater than 1 x[x < 0] <- 0 x[x > 1] <- 1 # return the value x } ## ----------------------------------------------------------------------------- envstoch <- environmental_stochasticity( masks = list(reproduction_mask, transition_mask), funs = list(reproduction_fn, transition_fn) ) ## ----dev = "png", fig.alt = "Line plot showing 100 simulated trajectories initialised with the same initial conditions. Lines are variable due to environmental stochasticity and range from slightly increasing trajectories to slightly decreasing."---- # create population dynamics object popdyn <- dynamics(popmat, envstoch) # simulate population dynamics sims <- simulate(popdyn, nsim = 100) # plot the population trajectories plot(sims, col = alpha("#2171B5", 0.4)) ## ----dev = "png", fig.alt = "Line plot showing 100 simulated trajectories initialised with the same initial conditions. Lines are variable due to environmental and demographic stochasticity and range from slightly increasing trajectories to complete extinction."---- # update population dynamics object popdyn <- update(popdyn, demostoch) # simulate population dynamics sims <- simulate(popdyn, nsim = 100) # plot the population trajectories plot(sims, col = alpha("#2171B5", 0.4)) ## ----dev = "png", fig.alt = "Line plot showing 100 simulated trajectories initialised with the same initial conditions. Lines are variable due to density dependence and environmental and demographic stochasticity and range from slightly decreasing trajectories to complete extinction."---- # specify a Ricker model for density dependence dd <- density_dependence( masks = reproduction(popmat, dims = 3:5), # only adults reproduce funs = ricker(k = 40, exclude = 1:2) # set k based on adult abundances ) # update the population dynamics object to include density dependence popdyn <- update(popdyn, dd) # simulate population dynamics sims <- simulate(popdyn, nsim = 100) # plot the population trajectories plot(sims, col = alpha("#2171B5", 0.4)) ## ----dev = "png", fig.alt = "Line plot showing 100 simulated trajectories initialised with the same initial conditions. Lines are variable due to environmental and demographic stochasticity and removals from the population and range from slightly decreasing trajectories to complete extinction."---- # specify density dependence that removes 10 % of adults in each generation dd_n <- add_remove_post( masks = all_classes(popmat, dims = 3:5), # want to focus on adults funs = function(n) 0.9 * n # define in-line function to return # 90 % of adult population ) # create a new population dynamics object popdyn <- dynamics(popmat, envstoch, demostoch, dd_n) # simulate population dynamics sims <- simulate(popdyn, nsim = 100) # plot the population trajectories plot(sims, col = alpha("#2171B5", 0.4)) ## ----dev = "png", fig.alt = "Line plot showing 100 simulated trajectories initialised with the same initial conditions. Lines are variable due to environmental and demographic stochasticity and a nesting covariate and range from slightly decreasing trajectories to complete extinction."---- # set up 20 years of covariates, such as proportion of available nesting sites nesting <- runif(20, min = 0.5, max = 1.0) # 50 % to 100 % of total sites available in each year # define the mask covar_mask <- reproduction(popmat, dims = 3:5) # assume nesting sites only affect reproduction # define a function that links vital rates to the covariates # (dots to soak up any extra arguments passed to other functions) covar_fn <- function(x, nests, ...) { x * nests # really simple function, assume the proportion of successful reproduction # attempts is equal to the proportion of nests } # combine this into a covariates term covs <- covariates(covar_mask, covar_fn) # create population dynamics object (without density dependence) popdyn <- dynamics(popmat, envstoch, demostoch, covs) # simulate population dynamics sims <- simulate( popdyn, nsim = 100, args = list(covariates = format_covariates(nesting)) ) # plot the population trajectories plot(sims, col = alpha("#2171B5", 0.4)) ## ----eval = FALSE------------------------------------------------------------- # sims <- simulate( # popdyn, # nsim = 100, # args = list( # covariates = c( # format_covariates(nesting), # list(static_argument1 = 0.05), # list(static_argument2 = 100) # ) # ) # ) ## ----dev = "png", fig.alt = "Line plot showing 100 simulated trajectories initialised with the same initial conditions. Lines are variable due to environmental and demographic stochasticity and replicate-specific covariates and range from slightly increasing trajectories to complete extinction."---- # set up 20 years of covariates, such as proportion of available nesting sites, # but now with a different minimum (and, therefore, mean) value for each replicate nesting <- do.call(cbind, lapply(runif(100, min = 0.5, max = 0.8), \(x) runif(20, min = x, max = 1.0))) # define the mask covar_mask <- reproduction(popmat, dims = 3:5) # assume nesting sites only affect reproduction # define a function that links vital rates to the covariates # (dots to soak up any extra arguments passed to other functions) covar_fn <- function(x, nests, ...) { x * nests # really simple function, assume the proportion of successful reproduction # attempts is equal to the proportion of nests } # combine this into a covariates term covs <- replicated_covariates(covar_mask, covar_fn) # create population dynamics object (without density dependence) popdyn <- dynamics(popmat, envstoch, demostoch, covs) # simulate population dynamics sims <- simulate( popdyn, nsim = 100, args = list(replicated_covariates = format_covariates(nesting)) ) # plot the population trajectories plot(sims, col = alpha("#2171B5", 0.4)) ## ----dev = "png", fig.alt = "Line plot showing 100 simulated trajectories initialised with the same initial conditions. Lines are variable due to environmental and demographic stochasticity and additions to and removals from the population and range from slightly increasing trajectories to slightly decreasing."---- # set up a release of 10 individuals each year into the first age class, # occurring after reproduction captives <- add_remove_post( masks = all_classes(popmat, dims = 1), funs = \(x) x + 10 ) # repeat to remove 2 adults via predation each year, prior to reproduction predators <- add_remove_pre( masks = all_classes(popmat, dims = ncol(popmat)), funs = \(x) ifelse(x >= 2, x - 2, 0) ) # create population dynamics object (without density dependence) popdyn <- dynamics(popmat, envstoch, demostoch, captives, predators) # simulate population dynamics sims <- simulate( popdyn, nsim = 100 ) # plot the population trajectories plot(sims, col = alpha("#2171B5", 0.4)) ## ----------------------------------------------------------------------------- # reproduction mask popmat[reproduction(popmat, dims = 3:5)] ## ----------------------------------------------------------------------------- # transition mask popmat[transition(popmat)] ## ----------------------------------------------------------------------------- # all elements popmat[all_cells(popmat)] ## ----dev = "png", fig.alt = "Line plot showing 100 simulated trajectories initialised with the same initial conditions. Lines are variable due to environmental stochasticity and all decline consistently towards zero."---- # define a function no_mask_fn <- function(x, dim) { # reconstruct matrix x <- array(x, dim = dim) # change elements with [i, j] notation x[2, 1] <- 0.6 * x[2, 1] x[3, 2] <- 1.25 * x[3, 2] # return x } # set this up as a form of environmental stochasticity envstoch <- environmental_stochasticity( masks = all_cells(popmat), # pass the entire matrix funs = no_mask_fn # use the no-mask function ) # create population dynamics object (without density dependence) popdyn <- dynamics(popmat, envstoch) # simulate population dynamics sims <- simulate( popdyn, nsim = 100, args = list(environmental_stochasticity = list(dim = dim(popmat))) ) # plot the population trajectories plot(sims, col = alpha("#2171B5", 0.4))