diff --git a/data-raw/AT/Experience/2018-02-15_Auswertung_Bestandsabfrage_Pensionskassen.xlsx b/data-raw/AT/Experience/2018-02-15_Auswertung_Bestandsabfrage_Pensionskassen.xlsx new file mode 100644 index 0000000000000000000000000000000000000000..d3520a701781ae0c50ef95e597e1a04b82df210f Binary files /dev/null and b/data-raw/AT/Experience/2018-02-15_Auswertung_Bestandsabfrage_Pensionskassen.xlsx differ diff --git a/data-raw/AT/create_MortalityTables_Austria_Experience.R b/data-raw/AT/create_MortalityTables_Austria_Experience.R index 83232d202e0c06f8e95e29c56c9e69c1cdf38647..364b5dc2e5e9d2cf5397ca31ca091ec4a34d8786 100644 --- a/data-raw/AT/create_MortalityTables_Austria_Experience.R +++ b/data-raw/AT/create_MortalityTables_Austria_Experience.R @@ -233,3 +233,115 @@ for (t in tarif) { } save(VU.Gesamtbestand.Storno, file = here::here("data", "VU.Gesamtbestand.Storno.RData")) + + + + + + +############################################################################### # +# Bestandssterbetafel der Pensionskassen Österreichs, 2010-16 ---- +############################################################################### # + +PKfile = here::here("data-raw", "AT", "Experience", "2018-02-15_Auswertung_Bestandsabfrage_Pensionskassen.xlsx") + +PKdata = read_excel(PKfile, sheet = "Gesamtbestand", + skip = 7, + col_names = c( + "Alter", + "m.AWB.BoY", "m.AWB.Tod", "m.AWB.Sonstige", "m.AWB.EoY", + "m.EP.BoY", "m.EP.Tod", "m.EP.Sonstige", "m.EP.EoY", + "m.WIP.BoY", "m.WIP.Tod", "m.WIP.Sonstige", "m.WIP.EoY", + "w.AWB.BoY", "w.AWB.Tod", "w.AWB.Sonstige", "w.AWB.EoY", + "w.EP.BoY", "w.EP.Tod", "w.EP.Sonstige", "w.EP.EoY", + "w.WIP.BoY", "w.WIP.Tod", "w.WIP.Sonstige", "w.WIP.EoY" + ) +) + + +PKdata.array = PKdata %>% + gather(Variable, Value, -Alter) %>% + separate(Variable, into = c("sex", "collar", "Variable")) %>% + # Add unisex (sum of m + w) + spread(sex, Value) %>% + mutate(u = m + w) %>% + gather(sex, Value, m, w, u) %>% + mutate(sex = factor(sex, levels = c("m", "w", "u"))) %>% + # Add Gesamt (sum of AWB + EP + WIP) + spread(collar, Value) %>% + mutate(Gesamt = AWB + EP + WIP) %>% + gather(collar, Value, AWB, EP, WIP, Gesamt) %>% + # Calculate exposure and raw probabilities + spread(Variable, Value) %>% + mutate(Exposure = BoY, + Exposure.qx = Exposure - Sonstige/2, + Exposure.sx = Exposure - Tod/2, + qx = ifelse(Exposure.qx == 0, 0,Tod / Exposure.qx), sx = ifelse(Exposure.sx == 0, 0, Sonstige / Exposure.sx)) %>% + mutate(BoY = NULL, EoY = NULL) %>% + # Create an array with dimensions Alter - Sex - Bestand - Varible + gather(Variable, Value, Exposure, Exposure.qx, Exposure.sx, Sonstige, Tod, qx, sx) %>% + acast(sex ~ collar ~ Alter ~ Variable, value.var = "Value") + + +# Store all tables in a huge array. Pre-create the array here with NA mortality tables +PKBestandstafel.2010.16 = array( + data = c(mortalityTable.NA), + # Use sex and collar from the array, add probability (qx/sx) and type (raw, smoothed) as new dimensions + dim = c(dim(PKdata.array)[1:2], 2, 2), + dimnames = c(dimnames(PKdata.array)[1:2], list(probability = c("qx", "sx"), data = c("raw", "smoothed"))) +) + +ages = as.integer(dimnames(PKdata.array)[[3]]) +for (sx in dimnames(PKdata.array)[[1]]) { + for (cl in dimnames(PKdata.array)[[2]]) { + sex = switch(sx, "m" = "Männer", "w" = "Frauen", "u" = "Unisex") + pension = switch(cl, + "Gesamt" = "Gesamtbestand", + "AWB" = "Anwartschaftsberechtigte", + "EP" = "Eigenpension", + "WIP" = "Witwenpension" + ) + + tablename = sprintf("PK-Bestand 2010-16, qx %s %s", cl, sex) + ages.used = PKdata.array[sx,cl,,"Exposure"] > 0 + PKBestandstafel.2010.16[[sx, cl, "qx", "raw"]] = mortalityTable.period( + name = tablename, + deathProbs = PKdata.array[sx,cl,ages.used,"qx"], + ages = ages[ages.used], + baseYear = 2013, + exposures = PKdata.array[sx,cl, ages.used,"Exposure"], + data = list( + dim = list(sex = sx, year = "2010-2016", data = "raw", collar = cl, type = cl, Tafel = "PK-Bestandsabfrage 2010-16", risk = "Tod", probability = "qx", table = tablename), + deaths = PKdata.array[sx, cl, ages.used, "Tod"] + ) + ) + PKBestandstafel.2010.16[[sx, cl, "qx", "smoothed"]] = PKBestandstafel.2010.16[[sx, cl, "qx", "raw"]] %>% + whittaker.mortalityTable(lambda = 1/2, d = 2, name.postfix = ", geglättet") %>% + mT.setDimInfo(data = "geglättet") + + tablename = sprintf("PK-Bestand 2010-16, sx %s %s", cl, sex) + PKBestandstafel.2010.16[[sx, cl, "sx", "raw"]] = mortalityTable.period( + name = tablename, + deathProbs = PKdata.array[sx,cl,ages.used,"sx"], + ages = ages[ages.used], + baseYear = 2013, + exposures = PKdata.array[sx,cl,ages.used,"Exposure"], + data = list( + dim = list(sex = sx, year = "2010-2016", data = "raw", collar = cl, type = cl, Tafel = "PK-Bestandsabfrage 2010-16", risk = "sonst. Ausscheiden", probability = "sx", table = tablename), + deaths = PKdata.array[sx, cl, ages.used, "Sonstige"] + ) + ) + PKBestandstafel.2010.16[[sx, cl, "sx", "smoothed"]] = PKBestandstafel.2010.16[[sx, cl, "sx", "raw"]] %>% + whittaker.mortalityTable(lambda = 1/10, d = 2, name.postfix = ", geglättet") %>% + mT.setDimInfo(data = "geglättet") + } +} + +save(PKBestandstafel.2010.16, file = here::here("data", "PKBestandstafel.2010.16.RData")) + + +# plotMortalityTables(PKBestandstafel.2010.16, legend.position = "bottom") +# +# plotMortalityTables(PKBestandstafel.2010.16["m",,"qx",], aes = aes(linetype = data, color = table), ages = 25:99, legend.position = "bottom") +# plotMortalityTables(PKBestandstafel.2010.16["u",,"sx",], aes = aes(linetype = data, color = collar), ages = 25:99, legend.position = "bottom") + labs(color = NULL, linetype = NULL) +# plotMortalityTables(PKBestandstafel.2010.16["u",,"qx",], aes = aes(linetype = data, color = collar), ages = 25:99, legend.position = "bottom") + labs(color = NULL, linetype = NULL) diff --git a/data/PKBestandstafel.2010.16.RData b/data/PKBestandstafel.2010.16.RData new file mode 100644 index 0000000000000000000000000000000000000000..b92e8b97e4e1acbb174bd3fad976e4d7be9f136b Binary files /dev/null and b/data/PKBestandstafel.2010.16.RData differ