Re-Creating Austrian data files

data-raw/AT/create_MortalityTables_Austria_Population.R

-###############################################################################
-#  Skript to generate Austrian census mortality table objects
-###############################################################################
+##############################################################################h#
+#  Skript to generate Austrian census mortality table objects               ####
+##############################################################################h#
 library(MortalityTables)
 library(readxl)
 library(dplyr)
@@ -11,9 +11,9 @@ library(here)
 library(rlang)
 
 
-###############################################################################
-### Volkszählungen Österreich
-###############################################################################
+##############################################################################h#
+### Volkszählungen Österreich                                               ####
+##############################################################################h#
 censusfile = here("data-raw", "AT", "Population", "ausfuehrliche_allgemeine_und_ausgeglichene_sterbetafeln_186871_bis_201012_.xlsx")
 censusfile.out = here("data", "mort.AT.census.RData")
 
@@ -147,9 +147,9 @@ save(
 
 
 
-###############################################################################
-### jährlich fortgeschriebene Sterbetafeln
-###############################################################################
+##############################################################################h#
+### jährlich fortgeschriebene Sterbetafeln                                  ####
+##############################################################################h#
 
 library(reshape2)
 library(openxlsx)
@@ -210,23 +210,18 @@ obstable = function(data, sex = "m") {
 
 
 mort.AT.observed = array(
-  data = c(mortalityTable.NA),
+  data = c(
+    obstable(AT.pop.obs, sex = "m"),
+    obstable(AT.pop.obs, sex = "w"),
+    obstable(AT.pop.obs, sex = "u")
+  ),
   dim = c(3),
   dimnames = list(Geschlecht = c("m", "w", "u"))
 )
-mort.AT.observed[["m"]] = obstable(AT.pop.obs, sex = "m")
-mort.AT.observed[["w"]] = obstable(AT.pop.obs, sex = "w")
-mort.AT.observed[["u"]] = obstable(AT.pop.obs, sex = "u")
-mort.AT.observed.male = mort.AT.observed[["m"]]
-mort.AT.observed.female = mort.AT.observed[["w"]]
-mort.AT.observed.unisex = mort.AT.observed[["u"]]
 
 
 save(
   mort.AT.observed,
-  mort.AT.observed.male,
-  mort.AT.observed.female,
-  mort.AT.observed.unisex,
   file = abridgedfile.out
 )
 
@@ -235,10 +230,10 @@ save(
 
 
 
-###############################################################################
-### Bevölkerungsprognose bis 2080 (mittleres Szenario)
-### Datenquelle: Statistik Austria
-###############################################################################
+##############################################################################h#
+### Bevölkerungsprognose bis 2080 (mittleres Szenario)                      ####
+### Datenquelle: Statistik Austria                                          ##h#
+##############################################################################h#
 
 library(openxlsx)
 
@@ -248,112 +243,107 @@ forecastfile.out = here::here("data", "mort.AT.forecast.RData")
 AT.pop.fc.M = openxlsx::read.xlsx(forecastfile, startRow = 1, rows = c(1,3:103), rowNames = TRUE)
 AT.pop.fc.F = openxlsx::read.xlsx(forecastfile, startRow = 1, rows = c(1,105:206), rowNames = TRUE)
 
-mort.AT.forecast.male = mortalityTable.observed(
-  name = "Österreich Männer (mittl. Sz.)",
-  baseYear = 2014,
-  deathProbs = AT.pop.fc.M,
-  ages = as.numeric(rownames(AT.pop.fc.M)),
-  years = as.numeric(colnames(AT.pop.fc.M)),
-  data = list(
-    dim = list(
-      table = "Bevölkerungsprognose Österreich (mittl. Szenario)",
-      sex = "m",
-      collar = "Gesamtbevölkerung",
-      type = "Bevölkerungsprognose",
-      country = "Österreich",
-      data = "official",
-      year = "2014-2080")
-  )
-)
-mort.AT.forecast.female = mortalityTable.observed(
-  name = "Österreich Frauen (mittl. Sz.)",
-  baseYear = 2014,
-  deathProbs = AT.pop.fc.F,
-  ages = as.numeric(rownames(AT.pop.fc.F)),
-  years = as.numeric(colnames(AT.pop.fc.F)),
-  data = list(
-    dim = list(
-      table = "Bevölkerungsprognose Österreich (mittl. Szenario)",
-      sex = "w",
-      collar = "Gesamtbevölkerung",
-      type = "Bevölkerungsprognose",
-      country = "Österreich",
-      data = "official",
-      year = "2014-2080")
-  )
-)
 mort.AT.forecast = array(
-  data = c(mortalityTable.NA),
+  data = c(
+    mortalityTable.observed(
+      name = "Österreich Männer (mittl. Sz.)",
+      baseYear = 2014,
+      deathProbs = AT.pop.fc.M,
+      ages = as.numeric(rownames(AT.pop.fc.M)),
+      years = as.numeric(colnames(AT.pop.fc.M)),
+      data = list(
+        dim = list(
+          table = "Bevölkerungsprognose Österreich (mittl. Szenario)",
+          sex = "m",
+          collar = "Gesamtbevölkerung",
+          type = "Bevölkerungsprognose",
+          country = "Österreich",
+          data = "official",
+          year = "2014-2080")
+      )
+    ),
+
+    mortalityTable.observed(
+      name = "Österreich Frauen (mittl. Sz.)",
+      baseYear = 2014,
+      deathProbs = AT.pop.fc.F,
+      ages = as.numeric(rownames(AT.pop.fc.F)),
+      years = as.numeric(colnames(AT.pop.fc.F)),
+      data = list(
+        dim = list(
+          table = "Bevölkerungsprognose Österreich (mittl. Szenario)",
+          sex = "w",
+          collar = "Gesamtbevölkerung",
+          type = "Bevölkerungsprognose",
+          country = "Österreich",
+          data = "official",
+          year = "2014-2080")
+      )
+    )
+  ),
   dim = c(2),
   dimnames = list(Geschlecht = c("m", "w"))
 )
-mort.AT.forecast[["m"]] = mort.AT.forecast.male
-mort.AT.forecast[["w"]] = mort.AT.forecast.female
 
 
-###############################################################################
-# Forecast using a trend derived from the Statistik Austria data
+##############################################################################h#
+# Forecast using a trend derived from the Statistik Austria data            ##h#
 
 lambda.forecast = function(qx) {
   logq = log(qx)
   rowMeans(logq[,-ncol(logq)] - logq[,-1])
 }
 
-mort.AT.forecast.male.trend = mortalityTable.trendProjection(
-  name = "Österreich Männer (mittl. Sz.)",
-  baseYear = 2014,
-  deathProbs = AT.pop.fc.M[,1],
-  trend = lambda.forecast(AT.pop.fc.M),
-  ages = as.numeric(rownames(AT.pop.fc.M)),
-  data = list(
-    dim = list(
-      table = "Bevölkerungsprognose Österreich (mittl. Szenario)",
-      sex = "m",
-      collar = "Gesamtbevölkerung",
-      type = "Bevölkerungsprognose",
-      country = "Österreich",
-      data = "official",
-      year = "2014-2080")
-  )
-)
-mort.AT.forecast.female.trend = mortalityTable.trendProjection(
-  name = "Österreich Frauen (mittl. Sz.)",
-  baseYear = 2014,
-  deathProbs = AT.pop.fc.F[,1],
-  trend = lambda.forecast(AT.pop.fc.F),
-  ages = as.numeric(rownames(AT.pop.fc.F)),
-  data = list(
-    dim = list(
-      table = "Bevölkerungsprognose Österreich (mittl. Szenario)",
-      sex = "w",
-      collar = "Gesamtbevölkerung",
-      type = "Bevölkerungsprognose",
-      country = "Österreich",
-      data = "official",
-      year = "2014-2080")
-  )
-)
-
 
 mort.AT.forecast.trend = array(
-  data = c(mortalityTable.NA),
+  data = c(
+    mortalityTable.trendProjection(
+      name = "Österreich Männer (mittl. Sz.)",
+      baseYear = 2014,
+      deathProbs = AT.pop.fc.M[,1],
+      trend = lambda.forecast(AT.pop.fc.M),
+      ages = as.numeric(rownames(AT.pop.fc.M)),
+      data = list(
+        dim = list(
+          table = "Bevölkerungsprognose Österreich (mittl. Szenario)",
+          sex = "m",
+          collar = "Gesamtbevölkerung",
+          type = "Bevölkerungsprognose",
+          country = "Österreich",
+          data = "official",
+          year = "2014-2080")
+      )
+    ),
+
+    mortalityTable.trendProjection(
+      name = "Österreich Frauen (mittl. Sz.)",
+      baseYear = 2014,
+      deathProbs = AT.pop.fc.F[,1],
+      trend = lambda.forecast(AT.pop.fc.F),
+      ages = as.numeric(rownames(AT.pop.fc.F)),
+      data = list(
+        dim = list(
+          table = "Bevölkerungsprognose Österreich (mittl. Szenario)",
+          sex = "w",
+          collar = "Gesamtbevölkerung",
+          type = "Bevölkerungsprognose",
+          country = "Österreich",
+          data = "official",
+          year = "2014-2080")
+      )
+    )
+  ),
   dim = c(2),
   dimnames = list(Geschlecht = c("m", "w"))
 )
-mort.AT.forecast.trend[["m"]] = mort.AT.forecast.male.trend
-mort.AT.forecast.trend[["w"]] = mort.AT.forecast.female.trend
 
 
-###############################################################################
+##############################################################################h#
 # Save to data
 
 save(
   mort.AT.forecast,
-  mort.AT.forecast.male,
-  mort.AT.forecast.female,
   mort.AT.forecast.trend,
-  mort.AT.forecast.male.trend,
-  mort.AT.forecast.female.trend,
 
   file = forecastfile.out
 )
@@ -361,10 +351,10 @@ save(
 
 
 
-###############################################################################
-### MCMC fit (derived during creation of the AVÖ 2018-P by Jonas Hirz)
+##############################################################################h#
+### MCMC fit (derived during creation of the AVÖ 2018-P by Jonas Hirz)      ####
 ### Datenquelle: Statistik Austria, Method: Jonas Hirz
-###############################################################################
+##############################################################################h#
 
 library(pracma)
 MCMCfile = here::here("data-raw", "AT", "Population", "Austria_Population_MCMC2018.csv")