setwd("C:/Users/Pessoal/Desktop/ESTATÍSTICA/UFPB/8º PERÍODO/REGRESSÃO 2/PROVA 2")
Prova 2 - Regressão II
Questão 1
- O conjunto de dados descrito no arquivo heartdis.txt apresenta as variáveis caso, número do caso (desconsidere esta variável no modelo proposto) x1, pressão sistólica do sangue, x2, uma medida de colesterol, x3, variável dummy = 1 se há histórico na família de doenças cardíacas, x4, uma medida de obesidade, x5, idade e HeartDisease, se o paciente tem doençaa cardíaca (variável resposta).
Definindo o diretório
Carregando o banco de dados
<- read.table("heartdis.txt", sep = ",", dec = ".", col.names = c("caso", "pressão_sistólica", "colesterol","dummy", "obesidade", "idade", "HeartDisease"), header = T) banco
Verificando a categoria das variáveis no banco e removendo a primeira coluna
<- banco[,-1]
banco glimpse(banco)
Rows: 462
Columns: 6
$ pressão_sistólica <int> 160, 144, 118, 170, 134, 132, 142, 114, 114, 132, 20…
$ colesterol <dbl> 5.73, 4.41, 3.48, 6.41, 3.50, 6.47, 3.38, 4.59, 3.83…
$ dummy <int> 1, 0, 1, 1, 1, 1, 0, 1, 1, 1, 0, 1, 0, 0, 1, 1, 0, 1…
$ obesidade <dbl> 25.30, 28.87, 29.14, 31.99, 25.99, 30.77, 20.81, 23.…
$ idade <int> 52, 63, 46, 58, 49, 45, 38, 58, 29, 53, 60, 40, 17, …
$ HeartDisease <int> 1, 1, 0, 1, 1, 0, 0, 1, 0, 1, 1, 1, 0, 0, 0, 0, 0, 1…
$dummy <- as.factor(banco$dummy)
banco$HeartDisease <- as.factor(banco$HeartDisease)
bancoglimpse(banco)
Rows: 462
Columns: 6
$ pressão_sistólica <int> 160, 144, 118, 170, 134, 132, 142, 114, 114, 132, 20…
$ colesterol <dbl> 5.73, 4.41, 3.48, 6.41, 3.50, 6.47, 3.38, 4.59, 3.83…
$ dummy <fct> 1, 0, 1, 1, 1, 1, 0, 1, 1, 1, 0, 1, 0, 0, 1, 1, 0, 1…
$ obesidade <dbl> 25.30, 28.87, 29.14, 31.99, 25.99, 30.77, 20.81, 23.…
$ idade <int> 52, 63, 46, 58, 49, 45, 38, 58, 29, 53, 60, 40, 17, …
$ HeartDisease <fct> 1, 1, 0, 1, 1, 0, 0, 1, 0, 1, 1, 1, 0, 0, 0, 0, 0, 1…
Estatística Descritiva
Visualizando as primeiras linhas do banco
%>%
banco slice_head(n=10) %>%
::gt() gt
pressão_sistólica | colesterol | dummy | obesidade | idade | HeartDisease |
---|---|---|---|---|---|
160 | 5.73 | 1 | 25.30 | 52 | 1 |
144 | 4.41 | 0 | 28.87 | 63 | 1 |
118 | 3.48 | 1 | 29.14 | 46 | 0 |
170 | 6.41 | 1 | 31.99 | 58 | 1 |
134 | 3.50 | 1 | 25.99 | 49 | 1 |
132 | 6.47 | 1 | 30.77 | 45 | 0 |
142 | 3.38 | 0 | 20.81 | 38 | 0 |
114 | 4.59 | 1 | 23.11 | 58 | 1 |
114 | 3.83 | 1 | 24.86 | 29 | 0 |
132 | 5.80 | 1 | 30.11 | 53 | 1 |
::skim(banco) skimr
Name | banco |
Number of rows | 462 |
Number of columns | 6 |
_______________________ | |
Column type frequency: | |
factor | 2 |
numeric | 4 |
________________________ | |
Group variables | None |
Variable type: factor
skim_variable | n_missing | complete_rate | ordered | n_unique | top_counts |
---|---|---|---|---|---|
dummy | 0 | 1 | FALSE | 2 | 0: 270, 1: 192 |
HeartDisease | 0 | 1 | FALSE | 2 | 0: 302, 1: 160 |
Variable type: numeric
skim_variable | n_missing | complete_rate | mean | sd | p0 | p25 | p50 | p75 | p100 | hist |
---|---|---|---|---|---|---|---|---|---|---|
pressão_sistólica | 0 | 1 | 138.33 | 20.50 | 101.00 | 124.00 | 134.00 | 148.00 | 218.00 | ▅▇▃▁▁ |
colesterol | 0 | 1 | 4.74 | 2.07 | 0.98 | 3.28 | 4.34 | 5.79 | 15.33 | ▆▇▂▁▁ |
obesidade | 0 | 1 | 26.04 | 4.21 | 14.70 | 22.98 | 25.80 | 28.50 | 46.58 | ▂▇▃▁▁ |
idade | 0 | 1 | 42.82 | 14.61 | 15.00 | 31.00 | 45.00 | 55.00 | 64.00 | ▅▅▅▆▇ |
Letra A
- Realize o ajuste da regressão logística e selecione as variáveis. O modelo é adequado? Justifique sua escolha.
<- glm(HeartDisease~1, data = banco, family = binomial(link="logit"))
menor <- glm(HeartDisease~pressão_sistólica+colesterol+obesidade+idade+dummy, data = banco, family = binomial(link = "logit"))
maior step(menor, scope = list(upper = maior), direction = "both")
Start: AIC=598.11
HeartDisease ~ 1
Df Deviance AIC
+ idade 1 525.56 529.56
+ dummy 1 561.89 565.89
+ colesterol 1 564.28 568.28
+ pressão_sistólica 1 579.32 583.32
+ obesidade 1 591.53 595.53
<none> 596.11 598.11
Step: AIC=529.56
HeartDisease ~ idade
Df Deviance AIC
+ dummy 1 506.66 512.66
+ colesterol 1 512.48 518.48
<none> 525.56 529.56
+ pressão_sistólica 1 524.44 530.44
+ obesidade 1 525.55 531.55
- idade 1 596.11 598.11
Step: AIC=512.66
HeartDisease ~ idade + dummy
Df Deviance AIC
+ colesterol 1 496.18 504.18
<none> 506.66 512.66
+ pressão_sistólica 1 505.24 513.24
+ obesidade 1 506.63 514.63
- dummy 1 525.56 529.56
- idade 1 561.89 565.89
Step: AIC=504.18
HeartDisease ~ idade + dummy + colesterol
Df Deviance AIC
<none> 496.18 504.18
+ obesidade 1 494.99 504.99
+ pressão_sistólica 1 495.17 505.17
- colesterol 1 506.66 512.66
- dummy 1 512.48 518.48
- idade 1 537.91 543.91
Call: glm(formula = HeartDisease ~ idade + dummy + colesterol, family = binomial(link = "logit"),
data = banco)
Coefficients:
(Intercept) idade dummy1 colesterol
-4.35183 0.05476 0.88199 0.16980
Degrees of Freedom: 461 Total (i.e. Null); 458 Residual
Null Deviance: 596.1
Residual Deviance: 496.2 AIC: 504.2
Resultado:
Após o procedimento da seleção de variáveis é observado que o modelo final ficou apenas com as seguintes variáveis: idade
, sendo a idade do paciente, colesterol
, conforme descrito acima que é uma medida de colesterol e dummy
, que é igual a 1, se existe na família do paciente histórico de doenças cardíacas.
Ajustando o modelo e verificando se é adequado
<- glm(HeartDisease~idade+dummy+colesterol, data = banco, family = binomial(link="logit"))
fit <- summary(fit)$dispersion
phi11 <- summary(fit)$deviance/phi11
desvio11 <- qchisq(0.95, desvio11) q.quadr11
Modelo | |
---|---|
Desvio/\phi | 496.1802755 |
\chi^2 | 549.107924 |
Temos do resultado acima que: O modelo em análise foi aceito.
<-summary(fit)
ajuste::kable(ajuste$coefficients) knitr
Estimate | Std. Error | z value | Pr(>|z|) | |
---|---|---|---|---|
(Intercept) | -4.3518333 | 0.4912572 | -8.858564 | 0.0000000 |
idade | 0.0547551 | 0.0090766 | 6.032564 | 0.0000000 |
dummy1 | 0.8819917 | 0.2194687 | 4.018758 | 0.0000585 |
colesterol | 0.1697957 | 0.0534461 | 3.176950 | 0.0014883 |
A equação é dada por:
log \left (\frac{\pi_1}{1-\pi_1} \right) = -4.352 + 0.055 \hspace{0.1cm}. \hspace{0.1cm}idade_i + 0.882\hspace{0.1cm} . \hspace{0.1cm}histórico_i + 0.1698\hspace{0.1cm} . \hspace{0.1cm}colesterol_i Resposta final:
Podemos observar que o modelo ajustado é adequado, e que todas as variáveis independentes foram importantes para o modelo, pois no teste em que a hipótese nula é de que \beta_i = 0, essa hipótese foi rejeitada para todas as variáveis independentes do modelo ajustado.
Letra B
- Faça a curva ROC do modelo. O que você pode concluir sobre o ajuste do modelo?
::ROC(form = HeartDisease~idade+dummy+colesterol, plot = "ROC", MX = TRUE, data = banco) Epi
Resposta:
A curva ROC fornece que o modelo ficou bem ajustado, pois a suavização da curva fica evidente através da análise gráfica.
Letra C
- Construa um envelope para os resíduos. Há algum ponto que não pertence ao envelope? Se sim, qual(is)?
par(mfrow=c(1,1))
<- model.matrix(fit)
X <- nrow(X)
n <- ncol(X)
p <- fit$weights
w <- diag(w)
W <- solve(t(X)%*%W%*%X)
H <- sqrt(W)%*%X%*%H%*%t(X)%*%sqrt(W)
H <- diag(H)
h <- resid(fit,type="deviance")/sqrt(1-h)
td <- matrix(0,n,100)
e #
for(i in 1:100){
<- runif(n) - fitted(fit)
dif >= 0 ] <- 0
dif[dif <0] <- 1
dif[dif<- dif
nresp <- glm(nresp ~ X, family=binomial)
fit <- fit$weights
w <- diag(w)
W <- solve(t(X)%*%W%*%X)
H <- sqrt(W)%*%X%*%H%*%t(X)%*%sqrt(W)
H <- diag(H)
h <- sort(resid(fit,type="deviance")/sqrt(1-h))}
e[,i] #
<- numeric(n)
e1 <- numeric(n)
e2 #
for(i in 1:n){
<- sort(e[i,])
eo <- (eo[2]+eo[3])/2
e1[i] <- (eo[97]+eo[98])/2}
e2[i] #
<- apply(e,1,mean)
med <- range(td,e1,e2)
faixa par(pty="s")
qqnorm(td,xlab="Percentil da N(0,1)",
ylab="Componente do Desvio", ylim=faixa, pch=16)
#
par(new=T)
#
qqnorm(e1,axes=F,xlab="",ylab="",type="l",ylim=faixa,lty=1)
par(new=T)
qqnorm(e2,axes=F,xlab="",ylab="", type="l",ylim=faixa,lty=1)
par(new=T)
qqnorm(med,axes=F,xlab="", ylab="", type="l",ylim=faixa,lty=2)
Resposta:
Não, aparentemente não existe nenhum ponto fora do envelope.
Letra D
- Construa um intervalo de confiança de 90% para os parâmetros do modelo.
Na construção do envelope o objeto que tinha sido modelado acima foi renomeado, por isso precisamos ajustar o mesmo modelo só que com um nome diferente.
<- glm(HeartDisease~idade+dummy+colesterol, data = banco, family = binomial(link="logit"))
fit2 ::kable(confint(fit2,level = 0.90)) knitr
Waiting for profiling to be done...
5 % | 95 % | |
---|---|---|
(Intercept) | -5.1911111 | -3.5725014 |
idade | 0.0401443 | 0.0700499 |
dummy1 | 0.5221366 | 1.2447973 |
colesterol | 0.0830075 | 0.2593495 |
Letra E
- Interprete o coeficiente \beta_5 da idade. Mantendo-se as outras variáveis constantes, o acréscimo de um ano na idade do paciente aumenta (ou diminui) em quanto a chance do paciente desenvolver uma doença cardíaca?
Resposta:
Como foi analisado no ajuste acima, com o aumento de uma unidade da idade a chance do paciente desdenvolver uma doença cardíaca aumenta em 0.0548.
Questão 2
- Considere o banco de dados Prestige do pacote carData do R que fornece 102 observações com seis variáveis das quais iremos utilizar apenas as variáveis: prestige (variável resposta) score de prestígio de Pineo-Porter para a ocupação, de uma pesquisa social feita nos meados dos anos 60, income, renda média, em dólares em 1971 e education, média, em anos, de estudo para a determinada educação.
Verificando a categoria das variáveis no banco
glimpse(carData::Prestige)
Rows: 102
Columns: 6
$ education <dbl> 13.11, 12.26, 12.77, 11.42, 14.62, 15.64, 15.09, 15.44, 14.5…
$ income <int> 12351, 25879, 9271, 8865, 8403, 11030, 8258, 14163, 11377, 1…
$ women <dbl> 11.16, 4.02, 15.70, 9.11, 11.68, 5.13, 25.65, 2.69, 1.03, 0.…
$ prestige <dbl> 68.8, 69.1, 63.4, 56.8, 73.5, 77.6, 72.6, 78.1, 73.1, 68.8, …
$ census <int> 1113, 1130, 1171, 1175, 2111, 2113, 2133, 2141, 2143, 2153, …
$ type <fct> prof, prof, prof, prof, prof, prof, prof, prof, prof, prof, …
Estatística Descritiva
Visualizando as primeiras linhas do banco
::Prestige %>%
carDataslice_head(n=10) %>%
::gt() gt
education | income | women | prestige | census | type |
---|---|---|---|---|---|
13.11 | 12351 | 11.16 | 68.8 | 1113 | prof |
12.26 | 25879 | 4.02 | 69.1 | 1130 | prof |
12.77 | 9271 | 15.70 | 63.4 | 1171 | prof |
11.42 | 8865 | 9.11 | 56.8 | 1175 | prof |
14.62 | 8403 | 11.68 | 73.5 | 2111 | prof |
15.64 | 11030 | 5.13 | 77.6 | 2113 | prof |
15.09 | 8258 | 25.65 | 72.6 | 2133 | prof |
15.44 | 14163 | 2.69 | 78.1 | 2141 | prof |
14.52 | 11377 | 1.03 | 73.1 | 2143 | prof |
14.64 | 11023 | 0.94 | 68.8 | 2153 | prof |
::skim(carData::Prestige) skimr
Name | carData::Prestige |
Number of rows | 102 |
Number of columns | 6 |
_______________________ | |
Column type frequency: | |
factor | 1 |
numeric | 5 |
________________________ | |
Group variables | None |
Variable type: factor
skim_variable | n_missing | complete_rate | ordered | n_unique | top_counts |
---|---|---|---|---|---|
type | 4 | 0.96 | FALSE | 3 | bc: 44, pro: 31, wc: 23 |
Variable type: numeric
skim_variable | n_missing | complete_rate | mean | sd | p0 | p25 | p50 | p75 | p100 | hist |
---|---|---|---|---|---|---|---|---|---|---|
education | 0 | 1 | 10.74 | 2.73 | 6.38 | 8.45 | 10.54 | 12.65 | 15.97 | ▆▇▆▃▆ |
income | 0 | 1 | 6797.90 | 4245.92 | 611.00 | 4106.00 | 5930.50 | 8187.25 | 25879.00 | ▇▇▁▁▁ |
women | 0 | 1 | 28.98 | 31.72 | 0.00 | 3.59 | 13.60 | 52.20 | 97.51 | ▇▂▂▂▂ |
prestige | 0 | 1 | 46.83 | 17.20 | 14.80 | 35.23 | 43.60 | 59.28 | 87.20 | ▃▇▅▅▂ |
census | 0 | 1 | 5401.77 | 2644.99 | 1113.00 | 3120.50 | 5135.00 | 8312.50 | 9517.00 | ▆▆▃▂▇ |
Letra A
- Faça o gráfico de dispersão da variável resposta prestige pelas variáveis explicativas income e education.
::ggplot(carData::Prestige, ggplot2::aes(x = income, y = prestige)) +
ggplot2::geom_point()+
ggplot2::xlab("Renda média em Doláres") +
ggplot2::ylab("Score do prestígio") +
ggplot2::labs(title = "Gráfico de dispersão entre o Score do Prestígio Pineo-Porter com relação a renda média", subtitle = "Pesquisa social realizada em meados dos anos 60.") ggplot2
::ggplot(carData::Prestige, ggplot2::aes(x = education, y = prestige)) +
ggplot2::geom_point()+
ggplot2::xlab("média em anos de estudo") +
ggplot2::ylab("Score do prestígio") +
ggplot2::labs(title = "Gráfico de dispersão entre o Score do Prestígio Pineo-Porter com relação a média em anos de estudo", subtitle = "Pesquisa social realizada em meados dos anos 60.") ggplot2
Letra B
- Realize o ajuste de um modelo GAM com a variável resposta prestige tendo uma distribuição Normal. Faça o gráfico das funções de suavização.
Verificando a distribuição dos dados da variável prestige, se tem um bom ajuste considerando a distribuição normal.
::ggplot(carData::Prestige, ggplot2::aes(prestige))+
ggplot2::geom_histogram(fill='white',
ggplot2color = "black",
breaks = hist(carData::Prestige$prestige, plot = F)$breaks) +
::xlab("Score do Prestígio de Pineo-Porter")+
ggplot2::ylab("Frequência")+
ggplot2::labs(title = "Histograma do Score de Prestígio de Pineo-Porter para a ocupação", subtitle = "Pesquisa social realizada em meados dos anos 60") ggplot2
Vamos continuar o ajuste considerando uma distribuição normal.
Primeiro Ajuste
<- mgcv::gam(prestige~te(income)+te(education), family = gaussian(), data = carData::Prestige)
fit3 summary(fit3)
Family: gaussian
Link function: identity
Formula:
prestige ~ te(income) + te(education)
Parametric coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 46.8333 0.6858 68.29 <2e-16 ***
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Approximate significance of smooth terms:
edf Ref.df F p-value
te(income) 2.843 3.264 18.5 <2e-16 ***
te(education) 2.912 3.412 44.9 <2e-16 ***
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
R-sq.(adj) = 0.838 Deviance explained = 84.7%
GCV = 51.379 Scale est. = 47.976 n = 102
par(mfrow=c(1,2))
plot(fit3)
Segundo ajuste
<- mgcv::gam(prestige~t2(income)+t2(education), family = gaussian(), data = carData::Prestige)
fit4 summary(fit4)
Family: gaussian
Link function: identity
Formula:
prestige ~ t2(income) + t2(education)
Parametric coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 46.8333 0.6858 68.29 <2e-16 ***
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Approximate significance of smooth terms:
edf Ref.df F p-value
t2(income) 2.843 3.264 7.189 9.05e-05 ***
t2(education) 2.912 3.412 44.249 < 2e-16 ***
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
R-sq.(adj) = 0.838 Deviance explained = 84.7%
GCV = 51.379 Scale est. = 47.976 n = 102
par(mfrow=c(1,2))
plot(fit4)
Terceiro Ajuste
<- mgcv::gam(prestige~s(income)+s(education), family = gaussian(), data = carData::Prestige)
fit5 summary(fit5)
Family: gaussian
Link function: identity
Formula:
prestige ~ s(income) + s(education)
Parametric coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 46.8333 0.6889 67.98 <2e-16 ***
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Approximate significance of smooth terms:
edf Ref.df F p-value
s(income) 3.118 3.877 14.61 <2e-16 ***
s(education) 3.177 3.952 38.78 <2e-16 ***
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
R-sq.(adj) = 0.836 Deviance explained = 84.7%
GCV = 52.143 Scale est. = 48.414 n = 102
par(mfrow=c(1,2))
plot(fit5)
Resultado:
Conforme os ajustes acima, o segundo e primeiro ajuste, no qual utiliza o parâmetro de suavização t2
e t
, se mostraram mais eficiente, tendo um coeficiente R^2 ajustado de 83.8% e um Desvio explicado de cerca de 84.7%, sendo assim utilizaremos o segundo modelo ajustado.
Letra C
- Faça uma análise de diagnósticos do modelo escolhido. O que você pode concluir do modelo?
par(mfrow = c(2,2))
::gam.check(fit4) mgcv
Method: GCV Optimizer: magic
Smoothing parameter selection converged after 4 iterations.
The RMS GCV score gradient at convergence was 0.000514641 .
The Hessian was positive definite.
Model rank = 9 / 9
Basis dimension (k) checking results. Low p-value (k-index<1) may
indicate that k is too low, especially if edf is close to k'.
k' edf k-index p-value
t2(income) 4.00 2.84 0.99 0.40
t2(education) 4.00 2.91 1.02 0.55
Resposta:
De acordo com a análise gráfica dos resíduos podemos verificar que o modelo ficou bem ajustado e que os desvios são aproximadamente normais.
Questão 3
- Considere o banco de dados fabric do pacote gamlss do R. Em que y é o número de falhas em um rolo de tecido e leng é o comprimento do tecido. A variável x, que é o log de leng não usaremos na questão.
Verificando a categoria das variáveis no banco
glimpse(gamlss.data::fabric)
Rows: 32
Columns: 3
$ leng <dbl> 551, 651, 832, 375, 715, 868, 271, 630, 491, 372, 645, 441, 895, …
$ y <dbl> 6, 4, 17, 9, 14, 8, 5, 7, 7, 7, 6, 8, 28, 4, 10, 4, 8, 9, 23, 9, …
$ x <dbl> 6.311735, 6.478510, 6.723832, 5.926926, 6.572283, 6.766192, 5.602…
Estatística Descritiva
Visualizando as primeiras linhas do banco
::fabric %>%
gamlss.dataslice_head(n=10) %>%
::gt() gt
leng | y | x |
---|---|---|
551 | 6 | 6.311735 |
651 | 4 | 6.478510 |
832 | 17 | 6.723832 |
375 | 9 | 5.926926 |
715 | 14 | 6.572283 |
868 | 8 | 6.766192 |
271 | 5 | 5.602119 |
630 | 7 | 6.445720 |
491 | 7 | 6.196444 |
372 | 7 | 5.918894 |
::skim(gamlss.data::fabric) skimr
Name | gamlss.data::fabric |
Number of rows | 32 |
Number of columns | 3 |
_______________________ | |
Column type frequency: | |
numeric | 3 |
________________________ | |
Group variables | None |
Variable type: numeric
skim_variable | n_missing | complete_rate | mean | sd | p0 | p25 | p50 | p75 | p100 | hist |
---|---|---|---|---|---|---|---|---|---|---|
leng | 0 | 1 | 587.66 | 211.39 | 122.0 | 453.75 | 590.50 | 735.75 | 952.00 | ▂▃▆▇▅ |
y | 0 | 1 | 8.88 | 5.81 | 1.0 | 5.75 | 8.00 | 9.25 | 28.00 | ▆▇▂▁▁ |
x | 0 | 1 | 6.29 | 0.46 | 4.8 | 6.12 | 6.38 | 6.60 | 6.86 | ▁▁▂▅▇ |
Letra A
- Faça o gráfico de dispersão da variável resposta y pela variável explicativa (x).
::ggplot(gamlss.data::fabric, ggplot2::aes(x = leng, y = y)) +
ggplot2::geom_point()+
ggplot2::xlab("Comprimento do tecido") +
ggplot2::ylab("Número de falhas") +
ggplot2::labs(title = "Gráfico de dispersão entre o número de falhas em um rolo e o comprimento do tecido") ggplot2
Letra B
- Realize o ajuste de um modelo GAMLSS com a variável resposta y tendo uma distribuição Poisson.
Verificando a distribuição dos dados da variável y, se tem um bom ajuste considerando a distribuição Poisson.
::ggplot(gamlss.data::fabric, ggplot2::aes(y))+
ggplot2::geom_histogram(fill='white',
ggplot2color = "black",
breaks = hist(gamlss.data::fabric$y, plot = F)$breaks) +
::xlab("Número de falhas")+
ggplot2::ylab("Frequência")+
ggplot2::labs(title = "Histograma do número de falhas em um rolo de tecido") ggplot2
Vamos ajustar o modelo de acordo com a distribuição Poisson para a variável resposta.
<- gamlss::gamlss(y~leng, sigma.formula = ~leng, data = gamlss.data::fabric, family = PO) fit6
GAMLSS-RS iteration 1: Global Deviance = 185.0559
GAMLSS-RS iteration 2: Global Deviance = 185.0559
summary(fit6)
Warning in summary.gamlss(fit6): summary: vcov has failed, option qr is used instead
******************************************************************
Family: c("PO", "Poisson")
Call: gamlss::gamlss(formula = y ~ leng, sigma.formula = ~leng, family = PO,
data = gamlss.data::fabric)
Fitting method: RS()
------------------------------------------------------------------
Mu link function: log
Mu Coefficients:
Estimate Std. Error z value Pr(>|z|)
(Intercept) 0.9717506 0.2124710 4.574 4.79e-06 ***
leng 0.0019297 0.0003063 6.300 2.97e-10 ***
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
------------------------------------------------------------------
No. of observations in the fit: 32
Degrees of Freedom for the fit: 2
Residual Deg. of Freedom: 30
at cycle: 2
Global Deviance: 185.0559
AIC: 189.0559
SBC: 191.9873
******************************************************************
Letra C
- Faça uma análise de diagnósticos do modelo escolhido. O que você pode concluir do modelo?
plot(fit6)
******************************************************************
Summary of the Randomised Quantile Residuals
mean = -0.04398648
variance = 1.991556
coef. of skewness = 0.4198306
coef. of kurtosis = 2.800601
Filliben correlation coefficient = 0.9893308
******************************************************************
Resposta:
Considerando que o problema tem poucas observações e que isto não traz muita precisão ao ajuste do modelo, todavia, concluimos que o modelo foi bem ajustado.