an experimental script for first tricky step of single age basepop

wpp_reverse_survival.R

# Idea: use wpp2022 or wpp2024 data
# 1) select year whose pop we want to adjust (2000)
# 2) get mort for 10 prior years
# 3) in cohort lines, get Lx, reverse-Sx, reverse cumprod of reverse-Sx
# 4) inflate year 2000 pop to fill Lexis space 1990-1999
# 5) calculate exposures by age and year 1990-1999, ages 15-49

# TODO: 1. merge with asfr, get births, use to get Bt series.
#       2. use same general idea to forward-survive Bt to Jan 1 2000, giving adjusted pop ages 0-9
#       3. make adjustments for mid-year census, in case given.

data(popAge1dt)
data(mx1dt)
# Jan 1 2000 female pop; 
# note:  1999 means dec 31, 1999, so we treat as jan 1, 2000.
popF <-
  popAge1dt |> 
  filter(country_code == 900, 
         year == 1999) |> 
  select(year, age, pop = popF) |> 
  mutate(year = year + 1,
         cohort = year - age - 1)

mxF <- mx1dt |> 
  filter(country_code == 900, 
         between(year, 1990, 1999)) |> 
  as_tibble() |> 
  select(year, age, mx = mxF) |>
  # could try to warp to PC shape here, 
  # but uncertain infants. Maybe using
  # an a0 assumption it'd be doable.
  
  # need cohorts to structure reverse survival
  mutate(cohort = year - age - 1,
         age_int = 1,
         ax = if_else(age == 0, 
                      lt_rule_1a0_ak(M0 = mx, Sex = "f"),
                      .5),
         qx = lt_id_ma_q(nMx = mx, nax = ax, AgeInt = age_int)) |> 
  arrange(cohort, age) |> 
  group_by(cohort) |> 
  mutate(lx = lt_id_q_l(nqx = qx, radix = 1),
         dx = lx * qx,
         Lx = lx - dx * (1-ax),
         SxRev = Lx / lead(Lx, default = 1)) |> 
  ungroup() |> 
  arrange(year, age) |> 
  group_by(year) |> 
  mutate(
    lxp = lt_id_q_l(nqx = qx, radix = 1),
    dxp = lxp * qx,
    Lxp = lxp - dxp * (1-ax),
    SxRev = if_else(year == max(year),
                         Lxp / lead(Lxp),
                         SxRev)) |> 
  ungroup() |> 
  filter(age < 100) |> 
  select(cohort, year, age, SxRev) |> 
  arrange(cohort,-age) |> 
  group_by(cohort) |> 
  # inflation for reverse-surviving
  mutate(inflation_factor = cumprod(SxRev))

# get exposure via reverse survival
expF <-
  popF |> 
  select(cohort, pop) |> 
  right_join(mxF,by=join_by(cohort)) |> 
  mutate(pop_hat = pop * inflation_factor) |> 
  select(year, age, pop = pop_hat) |> 
  bind_rows(popF |> select(year,age,pop)) |> 
  filter(between(age, 15,50)) |> 
  arrange(age, year) |> 
  mutate(pop_1p1 = lead(pop),
         exposure = (pop + pop_1p1) / 2) |> 
  filter(age<50)