#' @title Entwicklung der Durchschnittsrenten pro Vollrentenäquivalent bei Erst- und Lauf-
#' renten.
#'
#' @description Schreibt die Entwicklung von Rentenniveaus in den Lebensalter 62-65 per
#' Kohorte und über einem gewissen Grenzalter gepoolt über Zeitreihenextrapolation fort.
#' Zwischen 65 und dem Grenzalter wird ein 'Rentenzyklus' geschätzt, welcher die 
#' Durchschnittsrente pro Vollrentenäquivalent als Vielfaches des Niveaus der Kohorte im
#' Lebensalter 65 beschreibt.
#'
#' @param PARAM_GLOBAL 
#'
#' @param RENTENENTWICKLUNG 
#'
#' @param RR_AVS 
#'
#' @return Ein 'tibble' mit Wachstumsraten der Durchschnittsrenten zur Extrapolation der 
#' Referenz-Rentensummen im Rentenregister des Jahres 'PARAM_GLOBAL$jahr_rr':
#' - `RENTENZYKLUS`
#'
#' @author [MAS BSV](mailto:sekretariat.mas@bsv.admin.ch)
#'
#' @export

mod_rentenzyklus <- function(PARAM_GLOBAL,
                             RENTENENTWICKLUNG,
                             RR_AVS,
                             RR_AVS_ALLAGE) {
  
  # Projektion der Rentenniveaus vor und inklusive Lebensalter 65. -----------------------
  RR_0 <- RR_AVS %>% 
    filter(gpr == "rvieillesse") %>%
    mutate(coh = jahr - alt) %>%
    dplyr::summarize(pen  = sum(monatliche_rentensumme), eprc = sum(eprc),
                     .by = c("coh", "sex", "nat", "dom", "jahr", "alt")) %>% 
    left_join(select(RENTENENTWICKLUNG, jahr, minimalrente), 
              by = "jahr", relationship = "many-to-one") %>%
    # Ausdruck der durchschnittlichen Renten pro Vollrentenäquivalent relativ zur
    # kontemporären Minimalrente.
    mutate(pen = pen / (minimalrente * eprc)) %>% 
    select(coh, sex, nat, dom, jahr, alt, pen) %>%
    # Expansion der Daten um zukünftige Kohorten-ID's und Kalenderjahre, und Restriktion 
    # auf mögliche Eintrittsalter bis hin zum Beginn des Rentenzyklus. Die Unmöglichkeit 
    # für die Frauen-Kohorten 1970+ im Alter 62 vorzubeziehen aufgrund der AHV 21 wird 
    # dabei bewusst ignoriert.
    right_join(
      expand_grid(alt = 62:65, jahr = min(RR_AVS$jahr):PARAM_GLOBAL$jahr_ende,
                  sex = c("m", "f"), nat = c("ch", "au"), dom = c("ch", "au")) %>% 
        mutate(coh = jahr - alt) %>%
        filter(!(sex == "m" & alt < 63)) %>% 
        select(coh, sex, nat, dom, jahr, alt),
      by = c("coh", "sex", "nat", "dom", "jahr", "alt")
    ) %>% 
    # Eingrenzung der zur Extrapolation verwendeten Datenpunkte. Das Fenster wurde
    # gewählt, um Kontaminationen durch die vorteilhaften Vorbezugssätze der 10. AHV
    # Revision zu vermeiden, welche 2012 ausgelaufen sind.
    mutate(pen_c = ifelse(jahr %in% 2014:2023, pen, NA)) %>%
    impute_lm(pen_c ~ jahr | sex + nat + dom + alt) %>%
    # Zusammenführen der historischen und projizierten Rentenniveaus.
    mutate(pen = coalesce(pen, pen_c)) %>%
    select(coh, sex, nat, dom, jahr, alt, pen)
  
  # Projektion der Rentenniveaus über dem Alter 'rentenzyklus_max_alt' -------------------
  RR_F <- RR_AVS_ALLAGE %>% 
    filter(gpr == "rvieillesse") %>%
    mutate(coh = jahr - alt) %>%
    dplyr::summarize(pen  = sum(monatliche_rentensumme), eprc = sum(eprc),
                     .by = c("coh", "sex", "nat", "dom", "zv", "jahr", "alt")) %>% 
    left_join(select(RENTENENTWICKLUNG, jahr, minimalrente), 
              by = "jahr", relationship = "many-to-one")
  
  # Imputation der kontrafaktischen Wachstumsraten der laufenden Renten in 2001, als die
  # die 10. AHV Revision die Anpassung aller laufenden Renten erforderte. Wichtig: 
  # aufgrund des Prinzips der Besitzstandswahrung waren nur Anpassungen nach oben möglich.
  # Die exakten Regeln zur Aufwertung sind zu kompliziert um exakte kontrafaktische Renten 
  # zu berechnen.
  CORR <- RR_F %>% 
    # Eingrenzung auf Renten, welche bereits vor 1997 bezogen und damit im neuen Renten-
    # system berechnet wurden. Ledige werden ausgeschlossen, da deren Renten nicht von 
    # dieser Anpassung betroffen waren.
    filter(!(sex == "f" & coh >= 1935), !(sex == "m" & coh >= 1932),
           jahr %in% 1999:2002, zv != "ledig") %>%
    group_by(coh, sex, nat, dom, zv) %>%
    arrange(jahr, .by_group = TRUE) %>%
    # Restriktion auf Gruppen, die von 1999:2002 auch durchweg beobachtbar sind.
    filter(n() == 4) %>%
    mutate(pen = pen / (minimalrente * eprc)) %>%
    mutate(w_f = pen / lag(pen) - 1) %>%
    na.omit() %>%
    # Löschen des Wachstumssprungs in 2001 zur nachfolgenden Imputation.
    mutate(w_c = ifelse(jahr == 2001, NA, w_f)) %>%
    ungroup() %>%
    impute_lm(w_c ~ 1 | coh + sex + nat + dom + zv) %>%
    filter(jahr == 2001) %>%
    # Berechnung des kontrafaktischen Wachstumsfaktors.
    mutate(corr = (1 + w_c) / (1 + w_f)) %>%
    select(coh, sex, nat, dom, zv, corr)
  
  RR_F <- RR_F %>% 
    left_join(CORR, by = c("coh", "sex", "nat", "dom", "zv")) %>%
    # Ersetzung nötig für Ledige sowie Kohorten, welche ab 1997 oder später erstmals
    # bezogen haben.
    replace_na(list(corr = 1)) %>%
    # Anwendung der Korrektur ab 2001 auf laufende Renten mit Erstbezug vor 1997. Zudem
    # Konsolidierung der Lebensalter 99+ für Konsistenz mit den anderen Berechnungen.
    mutate(pen_c = ifelse(jahr >= 2001, pen * corr, pen)) %>%
    # Einschränkung auf Altersgruppen oberhalb der Lebenszyklus-Obergrenze.
    filter(alt > PARAM_GLOBAL$rentenzyklus_max_alt) %>% 
    # select(sex, nat, dom, jahr, eprc, pen, pen_c, minimalrente) %>% 
    dplyr::summarize(
      pen  = sum(pen), pen_c = sum(pen_c), eprc = sum(eprc),
      .by  = c("sex", "nat", "dom", "jahr", "minimalrente")) %>%  
    mutate(
      pen   = pen   / (minimalrente * eprc),
      pen_c = pen_c / (minimalrente * eprc)) %>% 
    # Erweiterung um die Projektionsjahre.
    right_join(
      expand_grid(jahr = min(RR_AVS$jahr):PARAM_GLOBAL$jahr_ende,
                  sex = c("m", "f"), nat = c("ch", "au"), dom = c("ch", "au")) %>% 
        select(sex, nat, dom, jahr),
      by = c("sex", "nat", "dom", "jahr")
    ) %>% 
    select(sex, nat, dom, jahr, eprc, pen, pen_c) %>% 
    group_by(sex, nat, dom) %>% 
    arrange(jahr, .by_group = TRUE) %>% 
    # Ausschluss der Daten vor Anpassung der laufenden Renten, da eine visuelle Inspektion
    # komplizierte Strukturbrüche nahelegt.
    # filter(jahr >= 2001) %>% 
    mutate(d_pen = pen_c - lag(pen_c)) %>%
    ungroup()
  
  # Projektion zukünftiger Rentenniveaus via NNETAR-Methode (basierend auf einlagigem
  # neuralem autoregressivem Netzwerk). 'set.seed' wird gesetzt, da bei der Initiali-
  # sierung des Algorithmus minimale Abweichungen numerischer Natur auftreten. Der Para-
  # meter 'n_networks' wurde höher als der Default-Wert von 20 gesetzt, da Simulationen
  # ansonsten instabile Prognosen nahelegen.
  set.seed(123)
  NN_PRED <-
    model(filter(as_tsibble(RR_F, index = jahr, key = c(sex, nat, dom)),
                 !(is.na(d_pen))), 
          net = NNETAR(d_pen, n_networks = 100)) %>%
    fabletools::forecast(h = PARAM_GLOBAL$jahr_ende - PARAM_GLOBAL$jahr_lj + 1, 
                         times = 0) %>%
    as_tibble() %>%
    select(sex, nat, dom, jahr, pred = .mean)
  
  RR_F <- RR_F %>% 
    left_join(NN_PRED, by = c("sex", "nat", "dom", "jahr")) %>%
    mutate(d_pen = coalesce(d_pen, pred)) %>%
    tidyr::replace_na(list(d_pen = 0)) %>% 
    select(- pred) %>%
    group_by(sex, nat, dom) %>%
    arrange(jahr, .by_group = TRUE) %>%
    mutate(d_pen = is.na(pen) * d_pen) %>%
    fill(pen) %>%
    mutate(pen = pen + cumsum(d_pen),
           pen_c = coalesce(pen_c, pen)) %>%
    group_by(sex, nat, dom) %>%
    arrange(jahr, .by_group = TRUE) %>%
    # Die Kohorten ID 9999 wird zur Kennzeichnung der konsolidierten Altersgruppe
    # verwendet.
    mutate(coh = 9999, alt = PARAM_GLOBAL$rentenzyklus_max_alt + 1) %>%
    select(coh, sex, nat, dom, jahr, alt, pen)
  
  # Imputation des Rentenzyklus vom Alter 65 bis 'rentenzyklus_max_alt' ------------------
  RR_EV <- RR_AVS %>% 
    filter(gpr == "rvieillesse") %>%
    mutate(coh = jahr - alt) %>%
    dplyr::summarise(pen  = sum(monatliche_rentensumme), eprc = sum(eprc),
                     .by = c("coh", "sex", "jahr", "alt")) %>% 
    left_join(select(RENTENENTWICKLUNG, jahr, minimalrente), 
              by = "jahr", relationship = "many-to-one") %>% 
    mutate(pen = pen / (minimalrente * eprc)) %>% 
    # Restriktion auf Kohorten, welche frühestens seit 1997 beziehen. Vorige Kohorten sind
    # zu kontaminiert für die Schätzung des Zyklus. Zudem Ausschluss von Lebensaltern
    # ausserhalb des Rentenzyklus.
    filter(!(sex == "f" & coh < 1935), !(sex == "m" & coh < 1932), 
           alt %in% 65:PARAM_GLOBAL$rentenzyklus_max_alt) %>% 
    select(coh, sex, jahr, alt, pen)
  
  # Manuelle Korrektur der männlichen Erstrentenniveaus, welche aufgrund der
  # Referenzalterverschiebungen der Frauen Sprünge aufweisen (Grund: spätere Verrentung
  # der Partnerin verzögert Splitting und Plafonierung).
  for (x in 65:68) {
    
    M_DAT <- RR_EV %>% 
      filter(sex == "m", alt == x) %>%
      ungroup() %>%
      mutate(ind = case_when(
        # Die Zeiträume umfassen die Referenzaltererhöhungen sowie den Auslauf der 
        # vorteilhaften Vorbezugssätze in 2012.
        jahr %in% 1997:2000 ~ "a",
        jahr %in% 2001:2004 ~ "b",
        jahr %in% 2005:2011 ~ "c",
        jahr %in% 2012:2024 ~ "d"))
    
    # Der Kontrafakt besteht darin, unterschiedliche Achsenabschnitte für die gewählten
    # Zeiträume zu schätzen, und nachfolgend ausschliesslich den letzten geschätzen
    # Achsenabschnitt zur Rückwärtsextrapolation zu verwenden. Das Subskript "_c" wird
    # verwendet, um 'counterfactual' abzukürzen.
    M_DAT <- M_DAT %>% 
      mutate(pen_c = 
               lm(pen ~ 0 + jahr + ind, M_DAT) %>% 
               predict(mutate(M_DAT, ind = "d")),
             pen_c = ifelse(jahr <= 2011, pen_c, pen)) %>%
      arrange(jahr) %>%
      select(sex, jahr, alt, pen_c)
    
    RR_EV <- RR_EV %>% 
      left_join(M_DAT, by = c("jahr", "sex", "alt")) %>%
      mutate(pen = ifelse(alt == x & sex == "m", pen_c, pen)) %>%
      select(- pen_c)
  }
  
  RR_EV <- RR_EV %>% 
    arrange(sex, alt, jahr) %>%
    mutate(pen_ref = ifelse(alt == 65, pen, NA)) %>%
    group_by(sex, coh) %>% 
    fill(pen_ref, .direction = "downup") %>%
    mutate(rz = pen / pen_ref) %>% 
    filter(alt <= PARAM_GLOBAL$rentenzyklus_max_alt) %>% 
    select(- pen, - pen_ref) %>% 
    ungroup()
  
  RR_EV <- RR_EV %>%  
    # Ergänzung um Projektionsjahre. Die Jahresgrenze wird über den Projektionshorizont 
    # hinaus gesetzt, um Randpunktprobleme in der späteren LOESS-Glättung zu vermeiden.
    right_join(
      expand_grid(jahr = min(RR_AVS$jahr):(PARAM_GLOBAL$jahr_ende + 5),
                  coh  = min(RR_EV$coh):(PARAM_GLOBAL$jahr_ende - 65),
                  sex = c("m", "f")) %>% 
        mutate(alt = jahr - coh) %>% 
        # Ausschluss inkohärenter Fälle.
        filter(jahr - coh == alt, alt %in% 65:PARAM_GLOBAL$rentenzyklus_max_alt) %>% 
        select(coh, sex, jahr, alt),
      by = c("coh", "sex", "jahr", "alt")
    ) %>% 
    group_by(sex, alt) %>%
    arrange(jahr, .by_group = TRUE) %>%
    # Bruchpunktanalyse zur Selektion der Extrapolationspunkte pro Zyklus-Zeitreihe 
    # konditional auf die vergangenen Lebensjahre seit 65. Die minimale Anzahl von Punkten
    # pro Segment 'h' wurde auf 3 gesetzt, um Cauchy-verteilte Prognosen zu vermeiden 
    # (gegeben normalverteilter Störterme). Die Restriktion auf Gruppen mit zumindest
    # '2 * h' Beobachtungen ist notwendig, um die minimalen Datenanforderungen der Methode 
    # zu erfüllen.
    mutate(w_rz = rz / lag(rz) - 1) %>%
    slice(- 1) %>% 
    mutate(bp = ifelse(sum(!is.na(w_rz)) >= 6,
                       max(breakpoints(w_rz ~ 1, h = 3)$breakpoints, 0, na.rm = TRUE), 
                       0),
           rz_c = ifelse(1:n() > bp, rz, NA)) %>%
    mutate(w_rz = rz_c / lag(rz_c) - 1) %>%
    ungroup() %>% 
    impute_lm(w_rz ~ 1 | sex + alt) %>%
    group_by(sex, alt) %>%
    arrange(jahr, .by_group = TRUE) %>%
    mutate(w_rz = is.na(rz) * w_rz) %>%
    fill(rz) %>%
    mutate(rz = rz * cumprod(1 + w_rz)) %>%
    select(coh, sex, jahr, alt, rz, rz_c) %>% 
    ungroup() 
  
  # Glättung der Zyklus-Prognosen anhand der LOESS-Methode.
  RR_L <- list()
  
  for (c in unique(RR_EV$coh)) {
    for (s in unique(RR_EV$sex)) {
      
      suppressWarnings({
        try({
          
          temp <-
            filter(RR_EV, coh == c, sex == s) %>%
            mutate(fl = ifelse(alt == 65, FALSE, TRUE)) %>%
            arrange(alt)
          
          temp$rz[temp$fl] <-
            predict(loess(rz ~ alt, temp, span = 1))[temp$fl]
          
          RR_L[[paste0(c, s)]] <- temp
          
        }, silent = TRUE)
      })
    }
  }
  
  RR_EV <- RR_L %>% 
    bind_rows() %>%
    # Ausfiltrierung der Jahre über dem Projektionshorizont, welche zwecks LOESS-Glättung
    # angefügt wurden.
    filter(jahr <= PARAM_GLOBAL$jahr_ende) %>% 
    # Erweiterung der Projektionen um Nationalität und Domizil zur Kompatibilität mit 
    # Skript 'mod_ahv_rentensumme_go'.
    expand(nat = c("ch", "au"), dom = c("ch", "au"), nesting(coh, jahr, sex, alt, rz)) %>% 
    select(coh, jahr, sex, nat, dom, alt, rz) %>% 
    # Anbindung der geschätzten Rentenniveaus im Alter 65 an die geschätzten
    # Zyklusfaktoren, und abschliessende Multiplikation um zu den projizierten Renten-
    # niveaus zu gelangen.
    filter(alt > 65) %>% 
    left_join(filter(RR_0, alt == 65) %>% select(coh, sex, nat, dom, pen), 
              by = c("coh", "sex", "nat", "dom"), relationship = "many-to-one") %>% 
    mutate(pen = pen * rz) %>% 
    select(- rz)
  
  # Zusammenführung der Prognosen zu den Rentenniveaus im Alter 62-65 (RR_0), der 
  # Durchschnittsrenten im Alter > 65 + rz_b (RR_F) sowie des Rentenzyklus (RR_EV) -------
  RENTENZYKLUS <- 
    bind_rows(RR_0, RR_EV, RR_F) %>% 
    filter(jahr >= PARAM_GLOBAL$jahr_rr) %>% 
    group_by(sex, nat, dom, alt) %>% 
    arrange(jahr, .by_group = TRUE) %>% 
    mutate(wf_rentenzyklus = pen / lag(pen, def = first(pen))) %>%
    ungroup() %>% 
    mutate(gpr = "rvieillesse") %>%
    select(sex, nat, dom, gpr, jahr, alt, pen, wf_rentenzyklus) %>% 
    arrange(alt, jahr) %>% 
    # Unterscheidung von faktischem und konsolidiertem Alter über der Zyklus-Obergrenze
    # zu späteren Merge-Zwecken.
    rename(alt_c = alt)
  
  return(RENTENZYKLUS = RENTENZYKLUS)
}
