Dados referentes ao número de sinistros registrados por 16483 clientes de uma seguradora de automóveis ao longo de um ano, contemplando as seguintes variáveis:
- Sinistros: Número de sinistros registrados;
- Exposicao: Período de cobertura do cliente durante o ano sob análise;
- Idade: Idade do cliente (em anos);
- Sexo: M para masculino e F para feminino;
- Valor: Valor do veículo segurado (em reais).
Verificação do conteúdo e a estrutura dos dados.
head(dados, 10) ### Dez primeiras linhas da base.
## Idade Sexo Valor Exposicao Sinistros lexpo
## 1 59 F 24.624 0.50 1 -0.6931472
## 2 45 M 23.391 0.70 0 -0.3566749
## 3 42 M 86.639 0.79 0 -0.2357223
## 4 63 F 77.545 0.01 0 -4.6051702
## 5 36 F 25.934 0.51 0 -0.6733446
## 6 33 M 42.704 0.79 0 -0.2357223
## 7 35 M 16.986 0.81 0 -0.2107210
## 8 63 M 19.055 0.01 0 -4.6051702
## 9 54 M 52.374 0.76 0 -0.2744368
## 10 32 M 52.524 0.79 0 -0.2357223
str(dados)
## 'data.frame': 16644 obs. of 6 variables:
## $ Idade : int 59 45 42 63 36 33 35 63 54 32 ...
## $ Sexo : Factor w/ 2 levels "F","M": 1 2 2 1 1 2 2 2 2 2 ...
## $ Valor : num 24.6 23.4 86.6 77.5 25.9 ...
## $ Exposicao: num 0.5 0.7 0.79 0.01 0.51 0.79 0.81 0.01 0.76 0.79 ...
## $ Sinistros: int 1 0 0 0 0 0 0 0 0 0 ...
## $ lexpo : num -0.693 -0.357 -0.236 -4.605 -0.673 ...
Análise descritiva da distribuição do número de sinistros.
table(dados$Sinistros) ### Distribuição do números de sinistros.
##
## 0 1 2 3 4 5
## 15845 605 168 22 3 1
taxageral <- sum(dados$Sinistros)/sum(dados$Exposicao); taxageral ### Taxa de sinistros na amostra.
## [1] 0.09488229
tab <- aggregate(cbind(Exposicao, Sinistros) ~ Sexo, data = dados, sum)
taxa <- with(tab, Sinistros/Exposicao)
tab <- cbind(tab, taxa)
### Distribuição do número de sinistros por sexo.
kable(tab, align = 'c', caption = '**Taxa de sinistros segundo Sexo**')
Taxa de sinistros segundo Sexo
F |
4379.05 |
461 |
0.1052740 |
M |
6413.27 |
563 |
0.0877867 |
dados$idadecat <- cut(dados$Idade, breaks=c(18,30,60, 92), include.lowest = T)
tab <- aggregate(cbind(Exposicao, Sinistros) ~ idadecat, data = dados, sum)
taxa <- with(tab, Sinistros/Exposicao)
tab <- cbind(tab, taxa)
### Distribuição do número de sinistros por sexo.
kable(tab, align = 'c', caption = '**Taxa de sinistros segundo Idade**')
Taxa de sinistros segundo Idade
[18,30] |
465.98 |
46 |
0.0987167 |
(30,60] |
6992.09 |
665 |
0.0951075 |
(60,92] |
3332.43 |
313 |
0.0939255 |
tabidsex <- aggregate(cbind(Exposicao, Sinistros) ~ Sexo + idadecat, data = dados, sum)
taxa <- with(tabidsex, Sinistros/Exposicao)
tabidsex <- cbind(tabidsex, taxa)
### Distribuição do número de sinistros por idade e sexo.
kable(tabidsex, align = 'c', caption = '**Taxa de sinistros segundo Sexo e Idade**')
Taxa de sinistros segundo Sexo e Idade
F |
[18,30] |
274.17 |
29 |
0.1057738 |
M |
[18,30] |
191.81 |
17 |
0.0886294 |
F |
(30,60] |
3047.43 |
318 |
0.1043502 |
M |
(30,60] |
3944.66 |
347 |
0.0879670 |
F |
(60,92] |
1057.43 |
114 |
0.1078086 |
M |
(60,92] |
2275.00 |
199 |
0.0874725 |
Regressão usando o modelo log-linear poisson.
dados <- na.omit(dados)
ajusteps <- glm(Sinistros ~ Sexo+Idade+I(Idade**2)+Valor+offset(log(Exposicao)), data = dados, family=poisson)
summary(ajusteps)
##
## Call:
## glm(formula = Sinistros ~ Sexo + Idade + I(Idade^2) + Valor +
## offset(log(Exposicao)), family = poisson, data = dados)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -0.5766 -0.3929 -0.3642 -0.2969 5.2765
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -1.4397241 0.3795695 -3.793 0.000149 ***
## SexoM -0.1777108 0.0636488 -2.792 0.005237 **
## Idade -0.0383063 0.0149386 -2.564 0.010340 *
## I(Idade^2) 0.0003360 0.0001411 2.382 0.017229 *
## Valor 0.0056734 0.0014868 3.816 0.000136 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for poisson family taken to be 1)
##
## Null deviance: 6580.7 on 16639 degrees of freedom
## Residual deviance: 6552.6 on 16635 degrees of freedom
## AIC: 8290.8
##
## Number of Fisher Scoring iterations: 6
### Estimação do parâmetro de dispersão.
X2 <- sum(resid(ajusteps,type='pearson')**2)
phichap <- X2/ajusteps$df.residual
phichap ### Indicador de superdispersão.
## [1] 2.510161
Diagnóstico do ajuste (gráficos).
##### Diagnóstico do modelo - gráficos.
par(mfrow=c(2,2))
plot(ajusteps)

par(mfrow=c(1,1))
envelope(ajusteps)

Ajuste do modelo associando um parâmetro ao termo offset (log-exposicao)
ajusteps2 <- glm(Sinistros ~ Sexo + Idade +I(Idade**2) + Valor + log(Exposicao), data = dados, family=poisson)
summary(ajusteps2)
##
## Call:
## glm(formula = Sinistros ~ Sexo + Idade + I(Idade^2) + Valor +
## log(Exposicao), family = poisson, data = dados)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -0.5052 -0.3708 -0.3485 -0.3282 5.4678
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -1.8778085 0.3805384 -4.935 0.000000803 ***
## SexoM -0.1864309 0.0636347 -2.930 0.00339 **
## Idade -0.0336108 0.0149183 -2.253 0.02426 *
## I(Idade^2) 0.0003083 0.0001409 2.188 0.02865 *
## Valor 0.0044722 0.0014833 3.015 0.00257 **
## log(Exposicao) 0.1875741 0.0410446 4.570 0.000004877 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for poisson family taken to be 1)
##
## Null deviance: 6370.2 on 16639 degrees of freedom
## Residual deviance: 6325.5 on 16634 degrees of freedom
## AIC: 8065.7
##
## Number of Fisher Scoring iterations: 6
anova(ajusteps, ajusteps2, test = 'Chisq')
## Analysis of Deviance Table
##
## Model 1: Sinistros ~ Sexo + Idade + I(Idade^2) + Valor + offset(log(Exposicao))
## Model 2: Sinistros ~ Sexo + Idade + I(Idade^2) + Valor + log(Exposicao)
## Resid. Df Resid. Dev Df Deviance Pr(>Chi)
## 1 16635 6552.6
## 2 16634 6325.5 1 227.05 < 2.2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Regressão usando a distribuição binomial negativa.
ajustenb2 <- glm.nb(Sinistros ~ Sexo+Idade+I(Idade**2)+Valor+log(Exposicao),data= dados)
summary(ajustenb2)
##
## Call:
## glm.nb(formula = Sinistros ~ Sexo + Idade + I(Idade^2) + Valor +
## log(Exposicao), data = dados, init.theta = 0.119522771, link = log)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -0.4185 -0.3299 -0.3136 -0.2980 2.6745
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -1.8350206 0.4797898 -3.825 0.000131 ***
## SexoM -0.1872978 0.0789426 -2.373 0.017664 *
## Idade -0.0351875 0.0187625 -1.875 0.060736 .
## I(Idade^2) 0.0003238 0.0001770 1.829 0.067366 .
## Valor 0.0044824 0.0018761 2.389 0.016885 *
## log(Exposicao) 0.1970250 0.0479747 4.107 0.0000401 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for Negative Binomial(0.1195) family taken to be 1)
##
## Null deviance: 3220.9 on 16639 degrees of freedom
## Residual deviance: 3189.8 on 16634 degrees of freedom
## AIC: 7485.3
##
## Number of Fisher Scoring iterations: 1
##
##
## Theta: 0.1195
## Std. Err.: 0.0104
##
## 2 x log-likelihood: -7471.2830
Diagnóstico do ajuste (gráficos).
##### Diagnóstico do modelo - gráficos.
par(mfrow=c(2,2))
plot(ajustenb2)

par(mfrow=c(1,1))
envelope(ajustenb2)

Explorando os efeitos das covariáveis. Estimativas pontuais e ICs (95%)
intervalos <- confint(ajustenb2)
## Waiting for profiling to be done...
estimat <- cbind(ajustenb2$coefficients, intervalos)
colnames(estimat)[1] <- 'Estimativa pontual'
### Quadro de estimativas
kable(round(estimat, 5), align = 'c', caption = '**Estimativas pontuais e intervalos de confiança - Modelo Binomial Negativo**')
Estimativas pontuais e intervalos de confiança - Modelo Binomial Negativo
(Intercept) |
-1.83502 |
-2.79221 |
-0.88666 |
SexoM |
-0.18730 |
-0.34165 |
-0.03281 |
Idade |
-0.03519 |
-0.07236 |
0.00230 |
I(Idade^2) |
0.00032 |
-0.00003 |
0.00067 |
Valor |
0.00448 |
0.00070 |
0.00825 |
lexpo |
0.19703 |
0.10298 |
0.29527 |
Gráficos de efeitos
efeitos <- allEffects(ajustenb2, given.values=c(lexpo=0))
trellis.par.set(list(axis.text = list(cex = 1.2)))
plot(efeitos[[2]], type='response',main=list(
label="Taxa de sinistros vs. Idade",
cex=1.5),
xlab=list(
label="Idade (anos)",
cex=1.5),
ylab=list(
label="Taxa de sinistros",
cex=1.5))

plot(efeitos[[1]], type='response',main=list(
label="Taxa de sinistros vs. Sexo",
cex=1.5),
xlab=list(
label="Sexo",
cex=1.5),
ylab=list(
label="Taxa de sinistros",
cex=1.5))

plot(efeitos[[4]], type='response',main=list(
label="Taxa de sinistros vs. Valor do automóvel",
cex=1.5),
xlab=list(
label="Valor (x1000 reais)",
cex=1.5),
ylab=list(
label="Taxa de sinistros",
cex=1.5))

Comparação dos ajustes
kable(matfreq, format = "markdown", caption = "Frequências amostrais e frequências ajustadas para o número de sinistros")
Amostra |
15841 |
605 |
168 |
22 |
3 |
1 |
0 |
0 |
0 |
0 |
0 |
Poisson não ajustada por covariáveis |
15647 |
963 |
30 |
1 |
0 |
0 |
0 |
0 |
0 |
0 |
0 |
Poisson ajustada por covariáveis |
15648 |
960 |
31 |
1 |
0 |
0 |
0 |
0 |
0 |
0 |
0 |
BN não ajustada por covariáveis |
15839 |
636 |
123 |
30 |
8 |
2 |
1 |
0 |
0 |
0 |
0 |
BN ajustada por covariáveis |
15839 |
636 |
122 |
30 |
8 |
2 |
1 |
0 |
0 |
0 |
0 |