Consumo de Cimento no Brasil

O Consumo do Cimento

A Série Consumo do Cimento no Brasil, tem a finalidade de analisar o comportamento ao longo dos meses e anos, analisando a correlação com outras fontes de dados como: Admissão na construção civil e desemprego no Brasil e aplicar métodos de previsão para anos vindouros.

Ao analisar essas áreas, mostramos como o consumo do cimento tem um impacto enorme na economia brasileira, já que a construção civil é a área que mais emprega no Brasil.

Ànalise dos dados

library(readxl)
library(dplyr)
library(visdat)
library(forecast)
library(seastests)
library(randtests)
library(tseries)
library(lmtest)
library(nortest)
library(knitr)

dados<-read.csv("C:/Users/elton/Downloads/consumo de cimento no brasil (1).csv", header=FALSE)
dados<- dados |> rename(c(Data=V1,Consumo=V2)) 
dados<- dados |> select(-c(V3))
dados<- dados[-1,]
dados$Consumo<- as.numeric(as.character(dados$Consumo))
vis_dat(dados)

summary(dados)

     Data              Consumo       
 Length:235         Min.   :2489405  
 Class :character   1st Qu.:3815035  
 Mode  :character   Median :4683733  
                    Mean   :4591333  
                    3rd Qu.:5412524  
                    Max.   :6634204  

Gráfico da Série

"consumo cimento"<- dados |> select(-Data)
attach(`consumo cimento`)
"consumo cimento br"<- ts(`consumo cimento`,frequency = 12,start = c(2003,1),end = c(2022,7))
forecast::autoplot(`consumo cimento br`,xlab = "Ano",ylab = "Consumo (Toneladas)",main="Consumo do Cimento no Brasil 2003/2022")

Teste de Tendência

\(H_0\) È aleatório

\(H_1\) Não é aleatório

cox.stuart.test(`consumo cimento br`)

    Cox Stuart test

data:  consumo cimento br
statistic = 87, n = 117, p-value = 1.283e-07
alternative hypothesis: non randomness

Tendência Crescente

\(H_0\) Não é crescente

\(H_1\) È crescente

cox.stuart.test(`consumo cimento br`,alternative = "right.sided")

    Cox Stuart test

data:  consumo cimento br
statistic = 87, n = 117, p-value = 6.414e-08
alternative hypothesis: increasing trend

Há evidência Estatística com 5% de significância e 95% de confiança que a Série apresenta tendência crescente.

Teste de Sazonalidade

\(H_0\) Não tem sazonalidade

\(H_1\) Tem sazonalidade

combined_test(`consumo cimento br`)

Test used:  WO 
 
Test statistic:  1 
P-value:  0 0 1.110223e-16

ggseasonplot(`consumo cimento br`)

Há evidência Estatística com 5% de significância e 95% de confiança que a Série apresenta sazonalidade.

Teste de estacionariedade

\(H_0\) Não é estacionária

\(H_1\) È estacionária

adf.test(`consumo cimento br`)

    Augmented Dickey-Fuller Test

data:  consumo cimento br
Dickey-Fuller = -1.7994, Lag order = 6, p-value = 0.6602
alternative hypothesis: stationary

pp.test(`consumo cimento br`)

    Phillips-Perron Unit Root Test

data:  consumo cimento br
Dickey-Fuller Z(alpha) = -22.438, Truncation lag parameter = 4, p-value
= 0.04024
alternative hypothesis: stationary

Há evidência estatística com 5% de significância e 95% de confiança que a série é não estacionária.

Diferença para tornar a série estacionária

ndiffs(`consumo cimento br`)

[1] 1

Gráfico de alto correlaço amostral

Acf(`consumo cimento br`, main = "Gráfico de correlação amostral", xlab = "Defasagem", ylab = "Autocorrelações")

grafico de alto correlaçao parcial

Pacf(`consumo cimento br`, main = "Gráfico de correlação Parcial", xlab = "Defasagem", ylab = "Autocorrelações")

ggtsdisplay(`consumo cimento br`)

Verificando serie

auto.arima(`consumo cimento br`)

Series: consumo cimento br 
ARIMA(2,1,0)(0,1,1)[12] 

Coefficients:
         ar1      ar2     sma1
      -0.696  -0.3699  -0.8395
s.e.   0.064   0.0639   0.0596

sigma^2 = 6.794e+10:  log likelihood = -3089.65
AIC=6187.3   AICc=6187.48   BIC=6200.91

ajustando o Modelo

fit <- astsa::sarima(`consumo cimento br`,p=2,d=1,q=0,P=0,D=1,Q=1,S=12)

initial  value 12.937066 
iter   2 value 12.677583
iter   3 value 12.489142
iter   4 value 12.483405
iter   5 value 12.482158
iter   6 value 12.481257
iter   7 value 12.480713
iter   8 value 12.480696
iter   9 value 12.480695
iter   9 value 12.480695
iter   9 value 12.480695
final  value 12.480695 
converged
initial  value 12.498737 
iter   2 value 12.498457
iter   3 value 12.498401
iter   4 value 12.498399
iter   5 value 12.498399
iter   5 value 12.498399
iter   5 value 12.498399
final  value 12.498399 
converged

fit$ttable

     Estimate     SE  t.value p.value
ar1   -0.6960 0.0640 -10.8661       0
ar2   -0.3699 0.0639  -5.7862       0
sma1  -0.8395 0.0596 -14.0903       0

Análise Diagnóstico dos Resíduos

residuos <- fit$fit$residuals
residuos_padronizados <- c((residuos - mean(residuos))/sd(residuos))
checkresiduals(residuos_padronizados)

    Ljung-Box test

data:  Residuals
Q* = 17.883, df = 10, p-value = 0.05698

Model df: 0.   Total lags used: 10

Teste de normalidade

\(H_0\) Tem normalidade

\(H_1\) Não tem normalidade

jarque.bera.test(residuos_padronizados)

    Jarque Bera Test

data:  residuos_padronizados
X-squared = 26.036, df = 2, p-value = 2.22e-06

lillie.test(residuos_padronizados)

    Lilliefors (Kolmogorov-Smirnov) normality test

data:  residuos_padronizados
D = 0.088289, p-value = 0.0001349

Há evidência estatística com 5% de significância e 95% de confiança que os erros não segue normalidade.

Como o modelo negou a suposição de normalidade, logo não podemos seguir com alguns modelos de previsão. Vamos utilizar Alisamento Exponencial

Alisamento Exponencial

fit2 <- HoltWinters(`consumo cimento br`, seasonal = "multiplicative")
fit2

Holt-Winters exponential smoothing with trend and multiplicative seasonal component.

Call:
HoltWinters(x = `consumo cimento br`, seasonal = "multiplicative")

Smoothing parameters:
 alpha: 0.2834238
 beta : 0.1003921
 gamma: 0.2116322

Coefficients:
             [,1]
a    5.256747e+06
b   -5.024995e+03
s1   1.097499e+00
s2   1.056415e+00
s3   1.064062e+00
s4   1.001946e+00
s5   8.943060e-01
s6   9.438850e-01
s7   8.900429e-01
s8   9.917546e-01
s9   9.579643e-01
s10  1.003100e+00
s11  1.011051e+00
s12  1.081409e+00

fit3<- HoltWinters(`consumo cimento br`, seasonal = "additive")
fit3

Holt-Winters exponential smoothing with trend and additive seasonal component.

Call:
HoltWinters(x = `consumo cimento br`, seasonal = "additive")

Smoothing parameters:
 alpha: 0.2695348
 beta : 0.09506498
 gamma: 0.2569866

Coefficients:
           [,1]
a   5259287.620
b     -4362.539
s1   492809.971
s2   292011.649
s3   312254.663
s4    -9443.779
s5  -571917.144
s6  -332625.016
s7  -556011.118
s8   -45943.636
s9  -215936.304
s10   27014.572
s11   41155.930
s12  413234.317

Predições

Método Multiplicativo

(prev_multiplicativo <- predict(fit2, n.ahead = 12, prediction.interval = T))

             fit     upr     lwr
Aug 2022 5763758 5984434 5543082
Sep 2022 5542688 5810798 5274578
Oct 2022 5577464 5896987 5257941
Nov 2022 5246840 5603001 4890678
Dec 2022 4678671 5055118 4302224
Jan 2023 4933307 5377649 4488964
Feb 2023 4647423 5121200 4173646
Mar 2023 5173535 5749433 4597636
Apr 2023 4992452 5605047 4379858
May 2023 5222636 5919148 4526124
Jun 2023 5258953 6019257 4498649
Jul 2023 5619485 6464246 4774723

Método aditivo

(prev_aditivo<- predict(fit3, n.ahead = 12, prediction.interval = T))

             fit     upr     lwr
Aug 2022 5747735 6264508 5230962
Sep 2022 5542574 6081388 5003761
Oct 2022 5558455 6122192 4994717
Nov 2022 5232394 5823871 4640916
Dec 2022 4665558 5287496 4043619
Jan 2023 4900487 5555496 4245479
Feb 2023 4672739 5363305 3982172
Mar 2023 5178444 5906933 4449955
Apr 2023 5004088 5772742 4235435
May 2023 5242677 6053621 4431732
Jun 2023 5252456 6107706 4397205
Jul 2023 5620171 6521641 4718702

Gráfico das Predições

par(mfrow=c(2,2))
plot(fit2,prev_multiplicativo,main = "Método Multiplicativo", xlab = "Tempo", ylab = "Consumo em Toneladas")
plot(fit3,prev_aditivo,main = "Método aditivo", xlab = "Tempo", ylab = "Consumo em Toneladas")

Predições

(fit4<- hw(`consumo cimento br`,seasonal = "additive"))

         Point Forecast   Lo 80   Hi 80   Lo 95   Hi 95
Aug 2022        5759739 5431243 6088234 5257348 6262129
Sep 2022        5587017 5238496 5935538 5054000 6120034
Oct 2022        5659258 5289569 6028948 5093867 6224650
Nov 2022        5391829 4999894 5783765 4792416 5991243
Dec 2022        4932676 4517476 5347876 4297683 5567669
Jan 2023        5119385 4679958 5558813 4447339 5791432
Feb 2023        4844530 4379960 5309099 4134032 5555028
Mar 2023        5328942 4838360 5819523 4578662 6079221
Apr 2023        5132207 4614784 5649629 4340877 5923537
May 2023        5377273 4832216 5922331 4543679 6210867
Jun 2023        5369702 4796248 5943155 4492680 6246724
Jul 2023        5705118 5102537 6307699 4783550 6626687
Aug 2023        5839945 5207522 6472369 4872737 6807154
Sep 2023        5667224 5004287 6330161 4653349 6681098
Oct 2023        5739465 5045357 6433574 4677918 6801013
Nov 2023        5472036 4746116 6197956 4361838 6582235
Dec 2023        5012883 4254531 5771235 3853084 6172682
Jan 2024        5199592 4408204 5990980 3989269 6409915
Feb 2024        4924737 4099725 5749748 3662990 6186483
Mar 2024        5409148 4549938 6268359 4095099 6723198
Apr 2024        5212413 4318443 6106384 3845204 6579623
May 2024        5457480 4528202 6386759 4036271 6878690
Jun 2024        5449909 4484784 6415033 3973878 6925939
Jul 2024        5785325 4783828 6786823 4253667 7316983

(fit5<- hw(`consumo cimento br`,seasonal = "multiplicative"))

         Point Forecast   Lo 80   Hi 80   Lo 95   Hi 95
Aug 2022        5776335 5378853 6173816 5168439 6384230
Sep 2022        5579106 5173125 5985088 4958211 6200001
Oct 2022        5685232 5246056 6124408 5013570 6356894
Nov 2022        5339311 4900257 5778365 4667835 6010786
Dec 2022        4774895 4356196 5193595 4134549 5415241
Jan 2023        5017627 4548013 5487241 4299415 5735839
Feb 2023        4723287 4251342 5195232 4001510 5445064
Mar 2023        5251853 4691797 5811910 4395321 6108386
Apr 2023        5042088 4468638 5615537 4165072 5919103
May 2023        5316635 4672390 5960880 4331347 6301923
Jun 2023        5221108 4547852 5894365 4191451 6250765
Jul 2023        5624368 4853626 6395110 4445620 6803116
Aug 2023        5749245 4913164 6585327 4470569 7027922
Sep 2023        5552931 4697256 6408607 4244288 6861575
Oct 2023        5658549 4735997 6581101 4247627 7069470
Nov 2023        5314242 4398911 6229572 3914364 6714119
Dec 2023        4752467 3888956 5615979 3431840 6073095
Jan 2024        4994050 4038199 5949900 3532203 6455897
Feb 2024        4701084 3754595 5647573 3253554 6148614
Mar 2024        5227156 4121613 6332699 3536374 6917939
Apr 2024        5018368 3904848 6131887 3315386 6721349
May 2024        5291614 4061338 6521889 3410070 7173157
Jun 2024        5196527 3932137 6460916 3262810 7130244
Jul 2024        5597877 4174105 7021650 3420405 7775349

Gráfico preditivo

plot(fit4, xlab = "Ano",ylab = "Consumo de cimento")

plot(fit5, xlab = "Ano",ylab = "Consumo de cimento")

Acurácia

aditivo<-accuracy(fit4)
multiplicativo<-accuracy(fit5)

stargazer:: stargazer(multiplicativo,type = "text",title = "Método Multiplicativo")

Método Multiplicativo
=========================================================================
                 ME        RMSE         MAE      MPE   MAPE  MASE   ACF1 
-------------------------------------------------------------------------
Training set -2,157.293 233,680.900 179,211.800 -0.175 3.999 0.484 -0.066
-------------------------------------------------------------------------

stargazer::stargazer(aditivo,type = "text",title = "Método Aditivo")

Método Aditivo
=========================================================================
                 ME        RMSE         MAE      MPE   MAPE  MASE   ACF1 
-------------------------------------------------------------------------
Training set -1,900.472 247,446.600 191,824.800 -0.142 4.358 0.518 -0.019
-------------------------------------------------------------------------

Escolha do Modelo

(fit5<- hw(`consumo cimento br`,seasonal = "multiplicative"))

         Point Forecast   Lo 80   Hi 80   Lo 95   Hi 95
Aug 2022        5776335 5378853 6173816 5168439 6384230
Sep 2022        5579106 5173125 5985088 4958211 6200001
Oct 2022        5685232 5246056 6124408 5013570 6356894
Nov 2022        5339311 4900257 5778365 4667835 6010786
Dec 2022        4774895 4356196 5193595 4134549 5415241
Jan 2023        5017627 4548013 5487241 4299415 5735839
Feb 2023        4723287 4251342 5195232 4001510 5445064
Mar 2023        5251853 4691797 5811910 4395321 6108386
Apr 2023        5042088 4468638 5615537 4165072 5919103
May 2023        5316635 4672390 5960880 4331347 6301923
Jun 2023        5221108 4547852 5894365 4191451 6250765
Jul 2023        5624368 4853626 6395110 4445620 6803116
Aug 2023        5749245 4913164 6585327 4470569 7027922
Sep 2023        5552931 4697256 6408607 4244288 6861575
Oct 2023        5658549 4735997 6581101 4247627 7069470
Nov 2023        5314242 4398911 6229572 3914364 6714119
Dec 2023        4752467 3888956 5615979 3431840 6073095
Jan 2024        4994050 4038199 5949900 3532203 6455897
Feb 2024        4701084 3754595 5647573 3253554 6148614
Mar 2024        5227156 4121613 6332699 3536374 6917939
Apr 2024        5018368 3904848 6131887 3315386 6721349
May 2024        5291614 4061338 6521889 3410070 7173157
Jun 2024        5196527 3932137 6460916 3262810 7130244
Jul 2024        5597877 4174105 7021650 3420405 7775349