ConsumoCerveja
Talita Saviano
14/05/2021
Usei o IMPORT DATASET para importar o arquivo “cerveja1” utilizado durante as questões.
y = cerveja1$Consumo_cerveja
x1= cerveja1$Temperatura_Media
x2 = cerveja1$Temperatura_Minima
x3 = cerveja1$Temperatura_Maxima
x4 = cerveja1$Precipitacao
x5 = cerveja1$Final_de_Semana
tabela = cbind(y,x1,x2,x3,x4,x5)Histograma do consumo de cerveja
hist(y, main = "Histograma do Consumo de Cerveja",xlab = "litros",freq = F, col = "lightblue", breaks = 10)
curve(dnorm(x,mean = mean(y), sd = sd(y)), add= T, col = "red")
Boxplot
boxplot(y,main = "Boxplot do Consumo de Cerveja")
Gráfico de dispersão entre as variáveie
plot(y,x1, pch=20, cex = 1.5, main = "Gráfico de dispersão",xlab = "Temperatura média em °C",ylab = "Consumo de cerveja em Litros")
plot(y,x2, pch=20, cex = 1.5, main = "Gráfico de dispersão",xlab = "Temperatura mínima em °C",ylab = "Consumo de cerveja em Litros")
plot(y,x3, pch=20, cex = 1.5, main = "Gráfico de dispersão",xlab = "Temperatura máxima em °C",ylab = "Consumo de cerveja em Litros")
plot(y,x4, pch=20, cex = 1.5, main = "Gráfico de dispersão",xlab = "Precipitação em mm",ylab = "Consumo de cerveja em Litros")
plot(y,x5, pch=20, cex = 1.5, main = "Gráfico de dispersão",xlab = "Final de semana",ylab = "Consumo de cerveja em Litros")
Análise Descritiva
pie(table(x5),labels = c("Dia útil - 71%","Final de Semana-29%"), col = rainbow(2), main= "Dias úteis x Final de Semana")
summary(y)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 14.34 21.09 23.30 24.14 26.53 34.70summary(x1)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 12.90 16.73 18.87 18.97 20.83 28.06summary(x2)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 10.60 13.30 14.40 14.65 15.75 21.30summary(x3)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 14.50 20.60 25.05 24.61 27.55 35.50summary(x4)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.000 0.000 0.000 2.613 0.000 58.000summary(x5)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.0000 0.0000 0.0000 0.2872 1.0000 1.0000Correlação entre as variáveis
pairs(tabela)
cor(tabela)## y x1 x2 x3 x4 x5
## y 1.0000000 0.58425755 0.32310820 0.67647780 -0.300085587 0.516269362
## x1 0.5842576 1.00000000 0.80666157 0.92288223 -0.224055021 -0.085180850
## x2 0.3231082 0.80666157 1.00000000 0.59031215 -0.049549258 -0.096205965
## x3 0.6764778 0.92288223 0.59031215 1.00000000 -0.290338567 -0.043966355
## x4 -0.3000856 -0.22405502 -0.04954926 -0.29033857 1.000000000 0.001839994
## x5 0.5162694 -0.08518085 -0.09620597 -0.04396635 0.001839994 1.000000000É possivel notar que há forte correlacao entre x1 e x2 e x1 e x3. Isso nos leva a um problema de multicolinearidade
Modelo Ajustado
arq = data.frame(y,x1,x2,x3,x4,x5)
lm0 = lm(y~1, data=arq) #menor modelo que a gente aceita so com beta0
lmcompleto = lm(y ~ x1+x2+x3+x4+x5)
step(lm0,scope = list(lower = lm0, upper = lmcompleto), trace=TRUE, test = "F")## Start: AIC=285.32
## y ~ 1
##
## Df Sum of Sq RSS AIC F value Pr(>F)
## + x3 1 876.20 1038.5 229.81 77.6235 7.264e-14 ***
## + x1 1 653.59 1261.1 248.06 47.6811 6.334e-10 ***
## + x5 1 510.33 1404.3 258.18 33.4319 1.004e-07 ***
## + x2 1 199.89 1714.8 276.95 10.7243 0.001491 **
## + x4 1 172.42 1742.3 278.45 9.1046 0.003297 **
## <none> 1914.7 285.32
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Step: AIC=229.81
## y ~ x3
##
## Df Sum of Sq RSS AIC F value Pr(>F)
## + x5 1 571.93 466.55 156.59 111.5528 < 2.2e-16 ***
## + x4 1 22.48 1016.00 229.75 2.0131 0.1594
## <none> 1038.48 229.81
## + x1 1 20.71 1017.77 229.91 1.8519 0.1769
## + x2 1 17.07 1021.41 230.25 1.5212 0.2206
## - x3 1 876.20 1914.68 285.32 77.6235 7.264e-14 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Step: AIC=156.6
## y ~ x3 + x5
##
## Df Sum of Sq RSS AIC F value Pr(>F)
## + x4 1 19.96 446.59 154.49 4.0228 0.04789 *
## <none> 466.55 156.59
## + x2 1 4.23 462.32 157.74 0.8233 0.36663
## + x1 1 3.21 463.35 157.95 0.6226 0.43215
## - x5 1 571.93 1038.48 229.81 111.5528 < 2e-16 ***
## - x3 1 937.80 1404.35 258.18 182.9153 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Step: AIC=154.48
## y ~ x3 + x5 + x4
##
## Df Sum of Sq RSS AIC F value Pr(>F)
## <none> 446.59 154.49
## + x2 1 1.88 444.71 156.09 0.3759 0.54135
## + x1 1 1.61 444.98 156.15 0.3223 0.57165
## - x4 1 19.96 466.55 156.59 4.0228 0.04789 *
## - x5 1 569.41 1016.00 229.75 114.7517 < 2e-16 ***
## - x3 1 784.25 1230.84 247.78 158.0466 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1##
## Call:
## lm(formula = y ~ x3 + x5 + x4, data = arq)
##
## Coefficients:
## (Intercept) x3 x5 x4
## 6.58715 0.65580 5.44511 -0.05751Gerado o stepwise, temos o modelo ideal com beta0, beta3, beta4 e beta5
lmx = lm(y ~ x3+x4+x5)
summary(lmx)##
## Call:
## lm(formula = y ~ x3 + x4 + x5)
##
## Residuals:
## Min 1Q Median 3Q Max
## -4.3311 -1.7814 0.2065 1.3471 5.7016
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 6.58715 1.34208 4.908 4.07e-06 ***
## x3 0.65580 0.05216 12.572 < 2e-16 ***
## x4 -0.05751 0.02868 -2.006 0.0479 *
## x5 5.44511 0.50831 10.712 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 2.228 on 90 degrees of freedom
## Multiple R-squared: 0.7668, Adjusted R-squared: 0.759
## F-statistic: 98.62 on 3 and 90 DF, p-value: < 2.2e-16Boxplot dos residuos estudentizados x y ajustado
plot(fitted(lmx),rstudent(lmx), pch = 19, cex = 1.5,main = "Modelo: Grafico de Y ajustado contra os Residuos Estudentizados") 
O gráfico indica homocedasticidade dos residuos
Normalidade dos erros
shapiro.test(residuals(lmx))##
## Shapiro-Wilk normality test
##
## data: residuals(lmx)
## W = 0.98035, p-value = 0.1697qqplot dos residuos: para verificar a hipotese de normalidade dos erros H0: os residuos sao normais x H1: os residuos sao nao normais
qqnorm(residuals(lmx),pch=19,main = "Modelo: Normal Q-Q Plot")
qqline(residuals(lmx))
Teste para variância dos erros por breuch-pagan
bptest(formula(lmx),studentize = F)##
## Breusch-Pagan test
##
## data: formula(lmx)
## BP = 8.5478, df = 3, p-value = 0.03595