################################################################################
# MANUSCRIPT: Public preferences for mosquito-borne disease prevention 
# interventions in metropolitan France
# AUTHOR: Josée Dussault
# DATE: November 25, 2025
# R VERSION: 4.5.0
# APOLLO VERSION: 0.3.5
# PURPOSE: This script estimates a Mixed Multinomial Logit (MMNL) model with 
# correlated random parameters (Cholesky decomposition) to analyze 
# Discrete Choice Experiment (DCE) data.
# INPUT: 'analysis_df_full.RData' (Cleaned respondent and choice data)
# OUTPUT: Model estimates, covariance matrix, and model fit statistics.
################################################################################

# ==============================================================================
# 1. SETUP AND LIBRARIES
# ==============================================================================

# Clear workspace
rm(list = ls())

# Load necessary packages (install if missing)
if (!require("pacman")) install.packages("pacman")
pacman::p_load(
  tidyverse,  # For data manipulation
  apollo,     # For DCE analysis
  here,       # For relative file paths
  parallel    # For core detection
)

# Initialize Apollo
apollo_initialise()

# Determine number of cores to use (leaves 1 core free for system stability)
num_cores <- parallel::detectCores(logical = FALSE) - 1

# Set core controls
apollo_control <- list(
  modelName       = "MMNL_Correlated_Main_Model",
  modelDescr      = "Mixed MNL model with 3,000 Sobol draws and correlated random parameters",
  indivID         = "id",  
  nCores          = num_cores,
  outputDirectory = "Output",
  seed            = 123456
)

# ==============================================================================
# 2. DATA LOADING AND PREPARATION
# ==============================================================================

# Load data using relative path
# Ensure 'analysis_df_full.RData' is in the project root or adjust path inside here()
if(file.exists(here("analysis_df_full.RData"))) {
  load(here("analysis_df_full.RData"))
  database <- df3 
} else {
  stop("Data file not found in working directory.")
}

# Variable recoding and feature engineering
database <- database %>%
  mutate(
    # Recode bite frequency (binary flags)
    bitefreq1 = if_else(freq_bites_cat == 1, 1, 0, missing = NA), # Never
    bitefreq2 = if_else(freq_bites_cat == 2, 1, 0, missing = NA), # Sometimes
    bitefreq3 = if_else(freq_bites_cat == 3, 1, 0, missing = NA), # Often
    
    # Recode financial precarity
    preca_bin = if_else(precarity > 1, 1, 0, missing = NA),
    
    # Recode eco-conscious diet
    # Reference: Omnivore; Index: Eco-conscious (meat reduction/veg/vegan)
    diet_bin = case_when(
      diet == 2 ~ 0, 
      diet > 2 ~ 1,
      # Text matching for "Other" category to catch vegetarians/flexitarians
      diet == 1 & grepl("pas de viande|sauf la viande|pesc|flex|vég", diet_other, ignore.case = TRUE) ~ 1,
      is.na(diet) ~ NA_real_,
      TRUE ~ 0
    ),
    
    # Recode gender (0 = Man [Ref], 1 = Woman)
    gender = gender - 1 
  ) %>%
  as.data.frame() # Apollo requires a standard data.frame

# ==============================================================================
# 3. CHOICE ANALYSIS (PRE-ESTIMATION)
# ==============================================================================

# Define settings for descriptive analysis of choices
choiceAnalysis_settings <- list(
  alternatives = c(A = 1, B = 2),
  avail        = list(A = database$avail_1, B = database$avail_2),
  choiceVar    = database$choice,
  explanators  = database[, c("diet_bin", "preca_bin")],
  printToScreen = TRUE,
  rows         = "all"
)

# Run descriptive analysis
apollo_choiceAnalysis(choiceAnalysis_settings, apollo_control, database)

# ==============================================================================
# 4. PARAMETER INITIALIZATION
# ==============================================================================

# Vector of parameters, including means (mu) and Cholesky elements (sigma)
apollo_beta <- c(
  # Alternative Specific Constant (ASC)
  asc_a    = 0, 
  mu_asc_b = 0,
  sigma_asc_b = 0.1, 
  
  # Participation attribute (Ref: Government)
  mu_b_part2 = 0, mu_b_part3 = 0, mu_b_part4 = 0, 
  
  # Cholesky elements for participation
  sigma_b_part2 = 0.1, sigma_b_part2_ascb = 0.1,
  sigma_b_part3 = 0.1, sigma_b_part3_part2 = 0.1, sigma_b_part3_ascb = 0.1,
  sigma_b_part4 = 0.1, sigma_b_part4_part3 = 0.1, sigma_b_part4_part2 = 0.1, sigma_b_part4_ascb = 0.1, 
  
  # Frequency attribute
  mu_b_freq = 0,
  
  # Cholesky elements for frequency
  sigma_b_freq = 0.1, sigma_b_freq_part4 = 0.1, sigma_b_freq_part3 = 0.1, 
  sigma_b_freq_part2 = 0.1, sigma_b_freq_ascb = 0.1,
  
  # Environmental effects (Ref: None)
  mu_b_env2 = 0, mu_b_env3 = 0,
  
  # Cholesky elements for environment
  sigma_b_env2 = 0.1, sigma_b_env2_freq = 0.1, sigma_b_env2_part4 = 0.1, 
  sigma_b_env2_part3 = 0.1, sigma_b_env2_part2 = 0.1, sigma_b_env2_ascb = 0.1, 
  
  sigma_b_env3 = 0.1, sigma_b_env3_env2 = 0.1, sigma_b_env3_freq = 0.1, 
  sigma_b_env3_part4 = 0.1, sigma_b_env3_part3 = 0.1, sigma_b_env3_part2 = 0.1, 
  sigma_b_env3_ascb = 0.1,
  
  # Side effects / Human health (Ref: None)
  mu_b_se2 = 0, mu_b_se3 = 0,
  
  # Cholesky elements for side effects
  sigma_b_se2 = 0.1, sigma_b_se2_env3 = 0.1, sigma_b_se2_env2 = 0.1, 
  sigma_b_se2_freq = 0.1, sigma_b_se2_part4 = 0.1, sigma_b_se2_part3 = 0.1, 
  sigma_b_se2_part2 = 0.1, sigma_b_se2_ascb = 0.1, 
  
  sigma_b_se3 = 0.1, sigma_b_se3_se2 = 0.1, sigma_b_se3_env3 = 0.1, 
  sigma_b_se3_env2 = 0.1, sigma_b_se3_freq = 0.1, sigma_b_se3_part4 = 0.1, 
  sigma_b_se3_part3 = 0.1, sigma_b_se3_part2 = 0.1, sigma_b_se3_ascb = 0.1
)

# Parameters kept fixed during estimation
apollo_fixed <- c("asc_a")

# ==============================================================================
# 5. RANDOM COMPONENTS (CHOLESKY DECOMPOSITION)
# ==============================================================================

# Set settings for Sobol draws
apollo_draws <- list(
  # Scrambled sobol would be preferred but it is disabled as of 20/06/2025
  interDrawsType = "sobol",  
  interNDraws    = 3000,
  interUnifDraws = c(),
  interNormDraws = c("draws_asc_b", 
                     "draws_b_part2", "draws_b_part3", "draws_b_part4", 
                     "draws_b_freq",
                     "draws_b_env2", "draws_b_env3",
                     "draws_b_se2", "draws_b_se3"),
  # See the technical appendix for more information on intra-individual draws
  intraDrawsType = "sobol",
  intraNDraws    = 0,
  intraUnifDraws = c(),
  intraNormDraws = c()
)

# Construct random coefficients
# This function manually builds the Cholesky matrix to induce correlation
apollo_randCoeff <- function(apollo_beta, apollo_inputs){
  randcoeff = list()
  
  randcoeff[["asc_b"]] = mu_asc_b + sigma_asc_b * draws_asc_b
  
  randcoeff[["b_part2"]] = mu_b_part2 + 
    sigma_b_part2 * draws_b_part2 + 
    sigma_b_part2_ascb * draws_asc_b
  
  randcoeff[["b_part3"]] = mu_b_part3 + 
    sigma_b_part3 * draws_b_part3 + 
    sigma_b_part3_part2 * draws_b_part2 + 
    sigma_b_part3_ascb * draws_asc_b
  
  randcoeff[["b_part4"]] = mu_b_part4 + 
    sigma_b_part4 * draws_b_part4 + 
    sigma_b_part4_part3 * draws_b_part3 + 
    sigma_b_part4_part2 * draws_b_part2 + 
    sigma_b_part4_ascb * draws_asc_b
  
  randcoeff[["b_freq"]] = mu_b_freq + 
    sigma_b_freq * draws_b_freq + 
    sigma_b_freq_part4 * draws_b_part4 + 
    sigma_b_freq_part3 * draws_b_part3 + 
    sigma_b_freq_part2 * draws_b_part2 + 
    sigma_b_freq_ascb * draws_asc_b
  
  randcoeff[["b_env2"]] = mu_b_env2 + 
    sigma_b_env2 * draws_b_env2 + 
    sigma_b_env2_freq * draws_b_freq + 
    sigma_b_env2_part4 * draws_b_part4 + 
    sigma_b_env2_part3 * draws_b_part3 + 
    sigma_b_env2_part2 * draws_b_part2 + 
    sigma_b_env2_ascb * draws_asc_b
  
  randcoeff[["b_env3"]] = mu_b_env3 + 
    sigma_b_env3 * draws_b_env3 + 
    sigma_b_env3_env2 * draws_b_env2 + 
    sigma_b_env3_freq * draws_b_freq + 
    sigma_b_env3_part4 * draws_b_part4 + 
    sigma_b_env3_part3 * draws_b_part3 + 
    sigma_b_env3_part2 * draws_b_part2 + 
    sigma_b_env3_ascb * draws_asc_b
  
  randcoeff[["b_se2"]] = mu_b_se2 + 
    sigma_b_se2 * draws_b_se2 + 
    sigma_b_se2_env3 * draws_b_env3 + 
    sigma_b_se2_env2 * draws_b_env2 + 
    sigma_b_se2_freq * draws_b_freq + 
    sigma_b_se2_part4 * draws_b_part4 + 
    sigma_b_se2_part3 * draws_b_part3 + 
    sigma_b_se2_part2 * draws_b_part2 + 
    sigma_b_se2_ascb * draws_asc_b
  
  randcoeff[["b_se3"]] = mu_b_se3 + 
    sigma_b_se3 * draws_b_se3 + 
    sigma_b_se3_se2 * draws_b_se2 + 
    sigma_b_se3_env3 * draws_b_env3 + 
    sigma_b_se3_env2 * draws_b_env2 + 
    sigma_b_se3_freq * draws_b_freq + 
    sigma_b_se3_part4 * draws_b_part4 + 
    sigma_b_se3_part3 * draws_b_part3 + 
    sigma_b_se3_part2 * draws_b_part2 + 
    sigma_b_se3_ascb * draws_asc_b
  
  return(randcoeff)
}

# Validate inputs
apollo_inputs <- apollo_validateInputs()

# ==============================================================================
# 6. MODEL SPECIFICATION
# ==============================================================================

apollo_probabilities <- function(apollo_beta, apollo_inputs, functionality="estimate"){
  
  apollo_attach(apollo_beta, apollo_inputs)
  on.exit(apollo_detach(apollo_beta, apollo_inputs))
  
  P = list()
  
  # List of utilities
  # Note: Variables ending in _1 refer to Alternative A, _2 refer to Alternative B
  V = list()
  V[["A"]] = asc_a + 
    b_part2 * part2_1 + 
    b_part3 * part3_1 + 
    b_part4 * part4_1 + 
    b_freq  * frequence_1 + 
    b_env2  * env2_1 + 
    b_env3  * env3_1 + 
    b_se2   * se2_1 + 
    b_se3   * se3_1
  
  V[["B"]] = asc_b + 
    b_part2 * part2_2 + 
    b_part3 * part3_2 + 
    b_part4 * part4_2 + 
    b_freq  * frequence_2 + 
    b_env2  * env2_2 + 
    b_env3  * env3_2 + 
    b_se2   * se2_2 + 
    b_se3   * se3_2
  
  # MNL settings
  mnl_settings = list(
    alternatives = c(A=1, B=2),
    avail        = 1, 
    choiceVar    = choice,
    utilities    = V
  )
  
  # Compute probabilities
  P[["model"]] = apollo_mnl(mnl_settings, functionality)
  
  # Panel product (choices from same individual)
  P = apollo_panelProd(P, apollo_inputs, functionality)
  
  # Average across inter-individual draws
  P = apollo_avgInterDraws(P, apollo_inputs, functionality)
  
  # Prepare outputs
  P = apollo_prepareProb(P, apollo_inputs, functionality)
  return(P)
}

# ==============================================================================
# 7. MODEL ESTIMATION AND OUTPUT
# ==============================================================================

# Estimate settings
estimate_settings = list(
# Bootstrap standard errors are preferred but computationally costly
  # bootstrapSE = 1000 
)

# Run estimation
model <- apollo_estimate(
  apollo_beta, 
  apollo_fixed, 
  apollo_probabilities, 
  apollo_inputs, 
  estimate_settings
)

# Output settings
modelOutput_settings = list(
  printClassical = FALSE, # Focus on robust SE
  printOutliers  = TRUE,
  printPVal      = 2      # Two-sided p-values
)

# Print results to console
apollo_modelOutput(model, modelOutput_settings)

# Save results to output directory
apollo_saveOutput(model)