Edward Owusu Manu

Ghana Statistical Service

[email protected]

Fitting Mortality

 # Fit fertility model
    fit_fertility = function() {
      log_info("Fitting fertility model...")
      timestamp <- format(Sys.time(), "%Y-%m-%d %H:%M:%S UTC")
      log_info("Started at: {timestamp}")
      
      # Define reproductive ages
      reproductive_ages <- c("15-19", "20-24", "25-29", "30-34", "35-39", "40-44", "45-49")
      
      # Filter and prepare fertility data
      fertility_data <- self$data[
        get(private$sex_var) == "Female" & 
          get(private$age_var) %in% reproductive_ages
      ]
      
      if (nrow(fertility_data) == 0) {
        log_error("No fertility data found for reproductive ages")
        stop("No fertility data available")
      }
      
      # Prepare model data
      model_data <- self$prepare_model_data(fertility_data, "fertility")
      
      # Add fertility-specific variables
      model_data[, `:=`(
        age_id = as.numeric(factor(get(private$age_var))),
        log_population = log(get(private$population_var))
      )]
      
      tryCatch({
        log_debug("Starting fertility model fitting with {nrow(model_data)} observations")
        
        self$fertility_model <- brm(
          bf(
            births ~ 1 + year_std + age_id + 
              (1 | region_id) + 
              (1 | district_id) + 
              offset(log_population),
            family = poisson()
          ),
          data = model_data,
          backend = "cmdstanr",
          control = list(
            adapt_delta = 0.999,
            max_treedepth = 15
          ),
          iter = 2000,
          warmup = 1000,
          chains = 4,
          cores = 4,
          seed = 123
        )
        
        log_info("Fertility model fitting successful")
        log_debug("Model summary:\\n{capture.output(summary(self$fertility_model))}")
        
      }, error = function(e) {
        log_error("Error fitting fertility model: {conditionMessage(e)}")
        stop(e)
      })
      
      # Save model timestamp
      private$fertility_model_timestamp <- format(Sys.time(), "%Y-%m-%d %H:%M:%S UTC")
    },

Fitting Mortlity Model

fit_mortality = function() {
      log_info("Fitting mortality model...")
      timestamp <- format(Sys.time(), "%Y-%m-%d %H:%M:%S UTC")
      log_info("Started at: {timestamp}")
      
      # Prepare mortality data
      mortality_data <- self$prepare_model_data(self$data, "mortality")
      
      # Add mortality-specific variables
      mortality_data[, `:=`(
        mortality_rate = get(private$deaths_var) / get(private$population_var),
        log_mortality = log((get(private$deaths_var) + 1) / get(private$population_var))
      )]
      
      if (any(is.infinite(mortality_data$log_mortality))) {
        log_warn("Infinite values detected in log mortality, adjusting...")
        mortality_data[is.infinite(log_mortality), log_mortality := log(0.001)]
      }
      
      tryCatch({
        log_debug("Starting mortality model fitting with {nrow(mortality_data)} observations")
        
        self$mortality_model <- brm(
          bf(
            log_mortality ~ 1 + year_std + age_factor + 
              (1 | region_id) + 
              (1 | district_id),
            family = gaussian()
          ),
          data = mortality_data,
          backend = "cmdstanr",
          control = list(
            adapt_delta = 0.999,
            max_treedepth = 20
          ),
          iter = 2000,
          warmup = 100,
          chains = 4,
          cores = 8,
          seed = 123,
          prior = c(
            prior(normal(0, 10), class = "b"),
            prior(normal(0, 2), class = "Intercept"),
            prior(exponential(1), class = "sd"),
            prior(exponential(1), class = "sigma")
          )
        )
        
        log_info("Mortality model fitting successful")
        log_debug("Model diagnostics:")
        log_debug("R-hat values:\\n{capture.output(rhat(self$mortality_model))}")
        
      }, error = function(e) {
        log_error("Error fitting mortality model: {conditionMessage(e)}")
        stop(e)
      })
      
      # Save model timestamp
      private$mortality_model_timestamp <- format(Sys.time(), "%Y-%m-%d %H:%M:%S UTC")
    }

Fitting Migrartion

In-migrant/ Out-Migrant

fit_migration = function() {
      log_info("Fitting migration models...")
      timestamp <- format(Sys.time(), "%Y-%m-%d %H:%M:%S UTC")
      log_info("Started at: {timestamp}")
      
      # Prepare migration data
      migration_data <- self$prepare_model_data(self$data, "migration")
      
      if (!("in_migration" %in% names(migration_data))) {
        log_error("In-migration variable not found in data")
        stop("Missing in_migration variable")
      }
      if (!("out_migration" %in% names(migration_data))) {
        log_error("Out-migration variable not found in data")
        stop("Missing out_migration variable")
      }
      
      tryCatch({
        log_debug("Fitting in-migration model...")
        
        self$migration_in_model <- brm(
          bf(
            in_migration ~ 1 + year_std + age_factor + 
              (1 | region_id) + 
              (1 | district_id),
            family = negbinomial()
          ),
          data = migration_data,
          backend = "cmdstanr",
          control = list(
            adapt_delta = 0.999,
            max_treedepth = 15
          ),
          iter = 2000,
          warmup = 1000,
          chains = 4,
          cores = 4,
          seed = 123
        )
        
        log_debug("Fitting out-migration model...")
        
        self$migration_out_model <- brm(
          bf(
            out_migration ~ 1 + year_std + age_factor + 
              (1 | region_id) + 
              (1 | district_id),
            family = negbinomial()
          ),
          data = migration_data,
          backend = "cmdstanr",
          control = list(
            adapt_delta = 0.999,
            max_treedepth = 15
          ),
          iter = 1000,
          warmup = 500,
          chains = 4,
          cores = 4,
          seed = 124
        )
        
        log_info("Migration models fitting successful")
        
      }, error = function(e) {
        log_error("Error fitting migration models: {conditionMessage(e)}")
        stop(e)
      })
      
      # Save model timestamp
      private$migration_model_timestamp <- format(Sys.time(), "%Y-%m-%d %H:%M:%S UTC")
    }