#' @title   BFS population scenario
#'
#' @description Ce .
#'
#' @param PARAM_GLOBAL
#'
#' @return une `tidylist` contenant le data frame suivant:
#'   - `AHV`
#'
#' @author [MAS BSV](mailto:sekretariat.mas@bsv.admin.ch)
#'
#' @export

options(readr.show_col_types = FALSE)

setwd("~/data/appl-wb/20_staff/kjo/fhh/2025-07-22T0923_u80874371_ahv_basis")

PARAM_GLOBAL <-
  read_delim("PARAM_GLOBAL.csv")

BEV_SCENARIO <-
  read_delim("BEV_SCENARIO.csv")

PENSION_RATE <-
  read_delim("PENSION_RATE.csv")

PENSION_N <-
  read_delim("PENSION_N.csv")

PENSION_NM <-
  read_delim("PENSION_NM.csv")

RENTENENTWICKLUNG <-
  read_delim("RENTENENTWICKLUNG.csv")

mod_ahv_BFSscenarios_basismodell <- function(BEV_SCENARIO,
                                             PENSION_RATE,
                                             PARAM_GLOBAL,
                                             PENSION_N,
                                             PENSION_NM,
                                             RENTENENTWICKLUNG) {

  print("Run module: mod_ahv_BFSscenarios_basismodell")

  # Projection interval *including* the current jahr.
  pint  <- PARAM_GLOBAL$jahr_abr: PARAM_GLOBAL$jahr_ende_basismodell

  BFS_SZEN <- BEV_SCENARIO %>%
    select(scen = scenario, jahr, sex, nat, alt, bevendejahr) %>%
    mutate(scen = 
             fct_recode(scen, 
                        "A" = "A_00_2025",
                        "B" = "B_00_2025",
                        "C" = "C_00_2025"
             )
    ) %>%
    filter(scen %in% c("A", "B", "C")) %>%
    # Consolidate higher age ranges for consistency with STATPOP.
    mutate(alt = pmin(99, alt)) %>%
    dplyr::summarize(bevendejahr = sum(bevendejahr),
                     .by = c("scen", "jahr", "sex", "nat", "alt")) %>%
    # Only keep latest observed jahr for adjustment purposes.
    filter(jahr %in% pint) %>%
    left_join(PENSION_RATE,
              by = c("jahr", "sex", "nat", "alt"), 
              relationship = "many-to-many") %>%
    tidyr::replace_na(list(share = 0)) %>%
    mutate(heads = bevendejahr * share) %>%
    dplyr::summarize(heads = sum(heads),
                     .by = c("scen", "jahr", "sex", "nat", "type"))

  # Adjust scenario-derived pension counts to the observed ones in the pension registry.
    ADJ <- BFS_SZEN %>%
      filter(jahr == first(pint)) %>%
      dplyr::summarize(heads = sum(heads),
                       .by = c("scen", "sex", "nat", "type")) %>%
      left_join(PENSION_N %>% 
                  filter(jahr == first(pint)) %>%
                  dplyr::summarize(n = sum(n), .by = c("sex", "nat", "type")),
                by = c("sex", "nat", "type")) %>%
      mutate(adj = n - heads) %>%
      select(- heads, - n)

    # Additive adjustment (normally multiplicative; exception in 2025 due to Ukrainian
    # fugitives).
    BFS_SZEN_BASISMODELL <- BFS_SZEN %>%
      left_join(ADJ, by = c("scen", "sex", "nat", "type")) %>%
      mutate(heads = heads + adj) %>%
      select(- adj) %>%
      dplyr::summarize(heads = sum(heads), .by = c("scen", "jahr", "sex", "type")) %>%
      mutate(dom = "ch") %>%
      select(scen, jahr, sex, dom, type, n = heads) %>%
      mutate(m = NA) %>%
      filter(jahr > first(pint))

    MP <- RENTENENTWICKLUNG %>%
      mutate(mp = 12 * minimalrente)  %>%
      select(jahr, mp)

    # Consolidation into final analysis data for regression. ---------------------------------
    A_DAT <-
      bind_rows(mutate(PENSION_NM, scen = "H"), BFS_SZEN_BASISMODELL) %>%
      # Extend analysis data by missing 'dom == au' combinations.
      right_join(
        expand_grid(jahr = min(PENSION_NM$jahr):last(pint), 
                    scen = c("H", "A", "B", "C"),
                    dom  = c("ch", "au"), sex = c("m", "f"),
                    type = c("alt", "kin", "wai", "wit")) %>% 
          filter(!(scen == "H" & jahr > first(pint)),
                 !(scen %in% c("A", "B", "C") & jahr <= first(pint))),
        by = c("scen", "jahr", "sex", "dom", "type")
      ) %>% 
      relocate(jahr, scen, sex, dom, type, n) %>% 
      left_join(MP, by = "jahr") %>%
      arrange(dom, sex, type, scen, jahr) %>%
      # Express mean pensions as multiples of contemporaneous minimal pensions.
      mutate(m = 12 * m / mp) %>% 
      arrange(jahr, scen)

  return(list(BFS_SZEN_BASISMODELL = BFS_SZEN_BASISMODELL,
              A_DAT = A_DAT))
}
