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