sapply(c("tidyverse", "magrittr", "tsibble", "fable", "simputation", "ggshadow",
         "imputeTS" , "spatstat.utils", "Amelia", "strucchange", "timeplyr"), 
       library, char = TRUE)

min <- 
  read_delim(
    "~/data/appl-wb/14_basismodell/24042025/data/mpen_VA26003.csv", show = FALSE) %>%
  mutate(mp = minimalrente) %>% 
  select(jahr, mp)

# Helper for assignment of '.RDATA' files.
loadRData <- function(fileName) {
  load(fileName)
  get(ls()[ls() != "fileName"]) }

# Life cycle boundary.
lb <- 20 

# Load pension registry.
RR <-
  loadRData("~/data/appl-wb/20_staff/kjo/misc_data/RR_AVS_2024_fullagerange.rdata") 

# Impute initial pensions. ---------------------------------------------------------
RR_0 <- RR %>% 
  mutate(coh = jahr - alt) %>%
  filter(gpr == "rvieillesse_simple", 
         eprc > 0, alt >= 62, age_ret > 61) %>% 
  dplyr::summarise(pen  = sum(monatliche_rentensumme), 
                   eprc = sum(eprc),
                   .by = c("coh", "jahr", "sex", "nat", "dom", "alt")) %>% 
  left_join(min, by = "jahr", relationship = "many-to-one") %>% 
  mutate(pen = pen / (mp * eprc), step = alt - 65) %>% 
  select(coh, jahr, sex, nat, dom, step, pen) %>% 
  filter(step %in% (-3:0)) %>% 
  mutate(jahr = factor(jahr, levels = (min(.$coh) + 65):2060),
         coh  = factor(coh , levels = c(min(.$coh):(2060 - 65)))) %>%
  complete(coh, jahr, sex, nat, dom, step) %>%
  mutate(jahr = parse_number(as.character(jahr)),
         coh  = parse_number(as.character(coh))) %>%
  filter(jahr - coh == 65 + step,
         !(sex == "m" & step == - 3), 
         !(sex == "m" & jahr < 2001 & step == - 2)) %>%
  select(coh, jahr, sex, nat, dom, step, pen) %>% 
  group_by(sex, nat, dom, step) %>% 
  arrange(sex, nat, dom, step, jahr) %>% 
  mutate(pen_c = ifelse(jahr %in% 2015:2023, pen, NA)) %>% 
  ungroup() %>% 
  impute_lm(pen_c ~ jahr | sex + nat + dom + step) %>% 
  group_by(sex, nat, dom, step) %>% 
  arrange(sex, nat, dom, step, jahr) %>% 
  mutate(pen = coalesce(pen, pen_c)) %>% 
  select(coh, jahr, sex, nat, dom, step, pen) %>% 
  filter(!(sex == "f" & step == -3 & jahr >= 2032),
         jahr >= PARAM_GLOBAL$jahr_rr) %>% 
  mutate(w_pen = pen / lag(pen, def = first(pen)),
         step = 65 + step) %>% 
  rename(alt = step)

# Impute ancient pensions. ----------------------------------------------------------
RR_F <- RR %>% 
  mutate(coh = jahr - alt) %>%
  filter(gpr == "rvieillesse_simple", 
         eprc > 0, alt >= 62, age_ret > 61) %>%
  dplyr::summarise(pen  = sum(monatliche_rentensumme),
                   eprc = sum(eprc),
                   n    = sum(bez_av),
                   .by = c("coh", "jahr", "sex", "nat", "dom", "zv", "alt")) %>% 
  left_join(min, by = "jahr", relationship = "many-to-one")

# Revert up-correction of current pensions in 2001.
corr <-
  filter(RR_F, !(sex == "f" & coh >= 1935), !(sex == "m" & coh >= 1932),
         jahr %in% 1999:2002, zv != "ledig") %>%
  group_by(coh, sex, nat, dom, zv) %>%
  filter(n() == 4) %>%
  mutate(pen = pen / (eprc * mp)) %>%
  arrange(coh, sex, nat, dom, zv, jahr) %>%
  mutate(corr = pen / lag(pen) - 1) %>%
  na.omit() %>%
  mutate(corr2 = ifelse(jahr == 2001, NA, corr)) %>%
  ungroup() %>%
  impute_lm(corr2 ~ 1 | coh + sex + nat + dom + zv) %>%
  filter(jahr == 2001) %>%
  mutate(corr = (1 + corr2) / (1 + corr)) %>%
  select(coh, sex, nat, dom, zv, corr)

RR_F2 <- RR_F

RR_F %<>%
  left_join(corr, by = c("coh", "sex", "nat", "dom", "zv")) %>%
  replace_na(list(corr = 1)) %>%
  mutate(
    pen_c = pen / (eprc * mp),
    pen_c = ifelse(jahr >= 2001, pen_c *
                     !(nat == "au" & dom == "ch" & sex == "f") * corr, NA),
    pen_c = pen_c * (eprc * mp)) %>%
  select(- corr) %>%
  filter(alt - 65 > lb) %>% 
  select(jahr, sex, nat, dom, eprc, pen, pen_c, mp) %>% 
  dplyr::summarize(
    pen  = sum(pen), pen_c = sum(pen_c), eprc = sum(eprc),
    .by  = c("jahr", "sex", "nat", "dom", "mp")) %>%  
  mutate(
    pen   = pen   / (eprc * mp),
    pen_c = pen_c / (eprc * mp),
    jahr = factor(jahr, levels = 1997:2060)) %>%
  complete(jahr, sex, nat, dom) %>%
  mutate(jahr = parse_number(as.character(jahr))) %>%
  select(jahr, sex, nat, dom, eprc, pen, pen_c) %>% 
  group_by(sex, nat, dom) %>% 
  arrange(sex, nat, dom, jahr) %>% 
  mutate(d_pen = pen_c - lag(pen_c)) %>% 
  # mutate(bp   = max(breakpoints(d_pen ~ 1, h = 5)$breakpoints, 0, na.rm = TRUE),
  #        d_pen = ifelse(1:n() > bp, d_pen, NA)) %>%
  ungroup() %>% 
  impute_lm(d_pen ~ 1 | sex + nat + dom) %>%
  group_by(sex, nat, dom) %>%
  arrange(sex, nat, dom, jahr) %>%
  mutate(d_pen = is.na(pen) * d_pen) %>%
  fill(pen) %>%
  mutate(pen = pen + cumsum(d_pen),
         pen_c = coalesce(pen_c, pen)) %>%
  filter(jahr <= 2060) %>%
  mutate(coh = 9999, alt = 65 + lb + 1) %>%
  select(coh, jahr, sex, nat, dom, alt, pen) %>% 
  # filter(jahr >= PARAM_GLOBAL$jahr_rr) %>% 
  mutate(w_pen = cumprod(pen / lag(pen, def = first(pen)))) 

ggplot(filter(RR_F, jahr >= 2001), aes(x = jahr, y = pen)) +
  geom_shadowline() +
  geom_shadowpoint() +
  facet_grid(sex ~ nat + dom, labeller = label_both)
    
  
# Impute pension life cycle from 65-85 ----------------------------------------------
RR_EV <-
  dplyr::rename(RR, age = alt, jahr = jahr) %>% 
  mutate(coh = jahr - age,
         gpr = ifelse(gpr == "rveuve" & age, "rvieillesse_simple", gpr),
         eprc = ifelse(gpr == "rveuve", bez_av, eprc)) %>%
  filter(gpr == "rvieillesse_simple", eprc > 0, age >= 62, age_ret > 61) %>% 
  dplyr::summarise(pen  = sum(monatliche_rentensumme), 
                   eprc = sum(eprc),
                   .by = c("jahr", "coh", "sex", "age")) %>% 
  left_join(min, by = "jahr", relationship = "many-to-one") %>% 
  mutate(pen = pen / (mp * eprc), step = age - 65) %>% 
  filter(!(sex == "f" & coh < 1935), !(sex == "m" & coh < 1932), step >= 0) %>% 
  select(coh, jahr, sex, step, pen)

# Impute counterfactual initial pensions for men around female reference age augmentation.
for (x in 0:3) {

  M_DAT <-
    filter(RR_EV, sex == "m", step == x) %>%
    ungroup() %>%
    mutate(ind = case_when(
      jahr %in% 1997:2000 ~ "a",
      jahr %in% 2001:2004 ~ "b",
      jahr %in% 2005:2011 ~ "c",
      jahr %in% 2012:2024 ~ "d"))

  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(jahr, sex, step, pen, pen_c)

  RR_EV %<>%
    left_join(select(M_DAT, - pen), by = c("jahr", "sex", "step")) %>%
    mutate(pen = ifelse(step == x & sex == "m", pen_c, pen)) %>%
    select(- pen_c)
}

ggplot(filter(RR_EV, step >= 10, sex == "f", step <= 15), aes(x = jahr, y = pen,
                                                              col = as.factor(step))) +
  scale_colour_viridis_d() +
  geom_shadowline() +
  geom_shadowpoint() +
  scale_y_continuous(expand = expansion(mult = .5))

RR_EV %<>%
  arrange(step, jahr) %>%
  mutate(pen_ref = ifelse(step == 0, pen, NA)) %>%
  group_by(sex, coh) %>% 
  fill(pen_ref, .direction = "downup") %>%
  mutate(lc = pen / pen_ref) %>% 
  filter(step <= lb) %>% 
  select(- pen, - pen_ref)

RR_EV %<>% 
  ungroup() %>%
  mutate(jahr = factor(jahr, levels = 1997:2060),
         coh  = factor(coh , levels = c(min(.$coh):(2060 - 65)))) %>%
  complete(coh, jahr, sex, step) %>%
  mutate(jahr = parse_number(as.character(jahr)),
         coh  = parse_number(as.character(coh))) %>%
  filter(jahr - coh == 65 + step, !(sex == "m" & coh == 1938)) %>%
  filter(!(jahr <= 2024 & is.na(lc))) %>%
  group_by(sex, step) %>%
  arrange(sex, step, jahr) %>%
  mutate(bp   = ifelse(step <= 16, max(breakpoints(lc ~ jahr, h = 3)$breakpoints), 0),
         bp   = ifelse(is.na(bp), 0, bp),
         lc_c = ifelse(1:n() > bp, lc, NA)) %>%
  mutate(d_lc = lc_c / lag(lc_c) - 1) %>%
  filter(step <= lb) %>%
  mutate(t = c(1, diff(jahr - 1997)), fl = is.na(lc)) %>%
  ungroup() %>% 
  impute_lm(d_lc ~ t | sex + step) %>%
  group_by(sex, step) %>%
  arrange(sex, jahr) %>%
  mutate(d_lc = is.na(lc) * d_lc) %>%
  fill(lc) %>%
  mutate(lc = lc * cumprod(1 + d_lc)) %>%
  select(coh, jahr, sex, step, lc) %>% 
  ungroup()

RR_L <- list()

for (c in unique(RR_EV$coh)) {
  for (s in unique(RR_EV$sex)) {

    try({

      temp <-
        filter(RR_EV, coh == c, sex == s) %>%
        mutate(fl = ifelse(step == 0, FALSE, TRUE)) %>%
        arrange(step)

        temp$lc[temp$fl] <-
          predict(loess(lc ~ step, temp, span = 1))[temp$fl]

      RR_L[[paste0(c, s)]] <- temp

      }, silent = TRUE)
  }
}

RR_EV <-
  bind_rows(RR_L)

RR_EV <-
  bind_rows(c("ch", "au") %>% map(\(x) mutate(RR_EV, nat = x)))

RR_EV <-
  bind_rows(c("ch", "au") %>% map(\(x) mutate(RR_EV, dom = x)))

RR_EV %<>%
  mutate(age = jahr - coh) %>% 
  select(coh, jahr, sex, nat, dom, age, step, g_p = lc)

# RR_C <- 
#   filter(RR_EV, jahr <= 2060) %>% 
#   select(coh, jahr, sex, nat, dom, step, lc) %>% 
#   arrange(coh, sex, nat, dom, step) %>% 
#   left_join(filter(RR_0, step == 0) %>% select(- step, - jahr), 
#             by = c("coh", "sex", "nat", "dom")) %>% 
#   group_by(coh, sex, nat, dom) %>% 
#   arrange(coh, sex, nat, dom, jahr) %>% 
#   fill(pen) %>% 
#   mutate(pen = pen * lc) %>% 
#   select(- lc) %>% 
#   bind_rows(filter(RR_0, step < 0)) %>% 
#   bind_rows(RR_F) %>% 
#   left_join(min, by = "jahr") %>% 
#   mutate(pen = pen, fl = jahr >= 2025)
  
ggplot(filter(RR_EV, jahr <= 2047, coh <= 1959) %>% mutate(fl = jahr >= 2025),
       aes(x = step, y = g_p, col = as.factor(coh), shape = sex,
           group = interaction(coh, sex))) +
  scale_colour_viridis_d(option = "B") +
  geom_hline(yintercept = 1) +
  geom_shadowline(alpha = .25) +
  geom_shadowpoint(size = 1.5)

# ggplot(filter(RR_X, step >= 0, jahr <= 2047, coh <= 1959), aes(x = step, y = pen,
#                                                                col = as.factor(coh))) +
#   scale_colour_viridis_d(option = "C") +
#   geom_shadowpoint(size = 1) +
#   facet_grid(sex ~ nat + dom)

# Extrapolate other mean pensions. --------------------------------------------------
RR_O <-
  RR %>% 
  filter(!(gpr %in% c("rvieillesse_simple", "rcompl_femme", NA))) %>% 
  mutate(gpr = case_when(
    gpr %in% c("rorphelin_pere_simple", "rorphelin_mere_simple", "rorphelin_double") ~
      "rorphelin",
    gpr %in% c("renfant_pere_simple", "renfant_mere_simple") ~
      "renfant",
    TRUE ~ gpr
  )) %>% 
  dplyr::summarise(pen  = sum(monatliche_rentensumme), 
                   n    = sum(bez_av),
                   .by = c("jahr", "sex", "nat", "dom", "gpr", "alt")) %>% 
  left_join(rename(min, jahr = jahr), by = "jahr", relationship = "many-to-one") %>% 
  mutate(pen = pen / (mp * n)) %>% 
  select(jahr, sex, nat, dom, gpr, alt, n, pen) %>% 
  group_by(jahr, sex, nat, dom, gpr) %>% 
  arrange(sex, nat, dom, gpr, jahr) %>% 
  dplyr::summarize(pen = weighted.mean(pen, n)) %>% 
  ungroup() %>% 
  mutate(pen = 
           ifelse(gpr == "rveuve" & sex == "m" & jahr %in% 2023:2024, NA, pen)) %>% 
  mutate(jahr = factor(jahr, levels = 1997:2075)) %>% 
  complete(jahr, sex, nat, dom, gpr) %>% 
  mutate(jahr = parse_number(as.character(jahr))) %>% 
  group_by(sex, nat, dom, gpr) %>% 
  arrange(sex, nat, dom, gpr, jahr) %>% 
  mutate(d_pen = pen - lag(pen)) %>% 
  mutate(bp    = max(breakpoints(d_pen ~ jahr, h = 4)$breakpoints, 0),
         bp    = ifelse(is.na(bp), 0, bp),
         d_pen = ifelse(1:n() > bp, d_pen, NA)) %>%
  select(- bp) %>% 
  ungroup() %>% 
  impute_lm(d_pen ~ 1 | sex + nat + dom) %>% 
  group_by(sex, nat, dom, gpr) %>%
  arrange(sex, nat, dom, gpr, jahr) %>%
  mutate(d_pen = is.na(pen) * d_pen) %>%
  fill(pen) %>%
  mutate(pen = pen + cumsum(d_pen)) %>% 
  select(- d_pen) %>% 
  filter(jahr >= PARAM_GLOBAL$jahr_rr) %>% 
  mutate(w_pen = pen / lag(pen, default = first(pen))) %>% 
  select(- pen)
  
x <- 
  filter(RR_0, sex == "m", nat == "ch", dom == "ch")

ggplot(filter(RR_O, jahr %in% 2015:2040), aes(x = jahr, y = pen, col = gpr)) +
  geom_shadowline() +
  geom_shadowpoint() +
  facet_grid(nat + dom ~ sex, labeller = label_both)

RR_Z <- 
  ungroup(RR_X) %>% 
  mutate(age = ifelse(coh != 9999, jahr - coh, 65 + lb + 1)) %>% 
  select(- coh) %>% 
  select(jahr, sex, nat, dom, age, pen) %>% 
  filter(jahr >= 2024) %>% 
  group_by(sex, nat, dom, age) %>% 
  arrange(sex, nat, dom, age, jahr) %>% 
  mutate(g_p = pen / lag(pen)) %>% 
  replace_na(list(g_p = 1)) %>% 
  mutate(g_p = cumprod(g_p)) %>% 
  select(jahr = jahr, sex, nat, dom, alt = age, g_p)

# 
# write_delim(RR_Z, file = "~/delfinverse/G_P.csv", delim = ";")

# Legacy code. ----------------------------------------------------------------------

# # Compute Aufwertungsfaktoren.
# 
# # Strukturfaktor.
# sf <- .002
# 
# temp <- 
#   read_delim("~/data/appl-wb/20_staff/kjo/misc_data/RENTENENTWICKLUNG.csv", show = FALSE) %>% 
#   select(jahr = jahr, sli = lohnindex, lik = preisindex, mp = minimalrente) %>%
#   mutate(sli = sli / filter(., jahr == 1979)$sli, lik) %>% 
#   filter(jahr >= 2024)
# 
# sli_m <- 
#   read_delim("sli_lik.csv", show = FALSE) %>% 
#   select(jahr = jahr, sli, lik) %>% 
#   left_join(min, by = "jahr") %>% 
#   mutate(sli = sli / filter(., jahr == 1979)$sli) %>% 
#   bind_rows(temp) %>% 
#   mutate(ms = roll_mean(sli, window = 43, partial = FALSE), 
#          af = (round(mp / 5.5, 1) / 100) / (1.1 * lag(ms)),
#          af = pmax(af, 1),
#          af = (as.integer(1000 * af + .5) / 1000),
#          gs = af * (lag(ms) + sf) / mp,
#          sex = "m", nat = "ch") %>% 
#   select(jahr, sex, nat, af, gs) %>% 
#   na.omit()
# 
# sli_f <- 
#   read_delim("sli_lik.csv", show = FALSE) %>% 
#   select(jahr = jahr, sli, lik) %>% 
#   left_join(min, by = "jahr") %>% 
#   mutate(sli = sli / filter(., jahr == 1979)$sli) %>% 
#   bind_rows(temp) %>% 
#   mutate(ms = roll_mean(sli, window = 42, partial = FALSE), 
#          af = (round(mp / 5.5, 1) / 100) / (1.1 * lag(ms)),
#          af = pmax(af, 1),
#          af = (as.integer(1000 * af + .5) / 1000),
#          gs = af * (lag(ms) + sf) / mp,
#          sex = "f", nat = "ch") %>% 
#   select(jahr, sex, nat, af, gs) %>% 
#   na.omit()
# 
# sli_au_f <- 
#   read_delim("sli_lik.csv", show = FALSE) %>% 
#   select(jahr = jahr, sli, lik) %>% 
#   left_join(min, by = "jahr") %>% 
#   mutate(sli = sli / filter(., jahr == 1979)$sli) %>% 
#   bind_rows(temp) %>% 
#   mutate(ms = roll_mean(sli, window = 18, partial = FALSE), 
#          af = (round(mp / 5.5, 1) / 100) / (1.1 * lag(ms)),
#          af = pmax(af, 1),
#          af = (as.integer(1000 * af + .5) / 1000),
#          gs = af * (lag(ms) + sf) / mp,
#          sex = "f", nat = "au") %>% 
#   select(jahr, sex, nat, af, gs) %>% 
#   na.omit()
# 
# sli_au_m <- 
#   read_delim("sli_lik.csv", show = FALSE) %>% 
#   select(jahr = jahr, sli, lik) %>% 
#   left_join(min, by = "jahr") %>% 
#   mutate(sli = sli / filter(., jahr == 1979)$sli) %>% 
#   bind_rows(temp) %>% 
#   mutate(ms = roll_mean(sli, window = 19, partial = FALSE), 
#          af = (round(mp / 5.5, 1) / 100) / (1.1 * lag(ms)),
#          af = pmax(af, 1),
#          af = (as.integer(1000 * af + .5) / 1000),
#          gs = af * (lag(ms) + sf) / mp,
#          sex = "m", nat = "au") %>% 
#   select(jahr, sex, nat, af, gs) %>% 
#   na.omit()
# 
# sli <- 
#   bind_rows(sli_m, sli_f, sli_au_f, sli_au_m) %>% 
#   filter(jahr >= 1985)
# 
# ggplot(sli, aes(x = jahr, y = af, col = interaction(sex, nat))) +
#   geom_shadowpoint()

# rr0 %<>%
#   mutate(type = "d_gs")
# 
# rr1 %<>%
#   mutate(type = "1")
# 
# rr2 <- 
#   bind_rows(rr0, rr1)
# 
# # Heuristic smoothing of 10th AHV reform effects.
# m1 <-
#   mean(filter(rr0, sex == "m", coh %in% 1946:1950)$pen) /
#   mean(filter(rr0, sex == "m", coh %in% 1932:1935)$pen)
# 
# m2 <-
#   mean(filter(rr0, sex == "m", coh %in% 1946:1950)$pen) /
#   mean(filter(rr0, sex == "m", coh %in% 1936:1939)$pen)
# 
# m3 <-
#   mean(filter(rr0, sex == "m", coh %in% 1946:1950)$pen) /
#   mean(filter(rr0, sex == "m", coh %in% 1940:1945)$pen)
# 
# f1 <-
#   mean(filter(rr0, sex == "f", coh %in% 1948:1949)$pen) /
#   mean(filter(rr0, sex == "f", coh %in% 1942:1947)$pen)
# 
# f2 <-
#   mean(filter(rr0, sex == "f", coh %in% 1940:1952)$pen) /
#   mean(filter(rr0, sex == "f", coh %in% 1939:1941)$pen)

# # Revert up-correction of current pensions in 2001. ---------------------------------
# corr <-
#   filter(rr, jahr %in% 1999:2003, age <= 100) %>%
#   group_by(coh, sex) %>%
#   filter(n() == 6) %>%
#   arrange(coh, sex, jahr) %>%
#   mutate(corr = c(NA, diff(pen))) %>%
#   na.omit() %>%
#   mutate(corr2 = ifelse(jahr == 2001, NA, corr)) %>%
#   ungroup() %>%
#   impute_lm(corr2 ~ 1 | coh + sex) %>%
#   filter(jahr == 2001, coh >= 1935) %>%
#   mutate(corr = corr2 - corr) %>%
#   select(coh, sex, corr)
# 
# RR_EV %<>%
# left_join(corr, by = c("coh", "sex")) %>%
# replace_na(list(corr = 0)) %>%
# mutate(pen = ifelse(jahr >= 2001, pen, pen)) %>%
# select(- corr) %>%

# RR_EV %<>%
#   arrange(step, jahr) %>%
#   mutate(pen_ref = ifelse(step == 0, pen, NA)) %>%
#   group_by(sex, coh) %>% 
#   fill(pen_ref, .direction = "downup") %>%
#   mutate(pen = pen / pen_ref) %>% 
#   ungroup() %>% 
#   mutate(jahr = factor(jahr, levels = 1997:2040),
#          coh  = factor(coh , levels = c(min(.$coh):(2040 - 65)))) %>%
#   complete(coh, jahr, sex, step) %>%
#   mutate(jahr = parse_number(as.character(jahr)),
#          coh  = parse_number(as.character(coh))) %>%
#   filter(jahr - coh == 65 + step) %>%
#   select(- eprc, - pen_ref) %>%
#   filter(!(jahr <= 2024 & is.na(pen))) %>% 
#   group_by(sex, step) %>% 
#   arrange(sex, step, jahr) %>% 
#   mutate(d_pen = c(NA, diff(pen))) %>%
#   ungroup() %>%
#   filter(step <= 20) %>% 
#   mutate(t = jahr - 1997, fl = is.na(pen)) %>% 
#   impute_rlm(d_pen ~ 0 + sqrt(t) | sex + step) %>%
#   group_by(sex, step) %>%
#   arrange(sex, jahr) %>% 
#   mutate(d_pen = is.na(pen) * d_pen) %>%
#   fill(pen) %>% 
#   mutate(pen = pen + cumsum(d_pen),
#          pen = case_when(
#            sex == "f" ~ pmax(1, pen),
#            sex == "m" ~ pmin(1, pen)
#          )) %>% 
#   select(coh, jahr, sex, step, pen, fl)

# RR_EV %<>%
#   arrange(step, jahr) %>%
#   mutate(pen_ref = ifelse(step == 0, pen, NA)) %>%
#   group_by(sex, coh) %>% 
#   fill(pen_ref, .direction = "downup") %>%
#   mutate(pen = pen / pen_ref) %>% 
#   ungroup() %>% 
#   mutate(jahr = factor(jahr, levels = 1997:2040),
#          coh  = factor(coh , levels = c(min(.$coh):(2040 - 65)))) %>%
#   complete(coh, jahr, sex, step) %>%
#   mutate(jahr = parse_number(as.character(jahr)),
#          coh  = parse_number(as.character(coh))) %>%
#   filter(jahr - coh == 65 + step) %>%
#   select(- eprc, - pen_ref) %>%
#   filter(!(jahr <= 2024 & is.na(pen))) %>% 
#   group_by(sex, step) %>% 
#   arrange(sex, step, jahr) %>% 
#   mutate(d_pen = pen / lag(pen) - 1) %>%
#   ungroup() %>%
#   filter(step <= 20) %>% 
#   mutate(t = jahr - 1997, fl = is.na(pen)) %>% 
#   impute_rlm(d_pen ~ 1 | sex + step) %>%
#   group_by(sex, step) %>%
#   arrange(sex, jahr) %>% 
#   mutate(d_pen = is.na(pen) * d_pen) %>%
#   fill(pen) %>% 
#   mutate(pen = pen * cumprod(1 + d_pen),
#          pen = case_when(
#            sex == "f" ~ pmax(1, pen),
#            sex == "m" ~ pmin(1, pen)
#          )) %>% 
#   select(coh, jahr, sex, step, pen, fl)

# RR_L <- list()
# 
# for (c in unique(RR_EV$coh)) {
#   for (s in unique(RR_EV$sex)) {
# 
#     try({
# 
#       temp <-
#         filter(RR_EV, coh == c, sex == s) %>%
# bind_rows(
#   slice_head(.) %>% mutate(step = min(step) - 3),
#   slice_head(.) %>% mutate(step = min(step) - 2),
#   slice_head(.) %>% mutate(step = min(step) - 1),
#   slice_tail(.) %>% mutate(step = max(step) + 1),
#   slice_tail(.) %>% mutate(step = max(step) + 2),
#   slice_tail(.) %>% mutate(step = max(step) + 3),
# ) %>%
#         arrange(step)
# 
#           temp$pen[temp$step >= 1] <-
#             predict(loess(pen ~ step, temp, span = .75))[temp$step >= 1]
# 
#       RR_L[[paste0(c, s)]] <- filter(temp, step %in% 0:(max(temp$step) - 3))
# 
#       }, silent = TRUE)
#   }
# }

# # for (S in c("m", "f")) {
# #   for (N in c("ch", "au")) {
# #     for (D in c("ch", "au")) {
# 
# # bp <-
# #   max(breakpoints(pen ~ jahr,
# #                   data = filter(RR_F, sex == "m", nat == "au", dom == "au", !is.na(pen)),
# #                   h = 3)$breakpoints)
# # 
# # if (!is.na(bp))
# #   RR_F %<>%
# #     mutate(reg = ifelse(sex == "m" & nat == "au" & dom == "au" & !is.na(pen), 1:n() > bp + 1, TRUE))
# # 
# # bp <-
# #   max(breakpoints(pen ~ jahr,
# #                   data = filter(RR_F, sex == "f", nat == "ch", dom == "au", !is.na(pen)),
# #                   h = 3)$breakpoints)
# # 
# # if (!is.na(bp))
# #   RR_F %<>%
# #     mutate(reg = ifelse(sex == "f" & nat == "ch" & dom == "au" & !is.na(pen), 1:n() > bp + 1, TRUE))
# 
#       # bp <-
#       #   max(breakpoints(pen ~ jahr,
#       #                   data = filter(RR_F, sex == S, nat == N, dom == D, !is.na(pen)),
#       #                   h = 3)$breakpoints)
#       # 
#       # if (!is.na(bp))
#       #   RR_F %<>%
#       #     filter(!(sex == S & nat == N & dom == D & n <= bp))
# #     }
# #   }
# # }

#        ind   = !(is.na(pen_c))) %>% 
# group_by(ind, .add = TRUE) %>%  
# mutate(bp = ifelse(ind, max(breakpoints(pen_c ~ jahr, h = 5)$breakpoints), NA),
#        bp = ifelse(ind & is.na(bp), 0, bp),
#        pen_c = ifelse(1:n() > bp, pen_c, pen_c)) %>%