Dataset
Trabajaremos con los datosfreMTPLfreq (renombrada como CONTRACTS), disponibles en el paquete CASdatasets (install.packages("CASdatasets", repos = "http://cas.uqam.ca/pub/", type="source")). Este conjunto de datos contiene información sobre un portafolio de seguros de automóviles de una aseguradora en Francia.
Tenemos 413,169 observaciones de las siguientes 10 variables:
PolicyID: ID de la póliza.ClaimNB: Número de reclamaciones durante el periodo de exposición.Exposure: Exposición de l póliza (en años).Power: Variable categórica que indica la potencia del auto.CarAge: Antigüedad del auto en años.DriveAge: Edad del conductor en años.Brand: Marca del auto. Puede ser uno de los siguientes grupos:A(Renaut Nissan y Citroen),B(Volkswagen, Audi, Skoda y Seat),C(Opel, General Motors y Ford),D(Fiat),E(Mercedes Chrysler y BMW),F(Japonés (a excepción de Nissan) y Koreano),G(otros).Gas: Indica si el auto consume gasolina regular o Diesel.Region: Región de la póliza en Francia. Basado en la clasificación usada entre 1970 y 2015.Density: Densidad de población (número de habitantes por km cuadrado) en la ciudad donde habita el dueño/conductor del auto.
library(CASdatasets)
data("freMTPLfreq")
CONTRACTS <- freMTPLfreq
attach(CONTRACTS)
str(CONTRACTS)
'data.frame': 413169 obs. of 10 variables:
$ PolicyID : Factor w/ 413169 levels "1","2","3","4",..: 1 2 3 4 5 6 7 8 9 10 ...
$ ClaimNb : int 0 0 0 0 0 0 0 0 0 0 ...
$ Exposure : num 0.09 0.84 0.52 0.45 0.15 0.75 0.81 0.05 0.76 0.34 ...
$ Power : Factor w/ 12 levels "d","e","f","g",..: 4 4 3 3 4 4 1 1 1 6 ...
$ CarAge : int 0 0 2 2 0 0 1 0 9 0 ...
$ DriverAge: int 46 46 38 38 41 41 27 27 23 44 ...
$ Brand : Factor w/ 7 levels "Fiat","Japanese (except Nissan) or Korean",..: 2 2 2 2 2 2 2 2 1 2 ...
$ Gas : Factor w/ 2 levels "Diesel","Regular": 1 1 2 2 1 1 2 2 2 2 ...
$ Region : Factor w/ 10 levels "Aquitaine","Basse-Normandie",..: 1 1 8 8 9 9 1 1 8 6 ...
$ Density : int 76 76 3003 3003 60 60 695 695 7887 27000 ...#Categorizamos DriverAge, CarAge y Density
CONTRACTS_cat <- CONTRACTS
CONTRACTS_cat$DriverAge <- cut(CONTRACTS$DriverAge,c(17,22,26,42,74,Inf))
CONTRACTS_cat$CarAge <- cut(CONTRACTS$CarAge,c(0,1,4,15,Inf), include.lowest = TRUE)
CONTRACTS_cat$Density <- cut(CONTRACTS$Density,c(0,40,200,500,4500,Inf),include.lowest = TRUE)
Análisis descriptivo
En esta sección nos enfocaremos en la variable ClaimNb (que será la variable respuesta) y cómo se ve afectada por los distintos valores del resto de las variables (variables explicativas), especialmente por Region, Gas, DriverAge y Density.
El número de reclamaciones es similar sin importar si el auto consume gasolina regular o diesel, pues no se muestra una evidente diferencia en las proporciones de cada categoría. En la siguiente tabla se muestran el conteo según el tipo de combustible que usa el auto y el número de reclamaciones.
| 0 | 1 | 2 | 3 | 4 | |
|---|---|---|---|---|---|
| Diesel | 197904 | 7655 | 369 | 15 | 2 |
| Regular | 199875 | 6978 | 357 | 13 | 1 |
En la gráfica anterior podemos notar que la región Centre acumula la mayor cantidad de reclamaciones, mientras que las regiones Poitou-Charentes, Nord-Pas-de Calais y Aquitaine tienen un número similar de reclamaciones acumuladas, al igual que Limousin y Haute-Normandie. Sin embargo, este resultado no nos asegura que una póliza de la región Centre tenga más probabilidad de tener una reclamación, pues deberíamos tomar en cuenta qué porcentaje de pólizas pertenecen a esta región así como su exposición. Para tomar en cuenta este factor, nos debemos fijar en la proporción de reclamaciones respecto a la exposición de cada región.. La tabla siguiente nos muestra dichos porcentajes.
| Region | expos | totalCl | totalCl_expos |
|---|---|---|---|
| Aquitaine | 14322 | 1055 | 0.074 |
| Basse-Normandie | 6658 | 452 | 0.068 |
| Bretagne | 27753 | 1871 | 0.067 |
| Centre | 102713 | 6475 | 0.063 |
| Haute-Normandie | 3178 | 220 | 0.069 |
| Ile-de-France | 30209 | 2591 | 0.086 |
| Limousin | 2396 | 197 | 0.082 |
| Nord-Pas-de-Calais | 11498 | 944 | 0.082 |
| Pays-de-la-Loire | 21934 | 1576 | 0.072 |
| Poitou-Charentes | 11163 | 800 | 0.072 |
Como se puede observar en la tabla los porcentajes son muy similares para cada región (ninguno rebasa el 10%) pero la región Centre es la que tiene el la menor proporción de reclamaciones respecto a su exposición.
Es notorio que existe una mayor diferencia en el número de reclamaciones acumuladas de conductores en el grupo de edad de 42 a 74 años con el grupo de 17 a 22 años, mientras que este último grupo es más similar al de 22 a 26 años. Esto da un indicio sobre qué categorías son más significativas para explicar el número de reclamaciones.
Notamos que el número de reclamaciones es similar entre las ciudades con una densidad menor a 40 y las que tienen un valor de densidad entre 200 a 500; mientras que las que tienen densidad entre 40 y 200 presentan un mayor número de reclamaciones. Esto contradice la idea intuitiva de que entre mayor densidad de población siempre es mayor el número de reclamaciones.
Ajuste de Distribución para la Frecuencia de reclamaciones
Frecuencia anualizada
Supongamos que la ocurrencia de una reclamación sigue un Proceso Poisson con intensidad \(\lambda\). Entonces, el número de reclamaciones que ocurren durante el periodo \([t,t+h]\) tiene distribución Poisson\((\lambda\cdot h)\). Si nos interesa modelar el número de reclamaciones por póliza que ocurren en un año (\(h=1\)), entonces suponemos que éstas siguen una distribución Poisson\((\lambda)\).
Para la póliza \(i\) el número anualizado de reclamaciones \(N_i\) en el periodo [0,1] (un año completo) es una variable que usualmente no observamos. En su lugar tenemos \(Y_i\) que es el número de reclamaciones que ocurren durante el periodo \([0,E_i]\) donde \(E_i\) es la exposición de la póliza \(i\).
Sin covariables
Sin tomar en cuenta las posibles variables explicativas la frecuencia promedio anualizada se calcula como \[m_N = \frac{\sum_{i=1}^n Y_i}{\sum_{i=1}^n E_i}\] y la varianza empírica es \[S_N^2 = \frac{\sum_{i=1}^n [Y_i-m_N\cdot E_i]^2}{\sum_{i=1}^n E_i}\].
[1] 0.0698[1] 0.074En una distribución Poisson la media es igual a la varianza, por lo que esperamos que el cociente de estas dos cantidades observadas sea cercano a 1. En este caso es \(v/m =\) 1.06.
Con una covariable
El número de reclamaciones de una póliza se ve afectado por distintos factores. Cuando queremos tomar en cuenta alguno de estos, como la región en la que vive el conductor (Region), la frecuencia promedio anualizada se calcula como \[m_{N,x} = \frac{\sum_{i=1, X=x}^n Y_i}{\sum_{i=1, X=x}^n E_i}\] y la varianza empírica es \[S_{N,x}^2 = \frac{\sum_{i=1, X=x}^n [Y_i-m_N\cdot E_i]^2}{\sum_{i=1, X=x}^n E_i}\]
# categorías de la variable Region
levels(Region)
[1] "Aquitaine" "Basse-Normandie" "Bretagne"
[4] "Centre" "Haute-Normandie" "Ile-de-France"
[7] "Limousin" "Nord-Pas-de-Calais" "Pays-de-la-Loire"
[10] "Poitou-Charentes" frec_Region <- data.frame(x=levels(Region),
m_x = rep(NA,10),
v_x = rep(NA,10),
phi = rep(NA,10))
# Media y varianza observad de la frecuencia anualizada
# para cada categoría de Region
for (i in 1:length(levels(Region))) {
Yi <- ClaimNb[Region==levels(Region)[i]]
Ei <- Exposure[Region==levels(Region)[i]]
mi <- frec_Region$m_x[i] <- sum(Yi)/sum(Ei)
vi <- frec_Region$v_x[i] <- sum((Yi-mi*Ei)^2)/sum(Ei)
frec_Region$phi <- vi/mi
}
| Region(x) | m_x | v_x | v_x/m_x |
|---|---|---|---|
| Aquitaine | 0.074 | 0.081 | 1.05 |
| Basse-Normandie | 0.068 | 0.072 | 1.05 |
| Bretagne | 0.067 | 0.070 | 1.05 |
| Centre | 0.063 | 0.065 | 1.05 |
| Haute-Normandie | 0.069 | 0.074 | 1.05 |
| Ile-de-France | 0.086 | 0.095 | 1.05 |
| Limousin | 0.082 | 0.090 | 1.05 |
| Nord-Pas-de-Calais | 0.082 | 0.092 | 1.05 |
| Pays-de-la-Loire | 0.072 | 0.076 | 1.05 |
| Poitou-Charentes | 0.072 | 0.076 | 1.05 |
Regresión Poisson
Se estableció previamente que \(Y_i \sim Poisson(\lambda \cdot E_i)\). Ahora nos interesa estimar el valor de \(\lambda\) y resulta que por el método de máxima verosimilitud, el estimador de \(\lambda\) es justamente la frecuencia promedio anualizada que ya hemos calculado. \[\hat{\lambda}_{mv}=\frac{\sum_{i=1}^n Y_i}{\sum_{i=1}^n E_i}\]
Sabemos que en realidad \(\lambda\) varia dependiendo de la póliza (por características de cada asegurado), por lo que podemos suponer que \(Y_i \sim Poisson(\lambda_i \cdot E_i)\).
Si tomamos en cuenta que el número de reclamaciones de la póliza \(i\) se ve afectado por el valor que tome un conjunto de covariables \(X_i'\) (vector aleatorio) entonces podemos proponer un modelo en el que \(\lambda_i = e^{X'_i \beta}\) (estamos usando el logaritmo como la función link) \[\Rightarrow Y_i \sim Poisson(e^{X'_i \beta+log(E_i)})\]
En este caso podemos ver al logaritmo de la exposición como otra variable explicativa, sin embargo no debemos estimar ningún coeficiente para esta, por lo que es conocida como variable offset.
Para estimar los coeficientes \(\beta\) por máxima verosimilitud podemos usar la función glm (modelos lineales generalizados) especificando la familia como Poisson, family=poisson con el parámetro link="log".
Con covariables categóricas
Usaremos tres variables explicativas Gas, DriverAge y Density categorizadas además de la exposición (Exposure) para explicar el número de reclamaciones ClaimsNb con este modelo.
reg <- glm(ClaimNb~Gas+DriverAge+Density+offset(log(Exposure)),family=poisson(link = "log"),data=CONTRACTS_cat)
summary(reg)
Call:
glm(formula = ClaimNb ~ Gas + DriverAge + Density + offset(log(Exposure)),
family = poisson(link = "log"), data = CONTRACTS_cat)
Deviance Residuals:
Min 1Q Median 3Q Max
-0.766 -0.339 -0.267 -0.149 6.520
Coefficients:
Estimate Std. Error z value Pr(>|z|)
(Intercept) -1.8647 0.0405 -46.1 <2e-16 ***
GasRegular -0.2060 0.0160 -12.8 <2e-16 ***
DriverAge(22,26] -0.6161 0.0461 -13.4 <2e-16 ***
DriverAge(26,42] -1.0797 0.0364 -29.7 <2e-16 ***
DriverAge(42,74] -1.0776 0.0355 -30.4 <2e-16 ***
DriverAge(74,Inf] -1.1071 0.0519 -21.3 <2e-16 ***
Density(40,200] 0.1847 0.0268 6.9 5e-12 ***
Density(200,500] 0.3182 0.0297 10.7 <2e-16 ***
Density(500,4.5e+03] 0.5269 0.0259 20.3 <2e-16 ***
Density(4.5e+03,Inf] 0.6372 0.0348 18.3 <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: 105613 on 413168 degrees of freedom
Residual deviance: 103986 on 413159 degrees of freedom
AIC: 135263
Number of Fisher Scoring iterations: 6El valor estimado como Intercept está asociado a las categorías de referencia de cada variable explicativa. La interpretación del modelo es similar a la de un modelo de regresión lineal pero ahora el cambio entre categorías se ve reflejando por la exponencial de los coeficientes estimados.
Por ejemplo, para un auto que consume Diesel, cuyo conductor tiene entre 17 y 22 años y la densidad de la ciudad del conductor es menor a 40 se espera una frecuencia anualizada de reclamaciones promedio de 0.155.
exp(coefficients(reg)["(Intercept)"])
(Intercept)
0.155 Mientras que para un auto con las mismas características pero que consume gasolina regular se espera una frecuencia anualizada de reclamaciones promedio de 0.126.
# Con las categorías de referencia
ref <- exp(coefficients(reg)["(Intercept)"])
# Cambio en la frecuencia cuando el auto consume gasolina regular
c_gas <- exp(coefficients(reg)["GasRegular"])
# Nueva frecuencia estimada
ref*c_gas
(Intercept)
0.126 # También puede calcularse como:
exp(sum(coefficients(reg)[c("(Intercept)","GasRegular")]))
[1] 0.126Con covariables continuas
En lugar de trabajar con la variable categórica DriverAge podemos usar la variable original (por años en vez de grupos de edad).
El modelo es el siguiente:
#Nuevo modelo con DriverAge como v. explicativa continua
reg.poisson <- glm(ClaimNb~DriverAge+offset(log(Exposure)),family=poisson,data=CONTRACTS)
summary(reg.poisson)
Call:
glm(formula = ClaimNb ~ DriverAge + offset(log(Exposure)), family = poisson,
data = CONTRACTS)
Deviance Residuals:
Min 1Q Median 3Q Max
-0.552 -0.351 -0.268 -0.150 6.441
Coefficients:
Estimate Std. Error z value Pr(>|z|)
(Intercept) -2.151338 0.026235 -82.0 <2e-16 ***
DriverAge -0.011106 0.000558 -19.9 <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: 105613 on 413168 degrees of freedom
Residual deviance: 105206 on 413167 degrees of freedom
AIC: 136467
Number of Fisher Scoring iterations: 6
Podemos comparar las predicciones de este modelo (izquierda) con el modelo en el que DriverAge es variable categórica (derecha). Las líneas verticales sobre la gráfica indican un intervalo de los veces la desviación estándar de las predicciones. La línea horizontal en ambas gráficas indica el valor de la frecuencia anualizada promedio general (\(\hat{\lambda}\)).
Ajuste de Distribución para la Severidad de las reclamaciones
El conjunto de datos freMTPLsev contiene el ID de póliza (PolicyID) y el costo de la reclamación (ClaimAmount) correspondientes a las reclamaciones de la base con la que estamos trabajando (CONTRACTS).
data("freMTPLsev")
# Para unir el dataset que contiene la severidad con el de la frecuencia y caracterísitcas de la póliza.
claims <- merge(freMTPLsev,CONTRACTS)
head(claims,n=4)
PolicyID ClaimAmount ClaimNb Exposure Power CarAge DriverAge
1 33 302 1 0.75 g 1 61
2 41 2001 1 0.14 l 5 50
3 92 1449 1 0.14 d 0 36
4 96 9924 2 0.62 j 0 51
Brand Gas Region Density
1 Japanese (except Nissan) or Korean Regular Ile-de-France 27000
2 Japanese (except Nissan) or Korean Diesel Basse-Normandie 56
3 Japanese (except Nissan) or Korean Regular Ile-de-France 4792
4 Japanese (except Nissan) or Korean Regular Ile-de-France 27000 PolicyID ClaimAmount ClaimNb Exposure Power CarAge DriverAge
1 33 302 1 0.75 g [0,1] (42,74]
2 41 2001 1 0.14 l (4,15] (42,74]
3 92 1449 1 0.14 d [0,1] (26,42]
4 96 9924 2 0.62 j [0,1] (42,74]
Brand Gas Region
1 Japanese (except Nissan) or Korean Regular Ile-de-France
2 Japanese (except Nissan) or Korean Diesel Basse-Normandie
3 Japanese (except Nissan) or Korean Regular Ile-de-France
4 Japanese (except Nissan) or Korean Regular Ile-de-France
Density
1 (4.5e+03,Inf]
2 (40,200]
3 (4.5e+03,Inf]
4 (4.5e+03,Inf]Ajustaremos y compararemos varios modelos basados en distribuciones de pérdida para los datos de severidad (el monto pagado de reclamación). El objetivo es conocer \(E(Y|X=x)\) (la esperanza del monto de reclamación para una póliza con características \(X=x\)) entre otras cosas para, junto con la frecuencia promedio hallada en la sección anterior, obtener una prima pura.
Análisis descriptivo
Podemos tratar de identificar qué variables o categorías de la póliza tienen más influencia sobre el monto de la reclamación graficando ClaimAmount contra las variables explicativas.
(#fig:claimAm_ca)Monto de reclamación (ClaimAmount) según el grupo al que pertenece los años del auto (CarAge).
La mediana del monto de reclamaciones es similar entre los cuatro grupos, sin embargo, el grupo de 4 a 15 años presenta los valores atípicos más altos. El grupo que muestra menor dispersión es el de menor a 1 año.
El grupo de edad de entre 17 y 22 años muestra diferencia en la distribución del monto de reclamación con los dos grupos siguientes; mientras que dichos dos grupos son más similares entre sí. Notamos que el grupo de mayor edad muestra una menor dispersión del monto de reclamación. Estas diferencias entre categorías pueden dar una idea sobre qué categorías serán significativas al ajustar un modelo de regresión.
(#fig:claimAm_gas)Monto de reclamación (ClaimAmount) según el tipo de combustible que consume el auto (Gas).
En general el monto de reclamación es similar sin importar el tipo de combustible que usa el auto, por lo que puede que no sea una variable significativa para tratar de explicar el monto de reclamación.
Modelo Gamma
Es común usar modelos lineales generalizados para ajustar una distribución para la severidad, por lo que usaremos nuevamente la función glm. Una primera opción es ajustar una regresión gamma.
En este modelo usamos las variables CarAge (categorizada) y Gas como variables explicativas.
reg.gamma <- glm(ClaimAmount~CarAge+Gas,family=Gamma(link="log"), data=claims_cat[claims_cat$ClaimAmount<15000,])
summary(reg.gamma)
Call:
glm(formula = ClaimAmount ~ CarAge + Gas, family = Gamma(link = "log"),
data = claims_cat[claims_cat$ClaimAmount < 15000, ])
Deviance Residuals:
Min 1Q Median 3Q Max
-3.344 -0.610 -0.152 -0.064 4.017
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 7.2598 0.0258 281.04 <2e-16 ***
CarAge(1,4] 0.0220 0.0311 0.71 0.4804
CarAge(4,15] -0.0731 0.0273 -2.68 0.0074 **
CarAge(15,Inf] -0.0868 0.0407 -2.13 0.0330 *
GasRegular -0.0187 0.0173 -1.08 0.2786
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
(Dispersion parameter for Gamma family taken to be 1.18)
Null deviance: 13455 on 16005 degrees of freedom
Residual deviance: 13423 on 16001 degrees of freedom
AIC: 262054
Number of Fisher Scoring iterations: 5En el resumen del modelo podemos ver que hay algunas categorías de CarAge que no son significativas.
Modelo Lognormal
Ahora probaremos con una regresión lognormal. En este caso no podemos usar la función glm pero podemos usar lm con log(ClaimAmount) como la variable respuesta.
reg.logn <- lm(log(ClaimAmount)~CarAge+Gas,data=claims_cat[claims_cat$ClaimAmount<15000,])
summary(reg.logn)
Call:
lm(formula = log(ClaimAmount) ~ CarAge + Gas, data = claims_cat[claims_cat$ClaimAmount <
15000, ])
Residuals:
Min 1Q Median 3Q Max
-6.155 -0.258 0.263 0.351 2.867
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 6.848469 0.024827 275.85 <2e-16 ***
CarAge(1,4] -0.000681 0.029914 -0.02 0.9818
CarAge(4,15] -0.081450 0.026228 -3.11 0.0019 **
CarAge(15,Inf] -0.036476 0.039133 -0.93 0.3513
GasRegular -0.022496 0.016613 -1.35 0.1757
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 1.04 on 16001 degrees of freedom
Multiple R-squared: 0.00144, Adjusted R-squared: 0.00119
F-statistic: 5.76 on 4 and 16001 DF, p-value: 0.000125Podemos ver que en este modelo solo una categoría de CarAge resulta ser significativa.
Tarificación con reclamaciones muy grandes
En los modelos anteriores solo tomamos en consideración montos de reclamación menores a 15,000. Veamos qué ocurre cuando usamos todos los datos disponibles.
Ajustaremos una regresión gamma y una regresión lognormal usando DriverAge como variable explicativa continua.
# Regresión gamma
reg.gamma2 <- glm(ClaimAmount~DriverAge,family=Gamma(link="log"),data=claims)
summary(reg.gamma2)$coefficients
Estimate Std. Error t value Pr(>|t|)
(Intercept) 8.09507 0.2035 39.78 0.0000
DriverAge -0.00993 0.0043 -2.31 0.0211# Regresión lognormal
reg.logn2 <- lm(log(ClaimAmount)~DriverAge,data=claims)
summary(reg.logn2)$coefficients
Estimate Std. Error t value Pr(>|t|)
(Intercept) 6.73618 0.027746 242.78 0.000000
DriverAge 0.00204 0.000587 3.47 0.000518Notamos que en ambos modelos los coeficientes son significativos (con \(\alpha=0.05\)) pero en el modelo gamma obtenemos un coeficiente negativo mientras que en el modelo lognormal es positivo. Esto está relacionado con los valores atípicos ya que éstos afectan más al modelo Gamma que al Lognormal. Recordemos que en el modelo Lognormal estamos trabajando con el logaritmo natural de los montos de reclamación, por lo que la escala ayuda a manejar mejor los valores atípicos muy grandes.
Modelo con dos tipos de reclamaciones
Podemos definir una variable \(Z\) que refleje información sobre el tamaño de la reclamación. Digamos que es la indicadora \(Z=0\) si \(Y>s\) y \(Z=1\) si \(Y\leq s\) para alguna \(s>0\). Entonces, \[E(Y)=E(Y|Y>s)\cdot P(Y>s) + E(Y|Y\leq s)\cdot P(Y\leq s)\] y en el caso de la esperanza condicionada a \(X\), \[E(Y|X)=E(Y|Y\leq s,X)\cdot P(Y\leq s|X) + E(Y|Y>s,X)\cdot P(Y>s|X) \]
Analizando por separado cada parte de este último resultado,
- A: \(E(Y|Y\leq s,X)\) Es el costo promedio de una reclamación estándar (excluyendo las que superan \(s\)).
- B: \(E(Y|Y>s,X)\) Es el costo promedio de las reclamaciones grandes (aquellas que superan \(s\)).
- C: \(P(Y\leq s|X)\), \(P(Y>s|X)\) Probabilidad de que una reclamación sea estándar o grande.
Notemos que menos del 2% de las pérdidas superan las 10,000 unidades monetarias por lo que tomaremos \(s=10000\).
s <- 10000
mean(claims$ClaimAmount > s)
[1] 0.017#Columna que indica si la reclamación es estándar (las que son menores a s).
claims$standard <- (claims$ClaimAmount < s)
Para la parte C ajustaremos una regresión logística para modelar la probabilidad de que una reclamación sea estándar.
library(splines)
age <- seq(18,100)
# Ajustamos una regresión logística
regC <- glm(standard~bs(DriverAge),data=claims,family=binomial)
#Predicciones
ypC <- predict(regC,newdata=data.frame(DriverAge=age),type="response",se=TRUE)
#Gráfica
plot(age,ypC$fit,ylim=c(.95,1),type="l",ylab="ypC",)
polygon(c(age,rev(age)),c(ypC$fit+2*ypC$se.fit,rev(ypC$fit-2*ypC$se.fit)), col="grey",border=NA)
abline(h=mean(claims$standard),lty=2)
Figure 1: Probabilidad de que una reclamación sea menor a s dada la edad del conductor.
En la gráfica anterior la línea punteada represanta la probabilidad de que una reclamación sea estándar (sin tomar en cuenta la edad del conductor). El área sombreada abarca el valor obtenido de la probabilidad de que la reclamación sea estándar y dos veces su desviación estándar.
Para las reclamaciones estándar y las reclamaciones grandes ajustaremos dos regresiones gamma.
#Índice de las reclamaciones estándar
index_standard <- which(claims$ClaimAmount < s)
#Valor promedio de una reclamación estándar
mean(claims$ClaimAmount[index_standard])
[1] 1280#Valor promedio de una reclamación grande
mean(claims$ClaimAmount[-index_standard])
[1] 51106# Regresión Gamma para las reclamaciones estándar
regA <- glm(ClaimAmount~bs(DriverAge),data=claims[index_standard,], family=Gamma(link="log"))
ypA <- predict(regA,newdata=data.frame(DriverAge=age),type="response")
# Regresión Gamma para las reclamaciones grandes
regB <- glm(ClaimAmount~bs(DriverAge),data=claims[-index_standard,],family=Gamma(link="log"))
ypB <- predict(regB,newdata=data.frame(DriverAge=age),type="response")
Para comparar los resultados obtenidos al separar las reclamaciones, ajustaremos un modelo de regresión gamma sobre todos los datos.
reg <- glm(ClaimAmount~bs(DriverAge),data=claims,family=Gamma(link="log"))
yp <- predict(reg,newdata=data.frame(DriverAge=age),type="response")
#Gráfica
ggplot(data.frame(age=age,yp=yp,y_ns=ypC$fit*ypA+(1-ypC$fit)*ypB,y_s=ypC$fit*ypA),
aes(x=age,y=yp)) +
geom_line(size=1.1) +
geom_segment(aes(x=age,xend=age,y=0,yend=y_ns),color="#a0d7dd",size=2) +
geom_segment(aes(x=age,xend=age,y=0,yend=y_s),color="#5f9ea0",size=2) +
geom_hline(yintercept = mean(claims$ClaimAmount),linetype=4) +
xlab("Edad del conductor") + ylab("Costo promedio de reclamación") +
theme_bw()
(#fig:reg_completa)Costo promedio de reclamación según la edad del conductor.
En la gráfica anterior la línea punteada es el promedio del monto de reclamación (tomando en cuenta todas las reclamaciones). La línea negra en el fondo es el monto promedio obtenido con la regresión gammma sobre todos los datos (reg). Las líneas verticales más oscuras representan el costo promedio asociado a las reclamaciones estándar, mientras que las líneas azul claro representan el monto promedio asociado a las reclamaciones grandes.