**R Views**, and kindly contributed to R-bloggers)

In a previous post, we reviewed how to import the Fama French 3-Factor data, wrangle that data, and then regress our portfolio returns on the factors. Please have a look at that previous post, as the following work builds upon it. For more background on Fama French, see the original article published in *The Journal of Financial Economics*, Common risk factors in the returns on stocks and bonds.

Today, we will explore the rolling Fama French model and the explanatory power of the 3 factors in different time periods. In the financial world, we often look at rolling means, standard deviations and models to make sure we haven’t missed anything unusual, risky, or concerning during different market or economic regimes. Our portfolio returns history is for the years 2013 through 2017, which is rather a short history, but there still might a be a 24-month period where the Fama French factors were particularly strong, weak, or meaningless. We would like to unearth and hypothesize about what explains them or their future likelihood.

We will be working with our usual portfolio consisting of:

```
+ 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%
```

Before we can run a Fama French model for that portfolio, we need to find portfolio monthly returns, which was covered in this post. I won’t go through the logic again but the code is here:

```
library(tidyquant)
library(tidyverse)
library(timetk)
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)
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")
```

We also need to import the Fama French factors and combine them into one object with our portfolio returns. We painstakingly covered this in the previous post and the code for doing so is here:

```
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.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))
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))
```

We now have one data frame `ff_portfolio_returns`

that holds our Fama French factors and portfolio returns. Let’s get to the rolling analysis.

We first define a rolling model with the `rollify()`

function from `tibbletime`

. However, instead of wrapping an existing function, such as `kurtosis()`

or `skewness()`

, we will pass in our linear Fama French model.

```
# Choose a 24-month rolling window
window <- 24
library(tibbletime)
# define a rolling ff model with tibbletime
rolling_lm <-
rollify(.f = function(R_excess, MKT_RF, SMB, HML) {
lm(R_excess ~ MKT_RF + SMB + HML)
}, window = window, unlist = FALSE)
```

Next, we pass columns from `ff_portfolio_returns`

to the rolling function model.

```
rolling_ff_betas <-
ff_portfolio_returns %>%
mutate(rolling_ff =
rolling_lm(R_excess,
MKT_RF,
SMB,
HML)) %>%
slice(-1:-23) %>%
select(date, rolling_ff)
head(rolling_ff_betas, 3)
```

```
# A tibble: 3 x 2
date rolling_ff
```
1 2014-12-31
2 2015-01-31
3 2015-02-28

We now have a new data frame called `rolling_ff_betas`

, in which the column `rolling_ff`

holds an S3 object of our model results. We can `tidy()`

that column with `map(rolling_ff, tidy)`

and then `unnest()`

the results, very similar to our CAPM work, except we have more than one independent variable.

```
rolling_ff_betas <-
ff_portfolio_returns %>%
mutate(rolling_ff =
rolling_lm(R_excess,
MKT_RF,
SMB,
HML)) %>%
mutate(tidied = map(rolling_ff,
tidy,
conf.int = T)) %>%
unnest(tidied) %>%
slice(-1:-23) %>%
select(date, term, estimate, conf.low, conf.high) %>%
filter(term != "(Intercept)") %>%
rename(beta = estimate, factor = term) %>%
group_by(factor)
head(rolling_ff_betas, 3)
```

```
# A tibble: 3 x 5
# Groups: factor [3]
date factor beta conf.low conf.high
```
1 2014-12-31 MKT_RF 0.931 0.784 1.08
2 2014-12-31 SMB -0.0130 -0.278 0.252
3 2014-12-31 HML -0.160 -0.459 0.139

We now have rolling betas and confidence intervals for each of our 3 factors. Let’s apply the same code logic and extract the rolling R-squared for our model. The only difference is we call `glance()`

instead of `tidy()`

.

```
rolling_ff_rsquared <-
ff_portfolio_returns %>%
mutate(rolling_ff =
rolling_lm(R_excess,
MKT_RF,
SMB,
HML)) %>%
slice(-1:-23) %>%
mutate(glanced = map(rolling_ff,
glance)) %>%
unnest(glanced) %>%
select(date, r.squared, adj.r.squared, p.value)
head(rolling_ff_rsquared, 3)
```

```
# A tibble: 3 x 4
date r.squared adj.r.squared p.value
```
1 2014-12-31 0.898 0.883 4.22e-10
2 2015-01-31 0.914 0.901 8.22e-11
3 2015-02-28 0.919 0.907 4.19e-11

We have extracted rolling factor betas and the rolling model R-squared, now let’s visualize.

## Visualizing Rolling Fama French

We start by charting the rolling factor betas with `ggplot()`

. This gives us an view into how the explanatory power of each factor has changed over time.

```
rolling_ff_betas %>%
ggplot(aes(x = date,
y = beta,
color = factor)) +
geom_line() +
labs(title= "24-Month Rolling FF Factor Betas",
x = "rolling betas") +
scale_x_date(breaks = scales::pretty_breaks(n = 10)) +
theme_minimal() +
theme(plot.title = element_text(hjust = 0.5),
axis.text.x = element_text(angle = 90))
```

The rolling factor beta chart reveals some interesting trends. Both SMB and HML have hovered around zero, while the MKT factor has hovered around 1. That’s consistent with our plot of betas with confidence intervals from last time.

Next, let’s visualize the rolling R-squared with `highcharter`

.

We first convert `rolling_ff_rsquared`

to `xts`

, using the `tk_xts()`

function.

```
rolling_ff_rsquared_xts <-
rolling_ff_rsquared %>%
tk_xts(date_var = date, silent = TRUE)
```

Then pass the `xts`

object to a `highchart(type = "stock")`

code flow, adding the rolling R-squared time series with `hc_add_series(rolling_ff_rsquared_xts$r.squared...)`

.

```
highchart(type = "stock") %>%
hc_add_series(rolling_ff_rsquared_xts$r.squared,
color = "cornflowerblue",
name = "r-squared") %>%
hc_title(text = "Rolling FF 3-Factor R-Squared") %>%
hc_add_theme(hc_theme_flat()) %>%
hc_navigator(enabled = FALSE) %>%
hc_scrollbar(enabled = FALSE) %>%
hc_exporting(enabled = TRUE)
```

That chart looks choppy, but the R-squared never really left the range between .9 and .95. We can tweak the minimum and maximum y-axis values for some perspective.

```
highchart(type = "stock") %>%
hc_add_series(rolling_ff_rsquared_xts$r.squared,
color = "cornflowerblue",
name = "r-squared") %>%
hc_title(text = "Rolling FF 3-Factor R-Squared") %>%
hc_yAxis( max = 2, min = 0) %>%
hc_add_theme(hc_theme_flat()) %>%
hc_navigator(enabled = FALSE) %>%
hc_scrollbar(enabled = FALSE) %>%
hc_exporting(enabled = TRUE)
```

Ah, when the y-axis is zoomed out a bit, our R-squared looks consistently near 1 for the life of the portfolio.

That’s all for today. Thanks and see you next time!

**leave a comment**for the author, please follow the link and comment on their blog:

**R Views**.

R-bloggers.com offers

**daily e-mail updates**about R news and tutorials on topics such as: Data science, Big Data, R jobs, visualization (ggplot2, Boxplots, maps, animation), programming (RStudio, Sweave, LaTeX, SQL, Eclipse, git, hadoop, Web Scraping) statistics (regression, PCA, time series, trading) and more...