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) %>%
  dplyr::rename(year = jahr) %>% 
  mutate(mp = minimalrente) %>% 
  select(year, mp)

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

# Life cycle boundary.
lb <- 23

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

# viz <- 
#   dplyr::rename(RR, age = alt, year = jahr) %>% 
#   mutate(coh = year - age,
#          gpr = ifelse(gpr == "rveuve", "rvieillesse_simple", gpr)
#          ) %>%
#   filter(gpr == "rvieillesse_simple", eprc > 0, age >= 62, age_ret > 61) %>% 
#   select(coh, year, sex, nat, dom, age_ret, age, kv = eprc, pen = monatliche_rentensumme) %>% 
#   dplyr::summarise(pen = sum(pen), kv  = sum(kv),
#                    .by = c("coh", "year", "sex", "nat", "dom", "age_ret", "age")) %>% 
#   filter(coh == 1950, sex == "m", nat == "au", dom == "au") %>% 
#   group_by(age_ret) %>% 
#   arrange(age_ret, year) 
# 
# ggplot(viz, aes(x = year, y = kv, col = as.factor(age_ret))) +
#   geom_shadowline() +
#   geom_shadowpoint()

# viz <- 
#   dplyr::rename(RR, age = alt, year = jahr) %>% 
#   mutate(coh = year - age,
#          gpr = ifelse(gpr == "rveuve", "rvieillesse_simple", gpr)
#   ) %>%
#   filter(gpr == "rvieillesse_simple", eprc > 0, age >= 62, age_ret > 61) %>% 
#   select(coh, year, sex, nat, dom, age_ret, age, kv = eprc, pen = monatliche_rentensumme) %>% 
#   dplyr::summarise(pen = sum(pen), kv  = sum(kv),
#                    .by = c("coh", "year", "sex", "nat", "dom", "age_ret", "age")) %>% 
#   filter(coh == 1955, sex == "m", nat == "au", age_ret == 65) %>% 
#   group_by(age_ret) %>% 
#   arrange(age_ret, year) 
# 
# tm <- 
#   read_delim("~/data/appl-wb/20_staff/kjo/fhh/2025-05-05T1538_u80874371_ahv_basis/TAUX_MORTALITE.csv") %>% 
#   select(year = jahr, sex, nat, age = alt, qm = quotients_mortalite)

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

ggplot(filter(RR_0, year <= 2040), aes(x = year, y = pen, col = as.factor(step))) +
  geom_vline(xintercept = c(2004.5, 2014.5, 2024.5)) +
  geom_shadowpoint() +
  facet_grid(sex ~ nat + dom, labeller = label_both) +
  scale_y_continuous(expand = expansion(mult = c(0.2, 0.2)))

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

#  x <-
#   filter(RR_F, age >= 85, year %in% 2000:2020) %>%
#   dplyr::summarize(eprc = sum(eprc), .by = c("year", "sex", "nat", "dom")) %>%
#   group_by(sex, nat, dom) %>%
#   arrange(sex, nat, dom, year) %>%
#   mutate(ein = first(eprc)) %>%
#   mutate(eprc = eprc / ein)
# 
# ggplot(x, aes(x = year, y = eprc, col = sex)) +
#   geom_hline(yintercept = 5) +
#   geom_shadowpoint() +
#   facet_grid(nat ~ dom, labeller = label_both) +
#   scale_y_continuous(breaks = 1:15)

x <- 
  filter(RR_F, age >= 85, year >= 2001) %>%
  dplyr::summarize(eprc = sum(eprc), n = sum(n), .by = c("year", "sex", "nat", "dom")) %>% 
  group_by(sex, nat, dom) %>% 
  arrange(sex, nat, dom, year) %>% 
  mutate(eprc = eprc / 1e5, n = n / 1e5) %>% 
  pivot_longer(cols = eprc:n)

ggplot(x, aes(x = year, y = value, col = sex, shape = name)) + 
  geom_shadowpoint() +
  facet_grid(nat ~ dom, labeller = label_both)

x <- 
  filter(RR_F, 
         # !(sex == "f" & coh >= 1935), !(sex == "m" & coh >= 1932),
         year >= 2000, zv != "ledig", age - 65 > lb) %>%
  dplyr::summarize(pen = sum(pen),
                   .by = c("year", "sex", "nat", "dom")) %>% 
  group_by(sex, nat, dom) %>% 
  arrange(sex, nat, dom, year) %>% 
  mutate(epe = first(pen)) %>% 
  mutate(pen = pen / epe)

ggplot(x, aes(x = year, y = pen, col = sex)) + 
  geom_hline(yintercept = 5) +
  geom_shadowpoint() +
  facet_grid(nat ~ dom) +
  scale_y_continuous(breaks = 1:10)

# Revert up-correction of current pensions in 2001.
corr <-
  filter(RR_F, !(sex == "f" & coh >= 1935), !(sex == "m" & coh >= 1932),
         year %in% 1999:2002, age >= 62, zv != "ledig") %>%
  group_by(coh, sex, nat, dom, zv) %>%
  filter(n() == 4) %>%
  mutate(pen = pen / (eprc * mp)) %>%
  arrange(coh, sex, nat, dom, zv, year) %>%
  mutate(corr = pen / lag(pen) - 1) %>%
  na.omit() %>%
  mutate(corr2 = ifelse(year == 2001, NA, corr)) %>%
  ungroup() %>%
  impute_lm(corr2 ~ 1 | coh + sex + nat + dom + zv) %>%
  filter(year == 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(year >= 2001, pen_c * corr, pen_c),
    pen_c = pen_c * (eprc * mp)) %>%
  select(- corr) %>%
  filter(age - 65 > lb) %>% 
  select(year, sex, nat, dom, eprc, pen, pen_c, mp) %>% 
  dplyr::summarize(
    pen  = sum(pen), pen_c = sum(pen_c), eprc = sum(eprc),
    .by  = c("year", "sex", "nat", "dom", "mp")) %>%  
  mutate(
    pen   = pen   / (eprc * mp),
    pen_c = pen_c / (eprc * mp),
    year = factor(year, levels = 1997:2060)) %>%
  complete(year, sex, nat, dom) %>%
  mutate(year = parse_number(as.character(year))) %>%
  select(year, sex, nat, dom, eprc, pen, pen_c) %>% 
  group_by(sex, nat, dom) %>% 
  arrange(sex, nat, dom, year) %>% 
  filter(year >= 2001) %>% 
  mutate(d_pen = c(NA, diff(pen_c))) %>% 
  ungroup() %>%
  impute_rlm(d_pen ~ 1 | sex + nat + dom) %>%
  group_by(sex, nat, dom) %>%
  arrange(sex, nat, dom, year) %>% 
  mutate(d_pen = is.na(pen) * d_pen) %>%
  fill(pen) %>% 
  mutate(pen = pen + cumsum(d_pen),
         pen_c = coalesce(pen_c, pen)) %>% 
  filter(year <= 2060) %>% 
  mutate(coh = 9999, step = lb + 1) %>% 
  select(coh, year, sex, nat, dom, step, pen, pen_c)

ggplot(filter(RR_F, year <= 2040), aes(x = year, y = pen)) +
  geom_vline(xintercept = c(2000.5, 2024.5)) +
  geom_shadowpoint() +
  facet_grid(sex ~ nat + dom) +
  scale_y_continuous(expand = expansion(mult = c(0.2, 0.2)))

# Impute pension life cycle from 65-85 ----------------------------------------------
RR_EV <-
  dplyr::rename(RR, age = alt, year = jahr) %>% 
  mutate(coh = year - 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("year", "coh", "sex", "age")) %>% 
  left_join(min, by = "year", 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, year, 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(
      year %in% 1997:2000 ~ "a",
      year %in% 2001:2004 ~ "b",
      year %in% 2005:2011 ~ "c",
      year %in% 2012:2024 ~ "d"))

  M_DAT %<>%
    mutate(pen_c = lm(pen ~ 0 + year + ind, M_DAT) %>% predict(mutate(M_DAT, ind = "d")),
           pen_c = ifelse(year <= 2011, pen_c, pen)) %>%
    arrange(year) %>%
    select(year, sex, step, pen, pen_c)

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

# RR_C <- 
#   filter(RR_EV, year <= 2060) %>% 
#   select(coh, year, sex, nat, dom, step, lc) %>% 
#   arrange(coh, sex, nat, dom, step) %>% 
#   left_join(filter(RR_0, step == 0) %>% select(- step, - year), 
#             by = c("coh", "sex", "nat", "dom")) %>% 
#   group_by(coh, sex, nat, dom) %>% 
#   arrange(coh, sex, nat, dom, year) %>% 
#   fill(pen) %>% 
#   mutate(pen = pen * lc) %>% 
#   select(- lc) %>% 
#   bind_rows(filter(RR_0, step < 0)) %>% 
#   bind_rows(RR_F) %>% 
#   left_join(min, by = "year") %>% 
#   mutate(pen = pen, fl = year >= 2025)
  
ggplot(filter(RR_EV, year <= 2047, coh <= 1959) %>% mutate(fl = year >= 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, year <= 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)

RR_Z <- 
  ungroup(RR_X) %>% 
  mutate(age = ifelse(coh != 9999, year - coh, 65 + lb + 1)) %>% 
  select(- coh) %>% 
  select(year, sex, nat, dom, age, pen) %>% 
  filter(year >= 2024) %>% 
  group_by(sex, nat, dom, age) %>% 
  arrange(sex, nat, dom, age, year) %>% 
  mutate(g_p = pen / lag(pen)) %>% 
  replace_na(list(g_p = 1)) %>% 
  mutate(g_p = cumprod(g_p)) %>% 
  select(jahr = year, 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(year = jahr, sli = lohnindex, lik = preisindex, mp = minimalrente) %>%
#   mutate(sli = sli / filter(., year == 1979)$sli, lik) %>% 
#   filter(year >= 2024)
# 
# sli_m <- 
#   read_delim("sli_lik.csv", show = FALSE) %>% 
#   select(year = jahr, sli, lik) %>% 
#   left_join(min, by = "year") %>% 
#   mutate(sli = sli / filter(., year == 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(year, sex, nat, af, gs) %>% 
#   na.omit()
# 
# sli_f <- 
#   read_delim("sli_lik.csv", show = FALSE) %>% 
#   select(year = jahr, sli, lik) %>% 
#   left_join(min, by = "year") %>% 
#   mutate(sli = sli / filter(., year == 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(year, sex, nat, af, gs) %>% 
#   na.omit()
# 
# sli_au_f <- 
#   read_delim("sli_lik.csv", show = FALSE) %>% 
#   select(year = jahr, sli, lik) %>% 
#   left_join(min, by = "year") %>% 
#   mutate(sli = sli / filter(., year == 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(year, sex, nat, af, gs) %>% 
#   na.omit()
# 
# sli_au_m <- 
#   read_delim("sli_lik.csv", show = FALSE) %>% 
#   select(year = jahr, sli, lik) %>% 
#   left_join(min, by = "year") %>% 
#   mutate(sli = sli / filter(., year == 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(year, sex, nat, af, gs) %>% 
#   na.omit()
# 
# sli <- 
#   bind_rows(sli_m, sli_f, sli_au_f, sli_au_m) %>% 
#   filter(year >= 1985)
# 
# ggplot(sli, aes(x = year, 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, year %in% 1999:2003, age <= 100) %>%
#   group_by(coh, sex) %>%
#   filter(n() == 6) %>%
#   arrange(coh, sex, year) %>%
#   mutate(corr = c(NA, diff(pen))) %>%
#   na.omit() %>%
#   mutate(corr2 = ifelse(year == 2001, NA, corr)) %>%
#   ungroup() %>%
#   impute_lm(corr2 ~ 1 | coh + sex) %>%
#   filter(year == 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(year >= 2001, pen, pen)) %>%
# select(- corr) %>%

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

# RR_EV %<>%
#   arrange(step, year) %>%
#   mutate(pen_ref = ifelse(step == 0, pen, NA)) %>%
#   group_by(sex, coh) %>% 
#   fill(pen_ref, .direction = "downup") %>%
#   mutate(pen = pen / pen_ref) %>% 
#   ungroup() %>% 
#   mutate(year = factor(year, levels = 1997:2040),
#          coh  = factor(coh , levels = c(min(.$coh):(2040 - 65)))) %>%
#   complete(coh, year, sex, step) %>%
#   mutate(year = parse_number(as.character(year)),
#          coh  = parse_number(as.character(coh))) %>%
#   filter(year - coh == 65 + step) %>%
#   select(- eprc, - pen_ref) %>%
#   filter(!(year <= 2024 & is.na(pen))) %>% 
#   group_by(sex, step) %>% 
#   arrange(sex, step, year) %>% 
#   mutate(d_pen = pen / lag(pen) - 1) %>%
#   ungroup() %>%
#   filter(step <= 20) %>% 
#   mutate(t = year - 1997, fl = is.na(pen)) %>% 
#   impute_rlm(d_pen ~ 1 | sex + step) %>%
#   group_by(sex, step) %>%
#   arrange(sex, year) %>% 
#   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, year, 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 ~ year,
# #                   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 ~ year,
# #                   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 ~ year,
#       #                   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 ~ year, h = 5)$breakpoints), NA),
#        bp = ifelse(ind & is.na(bp), 0, bp),
#        pen_c = ifelse(1:n() > bp, pen_c, pen_c)) %>%