#' Estimation des EPRC à partir de la population
#'
#' Ce module calcule les équivalents pleine rente cumulés (EPRC) à
#' partir des données d'une certaine population en les faisant évoluer selon
#' les taux de mortalité.
#'
#' @param PARAM_GLOBAL 
#'
#' @param POPULATION_TOT data frame contenant les données de la population
#' calculé dans la fonction \code{\link{mod_population}}.
#'
#' @param MORTALITE data frame contenant les taux de mortalité, cf. fonction
#' \code{\link{mod_input_mortalite}}.
#'
#' @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_ESTIMATION`
#'
#' @author [MAS BSV](mailto:sekretariat.mas@bsv.admin.ch)
#'
#' @export
#'

mod_eprc_estimation <- function(PARAM_GLOBAL,
                                BEVOELKERUNG,
                                TAUX_MORTALITE,
                                RR_AVS) {
  
  print("Run module: mod_eprc_estimation")
  
  # Aufbereitung der historischen und Szenario-bedingten Bevölkerungsentwicklungen zur 
  # Anwendung des Alogrithmus, welcher die kumulierten Vollrentenäquivalente projiziert.
  POPULATION_TOT <- BEVOELKERUNG %>%
    mutate(bevendejahr = bevendejahr, dom = "ch") %>%
    select(sex, nat, dom, jahr, alt, bevendejahr) %>%
    # Ausländische Rentenpopulation.
    bind_rows(
      BEVOELKERUNG %>%
        mutate(bevendejahr = rowSums(select(., auswanderung, saisonniers, frontaliers, 
                                               assures_facultatifs), na.rm = TRUE), 
               dom = "au") %>%
        select(sex, nat, dom, jahr, alt, bevendejahr)
      )
  
  # Berechnung des jahresweisen Bewertungsfaktors, welcher je nach Geschlecht bzw.
  # Kohorte Beitragsjahre in erworbene Skalen übersetzt.
  POPU <- POPULATION_TOT %>%
    left_join(TAUX_MORTALITE, by = c("sex", "nat", "jahr", "alt")) %>%
    mutate(
      
      # ID nach Geburtskohorte.
      coh = jahr - alt, 
      
      # Vereinfachende Annahme: die Übersetzung von Beitragsjahr zu Skala ist proportional
      # zur maximalen Anzahl Beitragsjahre der entsprechenden Kohorte. Auf individuellem
      # Level sind eigentlich noch Rundungsregeln zu beachten, welche hier nicht 
      # berücksichtigt werden können.
      bewertungsjahrfaktor = case_when(
        
        alt %in% 21:64 & sex == "m" ~ 
          pmax(
            1 / (65 - 21              ),
            1 / (65 - 21 + coh - 1927)),
        
        alt %in% 21:61 & sex == "f" & coh <= 1938 ~ 
          pmax(
            1 / (62 - 21              ),
            1 / (62 - 21 + coh - 1927)),
        
        alt %in% 21:62 & sex == "f" & coh %in% 1939:1941 ~ 
          pmax(
            1 / (63 - 21              ),
            1 / (63 - 21 + coh - 1927)),
        
        alt %in% 21:63 & sex == "f" & coh >= 1942 ~ 
          pmax(
            1 / (64 - 21              ),
            1 / (64 - 21 + coh - 1927)),
        
        TRUE ~ 0), 
      
      # Flussgrösse der Vollrentenäquivalente-Bildung.
      epr = bewertungsjahrfaktor * bevendejahr,
      
      # Imputation der kohortenweisen hypothetischen Vollrentenbestände im Initialisierungs-
      # jahr des Algorithmus.
      eprc = epr * 
        
        case_when(
          
          # Annahme: wer sich in der Schweiz befindet bzw. arbeitet leistet im betreffenden
          # Jahr rentenwirksame Beiträge. Die Kappung am Referenzalter nach Kohorte 
          # verhindert die Bewertung von Jahren nach Eintritt in die Rentenpopulation
          # (ignoriert eventuelle Schliessung von Beitragslücken nach dem Referenzalter,
          # welche seit der Reform AHV 21 möglich ist).
          (alt == 21 | jahr == min(jahr)) & nat == "ch" & sex == "m"                      
            ~ pmin(alt, 65) - 21,
          
          (alt == 21 | jahr == min(jahr)) & nat == "ch" & sex == "f" & coh <= 1938        
            ~ pmin(alt, 62) - 21,
          
          (alt == 21 | jahr == min(jahr)) & nat == "ch" & sex == "f" & coh %in% 1939:1941 
            ~ pmin(alt, 63) - 21,
          
          (alt == 21 | jahr == min(jahr)) & nat == "ch" & sex == "f" & coh >= 1942        
            ~ pmin(alt, 64) - 21,
          
          # Implizite Annahme: Emigranten transferieren nur ein Beitragsjahr ins Ausland
          # und kehren niemals in die Schweiz zurück. Diese Annahme wird durch eine 
          # spätere Justierung der projizierten Vollrentenansprüche auf das Rentenregister 
          # kompensiert.
          (alt == 21 | jahr == min(jahr)) & nat != "ch"                                   
            ~                  1,
          
          TRUE ~ 0)
      ) %>%
    ungroup()
  
  # Funktion zur iterativen Berechnung der akkumulierten Vollrentenäquivalente.
  calculate_eprc_extrapolation <- function(DTA) {
    
    # Jahr und Alter
    jahr <- unique(DTA$jahr)
    alt  <- unique(DTA$alt)
    
    # Taux de mortalité
    Q <- tibble_to_matrix(dplyr::select(DTA, jahr, alt, quotients_mortalite))
    
    # Equivalents pleine rente
    V <- tibble_to_matrix(dplyr::select(DTA, jahr, alt, epr))
    
    # Equivalents pleine rente cumulés
    K <- tibble_to_matrix(dplyr::select(DTA, jahr, alt, eprc))
    
    for (i in (seq_along(jahr[-1]) + 1)) {
      for (j in (seq_along(alt[-1]) + 1)) {
        
        K[i, j] <- (1 - Q[i - 1, j - 1]) * K[i - 1, j - 1] + V[i, j]
        
      }
    }
    
    matrix_to_tibble(K, dplyr::select(DTA, jahr, alt, eprc))
  }
  
  # Anwendung der EPRC-Funktion auf das kartesische Produkt von Geschlecht, Nationalität
  # und Domizil.
  EPRC_ESTIMATION <- crossing(
    sex = c("f", "m"), nat = c("ch", "au"), dom = c("ch", "au")) %>%
    group_by(sex, nat, dom) %>%
    do(dta0 = calculate_eprc_extrapolation(filter(
      POPU, sex == .$sex, nat == .$nat, dom == .$dom
    ))) %>%
    unnest(cols = c(dta0)) %>%
    filter(!is.na(eprc)) %>%
    left_join(POPULATION_TOT, by = c("sex", "nat", "dom", "jahr", "alt"))
  
  # Adjustierung der Vollrenten-Projektionen auf den aktuellsten Eintrag des Renten-
  # registers. Diese Justierung beeinflusst nicht die Folgeergebnisse, da ausschliesslich
  # die projizierten Wachstumsraten verwendet werden (welche durch multiplikative 
  # Justierungen unverändert bleiben). Diese Justierung ist jedoch zu Kontrollzwecken 
  # nützlich, da sie eine gute Reproduktion historischer Rentenbestände aufzeigt. Zudem 
  # werden so inkohärente Zwischen-Outputs verhindert.
  ADJ <- RR_AVS %>% 
    filter(gpr == "rvieillesse", jahr == PARAM_GLOBAL$jahr_rr) %>%
    select(sex, nat, dom, jahr, alt, eprc) %>%
    dplyr::summarize(eprc = sum(eprc),  
                     .by = c("sex", "nat", "dom", "jahr", "alt")) %>%
    group_by(sex, nat, dom, alt) %>%  
    left_join(select(EPRC_ESTIMATION, sex, nat, dom, jahr, alt, eprc_est = eprc), 
              by = c("sex" , "nat", "dom", "jahr", "alt")) %>%
    mutate(adj = eprc / eprc_est) %>%
    select(sex, nat, dom, alt, adj) %>% 
    na.omit()
  
  EPRC_ESTIMATION <- EPRC_ESTIMATION %>% 
    left_join(ADJ, by = c("sex", "nat", "dom", "alt"), relationship = "many-to-one") %>%
    replace_na(list(adj = 1)) %>% 
    mutate(eprc = eprc * adj) %>%
    select(- adj)
  
  return(EPRC_ESTIMATION = EPRC_ESTIMATION)
}
