# =============================================================================
#  02-CA.R  ·  Correspondence Analysis of the 2022 municipal cross-section
# =============================================================================
#
#    - Individuals (rows):  290 Swedish municipalities
#    - Active columns:      population-composition counts — variables that all
#                            measure "number of residents with attribute X",
#                            sharing a common unit (persons). The active set is
#                            deliberately restricted to age structure,
#                            educational attainment (Swedish-born, by gender),
#                            employment sector, and national origin. These
#                            variables together define the profile
#                            of the municipality's resident population.
#    - col.sup (a):         educational provision counts
#    - col.sup (b):         political vote and council counts
#    - col.sup (c):         infrastructure & mobility counts,
#                            vehicles, commuter flows, agricultural enterprises,
#                            livestock; genuine counts but measuring different
#                            entities (not persons), so they cannot share a
#                            contingency table with the active columns
#    - Outside CA:          rates, proportions, continuous measures, and
#                            count variables measuring event flows (births,
#                            deaths, migration) correlated with CA row
#                            scores post-hoc
#
#  Outputs:
#    data/processed/ca_exploratory.rds   - CA result (FactoMineR object)
#    data/processed/ca_var_groups.rds    - variable group lists

library(tidyverse)
library(FactoMineR)

# 00 - Load --------------------------------------------------------------------
m_sample <- read_rds("data/processed/m_sample.rds")
all_vars <- setdiff(names(m_sample), c("code", "municipality"))

# 01 - Exclude genuinely uninformative variables -------------------------------
# Removed from every part of the analysis: redundant totals, geographic areas,
# and always-zero columns that add no discriminating information.
truly_exclude <- c(
  # Redundant totals (sum of components already included elsewhere)
  "population",
  "livestock_total",
  "agricultural_enterprises_total",
  "number_of_registered_passenger_cars_by_status_total",
  # Geographic areas (ha / km²) — not counts of entities
  "land_area_ha",
  all_vars[str_detect(all_vars, "^type_of_land_")],
  all_vars[str_detect(all_vars, "^use_of_land_")],
  "forest",
  "open_land",
  "total_green_space",
  all_vars[str_detect(all_vars, "^inland_water")],
  all_vars[str_detect(all_vars, "^seawater")],
  all_vars[str_detect(all_vars, "^the_four_large")],
  # Always-zero columns
  "number_of_owner_occupied_dwellings_by_type_of_building_other_buildings",
  "number_of_owner_occupied_dwellings_by_type_of_building_special_housing"
)

analysis_vars <- setdiff(all_vars, truly_exclude)

# 02 - Define variable roles ---------------------------------------------------

# (a) Educational provision: the research object → col.sup
col_sup_edu <- analysis_vars[
  str_detect(analysis_vars, "^adult_students_") |
    str_detect(analysis_vars, "^admitted_students_") |
    str_detect(analysis_vars, "^graduates_from_") |
    str_detect(analysis_vars, "^location_of_home_vs_university_")
]

# (b) Political vote and council counts → col.sup
col_sup_politics <- analysis_vars[
  str_detect(analysis_vars, "^votes_by_party") |
    str_detect(analysis_vars, "^entitled_to_vote_by_education_level") |
    str_detect(analysis_vars, "^elected_members")
]

# (c) Infrastructure, mobility, and event counts → col.sup
# Counts but measuring dwellings, vehicles, farms, animals, or flows
# rather than resident persons. Projecting them as supplementary shows how
# they relate to the population-composition space without distorting it.
col_sup_infra <- analysis_vars[
  str_detect(
    analysis_vars,
    "^number_of_(rented|tenant_owned|owner_occupied)_dwellings"
  ) |
    str_detect(analysis_vars, "^number_of_registered_passenger_cars_") |
    str_detect(analysis_vars, "^workplaces_") |
    str_detect(analysis_vars, "^agricultural_enterprises_") |
    str_detect(analysis_vars, "^livestock_") |
    analysis_vars %in%
      c(
        "sex_men",
        "sex_women",
        "employment_by_gender_men",
        "employment_by_gender_women",
        "number_of_inmigrations",
        "number_of_outmigrations",
        "births",
        "deaths",
        "marriages",
        "divorces",
        "buildings",
        "buildings_for_seasonal_use",
        "concentrations_of_holiday_homes",
        "holiday_home_areas",
        "social_assistance_number_of_receiver_households",
        "urban_residences_proximity_to_public_green_areas_500_meters_or_less",
        "number_of_localities"
      )
]

col_sup_vars <- c(col_sup_edu, col_sup_politics, col_sup_infra)

# Active: population-composition person-counts
# All five groups answer "how many residents have attribute X?" and therefore
# share a common denominator.
active_vars <- analysis_vars[
  (str_detect(analysis_vars, "^age_") |
    str_detect(analysis_vars, "^education_level_of_swedish_men_") |
    str_detect(analysis_vars, "^education_level_of_swedish_women_") |
    str_detect(analysis_vars, "^employment_by_activity_sectors_") |
    str_detect(analysis_vars, "^birth_country_")) &
    !analysis_vars %in% col_sup_vars
]

# Everything else → post-hoc correlations with CA dimensions
outside_ca <- setdiff(analysis_vars, c(active_vars, col_sup_vars))

# 03 - Build CA matrix ---------------------------------------------------------
X <- m_sample |>
  select(all_of(c(active_vars, col_sup_vars))) |>
  as.data.frame()
rownames(X) <- m_sample$municipality

na_count <- sum(is.na(X))
if (na_count > 0) {
  cat("\nReplacing", na_count, "NAs with 0 in the CA matrix\n")
  X[is.na(X)] <- 0L
}

idx_sup <- seq(length(active_vars) + 1L, ncol(X))

# 04 - Run CA ------------------------------------------------------------------
ca <- CA(X, ncp = 10, col.sup = idx_sup, graph = FALSE)

contribs <- ca$col$contrib |>
  as.data.frame() |>
  rownames_to_column("variable")

for (d in paste0("Dim ", 1:5)) {
  top5 <- contribs |> slice_max(.data[[d]], n = 5) |> pull(variable)
  cat("\nTop contributors Dim", str_extract(d, "[0-9]+"), ":\n")
  cat(paste0("  ", top5), sep = "\n")
}

# 05 - Post-hoc: correlate row scores with outside-CA variables ----------------
ca_row_coords <- as.data.frame(ca$row$coord)

outside_data <- m_sample |>
  select(all_of(outside_ca)) |>
  mutate(across(everything(), \(x) {
    m <- mean(x, na.rm = TRUE)
    replace_na(x, if (is.finite(m)) m else 0)
  }))

posthoc_cor <- cor(
  ca_row_coords,
  outside_data,
  use = "pairwise.complete.obs"
) |>
  as.data.frame() |>
  rownames_to_column("dimension")

# 06 - Save --------------------------------------------------------------------
write_rds(ca, "data/processed/ca_exploratory.rds")
write_rds(
  list(
    active = active_vars,
    edu = col_sup_edu,
    politics = col_sup_politics,
    infra = col_sup_infra,
    outside = outside_ca
  ),
  "data/processed/ca_var_groups.rds"
)
write_csv(posthoc_cor, "data/processed/ca_posthoc_cor.csv")
