Arrumei alguns bugs e atualizei os códigos que estavão descontinuados do scrip de Jonathan Regenstein.

O modelo Fama-French de precificação de ativos

O modelo Fama-French (FF) ou modelo multifatores é uma extensão do modelo CAPM tradicional. O CAPM é um modelo de regressão simples, onde o excesso de retorno de um ativo de interesse é a variável dependente e o excesso de retorno do mercado é a única variável explicativa.

O modelo multifatores é a versão multivariada do modelo CAPM.

Vamos testar um modelo FF de 3 fatores que irá avaliar o poder explanatório: (1) do mercado (assim como no CAPM), (2) do tamanho das firmas (grande versus pequena) e (3) do valor da firma (a razão entre valor contábil e valor de mercado). Com relação à esta última medida, estamos investigando qual a influência de se incluir “ações de valor”, ou seja, aquelas com potencial de aumento do preço de suas ações (“value premium”).

# Os ativos usados para formar o portfolio são:
# SPY (S&P500 fund) weighted 25%
# EFA (a non-US equities fund) weighted 25%
# IJS (a small-cap value fund) weighted 20%
# EEM (an emerging-mkts fund) weighted 20%
# AGG (a bond fund) weighted 10%

library(tidyquant)
## Loading required package: lubridate
## 
## Attaching package: 'lubridate'
## The following objects are masked from 'package:base':
## 
##     date, intersect, setdiff, union
## Loading required package: PerformanceAnalytics
## Loading required package: xts
## Loading required package: zoo
## 
## Attaching package: 'zoo'
## The following objects are masked from 'package:base':
## 
##     as.Date, as.Date.numeric
## 
## Attaching package: 'PerformanceAnalytics'
## The following object is masked from 'package:graphics':
## 
##     legend
## Loading required package: quantmod
## Loading required package: TTR
## Registered S3 method overwritten by 'quantmod':
##   method            from
##   as.zoo.data.frame zoo
## ══ Need to Learn tidyquant? ════════════════════════════════════════════════════
## Business Science offers a 1-hour course - Learning Lab #9: Performance Analysis & Portfolio Optimization with tidyquant!
## </> Learn more at: https://university.business-science.io/p/learning-labs-pro </>
library(tidyverse)
## ── Attaching packages ─────────────────────────────────────── tidyverse 1.3.0 ──
## ✓ ggplot2 3.3.3     ✓ purrr   0.3.4
## ✓ tibble  3.1.0     ✓ dplyr   1.0.4
## ✓ tidyr   1.1.2     ✓ stringr 1.4.0
## ✓ readr   1.4.0     ✓ forcats 0.5.0
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## x lubridate::as.difftime() masks base::as.difftime()
## x lubridate::date()        masks base::date()
## x dplyr::filter()          masks stats::filter()
## x dplyr::first()           masks xts::first()
## x lubridate::intersect()   masks base::intersect()
## x dplyr::lag()             masks stats::lag()
## x dplyr::last()            masks xts::last()
## x lubridate::setdiff()     masks base::setdiff()
## x lubridate::union()       masks base::union()
library(timetk)
library(broom)
library(glue)
## 
## Attaching package: 'glue'
## The following object is masked from 'package:dplyr':
## 
##     collapse
symbols <- c("SPY","EFA", "IJS", "EEM","AGG")

prices <- 
  getSymbols(symbols, src = 'yahoo', 
              from = "2012-12-31",
             to = "2017-12-31",
             auto.assign = TRUE, warnings = FALSE) %>% 
  map(~Ad(get(.))) %>%
  reduce(merge) %>% 
  `colnames<-`(symbols)
## 'getSymbols' currently uses auto.assign=TRUE by default, but will
## use auto.assign=FALSE in 0.5-0. You will still be able to use
## 'loadSymbols' to automatically load data. getOption("getSymbols.env")
## and getOption("getSymbols.auto.assign") will still be checked for
## alternate defaults.
## 
## This message is shown once per session and may be disabled by setting 
## options("getSymbols.warning4.0"=FALSE). See ?getSymbols for details.
# Peso das ativos no portfolio
w <- c(0.25, 0.25, 0.20, 0.20, 0.10)

asset_returns_long <-  
  prices %>% 
  to.monthly(indexAt = "lastof", OHLC = FALSE) %>% 
  tk_tbl(preserve_index = TRUE, rename_index = "date") %>%
  gather(asset, returns, -date) %>% 
  group_by(asset) %>%  
  mutate(returns = (log(returns) - log(lag(returns)))) %>% 
  na.omit()

portfolio_returns_tq_rebalanced_monthly <- 
  asset_returns_long %>%
  tq_portfolio(assets_col  = asset, 
               returns_col = returns,
               weights     = w,
               col_rename  = "returns",
               rebalance_on = "months")

Baixando os fatores para usarmos na regressão, diretamente do website de Kenneth R. French.

temp <- tempfile()
base <- 
"http://mba.tuck.dartmouth.edu/pages/faculty/ken.french/ftp/"

factor <- 
  "Global_3_Factors"

format<-
  "_CSV.zip"

full_url <-
  glue(base,
        factor,
        format,
        sep ="")

# download dos dados para os fatores
download.file(
full_url,
temp,
quiet = TRUE)
Global_3_Factors <- 
  read_csv(unz(temp, 
               "Global_3_Factors.csv"), skip = 6) %>%
  rename(date = X1) %>% 
  mutate_at(vars(-date), as.numeric)%>% 
  mutate(date = 
           rollback(ymd(parse_date_time(date, "%Y%m") + months(1)))) %>% 
  filter(date >= 
   first(portfolio_returns_tq_rebalanced_monthly$date) & date <= 
   last(portfolio_returns_tq_rebalanced_monthly$date))
## Warning: Missing column names filled in: 'X1' [1]
## 
## ── Column specification ────────────────────────────────────────────────────────
## cols(
##   X1 = col_character(),
##   `Mkt-RF` = col_character(),
##   SMB = col_character(),
##   HML = col_character(),
##   RF = col_character()
## )
## Warning: 1 parsing failure.
## row col  expected    actual         file
## 349  -- 5 columns 1 columns <connection>
## Warning in mask$eval_all_mutate(quo): NAs introduzidos por coerção

## Warning in mask$eval_all_mutate(quo): NAs introduzidos por coerção

## Warning in mask$eval_all_mutate(quo): NAs introduzidos por coerção

## Warning in mask$eval_all_mutate(quo): NAs introduzidos por coerção
## Warning: 29 failed to parse.
tail(Global_3_Factors)  
## # A tibble: 6 x 5
##   date       `Mkt-RF`   SMB   HML    RF
##   <date>        <dbl> <dbl> <dbl> <dbl>
## 1 2017-07-31     2.51 -0.1   1.18  0.07
## 2 2017-08-31     0.13 -0.15 -1.31  0.09
## 3 2017-09-30     2.3   1.27  1.61  0.09
## 4 2017-10-31     1.8  -0.87 -0.93  0.09
## 5 2017-11-30     1.93 -0.61 -0.27  0.08
## 6 2017-12-31     1.38  0.9   0.22  0.09
ff_portfolio_returns <- 
  portfolio_returns_tq_rebalanced_monthly %>% 
  left_join(Global_3_Factors, by = "date") %>% 
  mutate(MKT_RF = Global_3_Factors$`Mkt-RF`/100,
         SMB = Global_3_Factors$SMB/100,
         HML = Global_3_Factors$HML/100,
         RF = Global_3_Factors$RF/100,
         R_excess = round(returns - RF, 4))


head(ff_portfolio_returns, 4)
## # A tibble: 4 x 8
##   date         returns `Mkt-RF`      SMB     HML    RF MKT_RF R_excess
##   <date>         <dbl>    <dbl>    <dbl>   <dbl> <dbl>  <dbl>    <dbl>
## 1 2013-01-31  0.0308       5.46  0.0017   0.0201     0 0.0546   0.0308
## 2 2013-02-28 -0.000870     0.09  0.00350 -0.0076     0 0.0009  -0.0009
## 3 2013-03-31  0.0187       2.29  0.0085  -0.0202     0 0.0229   0.0187
## 4 2013-04-30  0.0206       3.02 -0.0113   0.009      0 0.0302   0.0206
ff_dplyr_byhand <- lm(R_excess ~ MKT_RF + SMB + HML, 
                data = ff_portfolio_returns)
  
  tidy(ff_dplyr_byhand, conf.int = T, conf.level = .95)%>% 
  mutate_if(is.numeric, funs(round(., 3))) %>% 
  select(-statistic)
## Warning: `funs()` was deprecated in dplyr 0.8.0.
## Please use a list of either functions or lambdas: 
## 
##   # Simple named list: 
##   list(mean = mean, median = median)
## 
##   # Auto named with `tibble::lst()`: 
##   tibble::lst(mean, median)
## 
##   # Using lambdas
##   list(~ mean(., trim = .2), ~ median(., na.rm = TRUE))
## # A tibble: 4 x 6
##   term        estimate std.error p.value conf.low conf.high
##   <chr>          <dbl>     <dbl>   <dbl>    <dbl>     <dbl>
## 1 (Intercept)   -0.001     0.001   0.196   -0.004     0.001
## 2 MKT_RF         0.893     0.036   0        0.822     0.964
## 3 SMB            0.051     0.075   0.498   -0.099     0.201
## 4 HML            0.036     0.061   0.555   -0.086     0.159
ff_dplyr_byhand %>% 
   tidy(ff_dplyr_byhand, conf.int = T, conf.level = .95)%>% 
  mutate_if(is.numeric, funs(round(., 3)))%>%
  filter(term != "(Intercept)") %>% 
  ggplot(aes(x = term, y = estimate, shape = term, color = term)) + 
  geom_point() +
  geom_errorbar(aes(ymin = conf.low, ymax = conf.high)) +
  labs(title = "FF 3-Factor Coefficients for Our Portfolio",
       subtitle = "nothing in this post is investment advice",
       x = "",
       y = "coefficient",
       caption = "data source: Fama French website and yahoo! Finance") +
  theme_minimal() +
  theme(plot.title = element_text(hjust = 0.5),
        plot.subtitle = element_text(hjust = 0.5),
        plot.caption  = element_text(hjust = 0))