This illustrates how using leverage and targeting a specific volatility can enhance the overall risk/return profile for portfolios. I have heard of targeting volatiliy but never really explored it until reading Adaptive Markets by Andrew Lo.

library(quantmod)
library(PerformanceAnalytics)
library(tidyverse)

#create custome ggplot theme
#from http://joeystanley.com/blog/custom-themes-in-ggplot2
theme_joey <- function () { 
  theme_bw(base_size=12, base_family="Avenir") %+replace% 
    theme(
      panel.background  = element_blank(),
      plot.background = element_rect(fill="gray96", colour=NA), 
      legend.background = element_rect(fill="transparent", colour=NA),
      legend.key = element_rect(fill="transparent", colour=NA)
    )
}

First get the your data. In this case I used the daily CSRP date free from the Fama French Data library link. You will need to convert from csv to xts in R.

load("~/Coding/R/Working Directory/Kenneth French Factor Data/Fama French 3 factor and momentum from 1926 - July 2018.RData")

Create an xts dataframe from the Risk Free return and Market Return.

vol_dataframe_FF <- merge(FF_3_Factor_and_Momentum$MKT_Plus_Rf,FF_3_Factor_and_Momentum$RF)
colnames(vol_dataframe_FF) <- c("US Stock Market", "Risk Free Rate")

Create lagged return series to invest in to eliminate look ahead bias. We can only invest in the close following the signal day.

vol_dataframe_FF$lag_stock_returns <- lag.xts(vol_dataframe_FF[,1], -1)
vol_dataframe_FF$lag_cash_returns <- lag.xts(vol_dataframe_FF[,2], -1)

We create blended rolling vol time frames to minimize parameter specification risk (i.e. picking one time frame that worked really well in the past but might be overfitting for the future). We are trying to get the general signal vs. exactly right parameter. Using 20 - 140 trading days as the short term rolling window, divided into 20 day increments. There is a good research summary from Lazard Asset Management indicating that a 1 - 6 month window is a good place for predicting future volatilty based on autocorrelation.

equity_vol_20 <- rollapply(vol_dataframe_FF[,1], FUN = StdDev.annualized,
                                         width = 20)
equity_vol_40 <- rollapply(vol_dataframe_FF[,1], FUN = StdDev.annualized,
                           width = 40)
equity_vol_60 <- rollapply(vol_dataframe_FF[,1], FUN = StdDev.annualized,
                           width = 60)
equity_vol_80 <- rollapply(vol_dataframe_FF[,1], FUN = StdDev.annualized,
                           width = 80)
equity_vol_100 <- rollapply(vol_dataframe_FF[,1], FUN = StdDev.annualized,
                           width = 100)
equity_vol_120 <- rollapply(vol_dataframe_FF[,1], FUN = StdDev.annualized,
                           width = 120)
equity_vol_140 <- rollapply(vol_dataframe_FF[,1], FUN = StdDev.annualized,
                           width = 140)

Equity_Vol_Combined <- merge(equity_vol_20,
                             equity_vol_40,
                             equity_vol_60,
                             equity_vol_80,
                             equity_vol_100,
                             equity_vol_120,
                             equity_vol_140)

Create a blended equity vol measure.

Equity_vol_averaged <- apply(Equity_Vol_Combined, FUN = mean, MARGIN = 1)

Convert to xts dataframe.

Equity_vol_averaged_xts <- as.xts(as.data.frame(Equity_vol_averaged), dateFormat = "Date")

Merge the equity vol dataframe with the master dataframe.

vol_dataframe_FF <- merge(vol_dataframe_FF,Equity_vol_averaged_xts)

Check to make sure it looks right. I do this often to make sure the output looks correct.

tail(vol_dataframe_FF,10)
##            US.Stock.Market Risk.Free.Rate lag_stock_returns
## 2018-07-18         0.00278          8e-05          -0.00332
## 2018-07-19        -0.00332          8e-05          -0.00092
## 2018-07-20        -0.00092          8e-05           0.00158
## 2018-07-23         0.00158          8e-05           0.00228
## 2018-07-24         0.00228          8e-05           0.00838
## 2018-07-25         0.00838          8e-05          -0.00192
## 2018-07-26        -0.00192          8e-05          -0.00812
## 2018-07-27        -0.00812          8e-05          -0.00692
## 2018-07-30        -0.00692          8e-05           0.00518
## 2018-07-31         0.00518          8e-05                NA
##            lag_cash_returns Equity_vol_averaged
## 2018-07-18            8e-05           0.1285556
## 2018-07-19            8e-05           0.1267219
## 2018-07-20            8e-05           0.1252230
## 2018-07-23            8e-05           0.1246235
## 2018-07-24            8e-05           0.1213937
## 2018-07-25            8e-05           0.1204141
## 2018-07-26            8e-05           0.1173965
## 2018-07-27            8e-05           0.1172077
## 2018-07-30            8e-05           0.1179126
## 2018-07-31               NA           0.1165536

Choose a target vol level and 16% is the historical average equity vol. You wouldn’t have known that at the time but you can choose a level.

vol_dataframe_FF$target_vol <- .16

Construct the equity weight as a relation to target vol.

vol_dataframe_FF$equity_weight <- vol_dataframe_FF$target_vol/vol_dataframe_FF$Equity_vol_averaged

Cash weight will be the opposite.

vol_dataframe_FF$cash_weight <- 1 - vol_dataframe_FF$equity_weight

Get rid of any NA values.

vol_dataframe_FF <- na.omit(vol_dataframe_FF)

Compute the before fee portfolio return.

vol_dataframe_FF$portfolio_return <- (vol_dataframe_FF[,1] * vol_dataframe_FF$equity_weight) + (vol_dataframe_FF[,2] * vol_dataframe_FF$cash_weight)

Check to make sure it looks right.

tail(vol_dataframe_FF)
##            US.Stock.Market Risk.Free.Rate lag_stock_returns
## 2018-07-23         0.00158          8e-05           0.00228
## 2018-07-24         0.00228          8e-05           0.00838
## 2018-07-25         0.00838          8e-05          -0.00192
## 2018-07-26        -0.00192          8e-05          -0.00812
## 2018-07-27        -0.00812          8e-05          -0.00692
## 2018-07-30        -0.00692          8e-05           0.00518
##            lag_cash_returns Equity_vol_averaged target_vol equity_weight
## 2018-07-23            8e-05           0.1246235       0.16      1.283867
## 2018-07-24            8e-05           0.1213937       0.16      1.318026
## 2018-07-25            8e-05           0.1204141       0.16      1.328748
## 2018-07-26            8e-05           0.1173965       0.16      1.362903
## 2018-07-27            8e-05           0.1172077       0.16      1.365098
## 2018-07-30            8e-05           0.1179126       0.16      1.356937
##            cash_weight portfolio_return
## 2018-07-23  -0.2838669      0.002005800
## 2018-07-24  -0.3180261      0.002979657
## 2018-07-25  -0.3287482      0.011108610
## 2018-07-26  -0.3629026     -0.002645805
## 2018-07-27  -0.3650976     -0.011113800
## 2018-07-30  -0.3569372     -0.009418560

Making It Realistic with Fees

Chose transaction fee of 15 bps, though Andrew Lo used 5bps in his simulation but he estimates using futures the one way cost could be about 1 bps. However, transaction fees were about 2% before May day when commissions became unfixed, so you would not be able to execute this strategy fully since 1926, but you can going forward.

Transaction_Fee <- 0.0015

Calculate the portfolio turnover to calculate the fee

Equity_weight_change <- lag.xts(vol_dataframe_FF$equity_weight, -1) - vol_dataframe_FF$equity_weight
Cash_weight_change <- lag.xts(vol_dataframe_FF$cash_weight, -1) - vol_dataframe_FF$cash_weight

vol_dataframe_FF$Equity_weight_change <- Equity_weight_change
vol_dataframe_FF$Cash_weight_change <- Cash_weight_change

Portfolio_Turnover <- abs(vol_dataframe_FF$Equity_weight_change) + abs(vol_dataframe_FF$Cash_weight_change)

vol_dataframe_FF$Portfolio_Turnover <- Portfolio_Turnover

vol_dataframe_FF$Transaction_Fees <- vol_dataframe_FF$Portfolio_Turnover * Transaction_Fee

vol_dataframe_FF$portfolio_return_after_fees <- vol_dataframe_FF$portfolio_return - vol_dataframe_FF$Transaction_Fees

See if the actual porfolio vol came close to the target using 100 day, 252 days, 756 days (3 year)

vol_dataframe_FF$portfolio_return_vol_after_fees_100 <- rollapply(vol_dataframe_FF$portfolio_return_after_fees, FUN = StdDev.annualized,
                                                width = 100)
vol_dataframe_FF$portfolio_return_vol_after_fees_252 <- rollapply(vol_dataframe_FF$portfolio_return_after_fees, FUN = StdDev.annualized,
                                                                  width = 252)
vol_dataframe_FF$portfolio_return_vol_after_fees_756 <- rollapply(vol_dataframe_FF$portfolio_return_after_fees, FUN = StdDev.annualized,
                                                                  width = 756)

You can see using a longer measurement window it does a decent job at staying around the target volatility level looking at the summary statistics and a few charts during volatile times

##      Index            portfolio_return_vol_after_fees_100
##  Min.   :1926-12-18   Min.   :0.06598                    
##  1st Qu.:1947-04-09   1st Qu.:0.14485                    
##  Median :1970-09-19   Median :0.15804                    
##  Mean   :1971-04-06   Mean   :0.15898                    
##  3rd Qu.:1994-08-08   3rd Qu.:0.17228                    
##  Max.   :2018-07-30   Max.   :0.24704                    
##                       NA's   :99                         
##  portfolio_return_vol_after_fees_252 portfolio_return_vol_after_fees_756
##  Min.   :0.1177                      Min.   :0.1465                     
##  1st Qu.:0.1531                      1st Qu.:0.1571                     
##  Median :0.1605                      Median :0.1604                     
##  Mean   :0.1602                      Mean   :0.1607                     
##  3rd Qu.:0.1676                      3rd Qu.:0.1642                     
##  Max.   :0.1963                      Max.   :0.1795                     
##  NA's   :251                         NA's   :755

See the performance stats for the strategy before fees and after compared to 100% static buy and hold equity

Create total wealth index of the portfolio

Below ar Maximum Drawdown and Drawdown Ratio Stats

maxDrawdown(vol_dataframe_FF[,c(1,9,14)])
##                US.Stock.Market portfolio_return
## Worst Drawdown       0.8389632        0.6785538
##                portfolio_return_after_fees
## Worst Drawdown                   0.6850757
table.DrawdownsRatio(vol_dataframe_FF[,c(1,9,14)])
Testing to see at what fee level the strategy isn’t superior than a buy and hold from a pure return perspective to vol.

The equity level target vol of 16% becomes the same as pure equity exposure once the transaction costs are 40 bps of the portfolio, below that it is superior from a return perspective. This strategy works because the really bad returns happen when volatility is high and the strategy underweights equities in this instance it also overweighs equities when volatility is low which is when equities generate the highest returns usually.

There is room for further research, using different methods to forecast volatility such as GARCH, EWM, and ARMA models.