Objetivo : practicar visualización con ggplot2 y plotly en un contexto actuarial, leyendo e interpretando cada gráfico. No es solo cómo hacerlo, sino qué concluyes para tarificación, reservas y gestión del riesgo.

1) Paquetes y datos

1.1 Carga de paquetes

# Instala si hace falta:
# install.packages(c("tidyverse","ggrepel","plotly","ggridges","rpart","rpart.plot","scales"))
library(tidyverse)
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr     1.1.4     ✔ readr     2.1.5
## ✔ forcats   1.0.1     ✔ stringr   1.5.2
## ✔ ggplot2   4.0.0     ✔ tibble    3.3.0
## ✔ lubridate 1.9.4     ✔ tidyr     1.3.1
## ✔ purrr     1.1.0     
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library(ggplot2)
library(ggrepel)
library(plotly)
## 
## Attaching package: 'plotly'
## 
## The following object is masked from 'package:ggplot2':
## 
##     last_plot
## 
## The following object is masked from 'package:stats':
## 
##     filter
## 
## The following object is masked from 'package:graphics':
## 
##     layout
library(ggridges)
library(rpart)
library(rpart.plot)
library(scales)
## 
## Attaching package: 'scales'
## 
## The following object is masked from 'package:purrr':
## 
##     discard
## 
## The following object is masked from 'package:readr':
## 
##     col_factor

1.2 Generación de una base sintética (contexto autos)

Simulamos frecuencia y severidad por asegurado/año con variables típicas para segmentación.

set.seed(2025)

n <- 2500

df <- tibble(
  anio = sample(2021:2024, n, replace = TRUE, prob = c(0.2, 0.3, 0.3, 0.2)),
  region = sample(c("Andina","Caribe","Pacífico","Orinoquía"), n, replace = TRUE, prob = c(0.5,0.2,0.25,0.05)),
  tipo_vehiculo = sample(c("Sedán","SUV","Moto","Pickup"), n, replace = TRUE, prob = c(0.4,0.3,0.2,0.1)),
  edad = pmin(pmax(round(rnorm(n, 42, 12)), 18), 80),
  genero = sample(c("F","M"), n, replace = TRUE, prob = c(0.45, 0.55)),
  # Exposición anual (años asegurado): entre 0.2 y 1
  expo = round(runif(n, 0.2, 1.0), 2)
) |>
  mutate(
    # Frecuencia (Poisson) condicionada por segmentos
    lambda_base = 0.25 +
      0.05*(tipo_vehiculo=="Moto") +
      0.07*(tipo_vehiculo=="Pickup") +
      0.03*(region=="Caribe") +
      0.04*(edad < 25) +
      0.02*(edad > 70),
    reclamos = rpois(n, lambda = pmax(lambda_base * expo, 0.01)),
    # Severidad lognormal dependiente del tipo de vehículo
    mu_sev = 8.0 + 0.25*(tipo_vehiculo %in% c("SUV","Pickup")),
    sigma_sev = 0.6 + 0.05*(region=="Pacífico"),
    costo_prom = rlnorm(n, meanlog = mu_sev, sdlog = sigma_sev),
    # Costo total (severidad por número de reclamos)
    costo_total = round(costo_prom * pmax(reclamos, 1) * rlnorm(n, 0, 0.2), 0),
    prima = round( # prima simple basada en frecuencia esperada y severidad típica
      (lambda_base * exp(mu_sev + (sigma_sev^2)/2)) * 1.15 * expo, 0
    )
  ) |>
  mutate(
    # Tasa de siniestralidad (loss ratio) simple
    loss_ratio = costo_total / pmax(prima, 1)
  )

glimpse(df)
## Rows: 2,500
## Columns: 14
## $ anio          <int> 2024, 2023, 2023, 2023, 2024, 2023, 2021, 2022, 2024, 20…
## $ region        <chr> "Pacífico", "Pacífico", "Andina", "Pacífico", "Andina", …
## $ tipo_vehiculo <chr> "SUV", "SUV", "Moto", "Moto", "Sedán", "Sedán", "Moto", …
## $ edad          <dbl> 55, 50, 45, 41, 53, 44, 63, 38, 36, 40, 61, 35, 45, 38, …
## $ genero        <chr> "F", "M", "M", "F", "M", "F", "M", "M", "M", "M", "M", "…
## $ expo          <dbl> 0.52, 0.22, 0.95, 0.46, 0.89, 0.87, 0.44, 0.53, 0.26, 0.…
## $ lambda_base   <dbl> 0.25, 0.25, 0.30, 0.30, 0.25, 0.25, 0.30, 0.25, 0.33, 0.…
## $ reclamos      <int> 0, 1, 0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 1, 0, 1, 0, 0, 0, 0,…
## $ mu_sev        <dbl> 8.25, 8.25, 8.00, 8.00, 8.00, 8.00, 8.00, 8.00, 8.00, 8.…
## $ sigma_sev     <dbl> 0.65, 0.65, 0.60, 0.65, 0.60, 0.65, 0.60, 0.60, 0.60, 0.…
## $ costo_prom    <dbl> 2033.355, 4577.208, 1606.826, 7117.637, 3959.740, 5172.4…
## $ costo_total   <dbl> 1865, 5315, 1579, 7732, 3837, 3745, 2690, 2614, 3993, 11…
## $ prima         <dbl> 707, 299, 1170, 584, 913, 921, 542, 544, 352, 1080, 1156…
## $ loss_ratio    <dbl> 2.6379066, 17.7759197, 1.3495726, 13.2397260, 4.2026287,…

Diccionario breve
- reclamos: frecuencia anual simulada.
- costo_total: severidad * frecuencia (aprox.).
- expo: exposición (años en riesgo).
- prima: prima técnica aproximada.
- loss_ratio: relación siniestro/prima (indicador de rentabilidad).

2) Reglas de la actividad

  • Trabaja con dplyr + ggplot2 (estilo tidyverse).
  • Cada gráfico debe venir con 2–3 frases de interpretación actuarial (obligatorio).
  • No borres los chunks. Completa donde veas # TODO.
  • Usa scale_y_log10() o scale_x_log10() cuando la cola sea pesada.

3) Gráficos univariados y bivariados (ggplot2)

3.1 Histograma de costo_total (cola pesada)

df |>
  ggplot(aes(costo_total)) +
  geom_histogram(bins = 40, color = "white") +
  scale_x_log10(labels = label_number(scale_cut = cut_si(" "))) +
  labs(title = "Distribución de costos (log10)",
       x = "Costo total (log10)",
       y = "Frecuencia")

3.2 Densidades por tipo_vehiculo

df |>
  ggplot(aes(costo_total, fill = tipo_vehiculo)) +
  geom_density(alpha = 0.3) +
  scale_x_log10(labels = scales::label_number(scale_cut = scales::cut_si(" "))) +
  labs(title = "Densidad de costos por tipo de vehículo",
       x = "Costo total (log10)", y = "Densidad")

3.3 Boxplot costo_total ~ tipo_vehiculo (severidad comparada)

df |>
  ggplot(aes(tipo_vehiculo, costo_total, fill = tipo_vehiculo)) +
  geom_boxplot(outlier.alpha = 0.2) +
  scale_y_log10(labels = scales::label_number(scale_cut = scales::cut_si(" "))) +
  labs(title = "Severidad por tipo de vehículo",
       y = "Costo total (log10)", x = NULL)

3.4 Violin plot + puntos (variabilidad intra-segmento)

set.seed(1)
df |>
  sample_n(800) |>
  ggplot(aes(tipo_vehiculo, costo_total, fill = tipo_vehiculo)) +
  geom_violin(trim = FALSE, alpha = 0.2) +
  geom_jitter(width = 0.1, alpha = 0.25) +
  scale_y_log10(labels = scales::label_number(scale_cut = scales::cut_si(" "))) +
  labs(title = "Distribución intra-segmento (violín + puntos)",
       y = "Costo total (log10)")

# INTERPRETACIÓN: TODO

3.5 Ridgelines (ggridges) por region

df |>
  ggplot(aes(costo_total, region)) +
  geom_density_ridges(rel_min_height = 0.01, scale = 1.2) +
  scale_x_log10(labels = scales::label_number(scale_cut = scales::cut_si(" "))) +
  labs(title = "Perfiles de severidad por región (ridgelines)",
       x = "Costo total (log10)", y = NULL)
## Picking joint bandwidth of 0.0752

# INTERPRETACIÓN: TODO

### 3.6 Dispersión edad vs costo_total + suavizado

df |>
  ggplot(aes(edad, costo_total, color = tipo_vehiculo)) +
  geom_point(alpha = 0.35) +
  geom_smooth(se = FALSE, method = "loess") +
  scale_y_log10(labels = scales::label_number(scale_cut = scales::cut_si(" "))) +
  labs(title = "Edad vs Costo total (con suavizado)",
       x = "Edad", y = "Costo total (log10)")
## `geom_smooth()` using formula = 'y ~ x'

# INTERPRETACIÓN: TODO

3.7 Burbuja: edad vs costo_total con tamaño = expo

df |>
  ggplot(aes(edad, costo_total, size = expo, color = region)) +
  geom_point(alpha = 0.4) +
  scale_y_log10(labels = scales::label_number(scale_cut = scales::cut_si(" "))) +
  labs(title = "Burbuja: edad vs costo (tamaño = exposición)",
       x = "Edad", y = "Costo total (log10)", size = "Exposición")

# INTERPRETACIÓN: TODO

3.8 Barras con IC: frecuencia media por tipo_vehiculo

df |>
  group_by(tipo_vehiculo) |>
  summarise(mean_rec = mean(reclamos), se = sd(reclamos)/sqrt(n())) |>
  ggplot(aes(fct_reorder(tipo_vehiculo, mean_rec), mean_rec)) +
  geom_col() +
  geom_errorbar(aes(ymin = mean_rec - 1.96*se, ymax = mean_rec + 1.96*se), width = 0.2) +
  coord_flip() +
  labs(title = "Frecuencia media de reclamos por tipo",
       x = NULL, y = "Reclamos por año (promedio)")

# INTERPRETACIÓN: TODO

3.9 Series de tiempo: costo_total por anio (mediana)

df |>
  group_by(anio) |>
  summarise(mediana = median(costo_total)) |>
  ggplot(aes(anio, mediana)) +
  geom_line() +
  geom_point() +
  scale_y_log10(labels = scales::label_number(scale_cut = scales::cut_si(" "))) +
  labs(title = "Evolución de severidad (mediana)",
       x = "Año", y = "Costo mediano (log10)")

# INTERPRETACIÓN: TODO

4) Heatmaps (mapas de calor)

4.1 Heatmap de severidad mediana por edad_grupo y tipo_vehiculo

df_hm <- df |>
  mutate(edad_grupo = cut(edad, breaks = c(18,25,35,45,55,65,80),
                          labels = c("18-25","26-35","36-45","46-55","56-65","66-80"),
                          include.lowest = TRUE)) |>
  group_by(edad_grupo, tipo_vehiculo) |>
  summarise(mediana = median(costo_total), .groups = "drop")

df_hm |>
  ggplot(aes(tipo_vehiculo, edad_grupo, fill = mediana)) +
  geom_tile(color = "white") +
  scale_fill_viridis_c(labels = scales::label_number(scale_cut = scales::cut_si(" "))) +
  labs(title = "Heatmap de severidad mediana",
       x = "Tipo de vehículo", y = "Grupo de edad", fill = "Mediana")

# INTERPRETACIÓN: TODO

4.2 Heatmap de loss_ratio (promedio) por region y tipo_vehiculo

df |>
  group_by(region, tipo_vehiculo) |>
  summarise(lr = mean(loss_ratio), .groups = "drop") |>
  ggplot(aes(tipo_vehiculo, region, fill = lr)) +
  geom_tile(color = "white") +
  scale_fill_viridis_c() +
  labs(title = "Mapa de calor de loss ratio promedio",
       x = "Tipo de vehículo", y = "Región", fill = "LR")

# INTERPRETACIÓN: TODO

5) Correlaciones y Pareto

5.1 Mapa de calor de correlación (numéricas)

num_vars <- df |>
  transmute(edad, expo, reclamos, costo_total = log10(costo_total + 1), prima = log10(prima + 1), loss_ratio)

corr <- cor(num_vars, use = "pairwise.complete.obs")

tibble(
  var1 = rep(rownames(corr), times = ncol(corr)),
  var2 = rep(colnames(corr), each = nrow(corr)),
  r = as.vector(corr)
) |>
  ggplot(aes(var1, var2, fill = r)) +
  geom_tile(color = "white") +
  scale_fill_gradient2(limits = c(-1,1)) +
  coord_equal() +
  labs(title = "Mapa de calor de correlaciones", x = NULL, y = NULL, fill = "r")

# INTERPRETACIÓN: TODO

5.2 Curva de Pareto de costos por póliza (Top drivers)

df |>
  arrange(desc(costo_total)) |>
  mutate(pct = costo_total / sum(costo_total),
         acum = cumsum(pct),
         idx = row_number()) |>
  ggplot(aes(idx, acum)) +
  geom_line() +
  geom_hline(yintercept = 0.8, linetype = "dashed") +
  labs(title = "Curva de Pareto: contribución acumulada del costo",
       x = "Pólizas ordenadas por costo", y = "Acumulado")

# INTERPRETACIÓN: TODO

6) Árbol de decisión (segmentación visual)

p80 <- quantile(df$costo_total, 0.80)
df_tree <- df |>
  mutate(alto_costo = if_else(costo_total > p80, "SI","NO")) |>
  select(alto_costo, edad, region, tipo_vehiculo, expo, reclamos, prima)

set.seed(99)
fit <- rpart(alto_costo ~ ., data = df_tree, method = "class",
             control = rpart.control(cp = 0.01, minbucket = 100))

rpart.plot(fit, type = 2, extra = 104, box.palette = "RdYlGn", branch.lty = 2, shadow.col = "gray")

# INTERPRETACIÓN: ¿Qué splits aparecen? ¿Qué segmentos “empujan” a alto costo?

7) Versión interactiva (plotly)

p1 <- df |>
  ggplot(aes(edad, costo_total, color = tipo_vehiculo)) +
  geom_point(alpha = 0.5) +
  scale_y_log10(labels = scales::label_number(scale_cut = scales::cut_si(" "))) +
  labs(title = "Interactivo: Edad vs Costo por tipo de vehículo",
       x = "Edad", y = "Costo total (log10)")

ggplotly(p1)
p2 <- df |>
  group_by(region, tipo_vehiculo) |>
  summarise(lr = mean(loss_ratio), .groups = "drop") |>
  ggplot(aes(tipo_vehiculo, region, fill = lr)) +
  geom_tile(color = "white") +
  labs(title = "Interactivo: Loss ratio promedio",
       x = "Tipo de vehículo", y = "Región", fill = "LR")

ggplotly(p2)

Actividad adicional

A partir del dataset df, cada uno de ustdes debe elegir 3 gráficos diferentes entre los tipos listados abajo. No vale repetir el mismo tipo cambiando colores.

Para cada gráfico deben responder las preguntas interpretativas que aparecen debajo. Eso va en el PDF.

1) Facet comparativo

Gráfico: Severidad (costo_total) por tipo_vehiculo facetado por anio.

df |>
  ggplot(aes(tipo_vehiculo, costo_total, fill = tipo_vehiculo)) +
  geom_boxplot(outlier.alpha = 0.2) +
  scale_y_log10(labels = label_number(scale_cut = cut_si(" "))) +
  facet_wrap(~ anio) +
  labs(title = "Severidad por tipo de vehículo y año", x = NULL, y = "Costo (log10)")

Preguntas a responder:

  • ¿Qué tipos presentan mayor severidad consistentemente?
  • ¿Hay algún año donde cambia la relación entre segmentos? ¿Por qué es relevante esto para ajustar primas?
  • ¿Qué segmento sería candidato a aumento de tarifa y cuál a descuento?

2) Heatmap de severidad

Gráfico: Severidad mediana por tipo_vehiculo × grupo de edad.

df_hm <- df |>
  mutate(edad_grupo = cut(edad, breaks = c(18,25,35,45,55,65,80),
                          labels = c("18-25","26-35","36-45","46-55","56-65","66-80"),
                          include.lowest = TRUE)) |>
  group_by(edad_grupo, tipo_vehiculo) |>
  summarise(mediana = median(costo_total), .groups = "drop")

df_hm |>
  ggplot(aes(tipo_vehiculo, edad_grupo, fill = mediana)) +
  geom_tile(color = "white") +
  scale_fill_viridis_c(labels = label_number(scale_cut = cut_si(" "))) +
  labs(title = "Mapa de severidad mediana", x = "Tipo de vehículo", y = "Grupo de edad")

Preguntas a responder:

  • ¿Qué combinación edad–vehículo es la más riesgosa?
  • Si tuvieras que aplicar un deducible más alto, ¿a qué combinación se lo aplicas?
  • ¿Qué grupo parece estar subsidiando a otro?

3) Pareto de costos

Gráfico: ¿Cuántas pólizas explican el 80% del costo total?

df |>
  arrange(desc(costo_total)) |>
  mutate(acum = cumsum(costo_total) / sum(costo_total),
         idx = row_number()) |>
  ggplot(aes(idx, acum)) +
  geom_line(color="steelblue") +
  geom_hline(yintercept = 0.8, linetype = "dashed") +
  labs(title = "Curva de Pareto del costo", x = "Pólizas ordenadas", y = "Acumulado")

Preguntas a responder:

  • ¿Cuántas pólizas generan el 80% del costo total?
  • ¿Qué dice eso sobre el riesgo de eventos extremos?
  • ¿Se justifica un contrato de reaseguro? ¿Cuál (quota share / stop-loss)?

4) Scatter de rentabilidad (loss ratio)

Gráfico: prima vs costo_total (log-log), coloreado por loss_ratio > 1.

df |>
  ggplot(aes(prima, costo_total, color = loss_ratio > 1)) +
  geom_point(alpha = 0.5) +
  scale_x_log10(labels = label_number(scale_cut = cut_si(" "))) +
  scale_y_log10(labels = label_number(scale_cut = cut_si(" "))) +
  labs(color="Pérdida (>1)", title="Prima vs Costo: Pólizas rentables vs no rentables")

Preguntas a responder:

  • ¿Existe relación entre prima cobrada y severidad?
  • ¿Qué segmento está generando pérdidas sistemáticas?
  • ¿La solución parece aumentar primas, resegmentar, o imponer límites?

5) Segmentación con árbol

Gráfico: Árbol para identificar perfil de alto costo.

p80 <- quantile(df$costo_total, 0.80)
df_tree <- df |>
  mutate(alto_costo = if_else(costo_total > p80, "SI","NO"))

fit <- rpart(alto_costo ~ edad + region + tipo_vehiculo + expo + reclamos + prima,
             data=df_tree, method="class", control=rpart.control(cp=0.01))
rpart.plot(fit, type = 2, extra = 104)

Preguntas a responder:

  • ¿Cuál es el primer split y qué implica eso actuarialmente?
  • ¿Cuál segmento aparece como alto costo?
  • ¿Ese segmento requiere reaseguro, deducibles, coaseguro, o tarifa diferenciada?

Cómo lo entregan

  • Un documento PDF generado desde RMarkdown.

  • Contiene:

    • 3 gráficos distintos
      • respuestas a las preguntas de cada gráfico.

Nombre del archivo: Visualizacion_Actuarial_ApellidoNombre.pdf