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,
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.
Estime también el número de reclamos en la muestra con tamaños menores a $100.
\[ X \sim \text{Log-Normal}(\mu,\sigma^2) \]
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 \]
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 \]
Usamos:
\[ \mu=\ln(120)-\frac{\sigma^2}{2} \]
Sustituyendo:
\[ \mu=\ln(120)-\frac{0.015504}{2} \]
\[ \mu=4.7875-0.007752 \]
\[ \mu\approx4.7797 \]
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.
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.
En este ítem se replicará el ejemplo sobre el patrón de definición de reclamos visto en clase.
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:
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:
## [1] 7 4 3 6 2 8 5 11 7 1
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
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
)| 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.
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
)| 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 |
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:
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
)| 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 |
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:
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%
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.
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.
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
)| 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 |
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.
brvehins2dEl 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.
Para la variable ClaimNb... (ustedes escogen una sola),
ajustar:
Posteriormente, determinar cuál de las dos distribuciones presenta un mejor ajuste.
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")| 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 |
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.
Para la variable de severidad ClaimAmount... (ustedes
escogen una sola), ajustar:
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.
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")| 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")| 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 |
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")| Distribución | Percentil 95 |
|---|---|
| LogNormal | 51011.90 |
| Gamma | 65921.91 |
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.