1 Pricing

1.1 Introducción

Podemos considerar un principio de prima estándar (al menos desde un punto de vista teórico), al valor esperado asociado a algún riesgo. \(S_t\) tal que

\[ \pi(S_t) = (1 + \alpha) \mathbb{E} (S_t)\]

donde \(\alpha\) denota a los distintos cargos que la aseguradora puede hacer, y donde \(S_t\) es la variable aleatoria pérdida con \(t\) igual a un año.

Si \(N_t\) es el proceso de recuento que denota el número de reclamaciones ocurridas durante el período t y \(Yi\) denota el monto del i-ésimo reclamo. La pérdida total durante el período t es:

\[S_t = \sum_{i =1}^{N_t} Y_i\] Si consideramos que \(Y_i \,\,\, \forall i\) son inpendendientes es identicámente distribuidas. Tenemos que:

\[ \pi = \mathbb{E}(S) = \mathbb{E}(N) \mathbb{E}(Y)\]

Debido a que se debe considerar la heterogeneidad de los asegurados, y considerando que se cuanta con la información sobre cada asegurado (supongamos un vector \(\mathbf{X}\) de información).

\[ \pi = \mathbb{E}(S| \mathbf{X} = x) = \mathbb{E}(N | \mathbf{X} = x) \mathbb{E}(Y| \mathbf{X} = x)\]

Lo que se va a ser estimar \(\mathbb{E}(N | \mathbf{X} = x)\) y \(\mathbb{E}(Y| \mathbf{X} = x)\), es decir la frecuencia y severidad estimadas partiendo de las características de cada asegurado.

1.2 Datos

Los datos a utilizar corresponde a la cartera de motor, de una aseguradora francesa.

datos <- read_rds("base_trabajo.RDS")
  • policy_id (numérico): Identificador de póliza
  • claim_count (numérico): Número de siniestros durante el período de exposición
  • exposure: exposición, en años
  • power (categórico): potencia del coche
  • agecar (númerico) : antigüedad del automóvil en años.
  • agedriver (numérico): edad del conductor en años.
  • brand (factor): marca del coche, A: Renaut Nissan y Citro en; B: Volkswagen, Audi, Skoda y Seat; C Opel, General Motors y Ford; D Fiat; E Mercedes Chrysler y BMW; F japonés (excepto Nissan) y coreano; G otro.
  • fuel (factor): combustible que utiliza el coche con diesel o regular,
  • region (factor): con diferentes regiones, en Francia (basado en un estándar francés clasificación)
  • density (numérico): densidad de habitantes (número de habitantes por cuadrado kilómetro) en la ciudad donde vive el conductor del automóvil.
  • total_claims(numérico): Monto total de los siniestros ocurridos en el perido de exposición
  • cat_driver_age (categótico): Categorización de la edad del conductor.
  • cat_car_age (categótico): Categorización de la edad del automóvil.
  • cat_density (categótico): Categorización de la edad del automóvil.

1.3 Modelo para estimar la frecuencia

Para tener una noción acerca del modelo a estimar primero calculamos la tasa global de reclamaciones.

datos %>%
    summarise(tasa_reclamacion = sum(claim_count) / sum(exposure))
##   tasa_reclamacion
## 1       0.07361047

También podemos calcular la tasa agrupando por las variables categóricas que tenemos, de la cual es importante notar cuál es la exposición de cada uno de los categorías.

exposicion_edad <- datos %>%
 group_by(cat_driver_age) %>%
  summarise(exposicion = sum(exposure))

ggplot(exposicion_edad, aes(x = cat_driver_age, y = exposicion)) +  
  geom_histogram( stat =  "identity")+
  scale_y_continuous( labels = scales::comma)+
  xlab("Rango de edad del conductor") +
  ylab("Exposición") +
  ggtitle("Exposición por edad del conductor")

tasa_reclamo_edad <- datos %>%
  group_by(cat_driver_age) %>%
  summarise(claimrate = sum(claim_count) / sum(exposure))

ggplot(tasa_reclamo_edad, aes(x = cat_driver_age, y = claimrate, group = 1 )) +
  geom_point() +
  geom_line()+
  scale_y_continuous( breaks = seq(0,.22, by =.01), labels = scales::percent)+
  xlab("Rango de edad del conductor") +
  ylab("Tasa de reclamo") +
  ggtitle("Tasa de reclamo por categoría de edad")

Para construir nuestro modelo GLM para el recuento de reclamaciones usaremos una función de enlace de Poisson para estimar nuestros coeficientes de regresión. Ya que esperamos que nuestras estimaciones se ven afectadas por la tasa de siniestros esperada.

Supongamos \(N_i\), es el número de reclamos de la póliza \(i\) en un año. Si asumimos que esta se distribuye poisson, tenemos que:

\[N_i \sim \mathcal{P}(\alpha_i) \]

donde \(\alpha_i\) es la tasa de reclamo anual para la póliza \(i\).

Si la póliza \(i\) solo tiene exposición \(E_i < 1\) año, entonces \(\alpha_i\) no es observable (No cumple con lo anual), por ello hay que ponderarla acorde con su exposición \(E_i\)

Por lo tanto:

\[ N_i \sim \mathcal{P}(\lambda_i \, E_i). \]

Además, sabemos la función liga para la regresión possion es:

\[ \lambda_i = e^{(X_i \beta)} \]

Sustityuyendo tenemos que:

\[ N_i \sim \mathcal{P}(e^{(X_i \beta)} \, E_i). \]

\[ N_i \sim \mathcal{P}(e^{(X_i \beta)} \,e^{log(E_i)} ). \]

\[ N_i \sim \mathcal{P}(e^{X_i \beta + \log E_i}) \].

Si notamos \(X_i \beta + \log E_i\) bajo el propósito de una regresión \(\log E_i\) es el intercepto de la ecuación.

Para entender como funciona el GLM a través de un proceso possion. Estimaremos la tasa de reclamación utilizando solo a través de la categoría de edad del conductor:

model_glm_1 <- glm(claim_count ~ cat_driver_age  
                   , offset = log(exposure)
                   ,family = poisson
                   ,data = datos)

summary(model_glm_1)
## 
## Call:
## glm(formula = claim_count ~ cat_driver_age, family = poisson, 
##     data = datos, offset = log(exposure))
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -0.6508  -0.3700  -0.2694  -0.1526   6.5418  
## 
## Coefficients:
##                        Estimate Std. Error z value Pr(>|z|)    
## (Intercept)            -1.57201    0.03209  -48.99   <2e-16 ***
## cat_driver_age(22,26]  -0.56424    0.04384  -12.87   <2e-16 ***
## cat_driver_age(26,42]  -1.08682    0.03472  -31.30   <2e-16 ***
## cat_driver_age(42,74]  -1.10969    0.03386  -32.77   <2e-16 ***
## cat_driver_age(74,Inf] -1.18209    0.04948  -23.89   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for poisson family taken to be 1)
## 
##     Null deviance: 111053  on 413302  degrees of freedom
## Residual deviance: 110001  on 413298  degrees of freedom
## AIC: 141988
## 
## Number of Fisher Scoring iterations: 6

Hay que notar que la primer categoría de las variables son suprimidas, y sobre esta es que se tiene que interpretar al estimador (OJO solo al signo), por ejemplo todas la categorías de la variable car_driver_age son negativas, ya que los conductores más jóvenes (17,22] son lo que tienen mayor tasa de reclamación.

Para visualizar con el glm, esta capturando el comportamiendo que queremos necesitamos visualizar, el comportamiento marginal de la variables sobre el modelo.

plot(Effect("cat_driver_age",model_glm_1))

Observamos el comportamiento es similar al real, sin embargo las tasas son menores a lo que esperabamos

Ahora siendo el mismo ejericio pero aplicando un árbol de decisión tenemos que:

model_dt_1 <- rpart(as.matrix(datos[,c("exposure","claim_count")]) ~ cat_driver_age , 
                    data=datos,method="poisson",
                    control = rpart.control(minsplit = 2, minbucket = 1, cp = 0.0001,
                                            maxdepth = 2))

rpart.plot(model_dt_1)

En este caso vemos que las tasas generadas son como las reales, e incluso se brinda una nueva opción de agrupamiento para mayores de 26 años y menores de 26 (inluyendo 26 en el último caso).

1.4 Modelo para estimar la severidad

reclamo_edad <- datos %>%
  group_by(cat_driver_age) %>%
  summarise(siniestro = sum(claim_amount))

ggplot(reclamo_edad, aes(x = cat_driver_age, y = siniestro)) +
  geom_histogram( stat = "identity")+
  scale_y_continuous( labels = scales::comma)+
  xlab("Rango de edad del conductor") +
  ylab("Monto de reclamo") +
  ggtitle("Monto reclamo por categoría de edad") 

model_glm_2 <- glm(claim_amount ~ cat_driver_age  
                   ,family = Gamma(link = 'log')
                   ,data = datos %>% filter( claim_amount > 0),
                   weights = claim_count)


summary(model_glm_2)
## 
## Call:
## glm(formula = claim_amount ~ cat_driver_age, family = Gamma(link = "log"), 
##     data = datos %>% filter(claim_amount > 0), weights = claim_count)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -4.1408  -0.5246   0.0055   0.0810   2.6830  
## 
## Coefficients:
##                        Estimate Std. Error t value Pr(>|t|)    
## (Intercept)             7.09077    0.02337 303.416  < 2e-16 ***
## cat_driver_age(22,26]  -0.04709    0.03193  -1.475  0.14022    
## cat_driver_age(26,42]  -0.07665    0.02528  -3.032  0.00244 ** 
## cat_driver_age(42,74]  -0.04697    0.02466  -1.905  0.05678 .  
## cat_driver_age(74,Inf]  0.02856    0.03603   0.793  0.42804    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for Gamma family taken to be 0.5303109)
## 
##     Null deviance: 10953  on 15523  degrees of freedom
## Residual deviance: 10942  on 15519  degrees of freedom
## AIC: 272196
## 
## Number of Fisher Scoring iterations: 5

De manera análoga al modelo de frecuencia, hay que notar que la primer categoría de la variable es suprimida, y sobre esta es que se tiene que interpretar al estimador (OJO solo al signo), por ejemplo, (74,inf] tiene signo postivio eso quiere decir que la reclamación es mayor que la catgoría base (17-22]

Visualizamos de manera gráfica:

plot(Effect("cat_driver_age",model_glm_2))

Mientras que con un árbol de desición obtenemos que:

model_dt_2 <- rpart::rpart(claim_amount ~ cat_driver_age , 
                    data=datos%>% filter(claim_amount >0),  weights = claim_count,
                    control = rpart.control(minsplit = 2, minbucket = 1, cp = 0.0001,
                                            maxdepth = 2))

rpart.plot(model_dt_2)

1.5 Participiacón:

Acorde con lo visto en clase completar el siguiente código, adjuntar captura de su código funcionando, y el fragmento de código completado.

#### b. Edad del carro #####

exposicion_antiguedad <- datos %>%
  group_by(cat_car_age) %>%
  ******(exposicion = sum(exposure)) 
  ungroup() %>%
  mutate( cat_car_age = factor( cat_car_age, levels = c("[0,1]","(1,4]" , "(4,15]", "(15,Inf]" )))


ggplot(exposicion_antiguedad, aes(x = cat_car_age, y = exposicion)) +
  geom_****( stat =  "identity")+
  ******( labels = scales::comma)+
  xlab("Antigëdad del carro") +
  ylab("Exposición") +
  ggtitle("Exposición por antigüedad del carro") 


tasa_reclamo_antiguedad <- datos %>%
  group_by(cat_car_age) %>%
  summarise(claimrate = sum(claim_count) / sum(exposure))  %>% 
  ungroup() %>%
  mutate( cat_car_age = *****( cat_car_age, levels = c("[0,1]","(1,4]" , "(4,15]", "(15,Inf]" )))

ggplot(tasa_reclamo_antiguedad, aes(x = cat_car_age, y = claimrate, *******)) +
  geom_point() +
  geom_line()+
  scale_y_continuous( labels = scales::percent)+
  xlab("Antigëdad del carro") +
  ylab("Tasa de reclamo") +
  ggtitle("Tasa de reclamo por antigüedad del carro")