# Setup. ----------------------------------------------------------------------------

setwd("~/data/appl-wb/20_staff/kjo/fhh/2025-06-11T1641_u80874371_ahv_basis_kjo")

PARAM_GLOBAL <-
  read_delim("PARAM_GLOBAL.csv")

RENTENENTWICKLUNG <-
  read_delim("RENTENENTWICKLUNG.csv")

RR_AVS <-
  read_delim("RR_AVS.csv")

load("~/data/appl-wb/01_raw_data/allgemein/go/RR/RR_AVS/2024/RR_AVS_ALLAGE.RData")


# Datenaufbereitung. ----------------------------------------------------------------

# 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)

DAT <- 
  as_tsibble(RR_F, index = jahr, key = c(sex, nat, dom)) %>% 
  filter(sex == "f", nat == "au", dom == "ch", !(is.na(pen)))

DAT %>%  
  model(net = NNETAR(pen_c)) %>%
  fabletools::forecast(h = 16, 
                       times = 100) %>% 
  autoplot(rename(select(DAT, - pen_c), pen_c = pen))

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)


# Visualisierung. -------------------------------------------------------------------

VIZ <- RR_F %>% 
  filter(jahr <= 2024)

ggplot(VIZ, aes(x = jahr, y = pen, col = sex)) +
  geom_shadowpoint() +
  facet_grid(nat ~ dom, labeller = label_both)
