age_x_size.R
In ipmr: Integral Projection Models

## ----eval = FALSE-------------------------------------------------------------
#  
#  library(ipmr)
#  
#  param_list <- list(
#    surv_int = -17,
#    surv_z = 6.68,
#    surv_a = -0.334,
#    grow_int = 1.27,
#    grow_z = 0.612,
#    grow_a = -0.00724,
#    grow_sd = 0.0787,
#    repr_int = -7.88,
#    repr_z = 3.11,
#    repr_a = -0.078,
#    recr_int = 1.11,
#    recr_a = 0.184,
#    rcsz_int = 0.362,
#    rcsz_z = 0.709,
#    rcsz_sd = 0.159
#  )
#  
#  
#  inv_logit <- function(x) {
#  
#    return( 1 / (1 + exp(-x)) )
#  }
#  
#  f_fun <- function(age, s_age, pb_age, pr_age, recr) {
#  
#    if(age == 0) return(0)
#  
#    s_age * pb_age * pr_age * recr * 0.5
#  
#  }
#  
#  

## ----eval = FALSE-------------------------------------------------------------
#  
#  age_size_ipm <- init_ipm(sim_gen    = "general",
#                           di_dd      = "di",
#                           det_stoch  = "det",
#                           uses_age    = TRUE) %>%
#    define_kernel(
#      name          = "P_age",
#      family        = "CC",
#      formula       = s_age * g_age * d_wt,
#      s_age         = inv_logit(surv_int + surv_z * wt_1 + surv_a * age),
#      g_age         = dnorm(wt_2, mu_g_age, grow_sd),
#      mu_g_age      = grow_int + grow_z * wt_1 + grow_a * age,
#      data_list     = param_list,
#      states        = list(c("wt")),
#      uses_par_sets = FALSE,
#      age_indices   = list(age = c(0:20), max_age = 21),
#      evict_cor     = FALSE
#    )
#  

## ----eval = FALSE-------------------------------------------------------------
#  
#  age_size_ipm <-
#    define_kernel(
#      proto_ipm     = age_size_ipm,
#      name          = "F_age",
#      family        = "CC",
#      formula       = f_fun(age, s_age, pb_age, pr_age, rcsz) * d_wt,
#      s_age         = inv_logit(surv_int + surv_z * wt_1 + surv_a * age),
#      pb_age        = inv_logit(repr_int + repr_z * wt_1 + repr_a * age),
#      pr_age        = inv_logit(recr_int + recr_a * age),
#      rcsz          = dnorm(wt_2, rcsz_mu, rcsz_sd),
#      rcsz_mu       = rcsz_int + rcsz_z * wt_1,
#      data_list     = param_list,
#      states        = list(c("wt")),
#      uses_par_sets = FALSE,
#      age_indices   = list(age = c(0:20), max_age = 21),
#      evict_cor     = FALSE
#    )
#  

## ----eval = FALSE-------------------------------------------------------------
#  
#  age_size_ipm <- age_size_ipm %>%
#    define_impl(
#      make_impl_args_list(
#        kernel_names = c("P_age", "F_age"),
#        int_rule     = rep("midpoint", 2),
#        state_start    = c("wt_age", "wt_age"),
#        state_end      = c("wt_age", "wt_0")
#      )
#    )
#  

## ----eval = FALSE-------------------------------------------------------------
#  
#  age_size_ipm <- age_size_ipm %>%
#    define_domains(
#      wt = c(1.6, 3.7, 100)
#    ) %>%
#    define_pop_state(
#      n_wt_age = runif(100)
#    ) %>%
#    make_ipm(
#      usr_funs = list(inv_logit = inv_logit,
#                      f_fun     = f_fun),
#      iterate  = TRUE,
#      iterations = 100
#    )
#  
#  lam <- lambda(age_size_ipm)
#  lam
#  

## ----eval = FALSE-------------------------------------------------------------
#  
#  v_a <- left_ev(age_size_ipm, iterations = 100)
#  w_a <- right_ev(age_size_ipm, iterations = 100)
#  
#  par(mfrow = c(1, 2))
#  
#  plot(1:100, seq(0, max(unlist(w_a)), length.out = 100), type = "n",
#       ylab = expression(paste("w"[a],"(z)")),
#       xlab = "Size bin")
#  
#  for(i in seq_along(w_a)) {
#  
#    lines(w_a[[i]])
#  
#  }
#  
#  plot(1:100,
#       seq(0, max(unlist(v_a)), length.out = 100),
#       type = "n",
#       ylab = expression(paste("v"[a], "(z)")),
#       xlab = "Size bin")
#  
#  for(i in seq_along(v_a)) {
#  
#   lines(v_a[[i]])
#  
#  }
#