Add USA RP-2000 and USA Pub-2010 pension tables

data-raw/US/create_MortalityTables_US_Pensions.R

@@ -74,3 +74,207 @@ save(USA.UP94,
 )
 
 
+
+
+##############################################################################h#
+### USA RP-2000 - US 2000 Retirement Plan Mortality Tables                  ####
+##############################################################################h#
+
+USA.RP2000.data = read_excel(
+  US.pensions.file, sheet = "RP-2000",
+  col_names = c("age", "skip2",
+                "qxa", "qxp", "qx", "qxi", "BCx", "WCx", "qxpSmall", "qxpMedium", "qxpLarge", "AAx", "skip3",
+                "qya", "qyp", "qy", "qyi", "BCy", "WCy", "qypSmall", "qypMedium", "qypLarge", "AAy"),
+  skip = 5)
+
+makeRP2000table = function(data, field, sex, population) {
+  s = recode(sex, "m" = "Male", "f" = "Female")
+  AA = paste0("AA", recode(sex, "m" = "x", "f" = "y"))
+  d = filter(select(data, "age", qx = !!field, AA = !!AA), !is.na(qx))
+  mortalityTable.improvementFactors(
+    name = paste0("USA RP-2000, ", population, ", ", s),
+    ages = d$age,
+    deathProbs = d$qx,
+    improvement = d$AA,
+    baseYear = 2000,
+    data = list(
+      dim = list(table = paste0("RP-2000, ", population), sex = sex, collar = population, type = "PensionTable", data = "unloaded", year = 2000, country = "USA")
+    )
+  )
+}
+
+USA.RP2000 = array(
+  data = c(
+    pensionTable(
+      name = "RP-2000, Male",
+      qx  = makeRP2000table(data, field = "qxa", sex = "m", population = "Employee"),
+      qix = makeRP2000table(data, field = "qxi", sex = "m", population = "Disabled Retiree"),
+      qpx = makeRP2000table(data, field = "qxp", sex = "m", population = "Healthy Annuitant"),
+      qgx = makeRP2000table(data, field = "qx" , sex = "m", population = "Combined Healthy"),
+      invalids.retire = FALSE,
+      baseYear = 2000,
+      data = list(
+        dim = list(table = "RP-2000", sex = "m", type = "PensionTable", data = "unloaded", year = 2000, country = "USA")
+      )
+    ),
+    pensionTable(
+      name = "RP-2000, Female",
+      qx  = makeRP2000table(data, field = "qya", sex = "f", population = "Employee"),
+      qix = makeRP2000table(data, field = "qyi", sex = "f", population = "Disabled Retiree"),
+      qpx = makeRP2000table(data, field = "qyp", sex = "f", population = "Healthy Annuitant"),
+      qgx = makeRP2000table(data, field = "qy" , sex = "f", population = "Combined Healthy"),
+      invalids.retire = FALSE,
+      baseYear = 2000,
+      data = list(
+        dim = list(table = "RP-2000", sex = "f", type = "PensionTable", data = "unloaded", year = 2000, country = "USA")
+      )
+    )
+
+  ),
+  dim = c(2),
+  dimnames = list(
+    sex = c("m", "f")
+  )
+)
+
+USA.RP2000.Collar = array(
+  data = c(
+    makeRP2000table(data, field = "BCx", sex = "m", population = "Blue Collar Combined Healthy"),
+    makeRP2000table(data, field = "BCy", sex = "f", population = "Blue Collar Combined Healthy"),
+    makeRP2000table(data, field = "WCx", sex = "m", population = "White Collar Combined Healthy"),
+    makeRP2000table(data, field = "WCy", sex = "f", population = "White Collar Combined Healthy")
+  ),
+  dim = c(2, 2),
+  dimnames = list(
+    sex = c("m", "f"),
+    population = c("Blue Collar Combined Healthy", "White Collar Combined Healthy")
+  )
+)
+USA.RP2000.Amount = array(
+  data = c(
+    makeRP2000table(data, field = "qxpSmall", sex = "m", population = "Healthy Annuitant Small"),
+    makeRP2000table(data, field = "qypSmall", sex = "f", population = "Healthy Annuitant Small"),
+    makeRP2000table(data, field = "qxpMedium", sex = "m", population = "Healthy Annuitant Medium"),
+    makeRP2000table(data, field = "qypMedium", sex = "f", population = "Healthy Annuitant Medium"),
+    makeRP2000table(data, field = "qxpLarge", sex = "m", population = "Healthy Annuitant Large"),
+    makeRP2000table(data, field = "qypLarge", sex = "f", population = "Healthy Annuitant Large")
+  ),
+  dim = c(2, 3),
+  dimnames = list(
+    sex = c("m", "f"),
+    population = c("Healthy Annuitant Small", "Healthy Annuitant Medium", "Healthy Annuitant Large")
+  )
+)
+
+save(USA.RP2000, file = here::here("data", "USA.RP2000.RData"))
+save(USA.RP2000.Collar, file = here::here("data", "USA.RP2000.Collar.RData"))
+save(USA.RP2000.Amount, file = here::here("data", "USA.RP2000.Amount.RData"))
+
+
+
+
+##############################################################################h#
+### USA Pub-2010 - Public Retirement Plans Mortality Tables                 ####
+##############################################################################h#
+
+USA.Pub2010.file = here("data-raw", "US", "PensionPlans", "Pub-2010", "pub-2010-amount-mort-rates.xlsx")
+USA.PubH2010.file = here("data-raw", "US", "PensionPlans", "Pub-2010", "pub-2010-headcount-mort-rates.xlsx")
+USA.Pub2010.header = c("age", "__1", "qy", "qyp", "qyi", "qyw", "__2", "qx", "qxp", "qxi", "qxw", "__3", "__4")
+USA.Pub2010.headerSh = c("age", "__1", "qy", "qyp", "qyw", "__2", "qx", "qxp", "qxw", "__3", "__4")
+
+USA.Pub2010 = array(
+  data = c(pensionTable.NA),
+  dim = c(2, 3, 2, 3),
+  dimnames = list(
+    sex = c("m", "f"),
+    Population = c("General", "Teachers", "Safety"),
+    Weights = c("Amount", "Headcount"),
+    Salary = c("Overall", "AboveMedian", "BelowMedian")
+  )
+)
+
+makePub2010table = function(data, field, sex, subtable, salary, table, population, weights) {
+  # IF field does not exist return NA:
+  if (field %in% colnames(data)) {
+    s = recode(sex, "m" = "Male", "f" = "Female")
+    d = filter(select(data, "age", qx = !!field), !is.na(qx))
+    mortalityTable.period(
+      name = paste0("USA Pub-2000, ", population, ", " , subtable, ", ", s),
+      ages = d$age,
+      deathProbs = d$qx,
+      baseYear = 2010,
+      data = list(
+        dim = list(table = paste0(table, ", ", subtable), sex = sex, collar = paste(subtable, salary), salary = salary, subtable = subtable, population = population, weights = weights, type = "PensionTable", data = "unloaded", year = 2010, country = "USA")
+      )
+    )
+  } else {
+    mortalityTable.NA
+  }
+}
+
+
+dmn = dimnames(USA.Pub2010)
+for (w in dmn$Weights) {
+  fn = recode(w, "Amount" = USA.Pub2010.file,  "Headcount" = USA.PubH2010.file)
+  suffix = recode(w, "Amount" = "", "Headcount" = ".H")
+  juv = read_excel(fn, sheet = "Juvenile", skip = 4, col_names = c("age", "__", "qy", "qx"))
+  for (population in dmn$Population) {
+    for (Salary in dmn$Salary) {
+      tablename = paste0("Pub", substr(population, 1, 1), suffix, "-2010")
+      tab = paste0(tablename, recode(Salary, "Overall" = "", "AboveMedian" = "(A)", "BelowMedian" = "(B)"))
+      col_names = if(Salary == "Overall") USA.Pub2010.header else USA.Pub2010.headerSh
+      data = bind_rows(
+        juv,
+        read_excel(fn, sheet = tab, col_names = col_names, skip = 5)
+      )
+
+      USA.Pub2010[["m", population, w, Salary]] = pensionTable(
+        name = paste0("USA ", tablename, recode(Salary, "Overall" = "", "AboveMedian" = " Above-Median", "BelowMedian" = " Below-Median"), ", Male"),
+        qx  = makePub2010table(data, field = "qx", sex = "m", subtable = "Employee", table = tab, salary = Salary, population = population, weights = w),
+        qpx = makePub2010table(data, field = "qxp", sex = "m", subtable = "Healthy Retiree", table = tab, salary = Salary, population = population, weights = w),
+        qix = makePub2010table(data, field = "qxi", sex = "m", subtable = "Disabled Retiree", table = tab, salary = Salary, population = population, weights = w),
+        qwy = makePub2010table(data, field = "qxw" , sex = "m", subtable = "Contingent Survivor", table = tab, salary = Salary, population = population, weights = w),
+        invalids.retire = FALSE,
+        baseYear = 2010,
+        data = list(
+          dim = list(table = tab, sex = "m", type = "PensionTable", collar = "Salary", data = "unloaded", year = 2010, country = "USA")
+        )
+      )
+
+      USA.Pub2010[["f", population, w, Salary]] = pensionTable(
+        name = paste0("USA ", tablename, recode(Salary, "Overall" = "", "AboveMedian" = " Above-Median", "BelowMedian" = " Below-Median"), ", Female"),
+        qx  = makePub2010table(data, field = "qy", sex = "f", subtable = "Employee", table = tab, salary = Salary, population = population, weights = w),
+        qpx = makePub2010table(data, field = "qyp", sex = "f", subtable = "Healthy Retiree", table = tab, salary = Salary, population = population, weights = w),
+        qix = makePub2010table(data, field = "qyi", sex = "f", subtable = "Disabled Retiree", table = tab, salary = Salary, population = population, weights = w),
+        qwy = makePub2010table(data, field = "qyw" , sex = "f", subtable = "Contingent Survivor", table = tab, salary = Salary, population = population, weights = w),
+        invalids.retire = FALSE,
+        baseYear = 2010,
+        data = list(
+          dim = list(table = tab, sex = "f", type = "PensionTable", collar = "Salary", data = "unloaded", year = 2010, country = "USA")
+        )
+      )
+
+    }
+  }
+}
+
+USA.PubG2010 = USA.Pub2010[, "General", "Amount", "Overall"]
+USA.PubS2010 = USA.Pub2010[, "Safety", "Amount", "Overall"]
+USA.PubT2010 = USA.Pub2010[, "Teachers", "Amount", "Overall"]
+
+USA.PubG.H2010 = USA.Pub2010[, "General", "Headcount", "Overall"]
+USA.PubS.H2010 = USA.Pub2010[, "Safety", "Headcount", "Overall"]
+USA.PubT.H2010 = USA.Pub2010[, "Teachers", "Headcount", "Overall"]
+
+save(USA.Pub2010,
+     USA.PubG2010, USA.PubS2010, USA.PubT2010,
+     USA.PubG.H2010, USA.PubS.H2010, USA.PubT.H2010,
+     file = here::here("data", "USA.Pub2010.RData")
+)
+
+
+
+
+
+
+