Análise sobre as bases motorins e danishlc
Igor Mazzeto Resende Soares
09/07/2022
Leitura do banco de dados
# Dados da base `motorins`
dados_motorins <- read.csv("motorins.dat", sep="")
dados_motorins$Kilometres <- as.factor(dados_motorins$Kilometres)
dados_motorins$Zone <- as.factor(dados_motorins$Zone)
dados_motorins$Make <- as.factor(dados_motorins$Make)
# Removendo a variável payment da base de dados
dados_motorins = subset(dados_motorins, select = -Payment)
# Dados da base `danishlc`
danish <- read.csv("danishlc.dat", sep="")
danish$Age <- factor(danish$Age , levels=c("40-54", "55-59", "60-64", "65-69","70-74",">74"))Análise descritiva
Análise descritiva - base ‘Motorins’
# Histograma taxa de reclamos - base 'Motorins'
par(mfrow=c(3,2))
packHV::hist_boxplot(dados_motorins$Claims / dados_motorins$Insured,
main="Taxa de reclamos",
col="yellow",
xlab="Taxa de reclamos",
ylab = "Freq.")
plot(dados_motorins$Claims / dados_motorins$Insured ~ dados_motorins$Zone,
main="Taxa de reclamos por Zona",
col="dark green",
xlab="Zonas",
ylab = "Taxa de reclamos")
boxplot(dados_motorins$Claims / dados_motorins$Insured ~ dados_motorins$Bonus,
main="Taxa de reclamos por Bonus",
col="light green",
xlab="Bonus",
ylab = "Taxa de Reclamos")
boxplot(dados_motorins$Claims / dados_motorins$Insured ~ dados_motorins$Kilometres,
main="Taxa de reclamos por km percorrido",
col="light blue",
xlab="km",
ylab = "Taxa de Reclamos")
boxplot(dados_motorins$Claims / dados_motorins$Insured ~ dados_motorins$Make,
main="Taxa de reclamos por modelo",
col="light blue",
xlab="Make",
ylab = "Taxa de Reclamos") 
Comentários: as taxas de reclamos na escala possuem difícil visualização devido aos pontos observados fora do intervalo interquartílico, o que indica elevada dispersão e variabilidade dos dados. É possível também verificar na variável de interesse uma assimetria para direita.
Análise descritiva - base ‘danishlc’
par(mfrow=c(2,2))
packHV::hist_boxplot(danish$Cases / danish$Pop,
main="Taxa de câncer de pulmão" ,
col="blue",
xlab="Taxa de câncer de pulmão",
ylab = "Freq.")
boxplot(danish$Cases/danish$Pop ~ danish$Age,
main="Taxa de câncer de pulmão por idade",
col="orange",
xlab="Idade",
ylab = "Taxa de câncer de pulmão")
boxplot(danish$Cases/danish$Pop ~ danish$City,
main="Taxa de câncer de pulmão por cidade",
col="light blue",
xlab="Cidade",
ylab="Taxa de câncer de pulmão")
Comentários: a taxa de câncer de pulmão apresenta elevada dispersão conforme visto no gráfico de histograma. Analisando a distribuição das taxas de câncer de pulmão por idade, indivíduos com idade mais elevada possuem apresentam maior probabilidade de desenvolver a doença. O comportamento da distribuição da taxa em idades superiores a 74 anos chama a atenção devido a sua dispersão. Em relação a taxa por cidade, a mediana da taxa nas cidades Horsens, Kolding e Vejle são próximas. Fredericia é a cidade com maior mediana de taxa de câncer de pulmão. Segundo o Wikipédia, curiosamente a cidade é considerada um dos maiores hubs de transporte da Dinamarca.
Ajuste modelo ‘motorins’
# Ajuste do modelo para 'motorins'
modelo_m = glm(Claims ~ offset(log(Insured)) + Kilometres + Zone + Bonus + Make, data = dados_motorins, family = "poisson")
summary(modelo_m)##
## Call:
## glm(formula = Claims ~ offset(log(Insured)) + Kilometres + Zone +
## Bonus + Make, family = "poisson", data = dados_motorins)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -8.9411 -0.9325 -0.2387 0.6105 9.4199
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -1.739938 0.013630 -127.651 < 2e-16 ***
## Kilometres2 0.204203 0.007511 27.188 < 2e-16 ***
## Kilometres3 0.310530 0.008631 35.977 < 2e-16 ***
## Kilometres4 0.395459 0.012024 32.889 < 2e-16 ***
## Kilometres5 0.567998 0.012801 44.372 < 2e-16 ***
## Zone2 -0.239438 0.009495 -25.216 < 2e-16 ***
## Zone3 -0.389831 0.009668 -40.320 < 2e-16 ***
## Zone4 -0.585540 0.008650 -67.696 < 2e-16 ***
## Zone5 -0.328624 0.014529 -22.618 < 2e-16 ***
## Zone6 -0.529803 0.011874 -44.620 < 2e-16 ***
## Zone7 -0.735746 0.040697 -18.079 < 2e-16 ***
## Bonus -0.198056 0.001288 -153.741 < 2e-16 ***
## Make2 0.078421 0.021239 3.692 0.000222 ***
## Make3 -0.240878 0.025092 -9.600 < 2e-16 ***
## Make4 -0.656632 0.024181 -27.155 < 2e-16 ***
## Make5 0.158690 0.020234 7.843 4.41e-15 ***
## Make6 -0.340402 0.017374 -19.593 < 2e-16 ***
## Make7 -0.056424 0.023343 -2.417 0.015642 *
## Make8 -0.037993 0.031603 -1.202 0.229286
## Make9 -0.068676 0.009955 -6.899 5.25e-12 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for poisson family taken to be 1)
##
## Null deviance: 34070.6 on 2181 degrees of freedom
## Residual deviance: 4025.1 on 2162 degrees of freedom
## AIC: 11703
##
## Number of Fisher Scoring iterations: 4 dados_motorins$Res_Deviance <- residuals(modelo_m, type="deviance")
cat("Qualidade do modelo")## Qualidade do modelo 1 - pchisq(modelo_m$deviance,modelo_m$df.residual)## [1] 0Ajuste modelo ‘danish’
# Ajuste do modelo para 'danish'
modelo_d = glm(Cases ~ offset(log(Pop)) + Age + City, data = danish, family = "poisson")
summary(modelo_d)##
## Call:
## glm(formula = Cases ~ offset(log(Pop)) + Age + City, family = "poisson",
## data = danish)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -2.63573 -0.67296 -0.03436 0.37258 1.85267
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -5.6321 0.2003 -28.125 < 2e-16 ***
## Age55-59 1.1010 0.2483 4.434 9.23e-06 ***
## Age60-64 1.5186 0.2316 6.556 5.53e-11 ***
## Age65-69 1.7677 0.2294 7.704 1.31e-14 ***
## Age70-74 1.8569 0.2353 7.891 3.00e-15 ***
## Age>74 1.4197 0.2503 5.672 1.41e-08 ***
## CityHorsens -0.3301 0.1815 -1.818 0.0690 .
## CityKolding -0.3715 0.1878 -1.978 0.0479 *
## CityVejle -0.2723 0.1879 -1.450 0.1472
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for poisson family taken to be 1)
##
## Null deviance: 129.908 on 23 degrees of freedom
## Residual deviance: 23.447 on 15 degrees of freedom
## AIC: 137.84
##
## Number of Fisher Scoring iterations: 5 danish$Res_Deviance <- residuals(modelo_d,type="deviance")
cat("Qualidade do modelo")## Qualidade do modelo 1 - pchisq(modelo_d$deviance, modelo_d$df.residual)## [1] 0.07509017Análise dos Resíduos
par(mfrow=c(1,2))
plot(dados_motorins$Claims,
dados_motorins$Res_Deviance,
main="Residuos Motorins",
col="blue",
xlab="Deviance",
ylab = "Claims")
plot(danish$Cases,
danish$Res_Deviance,
main="Residuos Danish",
col="red",
xlab="Deviance",
ylab = "Casos")
Interpretação do modelo e comentários
Pra o modelo \(motorins\) assumindo a forma de que o valor esperado de reclamos pode ser escrito como \(E(Claims) = Insured \times e^{\beta_0 + \beta_1 \cdot Kilometer + \beta_2 \cdot Zone + \beta_3 \cdot Bonus + \beta_4 \cdot Make}\), observamos que as variáveis com maior probabilidade de reclamos são:
km acima de 25,000
Modelo tipo 5
É possível verificar que o modelo ajustado para a base \(motorins\) possui uma superdispersão ua vez que o indicador da qualidade do ajuste é zero. Desssa forma seria importante realizar um ajuste para corrigir tal fenômeno.
Para o modelo \(danish\) assumindo a forma de que o valor esperado casos de câncer de pulmão pode ser escrito como \(E(Cases) = Pop \times e^{\beta_0 + \beta_1 \cdot Age + \beta_2 \cdot City}\), observamos que a variável com maior probabilidade de casos é Age>74.
Nota explicativa: não foi realizado nenhum ajuste do modelo devido a qualidade do ajuste. É possível notar superdispersão na base \(motorins\) e baixa qualidade de ajuste em \(danish\).