ARIMA para Iflação (IPCA)

 UNIVERSIDADE FEDERAL DA PARAÍBA

Código

library(scales)
library(tidyverse)
library(forecast)
library(zoo)
library(sidrar)
library(timetk)
library(knitr)

Código

tab3 <- get_sidra(api = '/t/7060/n1/all/v/63,66/p/all/c315/7170,7445,7486,7558,7625,7660,7712,7766,7786/d/v63%202,v66%204') 

tab2 <- get_sidra(api = '/t/1419/n1/all/v/63,66/p/all/c315/7170,7445,7486,7558,7625,7660,7712,7766,7786/d/v63%202,v66%204')

tab1 <- get_sidra(api = '/t/2938/n1/all/v/63,66/p/all/c315/7170,7445,7486,7558,7625,7660,7712,7766,7786/d/v63%202,v66%204')

  
series <- c(7170,7445,7486,7558,7625,7660,
            7712,7766,7786)

names <- c("Alimentos", "Habitação", "Art de Resid", "Vestuário", 
           "Transporte", "Saude e Cuidados Pessoais", "despesas Pessoais",
           "Educação", "Comunicação")

Código

var1 <- matrix(NA, ncol = length(series),
               nrow = nrow(tab1)/ length(series)/2)

peso1 <- matrix(NA, ncol = length(series),
               nrow = nrow(tab1)/ length(series)/2)

var2 <- matrix(NA, ncol = length(series),
               nrow = nrow(tab2)/ length(series)/2)

peso2 <- matrix(NA, ncol = length(series),
               nrow = nrow(tab2)/ length(series)/2)

var3 <- matrix(NA, ncol = length(series),
               nrow = nrow(tab3)/ length(series)/2)

peso3 <- matrix(NA, ncol = length(series),
               nrow = nrow(tab3)/ length(series)/2)

Código

for(i in 1:length(series)){
  var1[,i] <- tab1$Valor[tab1$`Variável (Código)`==63&
                           tab1$`Geral, grupo, subgrupo, item e subitem (Código)`==series[i]]
  
  var2[,i] <- tab2$Valor[tab2$`Variável (Código)`==63&
                           tab2$`Geral, grupo, subgrupo, item e subitem (Código)`==series[i]]
  
  var3[,i] <- tab3$Valor[tab3$`Variável (Código)`==63&
                           tab3$`Geral, grupo, subgrupo, item e subitem (Código)`==series[i]]
  
  peso1[,i] <- tab1$Valor[tab1$`Variável (Código)`==66&
                           tab1$`Geral, grupo, subgrupo, item e subitem (Código)`==series[i]]
  
   peso2[,i] <- tab2$Valor[tab2$`Variável (Código)`==66&
                           tab2$`Geral, grupo, subgrupo, item e subitem (Código)`==series[i]]
   
    peso3[,i] <- tab3$Valor[tab3$`Variável (Código)`==66&
                           tab3$`Geral, grupo, subgrupo, item e subitem (Código)`==series[i]]
   
}

Código

variacao <- ts(rbind(var1,var2,var3), start = c(2006,07), frequency = 12)
pesos <- ts(rbind(peso1, peso2, peso3), start = c(2006,07), frequency = 12)

colnames(variacao) = names
colnames(pesos) = names

Código

ipca <- ts(round(rowSums(variacao*pesos/100),2),
           start = c(2006,07), frequency = 12)

ipca_df <- ipca |> 
  tk_tbl(preserve_index = T, rename_index = "date")

Inflação Observada

Código

ipca_df |> 
  ggplot(aes(x = date, y = value))+
  geom_line()

Inflação prevista para os Próximos 12 meses seguintes

Código

matrix <- matrix(NA, ncol = 9, nrow = 12)
for(i in 1:9){
  matrix[,i] <- forecast(auto.arima(variacao[,i],
                                    max.p = 5, max.q = 5,
                                    max.P = 2, max.Q = 2,
                                    seasonal = T), h = 12,
                         level = 40)$mean
}

colnames(matrix) = names

ipcaf <- round(rowSums(matrix*tail(pesos/100,12)),2)

infl <- ts(c(ipca, ipcaf), start = c(2006,07), frequency = 12) 

acum_12_ipca <- rollapply(infl, width = 12, FUN = sum, align = "right", fill = NA)

plot(acum_12_ipca)

Código

kable(acum_12_ipca[215:227],
      caption = "Acumulada 12 Meses")

Acumulada 12 Meses

x
3.88
4.34
4.55
4.74
4.83
5.02
5.10
5.04
5.03
4.94
5.19
5.30
5.28

Código

kable(ipcaf,
      caption = "Fluxo Mensal")

Fluxo Mensal

x
0.39
0.33
0.42
0.35
0.43
0.36
0.50
0.41
0.74
0.42
0.49
0.44

Código

inflacao_df <- infl |> 
  tk_tbl(preserve_index = T, rename_index = "date")

Inflação Observada Mais Previsão

Código

inflacao_df |> 
  ggplot(aes(x = date, y = value))+
  geom_line()

Produzindo a Série Acumulada em 12 Meses