From 804d0b9e34b18cbf1ca952b44a88f5de0e35dd43 Mon Sep 17 00:00:00 2001
From: Reinhold Kainhofer <reinhold@kainhofer.com>
Date: Sun, 4 Sep 2016 00:39:21 +0200
Subject: [PATCH] Finish Usage vignette

---
 R/deathProbabilities.R                        |   2 +
 .../using-the-valuationTables-package.Rmd     | 146 ++++++++++++++++--
 2 files changed, 136 insertions(+), 12 deletions(-)

diff --git a/R/deathProbabilities.R b/R/deathProbabilities.R
index b34c12b..51d9916 100644
--- a/R/deathProbabilities.R
+++ b/R/deathProbabilities.R
@@ -45,6 +45,8 @@ setMethod("deathProbabilities","valuationTable.trendProjection",
                   finalqx = exp(-object@trend * damping) * qx;
               } else {
                   # dampingFunction interpolates between the two trends:
+                  # The damping functions does NOT give yearly weights,
+                  # but rather cumulative weights from the base year until the observation year!
                   weights = sapply(YOB + 0:(length(qx)-1), object@dampingFunction);
                   finalqx = qx * exp(
                       -(object@trend * (1 - weights) + object@trend2 * weights) *
diff --git a/vignettes/using-the-valuationTables-package.Rmd b/vignettes/using-the-valuationTables-package.Rmd
index bfaa8b5..432e790 100644
--- a/vignettes/using-the-valuationTables-package.Rmd
+++ b/vignettes/using-the-valuationTables-package.Rmd
@@ -41,18 +41,18 @@ Provided types of valuation tables are:
     : Death probabilities of a given base year are projected into the future
       using age-specific trends $\lambda_x$. The death probability of an $x$-year old in year
       `baseYear + n` is calculated as:
-          $q_x^{(baseYear+n)} = q_x^{(baseYear)} \cdot e^{-n\cdot\lambda_x}$
+          $$q_x^{(baseYear+n)} = q_x^{(baseYear)} \cdot e^{-n\cdot\lambda_x}$$
     : Consequently, the death probabilities for a person born in year `YOB` can be calculated as
-        $q_x^{YOB} = q_x^{(base)} \cdot e^{-(YOB+x-baseYear)\cdot \lambda_x}$
+        $$q_x^{YOB} = q_x^{(base)} \cdot e^{-(YOB+x-baseYear)\cdot \lambda_x}$$
 * Cohort life table approximation using age shift
     : Class `valuationTable.ageShift`
     : Death probabilities for cohort $YOB$ are obtained by using death probabilities
       for cohort $X$ and modifying the technical age with a birth-year dependent shift:
-    :     $q_x^{YOB} = q_{x+shift(YOB)}^{(base)}$
-* Observed life table
-    : Class `valuationTable.observed`
-    : Death probabilities observed during several years. The probabilities are
-      stored as a matrix with observation year and age as dimensions.
+          $$q_x^{YOB} = q_{x+shift(YOB)}^{(base)}$$
+<!-- * Observed life table -->
+<!--     : Class `valuationTable.observed` -->
+<!--     : Death probabilities observed during several years. The probabilities are -->
+<!--       stored as a matrix with observation year and age as dimensions. -->
 * Mixed life table
     : Class `valuationTable.mixed`
     : Arithmetic mean of two life tables with given weights. This approach is
@@ -214,19 +214,141 @@ deathProbabilities(lt)
 ```
 
 
-### Observed life tables
-The observations for the given years
+<!-- ### Observed life tables -->
+<!-- The observations for the given years -->
 
-TODO
+<!-- TODO -->
 
 
 ### Cohort life tables with trend projection
 
-TODO
+A cohort life table with trend projection needs the following parameters:
+
+* The base table $q_x^{(base)}$ (death probabilities) for the given base period as a vector
+* Age-specific trend factors $\lambda_x$ as a vector
+* The base year (numeric)
+* 
+
+```{r}
+atPlus2 = valuationTable.trendProjection(
+    name = "Austrian Census Males 2011, 2% yearly trend",
+    baseYear = 2011,
+    deathProbs = deathProbabilities(mort.AT.census.2011.male),
+    ages = ages(mort.AT.census.2011.male),
+    trend = rep(0.02, length(ages(mort.AT.census.2011.male)))
+)
+```
+
+Some life tables do not assume a constant age-specific trend over time, but rather
+assume that the currently observed high mortality improvements are just a 
+temporary effect, so the current trend is in effect only for some time and 
+then reduces to some kind of long-term trend.
+
+There are two conceptual approaches: One is to use a trend dampening function
+that is simply applied to the starting trend. So, while the initial trend might 
+be 3\%, i.e. the projection will use `(ObservationYear-BaseYear) * OriginalYear`, 
+over time it will assume the value 
+`dampeningFunction(ObservationYear-BaseYear) * OriginalTrend`. The dampening 
+function in this case gives the cumulated trend effect from the base year until 
+the observation year.
+To implement this trend reduction with the ValuationTables package, simply pass
+a one-argument function as the `dampingFunction` slot to the class, the argument 
+will be the number of years from the base year (NOT the calendar year!):
+```{r}
+atPlus2.damp = valuationTable.trendProjection(
+    name = "Austrian M '11, 2% yearly, damping until 2111",
+    baseYear = 2011,
+    deathProbs = deathProbabilities(mort.AT.census.2011.male),
+    ages = ages(mort.AT.census.2011.male),
+    trend = rep(0.02, length(ages(mort.AT.census.2011.male))),
+    # damping function: 2011: full effect, linear reduction until yearly trend=0 in 2111:
+    # 2011: 100%, 2012: 99%, 2013: 98% => For 2013 we have a cumulative trend 
+    # of 297% instead of 300% for three full yearly trends!
+    dampingFunction = function(n) { n - n*(n+1)/2/100 }
+)
+
+plot(mort.AT.census.2011.male, atPlus2, atPlus2.damp, YOB=2011, legend.position=c(0.8,0.75))
+```
+
+The other approach is to assume that instead of the initial trend, after some 
+time a second trend (slot trend2) takes over. In this case, the `dampingFunction`
+slot is again a one-argument function that now gives the weight of the first trend, while `1-dampingFunction(year)` will give the weight of the second trend. As the weights 
+will be applied for the whole period from the base- to the observation year, the weights
+need to be cumulated and normalized. 
+
+The argument
+in this case is the actual calendar year (not the year since the base year like it was in the one-trend case above!)
+
+```{r}
+atPlus2.damp2 = valuationTable.trendProjection(
+    name = "Austrian M '11, 2% yearly, 1% long-term",
+    baseYear = 2011,
+    deathProbs = deathProbabilities(mort.AT.census.2011.male),
+    ages = ages(mort.AT.census.2011.male),
+    trend = rep(0.02, length(ages(mort.AT.census.2011.male))),
+    trend2 = rep(0.01, length(ages(mort.AT.census.2011.male))),
+    # damping function interpolates between the two trends: 
+    # until 2021 trend 1, from 2031 trend 2, linearly beteen
+    dampingFunction = function(year) { 
+        if (year <= 2021) 1
+        else if (year>2031) 14.5/(year-2011)
+        else 1 - (year-2021)*(year-2021+1)/20/(year-2011)
+    }
+)
+
+plot(mort.AT.census.2011.male, atPlus2, atPlus2.damp, atPlus2.damp2, YOB=2011, legend.position=c(0.8,0.75))
+```
 
 ### Cohort life tables with age-shift
 
-TODO
+Age-shifted cohort life tables are an approximation to full cohort life tables.
+Full cohort life tables apply a trend or improvment factors to the death 
+probabilities of a base year to obtail death probabilities for a given birth year.
+Age-shifting rather modifies the age of the corresponding person and uses the 
+same, unmodified base table for all cohorts. Basically, it works like this:
+
+> A 60-year old born in 1950 has the same death probability as a 50-year old 
+> born in 1900, so instead of looking at the cohort 1950, we can look at the 
+> cohort 1900 and for a person born 1950 we treat him as if he were 10 years 
+> younger.
+
+So, an age-shifted cohort life table just needs the base table and for each 
+birth year the amount the age is modified.
+
+```{r}
+baseTableShift = getCohortTable(atPlus2, YOB=2011);
+baseTableShift@name = "Base table of the shift (YOB 2011)"
+
+atShifted = valuationTable.ageShift(
+    name = "Approximation with age shift",
+    baseYear = 2011,
+    deathProbs = deathProbabilities(baseTableShift),
+    ages = ages(baseTableShift),
+    ageShifts = data.frame(
+        shifts = c(
+            rep( 0, 3), 
+            rep(-1, 3), 
+            rep(-2, 3), 
+            rep(-3, 3), 
+            rep(-4, 3), 
+            rep(-5, 3), 
+            rep(-6, 3)
+        ),
+        row.names = 2011:2031
+    )
+)
+
+ageShift(atShifted, YOB=2021)
+
+plot(baseTableShift, atPlus2, atShifted, YOB=2021, legend.position=c(0.8,0.75))
+```
+
+As one can see, for ages above 40 years, the table with 2% yearly trend and the
+corresponding age-shifted table have roughly the same mortalities. Below 40 years, 
+the two are very different, so this approximation through age-shifting should 
+really be used with extreme care!
+
+
 
 
 ## Modifying life table objects
-- 
GitLab