1 Introdução
A partir de uma série temporal com 60 observações mensais sobre as despesas realizadas, tentar estimar a despesa de 2020 utilizando técnicas de predição. Aqui utilizaremos o Prophet, ferramenta desenvolvida pelo Facebook, e técnicas tradicionais como ARIMA e suavização exponencial.
2 Dados
library(readxl)
library(tidyr)
library(dplyr)
library(plyr)
library(TSA)
library(prophet)
library(lubridate)
library(ggplot2)
library(forecast)
library(ggQC)
# Abrindo os dados --------------------------------------------------------
mensal <- read_excel("G:/Drives compartilhados/ESTATISTICA/predicao_orcamento/mensal.xlsx")
# agrupar por mês
mensal %>% select(data, despesas) %>% as.data.frame %>% group_by(., data) %>% summarise_all(list(sum)) -> dados_mensal
# converter as datas
dados_mensal$data <- parse_date_time(dados_mensal$data, orders = c("bdy", "bY"))
# ordenar a série temporal pelas datas
dados_mensal <- arrange(dados_mensal, data)
DT::datatable(dados_mensal)3 Prophet
Ajustamos o modelo no prophet e fazemos a predição para o ano de 2020. A tabela apresenta as predições mensais. Somando os meses temos uma predição da despesa anual.
O valor previsto pelo Prophet para 2020 é R$ 265.687.505
# Prophet ----------------------------------------------------------------
colnames(dados_mensal) <- c("ds", "y")
m <- prophet(dados_mensal, seasonality.mode = 'multiplicative')
future <- make_future_dataframe(m, periods = 12, freq = "month")
fcst <- predict(m, future)
#plot(m, fcst)
#prophet_plot_components(m, fcst)
# plot
dyplot.prophet(m, fcst)# predicoes para o ano que vem
DT::datatable(data.frame(Data = tail(future, 12), Valor = fcst$yhat[61:72])) ## [1] 2656875054 ARIMA
O método ARIMA prevê um valor de R$ 258.547.302 para 2020.
# ajuste para 2020
dados_arima_geral <- ts(dados_mensal$y, start=c(2015,1), end=c(2019,12), frequency = 12)
# plotando a serie e as observacoes contra o lag:
autoplot(dados_arima_geral)
## Series: dados_arima_geral
## ARIMA(0,1,1)(1,0,0)[12]
##
## Coefficients:
## ma1 sar1
## -0.8715 0.4247
## s.e. 0.0642 0.1175
##
## sigma^2 estimated as 1.39e+13: log likelihood=-977.28
## AIC=1960.56 AICc=1961 BIC=1966.79
##
## Training set error measures:
## ME RMSE MAE MPE MAPE MASE
## Training set 636741.3 3634045 1869790 1.316376 8.46798 0.8017017
## ACF1
## Training set 0.03461592
##
## Ljung-Box test
##
## data: Residuals from ARIMA(0,1,1)(1,0,0)[12]
## Q* = 5.3144, df = 10, p-value = 0.8692
##
## Model df: 2. Total lags used: 12
## [1] 2585473025 Holt-winters
O método de Holt-Winters apresentou como previsão para 2020 o valor de R$ 258.747.052, correspondente à soma das predições mensais.
# Exponential Smoothing --------------------------------------------------
# vamos utilizar Holt-Winters
# Previsao para 2020
fc <- forecast::hw(dados_arima_geral, damped = TRUE, seasonal = "multiplicative",
h=12)
summary(fc)##
## Forecast method: Damped Holt-Winters' multiplicative method
##
## Model Information:
## Damped Holt-Winters' multiplicative method
##
## Call:
## forecast::hw(y = dados_arima_geral, h = 12, seasonal = "multiplicative",
##
## Call:
## damped = TRUE)
##
## Smoothing parameters:
## alpha = 0.0018
## beta = 0.0018
## gamma = 1e-04
## phi = 0.9722
##
## Initial states:
## l = 13935464.3782
## b = 261373.1951
## s = 1.1319 1.3879 1.0967 0.8906 0.8931 0.8878
## 1.1368 0.9471 0.8965 0.9236 0.898 0.91
##
## sigma: 0.1471
##
## AIC AICc BIC
## 2038.737 2055.419 2076.435
##
## Error measures:
## ME RMSE MAE MPE MAPE MASE
## Training set -80814.54 2459330 1007718 -1.533386 4.975562 0.4320749
## ACF1
## Training set -0.04423105
##
## Forecasts:
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## Jan 2020 19428449 15765574 23091323 13826566 25030332
## Feb 2020 19208046 15586699 22829392 13669674 24746417
## Mar 2020 19791040 16059724 23522357 14084484 25497597
## Apr 2020 19245940 15617300 22874581 13696413 24795468
## May 2020 20366432 16526380 24206484 14493580 26239284
## Jun 2020 24486616 19869455 29103778 17425277 31547955
## Jul 2020 19153731 15541866 22765597 13629859 24677603
## Aug 2020 19297529 15658208 22936851 13731668 24863391
## Sep 2020 19274289 15638935 22909644 13714494 24834085
## Oct 2020 23769847 19285962 28253732 16912337 30627357
## Nov 2020 30122966 24439727 35806204 21431202 38814729
## Dec 2020 24602166 19959659 29244673 17502065 31702268autoplot(dados_arima_geral) +
autolayer(fc, series="HW multi damped", PI=FALSE)+
guides(colour=guide_legend(title="Predição mensal"))
## [1] 2587470526 Resultados
As predições para 2020 estão agrupadas na tabela abaixo:
7 Extra: XmR Chart
É possível utilizar uma carta de controle para monitorar a evolução das despesas. A carta considerada mais apropriada para tal fim foi a XmR. Esta carta não utiliza o desvio-padrão para determinar os limites de controle, mas o moving range. Uma explicação sucinta da carta XmR pode ser encontrada neste post. Antes de aplicar a carta, é necessário remover a sazonalidade presente nos dados.
# XmR chart ---------------------------------------------------------------
# removendo a sazonalidade
# referencia: Donald Wheeler - Make Sense of Data - capitulo 18
# https://www.staceybarr.com/measure-up/how-to-find-signals-in-your-seasonal-kpis/
ddd = dados_mensal$y
seasonal_average = matrix(NA,5,12)
cont=1
for(i in seq(1,60,12)){
seasonal_average[cont, ] = ddd[i:(i+11)]/mean(ddd[i:(i+11)])
cont = cont+1
}
# seasonal factor
seasonal_factor = colMeans(seasonal_average)
new_series = NULL
for(i in seq(1,60,12)){
new_series = c(new_series, ddd[i:(i+11)]/seasonal_factor)
}
# aplicando novamente a carta
dados_des = data.frame(ds = 1:60, y=new_series)
ggplot(dados_des, aes(x=ds, y=y, group=1)) +
geom_point() + geom_line() +
stat_QC(method="XmR", auto.label = T, label.digits = 4) +
ylab("Despesas") +
scale_x_discrete(expand = expand_scale(mult = .15))