SERIES TEMPORAIS

VENDAS FISICAS NA REGIAO METROPOLITANA DE SAO PAULO, OBSERVACOES MENSAIS DE 1984 A 1996

Para isso iremos usar os seguintes pacotes:
library(TSA)
library(forecast)
library(fpp3)
require(gridExtra)
library(readr)
library(astsa)
library(ggplot2)
library(dplyr)

Bancos de dados

dados <- read_csv("C:/Users/Maria/Downloads/a11_CONSUMO.csv")
## Rows: 153 Columns: 2
## -- Column specification --------------------------------------------------------
## Delimiter: ","
## dbl  (1): consumo
## date (1): data
## 
## i Use `spec()` to retrieve the full column specification for this data.
## i Specify the column types or set `show_col_types = FALSE` to quiet this message.
View(dados)
serie <- dados %>%
  mutate(data = yearmonth(data)) %>%
  as_tsibble(index = data)
serie
## # A tsibble: 153 x 2 [1M]
##        data consumo
##       <mth>   <dbl>
##  1 1984 jan    114.
##  2 1984 fev    111.
##  3 1984 mar    116.
##  4 1984 abr    112.
##  5 1984 mai    121.
##  6 1984 jun    121.
##  7 1984 jul    121.
##  8 1984 ago    127.
##  9 1984 set    129.
## 10 1984 out    133.
## # ... with 143 more rows
tail(serie)
## # A tsibble: 6 x 2 [1M]
##       data consumo
##      <mth>   <dbl>
## 1 1996 abr    103.
## 2 1996 mai    115.
## 3 1996 jun    103.
## 4 1996 jul    118.
## 5 1996 ago    119.
## 6 1996 set    117.
dados$data <- as.Date(dados$data, "%d-%m-%y")
summary(dados)
##       data               consumo      
##  Min.   :1984-01-31   Min.   : 75.39  
##  1st Qu.:1987-03-31   1st Qu.:101.87  
##  Median :1990-05-31   Median :116.25  
##  Mean   :1990-05-31   Mean   :120.94  
##  3rd Qu.:1993-07-31   3rd Qu.:130.60  
##  Max.   :1996-09-30   Max.   :232.01
dadost <- ts(dados, start = c (1984,1,31), frequency= 12 , end = c(1996,9,30) )

GRAFICO DA SERIE

dados %>% 
  ggplot(aes(x = data, y = consumo)) +
  geom_line() +
  # adicionar curva de tendencia
  geom_smooth(se = FALSE) +
  theme_bw() +
  # quebrar eixo x em 1 mes
  scale_x_date(date_labels = "%Y/%m",
               minor_breaks = NULL) +
  # inverter eixos
  theme(axis.text.x = element_text(angle = 90))
## `geom_smooth()` using method = 'loess' and formula 'y ~ x'

ACF E PACF

acf_consumo = serie %>% 
  ACF(consumo, lag_max = 20) %>% 
  autoplot() + labs(title="ACF DO CONSUMO")

pacf_consumo = serie %>% 
  PACF(consumo, lag_max = 20) %>% 
  autoplot() + labs(title="PACF DO CONSUMO")
gridExtra::grid.arrange(acf_consumo, pacf_consumo, ncol=2)

SAZONALIDADE

serie %>%
  gg_season(consumo, labels = "both") +
  labs(y = "VENDAS FISICAS",
       title = "Sazonalidade: CONSUMO")

SUBGRAFICO

serie %>%
  gg_subseries(consumo) +
  labs(
    y = "VENDAS FISICAS NA REGIAO METROPOLITANA DE SAO PAULO",
    title = "Sazonalidade: CONSUMO"
  )

EXTRAINDO

EXTRAINDO OS COMPONENTES DA SERIE TEMPORAL:

DECOMPOSICAO ADITIVA

serie %>%
  model(
    classical_decomposition(consumo, type = "additive")
  ) %>%
  components() %>%
  autoplot() +
  labs(title = "Decomposição classica aditiva do total do Consumo")
## Warning: Removed 6 row(s) containing missing values (geom_path).

DECOMPOSICAO MULTIPLICATIVA

serie %>%
  model(
    classical_decomposition(consumo, type = "multiplicative")
  ) %>%
  components() %>%
  autoplot() +
  labs(title = "Decomposição classica aditiva do total de Consumo")
## Warning: Removed 6 row(s) containing missing values (geom_path).

FORECAST

Para identificar os anos iniciais e finais

head(serie)
## # A tsibble: 6 x 2 [1M]
##       data consumo
##      <mth>   <dbl>
## 1 1984 jan    114.
## 2 1984 fev    111.
## 3 1984 mar    116.
## 4 1984 abr    112.
## 5 1984 mai    121.
## 6 1984 jun    121.
tail(serie)
## # A tsibble: 6 x 2 [1M]
##       data consumo
##      <mth>   <dbl>
## 1 1996 abr    103.
## 2 1996 mai    115.
## 3 1996 jun    103.
## 4 1996 jul    118.
## 5 1996 ago    119.
## 6 1996 set    117.

Definindo a base de dados em treinamento e teste

train <- serie %>%
  filter_index("1985 Q1" ~ "1995 Q1")
test <- serie %>%
  filter_index("1995 Q1" ~ .);test
## # A tsibble: 21 x 2 [1M]
##        data consumo
##       <mth>   <dbl>
##  1 1995 jan    99.1
##  2 1995 fev    99.3
##  3 1995 mar   115. 
##  4 1995 abr   106. 
##  5 1995 mai   110. 
##  6 1995 jun   108. 
##  7 1995 jul   113. 
##  8 1995 ago   114. 
##  9 1995 set   108. 
## 10 1995 out   112. 
## # ... with 11 more rows

verificando a eficazes:

head(train)
## # A tsibble: 6 x 2 [1M]
##       data consumo
##      <mth>   <dbl>
## 1 1985 jan    121.
## 2 1985 fev    114.
## 3 1985 mar    131.
## 4 1985 abr    118.
## 5 1985 mai    146.
## 6 1985 jun    135.
tail(train)
## # A tsibble: 6 x 2 [1M]
##       data consumo
##      <mth>   <dbl>
## 1 1994 ago   115. 
## 2 1994 set   108. 
## 3 1994 out   106. 
## 4 1994 nov   110. 
## 5 1994 dez   144. 
## 6 1995 jan    99.1

MODELO DE SUAVIZACAO

ESTIMANDO:

O modelo utilizado foi o EST (Error Trend Seasonal de decomposicao espaco estado)

sales_fit <- train %>%
  model(
    ETS = ETS(consumo)
  )

Gerando uma previsao, com 21 meses:

sales_fc <- sales_fit %>% forecast(h = 21)
sales_fc
## # A fable: 21 x 4 [1M]
## # Key:     .model [1]
##    .model     data     consumo .mean
##    <chr>     <mth>      <dist> <dbl>
##  1 ETS    1995 fev   N(94, 52)  93.5
##  2 ETS    1995 mar  N(107, 92) 107. 
##  3 ETS    1995 abr N(104, 110) 104. 
##  4 ETS    1995 mai N(115, 161) 115. 
##  5 ETS    1995 jun N(109, 168) 109. 
##  6 ETS    1995 jul N(113, 210) 113. 
##  7 ETS    1995 ago N(122, 276) 122. 
##  8 ETS    1995 set N(115, 270) 115. 
##  9 ETS    1995 out N(115, 299) 115. 
## 10 ETS    1995 nov N(113, 316) 113. 
## # ... with 11 more rows

Grafico da serie com as previsoes:

sales_fc %>%
  autoplot(train, level = NULL) +
  autolayer(
    test,
    colour = "black"
  ) +
  labs(
    y = "Megalitres",
    title = "Forecasts for quarterly beer production"
  ) +
  guides(colour = guide_legend(title = "Forecast"))
## Plot variable not specified, automatically selected `.vars = consumo`

ANALISE DE RESIDUOS

sales_fit %>% gg_tsresiduals()

FIM!