Propósito de la sesión. A partir del juego mostrado por el profesor, cada equipo construye su propia tabla de vida y la función de sobrevivencia $S(x)$ en R .

1. Objetivos, dinámica y entregables

Objetivos - Ejecutar en R una simulación discreta de mortalidad por edades. - Construir: $l_x, d_x, q_x, p_x, S_x$ y estimar $ \hat{e}_0 \approx \sum_x S_x $. - Comunicar hallazgos con gráficos y una interpretación breve.

Dinámica (hoy) 1) Demo del profesor (juego). 2) Trabajo en equipos (este archivo). 3) Entrega al final.

Entregables (hoy) - Tabla con columnas: Edad, lx, dx, qx, px, Sx. - Dos gráficos: línea de $S(x)$ y barras de $d_x$. - Estimación de $\hat{e}_0$ y 1 párrafo de interpretación técnica.

Rúbrica breve (10 pts): Correctitud (4), claridad del código (2), visualización (2), interpretación (2).

2. R en 5 minutos (recordatorio rápido)

Consola: ejecutar comandos; Script/Notebook: conservar trabajo.
Paquetes: primero instalar, luego library(...) para cargar.
Semilla set.seed() = resultados repetibles.
Guardar: con write.csv() o readr::write_csv().

# Instala SOLO si aún no los tienes (ejecútalo una vez y comenta):
# install.packages(c("tidyverse","ggplot2","dplyr","readr","purrr","ggplot2","knitr"))

library(tidyverse)
library(readr)
library(knitr)

set.seed(params$seed)

3. Modelos simples de mortalidad $q_x$

A continuación definimos tres reglas para $q_x$. Elige una en params$q_model.

linear: $q_x = \min(x/m, 1)$ — crece linealmente con la edad.
gompertz: $q_x = \min(A\,e^{B x}, 1)$ — mortalidad creciente exponencial (ancianidad).
weibull: $q_x = \min(\alpha\,x^{\beta}, 1)$ — flexible, potencia de la edad.

qfun_linear <- function(x, m) pmin(x / m, 1)

qfun_gompertz <- function(x, m, A = 0.002, B = 0.35) {
  pmin(A * exp(B * x), 1)
}

qfun_weibull <- function(x, m, alpha = 0.002, beta = 2) {
  pmin(alpha * (x ^ beta), 1)
}

get_qfun <- function(model = c("linear","gompertz","weibull")) {
  model <- match.arg(model)
  switch(model,
         linear   = function(x, m) qfun_linear(x, m),
         gompertz = function(x, m) qfun_gompertz(x, m),
         weibull  = function(x, m) qfun_weibull(x, m))
}

4. Simulación de una cohorte

La simulación recorre edades $x = 0, 1, \dots, m$. En cada edad usamos $q_x$ para decidir cuántos mueren (ensayos Bernoulli independientes).

Parámetros activos

params

## $l0
## [1] 40
## 
## $edad_max
## [1] 12
## 
## $q_model
## [1] "linear"
## 
## $seed
## [1] 123
## 
## $censura
## [1] 0

simulate_cohort <- function(l0, edad_max, q_model = "linear", censura = 0) {
  stopifnot(l0 > 0, edad_max >= 1, censura >= 0, censura <= 1)
  qfun <- get_qfun(q_model)
  
  lx  <- integer(edad_max + 1)
  dx  <- integer(edad_max + 1)
  cx  <- integer(edad_max + 1)  # censuras por edad (opcional)
  
  qxv <- numeric(edad_max + 1)
  pxv <- numeric(edad_max + 1)
  Sv  <- numeric(edad_max + 1)
  
  lx[1]  <- l0
  qxv[1] <- 0
  pxv[1] <- NA
  Sv[1]  <- 1
  
  for (x in 1:edad_max) {
    qx <- qfun(x, edad_max)
    # Muertes por Bernoulli(lx[x], qx)
    muertes <- sum(runif(lx[x]) < qx)
    # Censura aleatoria independiente
    cens    <- if (censura > 0) sum(runif(lx[x] - muertes) < censura) else 0
    
    dx[x+1] <- muertes
    cx[x+1] <- cens
    lx[x+1] <- lx[x] - muertes - cens
    
    qxv[x+1] <- qx
    pxv[x+1] <- 1 - qx
    Sv[x+1]  <- lx[x+1] / l0
    
    if (lx[x+1] <= 0) {
      # completar filas restantes con ceros si se extingue la cohorte
      lx[(x+2):(edad_max+1)] <- 0
      dx[(x+2):(edad_max+1)] <- 0
      cx[(x+2):(edad_max+1)] <- 0
      qxv[(x+2):(edad_max+1)] <- NA
      pxv[(x+2):(edad_max+1)] <- NA
      Sv[(x+2):(edad_max+1)]  <- 0
      break
    }
  }
  
  tabla <- tibble(
    Edad = 0:edad_max,
    lx   = lx,
    dx   = c(NA, dx[-1]),
    cx   = c(NA, cx[-1]),
    qx   = round(qxv, 4),
    px   = round(pxv, 4),
    Sx   = round(Sv, 4)
  )
  
  # Esperanza de vida discreta aproximada (área bajo S)
  e0 <- sum(Sv, na.rm = TRUE)
  
  list(tabla = tabla, e0 = e0)
}

res <- simulate_cohort(
  l0       = params$l0,
  edad_max = params$edad_max,
  q_model  = params$q_model,
  censura  = params$censura
)

tabla_vida <- res$tabla
e0_est     <- res$e0

kable(head(tabla_vida, 10), caption = "Primeras 10 filas de la tabla de vida simulada")

Primeras 10 filas de la tabla de vida simulada
Edad	lx	dx	cx	qx	px	Sx
0	40	NA	NA	0.0000	NA	1.000
1	37	3	0	0.0833	0.9167	0.925
2	29	8	0	0.1667	0.8333	0.725
3	22	7	0	0.2500	0.7500	0.550
4	13	9	0	0.3333	0.6667	0.325
5	11	2	0	0.4167	0.5833	0.275
6	3	8	0	0.5000	0.5000	0.075
7	0	3	0	0.5833	0.4167	0.000
8	0	0	0	NA	NA	0.000
9	0	0	0	NA	NA	0.000

Esperanza de vida aproximada

e0_est

## [1] 3.875

5. Visualización

# S(x)
ggplot(tabla_vida, aes(Edad, Sx)) +
  geom_line(linewidth = 1) +
  geom_point() +
  labs(title = "Función de sobrevivencia S(x)", y = "S(x)") +
  theme_minimal()

# dx (muertes por edad)
ggplot(tabla_vida[-1,], aes(Edad, dx)) +
  geom_col() +
  labs(title = "Muertes por edad (dx)", y = "dx") +
  theme_minimal()

Pregunta guía: ¿Cómo cambia la curvatura de $S(x)$ cuando cambias el modelo q_model o edad_max?

6. Comparar dos cohortes (opcional avanzado)

compare_cohorts <- function(l0, edad_max, model_a = "linear", model_b = "gompertz") {
  A <- simulate_cohort(l0, edad_max, model_a)$tabla %>% mutate(Modelo = model_a)
  B <- simulate_cohort(l0, edad_max, model_b)$tabla %>% mutate(Modelo = model_b)
  bind_rows(A, B)
}

comp <- compare_cohorts(params$l0, params$edad_max, "linear", "gompertz")

ggplot(comp, aes(Edad, Sx, color = Modelo)) +
  geom_line(linewidth = 1) + geom_point() +
  labs(title = "Comparación de S(x) entre modelos", y = "S(x)") +
  theme_minimal()

7. Exportar resultados

Genera archivos para tu entrega o para usarlos en otra sesión.

write_csv(tabla_vida, "tabla_vida_equipo.csv")

Archivos generados: tabla_vida_equipo.csv en la carpeta del proyecto.

8. Interpretación (responde en un párrafo)

¿Qué cuenta la curva $S(x)$ que generaste?
¿Cómo influyen tu elección de $q_x$ y los parámetros en $\hat{e}_0$?
¿Qué pasaría en un producto de vida si $q_x$ está subestimado o sobreestimado?

Escribe aquí tu párrafo de interpretación (máx. 8–10 líneas).

9. Lista de comprobación (antes de entregar)

Semilla fija (params$seed) para reproducibilidad.
Tabla con columnas pedidas y sin valores imposibles (calidad).
Gráficos con ejes y títulos legibles.
Archivo tabla_vida_equipo.csv generado.
1 párrafo de interpretación.

10. Apéndice: notas y ajustes finos

Censura (params$censura): si > 0, en cada edad se retira aleatoriamente un % de la cohorte (abandono/traslado). Útil para discutir sesgo si no se modela censura.
Parámetros de modelos: ajusta A, B, alpha, beta dentro de las funciones si necesitas curvas más/menos agresivas.
Escalas: si $l_0$ es pequeño, la variabilidad es alta (ley de los grandes números). Para ver curvas más “suaves”, incrementa $l_0$.
Extensión: implementar hazard discreta $h_x = d_x/l_x$ y acumulada $H_x = \sum h_x$, o calcular prima pura de un seguro temporal con tasa de interés.

Clase 1 — La Carrera de la Vida

Electiva: Análisis de Datos Actuariales con R

Prof. Luis Alejandro Ferro Alfonso — Universidad Antonio Nariño (UAN)

2025-08-22