#' @title Projection des EPRC à partir du RR filtré pour la population
#' suisse résidante (avec les retraites anticipées)
#'
#' @description Ce module projette les EPRC à partir du registre des rentes de
#' jahr_abr (avec les retraites anticipées) à l'aide des facteurs de croissance
#' calculés par âge et par année FACTEURS_CROISSANCE_ANNUELS_EPRC_ESTIMES.
#'
#' @param PARAM_GLOBAL un dataframe d'une seule ligne, dont nous utilisons les
#'   paramètres suivants:
#'   - `jahr_rr`: Année du registre des rentes analysé
#'
#' @param MORTALITE data frame contenant les taux de mortalité, cf. fonction
#' \code{\link{mod_input_mortalite}}.
#'
#' @param FACTEURS_CROISSANCE_ANNUELS_EPRC_ESTIMES data frame contenant les
#' facteurs de croissance calculés à la 2ème étape dans la fonction
#' \code{\link{mod_facteurs_croissance_annuels_eprc_estimes}} grâce aux EPRC
#' calculés à la première étape (EPRC_ESTIMATION de
#' \code{\link{mod_eprc_estimation}}).
#'
#' @param RR_AVS data frame contenant les données du registre des rentes de la
#' jahr_abr, cf. fonctions \code{\link{mod_input_rr_avs_dataframe}} and
#' create_rr_avs (dinput).
#'
#' @param list `tidylist`. Elément obligatoire dans tous les modules. Au lieu de
#'   fournir des dataframes au module, il est possible de l'alimenter uniquement
#'   avec une`tidylist` qui contient les tidy dataframes. Tous les datframes
#'   listés doivent être présents dans la tidylist, avec le même nom. De plus,
#'   la `tidylist` peut aussi contenir des dataframes qui ne sont pas utilisés
#'   par le module.
#'
#' @references \href{https://www.bsv.admin.ch/dam/bsv/fr/dokumente/ahv/finanzperspektiven/validierung-modellansatz-ahv.pdf.download.pdf/2018_07_09_definitif_ld_rapport_ofas.pdf}{Rapport de Prof. Dr Laurent Donzé}
#'
#' @return une `tidylist` contenant le data frame suivant:
#' - EPRC_PROJECTION_FLEX
#'
#' @author [MAS BSV](mailto:sekretariat.mas@bsv.admin.ch)
#'
#' @export
#'

source("~/delfinverse/dinput/R/utils.R")

options(readr.show_col_types = FALSE)

setwd("~/data/appl-wb/20_staff/kjo/fhh/2025-05-20T1646_u80874371_ahv_basis_kjo")

PARAM_GLOBAL <- 
  read_delim("PARAM_GLOBAL.csv")

FACTEURS_CROISSANCE_ANNUELS_EPRC_ESTIMES <- 
  read_delim("FACTEURS_CROISSANCE_ANNUELS_EPRC_ESTIMES.csv")

TAUX_MORTALITE <- 
  read_delim("TAUX_MORTALITE.csv")

RR_AVS <- 
  read_delim("RR_AVS.csv")

# mod_eprc_projection_flex <- function(PARAM_GLOBAL,
#                                      FACTEURS_CROISSANCE_ANNUELS_EPRC_ESTIMES,
#                                      TAUX_MORTALITE,
#                                      RR_AVS
#                                      ) {
#     
#     print("Run module: mod_eprc_projection_flex")

  #--- Initalisation----

  RR_0 <- RR_AVS %>%
    filter(!is.na(gpr))

  #---------Traitement et projection des EPRC avec une rente vieillesse----------

  RR_ASSURANCE_VIEILLESSE_EPRC_FLEX_FILTERED <- RR_0 %>%
    filter(jahr == PARAM_GLOBAL$jahr_rr &
      gpr == "rvieillesse_simple") %>%
    group_by(jahr, alt, dom, sex, nat, zv, age_ret, gpr) %>%
    summarise(eprc_ref = sum(eprc, na.rm = TRUE)) %>%
    ungroup() %>%
    dplyr::select(-jahr)
  

  EPRC_PROJECTION_FLEX_0_AV <- FACTEURS_CROISSANCE_ANNUELS_EPRC_ESTIMES %>%
    left_join(TAUX_MORTALITE, by = c("sex", "jahr", "alt", "nat")) %>%
    # Right_join pour que seuls les âges du RR soient pris en compte
    right_join(RR_ASSURANCE_VIEILLESSE_EPRC_FLEX_FILTERED,
      by = c("alt", "sex", "nat", "dom")
    ) %>%
    filter(!is.na(eprc)) %>%
    group_by(sex, nat, dom, alt, age_ret, gpr, zv) %>%
    # 1ère étape: projeter les eprc selon leur facteurs de croissance (cf. étape
    # 1 et 2). Nous utilisons ces eprc projetés comme valeur de départ pour
    # l'évolution de la mortalité.

    mutate(
      cumprod_wr = cumprod(wachstumsfaktor),
      eprc1 = cumprod_wr * eprc_ref
    ) %>%
    ungroup() %>% 
    select(age_ret, sex, nat, dom, gpr, zv, jahr, alt, eprc = eprc1)

  # # 2ème étape: ajuster avec les quotients de mortalité
  # 
  # # Données par âge de retraite
  # 
  # # .age_ret <- 64
  # # dta_age_ret(64)
  # 
  # dta_age_ret <- function(.age_ret) {
  # 
  #   # Noveaux rentiers projetés de jahr_rr à jahr_ende (1ère colonne)
  #   PROJ <- EPRC_PROJECTION_FLEX_0 %>%
  #     dplyr::select(sex, nat, dom, jahr, alt, gpr, age_ret, zv, eprc1) %>%
  #     filter(alt == age_ret) %>%
  #     filter(alt == .age_ret)
  # 
  #   # Rentiers observés en jahr_rr (1ère ligne)
  #   OBS <- RR_ASSURANCE_VIEILLESSE_EPRC_FLEX_FILTERED %>%
  #     filter(age_ret == .age_ret) %>%
  #     mutate(jahr = PARAM_GLOBAL$jahr_rr) %>%
  #     rename(eprc_ref2 = eprc_ref)
  # 
  #   PROJ %>%
  #     full_join(OBS, by = c("sex", "nat", "dom", "jahr", "alt", "gpr", "age_ret", "zv")) %>%
  #     mutate(eprc = if_else(is.na(eprc1), eprc_ref2, eprc1)) %>%
  #     dplyr::select(sex, nat, dom, jahr, alt, gpr, zv, eprc) %>%
  #     # Ajouter les quotients de mortalité
  #     right_join(
  #       dplyr::select(
  #         filter(EPRC_PROJECTION_FLEX_0, age_ret == .age_ret),
  #         sex, nat, dom, jahr, alt, gpr, zv, quotients_mortalite
  #       ),
  #       by = c("sex", "nat", "dom", "jahr", "alt", "gpr", "zv")
  #     ) %>%
  #     mutate(age_ret = .age_ret)
  # }
  # 
  # 
  # # Projection DES EPRC : Fonction de calcul des EPRC en fonction des quotients
  # # de mortalité
  # calculate_eprc_projection <- function(jahr, alt, quotients_mortalite, eprc) {
  #   template <- tibble(jahr, alt, eprc)
  # 
  #   Q <- tibble_to_matrix(tibble(jahr, alt, quotients_mortalite))
  #   K <- tibble_to_matrix(template)
  # 
  #   uni_jahr <- unique(jahr)
  #   uni_alt <- unique(alt)
  # 
  #   for (i in (seq_along(uni_jahr[-1]) + 1)) {
  #     for (j in (seq_along(uni_alt[-1]) + 1)) {
  #       # 2ème étape: calculer les données en les multipliant par les quotients
  #       # de mortalité pour x != age_ret: \hat{K}_{x, age_ret}^t = \hat{K}_{x-1,
  #       # age_ret}^{t - 1} * (1-q_x^t)
  #       K[i, j] <- (1 - Q[i - 1, j - 1]) * K[i - 1, j - 1]
  #     }
  #   }
  # 
  #   matrix_to_tibble(K, template)
  # }
  # 
  # EPRC_PROJECTION_FLEX_AV <-
  #   tibble(age_ret0 = unique(EPRC_PROJECTION_FLEX_0$age_ret)) %>%
  #   mutate(dta = lapply(age_ret0, dta_age_ret)) %>%
  #   unnest(dta) %>%
  #   dplyr::select(-age_ret0) %>%
  #   group_by(age_ret, sex, nat, dom, gpr, zv) %>%
  #   summarize(dta = list(calculate_eprc_projection(jahr, alt, quotients_mortalite, eprc))) %>%
  #   ungroup() %>%
  #   unnest(dta)


  #---------Traitement et projection des EPRC survivants, rentes compl. et
  # rentes pour enfants----

  # Filtrer pour les autres types de rentes
  RR_ASSURANCE_VIEILLESSE_EPRC_FLEX_FILTERED_AS <- RR_0 %>%
    filter(jahr == PARAM_GLOBAL$jahr_rr &
      gpr != "rvieillesse_simple") %>%
    rename(eprc_ref = eprc) %>%
    dplyr::select(-c(jahr, age_ret))


  EPRC_PROJECTION_FLEX_0_AS <- FACTEURS_CROISSANCE_ANNUELS_EPRC_ESTIMES %>%
    left_join(TAUX_MORTALITE, by = c("sex", "jahr", "alt", "nat")) %>%
    # Right_join pour que seuls les âges du RR soient pris en compte
    right_join(RR_ASSURANCE_VIEILLESSE_EPRC_FLEX_FILTERED_AS,
      by = c("alt", "sex", "nat", "dom")
    ) %>%
    filter(jahr >= PARAM_GLOBAL$jahr_rr &
      !is.na(eprc)) %>%
    group_by(sex, nat, dom, alt, gpr, zv) %>%
    # 1ère étape: Projeter les eprc selon les facteurs de croissance de la
    # population (cf. étape 1 et 2).

    mutate(
      cumprod_wr = cumprod(wachstumsfaktor_popu),
      eprc1 = cumprod_wr * eprc_ref
    ) %>%
    ungroup() %>% 
    select(sex, nat, dom, gpr, zv, jahr, alt, eprc = eprc1)


    # # 2ème étape: ajuster avec les quotients de mortalité
    # 
    # # Projection DES EPRC : Fonction de calcul des EPRC en fonction des
    # # quotients de mortalité
    # calculate_eprc_projection_as <- function(jahr, alt, quotients_mortalite, eprc1) {
    #   template <- tibble(jahr, alt, eprc1)
    # 
    #   Q <- tibble_to_matrix(tibble(jahr, alt, quotients_mortalite))
    #   K <- tibble_to_matrix(template)
    # 
    #   uni_jahr <- unique(jahr)
    #   uni_alt <- unique(alt)
    # 
    #   for (i in (seq_along(uni_jahr[-1]) + 1)) {
    #     for (j in (seq_along(uni_alt[-1]) + 1)) {
    #       # 2ème étape: calculer les données en les multipliant par les
    #       # quotients de mortalité pour x != age_ret: \hat{K}_{x, age_ret}^t =
    #       # \hat{K}_{x-1, age_ret}^{t - 1} * (1-q_x^t)
    #       K[i, j] <- (1 - Q[i - 1, j - 1]) * K[i - 1, j - 1]
    #     }
    #   }
    # 
    #   matrix_to_tibble(K, template)
    # }
    # 
    # # Estimation des EPRC pour les 4 groupes
    # EPRC_PROJECTION_FLEX_AS <-
    #   EPRC_PROJECTION_FLEX_0_AS %>%
    #   group_by(sex, nat, dom, gpr, zv) %>%
    #   summarize(dta = list(calculate_eprc_projection_as(jahr, alt, quotients_mortalite, eprc1))) %>%
    #   ungroup() %>%
    #   unnest(dta) %>%
    #   mutate(age_ret = NA_real_) %>%
    #   dplyr::select(age_ret, sex, nat, dom, gpr, zv, jahr, alt, eprc = eprc1)

    #----Joindre les deux tableaux-----------

    EPRC_PROJECTION_FLEX <- 
    bind_rows(EPRC_PROJECTION_FLEX_0_AV, EPRC_PROJECTION_FLEX_0_AS)

  # return(list(
  #     EPRC_PROJECTION_FLEX = EPRC_PROJECTION_FLEX
  #     )
  )
}
