## ----eval = FALSE-------------------------------------------------------------
#  
#  library(ipmr)
#  
#  # Set up the initial population conditions and parameters
#  
#  data_list <- list(
#    g_int     = 5.781,
#    g_slope   = 0.988,
#    g_sd      = 20.55699,
#    s_int     = -0.352,
#    s_slope   = 0.122,
#    s_slope_2 = -0.000213,
#    r_r_int   = -11.46,
#    r_r_slope = 0.0835,
#    r_s_int   = 2.6204,
#    r_s_slope = 0.01256,
#    r_d_mu    = 5.6655,
#    r_d_sd    = 2.0734,
#    e_p       = 0.15,
#    g_i       = 0.5067
#  )
#  
#  

## ----eval = FALSE-------------------------------------------------------------
#  
#  # We'll set up some helper functions. The survival function
#  # in this model is a quadratic function, so we use an additional inverse logit function
#  # that can handle the quadratic term.
#  
#  inv_logit <- function(int, slope, sv) {
#    1/(1 + exp(-(int + slope * sv)))
#  }
#  
#  inv_logit_2 <- function(int, slope, slope_2, sv) {
#    1/(1 + exp(-(int + slope * sv + slope_2 * sv ^ 2)))
#  }

## ----eval = FALSE-------------------------------------------------------------
#  
#  general_ipm <- init_ipm(sim_gen = "general", di_dd = "di", det_stoch = "det") %>%
#    define_kernel(
#      name          = "P",
#  
#      # We add d_ht to formula to make sure integration is handled correctly.
#      # This variable is generated internally by make_ipm(), so we don't need
#      # to do anything else.
#  
#      formula       = s * g * d_ht,
#  
#      # The family argument tells ipmr what kind of transition this kernel describes.
#      # it can be "CC" for continuous -> continuous, "DC" for discrete -> continuous
#      # "CD" for continuous -> discrete, or "DD" for discrete -> discrete.
#  
#      family        = "CC",
#  
#      # The rest of the arguments are exactly the same as in the simple models
#  
#      g             = dnorm(ht_2, g_mu, g_sd),
#      g_mu          = g_int + g_slope * ht_1,
#      s             = inv_logit_2(s_int, s_slope, s_slope_2, ht_1),
#      data_list     = data_list,
#      states        = list(c('ht')),
#      uses_par_sets = FALSE,
#      evict_cor     = TRUE,
#      evict_fun     = truncated_distributions('norm',
#                                              'g')
#    ) %>%
#    define_kernel(
#      name          = "go_discrete",
#      formula       = r_r * r_s * d_ht,
#  
#      # Note that now, family = "CD" because it denotes a continuous -> discrete transition
#  
#      family        = 'CD',
#      r_r           = inv_logit(r_r_int, r_r_slope, ht_1),
#      r_s           = exp(r_s_int + r_s_slope * ht_1),
#      data_list     = data_list,
#  
#      # Note that here, we add "b" to our list in states, because this kernel
#      # "creates" seeds entering the seedbank
#  
#      states        = list(c('ht', "b")),
#      uses_par_sets = FALSE
#    ) %>%
#    define_kernel(
#      name    = 'stay_discrete',
#  
#      # In this case, seeds in the seed bank either germinate or die, but they
#      # do not remain for multiple time steps. This can be adjusted as needed.
#  
#      formula = 0,
#  
#      # Note that now, family = "DD" because it denotes a discrete -> discrete transition
#  
#      family  = "DD",
#  
#      # The only state variable this operates on is "b", so we can leave "ht"
#      # out of the states list
#  
#      states  = list(c('b')),
#      evict_cor = FALSE
#    ) %>%
#    define_kernel(
#  
#      # Here, the family changes to "DC" because it is the discrete -> continuous
#      # transition
#  
#      name          = 'leave_discrete',
#      formula       = e_p * g_i * r_d,
#      r_d           = dnorm(ht_2, r_d_mu, r_d_sd),
#      family        = 'DC',
#      data_list     = data_list,
#  
#      # Again, we need to add "b" to the states list
#  
#      states        = list(c('ht', "b")),
#      uses_par_sets = FALSE,
#      evict_cor     = TRUE,
#      evict_fun     = truncated_distributions('norm',
#                                              'r_d')
#    )
#  

## ----eval = FALSE-------------------------------------------------------------
#  
#  general_ipm <- general_ipm %>%
#    define_impl(
#      list(
#        P              = list(int_rule    = "midpoint",
#                              state_start = "ht",
#                              state_end   = "ht"),
#        go_discrete    = list(int_rule    = "midpoint",
#                              state_start = "ht",
#                              state_end   = "b"),
#        stay_discrete  = list(int_rule    = "midpoint",
#                              state_start = "b",
#                              state_end   = "b"),
#        leave_discrete = list(int_rule    = "midpoint",
#                              state_start = "b",
#                              state_end   = "ht")
#      )
#    )
#  
#  

## ----eval = FALSE-------------------------------------------------------------
#  
#  general_ipm <- general_ipm %>%
#    define_impl(
#      make_impl_args_list(
#        kernel_names = c("P", "go_discrete", "stay_discrete", "leave_discrete"),
#        int_rule     = c(rep("midpoint", 4)),
#        state_start    = c('ht', "ht", "b", "b"),
#        state_end      = c('ht', "b", "b", 'ht')
#      )
#    )
#  

## ----eval = FALSE-------------------------------------------------------------
#  
#  # The lower and upper bounds for the continuous state variable and the number
#  # of meshpoints for the midpoint rule integration. We'll also create the initial
#  # population vector from a random uniform distribution
#  
#  L <- 1.02
#  U <- 624
#  n <- 500
#  
#  set.seed(2312)
#  
#  init_pop_vec   <- runif(500)
#  init_seed_bank <- 20
#  
#  
#  general_ipm <- general_ipm %>%
#    define_domains(
#  
#      # We can pass the variables we created above into define_domains
#  
#      ht = c(L, U, n)
#  
#    ) %>%
#    define_pop_state(
#  
#      # We can also pass them into define_pop_state
#  
#      pop_vectors = list(
#        n_ht = init_pop_vec,
#        n_b  = init_seed_bank
#      )
#    ) %>%
#    make_ipm(iterations = 100,
#             usr_funs = list(inv_logit   = inv_logit,
#                             inv_logit_2 = inv_logit_2))
#  
#  
#  # lambda is a generic function to compute per-capita growth rates. It has a number
#  # of different options depending on the type of model
#  
#  lambda(general_ipm)
#  
#  # If we are worried about whether or not the model converged to stable
#  # dynamics, we can use the exported utility is_conv_to_asymptotic. The default
#  # tolerance for convergence is 1e-10, but can be changed with the 'tol' argument.
#  
#  is_conv_to_asymptotic(general_ipm, tol = 1e-10)
#  
#  w <- right_ev(general_ipm)
#  v <- left_ev(general_ipm)
#  
#  
#  

## ----eval = FALSE-------------------------------------------------------------
#  
#  make_N <- function(ipm) {
#  
#    P     <- ipm$sub_kernels$P
#  
#    I     <- diag(nrow(P))
#    N     <- solve(I - P)
#  
#    return(N)
#  }
#  
#  eta_bar <- function(ipm) {
#  
#    N     <- make_N(ipm)
#    out   <- colSums(N)
#  
#    return(as.vector(out))
#  
#  }
#  
#  sigma_eta <- function(ipm) {
#  
#    N     <- make_N(ipm)
#  
#    out <- colSums(2 * (N %^% 2L) - N) - colSums(N) ^ 2
#  
#    return(as.vector(out))
#  }
#  
#  mean_l <- eta_bar(general_ipm)
#  var_l  <- sigma_eta(general_ipm)
#  
#  mesh_ps <- int_mesh(general_ipm)$ht_1 %>%
#    unique()
#  
#  par(mfrow = c(1,2))
#  
#  plot(mesh_ps, mean_l, type = "l", xlab = expression( "Initial size z"[0]))
#  plot(mesh_ps, var_l, type = "l", xlab = expression( "Initial size z"[0]))
#  

## ----eval = FALSE-------------------------------------------------------------
#  
#  library(ipmr)
#  
#  # Set up the initial population conditions and parameters
#  # Here, we are simulating random intercepts for growth
#  # and seed production, converting them to a list,
#  # and adding them into the list of constants. Equivalent code
#  # to produce the output for the output from lmer/glmer
#  # is in the comments next to each line
#  
#  all_g_int   <- as.list(rnorm(5, mean = 5.781, sd = 0.9)) # as.list(unlist(ranef(my_growth_model)))
#  all_r_s_int <- as.list(rnorm(5, mean = 2.6204, sd = 0.3)) # as.list(unlist(ranef(my_seed_model)))
#  
#  
#  names(all_g_int)   <- paste("g_int_", 1:5, sep = "")
#  names(all_r_s_int) <- paste("r_s_int_", 1:5, sep = "")
#  
#  constant_list <- list(
#    g_slope   = 0.988,
#    g_sd      = 20.55699,
#    s_int     = -0.352,
#    s_slope   = 0.122,
#    s_slope_2 = -0.000213,
#    r_r_int   = -11.46,
#    r_r_slope = 0.0835,
#    r_s_slope = 0.01256,
#    r_d_mu    = 5.6655,
#    r_d_sd    = 2.0734,
#    e_p       = 0.15,
#    g_i       = 0.5067
#  )
#  
#  all_params <- c(constant_list, all_g_int, all_r_s_int)
#  
#  # The lower and upper bounds for the continuous state variable and the number
#  # of meshpoints for the midpoint rule integration.
#  
#  L <- 1.02
#  U <- 624
#  n <- 500
#  
#  set.seed(2312)
#  
#  init_pop_vec   <- runif(500)
#  init_seed_bank <- 20
#  
#  # add some helper functions. The survival function
#  # in this model is a quadratic function, so we use an additional inverse logit function
#  # that can handle the quadratic term.
#  
#  inv_logit <- function(int, slope, sv) {
#    1/(1 + exp(-(int + slope * sv)))
#  }
#  
#  inv_logit_2 <- function(int, slope, slope_2, sv) {
#    1/(1 + exp(-(int + slope * sv + slope_2 * sv ^ 2)))
#  }
#  

## ----eval = FALSE-------------------------------------------------------------
#  
#  
#  general_stoch_kern_ipm <- init_ipm(sim_gen    = "general",
#                                     di_dd      = "di",
#                                     det_stoch  = "stoch",
#                                     kern_param = "kern") %>%
#    define_kernel(
#  
#      # The kernel name gets indexed by _year to denote that there
#      # are multiple possible kernels we can build with our parameter set.
#      # The _year gets substituted by the values in "par_set_indices" in the
#      # output, so in this example we will have P_1, P_2, P_3, P_4, and P_5
#  
#      name          = "P_year",
#  
#      # We also add _year to "g" to signify that it is going to vary across kernels.
#  
#      formula       = s * g_year * d_ht,
#      family        = "CC",
#  
#      # Here, we add the suffixes again, ensuring they are expanded and replaced
#      # during model building by the parameter names
#  
#      g_year           = dnorm(ht_2, g_mu_year, g_sd),
#      g_mu_year        = g_int_year + g_slope * ht_1,
#      s                = inv_logit_2(s_int, s_slope, s_slope_2, ht_1),
#      data_list        = all_params,
#      states           = list(c('ht')),
#  
#      # We set uses_par_sets to TRUE, signalling that we want to expand these
#      # expressions across all levels of par_set_indices.
#  
#      uses_par_sets    = TRUE,
#      par_set_indices = list(year = 1:5),
#      evict_cor        = TRUE,
#  
#      # we also add the suffix to `target` here, because the value modified by
#      # truncated_distributions is time-varying.
#  
#      evict_fun        = truncated_distributions('norm',
#                                                 target = 'g_year')
#    ) %>%
#    define_kernel(
#  
#      # again, we append the index to the kernel name, vital rate expressions,
#      # and in the model formula.
#  
#      name          = "go_discrete_year",
#      formula       = r_r * r_s_year * g_i * d_ht,
#      family        = 'CD',
#      r_r           = inv_logit(r_r_int, r_r_slope, ht_1),
#  
#      # Again, we modify the left and right hand side of this expression to
#      # show that there is a time-varying component
#  
#      r_s_year      = exp(r_s_int_year + r_s_slope * ht_1),
#      data_list     = all_params,
#      states        = list(c('ht', "b")),
#      uses_par_sets    = TRUE,
#      par_set_indices = list(year = 1:5)
#    ) %>%
#    define_kernel(
#  
#      # This kernel has no time-varying parameters, and so is not indexed.
#  
#      name    = 'stay_discrete',
#  
#      # In this case, seeds in the seed bank either germinate or die, but they
#      # do not remain for multipe time steps. This can be adjusted as needed.
#  
#      formula = 0,
#  
#      # Note that now, family = "DD" becuase it denotes a discrete -> discrete transition
#  
#      family  = "DD",
#      states  = list(c('b')),
#  
#      # This kernel has no time-varying parameters, so we don't need to designate
#      # it as such.
#  
#      uses_par_sets = FALSE,
#      evict_cor = FALSE
#    ) %>%
#    define_kernel(
#  
#      # This kernel also doesn't get a index, because there are no varying parameters.
#  
#      name          = 'leave_discrete',
#      formula       = e_p * r_d,
#      r_d           = dnorm(ht_2, r_d_mu, r_d_sd),
#      family        = 'DC',
#      data_list     = all_params,
#      states        = list(c('ht', "b")),
#      uses_par_sets = FALSE,
#      evict_cor     = TRUE,
#      evict_fun     = truncated_distributions('norm',
#                                              'r_d')
#    )  %>%
#    define_impl(
#      make_impl_args_list(
#  
#        # We add suffixes to the kernel names here to make sure they match the names
#        # we specified above.
#  
#        kernel_names = c("P_year", "go_discrete_year", "stay_discrete", "leave_discrete"),
#        int_rule     = c(rep("midpoint", 4)),
#        state_start    = c('ht', "ht", "b", "b"),
#        state_end      = c('ht', "b", "b", 'ht')
#      )
#    ) %>%
#    define_domains(
#      ht = c(L, U, n)
#    ) %>%
#    define_pop_state(
#        n_ht = init_pop_vec,
#        n_b  = init_seed_bank
#    ) %>%
#    make_ipm(
#      iterations = 100,
#  
#      # We can specify a sequence of kernels to select for the simulation.
#      # This helps others to reproduce what we did,
#      # and lets us keep track of the consequences of different selection
#      # sequences for population dynamics.
#  
#      kernel_seq = sample(1:5, size = 100, replace = TRUE),
#      usr_funs = list(inv_logit   = inv_logit,
#                      inv_logit_2 = inv_logit_2)
#    )
#  

## ----eval = FALSE-------------------------------------------------------------
#  
#  mean_kernels <- mean_kernel(general_stoch_kern_ipm)
#  lam_s        <- lambda(general_stoch_kern_ipm, burn_in = 0.15) # Remove first 15% of iterations
#  

## ----eval = FALSE-------------------------------------------------------------
#  
#  library(ipmr)
#  
#  # Define the fixed parameters in a list
#  
#  constant_params <- list(
#    s_int     = -5,
#    s_slope   = 2.2,
#    s_precip  = 0.0002,
#    s_temp    = -0.003,
#    g_int     = 0.2,
#    g_slope   = 1.01,
#    g_sd      = 1.2,
#    g_temp    = -0.002,
#    g_precip  = 0.004,
#    c_r_int   = 0.3,
#    c_r_slope = 0.03,
#    c_s_int   = 0.4,
#    c_s_slope = 0.01,
#    c_d_mu    = 1.1,
#    c_d_sd    = 0.1,
#    r_e       = 0.3,
#    r_d       = 0.3,
#    r_r       = 0.2,
#    r_s       = 0.2
#  )
#  
#  

## ----eval = FALSE-------------------------------------------------------------
#  
#  # Now, we create a set of environmental covariates. In this example, we use
#  # a normal distribution for temperature and a Gamma for precipitation.
#  
#  env_params <- list(
#    temp_mu = 8.9,
#    temp_sd = 1.2,
#    precip_shape = 1000,
#    precip_rate  = 2
#  )
#  
#  # We define a wrapper function that samples from these distributions
#  
#  sample_env <- function(env_params) {
#  
#    # We generate one value for each covariate per iteration, and return it
#    # as a named list.
#  
#    temp_now <- rnorm(1,
#                      env_params$temp_mu,
#                      env_params$temp_sd)
#  
#    precip_now <- rgamma(1,
#                         shape = env_params$precip_shape,
#                         rate = env_params$precip_rate)
#  
#    # The vital rate expressions can now use the names "temp" and "precip"
#    # as if they were in the data_list.
#  
#    out        <- list(temp = temp_now, precip = precip_now)
#  
#    return(out)
#  
#  }
#  
#  # Again, we can define our own functions and pass them into calls to make_ipm. This
#  # isn't strictly necessary, but can make the model code more readable/less error prone.
#  
#  inv_logit <- function(lin_term) {
#    1/(1 + exp(-lin_term))
#  }
#  
#  

## ----eval = FALSE-------------------------------------------------------------
#  
#  general_stoch_param_model <- init_ipm(sim_gen    = "general",
#                                        di_dd      = "di",
#                                        det_stoch  = "stoch",
#                                        kern_param = "param") %>%
#    define_kernel(
#      name       = "P_stoch",
#      family     = "CC",
#  
#      # As in the examples above, we have to add the d_surf_area
#      # to ensure the integration of the functions is done.
#  
#      formula    = s * g * d_surf_area,
#  
#      # We can reference continuously varying parameters by name
#      # in the vital rate expressions just as before, even though
#      # they are passed in define_env_state() as opposed to the kernel's
#      # data_list
#  
#      g_mu    = g_int + g_slope * surf_area_1 + g_temp * temp + g_precip * precip,
#      s_lin_p = s_int + s_slope * surf_area_1 + s_temp * temp + s_precip * precip,
#      s       = inv_logit(s_lin_p),
#      g       = dnorm(surf_area_2, g_mu, g_sd),
#  
#      data_list     = constant_params,
#      states        = list(c("surf_area")),
#      uses_par_sets = FALSE,
#      evict_cor     = TRUE,
#      evict_fun     = truncated_distributions("norm", "g")
#    ) %>%
#    define_kernel(
#      name          = "F",
#      family        = "CC",
#      formula       = c_r * c_s * c_d * (1 - r_e) * d_surf_area,
#  
#      c_r_lin_p     = c_r_int + c_r_slope * surf_area_1,
#      c_r           = inv_logit(c_r_lin_p),
#      c_s           = exp(c_s_int + c_s_slope * surf_area_1),
#      c_d           = dnorm(surf_area_2, c_d_mu, c_d_sd),
#      data_list     = constant_params,
#      states        = list(c("surf_area")),
#      uses_par_sets = FALSE,
#      evict_cor     = TRUE,
#      evict_fun     = truncated_distributions("norm", "c_d")
#    ) %>%
#    define_kernel(
#  
#      # Name can be anything, but it helps to make sure they're descriptive
#  
#      name = "go_discrete",
#  
#      # Family is now "CD" because it is a continuous -> discrete transition
#  
#      family        = "CD",
#      formula       = r_e * r_s * c_r * c_s * d_surf_area,
#      c_r_lin_p     = c_r_int + c_r_slope * surf_area_1,
#      c_r           = inv_logit(c_r_lin_p),
#      c_s           = exp(c_s_int + c_s_slope * surf_area_1),
#      data_list     = constant_params,
#      states        = list(c("surf_area", "sb")),
#      uses_par_sets = FALSE,
#  
#      # There is not eviction to correct here, so we can set this to false
#  
#      evict_cor     = FALSE
#    ) %>%
#    define_kernel(
#      name          = "stay_discrete",
#      family        = "DD",
#      formula       = r_s * r_r,
#      data_list     = constant_params,
#      states        = list("sb"),
#      uses_par_sets = FALSE,
#      evict_cor     = FALSE
#    ) %>%
#    define_kernel(
#      name          = "leave_discrete",
#      family        = "DC",
#      formula       = r_d * r_s * c_d,
#      c_d           = dnorm(surf_area_2, c_d_mu, c_d_sd),
#      data_list     = constant_params,
#      states        = list(c("surf_area", "sb")),
#      uses_par_sets = FALSE,
#      evict_cor     = TRUE,
#      evict_fun     = truncated_distributions("norm", "c_d")
#    ) %>%
#    define_impl(
#      make_impl_args_list(
#        kernel_names = c("P_stoch",
#                         "F",
#                         "go_discrete",
#                         "stay_discrete",
#                         "leave_discrete"),
#        int_rule     = rep("midpoint", 5),
#        state_start  = c("surf_area",
#                         "surf_area",
#                         "surf_area",
#                         "sb",
#                         "sb"),
#        state_end    = c("surf_area",
#                         "surf_area",
#                         "sb",
#                         "sb",
#                         "surf_area")
#      )
#    ) %>%
#    define_domains(
#      surf_area = c(0, 10, 100)
#    )
#  

## ----eval = FALSE-------------------------------------------------------------
#  
#  # In the first version, sample_env is provided in the data_list of
#  # define_env_state.
#  
#  general_stoch_param_ipm <-  define_env_state(
#    proto_ipm  = general_stoch_param_model,
#    env_covs   = sample_env(env_params),
#    data_list  = list(env_params = env_params,
#                      sample_env = sample_env)
#  ) %>%
#    define_pop_state(
#      n_surf_area = runif(100),
#      n_sb        = rpois(1, 20)
#    ) %>%
#    make_ipm(usr_funs = list(inv_logit  = inv_logit),
#             iterate = TRUE,
#             iterations = 100)
#  
#  
#  # in the second version, sample_env is provided in the usr_funs list of
#  # make_ipm(). These two versions are equivalent.
#  
#  general_stoch_param_ipm <-  define_env_state(
#    proto_ipm  = general_stoch_param_model,
#    env_covs   = sample_env(env_params),
#    data_list  = list(env_params = env_params)
#  ) %>%
#    define_pop_state(
#      n_surf_area = runif(100),
#      n_sb        = rpois(1, 20)
#    ) %>%
#    make_ipm(usr_funs = list(inv_logit  = inv_logit,
#                             sample_env = sample_env),
#             iterate = TRUE,
#             iterations = 100,
#             return_sub_kernels = TRUE)
#  
#  

## ----eval = FALSE-------------------------------------------------------------
#  
#  env_draws  <- general_stoch_param_ipm$env_seq
#  
#  mean_kerns <- mean_kernel(general_stoch_param_ipm)
#  
#  lam_s      <- lambda(general_stoch_param_ipm)
#  
#  all.equal(mean_kerns$mean_F,
#            general_stoch_param_ipm$sub_kernels$F_it_1,
#            check.attributes = FALSE)
#  

## ----eval = FALSE-------------------------------------------------------------
#  
#  data_list <- list(
#    g_int     = 5.781,
#    g_slope   = 0.988,
#    g_sd      = 20.55699,
#    s_int     = -0.352,
#    s_slope   = 0.122,
#    s_slope_2 = -0.000213,
#    r_r_int   = -11.46,
#    r_r_slope = 0.0835,
#    r_s_int   = 2.6204,
#    r_s_slope = 0.01256,
#    r_d_mu    = 5.6655,
#    r_d_sd    = 2.0734,
#    e_p       = 0.15,
#    g_i       = 0.5067
#  )
#  
#  
#  L <- 1.02
#  U <- 624
#  n <- 500
#  
#  set.seed(2312)
#  
#  init_pop_vec   <- runif(500)
#  init_seed_bank <- 20
#  
#  # Initialize the state list and add some helper functions. The survival function
#  # in this model is a quadratic function.
#  
#  inv_logit <- function(int, slope, sv) {
#    1/(1 + exp(-(int + slope * sv)))
#  }
#  
#  inv_logit_2 <- function(int, slope, slope_2, sv) {
#    1/(1 + exp(-(int + slope * sv + slope_2 * sv ^ 2)))
#  }
#  
#  general_ipm <- init_ipm(sim_gen    = "general",
#                          di_dd      = "di",
#                          det_stoch  = "det") %>%
#    define_kernel(
#      name          = "P",
#      formula       = s * g * d_ht,
#      family        = "CC",
#      g             = dnorm(ht_2, g_mu, g_sd),
#      g_mu          = g_int + g_slope * ht_1,
#      s             = inv_logit_2(s_int, s_slope, s_slope_2, ht_1),
#      data_list     = data_list,
#      states        = list(c('ht')),
#      uses_par_sets = FALSE,
#      evict_cor     = TRUE,
#      evict_fun     = truncated_distributions('norm',
#                                              'g')
#    ) %>%
#    define_kernel(
#      name          = "go_discrete",
#      formula       = r_r * r_s * g_i,
#      family        = 'CD',
#      r_r           = inv_logit(r_r_int, r_r_slope, ht_1),
#      r_s           = exp(r_s_int + r_s_slope * ht_1),
#      data_list     = data_list,
#      states        = list(c('ht', "b")),
#      uses_par_sets = FALSE
#    ) %>%
#    define_kernel(
#      name      = 'stay_discrete',
#      formula   = 0,
#      family    = "DD",
#      states    = list(c('ht', "b")),
#      evict_cor = FALSE
#    ) %>%
#    define_kernel(
#      name          = 'leave_discrete',
#      formula       = e_p * r_d,
#      r_d           = dnorm(ht_2, r_d_mu, r_d_sd),
#      family        = 'DC',
#      data_list     = data_list,
#      states        = list(c('ht', "b")),
#      uses_par_sets = FALSE,
#      evict_cor     = TRUE,
#      evict_fun     = truncated_distributions('norm',
#                                              'r_d')
#    ) %>%
#    define_impl(
#      make_impl_args_list(
#        kernel_names = c("P", "go_discrete", "stay_discrete", "leave_discrete"),
#        int_rule     = c(rep("midpoint", 4)),
#        state_start    = c('ht', "ht", "b", "b"),
#        state_end      = c('ht', "b", "b", 'ht')
#      )
#    ) %>%
#    define_domains(
#      ht = c(L, U, n)
#    ) %>%
#    define_pop_state(
#      pop_vectors = list(
#        n_ht = init_pop_vec,
#        n_b  = init_seed_bank
#      )
#    ) %>%
#    make_ipm(iterations = 100,
#             usr_funs = list(inv_logit   = inv_logit,
#                             inv_logit_2 = inv_logit_2))

## ----eval = FALSE-------------------------------------------------------------
#  
#  mega_mat <- make_iter_kernel(ipm = general_ipm,
#                               mega_mat = c(
#                                 stay_discrete, go_discrete,
#                                 leave_discrete, P
#                               ))
#  
#  # These values should be almost identical, so this should ~0
#  
#  Re(eigen(mega_mat[[1]])$values[1]) - lambda(general_ipm)
#  
#  

## ----eval = FALSE-------------------------------------------------------------
#  
#  # Get the names of each sub_kernel
#  sub_k_nms     <- names(general_ipm$sub_kernels)
#  
#  mega_mat_text <- c(sub_k_nms[3], sub_k_nms[2], sub_k_nms[4], sub_k_nms[1])
#  
#  mega_mat_2 <- make_iter_kernel(general_ipm,
#                                 mega_mat = mega_mat_text)
#  
#  # Should be TRUE
#  identical(mega_mat, mega_mat_2)
#  

## ----eval = FALSE-------------------------------------------------------------
#  
#  mega_mat <- make_iter_kernel(general_ipm,
#                                 mega_mat = c(P, 0,
#                                              I, P))
#  
#  
#  
#  

## ----eval = FALSE-------------------------------------------------------------
#  
#  all_g_int   <- as.list(rnorm(5, mean = 5.781, sd = 0.9))
#  all_f_s_int <- as.list(rnorm(5, mean = 2.6204, sd = 0.3))
#  
#  names(all_g_int)   <- paste("g_int_", 1:5, sep = "")
#  names(all_f_s_int) <- paste("f_s_int_", 1:5, sep = "")
#  
#  constant_list <- list(
#    g_slope   = 0.988,
#    g_sd      = 20.55699,
#    s_int     = -0.352,
#    s_slope   = 0.122,
#    s_slope_2 = -0.000213,
#    f_r_int   = -11.46,
#    f_r_slope = 0.0835,
#    f_s_slope = 0.01256,
#    f_d_mu    = 5.6655,
#    f_d_sd    = 2.0734,
#    e_p       = 0.15,
#    g_i       = 0.5067
#  )
#  
#  all_params <- c(constant_list, all_g_int, all_f_s_int)
#  
#  L <- 1.02
#  U <- 624
#  n <- 500
#  
#  set.seed(2312)
#  
#  init_pop_vec   <- runif(500)
#  init_seed_bank <- 20
#  
#  inv_logit <- function(int, slope, sv) {
#    1/(1 + exp(-(int + slope * sv)))
#  }
#  
#  inv_logit_2 <- function(int, slope, slope_2, sv) {
#    1/(1 + exp(-(int + slope * sv + slope_2 * sv ^ 2)))
#  }
#  
#  general_stoch_kern_ipm <- init_ipm(sim_gen    = "general",
#                                     di_dd      = "di",
#                                     det_stoch  = "stoch",
#                                     kern_param = "kern") %>%
#    define_kernel(
#      name          = "P_year",
#      formula       = s * g_year * d_ht,
#      family        = "CC",
#      g_year           = dnorm(ht_2, g_mu_year, g_sd),
#      g_mu_year        = g_int_year + g_slope * ht_1,
#      s                = inv_logit_2(s_int, s_slope, s_slope_2, ht_1),
#      data_list        = all_params,
#      states           = list(c('ht')),
#      uses_par_sets    = TRUE,
#      par_set_indices = list(year = 1:5),
#      evict_cor        = TRUE,
#      evict_fun        = truncated_distributions('norm',
#                                                 'g_year')
#    ) %>%
#    define_kernel(
#      name          = "go_discrete_year",
#      formula       = f_r * f_s_year * g_i * d_ht,
#      family        = 'CD',
#      f_r           = inv_logit(f_r_int, f_r_slope, ht_1),
#      f_s_year      = exp(f_s_int_year + f_s_slope * ht_1),
#      data_list     = all_params,
#      states        = list(c('ht', "b")),
#      uses_par_sets    = TRUE,
#      par_set_indices = list(year = 1:5)
#    ) %>%
#    define_kernel(
#      name    = 'stay_discrete',
#      formula = 0,
#      family  = "DD",
#      states  = list(c('b')),
#      uses_par_sets = FALSE,
#      evict_cor = FALSE
#    ) %>%
#    define_kernel(
#      name          = 'leave_discrete',
#      formula       = e_p * f_d * d_ht,
#      f_d           = dnorm(ht_2, f_d_mu, f_d_sd),
#      family        = 'DC',
#      data_list     = all_params,
#      states        = list(c('ht', "b")),
#      uses_par_sets = FALSE,
#      evict_cor     = TRUE,
#      evict_fun     = truncated_distributions('norm',
#                                              'f_d')
#    )  %>%
#    define_impl(
#      make_impl_args_list(
#        kernel_names = c("P_year", "go_discrete_year", "stay_discrete", "leave_discrete"),
#        int_rule     = c(rep("midpoint", 4)),
#        state_start    = c('ht', "ht", "b", "b"),
#        state_end      = c('ht', "b", "b", 'ht')
#      )
#    ) %>%
#    define_domains(
#      ht = c(L, U, n)
#    ) %>%
#    define_pop_state(
#        n_ht = init_pop_vec,
#        n_b  = init_seed_bank
#    ) %>%
#    make_ipm(
#      iterations = 10,
#      kernel_seq = sample(1:5, size = 10, replace = TRUE),
#      usr_funs = list(inv_logit   = inv_logit,
#                      inv_logit_2 = inv_logit_2)
#    )
#  

## ----eval = FALSE-------------------------------------------------------------
#  
#  block_list <- make_iter_kernel(general_stoch_kern_ipm,
#                                   mega_mat = c(stay_discrete, go_discrete_year,
#                                                leave_discrete, P_year))
#  
#  

