Fama French on R Views

Parsnipping Fama French

Thu, 14 Mar 2019 00:00:00 +0000

Today, we will continue our exploration of developments in the world of tidy models, and we will stick with our usual Fama French modeling flow to do so. For new readers who want get familiar with Fama French before diving into this post, see here where we covered importing and wrangling the data, here where we covered rolling models and visualization, and here where we covered managing many models. If you’re into Shiny, this flexdashboard might be of interest, as well.

Let’s get to it.

First, we need our data and, as usual, we’ll import data for daily prices of five ETFs, convert them to returns (have a look here for a refresher on that code flow), then import the five Fama French factor data and join it to our five ETF returns data. Here’s the code to make that happen (this code was covered in detail in this post:

symbols <- c("SPY", "EFA", "IJS", "EEM", "AGG")


# The prices object will hold our daily price data.
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)


asset_returns_long <-  
  prices %>% 
  tk_tbl(preserve_index = TRUE, rename_index = "date") %>%
  gather(asset, prices, -date) %>% 
  group_by(asset) %>%  
  mutate(daily_returns = (log(prices) - log(lag(prices)))) %>% 
  na.omit()

factors_data_address <- 
"http://mba.tuck.dartmouth.edu/pages/faculty/ken.french/ftp/Global_5_Factors_Daily_CSV.zip"

factors_csv_name <- "Global_5_Factors_Daily.csv"

temp <- tempfile()

download.file(
  # location of file to be downloaded
  factors_data_address,
  # where we want R to store that file
  temp, 
  quiet = TRUE)


Global_5_Factors <- 
  read_csv(unz(temp, factors_csv_name), skip = 6 ) %>%
  rename(date = X1, MKT = `Mkt-RF`) %>%
  mutate(date = ymd(parse_date_time(date, "%Y%m%d")))%>%
  mutate_if(is.numeric, funs(. / 100)) %>% 
  select(-RF)

data_joined_tidy <- 
  asset_returns_long %>%
  left_join(Global_5_Factors, by = "date") %>% 
  na.omit()

For today, let’s work with just the SPY data by filtering our data set by asset.

spy_2013_2017 <- data_joined_tidy %>% 
  filter(asset == "SPY")

Next, we re-sample this five years’ worth of data into smaller subsets of training and testing sets. This is frequently done by k-fold cross validation (see here for an example), where random samples are taken from the data, but since we are working with time series, we will use a time-aware technique. The rsample package has a function for exactly this purpose, the rolling_origin() function. We covered this process extensively in this previous post. Here’s the code to make it happen.

rolling_origin_spy_2013_2017 <- 
 rolling_origin(
  data       = spy_2013_2017,
  initial    = 100,
  assess     = 1,
  cumulative = FALSE
)

rolling_origin_spy_2013_2017 %>% 
  dim()

[1] 1159    2

We now have a data object called rolling_origin_spy_2013_2017 that holds 1159 splits of data. Each split consists of an analysis data set with 100 days of return and factor data, and an assessment data set with one day of return and factor data.

Now, we can start using that collection of data splits to fit a model on the assessment data, and then test our model on the assessment data. That means it’s time to introduce a relatively new addition to the R tool chain, the parsnip package.

parsnip is a unified model interface that allows us to create a model specification, set an analytic engine, and then fit a model. It’s a ‘unified’ interface in the sense that we can use the same scaffolding but insert different models, or different engines, or different modes. Let’s see how that works with linear regression.

Recall that in the previous post, we piped our data into a linear model like so:

analysis(rolling_origin_spy_2013_2017$splits[[1]]) %>% 
do(model = lm(daily_returns ~ MKT + SMB + HML + RMW + CMA, 
      data = .)) %>% 
tidy(model)

# A tibble: 6 x 6
# Groups:   asset [1]
  asset term         estimate std.error statistic  p.value
  <chr> <chr>           <dbl>     <dbl>     <dbl>    <dbl>
1 SPY   (Intercept)  0.000579  0.000338      1.71 8.98e- 2
2 SPY   MKT          0.909     0.0739       12.3  2.79e-21
3 SPY   SMB         -0.495     0.112        -4.43 2.52e- 5
4 SPY   HML         -0.609     0.208        -2.92 4.38e- 3
5 SPY   RMW         -0.591     0.259        -2.28 2.47e- 2
6 SPY   CMA         -0.395     0.206        -1.92 5.81e- 2

Now, we will pipe into the parsnip scaffolding, which will allow us to quickly change to a different model and specification further down in the code.

Since we are running a linear regression, we first create a specification with linear_reg(), then set the engine with set_engine("lm"), and finally fit the model with fit(five_factor_model, data = one of our splits)

lm_model <-
  linear_reg() %>%
  set_engine("lm") %>%
  fit(daily_returns ~ MKT + SMB + HML + RMW + CMA, 
      data = analysis(rolling_origin_spy_2013_2017$splits[[1]]))

lm_model

parsnip model object


Call:
stats::lm(formula = formula, data = data)

Coefficients:
(Intercept)          MKT          SMB          HML          RMW  
  0.0005794    0.9086303   -0.4951297   -0.6085088   -0.5910375  
        CMA  
 -0.3954515

Now that we’ve fit the model on our test set, let’s see how well it predicted the test set. We can use the predict() function and pass it the results of our parnsip code flow, along with the assessment split.

assessment(rolling_origin_spy_2013_2017$splits[[1]]) %>% 
  select(returns) %>% 
  bind_cols(predict(lm_model, 
        new_data = assessment(rolling_origin_spy_2013_2017$splits[[1]])))

# A tibble: 1 x 3
# Groups:   asset [1]
  asset returns   .pred
  <chr>   <dbl>   <dbl>
1 SPY      148. 0.00737

That worked well, but now let’s head to a more complex model and use the ranger package as an engine for a random forest analysis.

To set up the ranger random forest model in parsnip, we first use rand_forest(mode = "regression", mtry = 3, trees = 100) to create the specification, set_engine("ranger") to set the engine as the ranger package, and fit(daily_returns ~ MKT + SMB + HML + RMW + CMA ~ , data = analysis(rolling_origin_spy_2013_2017$splits[[1]]) to fit the five-factor Fama French model to the 100-day sample in our first split.

# Need to load the packages to be used as the random forest engine
library(ranger)

rand_forest(mode = "regression", mtry = 3, trees = 100) %>%
  set_engine("ranger") %>%
  fit(daily_returns ~ MKT + SMB + HML + RMW + CMA, 
      data = analysis(rolling_origin_spy_2013_2017$splits[[1]]))

parsnip model object

Ranger result

Call:
 ranger::ranger(formula = formula, data = data, mtry = ~3, num.trees = ~100,      num.threads = 1, verbose = FALSE, seed = sample.int(10^5,          1)) 

Type:                             Regression 
Number of trees:                  100 
Sample size:                      100 
Number of independent variables:  5 
Mtry:                             3 
Target node size:                 5 
Variable importance mode:         none 
Splitrule:                        variance 
OOB prediction error (MSE):       1.514654e-05 
R squared (OOB):                  0.6880896

Notice that ranger gives us an OOB prediction error (MSE) value as part of its return. parsnip returns to us what the underlying engine returns.

Now, let’s apply that random forest regression to all 1159 of our splits (recall that each split consists of 100 days of training data and one day of test data), so we can get an average RMSE. Warning: this will consume some resources on your machine and some time in your day.

To apply that model to our entire data set, we create a function that takes one split, passes it to our parsnip enabled model, and then uses the predict function to attempt to predict our assessment split. The function also allows us to specify the number of trees and the number of variables randomly sampled at each tree split, which is set with the mtry argument.

ranger_rf_regress <- function(mtry = 3, trees = 5, split){
    
    analysis_set_rf <- analysis(split)
     
    model <- 
      rand_forest(mtry = mtry, trees = trees) %>%
        set_engine("ranger") %>%
        fit(daily_returns ~ MKT + SMB + HML + RMW + CMA, data = analysis_set_rf)

    
    assessment_set_rf <- assessment(split)

    assessment_set_rf %>%
      select(date, daily_returns) %>%
      mutate(.pred = unlist(predict(model, new_data = assessment_set_rf))) %>% 
      select(date, daily_returns, .pred)
   
}

Now we want to pass it our object of 1159 splits, rolling_origin_spy_2013_2017$splits, and we want the function to iterate over each split. For that we turn to map_df() from the purrr package, which allows us to iterate over the data object and return a data frame. map_df() takes the data as an argument and our function as an argument.

ranger_results <- 
  map_df(.x = rolling_origin_spy_2013_2017$splits,
         ~ranger_rf_regress(mtry = 3, trees = 100, split = .x))

Here are the results. We now have 1159 predictions.

ranger_results %>% 
  head()

# A tibble: 6 x 4
# Groups:   asset [1]
  asset date       daily_returns    .pred
  <chr> <date>             <dbl>    <dbl>
1 SPY   2013-05-28       0.00597  0.00583
2 SPY   2013-05-29      -0.00652 -0.00403
3 SPY   2013-05-30       0.00369  0.00658
4 SPY   2013-05-31      -0.0145  -0.0114 
5 SPY   2013-06-03       0.00549  0.00119
6 SPY   2013-06-04      -0.00482  0.00202

Notice how the date of each prediction is included since we included it in the select() call in our function. That will come in handy for charting later.

Now, we can use the rmse() function from yardstick to calculate the root mean-squared error each of our predictions (our test sets had only one observation in them because we were testing on one month, so the RMSE is not a complex calculation here, but it would be the same code pattern if we had a larger test set). We can then find the average RMSE by calling summarise(avg_rmse = mean(.estimate)).

library(yardstick)

ranger_results %>%
  group_by(date) %>% 
  rmse(daily_returns, .pred) %>% 
  summarise(avg_rmse = mean(.estimate))

# A tibble: 1 x 1
  avg_rmse
     <dbl>
1  0.00253

We have the average RMSE; let’s see if the RMSE were stable over time, first with ggplot.

ranger_results %>%
  group_by(date) %>% 
  rmse(daily_returns, .pred) %>% 
  ggplot(aes(x = date, y = .estimate)) +
  geom_point(color = "cornflowerblue") +
  labs(y = "rmse", x = "", title = "RMSE over time via Ranger RF")

And with highcharter.

ranger_results %>%
  group_by(date) %>% 
  rmse(daily_returns, .pred) %>% 
  hchart(., hcaes(x = date, y = .estimate),
         type = "point") %>% 
  hc_title(text = "RMSE over time via Ranger RF") %>% 
  hc_yAxis(title = list(text = "RMSE"))

It looks like our RMSE is relatively stable, except for a period in mid to late 2015.

The amazing power of parsnip is how efficiently we can toggle to another random forest engine. Let’s suppose we wished to use the randomForest package instead of ranger. Here’s how we could reconfigure our previous work to use a different engine.

First, we’ll load up the randomForest package, because we need to load the package in order to use it as our engine. Then, we make one tweak to the original ranger_rf_regress function, by changing set_engine("ranger") to set_engine("randomForest"). That’s all, and we’re now running a random forest model using a different package.

library(randomForest)

randomForest_rf_regress <- function(mtry = 3, trees = 5, split){
    
    analysis_set_rf <- analysis(split)
     
    model <- 
      rand_forest(mtry = mtry, trees = trees) %>%
        set_engine("randomForest") %>%
        fit(daily_returns ~ MKT + SMB + HML + RMW + CMA, data = analysis_set_rf)

    
    assessment_set_rf <- assessment(split)

    assessment_set_rf %>%
      select(date, daily_returns) %>%
      mutate(.pred = unlist(predict(model, new_data = assessment_set_rf))) %>% 
      select(date, daily_returns, .pred)
   
}

We now have a new function called randomForest_rf_regress() that uses randomForest as the engine for our model and can use the same code scaffolding to run that model on our 1159 splits.

randomForest_results <- 
  map_df(.x = rolling_origin_spy_2013_2017$splits,
         ~randomForest_rf_regress(mtry = 3, trees = 100, split = .x))

randomForest_results %>% 
  head()

# A tibble: 6 x 4
# Groups:   asset [1]
  asset date       daily_returns    .pred
  <chr> <date>             <dbl>    <dbl>
1 SPY   2013-05-28       0.00597  0.00609
2 SPY   2013-05-29      -0.00652 -0.00438
3 SPY   2013-05-30       0.00369  0.00597
4 SPY   2013-05-31      -0.0145  -0.00987
5 SPY   2013-06-03       0.00549  0.00134
6 SPY   2013-06-04      -0.00482  0.00118

And we can use the same yardstick code to extract the RMSE.

randomForest_results %>%
  group_by(date) %>% 
  rmse(daily_returns, .pred) %>% 
  summarise(avg_rmse = mean(.estimate))

# A tibble: 1 x 1
  avg_rmse
     <dbl>
1  0.00252

There’s a lot more to explore in the parsnip package and the tidymodels collection. See you next time when we’ll get into some classification!

Wait: shameless book plug for those who read to the end: if you like this sort of thing, check out my new book Reproducible Finance with R!

Rsampling Fama French

Thu, 13 Dec 2018 00:00:00 +0000

Today we will continue our work on Fama French factor models, but more as a vehicle to explore some of the awesome stuff happening in the world of tidy models. For new readers who want get familiar with Fama French before diving into this post, see here where we covered importing and wrangling the data, here where we covered rolling models and visualization, my most recent previous post here where we covered managing many models, and if you’re into Shiny, this flexdashboard.

Our goal today is to explore k-fold cross-validation via the rsample package, and a bit of model evaluation via the yardstick package. We started the model evaluation theme last time when we used tidy(), glance() and augment() from the broom package. In this post, we will use the rmse() function from yardstick, but our main focus will be on the vfold_cv() function from rsample. We are going to explore these tools in the context of linear regression and Fama French, which might seem weird since these tools would typically be employed in the realms of machine learning, classification, and the like. We’ll stay in the world of explanatory models via linear regression world for a few reasons.

First, and this is a personal preference, when getting to know a new package or methodology, I prefer to do so in a context that’s already familiar. I don’t want to learn about rsample whilst also getting to know a new data set and learning the complexities of some crazy machine learning model. Since Fama French is familiar from our previous work, we can focus on the new tools in rsample and yardstick. Second, factor models are important in finance, despite relying on good old linear regression. We won’t regret time spent on factor models, and we might even find creative new ways to deploy or visualize them.

The plan for today is take the same models that we ran in the last post, only this use k-fold cross validation and bootstrapping to try to assess the quality of those models.

For that reason, we’ll be working with the same data as we did previously. I won’t go through the logic again, but in short, we’ll import data for daily prices of five ETFs, convert them to returns (have a look here for a refresher on that code flow), then import the five Fama French factor data and join it to our five ETF returns data. Here’s the code to make that happen:

library(tidyverse)
library(broom)
library(tidyquant)
library(timetk)

symbols <- c("SPY", "EFA", "IJS", "EEM", "AGG")


# The prices object will hold our daily price data.
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)


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

factors_data_address <- 
"http://mba.tuck.dartmouth.edu/pages/faculty/ken.french/ftp/Global_5_Factors_Daily_CSV.zip"

factors_csv_name <- "Global_5_Factors_Daily.csv"

temp <- tempfile()

download.file(
  # location of file to be downloaded
  factors_data_address,
  # where we want R to store that file
  temp, 
  quiet = TRUE)


Global_5_Factors <- 
  read_csv(unz(temp, factors_csv_name), skip = 6 ) %>%
  rename(date = X1, MKT = `Mkt-RF`) %>%
  mutate(date = ymd(parse_date_time(date, "%Y%m%d")))%>%
  mutate_if(is.numeric, funs(. / 100)) %>% 
  select(-RF)

data_joined_tidy <- 
  asset_returns_long %>%
  left_join(Global_5_Factors, by = "date") %>% 
  na.omit()

After running that code, we have an object called data_joined_tidy. It holds daily returns for 5 ETFs and the Fama French factors. Here’s a look at the first row for each ETF rows.

data_joined_tidy %>% 
  slice(1)

# A tibble: 5 x 8
# Groups:   asset [5]
  date       asset  returns    MKT     SMB    HML     RMW     CMA
  <date>     <chr>    <dbl>  <dbl>   <dbl>  <dbl>   <dbl>   <dbl>
1 2013-01-02 AGG   -0.00117 0.0199 -0.0043 0.0028 -0.0028 -0.0023
2 2013-01-02 EEM    0.0194  0.0199 -0.0043 0.0028 -0.0028 -0.0023
3 2013-01-02 EFA    0.0154  0.0199 -0.0043 0.0028 -0.0028 -0.0023
4 2013-01-02 IJS    0.0271  0.0199 -0.0043 0.0028 -0.0028 -0.0023
5 2013-01-02 SPY    0.0253  0.0199 -0.0043 0.0028 -0.0028 -0.0023

Let’s work with just one ETF for today and use filter(asset == "AGG") to shrink our data down to just that ETF.

agg_ff_data <- 
  data_joined_tidy %>% 
  filter(asset == "AGG")

Okay, we’re going to regress the daily returns of AGG on one factor, then three factors, then five factors, and we want to evaluate how well each model explains AGG’s returns. That means we need a way to test the model. Last time, we looked at the adjusted r-squared values when the model was run on the entirety of AGG returns. Today, we’ll evaluate the model using k-fold cross validation. That’s a pretty jargon-heavy phrase that isn’t part of the typical finance lexicon. Let’s start with the second part, cross-validation. Instead of running our model on the entire data set - all the daily returns of AGG - we’ll run it on just part of the data set, then test the results on the part that we did not use. Those different subsets of our original data are often called the training and the testing sets, though rsample calls them the analysis and assessment sets. We validate the model results by applying them to the assessment data and seeing how the model performed.

The k-fold bit refers to the fact that we’re not just dividing our data into training and testing subsets, we’re actually going to divide it into a bunch of groups, a k number of groups, or a k number of folds. One of those folds will be used as the validation set; the model will be fit on the other k - 1 sets, and then tested on the validation set. We’re doing this with a linear model to see how well it explains the data; it’s typically used in machine learning to see how well a model predicts data (we’ll get there in 2019).¹

If you’re like me, it will take a bit of tinkering to really grasp k-fold cross validation, but rsample as a great function for dividing our data into k-folds. If we wish to use five folds (the state of the art seems to be either five or ten folds), we call the vfold_cv() function, pass it our data object agg_ff_data, and set v = 5.

library(rsample)
library(yardstick)
set.seed(752)

cved_ff<- 
  vfold_cv(agg_ff_data, v = 5)

cved_ff

#  5-fold cross-validation 
# A tibble: 5 x 2
  splits           id   
  <list>           <chr>
1 <split [1K/252]> Fold1
2 <split [1K/252]> Fold2
3 <split [1K/252]> Fold3
4 <split [1K/252]> Fold4
5 <split [1K/251]> Fold5

We have an object called cved_ff, with a column called splits and a column called id. Let’s peek at the first split.

cved_ff$splits[[1]]

<1007/252/1259>

Three numbers. The first, 1007, is telling us how many observations are in the analysis. Since we have five folds, we should have 80% (or 4/5) of our data in the analysis set. The second number, 252, is telling us how many observations are in the assessment, which is 20% of our original data. The third number, 1259, is the total number of observations in our original data.

Next, we want to apply a model to the analysis set of this k-folded data and test the results on the assessment set. Let’s start with one factor and run a simple linear model, lm(returns ~ MKT).

We want to run it on analysis(cved_ff$splits[[1]]) - the analysis set of out first split.

ff_model_test <- lm(returns ~ MKT, data = analysis(cved_ff$splits[[1]]))

ff_model_test


Call:
lm(formula = returns ~ MKT, data = analysis(cved_ff$splits[[1]]))

Coefficients:
(Intercept)          MKT  
  0.0001025   -0.0265516

Nothing too crazy so far. Now we want to test on our assessment data. The first step is to add that data to the original set. We’ll use augment() for that task, and pass it assessment(cved_ff$splits[[1]])

ff_model_test %>% 
  augment(newdata = assessment(cved_ff$splits[[1]])) %>% 
  head() %>% 
  select(returns, .fitted)

        returns       .fitted
1  0.0009021065  1.183819e-04
2  0.0011726989  4.934779e-05
3  0.0010815505  1.157267e-04
4 -0.0024385815 -7.544460e-05
5 -0.0021715702 -8.341007e-05
6  0.0028159467  3.865527e-04

We just added our fitted values to the assessment data, the subset of the data on which the model was not fit. How well did our model do when compare the fitted values to the data in the held out set?

We can use the rmse() function from yardstick to measure our model. RMSE stands for root mean-squared error. It’s the sum of the squared differences between our fitted values and the actual values in the assessment data. A lower RMSE is better!

ff_model_test %>% 
  augment(newdata = assessment(cved_ff$splits[[1]])) %>%
  rmse(returns, .fitted)

# A tibble: 1 x 3
  .metric .estimator .estimate
  <chr>   <chr>          <dbl>
1 rmse    standard     0.00208

Now that we’ve done that piece by piece, let’s wrap the whole operation into one function. This function takes one argument, a split, and we’re going to use pull() so we can extract the raw number, instead of the entire tibble result.

model_one <- function(split) {
  
  split_for_model <- analysis(split)
  
  ff_model <- lm(returns ~ MKT, data = split_for_model)
  
  holdout <- assessment(split)

  rmse <- ff_model %>%
      augment(newdata = holdout) %>% 
      rmse(returns, .fitted) %>% 
      pull(.estimate)
}

Now we pass it our first split.

model_one(cved_ff$splits[[1]]) %>% 
  head()

[1] 0.002080324

Now we want to apply that function to each of our five folds that are stored in agg_cved_ff. We do that with a combination of mutate() and map_dbl(). We use map_dbl() instead of map because we are returning a number here and there’s not a good reason to store that number in a list column.

 cved_ff %>% 
  mutate(rmse = map_dbl(cved_ff$splits, model_one))

#  5-fold cross-validation 
# A tibble: 5 x 3
  splits           id       rmse
* <list>           <chr>   <dbl>
1 <split [1K/252]> Fold1 0.00208
2 <split [1K/252]> Fold2 0.00189
3 <split [1K/252]> Fold3 0.00201
4 <split [1K/252]> Fold4 0.00224
5 <split [1K/251]> Fold5 0.00190

OK, we have five RMSE’s since we ran the model on five separate analysis fold sets and tested on five separate assessment fold sets. Let’s find the average RMSE by taking the mean() of the rmse column. That can help reduce noisiness that resulted from our random creation of those five folds.

cved_ff %>% 
  mutate(rmse = map_dbl(cved_ff$splits, model_one)) %>% 
  summarise(mean_rse = mean(rmse))

#  5-fold cross-validation 
# A tibble: 1 x 1
  mean_rse
     <dbl>
1  0.00202

We now have the mean RMSE after running on our model, lm(returns ~ MKT), on all five of our folds.

That process for finding the mean RMSE can be applied other models, as well. Let’s suppose we wish to find the mean RMSE for two other models: lm(returns ~ MKT + SMB + HML), the Fama French three-factor model, and lm(returns ~ MKT + SMB + HML + RMW + CMA, the Fama French five-factor model. By comparing the mean RMSE’s, we can evaluate which model explained the returns of AGG better. Since we’re just adding more and more factors, the models can be expected to get more and more accurate but again, we are exploring the rsample machinery and creating a template where we can pop in whatever models we wish to compare.

First, let’s create two new functions, that follow the exact same code pattern as above but house the three-factor and five-factor models.

model_two <- function(split) {

  split_for_model <- analysis(split)
  
  ff_model <- lm(returns ~ MKT + SMB + HML, data = split_for_model)

  holdout <- assessment(split)

  rmse <- 
    ff_model %>%
    augment(newdata = holdout) %>% 
    rmse(returns, .fitted) %>% 
    pull(.estimate)

}

model_three <- function(split) {
  
  split_for_model <- analysis(split)

  ff_model <- lm(returns ~ MKT + SMB + HML + RMW + CMA, data = split_for_model)

  holdout <- assessment(split)

  rmse <- 
    ff_model %>%
    augment(newdata = holdout) %>% 
    rmse(returns, .fitted) %>% 
    pull(.estimate)

}

Now we pass those three models to the same mutate() with map_dbl() flow that we used with just one model. The result will be three new columns of RMSE’s, one for each of our three models applied to our five folds.

cved_ff %>%
  mutate(
    rmse_model_1 = map_dbl(
        splits, 
        model_one),
    rmse_model_2 = map_dbl(
        splits, 
        model_two),
    rmse_model_3 = map_dbl(
        splits, 
        model_three))

#  5-fold cross-validation 
# A tibble: 5 x 5
  splits           id    rmse_model_1 rmse_model_2 rmse_model_3
* <list>           <chr>        <dbl>        <dbl>        <dbl>
1 <split [1K/252]> Fold1      0.00208      0.00211      0.00201
2 <split [1K/252]> Fold2      0.00189      0.00184      0.00178
3 <split [1K/252]> Fold3      0.00201      0.00195      0.00194
4 <split [1K/252]> Fold4      0.00224      0.00221      0.00213
5 <split [1K/251]> Fold5      0.00190      0.00183      0.00177

We can also find the mean RMSE for each model.

cved_ff %>%
  mutate(
    rmse_model_1 = map_dbl(
        splits, 
        model_one),
    rmse_model_2 = map_dbl(
        splits, 
        model_two),
    rmse_model_3 = map_dbl(
        splits, 
        model_three)) %>% 
  summarise(mean_rmse_model_1 = mean(rmse_model_1), 
            mean_rmse_model_2 = mean(rmse_model_2), 
            mean_rmse_model_3 = mean(rmse_model_3))

#  5-fold cross-validation 
# A tibble: 1 x 3
  mean_rmse_model_1 mean_rmse_model_2 mean_rmse_model_3
              <dbl>             <dbl>             <dbl>
1           0.00202           0.00199           0.00192

That code flow worked just fine, but we had to repeat ourselves when creating the functions for each model. Let’s toggle to a flow where we define three models - the ones that we wish to test with via cross-validation and RMSE - then pass those models to one function.

First, we use as.formula() to define our three models.

mod_form_1 <- as.formula(returns ~ MKT)
mod_form_2 <- as.formula(returns ~ MKT + SMB + HML)
mod_form_3 <- as.formula(returns ~ MKT + SMB + HML + RMW + CMA)

Now we write one function that takes split as an argument, same as above, but also takes formula as an argument, so we can pass it different models. This gives us the flexibility to more easily define new models and pass them to map, so I’ll append _flex to the name of this function.

ff_rmse_models_flex <- function(split, formula) {
  
  split_for_data <- analysis(split)
  
  ff_model <- lm(formula, data = split_for_data)
  
  holdout <- assessment(split)

  rmse <- 
    ff_model %>%
    augment(newdata = holdout) %>% 
    rmse(returns, .fitted) %>% 
    pull(.estimate)
  

}

Now we use the same code flow as before, except we call map_dbl(), pass it our cved_ff$splits object, our new flex function called ff_rmse_models_flex(), and the model we wish to pass as the formula argument. First we pass it mod_form_1.

cved_ff %>% 
  mutate(rmse_model_1 = map_dbl(cved_ff$splits, 
                          ff_rmse_models_flex,
                          formula = mod_form_1))

#  5-fold cross-validation 
# A tibble: 5 x 3
  splits           id    rmse_model_1
* <list>           <chr>        <dbl>
1 <split [1K/252]> Fold1      0.00208
2 <split [1K/252]> Fold2      0.00189
3 <split [1K/252]> Fold3      0.00201
4 <split [1K/252]> Fold4      0.00224
5 <split [1K/251]> Fold5      0.00190

Now let’s pass it all three models and find the mean RMSE.

cved_ff %>% 
  mutate(rmse_model_1 = map_dbl(cved_ff$splits, 
                          ff_rmse_models_flex,
                          formula = mod_form_1),
         rmse_model_2 = map_dbl(cved_ff$splits, 
                          ff_rmse_models_flex,
                          formula = mod_form_2),
         rmse_model_3 = map_dbl(cved_ff$splits, 
                          ff_rmse_models_flex,
                          formula = mod_form_3)) %>% 
         summarise(mean_rmse_model_1 = mean(rmse_model_1), 
                   mean_rmse_model_2 = mean(rmse_model_2), 
                   mean_rmse_model_3 = mean(rmse_model_3))

#  5-fold cross-validation 
# A tibble: 1 x 3
  mean_rmse_model_1 mean_rmse_model_2 mean_rmse_model_3
              <dbl>             <dbl>             <dbl>
1           0.00202           0.00199           0.00192

Alright, that code flow seems a bit more flexible than our original method of writing a function to assess each model. We didn’t do much hard thinking about functional form here, but hopefully this provides a template where you could assess more nuanced models. We’ll get into bootstrapping and time series work next week, then head to Shiny to ring in the New Year!

And, finally, a couple of public service announcements.

First, thanks to everyone who has checked out my new book! The price just got lowered for the holidays. See on Amazon or on the CRC homepage (okay, that was more of an announcement about my book).

Second, applications are open for the Battlefin alternative data contest, and RStudio is one of the tools you can use to analyze the data. Check it out here. In January, they’ll announce 25 finalists who will get to compete for a cash prize and connect with some quant hedge funds. Go get ‘em!

Thanks for reading and see you next time.

For more on cross-validation, see “An Introduction to Statistical Learning”, chapter 5. Available online here: http://www-bcf.usc.edu/~gareth/ISL/.↩

Many Factor Models

Mon, 19 Nov 2018 00:00:00 +0000

Today, we will return to the Fama French (FF) model of asset returns and use it as a proxy for fitting and evaluating multiple linear models. In a previous post, we reviewed how to run the FF three-factor model on the returns of a portfolio. That is, we ran one model on one set of returns. Today, we will run multiple models on multiple streams of returns, which will allow us to compare those models and hopefully build a code scaffolding that can be used when we wish to explore other factor models.

Let’s get to it!

We will start by importing daily prices and calculating the returns of our five usual ETFs: SPY, EFA, IJS, EEM and AGG. I covered the logic for this task in a previous post and the code is below.

library(tidyverse)
library(broom)
library(tidyquant)
library(timetk)


symbols <- c("SPY", "EFA", "IJS", "EEM", "AGG")


# The prices object will hold our daily price data.
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)


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


asset_returns_long %>% 
  head()

# A tibble: 6 x 3
# Groups:   asset [1]
  date       asset  returns
  <date>     <chr>    <dbl>
1 2013-01-02 SPY    0.0253 
2 2013-01-03 SPY   -0.00226
3 2013-01-04 SPY    0.00438
4 2013-01-07 SPY   -0.00274
5 2013-01-08 SPY   -0.00288
6 2013-01-09 SPY    0.00254

We now have the returns of our five ETFs saved in a tidy tibble called asset_returns_long. Normally we would combine these into one portfolio, but we will leave them as individual assets today so we can explore how to model the returns of multiple assets saved in one data object.

We are going to model those individual assets on the Fama French set of five factors to see if those factors explain our asset returns. Those five factors are the market returns (similar to CAPM), firm size (small versus big), firm value (high versus low book-to-market), firm profitability (high versus low operating profits), and firm investment (high versus low total asset growth). To learn more about the theory behind using these factors, see this article.

Our next step is to import our factor data, and luckily FF make them available on their website. I presented the code showing how to import this data in a previous post on my blog so I won’t go through the steps again, but the code is below.

factors_data_address <- 
"http://mba.tuck.dartmouth.edu/pages/faculty/ken.french/ftp/Global_5_Factors_Daily_CSV.zip"

factors_csv_name <- "Global_5_Factors_Daily.csv"

temp <- tempfile()

download.file(
  # location of file to be downloaded
  factors_data_address,
  # where we want R to store that file
  temp, 
  quiet = TRUE)


Global_5_Factors <- 
  read_csv(unz(temp, factors_csv_name), skip = 6 ) %>%
  rename(date = X1, MKT = `Mkt-RF`) %>%
  mutate(date = ymd(parse_date_time(date, "%Y%m%d")))%>%
  mutate_if(is.numeric, funs(. / 100)) %>% 
  select(-RF)

Global_5_Factors %>% 
  head()

# A tibble: 6 x 6
  date            MKT       SMB     HML     RMW       CMA
  <date>        <dbl>     <dbl>   <dbl>   <dbl>     <dbl>
1 1990-07-02  0.00700 -0.000600 -0.0031  0.0022  0.0004  
2 1990-07-03  0.0018   0.0008   -0.0017  0.0007  0.0004  
3 1990-07-04  0.0063  -0.0019   -0.0016 -0.0007  0.000300
4 1990-07-05 -0.0074   0.0031    0.0017 -0.0013  0.000600
5 1990-07-06  0.002   -0.0015    0.0002  0.002  -0.000300
6 1990-07-09  0.00240  0.0018    0.0001  0.0004 -0.00240

Next, we mash asset_returns_long and Global_5_Factors into one data object, using left_join(..., by = "date") because each object has a column called date.

data_joined_tidy <- 
  asset_returns_long %>%
  left_join(Global_5_Factors, by = "date") %>% 
  na.omit()

data_joined_tidy %>% 
  head(5)

# A tibble: 5 x 8
# Groups:   asset [1]
  date       asset  returns     MKT      SMB       HML     RMW      CMA
  <date>     <chr>    <dbl>   <dbl>    <dbl>     <dbl>   <dbl>    <dbl>
1 2013-01-02 SPY    0.0253   0.0199 -0.0043   0.0028   -0.0028 -0.0023 
2 2013-01-03 SPY   -0.00226 -0.0021  0.00120  0.000600  0.0008  0.0013 
3 2013-01-04 SPY    0.00438  0.0064  0.0011   0.0056   -0.0043  0.0036 
4 2013-01-07 SPY   -0.00274 -0.0014  0.00580  0        -0.0015  0.0001 
5 2013-01-08 SPY   -0.00288 -0.0027  0.0018  -0.00120  -0.0002  0.00120

We now have a tibble called data_joined_tidy with the asset names in the asset column, asset returns in the returns column, and our five FF factors in the MKT, SMB, HML, RMW and CMA columns. We want to explore whether there is a linear relationship between the returns of our five assets and any/all of the five FF factors. Specifically, we will run several linear regressions, save the results, examine the results, and then quickly visualize the results.

The broom and purrr packages will do a lot of the heavy lifting for us eventually, but let’s start with a simple example: regress the return of one ETF on one of the FF factors. We will use do() for this, which I believe has been declared not a best practice but it’s so irresistibly simple to plunk into the pipes.

data_joined_tidy %>% 
  filter(asset == "SPY") %>% 
  do(model = lm(returns ~ MKT, data = .))

Source: local data frame [1 x 2]
Groups: <by row>

# A tibble: 1 x 2
  asset model   
* <chr> <list>  
1 SPY   <S3: lm>

That worked, but our model is stored as a nested S3 object. Let’s use tidy(), glance(), and augment() to view the results.

data_joined_tidy %>% 
  filter(asset == "SPY") %>% 
  do(model = lm(returns ~ MKT, data = .)) %>% 
  tidy(model)

# A tibble: 2 x 6
# Groups:   asset [1]
  asset term        estimate std.error statistic p.value
  <chr> <chr>          <dbl>     <dbl>     <dbl>   <dbl>
1 SPY   (Intercept) 0.000126  0.000100      1.26   0.208
2 SPY   MKT         1.02      0.0154       66.0    0

data_joined_tidy %>% 
  filter(asset == "SPY") %>% 
  do(model = lm(returns ~ MKT, data = .)) %>% 
  glance(model)

# A tibble: 1 x 12
# Groups:   asset [1]
  asset r.squared adj.r.squared   sigma statistic p.value    df logLik
  <chr>     <dbl>         <dbl>   <dbl>     <dbl>   <dbl> <int>  <dbl>
1 SPY       0.776         0.776 0.00354     4356.       0     2  5319.
# ... with 4 more variables: AIC <dbl>, BIC <dbl>, deviance <dbl>,
#   df.residual <int>

data_joined_tidy %>% 
  filter(asset == "SPY") %>% 
  do(model = lm(returns ~ MKT, data = .)) %>% 
  augment(model) %>% 
  head(5)

# A tibble: 5 x 10
# Groups:   asset [1]
  asset  returns     MKT  .fitted .se.fit   .resid    .hat  .sigma .cooksd
  <chr>    <dbl>   <dbl>    <dbl>   <dbl>    <dbl>   <dbl>   <dbl>   <dbl>
1 SPY    0.0253   0.0199  0.0204  3.17e-4  4.90e-3 7.99e-3 0.00354 7.77e-3
2 SPY   -0.00226 -0.0021 -0.00201 1.07e-4 -2.47e-4 9.17e-4 0.00354 2.24e-6
3 SPY    0.00438  0.0064  0.00665 1.36e-4 -2.27e-3 1.47e-3 0.00354 3.02e-4
4 SPY   -0.00274 -0.0014 -0.00130 1.04e-4 -1.44e-3 8.59e-4 0.00354 7.07e-5
5 SPY   -0.00288 -0.0027 -0.00263 1.11e-4 -2.56e-4 9.82e-4 0.00354 2.56e-6
# ... with 1 more variable: .std.resid <dbl>

We can quickly pop our augmented results into ggplot() and inspect our residuals versus our fitted values. The important takeaway here is that our augmented results are in a data frame, so we can use all of our ggplot() code flows to create visualizations.

data_joined_tidy %>% 
  filter(asset == "SPY") %>% 
  do(model = lm(returns ~ MKT, data = .)) %>% 
  augment(model) %>% 
  ggplot(aes(y = .resid, x = .fitted)) +
  geom_point(color = "cornflowerblue")

Alright, we have run a simple linear regression and seen how tidy(), glance(), and augment() clean up the model results. We could, of course, keep repeating this process for any combination of the FF factors and any of our ETFs, but let’s look at a more efficient approach for fitting multiple models on all of our ETFs.

First, let’s create and save three models as functions. That will allow us to pass them to the map functions from purrr. We will save a one-factor model as a function called model_one, a three-factor model as a function called model_two and a five-factor model as a function called model_three. Note that each function takes a data frame as an argument.

model_one <- function(df) {
  lm(returns ~ MKT, data = df)
}

model_two <- function(df) {
  lm(returns ~ MKT + SMB + HML, data = df)
}

model_three <- function(df) {
  lm(returns ~ MKT + SMB + HML + RMW + CMA, data = df)
}

Now we want to run those three models on each of our five asset returns or, equivalently, we need to pass in a data frame of asset returns to each of those functions. However, we don’t want to save our five ETF returns as five separate tibbles. That would get quite unwieldy with a larger set of ETFs.

Instead, let’s use nest() to make our data more compact!

data_joined_tidy %>% 
  group_by(asset) %>% 
  nest()

# A tibble: 5 x 2
  asset data                
  <chr> <list>              
1 SPY   <tibble [1,259 × 7]>
2 EFA   <tibble [1,259 × 7]>
3 IJS   <tibble [1,259 × 7]>
4 EEM   <tibble [1,259 × 7]>
5 AGG   <tibble [1,259 × 7]>

In my mind, our task has gotten a little conceptually simpler: we want to apply each of our models to each tibble in the data column, and to do that, we need to pass each tibble in that column to our functions.

Let’s use a combination of mutate() and map().

data_joined_tidy %>% 
  group_by(asset) %>% 
  nest() %>%
  mutate(one_factor_model = map(data, model_one),
         three_factor_model = map(data, model_two),
         five_factor_model = map(data, model_three))

# A tibble: 5 x 5
  asset data           one_factor_model three_factor_mod… five_factor_mod…
  <chr> <list>         <list>           <list>            <list>          
1 SPY   <tibble [1,25… <S3: lm>         <S3: lm>          <S3: lm>        
2 EFA   <tibble [1,25… <S3: lm>         <S3: lm>          <S3: lm>        
3 IJS   <tibble [1,25… <S3: lm>         <S3: lm>          <S3: lm>        
4 EEM   <tibble [1,25… <S3: lm>         <S3: lm>          <S3: lm>        
5 AGG   <tibble [1,25… <S3: lm>         <S3: lm>          <S3: lm>

From a substantive perspective, we’re done! We have run all three models on all five assets and stored the results. Of course, we’d like to be able to look at the results, but the substance is all there.

The same as we did above, we will use tidy(), glimpse(), and augment(), but now in combination with mutate() and map() to clean up the model results stored in each column. Let’s start by running just model_one and then tidying the results.

data_joined_tidy %>% 
  group_by(asset) %>% 
  nest() %>%
  mutate(one_factor_model = map(data, model_one),
         tidied_one = map(one_factor_model, tidy))

# A tibble: 5 x 4
  asset data                 one_factor_model tidied_one          
  <chr> <list>               <list>           <list>              
1 SPY   <tibble [1,259 × 7]> <S3: lm>         <data.frame [2 × 5]>
2 EFA   <tibble [1,259 × 7]> <S3: lm>         <data.frame [2 × 5]>
3 IJS   <tibble [1,259 × 7]> <S3: lm>         <data.frame [2 × 5]>
4 EEM   <tibble [1,259 × 7]> <S3: lm>         <data.frame [2 × 5]>
5 AGG   <tibble [1,259 × 7]> <S3: lm>         <data.frame [2 × 5]>

If we want to see those tidied results, we need to unnest() them.

data_joined_tidy %>% 
  group_by(asset) %>% 
  nest() %>%
  mutate(one_factor_model = map(data, model_one),
         tidied_one = map(one_factor_model, tidy)) %>% 
  unnest(tidied_one)

# A tibble: 10 x 6
   asset term          estimate std.error statistic   p.value
   <chr> <chr>            <dbl>     <dbl>     <dbl>     <dbl>
 1 SPY   (Intercept)  0.000126  0.000100      1.26  2.08e-  1
 2 SPY   MKT          1.02      0.0154       66.0   0.       
 3 EFA   (Intercept) -0.000288  0.0000972    -2.97  3.07e-  3
 4 EFA   MKT          1.29      0.0150       86.0   0.       
 5 IJS   (Intercept)  0.0000634 0.000171      0.371 7.11e-  1
 6 IJS   MKT          1.13      0.0264       42.9   3.25e-248
 7 EEM   (Intercept) -0.000491  0.000203     -2.42  1.57e-  2
 8 EEM   MKT          1.40      0.0313       44.8   4.94e-263
 9 AGG   (Intercept)  0.0000888 0.0000572     1.55  1.21e-  1
10 AGG   MKT         -0.0282    0.00883      -3.19  1.46e-  3

Let’s use glance() and augment() as well.

data_joined_tidy %>% 
  group_by(asset) %>% 
  nest() %>%
  mutate(one_factor_model = map(data, model_one),
         tidied_one = map(one_factor_model, tidy),
         glanced_one = map(one_factor_model, glance),
         augmented_one = map(one_factor_model, augment))

# A tibble: 5 x 6
  asset data     one_factor_model tidied_one   glanced_one  augmented_one 
  <chr> <list>   <list>           <list>       <list>       <list>        
1 SPY   <tibble… <S3: lm>         <data.frame… <data.frame… <data.frame […
2 EFA   <tibble… <S3: lm>         <data.frame… <data.frame… <data.frame […
3 IJS   <tibble… <S3: lm>         <data.frame… <data.frame… <data.frame […
4 EEM   <tibble… <S3: lm>         <data.frame… <data.frame… <data.frame […
5 AGG   <tibble… <S3: lm>         <data.frame… <data.frame… <data.frame […

Again, we use unnest() if we wish to look at the glanced or augmented results.

data_joined_tidy %>% 
  group_by(asset) %>% 
  nest() %>%
  mutate(one_factor_model = map(data, model_one),
         tidied_one = map(one_factor_model, tidy),
         glanced_one = map(one_factor_model, glance),
         augmented_one = map(one_factor_model, augment)) %>% 
  # unnest(tidied_one) 
   unnest(glanced_one)

# A tibble: 5 x 16
  asset data      one_factor_model tidied_one    augmented_one   r.squared
  <chr> <list>    <list>           <list>        <list>              <dbl>
1 SPY   <tibble … <S3: lm>         <data.frame … <data.frame [1…   0.776  
2 EFA   <tibble … <S3: lm>         <data.frame … <data.frame [1…   0.855  
3 IJS   <tibble … <S3: lm>         <data.frame … <data.frame [1…   0.594  
4 EEM   <tibble … <S3: lm>         <data.frame … <data.frame [1…   0.615  
5 AGG   <tibble … <S3: lm>         <data.frame … <data.frame [1…   0.00803
# ... with 10 more variables: adj.r.squared <dbl>, sigma <dbl>,
#   statistic <dbl>, p.value <dbl>, df <int>, logLik <dbl>, AIC <dbl>,
#   BIC <dbl>, deviance <dbl>, df.residual <int>

  # unnest(augmented_one)

data_joined_tidy %>% 
  group_by(asset) %>% 
  nest() %>%
  mutate(one_factor_model = map(data, model_one),
         tidied_one = map(one_factor_model, tidy),
         glanced_one = map(one_factor_model, glance),
         augmented_one = map(one_factor_model, augment)) %>% 
  # unnest(tidied_one) 
  # unnest(glanced_one)
  unnest(augmented_one) %>% 
  head(5)

# A tibble: 5 x 10
  asset  returns     MKT  .fitted .se.fit   .resid    .hat  .sigma .cooksd
  <chr>    <dbl>   <dbl>    <dbl>   <dbl>    <dbl>   <dbl>   <dbl>   <dbl>
1 SPY    0.0253   0.0199  0.0204  3.17e-4  4.90e-3 7.99e-3 0.00354 7.77e-3
2 SPY   -0.00226 -0.0021 -0.00201 1.07e-4 -2.47e-4 9.17e-4 0.00354 2.24e-6
3 SPY    0.00438  0.0064  0.00665 1.36e-4 -2.27e-3 1.47e-3 0.00354 3.02e-4
4 SPY   -0.00274 -0.0014 -0.00130 1.04e-4 -1.44e-3 8.59e-4 0.00354 7.07e-5
5 SPY   -0.00288 -0.0027 -0.00263 1.11e-4 -2.56e-4 9.82e-4 0.00354 2.56e-6
# ... with 1 more variable: .std.resid <dbl>

Let’s change gears a bit and evaluate how well each model explained one of our asset returns, IJS, based on adjusted R-squareds.

First, we use filter(asset == "IJS"), nest the data, then map() each of our models to the nested data. I don’t want the raw data anymore, so will remove it with select(-data).

data_joined_tidy %>% 
  group_by(asset) %>% 
  filter(asset == "IJS") %>%
  nest() %>%
  mutate(one_factor_model = map(data, model_one),
         three_factor_model = map(data, model_two),
         five_factor_model = map(data, model_three)) %>% 
  select(-data)

# A tibble: 1 x 4
  asset one_factor_model three_factor_model five_factor_model
  <chr> <list>           <list>             <list>           
1 IJS   <S3: lm>         <S3: lm>           <S3: lm>

We now have our three model results for the returns of IJS. Let’s use gather() to put those results in tidy format, and then glance() to get at the adjusted R-squared, AIC, and BIC.

models_results <- 
  data_joined_tidy %>% 
  group_by(asset) %>% 
  filter(asset == "IJS") %>%
  nest() %>%
  mutate(one_factor_model = map(data, model_one),
         three_factor_model = map(data, model_two),
         five_factor_model = map(data, model_three)) %>% 
  select(-data) %>% 
  gather(models, results, -asset) %>% 
  mutate(glanced_results = map(results, glance)) %>% 
  unnest(glanced_results) %>% 
  select(asset, models, adj.r.squared, AIC, BIC)

models_results

# A tibble: 3 x 5
  asset models             adj.r.squared    AIC    BIC
  <chr> <chr>                      <dbl>  <dbl>  <dbl>
1 IJS   one_factor_model           0.594 -9282. -9266.
2 IJS   three_factor_model         0.599 -9298. -9272.
3 IJS   five_factor_model          0.637 -9421. -9385.

Let’s plot these results and quickly glance at where the adjusted R-squareds lie. We will call ggplot(aes(x = models, y = adj.r.squared, color = models)) and then geom_point().

models_results %>% 
  ggplot(aes(x = models, y = adj.r.squared, color = models)) + 
  geom_point() +
  labs(x = "", 
       title = "Models Comparison") +
  theme(plot.title = element_text(hjust = 0.5))

That chart looks alright, but the models are placed on the x-axis in alphabetical order, whereas I’d prefer they go in ascending order based on adjusted R-squared. We can make that happen with ggplot(aes(x = reorder(models, adj.r.squared)...). Let’s also add labels on the chart with geom_text(aes(label = models), nudge_y = .003). Since we’re labeling in the chart, we can remove the x-axis labels with theme(axis.text.x = element_blank()).

models_results %>% 
  ggplot(aes(x = reorder(models, adj.r.squared), y = adj.r.squared, color = models)) + 
  geom_point(show.legend = NA) +
  geom_text(aes(label = models),
            nudge_y = .003) +
  labs(x = "", 
       title = "Models Comparison") +
  theme(plot.title = element_text(hjust = 0.5),
        axis.text.x = element_blank(),
        axis.ticks.x=element_blank())

Pay close attention to the scale on the y-axis. The lowest adjusted R-squared is less than .05 away from the highest. Maybe that amount is meaningful in your world, and maybe it isn’t.

Before we close, let’s get back to modeling and saving results. Here is the full code for running each model on each asset, then tidying, glancing, and augmenting those results. The result is a compact, nested tibble where the columns can be unnested depending on which results we wish to extract.

data_joined_tidy %>% 
  group_by(asset) %>% 
  nest() %>%
  mutate(one_factor_model = map(data, model_one),
         three_factor_model = map(data, model_two),
         five_factor_model = map(data, model_three)) %>% 
  mutate(tidied_one = map(one_factor_model, tidy),
         tidied_three = map(three_factor_model, tidy),
         tidied_five = map(five_factor_model, tidy)) %>% 
  mutate(glanced_one = map(one_factor_model, glance),
         glanced_three = map(three_factor_model, glance),
         glanced_five = map(five_factor_model, glance)) %>%
  mutate(augmented_one = map(one_factor_model, augment),
         augmented_three = map(three_factor_model, augment),
         augmented_five = map(five_factor_model, augment)) # %>%

# A tibble: 5 x 14
  asset data           one_factor_model three_factor_mod… five_factor_mod…
  <chr> <list>         <list>           <list>            <list>          
1 SPY   <tibble [1,25… <S3: lm>         <S3: lm>          <S3: lm>        
2 EFA   <tibble [1,25… <S3: lm>         <S3: lm>          <S3: lm>        
3 IJS   <tibble [1,25… <S3: lm>         <S3: lm>          <S3: lm>        
4 EEM   <tibble [1,25… <S3: lm>         <S3: lm>          <S3: lm>        
5 AGG   <tibble [1,25… <S3: lm>         <S3: lm>          <S3: lm>        
# ... with 9 more variables: tidied_one <list>, tidied_three <list>,
#   tidied_five <list>, glanced_one <list>, glanced_three <list>,
#   glanced_five <list>, augmented_one <list>, augmented_three <list>,
#   augmented_five <list>

  # unnest any broomed column for viewing
  # unnest(Insert nested column name here)

There are probably more efficient ways to do this, and in the future we’ll explore a package that runs these model comparisons for us, but for now, think about how we could wrap this work to a Shiny application or extend this code flow to accommodate more models and more assets.

Thanks for reading and see you next time!

Monte Carlo

Tue, 05 Jun 2018 00:00:00 +0000

Today, we change gears from our previous work on Fama French and run a Monte Carlo (MC) simulation of future portfolio returns. Monte Carlo relies on repeated, random sampling. We will sample based on two parameters: mean and standard deviation of portfolio returns. Our long-term goal (long-term == over the next two or three blog posts) is to build a Shiny app that allows an end user to build a custom portfolio, simulate returns and visualize the results. If you just can’t wait, a link to that final Shiny app is here.

Let’s get to it.

Devoted readers won’t be surprised that we will be simulating the returns of our usual portfolio, which consists of:

+ SPY (S&P 500 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 simulate that portfolio, we need to calculate portfolio monthly returns, which was covered in my previous post, Introduction to Portfolio Returns.

I won’t go through the logic again, but the code is here:

library(tidyquant)
library(tidyverse)
library(timetk)
library(broom)

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 will be working with the data object portfolio_returns_tq_rebalanced_monthly and we first find the mean and standard deviation of returns.

We will name those variables mean_port_return and stddev_port_return.

mean_port_return <- 
  mean(portfolio_returns_tq_rebalanced_monthly$returns)

stddev_port_return <- 
  sd(portfolio_returns_tq_rebalanced_monthly$returns)

Then we use the rnorm() function to sample from a distribution with mean equal to mean_port_return and standard deviation equal to stddev_port_return. That is the crucial random sampling that underpins this exercise.

We also must decide how many draws to pull from this distribution, meaning how many monthly returns we will simulate. 120 months is 10 years, and that feels like a good amount of time.

simulated_monthly_returns <- rnorm(120, 
                                   mean_port_return, 
                                   stddev_port_return)

Have a quick look at the simulated monthly returns.

head(simulated_monthly_returns)

[1]  0.05216143  0.02271485 -0.04271307  0.04811250 -0.05575058  0.06006096

tail(simulated_monthly_returns)

[1]  0.024794729  0.008539198 -0.018852629 -0.002656127 -0.025583337
[6]  0.004412755

Next, we calculate how a dollar would have grown given those random monthly returns. We first add a 1 to each of our monthly returns, because we start with $1.

simulated_returns_add_1 <- 
  tibble(c(1, 1 + simulated_monthly_returns)) %>% 
  `colnames<-`("returns")

head(simulated_returns_add_1)

# A tibble: 6 x 1
  returns
    <dbl>
1   1    
2   1.05 
3   1.02 
4   0.957
5   1.05 
6   0.944

That data is now ready to be converted into the cumulative growth of a dollar. We can use either accumulate() from purrr or cumprod(). Let’s use both of them with mutate() and confirm consistent, reasonable results.

simulated_growth <- 
simulated_returns_add_1 %>%
    mutate(growth1 = accumulate(returns, function(x, y) x * y),
           growth2 = accumulate(returns, `*`),
           growth3 = cumprod(returns)) %>% 
    select(-returns)

tail(simulated_growth)

# A tibble: 6 x 3
  growth1 growth2 growth3
    <dbl>   <dbl>   <dbl>
1    2.09    2.09    2.09
2    2.11    2.11    2.11
3    2.07    2.07    2.07
4    2.06    2.06    2.06
5    2.01    2.01    2.01
6    2.02    2.02    2.02

We just ran three simulations of dollar growth over 120 months. We passed in the same monthly returns, and that’s why we got three equivalent results.

Are they reasonable? What compound annual growth rate (CAGR) is implied by this simulation?

cagr <- 
  ((simulated_growth$growth1[nrow(simulated_growth)]^
      (1/10)) - 1) * 100

cagr <- round(cagr, 2)

This simulation implies an annual compounded growth of 7.26%. That seems reasonable given our actual returns have all been taken from a raging bull market. Remember, the above code is a simulation based on sampling from a normal distribution. If you re-run this code on your own, you will get a different result.

If we feel good about this first simulation, we can run several more to get a sense for how they are distributed. Before we do that, let’s create several different functions that could run the same simulation.

Several Simulation Functions

Let’s build three simulation functions that incorporate the accumulate() and cumprod() workflows above. We have confirmed they give consistent results so it’s a matter of stylistic preference as to which one is chosen in the end. Perhaps you feel that one is more flexible or extensible, or fits better with your team’s code flows.

Each of the below functions needs four arguments: N for the number of months to simulate (we chose 120 above), init_value for the starting value (we used $1 above), and the mean-standard deviation pair to create draws from a normal distribution. We choose N and init_value, and derive the mean-standard deviation pair from our portfolio monthly returns.

Here is our first growth simulation function using accumulate().

simulation_accum_1 <- function(init_value, N, mean, stdev) {
    tibble(c(init_value, 1 + rnorm(N, mean, stdev))) %>% 
    `colnames<-`("returns") %>%
    mutate(growth = 
             accumulate(returns, 
                        function(x, y) x * y)) %>% 
    select(growth)
}

Almost identical, here is the second simulation function using accumulate().

simulation_accum_2 <- function(init_value, N, mean, stdev) {
  tibble(c(init_value, 1 + rnorm(N, mean, stdev))) %>% 
    `colnames<-`("returns") %>%
  mutate(growth = accumulate(returns, `*`)) %>% 
  select(growth)
}

Finally, here is a simulation function using cumprod().

simulation_cumprod <- function(init_value, N, mean, stdev) {
  tibble(c(init_value, 1 + rnorm(N, mean, stdev))) %>% 
    `colnames<-`("returns") %>%
  mutate(growth = cumprod(returns)) %>% 
  select(growth)
}

Here is a function that uses all three methods, in case we want a fast way to re-confirm consistency.

simulation_confirm_all <- function(init_value, N, mean, stdev) {
  tibble(c(init_value, 1 + rnorm(N, mean, stdev))) %>% 
    `colnames<-`("returns") %>%
    mutate(growth1 = accumulate(returns, function(x, y) x * y),
           growth2 = accumulate(returns, `*`),
           growth3 = cumprod(returns)) %>% 
    select(-returns)
}

Let’s test that confirm_all() function with an init_value of 1, N of 120, and our parameters.

simulation_confirm_all_test <- 
  simulation_confirm_all(1, 120, 
                         mean_port_return, stddev_port_return)

tail(simulation_confirm_all_test)

# A tibble: 6 x 3
  growth1 growth2 growth3
    <dbl>   <dbl>   <dbl>
1    2.26    2.26    2.26
2    2.22    2.22    2.22
3    2.17    2.17    2.17
4    2.21    2.21    2.21
5    2.20    2.20    2.20
6    2.23    2.23    2.23

That’s all for today. Next time, we will explore methods for running more than one simulation with the above functions and then visualizing the results. See you then.