pop_project.R

##~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
##  Function to project the population dynamic forward, over time             ~~
##~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
#' Population projection over time
#'
#' @param fatalities a vector (numeric). Each value correspond to the number of fatalities for each scenario.
#' The number of scenario assesed corresponds to the size of that vector.
#' @param intial_pop_vector a vector (numeric). Initial size of each age class. Typically, the output of the
#' pop_vector function.
#' @param s a vector of survival probabilities for each age class
#' @param f a vector of fecundity values for each age class
#' @param model_demo an R object corresponding to the demographic model to be used. The 4 possible models currently are:
#' M1_noDD_noDemoStoch, M2_noDD_WithDemoStoch, M3_WithDD_noDemoStoch, M4_WithDD_WithDemoStoch,
#' @param time_horzion a number. The number of years (time horizon) over which to project the population dynamics.
#' @param coeff_var_environ a number. The coefficient of variation to model environment stochasticity.
#' @param fatal_constant text (character). Either "h" or "M". Using "h" sets the fatality RATE as the constant value across years.
#' Using "M" sets the NUMBER of fatalities as the constant value across years.
#' @param onset_time unused. Just here because it's required for cumulated impact and in higher level 'run_simul" function.
#' @param DD_params NULL or a list. Density-dependence parameters (rMAX, K, theta). Only used in DD models M3 and M4.
#'
#' @return a 3D array containing the size of each age class (dim 1), for each year (dim 2) and each scenario (dim 3).
#' @export
#'
#' @import magrittr
#'
#' @examples
#' s <- c(0.5, 0.7, 0.8, 0.95)
#' f <- c(0, 0, 0.05, 0.55)
#' N0 <- pop_vector(pop_size = 200, pop_size_type = "Npair", s, f)
#' pop_project(fatalities = c(0, 5, 10), intial_pop_vector = N0, s = s, f = f,
#' model_demo = M2_noDD_WithDemoStoch, time_horzion = 30,
#' coeff_var_environ = 0.1, fatal_constant = "h")
#'
pop_project <- function(fatalities,
                        intial_pop_vector,
                        s, f,
                        DD_params = NULL,
                        model_demo,
                        time_horzion,
                        coeff_var_environ,
                        fatal_constant = "h",
                        onset_time = NULL){


  M <- fatalities
  N0 <- intial_pop_vector
  cv_env <- coeff_var_environ

  # Number of years
  nyr <- time_horzion

  # Number of age classes
  nac <- length(s)

  # Number of fatalities scenario
  nsc <- length(fatalities)


  # Initiate Pop Size (output) Array
  N <- array(NA, dim = c(nac, nyr, nsc), dimnames = list(paste0("age", 1:nac),
                                                         paste0("year", 1:nyr),
                                                         paste0("scenario", 1:nsc)
  ))
  N[,1,] <-  N0

  ## Loops over time (years)
  for(t in 2:nyr){

    # Environmental Stochasticity
    ss = 1 - rnorm(nac, mean = qlogis(1-s), sd = cv_env/(s)) %>% plogis        ## sample thru the mortality rate : 1 - s
    ff = rnorm(nac, mean = log(f), sd = cv_env) %>% exp

    # Fatalities : constant number (M) or constant rate (h)
    if(fatal_constant == "M"){
      h <- sapply(M/apply(N[,t-1,], 2, sum), min, 1)
    } else {
      h <- sapply(M/apply(N[,1,], 2, sum), min, 1)
    }

    # Sample a seed for RNG
    seed <- ((((Sys.time() %>% as.numeric) %% 1e5) * 1e5) %% 1e5) %>% round
      #runif(1, 0, 1e6)

    ## Projection : apply the LESLIE matrix calculation forward
    # Scenario 0
    for(j in 1:nsc){
      set.seed(seed)
      N[,t,j] <- model_demo(N1 = N[,t-1,j], s = ss, f = ff, h = h[j], DD_params = DD_params)
    } # j

  } # t

  return(N)

} # END FUNCTION
################################################################################