Problema 1

1500 reclamos en relación al seguro de cierto tipo de fachada de vidrio revela un costo medio por reclamo de $120 y una desviación estándar de $15. Asumiendo que el costo de los reclamos X posee una distribución log-normal,

  1. calcule el costo x de un reclamo tal que puede esperarse que 800 de las reclamaciones sean menores a x y las otras 700 mayores que x.

  2. Estime también el número de reclamos en la muestra con tamaños menores a $100.

Datos del problema

  • Total de reclamos: \(n = 1500\)
  • Costo medio: \(\bar{X} = \$120\)
  • Desviación estándar: \(s = \$15\)
  • Distribución:

\[ X \sim \text{Log-Normal}(\mu,\sigma^2) \]

Paso 1: Determinar los parámetros \(\mu\) y \(\sigma\)

Para una distribución log-normal, si

\[ Y=\ln(X)\sim N(\mu,\sigma^2) \]

entonces:

\[ E[X]=e^{\mu+\sigma^2/2}=120 \]

y

\[ Var[X]=(e^{\sigma^2}-1)e^{2\mu+\sigma^2}=15^2=225 \]

Resolviendo para \(\sigma^2\)

Usamos:

\[ Var[X]=E[X]^2(e^{\sigma^2}-1) \]

Sustituyendo:

\[ 225=120^2(e^{\sigma^2}-1) \]

\[ 225=14400(e^{\sigma^2}-1) \]

\[ e^{\sigma^2}=1+\frac{225}{14400} \]

\[ e^{\sigma^2}=1.015625 \]

Aplicando logaritmo natural:

\[ \sigma^2=\ln(1.015625)\approx0.015504 \]

\[ \sigma\approx0.1245 \]

Resolviendo para \(\mu\)

Usamos:

\[ \mu=\ln(120)-\frac{\sigma^2}{2} \]

Sustituyendo:

\[ \mu=\ln(120)-\frac{0.015504}{2} \]

\[ \mu=4.7875-0.007752 \]

\[ \mu\approx4.7797 \]

a) Costo \(x\) tal que 800 reclamos sean menores y 700 mayores

Buscamos el percentil

\[ p=\frac{800}{1500}=0.5333... \]

Para la distribución log-normal:

\[ P(X\le x)=\Phi\left(\frac{\ln(x)-\mu}{\sigma}\right) \]

Entonces:

\[ \frac{\ln(x)-\mu}{\sigma}=\Phi^{-1}(0.5333)\approx0.0837 \]

Despejando:

\[ \ln(x)=\mu+\sigma(0.0837) \]

Sustituyendo valores:

\[ \ln(x)=4.7797+0.1245(0.0837) \]

\[ \ln(x)\approx4.7901 \]

Aplicando exponencial:

\[ x=e^{4.7901}\approx\$120.32 \]

R/: Se espera que 800 de los 1500 reclamos tengan un costo menor a $120.32, y los otros 700 sean mayores.

b) Número estimado de reclamos menores a $100

Calculamos:

\[ P(X<100) \]

Estandarizando:

\[ z=\frac{\ln(100)-\mu}{\sigma} \]

Sustituyendo:

\[ z=\frac{4.6052-4.7797}{0.1245} \]

\[ z\approx-1.4020 \]

Entonces:

\[ P(X<100)=\Phi(-1.4020)\approx0.0805 \]

Número esperado de reclamos:

\[ 1500(0.0805)\approx121 \]

R/: Se estima que aproximadamente 121 reclamos de la muestra tendrán un costo inferior a $100.


Punto 2

Simulación del Patrón de Definición de Reclamos

En este ítem se replicará el ejemplo sobre el patrón de definición de reclamos visto en clase.

a) Fijar una semilla para el generador de números aleatorios

Se utilizará el número de cédula de uno de los integrantes del equipo como semilla para garantizar la reproducibilidad de los resultados.

Número de cédula utilizado:

\[ 1060597302 \]

En R:

set.seed(1060597302)

b) Generación de una muestra aleatoria de trimestres

Se requiere generar una muestra aleatoria de 10 elementos de la lista:

\[ \{1,2,3,\dots,12\} \]

con reemplazo. Cada número representa el número de trimestres entre el reporte de un reclamo y el instante de pago correspondiente.

En R:

# Generación de los trimestres
trimestres <- sample(1:12,
                     size = 10,
                     replace = TRUE)

trimestres
##  [1]  7  4  3  6  2  8  5 11  7  1

c) Generación de las cantidades de pago

Las cantidades de los 10 pagos se obtienen seleccionando aleatoriamente 10 números con reemplazo de la lista:

\[ \{100,200,300,\dots,1000\} \]

En R:

# Valores posibles de pago
pagos_posibles <- seq(100, 1000, by = 100)

# Generación de los pagos
pagos <- sample(pagos_posibles,
                size = 10,
                replace = TRUE)

pagos
##  [1] 100 200 700 500 700 700 400 500 400 400

d) Tabla de pagos de reclamos

A continuación se presenta la tabla de pagos simulada siguiendo el formato de la tabla 4 de la presentación PatRecl.

library(knitr)
library(kableExtra)
library(dplyr)

# Semilla
set.seed(1060597302)

# Número de reclamos
n_reclamos <- 10

# Cantidad de pagos por reclamo (entre 1 y 4)
num_pagos <- sample(1:4, n_reclamos, replace = TRUE)

# Crear lista vacía
lista_reclamos <- vector("list", n_reclamos)

# Generar datos aleatorios
for(i in 1:n_reclamos){

  pagos <- sample(seq(100,1000,100),
                  num_pagos[i],
                  replace = TRUE)

  trimestres <- sample(1:12,
                       num_pagos[i],
                       replace = TRUE)

  fila <- c()

  for(j in 1:num_pagos[i]){
    fila <- c(fila, pagos[j], trimestres[j])
  }

  lista_reclamos[[i]] <- fila
}

# Número máximo de columnas necesarias
max_cols <- max(sapply(lista_reclamos, length))

# Completar filas con NA
tabla <- lapply(lista_reclamos, function(x){
  length(x) <- max_cols
  x
})

# Convertir a data.frame
tabla4 <- as.data.frame(do.call(rbind, tabla))

# Nombres columnas
n_pares <- max_cols/2

nombres <- c()

for(i in 1:n_pares){
  nombres <- c(nombres,
               paste0("Pago", i),
               paste0("trimestre", i))
}

colnames(tabla4) <- nombres

# Agregar número de reclamo
tabla4 <- cbind(`Reclamo #` = 1:n_reclamos,
                tabla4)

# Mostrar tabla
kable(tabla4,
      align = "c",
      caption = "Tabla 4. Pagos de reclamos simulados") %>%
  kable_styling(
    bootstrap_options = c("striped","hover","condensed"),
    full_width = FALSE
  )
Tabla 4. Pagos de reclamos simulados
Reclamo # Pago1 trimestre1 Pago2 trimestre2 Pago3 trimestre3 Pago4 trimestre4
1 100 7 100 5 200 7 NA NA
2 700 5 400 4 NA NA NA NA
3 400 11 500 9 100 11 300 4
4 400 6 900 9 300 1 NA NA
5 1000 2 700 7 NA NA NA NA
6 200 9 600 8 NA NA NA NA
7 600 5 900 1 300 9 900 3
8 500 5 NA NA NA NA NA NA
9 800 4 800 6 300 7 NA NA
10 600 12 1000 3 200 8 NA NA

Nota: los códigos anteriores eran para mostrar cómo funcionaba el código, los resultados que muestra esta tabla son con los que vamos a trabajar.

e) Ajuste por inflación de los pagos

Cada pago debe expresarse en dólares constantes de Ene 1, 1996 (inicio del período Dic95–Ene96). Se asume que los incidentes ocurrieron en promedio hacia la mitad de ese período, es decir, hacia Ene 1, 1996.

El índice de inflación utilizado es el de la Tabla 3 de PatRecl (Cuadro 5 de la presentación):

Fecha Índice
Ene 1, 1996 100
Ene 1, 1997 105
Ene 1, 1998 115
Ene 1, 1999 145
Ene 1, 2000 157
Ene 1, 2001 169
Ene 1, 2002 183
Ene 1, 2003 201
Ene 1, 2004 227

Para ajustar un pago realizado en el trimestre \(t\) (medido desde Ene 1, 1996) a dólares de Ene 1, 1996, se aplica la fórmula de deflactación:

\[ \text{Pago}_{96} = \frac{\text{Pago observado}}{\text{Factor de inflación acumulado desde Ene 1, 1996 hasta el momento del pago}} \]

El factor de inflación entre dos fechas consecutivas del índice se interpola de forma proporcional dentro de cada año.

Lógica de la fórmula: si un pago se realizó \(t\) trimestres después del incidente (Ene 1, 1996), ese instante equivale a \(t/4\) años desde Ene 1, 1996. Identificamos el año base \(k\) tal que el pago cae entre \(\text{Ene 1, } 1996+k\) y \(\text{Ene 1, } 1996+k+1\), y la fracción dentro de ese año es \(f = (t/4) - k\). Entonces:

\[ \text{Factor}(t) = \frac{I_k}{100} \times \left(\frac{I_{k+1}}{I_k}\right)^{f} \]

donde \(I_k\) e \(I_{k+1}\) son los índices de inflación al inicio y final de ese año.

Y el pago ajustado a dólares de Ene 1, 1996 es:

\[ \text{Pago}_{96} = \frac{\text{Pago observado}}{\text{Factor}(t)} \]

library(knitr)
library(kableExtra)
library(dplyr)

# ── Reproducir la misma tabla4 del ítem d) ──────────────────────────────────
set.seed(1060597302)

n_reclamos <- 10
num_pagos  <- sample(1:4, n_reclamos, replace = TRUE)

lista_reclamos <- vector("list", n_reclamos)

for (i in 1:n_reclamos) {
  pagos_i     <- sample(seq(100, 1000, 100), num_pagos[i], replace = TRUE)
  trimestres_i <- sample(1:12,              num_pagos[i], replace = TRUE)

  fila <- c()
  for (j in 1:num_pagos[i]) {
    fila <- c(fila, pagos_i[j], trimestres_i[j])
  }
  lista_reclamos[[i]] <- fila
}

max_cols <- max(sapply(lista_reclamos, length))

tabla_raw <- lapply(lista_reclamos, function(x) {
  length(x) <- max_cols
  x
})

tabla4 <- as.data.frame(do.call(rbind, tabla_raw))

n_pares  <- max_cols / 2
nombres  <- c()
for (i in 1:n_pares) {
  nombres <- c(nombres, paste0("Pago", i), paste0("trim", i))
}
colnames(tabla4) <- nombres

# ── Índice de inflación (Tabla 3 PatRecl) ───────────────────────────────────
indice_inflacion <- c(
  "1996" = 100,
  "1997" = 105,
  "1998" = 115,
  "1999" = 145,
  "2000" = 157,
  "2001" = 169,
  "2002" = 183,
  "2003" = 201,
  "2004" = 227
)

# ── Función: factor de inflación acumulado desde Ene 1, 1996 ────────────────
factor_inflacion <- function(t) {
  años_desde_96 <- t / 4
  anio_base     <- floor(años_desde_96)
  fraccion      <- años_desde_96 - anio_base

  anio_inicio <- 1996 + anio_base
  anio_fin    <- anio_inicio + 1

  I_inicio <- indice_inflacion[as.character(anio_inicio)]
  I_fin    <- indice_inflacion[as.character(anio_fin)]

  if (is.na(I_inicio)) return(NA)
  if (is.na(I_fin))    I_fin <- I_inicio

  factor <- (I_inicio / 100) * (I_fin / I_inicio)^fraccion
  return(factor)
}

# ── Función: pago ajustado a dólares de Ene 1, 1996 ────────────────────────
ajustar_pago <- function(pago, trimestre) {
  if (is.na(pago) || is.na(trimestre)) return(NA)
  f <- factor_inflacion(trimestre)
  round(pago / f, 2)
}

# ── Construir tabla de pagos ajustados ──────────────────────────────────────
tabla_ajustada <- tabla4

for (i in 1:n_pares) {
  col_pago <- paste0("Pago",  i)
  col_trim <- paste0("trim",  i)
  col_adj  <- paste0("Pago", i, "_adj96")

  tabla_ajustada[[col_adj]] <- mapply(
    ajustar_pago,
    tabla4[[col_pago]],
    tabla4[[col_trim]]
  )
}

cols_mostrar <- c("Reclamo #")
for (i in 1:n_pares) {
  cols_mostrar <- c(cols_mostrar,
                    paste0("Pago",     i),
                    paste0("trim",     i),
                    paste0("Pago", i, "_adj96"))
}

tabla_e <- cbind(`Reclamo #` = 1:n_reclamos, tabla_ajustada)
tabla_e <- tabla_e[, cols_mostrar]

nuevos_nombres <- c("Reclamo #")
for (i in 1:n_pares) {
  nuevos_nombres <- c(nuevos_nombres,
                      paste0("Pago ", i, " ($)"),
                      paste0("Trim ", i),
                      paste0("Pago ", i, " ($96)"))
}
colnames(tabla_e) <- nuevos_nombres

kable(tabla_e,
      align   = "c",
      caption = "Tabla e). Pagos observados y ajustados a dólares de Ene 1, 1996") %>%
  kable_styling(
    bootstrap_options = c("striped", "hover", "condensed"),
    full_width = FALSE
  )
Tabla e). Pagos observados y ajustados a dólares de Ene 1, 1996
Reclamo # Pago 1 ($) Trim 1 Pago 1 (\(96) </th> <th style="text-align:center;"> Pago 2 (\)) Trim 2 Pago 2 (\(96) </th> <th style="text-align:center;"> Pago 3 (\)) Trim 3 Pago 3 (\(96) </th> <th style="text-align:center;"> Pago 4 (\)) Trim 4 Pago 4 ($96)
1 100 7 88.96 100 5 93.10 200 7 177.91 NA NA NA
2 700 5 651.68 400 4 380.95 NA NA NA NA NA NA
3 400 11 292.32 500 9 410.30 100 11 73.08 300 4 285.71
4 400 6 364.01 900 9 738.55 300 1 296.36 NA NA NA
5 1000 2 975.90 700 7 622.70 NA NA NA NA NA NA
6 200 9 164.12 600 8 521.74 NA NA NA NA NA NA
7 600 5 558.58 900 1 889.09 300 9 246.18 900 3 867.66
8 500 5 465.48 NA NA NA NA NA NA NA NA NA
9 800 4 761.90 800 6 728.03 300 7 266.87 NA NA NA
10 600 12 413.79 1000 3 964.07 200 8 173.91 NA NA NA

f) Tabla de patrón de definición de reclamos

Siguiendo la estructura de la Tabla 7 de PatRecl, se construye la tabla de patrón de definición de reclamos con los pagos ajustados por inflación. Las columnas son:

  • Duración (trimestres): tiempo desde el incidente hasta el pago.
  • Severidad promedio definida (como % de la última): severidad media acumulada hasta ese trimestre, expresada como porcentaje de la severidad promedio total final.
  • % de reclamos definidos por número: porcentaje acumulado de reclamos que ya han realizado al menos un pago hasta ese trimestre.
  • Por cantidad: porcentaje acumulado del total pagado hasta ese trimestre, como % del total final.
pagos_lista <- list()

for (i in 1:n_reclamos) {
  for (j in 1:n_pares) {
    p   <- tabla4[[paste0("Pago", j)]][i]
    tr  <- tabla4[[paste0("trim", j)]][i]
    adj <- tabla_ajustada[[paste0("Pago", j, "_adj96")]][i]

    if (!is.na(p) && !is.na(tr)) {
      pagos_lista[[length(pagos_lista) + 1]] <- list(
        reclamo   = i,
        pago      = p,
        trimestre = tr,
        pago_adj  = adj
      )
    }
  }
}

df_pagos <- do.call(rbind, lapply(pagos_lista, as.data.frame))

trimestres_obs <- sort(unique(df_pagos$trimestre))

total_pagos_adj <- sum(df_pagos$pago_adj, na.rm = TRUE)
total_reclamos  <- n_reclamos

patron <- data.frame(
  Trimestre          = trimestres_obs,
  Sev_prom_acum      = NA_real_,
  Sev_prom_pct       = NA_real_,
  Reclamos_def_num   = NA_real_,
  Reclamos_pct_num   = NA_real_,
  Cant_acum          = NA_real_,
  Cant_pct           = NA_real_
)

for (k in seq_along(trimestres_obs)) {
  t_actual <- trimestres_obs[k]
  sub <- df_pagos[df_pagos$trimestre <= t_actual, ]
  reclamos_def <- length(unique(sub$reclamo))
  sev_media_acum <- sum(sub$pago_adj, na.rm = TRUE) / reclamos_def
  cant_acum <- sum(sub$pago_adj, na.rm = TRUE)

  patron$Sev_prom_acum[k]    <- round(sev_media_acum, 2)
  patron$Reclamos_def_num[k] <- reclamos_def
  patron$Reclamos_pct_num[k] <- round(100 * reclamos_def / total_reclamos, 1)
  patron$Cant_acum[k]        <- round(cant_acum, 2)
  patron$Cant_pct[k]         <- round(100 * cant_acum / total_pagos_adj, 1)
}

sev_final <- patron$Sev_prom_acum[nrow(patron)]
patron$Sev_prom_pct <- round(100 * patron$Sev_prom_acum / sev_final, 1)

fila_inf <- data.frame(
  Trimestre          = Inf,
  Sev_prom_acum      = sev_final,
  Sev_prom_pct       = 100,
  Reclamos_def_num   = total_reclamos,
  Reclamos_pct_num   = 100,
  Cant_acum          = total_pagos_adj,
  Cant_pct           = 100
)

patron <- rbind(patron, fila_inf)
patron$Trimestre <- ifelse(is.infinite(patron$Trimestre), "∞", as.character(patron$Trimestre))

colnames(patron) <- c(
  "Duración (trimestres)",
  "Sev. media acum. ($96)",
  "Sev. media (% del final)",
  "# Reclamos definidos",
  "% Reclamos definidos",
  "Cant. acum. ($96)",
  "% Cantidad acum."
)

kable(patron,
      align   = "c",
      caption = "Tabla f). Patrón de definición de reclamos (Tabla 7 de PatRecl)") %>%
  kable_styling(
    bootstrap_options = c("striped", "hover", "condensed"),
    full_width = FALSE
  )
Tabla f). Patrón de definición de reclamos (Tabla 7 de PatRecl)
Duración (trimestres) Sev. media acum. ($96) Sev. media (% del final) # Reclamos definidos % Reclamos definidos Cant. acum. ($96) % Cantidad acum.
1 592.72 47.5 2 20 1185.45 9.5
2 720.45 57.8 3 30 2161.35 17.3
3 998.27 80.0 4 40 3993.08 32.0
4 774.52 62.1 7 70 5421.64 43.5
5 798.94 64.1 9 90 7190.48 57.6
6 920.28 73.8 9 90 8282.52 66.4
7 1048.77 84.1 9 90 9438.96 75.7
8 1013.46 81.3 10 100 10134.61 81.3
9 1169.38 93.8 10 100 11693.76 93.8
11 1205.92 96.7 10 100 12059.16 96.7
12 1247.30 100.0 10 100 12472.95 100.0
1247.30 100.0 10 100 12472.95 100.0

g) Aplicación a los datos de 1997

Se utilizará el patrón de definición de reclamos construido en el ítem f) junto con los datos del asegurador durante 1997 (Tabla 1 del enunciado).

Datos del problema:

  • Reclamos definidos al final de 1998: 98, con costo total de $48,906
  • Reclamos notificados pero no definidos aún: 10
  • Los pagos totales se harán en promedio 2 años más tarde

Al final de 1998, han transcurrido 8 trimestres desde Ene 1, 1997 (inicio del año de incidentes). Según el patrón de definición construido en f), consultamos el % de reclamos definidos por número al trimestre 8.

patron_num <- patron
patron_num[["Duración (trimestres)"]] <- suppressWarnings(
  as.numeric(patron_num[["Duración (trimestres)"]])
)

trimestre_eval <- 8

dur_vec     <- patron_num[["Duración (trimestres)"]]
pct_num_vec <- patron_num[["% Reclamos definidos"]]
pct_sev_vec <- patron_num[["Sev. media (% del final)"]]

dur_finito  <- dur_vec[!is.na(dur_vec)]
pct_num_fin <- pct_num_vec[!is.na(dur_vec)]
pct_sev_fin <- pct_sev_vec[!is.na(dur_vec)]

pct_recl_8 <- approx(dur_finito, pct_num_fin, xout = trimestre_eval, rule = 2)$y
pct_sev_8  <- approx(dur_finito, pct_sev_fin,  xout = trimestre_eval, rule = 2)$y

cat(sprintf(
  "Al trimestre %d (final de 1998):\n  %% reclamos definidos (por número): %.1f%%\n  %% severidad media definida (por cantidad): %.1f%%\n",
  trimestre_eval, pct_recl_8, pct_sev_8
))
## Al trimestre 8 (final de 1998):
##   % reclamos definidos (por número): 100.0%
##   % severidad media definida (por cantidad): 81.3%

h) Cálculos actuariales para 1999

h.1) Estimación de la tasa de frecuencia de 1997

La tasa de frecuencia se define como:

\[ \hat{\lambda}_{97} = \frac{\text{# Reclamos esperados}}{\text{Exposición}} \]

La exposición se calcula como el área bajo la curva \(P(t)\) (número de pólizas en fuerza) durante 1997, aproximada por la regla del trapecio:

\[ \text{Exposición} = \frac{1}{4}\left[\frac{6213+6435}{2} + \frac{6435+6522}{2} + \frac{6522+6899}{2} + \frac{6899+7138}{2}\right] \approx 6633 \]

El número esperado de reclamos se obtiene a partir de los 98 observados, usando el % de reclamos definidos según el patrón:

\[ \text{# Reclamos esperados} = \frac{98}{\% \text{ definidos al trimestre 8} / 100} \]

polizas <- c(6213, 6435, 6522, 6899, 7138)

exposicion <- (1/4) * sum(
  (polizas[1] + polizas[2]) / 2,
  (polizas[2] + polizas[3]) / 2,
  (polizas[3] + polizas[4]) / 2,
  (polizas[4] + polizas[5]) / 2
)

cat(sprintf("Exposición ≈ %.0f pólizas-año\n", exposicion))
## Exposición ≈ 6633 pólizas-año
reclamos_obs <- 98
pct_def_97   <- pct_recl_8 / 100

reclamos_esp <- reclamos_obs / pct_def_97

cat(sprintf(
  "\nReclamos observados al final de 1998: %d\n%% definidos según patrón (trim 8): %.1f%%\nReclamos esperados totales: %.1f\n",
  reclamos_obs, pct_recl_8, reclamos_esp
))
## 
## Reclamos observados al final de 1998: 98
## % definidos según patrón (trim 8): 100.0%
## Reclamos esperados totales: 98.0
lambda_97 <- reclamos_esp / exposicion

cat(sprintf("\nλ_97 = %.1f / %.0f = %.5f = %.3f%%\n",
            reclamos_esp, exposicion, lambda_97, lambda_97 * 100))
## 
## λ_97 = 98.0 / 6633 = 0.01477 = 1.477%

Interpretación: La tasa de frecuencia de reclamos estimada para 1997 es \(\hat{\lambda}_{97}\), que representa el número esperado de reclamos por póliza-año en fuerza.


h.2) Estimación de la severidad media en dólares de Jul 1997

La severidad media observada al final de 1998 (en dólares corrientes de esa fecha) es:

\[ \bar{S}_{\text{obs}} = \frac{\$48{,}906}{98} \approx \$499 \]

Esta cantidad está expresada en dólares de aproximadamente Ene 1, 1998 (promedio del período Ene97–Dic98). Para llevarla a dólares de Jul 1, 1997, deflactamos con el índice de inflación.

Además, como solo se ha observado el % de severidad correspondiente al patrón al trimestre 8, la severidad esperada total (en dólares de Ene 1, 1998) es:

\[ \bar{S}_{\text{esp, Ene98}} = \frac{\bar{S}_{\text{obs}}}{\% \text{ severidad definida al trim 8} / 100} \]

Luego se deflacta de Ene 1, 1998 a Jul 1, 1997 (medio año atrás). Con índice 115 en Ene98 e índice 105 en Ene97, Jul97 corresponde a un índice interpolado:

\[ I_{\text{Jul97}} = 105 \times \left(\frac{115}{105}\right)^{0.5} \]

sev_obs_ene98 <- 48906 / 98
cat(sprintf("Severidad media observada (dólares de ~Ene 1998): $%.2f\n", sev_obs_ene98))
## Severidad media observada (dólares de ~Ene 1998): $499.04
sev_esp_ene98 <- sev_obs_ene98 / (pct_sev_8 / 100)
cat(sprintf(
  "%% severidad definida según patrón (trim 8): %.1f%%\nSeveridad esperada total (dólares de Ene 1998): $%.2f\n",
  pct_sev_8, sev_esp_ene98
))
## % severidad definida según patrón (trim 8): 81.3%
## Severidad esperada total (dólares de Ene 1998): $613.83
I_ene97 <- 105
I_ene98 <- 115

I_jul97 <- I_ene97 * (I_ene98 / I_ene97)^0.5

cat(sprintf("Índice de inflación en Jul 1, 1997: %.4f\n", I_jul97))
## Índice de inflación en Jul 1, 1997: 109.8863
factor_def <- I_ene98 / I_jul97

sev_esp_jul97 <- sev_esp_ene98 / factor_def

cat(sprintf("Severidad media esperada en dólares de Jul 1, 1997: $%.2f\n", sev_esp_jul97))
## Severidad media esperada en dólares de Jul 1, 1997: $586.53

Interpretación: La severidad media estimada en dólares de julio de 1997 es \(\hat{S}_{97}\). Este es el costo esperado por reclamo a precios del período de referencia.


h.3) Prima a cobrar en 1999 (con inflación anual del 15% desde Ene 1, 1998)

La prima de riesgo (pura) para 1999 se estima proyectando la severidad media de Jul 1997 hasta el momento promedio de pago. Los pagos se realizarán en promedio 2 años después de los incidentes de 1997, es decir, alrededor de mediados de 1999.

El período de inflación a proyectar es desde Jul 1, 1997 hasta mediados de 1999, lo que equivale aproximadamente a 2 años de inflación compuesta al 15% anual (a partir de Ene 1, 1998 según el enunciado).

Sin embargo, el período preciso es: - Desde Jul 1, 1997 hasta Jul 1, 1999 = 2 años. - Del total, desde Jul 1, 1997 a Ene 1, 1998 = 0.5 años con la inflación vigente antes de 1998. - Desde Ene 1, 1998 en adelante, la inflación es 15% anual, por lo que 1.5 años de inflación al 15%.

\[ \text{Factor inflación total} = \left(\frac{I_{\text{Ene98}}}{I_{\text{Jul97}}}\right)^{1} \times (1.15)^{1.5} \]

La prima de riesgo para 1999 es:

\[ \Pi_{99} = \hat{\lambda}_{97} \times \hat{S}_{97} \times \text{Factor de inflación} \]

factor_jul97_ene98 <- I_ene98 / I_jul97
factor_ene98_jul99 <- (1.15)^1.5
factor_total <- factor_jul97_ene98 * factor_ene98_jul99

cat(sprintf(
  "Factor inflación Jul97→Ene98: %.4f\nFactor inflación Ene98→Jul99 (15%% anual, 1.5 años): %.4f\nFactor inflación total Jul97→Jul99: %.4f\n",
  factor_jul97_ene98, factor_ene98_jul99, factor_total
))
## Factor inflación Jul97→Ene98: 1.0465
## Factor inflación Ene98→Jul99 (15% anual, 1.5 años): 1.2332
## Factor inflación total Jul97→Jul99: 1.2906
sev_1999 <- sev_esp_jul97 * factor_total
cat(sprintf("Severidad media proyectada a mediados de 1999: $%.2f\n", sev_1999))
## Severidad media proyectada a mediados de 1999: $756.99
prima_riesgo_99 <- lambda_97 * sev_1999
cat(sprintf(
  "\nPrima de riesgo pura para 1999:\nλ_97 × S_1999 = %.5f × $%.2f = $%.4f por póliza-año\n",
  lambda_97, sev_1999, prima_riesgo_99
))
## 
## Prima de riesgo pura para 1999:
## λ_97 × S_1999 = 0.01477 × $756.99 = $11.1845 por póliza-año

Resumen de resultados:

resumen <- data.frame(
  Resultado = c(
    "Exposición 1997 (pólizas-año)",
    "Reclamos esperados 1997",
    "Tasa de frecuencia λ_97 (%)",
    "Severidad media obs. (Ene 1998, $)",
    "Severidad media esp. (Ene 1998, $)",
    "Severidad media esp. (Jul 1997, $)",
    "Factor inflación Jul97→Jul99",
    "Severidad proyectada 1999 ($)",
    "Prima de riesgo pura 1999 ($/póliza-año)"
  ),
  Valor = c(
    round(exposicion, 0),
    round(reclamos_esp, 1),
    round(lambda_97 * 100, 4),
    round(sev_obs_ene98, 2),
    round(sev_esp_ene98, 2),
    round(sev_esp_jul97, 2),
    round(factor_total, 4),
    round(sev_1999, 2),
    round(prima_riesgo_99, 4)
  )
)

kable(resumen,
      align   = c("l", "r"),
      caption = "Tabla h). Resumen de resultados actuariales para 1997–1999") %>%
  kable_styling(
    bootstrap_options = c("striped", "hover", "condensed"),
    full_width = FALSE
  )
Tabla h). Resumen de resultados actuariales para 1997–1999
Resultado Valor
Exposición 1997 (pólizas-año) 6633.0000
Reclamos esperados 1997 98.0000
Tasa de frecuencia λ_97 (%) 1.4775
Severidad media obs. (Ene 1998, $) 499.0400
Severidad media esp. (Ene 1998, \() </td> <td style="text-align:right;"> 613.8300 </td> </tr> <tr> <td style="text-align:left;"> Severidad media esp. (Jul 1997, latexa110bcaa65bc9ef1206d59d8f26d9c18) </td> <td style="text-align:right;"> 756.9900 </td> </tr> <tr> <td style="text-align:left;"> Prima de riesgo pura 1999 (\)/póliza-año) 11.1845

Punto 3

El paquete de R CASdatasets consiste en una colección de conjuntos de datos actuariales. En la guía de documentación del paquete, en la página 26, se describe la base de datos brvehins, la cual consiste en 2 conjuntos de datos sobre seguros de vehículos en Brasil.

El primer conjunto de datos brvehins1 está subdividido en 5 subconjuntos brvehins1a - brvehins1e y el segundo en 4 subconjuntos brvehins2a - brvehins2d, para un total de 9 conjuntos de datos que en el mismo orden se etiquetarán de cero a ocho, 0-8.

Ustedes suman el último dígito de la cédula de cada uno de los 3 integrantes del grupo, dividen esta suma entre 9 y, de acuerdo al residuo de esta división, escogen la correspondiente base de entre las 9 bases que hemos indicado.

Base de datos: brvehins2d

El presente análisis utiliza la base de datos brvehins2d, perteneciente al paquete CASdatasets de R, el cual recopila conjuntos de datos de naturaleza actuarial. Esta base forma parte de la colección brvehins, que contiene información sobre seguros de vehículos en Brasil, y corresponde al cuarto subconjunto del segundo conjunto de datos.

La base brvehins2d contiene información de pólizas de seguros vehiculares con un total de 18 variables, entre las que se destacan características del vehículo como el año (VehYear), modelo (VehModel) y grupo (VehGroup), información geográfica como ciudad (City), área (Area) y estado (State), variables de exposición y prima (ExposTotal, PremTotal), así como variables de frecuencia y severidad de siniestros clasificadas por tipo: robo, colisión, incendio y otros.

Para el desarrollo de este trabajo se utilizarán las variables ClaimNbColl (número de reclamaciones por colisión) y ClaimAmountColl (monto de las reclamaciones por colisión), con el objetivo de ajustar distribuciones de frecuencia y severidad, respectivamente.

a) Frecuencia de reclamaciones

Para la variable ClaimNb... (ustedes escogen una sola), ajustar:

  • Distribución de Poisson.
  • Distribución Binomial Negativa.

Posteriormente, determinar cuál de las dos distribuciones presenta un mejor ajuste.

Ajuste de distribuciones de frecuencia

Para el análisis de frecuencia de siniestros se trabaja con la variable ClaimNbColl, la cual registra el número de reclamaciones por colisión por póliza. Dado que esta variable representa conteos de eventos, las distribuciones candidatas para modelarla son la distribución de Poisson y la distribución Binomial Negativa, ambas ampliamente utilizadas en el contexto actuarial para modelar la frecuencia de siniestros.

La distribución de Poisson asume que la media y la varianza de la variable son iguales, mientras que la Binomial Negativa permite que la varianza sea mayor que la media, lo que la hace más flexible ante la presencia de sobredispersión en los datos. Esta situación es común en carteras de seguros, donde una gran proporción de las pólizas no presenta siniestros y unas pocas concentran una alta cantidad de reclamaciones.

claim <- brvehins2d$ClaimNbColl

# Ajuste Poisson
fit_pois <- fitdistr(claim, "Poisson")

# Ajuste Binomial Negativa
fit_nb <- fitdistr(claim, "negative binomial")
# Tabla comparativa con AIC y BIC
tabla_comp <- data.frame(
  Distribución = c("Poisson", "Binomial Negativa"),
  Parámetros = c(
    paste0("λ = ", round(fit_pois$estimate, 4)),
    paste0("r = ", round(fit_nb$estimate[1], 4),
           ", p = ", round(fit_nb$estimate[2], 4))
  ),
  LogVerosimilitud = c(
    round(fit_pois$loglik, 2),
    round(fit_nb$loglik, 2)
  ),
  AIC = c(
    round(AIC(fit_pois), 2),
    round(AIC(fit_nb), 2)
  ),
  BIC = c(
    round(BIC(fit_pois), 2),
    round(BIC(fit_nb), 2)
  )
)

tabla_comp %>%
  kable(caption = "Comparación de distribuciones de frecuencia",
        align = c("l", "c", "c", "c", "c")) %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
                full_width = FALSE,
                position = "center") %>%
  row_spec(0, bold = TRUE, background = "#2C3E50", color = "white")
Comparación de distribuciones de frecuencia
Distribución Parámetros LogVerosimilitud AIC BIC
Poisson λ = 0.175 -438929.6 877861.2 877872.6
Binomial Negativa r = 0.0689, p = 0.175 -264871.4 529746.8 529769.7

Comparación e interpretación

A partir de los criterios de información obtenidos, se observa que la Binomial Negativa presenta valores de AIC y BIC significativamente menores que los de la distribución de Poisson (529,746.8 vs 877,861.2 en AIC y 529,769.7 vs 877,872.6 en BIC), lo que indica un mejor ajuste a los datos observados.

Este resultado es consistente con lo esperado, dado que la variable ClaimNbColl presenta una marcada sobredispersión: la gran mayoría de las pólizas registra cero colisiones, mientras que unas pocas concentran una cantidad elevada de reclamaciones. La distribución de Poisson no logra capturar adecuadamente esta característica al asumir igualdad entre media y varianza, mientras que la Binomial Negativa se adapta mejor a este comportamiento gracias a su parámetro adicional de dispersión.

Por lo tanto, la Binomial Negativa constituye el modelo más adecuado para representar la frecuencia de siniestros por colisión en esta cartera.

# Frecuencias observadas
obs <- table(claim)
x_vals <- as.integer(names(obs))
freq_obs <- as.vector(obs) / length(claim)

# Probabilidades teóricas Poisson
lambda <- fit_pois$estimate["lambda"]
prob_pois <- dpois(x_vals, lambda)

# Probabilidades teóricas Binomial Negativa
r <- fit_nb$estimate["size"]
p <- fit_nb$estimate["mu"]
prob_nb <- dnbinom(x_vals, size = r, mu = p)

# Data frame para ggplot
df <- data.frame(
  x = rep(x_vals, 3),
  prob = c(freq_obs, prob_pois, prob_nb),
  tipo = rep(c("Observado", "Poisson", "Binomial Negativa"),
             each = length(x_vals))
)

# Grafica limitando a x <= 20
df_filtrado <- df[df$x <= 20, ]

ggplot(df_filtrado, aes(x = x, y = prob, color = tipo, linetype = tipo)) +
  geom_line(linewidth = 1) +
  geom_point(size = 2) +
  scale_color_manual(values = c("Observado" = "black",
                                 "Poisson" = "steelblue",
                                 "Binomial Negativa" = "firebrick")) +
  labs(title = "Ajuste de distribuciones de frecuencia",
       subtitle = "ClaimNbColl - brvehins2d",
       x = "Número de colisiones",
       y = "Probabilidad",
       color = "Distribución",
       linetype = "Distribución") +
  theme_minimal() +
  theme(legend.position = "bottom",
        plot.title = element_text(face = "bold"))

La gráfica muestra el ajuste de los modelos Poisson y Binomial Negativa frente a las frecuencias observadas de ClaimNbColl. Se puede apreciar que la Binomial Negativa se aproxima mejor a los datos observados, especialmente en los primeros valores donde se concentra la mayor parte de la información.

Por su parte, el modelo Poisson presenta una ligera desviación en estos puntos clave, lo que refuerza la conclusión de que la Binomial Negativa es el modelo más adecuado para representar la frecuencia de siniestros por colisión en esta cartera.

b) Severidad de reclamaciones

Para la variable de severidad ClaimAmount... (ustedes escogen una sola), ajustar:

  • Distribución LogNormal.
  • Distribución Gamma.

En cada caso estimar el percentil 95%, es decir, el valor de la pérdida que solo es superada por el 5% de las pérdidas más altas.

Ajuste de distribuciones de severidad

Para el análisis de severidad se trabaja con la variable ClaimAmountColl, la cual registra el monto de las reclamaciones por colisión. Dado que las distribuciones candidatas, LogNormal y Gamma, están definidas únicamente para valores estrictamente positivos, el ajuste se realizará exclusivamente sobre las pólizas que efectivamente registraron pérdidas.

Por esta razón, se excluyen las observaciones con monto igual a cero, ya que corresponden a pólizas sin siniestros durante el período de exposición.

severidad <- brvehins2d$ClaimAmountColl
severidad <- severidad[severidad > 0]

# Tabla resumen
tabla_resumen <- data.frame(
  Estadístico = c("Mínimo", "Q1", "Mediana", "Media", "Q3", "Máximo", "N observaciones"),
  Valor = c(
    round(min(severidad), 2),
    round(quantile(severidad, 0.25), 2),
    round(median(severidad), 2),
    round(mean(severidad), 2),
    round(quantile(severidad, 0.75), 2),
    round(max(severidad), 2),
    length(severidad)
  )
)

tabla_resumen %>%
  kable(caption = "Resumen estadístico - ClaimAmountColl (valores > 0)",
        align = c("l", "c")) %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
                full_width = FALSE,
                position = "center") %>%
  row_spec(0, bold = TRUE, background = "#2C3E50", color = "white")
Resumen estadístico - ClaimAmountColl (valores > 0)
Estadístico Valor
Mínimo 1.00
Q1 1641.00
Mediana 3866.50
Media 12257.72
Q3 10646.00
Máximo 1660628.00
N observaciones 56462.00

A partir del resumen estadístico se observa que la distribución de los montos es marcadamente asimétrica hacia la derecha, dado que la media (12,257.72) supera considerablemente a la mediana (3,866.50). Esto indica que una pequeña proporción de siniestros concentra pérdidas de gran magnitud, alcanzando valores de hasta 1,660,628.

Este patrón es característico de variables de severidad en seguros y sugiere que las distribuciones LogNormal y Gamma constituyen alternativas adecuadas para modelar este tipo de datos.

# Ajuste LogNormal
fit_ln <- fitdistr(severidad, "lognormal")

# Ajuste Gamma con valores iniciales
fit_gam <- fitdist(severidad, "gamma", method = "mme")
# Tabla comparativa parámetros severidad
tabla_sev <- data.frame(
  Distribución = c("LogNormal", "Gamma"),
  Parámetros = c(
    paste0("μ = ", round(fit_ln$estimate["meanlog"], 4),
           ", σ = ", round(fit_ln$estimate["sdlog"], 4)),
    paste0("shape = ", round(fit_gam$estimate["shape"], 6),
           ", rate = ", round(fit_gam$estimate["rate"], 8))
  ),
  LogVerosimilitud = c(
    round(fit_ln$loglik, 2),
    round(fit_gam$loglik, 2)
  ),
  AIC = c(
    round(AIC(fit_ln), 2),
    round(fit_gam$aic, 2)
  ),
  BIC = c(
    round(BIC(fit_ln), 2),
    round(fit_gam$bic, 2)
  )
)

tabla_sev %>%
  kable(caption = "Comparación de distribuciones de severidad - ClaimAmountColl",
        align = c("l", "c", "c", "c", "c")) %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
                full_width = FALSE,
                position = "center") %>%
  row_spec(0, bold = TRUE, background = "#2C3E50", color = "white")
Comparación de distribuciones de severidad - ClaimAmountColl
Distribución Parámetros LogVerosimilitud AIC BIC
LogNormal μ = 8.3108, σ = 1.5375 -573649.0 1147302 1147320
Gamma shape = 0.167588, rate = 1.367e-05 -602648.3 1205301 1205318

Comparación e interpretación

A partir de los criterios de información obtenidos, se observa que la distribución LogNormal presenta valores de AIC y BIC significativamente menores que los de la distribución Gamma (1,147,302 vs 1,205,301 en AIC y 1,147,320 vs 1,205,318 en BIC), lo que indica un mejor ajuste a los datos de severidad.

Este resultado es consistente con el comportamiento observado en la variable ClaimAmountColl, la cual presenta una marcada asimetría positiva y una cola derecha pesada, características que la distribución LogNormal captura de manera más adecuada gracias a sus parámetros de localización (\(\mu = 8.3108\)) y escala (\(\sigma = 1.5375\)), definidos sobre el logaritmo de la variable.

Por lo tanto, la distribución LogNormal constituye el modelo más adecuado para representar la severidad de los siniestros por colisión en esta cartera.

# Percentil 95 LogNormal
p95_ln <- qlnorm(0.95,
                 meanlog = fit_ln$estimate["meanlog"],
                 sdlog   = fit_ln$estimate["sdlog"])

# Percentil 95 Gamma
p95_gam <- qgamma(0.95,
                  shape = fit_gam$estimate["shape"],
                  rate  = fit_gam$estimate["rate"])

# Tabla percentil 95
tabla_p95 <- data.frame(
  Distribución = c("LogNormal", "Gamma"),
  Percentil_95 = c(
    round(p95_ln, 2),
    round(p95_gam, 2)
  )
)

tabla_p95 %>%
  kable(caption = "Percentil 95 - Distribuciones de severidad",
        col.names = c("Distribución", "Percentil 95"),
        align = c("l", "c")) %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
                full_width = FALSE,
                position = "center") %>%
  row_spec(0, bold = TRUE, background = "#2C3E50", color = "white")
Percentil 95 - Distribuciones de severidad
Distribución Percentil 95
LogNormal 51011.90
Gamma 65921.91

Percentil 95 - Valor en Riesgo

El percentil 95 representa el valor de pérdida que solo es superado por el 5% de los siniestros más costosos. Es decir, el 95% de las reclamaciones por colisión se encuentran por debajo de dicho valor.

  • Bajo el modelo LogNormal, el percentil 95 es de $51,011.90, lo que indica que solo el 5% de los siniestros supera este monto.

  • Bajo el modelo Gamma, el percentil 95 es de $65,921.91, un valor más conservador que sobreestima la cola de la distribución en comparación con los datos observados.

Dado que la distribución LogNormal presentó el mejor ajuste a los datos, se concluye que el valor de pérdida que solo es superado por el 5% de los siniestros más altos es de aproximadamente $51,011.90.

# Valores para la curva
x_vals <- seq(100, quantile(severidad, 0.99), length.out = 1000)

# Densidades teóricas
dens_ln <- dlnorm(x_vals,
                  meanlog = fit_ln$estimate["meanlog"],
                  sdlog   = fit_ln$estimate["sdlog"])

dens_gam <- dgamma(x_vals,
                   shape = fit_gam$estimate["shape"],
                   rate  = fit_gam$estimate["rate"])

# Data frame
df_sev <- data.frame(
  x = rep(x_vals, 2),
  densidad = c(dens_ln, dens_gam),
  tipo = rep(c("LogNormal", "Gamma"), each = length(x_vals))
)

ggplot() +
  geom_histogram(aes(x = severidad, y = after_stat(density)),
                 bins = 100,
                 fill = "grey80", color = "white") +
  geom_line(data = df_sev, aes(x = x, y = densidad, color = tipo),
            linewidth = 1) +
  scale_color_manual(values = c("LogNormal" = "firebrick",
                                "Gamma" = "steelblue")) +
  coord_cartesian(xlim = c(0, quantile(severidad, 0.99))) +
  labs(title = "Ajuste de distribuciones de severidad",
       subtitle = "ClaimAmountColl - brvehins2d",
       x = "Monto de reclamación",
       y = "Densidad",
       color = "Distribución") +
  theme_minimal() +
  theme(legend.position = "bottom",
        plot.title = element_text(face = "bold"))

La gráfica muestra el ajuste de los modelos LogNormal y Gamma frente a la densidad empírica de ClaimAmountColl. Se puede observar que la distribución LogNormal (rojo) sigue de manera más adecuada la forma del histograma, capturando correctamente la asimetría positiva y la cola derecha de los datos.

Por su parte, el modelo Gamma (azul) presenta un pico excesivamente pronunciado en los valores bajos, alejándose del comportamiento observado en la distribución empírica.

Estos resultados respaldan lo obtenido mediante los criterios AIC y BIC, confirmando que la distribución LogNormal proporciona el mejor ajuste para modelar la severidad de los siniestros por colisión.