Recap-Tutorial-1.knit

class: center, middle, inverse, title-slide, clear
count: false

# Modelling and quantifying mortality and longevity risk 
## Recap

### Katrien Antonio, Michel Vellekoop, Torsten Kleinow, Frank van Berkum, and Jens Robben
### <a href="https://gitfront.io/r/jensrobben/mUZ8CcDz5x1L/Lausanne-summer-school/">35th International Summer School of the Swiss Association of Actuaries </a> | June 3-7, 2024
###  <a> </a>

---

# Constructing the mortality data set

.pull-left[

```r
User = "summerschool.rclr2024@outlook.com"
pw   = "Test1234."
Df   = hmd.mx("CHE", User , pw , "Switzerland")
```
]

.pull-right[
Use the `hmd.mx` function from {demography} to read the "Mx" (1 x 1) data from the HMD.
]

.pull-left[

```r
years <- 1970:2022
ages  <- 0:90
```

]

.pull-right[
We define a calibration period `years` and an age range `ages` on which we will calibrate the Lee-Carter model.
]

.pull-left[

```r
Df <- demography::extract.years(Df, years = years)
Df <- demography::extract.ages(Df, ages = ages, 
                     combine.upper = FALSE)
```
]

.pull-right[
We use `extract.years` and `extract.ages` from the {demography} package to subset `Df` according to the specified `years` and `ages`.
]

.pull-left[

```r
dim(Df$rate$male)
## [1] 91 53
dim(Df$pop$female)
## [1] 91 53
view(Df$rate$female)
```
]

.pull-right[
The death rates are stored in `Df$rate` for males (`$male`) and females (`$female`) and the exposures are contained in `Df$pop`. These statistics are stored in a 91x53 matrix, with in the rows the ages, and in the columns the years in the calibration period.
]

---
# What if {demography} does not work?

.pull-left[

```r
Df <- readRDS(file = "../data/hmd/Df_CHE_hmd_mx.rds")
```
]

.pull-right[
Read in the pre-downloaded mortality data set `Df` of Switzerland using the `readRDS` function.
]

.pull-left[

```r
row <- Df$age
col <- Df$year

Df$pop$female <- Df$pop$female[row <= 90, col >= 1970]
Df$pop$male   <- Df$pop$male[row <= 90, col >= 1970]
Df$pop$total  <- Df$pop$total[row <= 90, col >= 1970]

Df$rate$female <- Df$rate$female[row <= 90, col >= 1970]
Df$rate$male   <- Df$rate$male[row <= 90, col >= 1970]
Df$rate$total  <- Df$rate$total[row <= 90, col >= 1970]
```
]

.pull-right[
We filter the exposures and death rates, contained in `Df`, according to the specified age range and calibration period. We do this by filtering the rows on ages below 90 (maximum age in `ages`) and years beyond the year 1970 (minimum year in `years`). This is what happens inside the functions `extract.years` and `extract.ages` of the {demography} package.
]

.pull-left[

```r
dim(Df$rate$male)
## [1] 91 53
dim(Df$pop$female)
## [1] 91 53
view(Df$rate$female)
```

]

.pull-right[
The mortality data object `Df` is now in the same structure as in the previous slide.
]

---
# Fitting the Lee-Carter model

.pull-left[

```r
etx <- t(Df$pop$male)
dtx <- round(etx * t(Df$rate$male))
```
]

.pull-right[
We extract the male exposures and store these in `etx`. Note the use of the transpose function `t(...)` to make sure the years are now in the rows and the ages in columns (! required by `fit701` function !). <br>
We extract the male death rates and multiply these with the exposures to obtain the death counts `dtx`.
 ]

.pull-left[

```r
source('../scripts/fitModels.R')

LCfit701 <- fit701(ages, years, etx, dtx,
                   matrix(1, length(years),
                          length(ages)))
```
]

.pull-right[
We load the LifeMetrics code by reading the script `fitModels.R` using the `source` function. <br>
We fit the Lee-Carter mortality model using the `fit701` function from this code. As inputs we have the age range (`ages`), the calibration period (`years`), the exposures (`etx`), the death counts (`dtx`), and a matrix of unit weights.
]

---
# Outputs from the fitted Lee-Carter model

.pull-left[

```r
LCfit701$beta1[1:4]
## [1] -5.064321 -7.641017 -8.035925 -8.300943
LCfit701$beta2[1:4]
## [1] 0.01385526 0.01814825 0.01805656 0.01962950
LCfit701$kappa2[1:4]
## [1] 55.56486 55.08631 50.93098 48.65967
```

]

.pull-right[
The parameter estimates from the fitted Lee-Carter mortality model are retrieved by calling `$beta1` for the `$\beta_x^{(1)}$`, `$beta2` for the `$\beta_x^{(2)}$`, and `$kappa2` for the `$\kappa_t^{(2)}$`. We print the first four estimates.
]

.pull-left[

```r
str(LCfit701$mhat)
##  num [1:53, 1:91] 0.0136 0.0136 0.0128 0.0124 0.0121 ...
##  - attr(*, "dimnames")=List of 2
##   ..$ : chr [1:53] "1970" "1971" "1972" "1973" ...
##   ..$ : chr [1:91] "0" "1" "2" "3" ...
```
]

.pull-right[
The `mhat` object contains the fitted force of mortality `$\hat{\mu}_{t,x}$` and has dimension names (`dimnames`): the row names are the years in the calibration period and the column names are the ages in the considered age range.
]

.pull-left[

```r
LCfit701$mhat['2019','65'] 
## [1] 0.009233711
LCfit701$mhat[50,66]
## [1] 0.009233711
```

]

.pull-right[
Using these row and column names, you can easily extract information from `mhat`. E.g., you can retrieve the force of mortality in the year 2019 for age 65 using character notations. Alternatively, you extract the 50th row and the 66th column to obtain `$\hat{\mu}_{2019,65}$`.
]

---
# Outputs from the fitted Lee-Carter model

.pull-left[

```r
exp(LCfit701$beta1[66] + 
  LCfit701$beta2[66]*LCfit701$kappa2[50])
## [1] 0.009233711
```
]

.pull-right[
We can verify the value for `$\hat{\mu}_{2019,65}$`, by calculating it manually using the formula:
`\begin{align*}
\hat{\mu}_{2019,65} = \exp\left(\hat{\beta}_{65}^{(1)} + \hat{\beta}_{65}^{(2)} \cdot \hat{\kappa}_{2019}^{(2)}\right).
\end{align*}`
]

.pull-left[

```r
qhat <- 1 - exp(-LCfit701$mhat)
qhat['2019','65']
## [1] 0.009191211
```
]

.pull-right[
From the fitted forces of mortality, we can then calculate the mortality rates using the relation:
`\begin{align*}
\hat{q}_{t,x} = 1 - \exp(-\hat{\mu}_{t,x}).
\end{align*}`
As an example, the estimated mortality rate in the year 2019 for age 65 can be extracted in a similar way.
]

.pull-left[

```r
ggplot(...) + 
  ...
```

]

.pull-right[
We can plot parameter estimates, estimated forces of mortality, mortality rates, survival probabilities,... using {ggplot} instructions.
]