ProcessoLOP
Erick Araújo
20/04/2021
Introdução:
O relatório apresenta a análise de um conjunto de dados que contém informações sobre o consumo de cerveja de uma cidade no ano de 2019. Por fim, esboçamos um modelo que busca descobrir se um determinado dia da semana, é um dia útil, ou fim de semana, baseado no consumo de cerveja em litros do dia em questão.
Importação dos dados:
# importando os dados
setwd("C:\\Users\\Erick\\Desktop\\Erick\\EstagioLOP")Pacotes usados:
library(tidyverse)
library(lubridate)Leitura e preparação dos dados:
dados <- as.tibble(read.csv2("consumo_cerveja.csv", sep = ";", dec = ","))
# mudando a categoria de algumas variáveis:
dados <- dados %>% mutate(Data = dmy(Data),
Final.de.Semana = as_factor(Final.de.Semana))O banco de dados em análise contém informações sobre o consumo de cerveja de uma cidade durante o ano de 2019, possui 365 observações e 7 variáveis, sendo elas:
Data: Dias corridos entre 01/01/2019 e 31/12/2019.
Temperatura Média: Descreve a temperatura média registrada no dia em questão. Variação entre a mínima e a máxima.
Temperatura Mínima: Descreve a temperatura mínima registrada no dia em questão.
Temperatura Máxima: Descreve a tempertura máxima registrada no dia em questão.
Precipitação: Descreve qualquer fenômeno relacionado à queda de água do céu (chuva, neve e granizo). Essa grandeza geralmente aparece representada em dois formatos principais: A probabilidade, que mede o grau de segurança com que se pode esperar a realização de uma precipitação, ou o índice pluviométrico: Essa milimetragem significa que, se tivéssimos nesse local uma caixa aberta com 1m² de base, o nível de água dentro dela teria atingido “X”mm de altura. No nosso conjunto de dados a precipitação foi registrada em índice pluviométrico.
Final de semana: Variável binária que destaca os finais de semana regitrados. 1 = Final de Semana; 0 = Dia útil.
Consumo de cerveja em litros: Descreve o consumo de cerveja em litros para cada dia registrado.
Estatísticas Descritivas Básicas:
summary(dados) # Estatísticas básicas para uma primeira visualização dos dados## Data Temperatura.Media..C. Temperatura.Minima..C.
## Min. :2019-01-01 Min. :12.90 Min. :10.60
## 1st Qu.:2019-04-02 1st Qu.:19.00 1st Qu.:15.30
## Median :2019-07-02 Median :21.37 Median :17.90
## Mean :2019-07-02 Mean :21.29 Mean :17.47
## 3rd Qu.:2019-10-01 3rd Qu.:23.29 3rd Qu.:19.60
## Max. :2019-12-31 Max. :52.86 Max. :24.50
## NA's :1 NA's :1
## Temperatura.Maxima..C. Precipitacao..mm. Final.de.Semana
## Min. :14.50 Min. : 0.000 0:261
## 1st Qu.:23.80 1st Qu.: 0.000 1:104
## Median :26.90 Median : 0.000
## Mean :26.61 Mean : 5.197
## 3rd Qu.:29.40 3rd Qu.: 3.200
## Max. :36.50 Max. :94.800
## NA's :1
## Consumo.de.cerveja..litros.
## Min. :14343
## 1st Qu.:22008
## Median :24867
## Mean :25401
## 3rd Qu.:28631
## Max. :37937
## O quadro acima nos apresenta as medidas de tendência central de cada variável, tais como a data inicial e a final do período analisado, as tempetaruas médias registradas, mínimas e máximas, precipitação, finais de semana registrados, e o consumo de cerveja em litros.
Como possuímos um conjunto de dados anual, vamos primeiro analisar a distribuição do consumo de cerveja ao longo do ano. Para facilitar a visualização e a interpretação desses dados, iremos esboçar uma média móvel simples na variável “Consumo de Cerveja em litros” durante todo o ano de 2019.
Média móvel do consumo anual de cerveja (2019)
# média móvel do consumo anual de cerveja
mm <- stats::filter(dados$Consumo.de.cerveja..litros., filter = rep(1/15, 15), method = "convolution", sides = 1, circular = T)# Tabela que servirá de base para a construção do gráfico da média movel
gmm <- stack(list(
consumo = dados$Consumo.de.cerveja..litros.,
MM = as.numeric(mm)
))# Adicionando o vetor Data à tabela
gmm$data <- dados$Data# Plotando o gráfico
ggplot(gmm, aes(x=data, y=values, colour = ind)) +
geom_line(size = 0.90) +
ggtitle("Consumo de Cerveja durante o Ano (2019)") +
xlab("Data") + ylab("Consumo de Cerveja (l)") +
scale_x_date(date_labels = "%b %y", date_breaks = "2 months") +
theme_light()
Como podemos observar no gráfico, o intervalo de maior consumo acontece entre janeiro e fevereiro, duminui entre maio e setembro, e volta a crescer em outubro. A grande vantagem das médias móveis é nos permitir identificar possíveis tendências. Nesse gráfico por exemplo, podemos associar os meses de maior consumo, com as estações mais quentes. Verão entre Dezembro e Fevereiro, e Inverno entre Junho e Setembro, período em que a média móvel apresentou os menores valores para o consumo de cerveja.
Como associamos o consumo de cerveja às estações do ano, podemos levantar a seguinte questão:
Será que a temperatura influencia no consumo de cerveja?
Para isso, testaremos estatisticamente duas hipóteses:
H0: correlação entre consumo e temperatura é igual a 0
H1: correlaçao entre consumo e temperatura é diferente de 0
Teste de Hipóteses
# Teste de correlação de Pearson
cor.test(
x = dados$Temperatura.Media..C.,
y = dados$Consumo.de.cerveja..litros.,
method = "pearson"
)##
## Pearson's product-moment correlation
##
## data: dados$Temperatura.Media..C. and dados$Consumo.de.cerveja..litros.
## t = 13.021, df = 362, p-value < 2.2e-16
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## 0.4904703 0.6309491
## sample estimates:
## cor
## 0.5647874Com uma significância de 5%, podemos concluir que as variáveis analisadas apresentam uma correlação positiva moderada.
Vamos observar o comportamento gráfico das duas variáveis:
library(ggplot2)
ggplot(dados) +
aes(x = Temperatura.Media..C., y = Consumo.de.cerveja..litros.) +
geom_point(size = 1L, colour = "darkblue") +
geom_smooth(method = lm) +
ggtitle("Consumo x Temperatura") +
xlab("Temperatura Média (C°)") + ylab("Consumo de Cerveja (l)") +
theme_light()
Graficamente conseguimos visualizar que de fato há uma tendência linear positiva entre as variáveis, ou seja a medida que a temperatura aumenta, o consumo de cerveja também aumenta.
Podemos também aplicar um filtro ao gráfico de dispersão Consumo x Temperatura para diferenciar os dias úteis dos finais de semana.
# Gráfico Consumo x Temperatura
library(ggplot2)
ggplot(dados) +
aes(x = Temperatura.Media..C., y = Consumo.de.cerveja..litros., colour = Final.de.Semana) +
geom_point(size = 1L) +
scale_color_hue() +
ggtitle("Consumo x Temperatura", subtitle = "Comparação: Dias úteis = 0; Final de Semana = 1") +
xlab("Temperatura Média (C°)") + ylab("Consumo de Cerveja (l)") +
theme_light()
Podemos notar no gráfico de disperssão que o consumo de cerveja é maior aos finais de semana. Para uma visualização mais direta e evidente, podemos recorrer a visualização por um gráfico boxplot:
library(ggplot2)
ggplot(dados) +
aes(x = Final.de.Semana, y = Consumo.de.cerveja..litros.) +
geom_boxplot(fill = "orange") +
ggtitle("Consumo de Cerveja", subtitle = "Comparação: Dias úteis = 0; Final de Semana = 1") +
xlab("Dia da semana") + ylab("Consumo de Cerveja (l)") +
theme_minimal()
Pelo boxsplot conseguimos ver com clareza que o consumo médio de cerveja aos final de semana é mais alto em comparação aos dias úteis.
Como os gráficos indicam uma forte associação entre o consumo de cerveja e os finais de semana, vou propor aqui uma dinâmica:
Dividiremos o nosso banco de dados em duas partes, usaremos a primeira para criar um modelo de Regressão, depois usaremos o modelo criado para adivinhar, na segunda parte do conjunto de dados, se aquele determinado dia da semana foi um fim de semana, ou dia útil, com base no consumo de cerveja.
Regressão e Análise
# dividindo o nosso banco em duas partes
jannov <- dados[1:334,] # janeiro a novembro
dezembro <- dados[335:365,] # Dezembro#modelo
m1 <- glm(Final.de.Semana~Consumo.de.cerveja..litros., family = binomial(link = "logit"), data = jannov)
summary(m1)##
## Call:
## glm(formula = Final.de.Semana ~ Consumo.de.cerveja..litros.,
## family = binomial(link = "logit"), data = jannov)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -2.1362 -0.6797 -0.4186 0.7013 2.3390
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -9.309e+00 1.066e+00 -8.730 < 2e-16 ***
## Consumo.de.cerveja..litros. 3.202e-04 3.931e-05 8.146 3.76e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 400.69 on 333 degrees of freedom
## Residual deviance: 303.94 on 332 degrees of freedom
## AIC: 307.94
##
## Number of Fisher Scoring iterations: 5A nossa variável de interesse é o Consumo de Cerveja, que obteve coeficiente 3.202e-04. Pelo fato de ser positivo, nos informa que quando o consumo de cerveja se eleva, elevam-se as chances de o dia em questão ser um final de semana. De igual forma, nota-se que há significância estatística a p = 0,001 na utilização da variável Consumo de Cerveja (l) para o modelo, mostrando que a variável possui importância ao modelo de regressão proposto.
Porém, o modelo da regressão logística tras os resultados dos estimadores na forma logarítma, ou seja, o log das chances da variável Consumo de Cerveja(l) no modelo é 3.202e-04. No entanto, para uma interpretação mais enriquecida da relação do Consumo, com o dia da semana em questão é necessária a transformação deste coeficiente, ou seja, que seja efetuada a exponênciação da variável de regressão. Assim obteremos a razão das chances.
# Razão das chances
require(mfx)
logitor(Final.de.Semana~Consumo.de.cerveja..litros., data = jannov)## Call:
## logitor(formula = Final.de.Semana ~ Consumo.de.cerveja..litros.,
## data = jannov)
##
## Odds Ratio:
## OddsRatio Std. Err. z P>|z|
## Consumo.de.cerveja..litros. 1.00032025 0.00003932 8.146 3.761e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1A razão de chances observada da variável consumo foi 1.00032025, que pode assim ser interpretada:
Para cada variação unitária no Consumo de cerveja, as chances de o dia em questão ser um final de semana aumentam em 1.00032025 vezes.
Parece pouco, porém estamos lidando com uma grandeza na casa dos milhares, logo, a variação no consumo, sempre ocorre substancialmente.
Predição das probabilidades:
# Intervalo de confiança
exp(cbind(OR=coef(m1), confint(m1)))## OR 2.5 % 97.5 %
## (Intercept) 9.064553e-05 1.000636e-05 0.000661652
## Consumo.de.cerveja..litros. 1.000320e+00 1.000247e+00 1.000401275# Predição de probabilidades
dezembro$predicao <- predict(m1, newdata = dezembro, type = "response")Adicionei uma coluna no banco de dados Dezembro que contém as probabilidades de cada um dos 31 dias em questão ser um final de semana. Os valores foram calculados usando o modelo m1 esboçado anteriormente.
dezembro$predicao## 1 2 3 4 5 6 7
## 0.18932395 0.61021346 0.44687127 0.53530603 0.74691052 0.76630215 0.13896443
## 8 9 10 11 12 13 14
## 0.39295748 0.34993346 0.12287893 0.63049546 0.54055885 0.50934769 0.42529971
## 15 16 17 18 19 20 21
## 0.46370442 0.07145595 0.18006797 0.34304576 0.75202080 0.58371952 0.20476927
## 22 23 24 25 26 27 28
## 0.32777340 0.30289615 0.69013445 0.29218903 0.09291092 0.73809558 0.27828625
## 29 30 31
## 0.10291481 0.05980182 0.10703590# Matriz de confusão e calculo da acurácia
require(caret)
dezembro$resultado <- as.factor(
ifelse(
predict(m1,
newdata = dezembro,
type = "response")
>0.7,"1","0"))Para gerar uma variável binária resultante, adicionei um critério que considera as probabilidades acima de 70% finais de semana.
Sendo: 1 = Final de Semana e 0 = Dia útil.
confusionMatrix(dezembro$resultado, dezembro$Final.de.Semana, positive = "1")## Confusion Matrix and Statistics
##
## Reference
## Prediction 0 1
## 0 23 4
## 1 0 4
##
## Accuracy : 0.871
## 95% CI : (0.7017, 0.9637)
## No Information Rate : 0.7419
## P-Value [Acc > NIR] : 0.06876
##
## Kappa : 0.5974
##
## Mcnemar's Test P-Value : 0.13361
##
## Sensitivity : 0.5000
## Specificity : 1.0000
## Pos Pred Value : 1.0000
## Neg Pred Value : 0.8519
## Prevalence : 0.2581
## Detection Rate : 0.1290
## Detection Prevalence : 0.1290
## Balanced Accuracy : 0.7500
##
## 'Positive' Class : 1
## CONCLUSÃO:
A matriz de confusão retorna uma excelente acurácia total do modelo em 87%. Entre os 8 dias listados como final de semana no mes de dezembro, nosso modelo acertou 4. E entre os 23 dias úteis, não acusou nenhum falsamente.