Pertussis-seroprevalence / f-CreateSerotransModel.R
f-CreateSerotransModel.R
Raw
#######################################################################################################
# Create pomp object for the pertussis serotransmission model
# The time unit is YEARS; all rates are PER YEAR
#######################################################################################################

CreateSerotransMod <- function(nA, 
                               f_mat,
                               dt_mod = 0.01, 
                               dt_sim = 0.1,
                               t_sim = 200, 
                               debug_bool = F) {
  # Args: 
  # nA: no of age classes [integer]
  # f_mat: contact matrix (density scale) [matrix]
  # dt_mod: time step (in years) for stochastic model simulator [numeric]
  # dt_sim: time step (in years) for simulated data [numeric]
  # t_sim: no of years of simulation [numeric]
  # debug_bool: should messages be displayed to help debug? [boolean] 
  
  # Check contact matrix
  stopifnot(nrow(f_mat) == ncol(f_mat))
  stopifnot(nrow(f_mat) == nA)
  stopifnot(isSymmetric(f_mat))
  
  # Extract C code from file
  mod_code <- readLines("c-serotransmission_model.c")
  components_nm <- c("globs", "stochSim")
  components_l <- vector(mode = 'list', length = length(components_nm))
  names(components_l) <- components_nm
  
  for(nm in components_nm) {
    components_l[[nm]] <- mod_code[str_which(mod_code, paste0("start_", nm)):str_which(mod_code, paste0("end_", nm))] %>% 
      str_flatten(collapse = "\n")
    
    if(nm == "globs") {
      components_l[[nm]] <- paste(components_l[[nm]], 
                                  sprintf("static int nA = %d;\nstatic int debug = %d;", 
                                          nA, as.integer(debug_bool)), 
                                  sep = "\n")
    }
    components_l[[nm]] <- Csnippet(text = components_l[[nm]])
  }
  
  # Names of model variables 
  states_nm <- c("S1", "S2", "E1", "E2", "I1", 
                 "I2", "R", "Re", "Rp1", "Rp2", 
                 "V", "Ve", "Vp", "Ci1", "Ci2", 
                 "Cs")
  all_states_nm <- sapply(paste0(states_nm, "_"), paste0, 1:nA) %>% as.vector()
  
  # Names of parameters
  # NB: negative values indicate parameters that have no default value and must be assigned
  params_vec <- c(
    setNames(object = as.numeric(t(f_mat)), nm = paste0("f_", 1:(nA * nA))), # Contact matrix
    setNames(object = rep(0, nA), paste0("p_V_", 1:nA)), # Effective vaccination coverage (proportion)
    setNames(object = rep(-1, nA), paste0("delta_", 1:nA)), # Aging rates
    setNames(object = rep(-1, nA), paste0("N_", 1:nA)), # Age-specific populations
    "N_tot" = -1, # Total population size
    "b_rate" = -1, # Birth rate (per capita)
    "t_V" = 150, # Start time of vaccination
    "alpha_V" = 0.01067172, # Rate of waning vaccine-derived immunity
    "q1" = 0.09373881, # Susceptibility in 0-9 yo
    "q21" = 0.5117505, # Susceptibility in 10-19 yo relative to that in 0-9 yo
    "q32" = 0.1725993 , # Susceptibility in >=20 yo relative to that in 10-19 yo
    "theta" = 0.9874919, # Transmissibility of secondary infections relative to that of primary infections
    "iota" = 1e-3, # Prevalence of imported cases
    "sigma" = 365 / 8, # Latent rate 
    "gamma" = 365 / 15, # Recovery rate
    "alpha_R" = 1 / 34, # Rate of waning infection-derived immunity (Table 1, Lavine et al., 2013)
    "rho_R" = 6.6, # Boosting coefficient (Table 1, Lavine et al., 2013)
    "rho_V" = 1, # Boosting coefficient
    "t_p_R" = 23 / 365, # Average time to seroconversion after immune boost
    "t_p_V" = 23 / 365, # # Average time to seroconversion after immune boost
    "t_n_I" = 1, # Average duration of seropositivity after infection
    "t_n_R" = 1, # Average duration of seropositivity after immune boost from R state
    "t_n_V" = 1, # Average duration of seropositivity after immune boost from V state
    setNames(object = rep(0, length(all_states_nm)), nm = paste0(all_states_nm, "_0")) # Initial conditions
  )
  
  #browser()
  po <- pomp(data = data.frame(time = seq(from = dt_sim, to = t_sim, by = dt_sim), 
                               X = NA),
             times = "time",
             t0 = 0,
             obsnames = "X",
             statenames = all_states_nm,
             accumvars = c(
               paste0("Ci1_", 1:nA),
               paste0("Ci2_", 1:nA), 
               paste0("Cs_", 1:nA)
             ),
             paramnames = names(params_vec), 
             params = params_vec,
             globals = components_l[["globs"]],
             rprocess = euler(step.fun = components_l[["stochSim"]], delta.t = dt_mod), 
             rinit = NULL
             #cdir = "_help/", 
             #cfile = "codes"
  )
  return(po)
}

#######################################################################################################
# END
#######################################################################################################