Teoria del Riesgo Tarea 1 Ejercicio 13

Ejercicio en R: De la paquetería insuranceData, obtenga los datos de la base AutoClaims, la cual contiene 6,773 observaciones, cada una con cinco variables. La base trata acerca de la ’experiencia en reclamaciones de una aseguradora de propiedad y accidentes del medio oeste (EE. UU.) para pasajeros privados de seguro de automóvil.

ESTADO (STATE): Se utilizan códigos numéricos del 01 al 17. A cada uno se le ha asignado aleatoriamente un estado individual real, mediante un factor con niveles ESTADO 01, ESTADO 02, ESTADO 03, ESTADO 04, ESTADO 05, ESTADO 06, ESTADO 07, ESTADO 08, ESTADO 09, ESTADO 10, ESTADO 11, ESTADO 12, ESTADO s13, ESTADO 14, ESTADO 15, ESTADO 16, ESTADO 17.

CLASE (CLASS): Clasificación clase de operador, basada en edad, sexo, estado civil, uso del vehículo, unfactor con niveles C1, C11, C1A, C1B, C1C, C2, C6, C7, C71, C72, C7A, C7B, C7C, F1, F11, F6, F7, F71.

GÉNERO (GENDER): un factor con niveles F, M.

EDAD (AGE): Edad del operador, un vector numérico.

PAGADO (PAID): Monto pagado para liquidar y cerrar una reclamación, un vector numérico. Las primeras 4 variables son variables independientes (Xi ) y la última de pago es la variable dependiente (Yi ).

llamamos a la base de datos

library(insuranceData) 
data(AutoClaims)

Resumen Datos

str(AutoClaims)

'data.frame':   6773 obs. of  5 variables:
 $ STATE : Factor w/ 13 levels "STATE 01","STATE 02",..: 11 12 12 12 12 12 12 7 11 3 ...
 $ CLASS : Factor w/ 18 levels "C1 ","C11","C1A",..: 7 7 2 16 16 16 2 7 2 2 ...
 $ GENDER: Factor w/ 2 levels "F","M": 2 2 2 1 2 2 2 2 2 2 ...
 $ AGE   : int  97 96 95 95 95 95 94 94 93 93 ...
 $ PAID  : num  1134 3761 7842 2385 650 ...

Todos los incisos e realizan a la variable Yi PAID

PAID=AutoClaims$PAID

I Análisis estadístico descriptivo

Medidas de tendencia centrales

median(PAID) 

[1] 1001.7

summary(PAID)

   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
    9.5   523.7  1001.7  1853.0  2137.4 60000.0 

Inicios de asimetria

Medidas de dispersión

var(PAID)

[1] 7006129

sd(PAID)

[1] 2646.909

range(PAID)

[1]     9.5 60000.0

IQR(PAID)

[1] 1613.67

range(PAID)

[1]     9.5 60000.0

diff(range(PAID))

[1] 59990.5

Medidas de formas

Usamos libreria moments

library(moments)
sesgo=skewness(PAID)
sesgo

[1] 6.235669

sesgo > 0: La curva es asimétricamente positiva por lo que los valores se tienden a reunir más en la parte izquierda que en la derecha de la media.

kurtosis_1=kurtosis(PAID)
kurtosis_1

[1] 87.27753

kurtosis_1 > 3 la distribución es Leptocúrtica principios de asimetria datos sesgados a la derecha

II BLOXPLOT

Realiza un boxplot de la variable de Pago. Adicionalmente, genera tablas de agregación por cada variable explicativa (Xi )

PAID

a = boxplot(PAID,col="darkblue",main="PAGO",col.main="BLUE",lwd=2)

Datos sesgados a la derecha Datos atipicos a la derecha

Tablas de agregación por cada variable explicativa Xi

library(ggplot2)
library(dplyr)

STATE

ggplot(AutoClaims, aes(x=as.factor(STATE), y=PAID, fill=STATE)) +
  geom_boxplot() +
  labs(title="'PAGO ~ ESTADO'.",
       subtitle = "Boxplot",
       x="STATE",
       y="PAID") +
  theme_bw() +
  theme(legend.position="none")

CLASS

ggplot(AutoClaims, aes(x=as.factor(CLASS), y=PAID, fill=CLASS)) +
  geom_boxplot() +
  labs(title="'PAGO ~ CLASE'.",
       subtitle = "Boxplot",
       x="CLASS",
       y="PAID") +
  theme_bw() +
  theme(legend.position="none")

GENDER

ggplot(AutoClaims, aes(x=as.factor(GENDER), y=PAID, fill=GENDER)) +
  geom_boxplot() +
  labs(title="'PAGO ~ GENERO'.",
       subtitle = "Boxplot",
       x="GENDER",
       y="PAID") +
  theme_bw() +
  theme(legend.position="none")

AGE

ggplot(AutoClaims, aes(x=as.factor(AGE), y=PAID, fill=AGE)) +
  geom_boxplot() +
  labs(title="'PAGO ~ EDAD'.",
       subtitle = "Boxplot",
       x="AGE",
       y="PAID") +
  theme_bw() +
  theme(legend.position="none")

III Densidad Empírica Yi PAID

Realiza un gráfico de la densidad empírica de los datos de la variable dependiente (Yi) PAID ¿Tiene forma de alguna distribución teórica conocida? ¿Con qué parámetro(s)? Densidad empirica Limitamos el rango de 0 a 20,000 para apreciar mejor las graficas Parece una variable aleatoria de perdida de cola pesada Gamma, Lognormal, Weibull, pareto

library(actuar)
hist(AutoClaims$PAID,freq=F,breaks = 200,col="yellow",main="Histograma de Pagos",col.main="BLUE",xlim = c(0,20000))
d<-density(PAID)
lines(d,col="black",lwd=1.5)

curve(dgamma(x,0.5,0),0,20000,add=T,col="darkorange",lwd=1.5)
curve(dlnorm(x,7,1),0,20000,add=T,col="deeppink",lwd=1.5)

curve(dweibull(x,1,180),0,20000,add=T,col="blue",lwd=1.5)
curve(dpareto1(x,5,682),0,20000,add=T,col="purple",lwd=1.5)

legend("topright",c("densidad","gamma(1,1)","lognormal(7,1)","weibull(1,180)","pareto(5,682)"),
       col=c("black","darkorange","deeppink","blue","purple"),
       lwd=c(1.5,1.5,1.5,1.5,1.5,1.5))

Carga la paquetería fitdistrplus (la estarás utilizando en varios incisos posteriores).

library(fitdistrplus)
library(MASS)
library(survival)

IV Diagrama de Cullen and Frey

IV Investiga acerca del diagrama de Cullen and Frey y su aplicación dentro del ajuste de distribuciones.

Utilizando la función descdist, genera un diagrama de este tipo con los datos de la variable de pago y da suinterpretación.

Para determinar el modelo de distribución que puede seguir este conjunto de datos se creo el grafico de Cullen and Frey que muestra a qué tipo de distribución los datos se asemejan más. Por lo que se genero 800 valores de arranque para determinar la ubicación de las observaciones (punto azul) y su aproximacion a la distribucion mas cercana

Grafica el sesgo vs curtosis

descdist(PAID,boot = 800)

summary statistics
------
min:  9.5   max:  60000 
median:  1001.7 
mean:  1853.035 
estimated sd:  2646.909 
estimated skewness:  6.23705 
estimated kurtosis:  87.34067 

El gráfico señala que la distribución de los datos experimentales siguen la distribución gamma, una weibull, lognormal puesto que el conjunto de datos se encuentran cerca a las formas que indican dichas distribuciones.

V Ajuste de datos

V Utiliza ahora un ajuste considerando la(s) distribución(es) obtenida(s) en el inciso anterior con respecto ala función fitdist (individualmente por distribución) de la paquetería ya cargada y guardar cada ajuste en una variable diferente (en caso de ser más de un ajuste).

LOGNORMAL

Segun el qqplot tendriamos un buen ajuste

f1<-fitdist(PAID,"lnorm")

$start.arg
$start.arg$meanlog
[1] 6.955611

$start.arg$sdlog
[1] 1.070953


$fix.arg
NULL

plot(f1)

f1

Fitting of the distribution ' lnorm ' by maximum likelihood 
Parameters:

Segun el qqplot tendriamos seria un buen ajuste

GAMMA

f2 = fitdist(PAID,"gamma",method="mme")

$start.arg
$start.arg$shape
[1] 0.4901772

$start.arg$rate
[1] 0.0002645267


$fix.arg
NULL

plot(f2)

f2

Fitting of the distribution ' gamma ' by matching moments 
Parameters:

Segun el qqplot tendriamos no seria un buen ajuste

WEIBULL

f3<-fitdist(PAID,"weibull")

$start.arg
$start.arg$shape
[1] 1.120414

$start.arg$scale
[1] 1747.84


$fix.arg
NULL

plot(f3)

f3

Fitting of the distribution ' weibull ' by maximum likelihood 
Parameters:

Segun el qqplot tendriamos no seria un buen ajuste

VI Criterio de Akaike (AIC) y Criterio Bayesiano (BIC)

Investiga acerca del ‘Criterio de Akaike (AIC) y Criterio Bayesiano (BIC)’ y posteriormente genera una tabla de comparación con los AIC o BIC (como tú prefieras) obtenidos para los ajustes. Con base en la tabla anterior determina cuál es la distribución con mejor ajuste ¿Es la misma distribución que tú propusisteen en incisos anteriores? En caso ser diferente a la propuesta, ¿por qué crees que fue así? (simplemente queremos tu opinión).

tabla_AIC_BIC = data.frame(c(f1$aic,f1$bic),c(f2$aic,f2$bic),c(f3$aic,f3$bic))
rownames(tabla_AIC_BIC) = c("AIC","BIC")
colnames(tabla_AIC_BIC) = c("LOGNORMAL","GAMMA","WEIBULL")
#imprimir resultado
tabla_AIC_BIC

El AIC mide el desajuste entre una distribución hipotética y una distribución teórica

Elegir como función depérdida (o criterio de especificación) el mínimo del criterio de información AIC

Tomamos aquella con el AIC y BIC mas pequeño, para tener el menor desajuste

En este caso seria l modeo f1, una lognoormal (6.95,1.07)

No es la misma distribucion, los parametros son distintos

VII Comparacion entre densidad empirica y densidad ajustada

VII Con la distribución ajustada, danos los parámetros del modelo y además genera una gráfica en donde tengas tu densidad empírica y la función de distribución acumulada empalmadas, y por último comparalas y justifica.

log normal parametros Mean=6.955611, Sd=1.070953 lo recortamos hasta 20000 para tener una mejor aprecviacion de las grafgicas

hist(AutoClaims$PAID,freq=F,breaks = 200,col="yellow",main="Comparacion entre densidad empirica y densidad ajustada",col.main="BLUE",xlim = c(0,20000))
# densidad empirica
densidad_empirica=density(PAID)
lines(densidad_empirica,col="red",lwd=2)

# log normal parametros Mean=6.955611, Sd=1.070953 
curve(dlnorm(x,f1$estimate[1],f1$estimate[2]),0,20000,add=TRUE,col="blue",lwd=2)
legend("topright",c("densidad empirica","lognormal(6.9561,1.0709)"),
       col=c("red","blue"),
       lwd=c(2,2))

Aparentemente es un buen ajuste de no ser por los datos apiticos del 1000 a 2000 Al trabajar con datos reales pasa esto