some fertility decompositions

fertility_decomp.R

library(tidyverse)
library(HMDHFDplus)
fert <- readHFDweb("USA",
                   "asfrRR", 
                   username = Sys.getenv("us"), 
                   password = Sys.getenv("pw"))

# ASFR as function of rates:
# decomposition result is just the age-specific rate differences
fert |> 
  filter(Year %in% range(Year)) |> 
  ggplot(aes(x = Age, y = ASFR, color = as.factor(Year))) +
  geom_line()


fert |> 
  filter(Year %in% range(Year)) |> 
  pivot_wider(names_from = Year, values_from = ASFR) |> 
  mutate(cc = `1933` - `2021`) |> 
  ggplot(aes(x= Age, y = cc)) +
  geom_line()

# what about parity progression ratios?

tfr_vec <- function(asfr_vec){
  sum(asfr_vec)
}

pars1 <- c(.968, .940,.929, .913, .888, .856, .819, .774, .723, .663)
pars2 <- c(.968, .940,.929, .913, .888, .856, .819, .774, .723, .663) * seq(.9,.1,length=10)

plot(pars1, ylim = c(0,1))
lines(pars2)

cumprod(pars1) |> sum()

cfrpp_vec <- function(pp_vec){
  cumprod(pp_vec) |> sum()
}
cfrpp_vec(pars1)
cfrpp_vec(pars2)

library(DemoDecomp)

horiuchi(cfrpp_vec, pars2, pars1, N = 20) |> plot()
#stepwise_replacement(cfrpp_vec, pars2, pars1) |> lines()
ltre(cfrpp_vec, pars2, pars1) |> lines(col = "blue")

# mean age at birth (with rates as weights)

mab_vec <- function(asfr_vec){
  w <- asfr_vec / sum(asfr_vec)
  x <- 12.5:55.5
  sum(x * w)
}
fert |> 
  filter(Year %in% range(Year)) |> 
  pivot_wider(names_from = Year, values_from = ASFR) |> 
  mutate(cc = horiuchi(mab_vec, pars1 = `1933`, pars2 = `2021`, N = 20)) |> 
  ggplot(aes(x = Age, y = cc)) +
  geom_line()

fert |> 
  filter(Year %in% range(Year)) |> 
  group_by(Year) |> 
  summarize(mab = mab_vec(ASFR))