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.

Correlação entre o dólar e ações de empresas do Índice Bovespa

Sat, 07 Nov 2015 00:00:00 +0000

Introdução

Este projeto surgiu de uma situação que eu estou lidando no momento: digamos que você deseja investir dinheiro para fazer uma viagem internacional durante suas férias daqui a 5 anos. Como os gastos da viagem serão indexados pelo dólar, não basta apenas escolher um bom investimento como títulos do tesouro ou outras modalidades de renda fixa. Por mais que os rendimentos deles possam apresentar enormes vantagens para seus investidores, eles precisam ser maiores que a valorização do dólar, caso contrário você correrá o risco de chegar no fim desse período de 5 anos sem o dinheiro necessário para realizar seu sonho. Se já é muito difícil prever quanto custará o dólar na próxima semana, prever seu valor em 5 anos é impossível.

Independentemente se você deseja realizar uma viagem internacional ou não, muitas pessoas certamente já desejaram saber como o desempenho do dólar afeta o rendimento de ações na bolsa. É disto que o post inaugural deste blog se trata: talvez seja uma boa decisão investir em ações de empresas que acompanhem o comportamento do dólar, isto é, que aumentem quando o dólar aumenta. Em estatística, isso é chamado de correlação:

Diz-se que existe correlação entre duas ou mais variáveis quando as alterações sofridas por uma delas são acompanhadas por modificações nas outras. Ou seja, no caso de duas variáveis x e y os aumentos (ou diminuições) em x correspondem a aumentos (ou diminuições) em y. Assim, a correlação revela se existe uma relação funcional entre uma variável e as restantes.

Programação e resultados

Todo o processo de análise foi feito no R, usando dados de cotações obtidos no Yahoo Finance. Segue abaixo o código

#1 Baixar série historica do dolar de 2 anos
library(quantmod)
library(plyr)
library(dplyr)
library(corrplot)
library(ggplot2)
library(reshape2)
library(lubridate)

Após carregar as bibliotecas que serão usadas no código, é usado o pacote quantmod para baixar e plotar uma série histórica do dólar. Por tentativa e erro, defini que o período de análise seria entre 25 de agosto de 2013 até 01 de agosto de 2015.

datainicial = "2013-08-25"
datafinal = "2015-08-01"
cotacoes = getFX("USD/BRL", from=datainicial, to=datafinal, env=NULL)
lineChart(cotacoes)

Um pouco de transformação de dados (o famoso Data Wrangling) necessária para transformar a variável cotacoes de classe xts em dataframes:

cotacoes = as.data.frame(cotacoes)
cotacoes$Data = rownames(cotacoes)
rownames(cotacoes) = NULL

Agora já podemos baixar as cotações das empresas. Já que existem centenas de empresas listadas , eu escolhi apenas as que compõem o Índice Bovespa. Para isso, eu salvei a lista das empresas em um arquivo csv e a carreguei no R.

ibovespa <- read.csv2("https://raw.githubusercontent.com/sillasgonzaga/sillasgonzaga.github.io/master/data/ibovespa.csv")
suffix = as.data.frame(replicate(nrow(ibovespa), ".SA")) 

#Um pouco de Data Wrangling para concatenar os códigos das empresas com o sufixo.

temp = cbind(ibovespa, suffix)
ibovespa = apply(temp, 1,
               function(x) paste0(toString(x[1]), toString(x[2]))
               )

Depois de carregar os códigos das empresas e adicionar o sufixo .SA (sufixo que identifica as ações da Bovespa), hora de baixar as séries históricas de cotações de cada empresa.

#Baixar cotacões
getSymbols(ibovespa[1:36], auto.assign = TRUE, from=datainicial, to=datafinal) #O 37(IBOV.SA) dá problema

##  [1] "ABEV3.SA" "BBAS3.SA" "BBDC3.SA" "BBDC4.SA" "BBSE3.SA" "BRAP4.SA"
##  [7] "BRFS3.SA" "BRKM5.SA" "BRML3.SA" "BRPR3.SA" "BVMF3.SA" "CCRO3.SA"
## [13] "CESP6.SA" "CIEL3.SA" "CMIG4.SA" "CPFE3.SA" "CPLE6.SA" "CRUZ3.SA"
## [19] "CSAN3.SA" "CSNA3.SA" "CTIP3.SA" "CYRE3.SA" "DTEX3.SA" "ECOR3.SA"
## [25] "ELET3.SA" "ELET6.SA" "EMBR3.SA" "ENBR3.SA" "ESTC3.SA" "FIBR3.SA"
## [31] "GFSA3.SA" "GGBR4.SA" "GOAU4.SA" "GOLL4.SA" "HGTX3.SA" "HYPE3.SA"

getSymbols(ibovespa[38:40], auto.assign = TRUE, from=datainicial, to=datafinal) #O 41(IBOV.SA) dá problema

## [1] "ITSA4.SA" "ITUB4.SA" "JBSS3.SA"

getSymbols(ibovespa[42:56], auto.assign = TRUE, from=datainicial, to=datafinal) #O 57(IBOV.SA) dá problema

##  [1] "KROT3.SA" "LAME4.SA" "LREN3.SA" "MRFG3.SA" "MRVE3.SA" "MULT3.SA"
##  [7] "NATU3.SA" "OIBR4.SA" "PCAR4.SA" "PETR3.SA" "PETR4.SA" "POMO4.SA"
## [13] "QUAL3.SA" "RENT3.SA" "RUMO3.SA"

getSymbols(ibovespa[58:length(ibovespa)], auto.assign = TRUE, from=datainicial, to=datafinal)

##  [1] "SBSP3.SA" "SMLE3.SA" "SUZB5.SA" "TBLE3.SA" "TIMP3.SA" "UGPA3.SA"
##  [7] "USIM5.SA" "VALE3.SA" "VALE5.SA" "VIVT4.SA"

Como exemplo, esta é o arquivo de cotações da Petrobras baixado, seguido por um gráfico:

head(PETR3.SA)

##            PETR3.SA.Open PETR3.SA.High PETR3.SA.Low PETR3.SA.Close
## 2013-08-26         17.50         17.69        17.14          17.14
## 2013-08-27         16.98         17.12        16.53          16.57
## 2013-08-28         16.60         16.75        16.10          16.17
## 2013-08-29         16.26         16.49        15.96          15.97
## 2013-08-30         16.26         16.49        15.71          16.05
## 2013-09-02         16.38         16.43        16.05          16.15
##            PETR3.SA.Volume PETR3.SA.Adjusted
## 2013-08-26         6789100          16.53003
## 2013-08-27        10819800          15.98032
## 2013-08-28         7769900          15.59455
## 2013-08-29         6036800          15.40167
## 2013-08-30        13563200          15.47882
## 2013-09-02         6689200          15.57526

lineChart(PETR3.SA)

As variáveis criadas pelo quantmod com as cotações baixadas do Yahoo Finance são da classe xts. Além disso, é apenas na última coluna (Adjusted) que estamos interessados, além, claro, da coluna referente às datas. Portanto, foi criada uma função que transforma a variável em dataframe e extrai apenas a coluna referente ao Adjusted:

f = function(x) {
  temp = as.data.frame(x)
  result = as.data.frame(temp[,6])
  names(result) = names(temp)[6]
  result$Data = rownames(temp)
  return(result)
}

Criada a função, basta aplicá-la em cada uma das variáveis. Infelizmente, tive de fazer isso uma por uma, manualmente, porque não consiga pensar em um for loop que iterasse em todos os arquivos da classe xts. Sugestões são muito bem vindas.

ABEV3.SA = f(ABEV3.SA)
BBAS3.SA = f(BBAS3.SA)
BBDC3.SA = f(BBDC3.SA)
BBDC4.SA = f(BBDC4.SA)
BBSE3.SA = f(BBSE3.SA)
BRAP4.SA = f(BRAP4.SA)
BRFS3.SA = f(BRFS3.SA) 
BRKM5.SA = f(BRKM5.SA)
BRML3.SA = f(BRML3.SA)
BRPR3.SA = f(BRPR3.SA)
BVMF3.SA = f(BVMF3.SA)
CCRO3.SA = f(CCRO3.SA)
CESP6.SA = f(CESP6.SA)
CIEL3.SA = f(CIEL3.SA)
CMIG4.SA = f(CMIG4.SA)
CPFE3.SA = f(CPFE3.SA)
CPLE6.SA = f(CPLE6.SA)
CRUZ3.SA = f(CRUZ3.SA)
CSAN3.SA = f(CSAN3.SA)
CSNA3.SA = f(CSNA3.SA)
CTIP3.SA = f(CTIP3.SA)
CYRE3.SA = f(CYRE3.SA)
DTEX3.SA = f(DTEX3.SA)
ECOR3.SA = f(ECOR3.SA)
ELET3.SA = f(ELET3.SA)
ELET6.SA = f(ELET6.SA)
EMBR3.SA = f(EMBR3.SA)
ENBR3.SA = f(ENBR3.SA)
ESTC3.SA = f(ESTC3.SA)
FIBR3.SA = f(FIBR3.SA)
GFSA3.SA = f(GFSA3.SA)
GGBR4.SA = f(GGBR4.SA)
GOAU4.SA = f(GOAU4.SA)
GOLL4.SA = f(GOLL4.SA)
HGTX3.SA = f(HGTX3.SA)
HYPE3.SA = f(HYPE3.SA)
ITSA4.SA = f(ITSA4.SA)
ITUB4.SA = f(ITUB4.SA)
JBSS3.SA = f(JBSS3.SA)
KROT3.SA = f(KROT3.SA)
LAME4.SA = f(LAME4.SA)
LREN3.SA = f(LREN3.SA)
MRFG3.SA = f(MRFG3.SA)
MRVE3.SA = f(MRVE3.SA)
MULT3.SA = f(MULT3.SA)
NATU3.SA = f(NATU3.SA)
OIBR4.SA = f(OIBR4.SA)
PCAR4.SA = f(PCAR4.SA)
PETR3.SA = f(PETR3.SA)
PETR4.SA = f(PETR4.SA)
POMO4.SA = f(POMO4.SA)
QUAL3.SA = f(QUAL3.SA)
RENT3.SA = f(RENT3.SA)
RUMO3.SA = f(RUMO3.SA)
SBSP3.SA = f(SBSP3.SA)
SMLE3.SA = f(SMLE3.SA)
SUZB5.SA = f(SUZB5.SA)
TBLE3.SA = f(TBLE3.SA)
TIMP3.SA = f(TIMP3.SA)
UGPA3.SA = f(UGPA3.SA)
USIM5.SA = f(USIM5.SA)
VALE3.SA = f(VALE3.SA)
VALE5.SA = f(VALE5.SA)
VIVT4.SA = f(VIVT4.SA)

O último passo da etapa de transformação de dados consiste em juntar todas as ações das empresas, além das cotações do dólar, em uma variável só, chamada de df_final. Nesta etapa, tive um problema semelhante à anterior: não sabia muito bem como criar um for loop para não ter de escrever as variáveis manualmente. Ainda bem que o iBovespa só é composto por 67 empresas.

df_final = join_all(dfs=list(cotacoes,
                              ABEV3.SA,BBAS3.SA,BBDC3.SA,BBDC4.SA,BBSE3.SA,BRAP4.SA,BRFS3.SA,BRKM5.SA,BRML3.SA,
                              BRPR3.SA,BVMF3.SA,CCRO3.SA,CESP6.SA,CIEL3.SA,CMIG4.SA,CPFE3.SA,CPLE6.SA,CRUZ3.SA,
                              CSAN3.SA,CSNA3.SA,CTIP3.SA,CYRE3.SA,DTEX3.SA,ECOR3.SA,ELET3.SA,ELET6.SA,EMBR3.SA,
                              ENBR3.SA,ESTC3.SA,FIBR3.SA,GFSA3.SA,GGBR4.SA,GOAU4.SA,GOLL4.SA,HGTX3.SA,HYPE3.SA,
                              ITSA4.SA,ITUB4.SA,JBSS3.SA,KROT3.SA,LAME4.SA,LREN3.SA,MRFG3.SA,MRVE3.SA,MULT3.SA,
                              NATU3.SA,OIBR4.SA,PCAR4.SA,PETR3.SA,PETR4.SA,POMO4.SA,QUAL3.SA,RENT3.SA,RUMO3.SA,
                              SBSP3.SA,SMLE3.SA,SUZB5.SA,TBLE3.SA,TIMP3.SA,UGPA3.SA,USIM5.SA,VALE3.SA,VALE5.SA,
                              VIVT4.SA), by="Data")

Agora, um novo dataframe sem a coluna de data é criado. Isso é necessário para criar a matriz de correlação, que só aceita como argumento um dataframe 100% composto de elementos numéricos.

df_final2 = na.omit(df_final)
df_final2 = select(df_final2, -Data)

Finalmente, podemos prosseguir com a criação da matriz de correlação usando a função base cor():

m = cor(df_final2)

Como a matriz resultante m é muito grande (64 linhas e 64 colunas), vou mostrar apenas uma parte dela:

m[1:5,1:5]

##                        USD.BRL ABEV3.SA.Adjusted BBAS3.SA.Adjusted
## USD.BRL            1.000000000       0.006523715        -0.7834658
## ABEV3.SA.Adjusted  0.006523715       1.000000000         0.2606677
## BBAS3.SA.Adjusted -0.783465819       0.260667660         1.0000000
## BBDC3.SA.Adjusted -0.559099285       0.338385543         0.7049489
## BBDC4.SA.Adjusted -0.772544701       0.236813392         0.9015431
##                   BBDC3.SA.Adjusted BBDC4.SA.Adjusted
## USD.BRL                  -0.5590993        -0.7725447
## ABEV3.SA.Adjusted         0.3383855         0.2368134
## BBAS3.SA.Adjusted         0.7049489         0.9015431
## BBDC3.SA.Adjusted         1.0000000         0.8857323
## BBDC4.SA.Adjusted         0.8857323         1.0000000

Os rótulos das linhas e colunas são referentes aos, digamos, indicadores (USD.BRL é a cotação do dólar). Os números dentro da matriz correspondem a correlação entre a variável da linha e a da coluna. Apenas com esta pequena fração da matriz, já é possível observar algumas correlações muito interessantes: - O dólar apresenta correlações negativas muito fortes (-0,77 e -0,75) com as ações do Banco do Brasil ON (BBAS3) e Bradesco (BBDC4), respectivamente. Ou seja, na maioria das vezes quando o dólar sobe, as ações desses dois bancos caem e vice-versa. Será uma tendência com todos os bancos listados na bolsa?
- Existe uma correlação positiva muito forte (0,90) entre as ações do Bradesco e do Banco do Brasil.

Além disso, é possível saber facilmente qual a correlação negativa mais forte dentre as cotações analisadas:

min(m)

## [1] -0.882108

which(m == min(m), arr.ind=TRUE)

##                   row col
## OIBR4.SA.Adjusted  48  29
## ENBR3.SA.Adjusted  29  48

A correlação negativa mais forte (-0,88), sabe-se lá o porquê, é entre a Oi e a EDP Energias do Brasil. Para comprovar este fato, veja este gráfico gerado com o ggplot2:

temp = select(df_final, Data, OIBR4.SA.Adjusted, ENBR3.SA.Adjusted)
temp = na.omit(temp)
temp = melt(temp, "Data")
levels(temp$variable) = c("Oi", "EDP Energias\n do Brasil")
ggplot(temp, aes(x=ymd(Data), value)) +  geom_line() +
  facet_grid(variable~., scales="free") +
  labs(title="Comparacão entre açoes da Oi e da EDP", x="Data", y="Valor")

Olhando o gráfico, pode-se inferir que a existência de outliers (comportamento anômalo) de subida e descida bruscas que as ações da Oi tiveram no fim de 2014 pode ter influenciado no cálculo da correlação. A título de curiosidade, vamos fazer a mesma análise com a segunda correlação negativa mais forte:

which(m == min( m[m!=min(m)] ), arr.ind=TRUE)

##                   row col
## BVMF3.SA.Adjusted  12   1
## USD.BRL             1  12

temp = select(df_final, Data, USD.BRL, BVMF3.SA.Adjusted)
temp = na.omit(temp)
temp = melt(temp, "Data")
levels(temp$variable) = c("Dólar", "BM&F Bovespa")
ggplot(temp, aes(x=ymd(Data), value)) +  geom_line() +
  facet_grid(variable~., scales="free") +
  labs(title="Comparacão entre dólar e açoes da BM&F Bovespa", x="Data", y="Valor")

Agora sim fica fácil percer a correlação negativa entre as variáveis: nos períodos quando o dólar sobe, as ações da BMF Bovespa caem (com algumas exceções) e vice-versa.

Existe um método ainda mais fácil de observar correlações entre um maior número de variáveis, como o do nosso exemplo(64): o gráfico de correlação, também chamado de correlograma.

Na verdade, 64 variáveis ainda é um número alto para se plotar em um gráfico. Por tentativa e erro, definir que o correlograma irá exibir apenas 15 indicadores, sendo eles o dólar e outros 14 selecionados aleatoriamente.

m2 = (df_final2[, c(1, runif(9,min=2, max=65))])
m2 = cor(m2)
corrplot(m2, method="color", tl.cex = 1, type="full", addCoef.col = "white")

Aliás, é bom que se diga que eu só selecionei a seed 123 (que fixa a escolha de números aleatórios pelo R), ou seja, se você tentar esse mesmo código, provavelmente sua matriz não terá os mesmos indicadores da mostrada aqui.

Dois pontos interessantes:

Existe uma correlação positiva altísssima (0,96, sendo que o máximo é 1) entre o dólar e as ações da Suzano Papel e Celulose(SUZB5), o que pode ser interpretado como natural dado a importância da exportação para a empresa.
A maior correlação negativa entre o dólar e um dos indicadores dessa fração da matriz original - no caso, a BRMalls (BRML3) é de -0,71.

Essas duas observações são investigadas no gráfico abaixo.

temp <- df_final %>%
  select(Data, USD.BRL, BRML3.SA.Adjusted, SUZB5.SA.Adjusted) %>%
  na.omit() %>%
  melt("Data")

levels(temp$variable) = c("Dolar", "BRMalls", "Suzano Papel\n e Celulose")
ggplot(temp, aes(x=ymd(Data), value)) + geom_line() + facet_grid(variable~., scales="free")

A tendência mostrada no gráfico é clara: quando o dólar sobe, os papéis da Suzano acompanham a subida, inversamente aos da BRMalls.

Conclusão

Se por um lado houve o foco apenas no dólar, este mesmo código possibilita a análise de correlações não apenas entre o dólar e ações de empresas mas também entre ações em si.

Além disso, embora os gráficos – tanto os de linha quanto o correlograma – mostrados aqui confirmam as correlações obtidas na matriz de correlação, é bom ressaltar que, no período analisado, o dólar praticamente só subiu. Para uma análise mais profunda (e exata), seria necessário selecionar um período de tempo maior ou pelo menos um onde o dólar tenha tanto caído quanto subido.