Paixão por Dados

mafs: Analisando a eficácia dos modelos preditivos usados no pacote

Sun, 29 Jan 2017 00:00:00 +0000

Lancei recentemente a versão 0.0.2 do pacote mafs tanto no CRAN como no Github. Adicionei dois novos recursos:
* No data frame df_models criado, foi acrescentada uma variável referente ao tempo de execução (runtime) do modelo para a série temporal de input. Isso foi uma necessidade devido ao fato de alguns modelos levarem muito tempo para rodar. Esse dado será importante para ser levado em consideração no segundo recurso adicionado:
* A função select_forecast() agora tem um argumento chamado dont_apply, no qual o usuário poderá inserir os modelos (em forma de vetor de caracteres) que não deverão ser usados na função para criar modelos preditivos. Esse recurso é muito útil para excluir da função os pacotes que demoram muito e que não costumam entregar bons resultados.

Neste post, farei uma demonstração da aplicação do pacote mafs em diversas séries temporais diferentes.

# carregar pacotes importantes
library(fpp)
library(dplyr)
library(ggplot2)
library(mafs)
library(magrittr)
library(ggrepel)

Os dados

As séries temporais usadas pertencem ao pacote fpp, que disponibiliza as séries temporais usadas no livro do Hyndman.

Vamos armazenar essas diversas séries em uma lista:

data_fpp <- list(a10 = a10, ausair = ausair, ausbeer = ausbeer,
                 austa = austa, austourists = austourists,
                 cafe = cafe, debitcards = debitcards,
                 elecequip = elecequip, elecsales = elecsales,
                 euretail = euretail, guinearice = guinearice,
                 h02 = h02, livestock = livestock,
                 oil = oil, sunspotarea = sunspotarea,
                 usmelec = usmelec, wmurders = wmurders
                 )
# confirmando que todas as séries são objetos do tipo 'ts', que é a classe
# usada como input para a funcão select_forecast()
lapply(data_fpp, class) %>% unlist

##         a10      ausair     ausbeer       austa austourists        cafe 
##        "ts"        "ts"        "ts"        "ts"        "ts"        "ts" 
##  debitcards   elecequip   elecsales    euretail  guinearice         h02 
##        "ts"        "ts"        "ts"        "ts"        "ts"        "ts" 
##   livestock         oil sunspotarea     usmelec    wmurders 
##        "ts"        "ts"        "ts"        "ts"        "ts"

Será que todas essas séries são mensais? Podemos confirmar essa informação com a função frequency().

lapply(data_fpp, frequency) %>% unlist

##         a10      ausair     ausbeer       austa austourists        cafe 
##          12           1           4           1           4           4 
##  debitcards   elecequip   elecsales    euretail  guinearice         h02 
##          12          12           1           4           1          12 
##   livestock         oil sunspotarea     usmelec    wmurders 
##           1           1           1          12           1

# fazer um gráfico
lapply(data_fpp, frequency) %>% unlist %>% table %>% barplot()

Temos então 8 séries anuais (frequência 1), 4 trimestrais e 5 mensais. Esse será um bom teste para o pacote mafs.

Modelagem

Para aplicar a função select_forecast() em todas as séries, é necessário um for loop:

# criar lista vazia para salvar os resultados
df_results <- vector("list", length = length(data_fpp))

# iniciar loop
for (i in 1:length(data_fpp)){
  print(i)
  # salvar serie do loop
  data <- data_fpp[[i]]
  # usar tamanho da serie de teste de 6. o horizonte de previsão não importa
  # nao usar modelo híbrido apenas como demonstração do novo arg dont_apply
  mafs_result <- select_forecast(data, test_size = 6, horizon = 3,
                                 error = "MAPE", dont_apply = "hybrid")
  
  mafs_result <- mafs_result$df_models
  # acrescentar nome da série no dataframe dos resultados
  mafs_result$serie <- names(data_fpp)[i]
  df_results[[i]] <- mafs_result
}

# converter para data frame
df_results <- bind_rows(df_results)
saveRDS(df_results, "/home/sillas/R/data/2017-01-29-mafs02.Rds")

Análise dos dados

Uma rápida visualização tabular dos resultados:

head(df_results)

##        model         ME      RMSE       MAE        MPE      MAPE     MASE
## 1 auto.arima -0.5266278  2.726579  2.317648  -3.404950 11.368897 1.867733
## 2       bats -0.6987866  2.543283  2.302901  -3.848498 11.063269 1.855849
## 3    croston  0.9954976  3.783578  2.770328   2.119148 11.608482 2.232536
## 4        ets -0.1664123  2.315405  2.059765  -1.141468  9.653898 1.659911
## 5      meanf 12.1695849 12.705245 12.169585  52.965233 52.965233 9.807155
## 6      naive -3.3000045  4.920821  4.586426 -17.426919 21.763365 3.696083
##          ACF1 best_model runtime_model serie
## 1 -0.48291837        ets         1.508   a10
## 2 -0.50875972        ets         4.643   a10
## 3 -0.07557645        ets         1.717   a10
## 4 -0.49674756        ets         1.501   a10
## 5 -0.07557645        ets         0.001   a10
## 6 -0.07557645        ets         0.004   a10

Vamos ver então quais modelos despontam como os mais rápidos e os mais eficientes.

Primeiro, um gráfico do tempo de execução por pacote

ggplot(df_results, aes(x = reorder(model, runtime_model, FUN = median),
                       y = runtime_model)) +
  geom_boxplot() +
  labs(x = NULL, y = "Tempo de execução (s)") +
  coord_flip()

Percebe-se que os modelos tbats() e bats() são os mais computacionalmente custosos. Os mais rápidos são, sem surpresas, os modelos de previsão simples, como o da média simples e o modelo ingênuo.

Agora, um gráfico da acurácia dos modelos de acordo com a métrica MAPE:

ggplot(df_results, aes(x = reorder(model, -MAPE, FUN = median),
                       y = MAPE)) +
  geom_boxplot() +
  labs(x = NULL, y = "MAPE (%)") +
  coord_flip()

Alguns modelos apresentaram outliers, o que distorceu o boxplot. Visto que esse gráfico não serviu para muita coisa, é melhor resumir a acurácia por meio da mediana simples do MAPE:

# calcular a mediana do MAPE para cada modelo
df_results %>%
  group_by(model) %>%
  summarise(MAPE_mediano = median(MAPE)) %>%
  ggplot(aes(x = reorder(model, -MAPE_mediano), y = MAPE_mediano)) +
    geom_bar(stat = "identity") +
    labs(x = NULL, y = "MAPE mediano") +
    coord_flip() +
    theme_bw()

Vê-se que os modelos que obtiveram os melhores resultados foram os modelos stlm(), seja por arima ou por ets. Não vou entrar em detalhes estatísticos sobre o porquê desse resultado para não fugir do escopo do post.

Vamos então analisar a relação entre tempo de execução e eficácia dos modelos por meio de um gráfico de pontos.

ggplot(df_results, aes(x = runtime_model, y = MAPE)) + 
  geom_point() +
  theme_bw()

É difícil visualizar alguma relação muito clara nesse gráfico. Ao invés de plotar todos os data points, vamos resumir os dados pela mediana do MAPE e do runtime para cada modelo.

df_results %>%
  group_by(model) %>%
  summarise(MAPE_mediano = median(MAPE),
            runtime_mediano = median(runtime_model)) %>%
  ggplot(aes(y = runtime_mediano,  x = MAPE_mediano)) +
    geom_point() +
    labs(y =  "Tempo de execução mediano (s)",
         x = "MAPE mediano (%)") +
    geom_text_repel(aes(label = model)) +
    theme_bw()

Novamente, não é possível determinar que a acurácia do modelo influencia o seu tempo de execução.

Análise da influência da frequência da série

Influência no tempo de execução

Já que estamos trabalhando ao mesmo tempo com séries trimestrais, mensais e anuais, por que não analisar a influência da variável da frequência da série nos resultados obtidos com o pacote?

Primeiro, vamos criar um data frame com características sobre as séries analisadas

df_series <- data.frame(
  serie = names(data_fpp),
  frequencia = lapply(data_fpp, frequency) %>% unlist,
  tamanho_serie = lapply(data_fpp, length) %>% unlist
)

# juntar ao dataframe de resultados
df_results %<>% left_join(df_series, by = "serie")

names(data_fpp)

##  [1] "a10"         "ausair"      "ausbeer"     "austa"       "austourists"
##  [6] "cafe"        "debitcards"  "elecequip"   "elecsales"   "euretail"   
## [11] "guinearice"  "h02"         "livestock"   "oil"         "sunspotarea"
## [16] "usmelec"     "wmurders"

Para demosntrar a influência da frequência da série no tempo de execução dos modelos, uma boa opção de visualização é o gráfico de densidade:

df_results$frequencia %<>% as.factor

df_results %>%
  filter(runtime_model <= quantile(runtime_model, 0.90)) %>%
  ggplot(aes(x = runtime_model, color = frequencia)) + geom_density()

É difícil tirar qualquer tipo de conclusão a partir do gráfico acima. Dá para afirmar que a probabilidade de um modelo ter um runtime muito curto (de até 0,25 segundos) é menor para séries mensais e trimestrais do que para mensais.

Um teste estatístico que pode ser usado para mensura essa relação é o ANOVA e o teste de Tukey:

anova.fit <- aov(runtime_model ~ frequencia, data = df_results)
summary(anova.fit)

##              Df Sum Sq Mean Sq F value Pr(>F)  
## frequencia    2    221  110.36   3.599 0.0287 *
## Residuals   262   8035   30.67                 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

# Teste de Tukey
anova.fit %>% TukeyHSD()

##   Tukey multiple comparisons of means
##     95% family-wise confidence level
## 
## Fit: aov(formula = runtime_model ~ frequencia, data = df_results)
## 
## $frequencia
##           diff        lwr      upr     p adj
## 4-1  0.4026234 -1.6041101 2.409357 0.8840947
## 12-1 2.0767411  0.1990179 3.954464 0.0260572
## 12-4 1.6741176 -0.4496095 3.797845 0.1530838

O resultado do teste ANOVA aponta um valor significante (valor p menor que 0,05), o que indica que a hipótese nula de que a frequência da série não influencia o tempo de execução do ajuste pode ser rejeitado.

Já o teste de Tukey indica que apenas a hipótese nula só pode ser rejeitada para a comparação entre séries mensais e anuais. Para as outras duas comparações, o valor p é maior que 0,05.

Influência na acurácia

df_results %>%
  filter(MAPE <= quantile(MAPE, 0.90)) %>%
  ggplot(aes(x = MAPE, color = frequencia)) + geom_density()

anova.fit <- aov(MAPE ~ frequencia, data = df_results)
summary(anova.fit)

##              Df   Sum Sq Mean Sq F value   Pr(>F)    
## frequencia    2   900822  450411   10.14 5.71e-05 ***
## Residuals   262 11633340   44402                     
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

# Teste de Tukey
anova.fit %>% TukeyHSD()

##   Tukey multiple comparisons of means
##     95% family-wise confidence level
## 
## Fit: aov(formula = MAPE ~ frequencia, data = df_results)
## 
## $frequencia
##             diff        lwr       upr     p adj
## 4-1  -120.929333 -197.28734 -44.57133 0.0006774
## 12-1 -115.580724 -187.02977 -44.13168 0.0005011
## 12-4    5.348609  -75.46111  86.15832 0.9866718

Conclusão

Uma próxima análise poderia incluir um número maior de séries e de frequências diferentes, como diárias e semanais.

Meu primeiro pacote R: aplicação para série temporal do varejo

Thu, 27 Oct 2016 00:00:00 +0000

Depois de um longo hiato devido à falta de tempo, o blog está de volta à ativa.

Um dos (muitos) motivos de minha ausência tem sido a elaboração do meu TCC, que é sobre previsão de demanda. Eu desenvolvi um sistema que seleciona automaticamente o melhor modelo de previsão dentre os disponíveis no pacote forecast para uma dada série temporal de acordo com a métrica de erro escolhida pelo usuário. O nome do pacote é mafs e já está disponível em meu Github para ser baixado e instalado gratuitamente. Notem, porém, que este é meu primeiro pacote R e eu provavelmente acabei cometendo muitos erros de principiante. Por isso, o pacote ainda é limitado e pode não funcionar em algumas situações que eu não vislumbrei. Uma possível limitação do pacote, por exemplo, é que ele só foi testado para séries mensais e não de outros períodos, como semanais, diárias ou trimestrais.

Demonstração do pacote

Apresentação e análise exploratória dos dados

Para demonstrar na prática como funciona o pacote, irei analisar neste post uma série temporal de periodicidade mensal referente ao volume de vendas do varejo, tema que tenho pesquisado recentemente e obtida no site do IBGE. O dataset será disponibilizado no repositório do blog.

# carregar bibliotecas importantes
library(mafs)
library(magrittr)
library(forecast)
library(ggplot2)
# importar dados
varejo <- read.csv2("https://raw.githubusercontent.com/sillasgonzaga/sillasgonzaga.github.io/master/data/varejo.csv",
                    stringsAsFactors = FALSE)
# exibir dados
head(varejo); tail(varejo)

##   Período Moveis.e.eletrodomesticos
## 1  jan/00                      29.5
## 2  fev/00                      28.4
## 3  mar/00                      30.1
## 4  abr/00                      28.8
## 5  mai/00                      34.8
## 6  jun/00                      30.5

##     Período Moveis.e.eletrodomesticos
## 185  mai/15                     103.8
## 186  jun/15                      91.6
## 187  jul/15                      94.3
## 188  ago/15                      91.1
## 189  set/15                      90.2
## 190                                NA

# retirar última linha, que veio em branco
varejo <- varejo[1:(nrow(varejo)-1), ]

Como pode-se ver, a série temporal vai desde Janeiro de 2000 a Setembro de 2015. Essa informação é importante para criar um objeto da class ts que será usado como input das funções do pacote mafs.

# transformar para série temporal
varejo <- ts(varejo[, 2], start = c(2000, 1), frequency = 12)
# Visualizar série
plot(varejo)

# Visualizar decomposição sazonal da série
varejo %>% decompose %>% plot

O gráfico da série decomposta mostra que há fortes componentes de tendência e sazonalidade na série. O componente aleatório possui média de 0,13, o que, por ser próxima a zero, nos leva a acreditar que a decomposição foi bem sucedida. O elemento sazonal da série também pode ser analisado nos gráficos a seguir.

# função ggmonthplot do pacote forecast
ggmonthplot(varejo)

# estratificação por mês
ggseasonplot(varejo, year.labels = TRUE) + geom_point() + theme_bw()

A partir dos dois gráficos é possível fazer uma observação interessante: A tendência é praticamente alternada. A série sempre cai de Janeiro a Fevereiro, sobe em Março, cai em Abril, sobe em Maio, cai em Junho, sobe ou se mantém estável em Julho, sobe em Agosto, cai ou se mantém estável em Setembro, e sobe de Outubro a Dezembro. A diferença mais evidente ocorrente entre os meses de Novembro e Dezembro.

Poderiam ser feitas mais algumas análises exploratórias, mas eu acabaria fugindo do escopo do post.

Aplicação do modelo.

O pacote mafs é um wrapper de diversos modelos presentes no pacote forecast, que são:

available_models()

##  [1] "auto.arima" "ets"        "nnetar"     "tbats"      "bats"      
##  [6] "stlm_ets"   "stlm_arima" "StructTS"   "meanf"      "naive"     
## [11] "snaive"     "rwf"        "rwf_drift"  "splinef"    "thetaf"    
## [16] "croston"    "tslm"       "hybrid"

Cada um desses modelos pode ser aplicado à série temporal analisada por meio da função mafs::apply_selected_model(). Por exemplo, para o modelo de redes neurais, temos:

apply_selected_model(varejo, "nnetar", horizon = 6) %>% forecast(h  = 6) %>% plot

Imagine-se agora na situação onde vocë é um analista de previsão e precisa realizar, periodicamente, projeções de centenas ou milhares de séries temporais. Seria impraticável testar todos esses 18 modelos disponíveis, não seria? Pensando nisso, a principal função do mafs, chamada select_forecast() automatiza esse processo. Ela depende de quatro parâmetros:
* x, que é a série temporal de input;
* test_size, que é o tamanho da série de teste a ser usado para mensurar a acurácia das previsões obtidas;
* horizon, o tamanho do horizonte de previsão; * error, a métrica de erro para definir o melhor modelo.

O código da função pode ser conferido aqui. Resumidamente, ela separa a série de input em duas: a série de treino, usada para construir o ajuste dos modelos, e a série de teste, usada para mensurar a previsão obtida com os ajustes nas séries de treino em comparação com a série original. A partir das previsões obtidas, a de melhor acurácia (de acordo com a métrica escolhida pelo usuário) é selecionada para prever os valores futuros da série.

Após fazer tudo isso, a função retorna como output três objetos, como pode ser conferido em sua documentação (help("select_forecast")).

output <- select_forecast(varejo, test_size = 6, horizon = 6, error = "MAPE")
# output com resultado de modelos
output$df_models

##         model        ME     RMSE       MAE       MPE     MAPE     MASE
## 1  auto.arima -11.87629 12.25375 11.876285 -12.63291 12.63291 1.683951
## 2        bats -14.05779 14.38923 14.057791 -15.05612 15.05612 1.993269
## 3     croston -22.86110 23.31736 22.861101 -24.61078 24.61078 3.241499
## 4         ets -10.50871 11.15770 10.508709 -11.27795 11.27795 1.490041
## 5      hybrid -14.06093 14.34473 14.060933 -15.01467 15.01467 1.993714
## 6       meanf  25.49699 25.90687 25.496995  26.97627 26.97627 3.615245
## 7       naive  -9.45000 10.50579  9.583333 -10.30420 10.43265 1.358831
## 8      nnetar -19.77968 22.52728 19.779681 -20.68638 20.68638 2.804582
## 9         rwf  -9.45000 10.50579  9.583333 -10.30420 10.43265 1.358831
## 10  rwf_drift -10.87115 11.95716 10.871154 -11.83788 11.83788 1.541432
## 11     snaive -18.16667 18.49784 18.166667 -19.29829 19.29829 2.575871
## 12    splinef -26.14144 26.54988 26.141436 -28.11256 28.11256 3.706622
## 13 stlm_arima -21.31549 21.63862 21.315487 -22.84688 22.84688 3.022345
## 14   stlm_ets -17.70250 18.02916 17.702498 -18.98920 18.98920 2.510056
## 15   StructTS -14.82386 15.16935 14.823861 -15.77388 15.77388 2.101891
## 16      tbats -13.34142 13.85944 13.341419 -14.26644 14.26644 1.891694
## 17     thetaf -14.75199 15.18143 14.751994 -15.76853 15.76853 2.091701
## 18       tslm -25.84932 26.10141 25.849322 -27.70415 27.70415 3.665202
##           ACF1 best_model runtime_model
## 1  -0.24342789      naive         1.471
## 2   0.36081896      naive         3.064
## 3  -0.21035874      naive         0.975
## 4   0.40036466      naive         1.547
## 5   0.11501661      naive         9.041
## 6  -0.21035874      naive         0.003
## 7  -0.21035874      naive         0.004
## 8  -0.09009255      naive         0.984
## 9  -0.21035874      naive         0.002
## 10 -0.06220684      naive         0.004
## 11 -0.25244021      naive         0.003
## 12 -0.18889000      naive         0.437
## 13  0.50840456      naive         0.103
## 14  0.50385963      naive         0.029
## 15 -0.26397115      naive         0.430
## 16  0.30026636      naive         6.824
## 17  0.19311316      naive         0.011
## 18  0.50145846      naive         0.003

# output com valores previstos e reais
output$df_comparison

##         time forecasted observed
## 1 2015-04-03      103.4     92.7
## 2 2015-05-03      103.4    103.8
## 3 2015-06-02      103.4     91.6
## 4 2015-07-03      103.4     94.3
## 5 2015-08-02      103.4     91.1
## 6 2015-09-02      103.4     90.2

# output com valores previstos, incluindo o intervalo de confiança de 80 e de 95%
output$best_forecast

##          Point Forecast    Lo 80    Hi 80    Lo 95    Hi 95
## Oct 2015           90.2 72.52035 107.8796 63.16131 117.2387
## Nov 2015           90.2 65.19720 115.2028 51.96152 128.4385
## Dec 2015           90.2 59.57795 120.8220 43.36762 137.0324
## Jan 2016           90.2 54.84070 125.5593 36.12262 144.2774
## Feb 2016           90.2 50.66710 129.7329 29.73965 150.6603
## Mar 2016           90.2 46.89388 133.5061 23.96901 156.4310

O output de output$df_models mostra que o modelo de menor MAPE foi curiosamente o naive, que corresponde simplesmente a usar o último valor observado como previsão dos próximos valores. Tal previsão pode ser conferida visualmente com outra função do mafs, chamada gg_fit()

gg_fit(varejo, 6, "naive") + theme_bw() + theme(legend.position = "bottom")

Para avaliar a eficiência do meu método, pode-se calcular o MAPE real, isto é, o erro relativo médio entre os valores previstos e os reais, presentes no objeto output$df_comparison

x <- output$df_comparison
# Calcular MAPE real
mape_real <- 100 * abs(x$forecasted - x$observed)/x$observed
# mostrar mape mês a mês
mape_real

## [1] 11.5426106  0.3853565 12.8820961  9.6500530 13.5016465 14.6341463

# mostrar mape médio
mean(mape_real)

## [1] 10.43265

Obtivemos um MAPE médio de 10,43%.

Ideias para o futuro

Devido à automatização possibilitada pelo pacote, é possível pensar em diversas outras análises e testes de hipóteses. Por exemplo: o tamanho da série influencia o desempenho do sistema? Isso poderia ser feito variando o argumento test_size, calculando o MAPE real para cada valor do argumento e depois comparando os resultados. Talvez isso tema de um futuro post.