Arrumei alguns bugs e atualizei os códigos que estavão descontinuados do scrip de Jonathan Regenstein.
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))