Tarea 1 - Tablas de Mortalidad - CÁLCULO ACTUARIAL

Author

Brayan Cubides

Limpieza de entorno y directorio

rm(list = ls(all = TRUE))
setwd("C:/Users/cubid/Desktop/QUARTO - MATERIAS UNAL/9 CÁLCULO ACTUARIAL/Corte 1 - Mortalidad/Tarea 1 - Tablas de Mortalidad")

Lectura y exploración de datos

qx <- read.delim("q_X - TablaMortAseg.txt")
colnames(qx)[colnames(qx) == "x"] <- "X"
qx_truncado <- read.delim("q_X_truncado - TablaMortAseg.txt")

Función CrearTablaConEsperanza

Calcula las siguientes columnas para un vector (q_x):

\[p_x = 1 - q_x\]
\[l_x\]: número de personas vivas a cada edad
\[d_x = l_x \, q_x\]: defunciones
\[e^0_x = \frac{\sum_{j=i+1}^n l_j}{l_i} + 0.5\]: esperanza de vida

TablaMortalidad <- function(qx_df, col_qx, l0 = 100000) {
  edades <- qx_df$X
  qx     <- qx_df[[col_qx]]
  n      <- length(qx)

  px <- 1 - qx
  lx <- dx <- numeric(n)
  lx[1] <- l0
  
  # l_x
  for(i in seq_len(n - 1)) {
    dx[i]   <- lx[i] * qx[i]
    lx[i+1] <- lx[i] - dx[i]
  }
  # última edad
  dx[n] <- lx[n] * qx[n]
  
  # e^0_x = (sum_{j>i} l_j)/l_i + 1/2
  e0x <- numeric(n)
  for(i in seq_len(n)) {
    if(i < n) {e0x[i] <- sum(lx[(i+1):n]) / lx[i] + 0.5
    } else {e0x[i] <- 0.5}
  }
  data.frame(x   = edades, qx  = round(qx,6), px  = round(px,6), lx  = round(lx), dx  = round(dx,1), e0x = round(e0x,1))
}

Generar tablas de mortalidad completas

tabla_Rentistas_Hombres <- TablaMortalidad(qx, col_qx = "qxH", l0 = 100000)
head(tabla_Rentistas_Hombres)

  x       qx       px     lx   dx  e0x
1 0 0.000485 0.999515 100000 48.5 79.3
2 1 0.000485 0.999515  99952 48.5 78.3
3 2 0.000485 0.999515  99903 48.5 77.4
4 3 0.000485 0.999515  99855 48.4 76.4
5 4 0.000485 0.999515  99806 48.4 75.4
6 5 0.000485 0.999515  99758 48.4 74.5

tabla_Rentistas_Mujeres <- TablaMortalidad(qx, col_qx = "qxM", l0 = 100000)
head(tabla_Rentistas_Mujeres)

  x       qx       px     lx   dx  e0x
1 0 0.000272 0.999728 100000 27.2 84.7
2 1 0.000272 0.999728  99973 27.2 83.7
3 2 0.000272 0.999728  99946 27.2 82.8
4 3 0.000272 0.999728  99918 27.2 81.8
5 4 0.000272 0.999728  99891 27.2 80.8
6 5 0.000272 0.999728  99864 27.2 79.8

tabla_invalidos_Hombres <- TablaMortalidad(qx, col_qx = "qxiH", l0 = 100000)
head(tabla_invalidos_Hombres)

  x       qx       px     lx     dx  e0x
1 0 0.014786 0.985214 100000 1478.6 43.8
2 1 0.014803 0.985197  98521 1458.5 43.5
3 2 0.014822 0.985178  97063 1438.7 43.1
4 3 0.014842 0.985158  95624 1419.2 42.8
5 4 0.014863 0.985137  94205 1400.2 42.4
6 5 0.014886 0.985114  92805 1381.5 42.0

tabla_invalidos_Mujeres <- TablaMortalidad(qx, col_qx = "qxiM", l0 = 100000)
head(tabla_invalidos_Mujeres)

  x       qx       px     lx    dx  e0x
1 0 0.009112 0.990888 100000 911.2 55.4
2 1 0.009120 0.990880  99089 903.7 54.9
3 2 0.009129 0.990871  98185 896.3 54.4
4 3 0.009138 0.990862  97289 889.0 53.9
5 4 0.009148 0.990852  96400 881.9 53.4
6 5 0.009159 0.990841  95518 874.8 52.9

tabla_Hombres_Asegurados <- TablaMortalidad(qx_truncado, col_qx = "qxH", l0 = 100000)
head(tabla_Hombres_Asegurados)

   x       qx       px     lx  dx  e0x
1 20 0.003560 0.996440 100000 356 54.3
2 21 0.003593 0.996407  99644 358 53.5
3 22 0.003636 0.996364  99286 361 52.7
4 23 0.003680 0.996320  98925 364 51.9
5 24 0.003713 0.996287  98561 366 51.1
6 25 0.003727 0.996273  98195 366 50.3

tabla_Mujeres_aseguradas <- TablaMortalidad(qx_truncado, col_qx = "qxM", l0 = 100000)
head(tabla_Mujeres_aseguradas)

   x       qx       px     lx  dx  e0x
1 20 0.001300 0.998700 100000 130 57.4
2 21 0.001342 0.998658  99870 134 56.5
3 22 0.001384 0.998616  99736 138 55.5
4 23 0.001416 0.998584  99598 141 54.6
5 24 0.001458 0.998542  99457 145 53.7
6 25 0.001490 0.998510  99312 148 52.8