Momentum Investing with R

Momentum Investing with R

This is my note for learning Momentum Investing with R.

In practice, momentum entails a look back into the past to determine whether an asset has exceed some benchmark, and if it has, buy and hold that asset for some benchmark, and if it has, buy and hold that asset for some time into the future. That’s completely flying in the face of the efficient market hypothesis because it’s positing that the past is somehow giving us information that has not been reflected in the current price of the asset.

R
1
2
3
4
5
6
library(tidyverse)
library(highcharter)
library(tibbletime)
library(tidyquant)
library(timetk)
library(riingo)

We are going to implement a simplified version of a momentum strategy that deals with 4 assets:

  • SPY: an SP500 ETF
  • EFA: a global equities ETF
  • AGG: a bond ETF
  • TLT: a treasuries ETF

The strategy logic goes as follows: compare the previous twelve month’s returns of SPY to TLT. If the returns of SPY do not exceed those of TLT, hold bonds AGG for next month. If SPY returns do exceed TLT, compare the previous 12 months’ returns of SPY to EFA, whichever of SPY or EFA had the higher previous twelve months’ returns, hold that asset for the next month. Thus, each month, our strategy will hold either AGG, SPY, or EFA and we reexamine at the end of each month, That’s twelve look-backs per year, and twelve possible buy/sell transactions per year.

That is:

SPY <= TLT => hold AGG (Stock market is a bear market, so we hold bolds)
SPY >= TLT (Bull Market), hold asset with highest returns.

R
1
2
3
4
5
6
7
8
9
10
11
12
13
symbols <- c("SPY", "AGG", "EFA", "TLT")
prices_monthly <- symbols %>%
riingo_prices(
start_date = "2000-01-01",
end_date = "2019-11-02"
) %>%
mutate(date = ymd(date)) %>%
group_by(ticker) %>%
tq_transmute(
select = adjClose,
mutate_fun = to.monthly,
indexAt = "lastof"
)

Recall that we wish to implement this flow:

  1. if previous 12 months’ SPY return is lower than TLT’s, buy AGG this month, else move to step 2;
  2. If previous 12 months’ SPY is higher then previous 12 months’ EFA, buy/hold SPY this month, else move to step 3.
  3. If previous 12 months’ EFA is higher then previous 12 months’ SPY, buy/hold EFA this month.
R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
n_lag <- 12
risk_free_tlt <- prices_monthly %>%
dplyr::filter(ticker == "TLT") %>%
mutate(
tbill_twelve_mon_ret = ((adjClose / dplyr::lag(adjClose, n_lag)) - 1)
) %>%
ungroup() %>%
select(-adjClose, -ticker) %>%
na.omit()

# one month returns of AGG
bond_returns <- prices_monthly %>%
dplyr::filter(ticker == "AGG") %>%
mutate(
bond_return = ((adjClose / dplyr::lag(adjClose)) - 1)
) %>%
ungroup() %>%
select(-adjClose, -ticker) %>%
na.omit()

equities_ex_us_returns <- prices_monthly %>%
dplyr::filter(ticker == "EFA") %>%
mutate(
ex_us_return = ((adjClose / dplyr::lag(adjClose)) - 1),
ex_us_twelve_mon_ret = ((adjClose / dplyr::lag(adjClose, n_lag)) - 1)
) %>%
ungroup() %>%
select(-adjClose, -ticker) %>%
na.omit()

sp_500_returns <- prices_monthly %>%
dplyr::filter(ticker == "SPY") %>%
mutate(
spy_return = (adjClose / dplyr::lag(adjClose)) - 1,
spy_twelve_mon_ret = (adjClose / dplyr::lag(adjClose, n_lag)) - 1
) %>%
select(-adjClose) %>%
rename(mom_asset = ticker)

# join:
joined_returns_tbl <- sp_500_returns %>%
left_join(risk_free_tlt, by = "date") %>%
left_join(equities_ex_us_returns, by = "date") %>%
left_join(bond_returns, by = "date") %>%
na.omit()

head(joined_returns_tbl)
joined_returns_tbl %>%
select(date, contains("twelve")) %>%
head()
#> Adding missing grouping variables: `mom_asset`
#> # A tibble: 6 x 5
#> # Groups: mom_asset [1]
#> mom_asset date spy_twelve_mon_ret tbill_twelve_mon_ret ex_us_twelve_mon_ret
#> <chr> <date> <dbl> <dbl> <dbl>
#> 1 SPY 2003-10-31 0.209 0.0350 0.285
#> 2 SPY 2003-11-30 0.151 0.0481 0.247
#> 3 SPY 2003-12-31 0.282 0.0162 0.398
#> 4 SPY 2004-01-31 0.340 0.0411 0.477
#> 5 SPY 2004-02-29 0.377 0.0329 0.544
#> 6 SPY 2004-03-31 0.356 0.0619 0.581

It might be interesting or important to know when the strategy is holding AGG, SPY or EFA, so let’s create a column called strat_label that has the values bond, spy, and ex-us depending on where the strategy invests. That would allow us to calculate and visualize, for example, the proportion of time spent invested in EFA.

R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
strat_returns <- joined_returns_tbl %>% 
mutate(
strat_returns = if_else(
dplyr::lag(spy_twelve_mon_ret) < dplyr::lag(tbill_twelve_mon_ret),
bond_return,
if_else(
dplyr::lag(spy_twelve_mon_ret) > dplyr::lag(ex_us_twelve_mon_ret),
spy_return,
ex_us_return
)
),
strat_label = if_else(
dplyr::lag(spy_twelve_mon_ret) < dplyr::lag(tbill_twelve_mon_ret),
"bond",
if_else(
dplyr::lag(spy_twelve_mon_ret) > dplyr::lag(ex_us_twelve_mon_ret),
"spy",
"ex_us"
)
),
# Set 80/20 SPY/AGG portfolio as benchmark
bench_returns = (0.8 * spy_return) + (0.2 * bond_return)
) %>%
na.omit() %>%
select(date, bench_returns, contains("strat"))
R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
library(ggchicklet)
strat_returns %>%
count(strat_label) %>%
mutate(prop = prop.table(n)) %>%
ggplot(aes(x = strat_label, y = prop, fill = strat_label)) +
geom_chicklet(width = 0.75) +
scale_y_continuous(labels = scales::percent) +
geom_label(aes(label = strat_label), vjust = -0.5, fill = "white") +
ylab("relative frequencies") +
xlab("") +
expand_limits(y = 0.4) +
theme(legend.position = "none",
axis.text.x = element_blank(),
axis.ticks = element_blank()) +
scale_fill_tq()

R
1
2
3
4
5
6
7
8
9
10
11
# Highcharter
strat_returns %>%
count(strat_label) %>%
mutate(prop = prop.table(n)) %>%
hchart(hcaes(x = strat_label,
y = prop,
color = strat_label),
type = "column",
pointWidth = 30) %>%
hc_tooltip(pointFormat = "{point.strat_label}: {point.prop: .2f}") %>%
hc_add_theme(hc_theme_elementary())

R
1
2
3
4
5
6
7
8
9
strat_returns %>% 
ungroup() %>%
select(bench_returns, strat_returns) %>%
gather(type, returns) %>%
ggplot(aes(returns, color = type, fill = type)) +
geom_histogram(bins = 60) +
facet_wrap(~ type, ncol = 1) +
scale_fill_tq() +
scale_color_tq()

R
1
2
3
4
5
6
7
8
9
10
library(ggrapid)
strat_returns %>%
ungroup() %>%
select(bench_returns, strat_returns) %>%
gather(type, returns) %>%
plot_density(
x = returns,
facet = type,
fill = type
)

R
1
2
3
4
5
6
7
8
9
10
11
strat_returns %>% 
ungroup() %>%
select(bench_returns, strat_returns) %>%
gather(type, returns) %>%
ggplot(aes(type, returns,
color = type,
fill = type)) +
geom_boxplot(width = 0.1, fill = "white") +
geom_violin(alpha = 0.05) +
coord_flip() +
scale_color_tq()

R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
strat_growth <- strat_returns %>% 
mutate(
strat_growth = purrr::accumulate(1 + strat_returns, `*`),
bench_growth = purrr::accumulate(1 + bench_returns, `*`)
) %>%
ungroup() %>%
select(date, contains("growth")) %>%
gather(strat, growth, -date)

strat_growth %>%
hchart(
hcaes(x = date,
y = growth,
group = strat),
type = "line"
) %>%
hc_tooltip(pointFormat = "{point.strat}: ${point.growth: .2f}")

Our momentum strategy did not grow as much as a pure buy-sold strategy. Let’s check some summary statistics by using tq_performance() and table.Stats.

R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
strat_returns %>% 
ungroup() %>%
select(date, strat_returns, bench_returns) %>%
gather(strats, returns, -date) %>%
group_by(strats) %>%
tq_performance(Ra = returns,
performance_fun = table.Stats) %>%
gather(stat, value, -strats)

strat_returns %>%
ungroup() %>%
select(date, strat_returns, bench_returns) %>%
gather(strats, returns, -date) %>%
group_by(strats) %>%
tq_performance(Ra = returns,
performance_fun = table.DownsideRisk) %>%
select(MaximumDrawdown, contains("VaR"))

#> Adding missing grouping variables: `strats`
#> # A tibble: 2 x 4
#> # Groups: strats [2]
#> strats MaximumDrawdown `HistoricalVaR(95%… `ModifiedVaR(95%…
#> <chr> <dbl> <dbl> <dbl>
#> 1 strat_retur… 0.172 -0.0489 -0.0436
#> 2 bench_retur… 0.422 -0.0497 -0.0495

The momentum strat didn’t grow as much as buy-hold, but it had a far smaller max drawdown.

# R

Comments

Your browser is out-of-date!

Update your browser to view this website correctly. Update my browser now

×