├── Demo_Death_Cross.R ├── LICENSE ├── README.md ├── heatmap_qrv_0.0.1.R ├── heatmap_qrv_0.0.3.R ├── lagger_0.0.1.R ├── original_code_from_learning_machines.R ├── qrvx_2.0.0.R ├── quant_rv_1.0.0.R ├── quant_rv_1.0.1.R ├── quant_rv_1.1.0.R ├── quant_rv_1.2.0.R ├── quant_rv_1.3.0.R ├── quant_rv_1.3.1.R ├── quant_rv_1.3.2.R ├── quant_rv_1.3.3.R ├── quant_rv_2.0.0.R ├── replacing-the-40.R ├── rv_vs_rtns_0.0.1.R ├── rv_vs_rtns_0.0.2.R ├── rv_vs_rtns_0.0.3.R ├── vol_compare └── vol_compare_0.0.2.R /Demo_Death_Cross.R: -------------------------------------------------------------------------------- 1 | ### Demo-Death-Cross.R by babbage9010 and friends 2 | ### released under MIT License 3 | # Simple "Golden Death" strategy 4 | # Signal is true at daily close if SMA(SPY,50) > SMA(SPY,200) 5 | # Strategy goes long at the open on the next day, or sells at the open 6 | # if signal returns 0 7 | # variable "sdp" is used to display the proper plot of strategy vs benchmark 8 | # without comparing the 200 day lag while SMA(SPY,200) is being calculated 9 | # Some commented out code was used to make the other plots in the blog post 10 | # originally published Nov 23 2023 11 | 12 | # Step 1: Load necessary libraries and data 13 | library(quantmod) 14 | library(PerformanceAnalytics) 15 | 16 | #dates and symbols for gathering data 17 | #setting to start of 2021 18 | #date_start <- as.Date("2021-01-01") 19 | #setting back 200 trading days 20 | #date_start <- as.Date("2020-03-18") 21 | #setting to start of SPY trading 22 | date_start <- as.Date("1993-01-29") 23 | date_end <- as.Date("2034-12-31") #a date in the future 24 | symbol_benchmark1 <- "SPY" # benchmark for comparison 25 | symbol_signal1 <- "SPY" # S&P 500 symbol (use SPY or ^GSPC) 26 | symbol_trade1 <- "SPY" # ETF to trade 27 | 28 | #get data from yahoo 29 | data_benchmark1 <- getSymbols(symbol_benchmark1, src = "yahoo", from = date_start, to = date_end, auto.assign = FALSE) 30 | data_signal1 <- getSymbols(symbol_signal1, src = "yahoo", from = date_start, to = date_end, auto.assign = FALSE) 31 | data_trade1 <- getSymbols(symbol_trade1, src = "yahoo", from = date_start, to = date_end, auto.assign = FALSE) 32 | 33 | #use these prices 34 | prices_benchmark1 <- Ad(data_benchmark1) #Adjusted(Ad) for the #1 benchmark 35 | prices_signal1 <- Ad(data_signal1) #Adjusted(Ad) for the signal 36 | prices_trade1 <- Op(data_trade1) #Open(Op) for our trading 37 | 38 | #calculate 1 day returns (rate of change) 39 | roc_benchmark1 <- ROC(prices_benchmark1, n = 1, type = "discrete") 40 | roc_signal1 <- ROC(prices_signal1, n = 1, type = "discrete") 41 | roc_trade1 <- ROC(prices_trade1, n = 1, type = "discrete") 42 | 43 | #the strategy 44 | spy50 <- SMA(prices_signal1, 50) 45 | spy200 <- SMA(prices_signal1, 200) 46 | signal_1 <- ifelse(spy50 >= spy200, 1, 0) 47 | signal_1[is.na(signal_1)] <- 0 48 | 49 | #calculate returns 50 | returns_benchmark1 <- stats::lag(roc_benchmark1, 0) 51 | returns_benchmark1 <- na.omit(returns_benchmark1) 52 | label_benchmark1 <- "Benchmark SPY total return" 53 | 54 | returns_strategy1 <- roc_trade1 * stats::lag(signal_1, 2) 55 | returns_strategy1 <- na.omit(returns_strategy1) 56 | label_strategy1 <- "Golden Death" 57 | 58 | #combine returns into one XTS object, add column names 59 | comparison <- cbind(returns_strategy1, returns_benchmark1) 60 | colnames(comparison) <- c(label_strategy1, label_benchmark1) 61 | 62 | #default chart and stats: uses full data downloaded 63 | #charts.PerformanceSummary(comparison, main = "Golden Death Strategy vs S&P 500 Benchmark - default") 64 | #stats_default <- rbind(table.AnnualizedReturns(comparison), maxDrawdown(comparison)) 65 | 66 | #trimmed plot and stats 67 | # sdp = start date for plotting 68 | sdp <- "2021-01-01/" #start date for our plot in this blog post 69 | #other sample sdp examples 70 | #sdp <- "/" # same as default, use all the data downloaded 71 | #sdp <- "/1995-12-31" # all data to end of 1995 72 | #sdp <- "1993-11-13/1995-12-31" # start after 200 days, to end of 1995 73 | charts.PerformanceSummary(comparison[sdp], main = "Golden Death Strategy vs S&P 500 Benchmark - trimmed") 74 | stats_gd <- rbind(table.AnnualizedReturns(comparison[sdp]), maxDrawdown(comparison[sdp])) 75 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2023 babbage9010 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # quant_rv 2 | quant_rv is a quantitative ETF trading strategy based on realized volatility, written in R. it's released under the MIT license. 3 | 4 | HowTo: the code is written in R, and explained at the blog. In short, install R Studio, download/save these R files to your computer and load them into R Studio and "source" them. The first time you may need to "install" a couple libraries (the error messages should help with that). More explicit beginner instructions someday, but it's pretty easy. 5 | 6 | i am blogging along with this at [https://babbage9010.wordpress.com](https://babbage9010.wordpress.com) Code releases are separate R scripts that tie into the blog posts. so far i've kept it up for about 17 posts in eight months, and starting to get somewhere interesting 7 | 8 | ====== Feb 2024 versions ====== 9 | 10 | quant_rv_2.0.0 met my goals for beating SPY total return in real and risk-adjusted returns by investing in SPY or SH depending on the daily signal. I stopped further dev on quant_rv there for now. My latest contribution, qrvx, takes two long and one short legs from quant_rv and combines them into a strategy with a negative correlation to SPY, making it suitable for combining in 60/40 fashion with SPY to get even better risk-adjusted returns than before. 11 | 12 | qrvx_2.0.0 is a subset of quant_rv specifically crafted to have a very low to negative correlation with SPY. You can read [the blog post about it here](https://babbage9010.wordpress.com/2024/02/26/replacing-the-40-with-qrvx-in-r/). 13 | 14 | ====== November 2 2023 version ====== 15 | 16 | quant_rv_1.3.3 consistently beats SPY total return by investing in SPY or SH depending on the daily signal. It meets all the goals set out for the July 3 version (below). It has not been shown to meet the stretch goal (#7 below) but that may show up in future posts as it is further explored. Also to be explored... testing with market data from before and after the in-sampe test period (July 2006 to December 2019). 17 | 18 | ====== July 3 2023 version ====== 19 | 20 | the goal (as of July 3 2023) is to create a strategy that: 21 | 1. trades popular, liquid ETFs (to allow it to scale meaningfully) with no extra leverage (no 2x or 3x ETFs) 22 | 2. develops signals based on sensible, logical, statistically meaningful market observations (like realized volatility) 23 | 3. trades at the next-day Open with signals based on the previous day’s market data (allowing plenty of time for followers to generate signals and place trades) 24 | 4. unequivacably beats a benchmark of buy-and-hold SPY (including dividends compounded, ie., calculated using Adjusted Close) on all these metrics: Annual Return, Annualized Standard Deviation, Sharpe Ratio, Max Drawdown 25 | 5. uses the same instruments as the benchmark in order to meet these goals (ie, SPY or derivatives/equivalents, not QQQ or some specific market sector ETF) 26 | 6. accomplishes its goals without consideration of dividends collected by the strategy (quant_rv gets one hand tied behind its back) 27 | 7. stretch goal: also performs reasonably well across several different market/ETF areas, to show that it really meets the #2 (sensible) goal above 28 | 29 | Note 2 (July 3 2023): the earlier goals were met in the quant_rv 1.1.0 release, please read details on the blog for that release and a bit more about setting these new goals: 30 | [https://babbage9010.wordpress.com/2023/07/03/meeting-goals-setting-higher-goals](https://babbage9010.wordpress.com/2023/07/03/meeting-goals-setting-higher-goals) 31 | 32 | ====== June 30 2023 version ====== 33 | 34 | the goal (as of June 2023) is to create a strategy that: 35 | 1. develops a signal based on market close values and trades on the next-day Open (easy to trade) 36 | 2. makes sense logically (not based on magic) 37 | 3. can beat market benchmarks on a risk-adjusted basis, and hopefully on a CAGR basis 38 | 39 | Note 1 (July 2 2023): these are goals. The first two are already met, I believe, although I plan to document why it isn't magic. The last one (beating benchmarks) is not met yet, except barely perhaps, if you only look at the Sharpe ratio. It's definitely not a great strategy yet, or even more than a proof of concept. But I have high hopes. 40 | -------------------------------------------------------------------------------- /heatmap_qrv_0.0.1.R: -------------------------------------------------------------------------------- 1 | ### heatmap_qrv v0.0.1 by babbage9010 and friends 2 | # initial release 3 | # this code is really weak, I barely knew what I was doing when I 4 | # started, probably ridiculous list of lists then convert to matrix 5 | # but it's my start. 6 | # ALSO suspect that using ifelse inside the for-for loop is BAD for 7 | # performance. maybe some flavor of apply()? help welcome, drop 8 | # me a comment on the blog or a message in Github or a tweet. 9 | ### released under MIT License 10 | 11 | # Step 1: Load necessary libraries and data 12 | library(quantmod) 13 | library(PerformanceAnalytics) 14 | 15 | date_start <- as.Date("2006-07-01") 16 | date_end <- as.Date("2019-12-31") 17 | symbol_signal1 <- "SPY" # S&P 500 symbol (use SPY or ^GSPC) 18 | symbol_trade1 <- "SPY" # ETF to trade 19 | 20 | data_spy <- getSymbols(symbol_signal1, src = "yahoo", from = date_start, to = date_end, auto.assign = FALSE) 21 | prices_signal1 <- Cl(data_spy) #SPY ETF, Close(Cl) for the signal (realized vol) 22 | prices_trade1 <- Op(data_spy) #SPY data, Open(Op) for our trading 23 | 24 | 25 | #make a heatmap, days (lookback) vs thresh (volatility threshold) 26 | # start with a small vector of days, thresh to test it out 27 | # the biggest ones here (29x31) took 7 minutes to run on a M1 MacBook Air 28 | days <- c(3,5,10) 29 | #days <- c(3,5,10,20,40,100) 30 | #days <- c(4,6,8,10,12,14,16,18,20,24,28,32,36,40) 31 | #days <- c(2,3,4,5,6,7,8,9,10,12,14,16,18,20,22,24,26,28,30,34,38,42,46,50,60,70,80,90,100) 32 | thresh <- c(0.05,0.10,0.20,0.50,0.80) 33 | #thresh <- c(0.04,0.05,0.06,0.07,0.08,0.09,0.10,0.11,0.12,0.13,0.14,0.15,0.16,0.17,0.18,0.19,0.20,0.21,0.22,0.23,0.24,0.25,0.30,0.35,0.40,0.45,0.50,0.55,0.60,0.65,0.70) 34 | 35 | #uncomment the next line if you want timestamps to see how long it takes. 36 | #timestamp() 37 | ar_days <- list() 38 | sh_days <- list() 39 | for(d in 1:length(days)){ 40 | ar_thresh <- list() 41 | sh_thresh <- list() 42 | for(t in 1:length(thresh)){ 43 | r <- ROC(prices_signal1, n = 1, type = "discrete") 44 | v <- runSD(r, n = days[d]) * sqrt(252) 45 | s <- ifelse(v < thresh[t], 1, 0) 46 | s <- na.omit(s) 47 | sr <- r * Lag(s, 2) 48 | ar <- Return.annualized(sr) 49 | ar_thresh[t] <- ar 50 | sh <- SharpeRatio.annualized(sr) 51 | sh_thresh[t] <- sh 52 | } 53 | ar_days[[d]] <- ar_thresh 54 | sh_days[[d]] <- sh_thresh 55 | } 56 | 57 | #generate the heatmaps from the matrices 58 | arm_days <- do.call(rbind,ar_days) 59 | arm <- matrix(as.numeric(arm_days),ncol=ncol(arm_days)) 60 | rownames(arm) <- days 61 | colnames(arm) <- thresh 62 | heatmap(arm,Rowv=NA,Colv=NA) 63 | 64 | shm_days <- do.call(rbind,sh_days) 65 | shm <- matrix(as.numeric(shm_days),ncol=ncol(shm_days)) 66 | rownames(shm) <- days 67 | colnames(shm) <- thresh 68 | heatmap(shm,Rowv=NA,Colv=NA) 69 | 70 | #this one too 71 | #timestamp() 72 | #unnecessary info, uncomment if you like 73 | #print( paste("Days:",length(days),"x","Thresh:",length(thresh),"matrix of values")) 74 | -------------------------------------------------------------------------------- /heatmap_qrv_0.0.3.R: -------------------------------------------------------------------------------- 1 | ### heatmap_qrv v0.0.3 by babbage9010 and friends 2 | ### released under MIT License 3 | # adds nATR to the vol measures you can generate heatmaps for 4 | # takes a long time: reduce the resolution to generate test maps more quickly 5 | 6 | # Step 1: Load necessary libraries and data 7 | library(quantmod) 8 | library(PerformanceAnalytics) 9 | 10 | date_start <- as.Date("2006-07-01") 11 | date_end <- as.Date("2019-12-31") 12 | symbol_signal1 <- "SPY" # S&P 500 symbol (use SPY or ^GSPC) 13 | symbol_trade1 <- "SPY" # ETF to trade 14 | 15 | data_spy <- getSymbols(symbol_signal1, src = "yahoo", from = date_start, to = date_end, auto.assign = FALSE) 16 | prices_signal1 <- Cl(data_spy) #SPY ETF, Close(Cl) for the signal (realized vol) 17 | prices_trade1 <- Op(data_spy) #SPY data, Open(Op) for our trading 18 | 19 | 20 | #make a heatmap, days (lookback) vs thresh (volatility threshold) 21 | # start with a small vector of days, thresh to test it out 22 | # the biggest ones here (29x31) took 7 minutes to run on a M1 MacBook Air 23 | days <- c(3,5,10) 24 | #days <- c(3,5,10,20,40,100) 25 | #days <- c(4,6,8,10,12,14,16,18,20,24,28,32,36,40) 26 | #days <- c(2,3,4,5,6,7,8,9,10,12,14,16,18,20,22,24,26,28,30,34,38,42,46,50,60,70,80,90,100) 27 | thresh <- c(0.05,0.10,0.20,0.50,0.80) 28 | #thresh <- c(0.04,0.05,0.06,0.07,0.08,0.09,0.10,0.11,0.12,0.13,0.14,0.15,0.16,0.17,0.18,0.19,0.20,0.21,0.22,0.23,0.24,0.25,0.30,0.35,0.40,0.45,0.50,0.55,0.60,0.65,0.70) 29 | days <- seq(2,100,by=1) 30 | #use this thresh for nATR 31 | thresh <- seq(0.000,0.05,by=0.0005) 32 | #use this thresh for other vol measures 33 | #thresh <- seq(0.01,1.08,by=0.005) 34 | 35 | #uncomment the next line if you want timestamps to see how long it takes. 36 | timestamp() 37 | ar_days <- list() 38 | sh_days <- list() 39 | ex_days <- list() 40 | md_days <- list() 41 | for(d in 1:length(days)){ 42 | ar_thresh <- list() 43 | sh_thresh <- list() 44 | ex_thresh <- list() 45 | md_thresh <- list() 46 | for(t in 1:length(thresh)){ 47 | r <- ROC(prices_signal1, n = 1, type = "discrete") 48 | #v <- runSD(r, n = days[d]) * sqrt(252) 49 | #v <- volatility(data_spy, n=days[d], calc="close") 50 | #v <- volatility(data_spy, n=days[d], calc="gk.yz") 51 | #v <- volatility(data_spy, n=days[d], calc="parkinson") 52 | #v <- volatility(data_spy, n=days[d], calc="rogers.satchell") 53 | v <- ATR(data_spy, n=days[d], maType="ZLEMA")[ , "atr"] / prices_signal1 54 | s <- ifelse(v < thresh[t], 1, 0) 55 | s <- na.omit(s) 56 | sr <- r * stats::lag(s, 2) 57 | ar <- Return.annualized(sr) 58 | ar_thresh[t] <- ar 59 | sh <- SharpeRatio.annualized(sr) 60 | sh_thresh[t] <- sh 61 | ex <- sum(sr != 0, na.rm=TRUE) / length(sr) 62 | #^^^ why not just sr!=0? see response by Jealie to first answer here: 63 | #https://stackoverflow.com/questions/22286957/count-the-number-of-non-zero-elements-of-each-column 64 | ex_thresh[t] <- ex 65 | md <- maxDrawdown(sr) 66 | md_thresh[t] <- md 67 | } 68 | ar_days[[d]] <- ar_thresh 69 | sh_days[[d]] <- sh_thresh 70 | ex_days[[d]] <- ex_thresh 71 | md_days[[d]] <- md_thresh 72 | timestamp() 73 | print( paste("Days to go:",length(days)-d) ) 74 | } 75 | 76 | #generate the heatmaps from the matrices 77 | arm_days <- do.call(rbind,ar_days) 78 | arm <- matrix(as.numeric(arm_days),ncol=ncol(arm_days)) 79 | rownames(arm) <- days 80 | colnames(arm) <- thresh 81 | 82 | shm_days <- do.call(rbind,sh_days) 83 | shm <- matrix(as.numeric(shm_days),ncol=ncol(shm_days)) 84 | rownames(shm) <- days 85 | colnames(shm) <- thresh 86 | 87 | exm_days <- do.call(rbind,ex_days) 88 | exm <- matrix(as.numeric(exm_days),ncol=ncol(exm_days)) 89 | rownames(exm) <- days 90 | colnames(exm) <- thresh 91 | 92 | mdm_days <- do.call(rbind,md_days) 93 | mdm <- matrix(as.numeric(mdm_days),ncol=ncol(mdm_days)) 94 | rownames(mdm) <- days 95 | colnames(mdm) <- thresh 96 | 97 | heatmap(exm,Rowv=NA,Colv=NA) 98 | heatmap(arm,Rowv=NA,Colv=NA) 99 | heatmap(shm,Rowv=NA,Colv=NA) 100 | heatmap(mdm,Rowv=NA,Colv=NA) 101 | 102 | #this one too 103 | timestamp() 104 | -------------------------------------------------------------------------------- /lagger_0.0.1.R: -------------------------------------------------------------------------------- 1 | ### lagger v0.0.1 by babbage9010 and friends 2 | ### released under MIT License 3 | # 4 | # Simple backtesting demo to understand how lag() works 5 | # 6 | 7 | # Load the necessary libraries 8 | library(quantmod) 9 | library(PerformanceAnalytics) 10 | 11 | # Generate date sequence from Jan 1, 2023 to Feb 28, 2023 12 | dates <- seq(from = as.Date("2023-01-01"), to = as.Date("2023-02-13"), by = "days") 13 | 14 | # Create a matrix with labeled columns 15 | data_matrix <- matrix( 16 | c(1.1, 1.2, 1.0, 1.1, 1.1, 0), 17 | nrow = length(dates), 18 | ncol = 6, 19 | byrow = TRUE, 20 | dimnames = list(dates, c("Open", "High", "Low", "Close", "Adjusted Close", "Volume")) 21 | ) 22 | 23 | # Create the XTS object 24 | my_xts <- xts(data_matrix, order.by = dates) 25 | 26 | # Apply the specified pattern to the relevant columns 27 | for (i in seq_along(my_xts[,1])) { 28 | if (i %% 10 == 0 && i > 3) { 29 | # Every 10th day: Increase Open, High, Low, Close, Adjusted Close by 0.02 30 | my_xts[i, c("Open", "High", "Low", "Close", "Adjusted Close")] <- my_xts[i, c("Open", "High", "Low", "Close", "Adjusted Close")] + 0.02 31 | } else if ((i - 1) %% 10 == 0 && i > 3) { 32 | # The day after the 10th day: Increase Open, High, Low, Close, Adjusted Close by 0.01 33 | my_xts[i, c("Open", "High", "Low", "Close", "Adjusted Close")] <- my_xts[i, c("Open", "High", "Low", "Close", "Adjusted Close")] + 0.03 34 | } 35 | } 36 | 37 | 38 | #strategy 39 | prices_close <- Ad(my_xts) 40 | prices_open <- Op(my_xts) 41 | roc_close <- ROC(prices_close, n = 1, type = "discrete") 42 | roc_open <- ROC(prices_open, n = 1, type = "discrete") 43 | 44 | returns_benchmark <- roc_close 45 | returns_benchmark <- na.omit(returns_benchmark) 46 | 47 | comparison1 <- cbind(returns_benchmark) 48 | colnames(comparison1) <- c("Benchmark: Up up DOWN") 49 | charts.PerformanceSummary(comparison1, main = "Testing Lag Strategies") 50 | 51 | #strategies testing lag 52 | roc_thresh <- 0.015 53 | 54 | roc_trade <- roc_open #substitute roc_close to look at the close! 55 | signal <- ifelse(roc_close >= roc_thresh, 1, 0) 56 | 57 | #lag(0) 58 | returns_strategy0 <- roc_trade * stats::lag(signal, 0) 59 | returns_strategy0 <- na.omit(returns_strategy0) 60 | 61 | #lag(1) 62 | returns_strategy1 <- roc_trade * stats::lag(signal, 1) 63 | returns_strategy1 <- na.omit(returns_strategy1) 64 | 65 | #lag(2) 66 | returns_strategy2 <- roc_trade * stats::lag(signal, 2) 67 | returns_strategy2 <- na.omit(returns_strategy2) 68 | 69 | comparison2 <- cbind(returns_benchmark, returns_strategy0, returns_strategy1, returns_strategy2) 70 | colnames(comparison2) <- c("Benchmark: Up up DOWN", "Lag(0) Time Travel", "Lag(1) Magical Thinking", "Lag(2) Next Day") 71 | stats_rv <- rbind(table.AnnualizedReturns(comparison2), maxDrawdown(comparison2)) 72 | charts.PerformanceSummary(comparison2, main = "Testing Lag Strategies") 73 | 74 | 75 | 76 | -------------------------------------------------------------------------------- /original_code_from_learning_machines.R: -------------------------------------------------------------------------------- 1 | ### This code is from a freely accessible blog post on April 10 2023: 2 | ### https://blog.ephorie.de/building-and-backtesting-a-volatility-based-trading-strategy-with-chatgpt 3 | ### License for original code not listed, code generated by ChatGPT; treating license as MIT. 4 | ### 5 | 6 | # Step 1: Load necessary libraries and data 7 | library(quantmod) 8 | library(PerformanceAnalytics) 9 | 10 | start_date <- as.Date("2000-01-01") 11 | end_date <- as.Date("2021-12-31") 12 | symbol <- "^GSPC" # S&P 500 symbol 13 | 14 | getSymbols(symbol, src = "yahoo", from = start_date, to = end_date, auto.assign = FALSE) -> sp500_data 15 | price_data <- Ad(sp500_data) 16 | 17 | # Step 2: Calculate volatility as a risk indicator 18 | lookback_period <- 20 19 | volatility <- runSD(ROC(price_data, n = 1, type = "discrete"), n = lookback_period) * sqrt(252) 20 | 21 | # Step 3: Develop the trading strategy 22 | threshold <- 0.15 23 | signal <- ifelse(volatility < threshold, 1, 0) 24 | signal <- lag(signal, 1) # To avoid look-ahead bias 25 | signal[is.na(signal)] <- 0 26 | 27 | # Step 4: Backtest the strategy 28 | returns <- ROC(price_data, n = 1, type = "discrete") * signal 29 | strategy_returns <- na.omit(returns) 30 | 31 | # Calculate benchmark returns 32 | benchmark_returns <- ROC(price_data, n = 1, type = "discrete") 33 | benchmark_returns <- na.omit(benchmark_returns) 34 | 35 | # Step 5: Evaluate performance and risk metrics 36 | comparison <- cbind(strategy_returns, benchmark_returns) 37 | colnames(comparison) <- c("Strategy", "Benchmark") 38 | 39 | charts.PerformanceSummary(comparison, main = "Long/Flat Strategy vs S&P 500 Benchmark") 40 | -------------------------------------------------------------------------------- /qrvx_2.0.0.R: -------------------------------------------------------------------------------- 1 | ### qrvx v2.0.0 by babbage9010 and friends 2 | ### released under MIT License 3 | # qrvx_2.0.0.R based on quant_rv_2.0.0.R 4 | # 1: aims for decent performance strategy with low correlation with SPY 5 | # 2: combo w/SPY in 60/40-style: SPY-like returns, better risk-adjusted stats 6 | # 3: published with data through Feb 26, 2024 7 | 8 | ### Step 1: Load necessary libraries and data 9 | library(quantmod) 10 | library(PerformanceAnalytics) 11 | 12 | date_start <- as.Date("1992-03-01") 13 | date_end <- as.Date("2033-12-31") 14 | symbol_benchmark1 <- "SPY" # benchmark for comparison 15 | symbol_signal1 <- "SPY" # S&P 500 symbol (use SPY or ^GSPC) 16 | symbol_trade1 <- "SPY" # ETF to trade 17 | symbol_trade2 <- "SPY" # -1x ETF to trade. in real life use SH 18 | 19 | ### reloadall == TRUE is to rebuild the VOL and SIG matrices 20 | ### when changing lookback & threshold vectors 21 | ### FWIW, I just leave it FALSE and empty my environment if I want 22 | ### to rebuild the matrices 23 | reloadall <- FALSE | !exists("data_benchmark1") 24 | if(reloadall){ 25 | data_benchmark1 <- getSymbols(symbol_benchmark1, src = "yahoo", from = date_start, to = date_end, auto.assign = FALSE) 26 | data_signal1 <- getSymbols(symbol_signal1, src = "yahoo", from = date_start, to = date_end, auto.assign = FALSE) 27 | data_trade1 <- getSymbols(symbol_trade1, src = "yahoo", from = date_start, to = date_end, auto.assign = FALSE) 28 | data_trade2 <- getSymbols(symbol_trade2, src = "yahoo", from = date_start, to = date_end, auto.assign = FALSE) 29 | prices_benchmark1 <- Ad(data_benchmark1) #Adjusted(Ad) for the #1 benchmark 30 | prices_benchmark2 <- Op(data_benchmark1) #Open(Op) for the #2 benchmark 31 | prices_signal1 <- Ad(data_signal1) #Adjusted(Ad) for the signal (realized vol) 32 | prices_trade1 <- Op(data_trade1) #Open(Op) for our trading 33 | prices_trade2 <- Op(data_trade2) #Open(Op) for our trading 34 | prices_signal1Cl <- Cl(data_signal1) #Close(Cl) for the ATR normalization 35 | } 36 | 37 | ### Step 2: Calculate ROC series 38 | roc_signal1 <- ROC(prices_signal1, n = 1, type = "discrete") 39 | roc_benchmark1 <- ROC(prices_benchmark1, n = 1, type = "discrete") 40 | roc_benchmark2 <- ROC(prices_benchmark2, n = 1, type = "discrete") 41 | roc_trade1 <- ROC(prices_trade1, n = 1, type = "discrete") 42 | 43 | #HACK! SH not available in olden times, so use -1x SPY 44 | roc_trade2 <- -1 * ROC(prices_trade1, n = 1, type = "discrete") 45 | 46 | 47 | # Step 3: Function for building the volatility signals 48 | # we're using five measures of volatility with four lookback periods 49 | 50 | ### first, calculate the volatility parameter space as a big XTS 51 | calc_vols <- function(volmeas, lookbacks){ 52 | ### calculates volatilities for all the vol measures + lookbacks 53 | numvolmeas <- length(volmeas) #number of vol measures (5) 54 | numlbs <- length(lookbacks) 55 | xts_vols <- as.xts(data_signal1[,"SPY.Adjusted"]) 56 | numvols <- numvolmeas*numlbs 57 | volnames <- c(1:numvols) 58 | nas <- xts(matrix(NA,nrow(xts_vols),length(volnames)), 59 | index(xts_vols), dimnames=list(NULL,volnames)) 60 | xts_vols <- merge(xts_vols, nas) 61 | print(paste("vrows",nrow(xts_vols),"vcols",ncol(xts_vols))) 62 | vidx <- 0 63 | for(vv in volmeas){ 64 | #print(paste("vv",vv,"vidx",vidx)) 65 | if(vv != "natr"){ 66 | for(nn in 1:numlbs){ 67 | #print(paste("nn",nn,"v+n",vidx+nn,"lb",lookbacks[nn])) 68 | xts_vols[,1+vidx+nn] <- volatility(data_signal1, n = lookbacks[nn], calc = vv) 69 | } 70 | } else { 71 | for(nn in 1:numlbs){ 72 | #print(paste("nn",nn,"v+n",vidx+nn,"lb",lookbacks[nn])) 73 | xts_vols[,1+vidx+nn] <- ATR(data_signal1, n=lookbacks[nn], maType="ZLEMA")[ , "atr"] / prices_signal1Cl 74 | } 75 | } 76 | vidx <- vidx + numlbs 77 | } 78 | return(xts_vols) 79 | } 80 | 81 | ### second, calc the vol signals with a sequence of thresholds, store as XTS 82 | calc_sigs <- function(volmeas, lookbacks, thevols, vthresh, lthresh){ 83 | ### calculates all the signals: loop volmeasures, then lookbacks, then thresholds 84 | xts_sigs <- as.xts(data_signal1[,"SPY.Adjusted"]) 85 | numlbs <- length(lookbacks) 86 | numthresholds <- length(vthresh) 87 | numvols <- ncol(thevols) - 1 88 | numsigs <- numvols * numthresholds 89 | print(paste("nl",numlbs,"nt",numthresholds,"nv",numvols,"ns",numsigs)) 90 | siggnames <- c(1:numsigs) 91 | nas <- xts(matrix(NA,nrow(xts_sigs),length(siggnames)), 92 | index(xts_sigs), dimnames=list(NULL,siggnames)) 93 | xts_sigs <- merge(xts_sigs, nas) 94 | print(paste("vrows",nrow(xts_sigs),"vcols",ncol(xts_sigs))) 95 | 96 | ### make a matrix of sig references (which vol,lb,th for each sig) 97 | vidx <- 0 98 | sidx <- 0 99 | for(vv in volmeas){ 100 | print(paste("vv",vv,"vidx",vidx)) 101 | if(vv != "natr"){ 102 | for(nn in 1:numlbs){ 103 | #print(paste("nn",nn)) 104 | for(tt in 1:numthresholds){ 105 | #calc sig here 106 | #print(paste("tt",tt,"s+n+t",sidx+nn+tt,"whichvol",1+vidx+nn)) 107 | xts_sigs[,sidx+nn+tt] <- ifelse( thevols[,1+vidx+nn] < vthresh[tt], 1, 0) 108 | } 109 | sidx <- sidx + numthresholds - 1 110 | } 111 | sidx <- sidx + numlbs #4? is it numthresholds-1? or? 112 | } else { # only natr 113 | for(nn in 1:numlbs){ 114 | #print(paste("nn",nn)) 115 | for(tt in 1:numthresholds){ 116 | #calc sig here 117 | #print(paste("tt",tt,"s+n+t",sidx+nn+tt,"whichvol",1+vidx+nn)) 118 | xts_sigs[,sidx+nn+tt] <- ifelse( thevols[,1+vidx+nn] < lthresh[tt], 1, 0) 119 | } 120 | sidx <- sidx + numthresholds - 1 121 | } 122 | } 123 | vidx <- vidx + numlbs 124 | } 125 | return(xts_sigs) 126 | } 127 | 128 | ### third, calculate the signal totals for each trading day 129 | calc_sigtotal <- function(thesigs,sbst=c(0)){ 130 | ### calculate the allvol or selvol, total of positive signals 131 | ### thesigs includes a reference column of SPY values 132 | ### get rid of it for this 133 | ### sbst is a list, an optional subset of column numbers to sum sig totals across 134 | ### default is to use ALL signals available (allvol) 135 | numsigcols <- ncol(thesigs) 136 | allthesigs <- thesigs[,2:numsigcols] 137 | if(sbst[1] == 0){ 138 | therealsigs <- allthesigs 139 | } else { 140 | therealsigs <- allthesigs[,sbst] 141 | } 142 | #siggs is our signal totals to be returned as a 1 col xts object 143 | siggs <- as.xts(data_signal1[,"SPY.Adjusted"]) #match it to SPY for index 144 | sums <- xts(rowSums(therealsigs, na.rm=TRUE), index(siggs)) 145 | siggs[,1] <- sums #replace prices in siggs with signal sums 146 | return( siggs ) 147 | } 148 | 149 | ### finally, set up the vthresh and lthresh sequences 150 | ### then call the function(s) above 151 | 152 | ### vthresh and lthresh are the threshold values for signal generation 153 | ### length(vthresh) must == length(lthresh) to work right 154 | ### vthresh = thresholds for the four volatility measures 155 | #vthresh3 <- seq(0.13, 0.22, by=0.01) #lower res sampling 156 | #vthresh3 <- seq(0.13, 0.22, by=0.005) #medium res sampling 157 | vthresh3 <- seq(0.13, 0.22, by=0.0025) #high res sampling 158 | 159 | ### lthresh = thresholds for the NATR vol-like measure 160 | #lthresh3 <- seq(0.006, 0.015, by=0.00025) #lower res sampling 161 | #lthresh3 <- seq(0.006, 0.015, by=0.00025) #medium res sampling 162 | lthresh3 <- seq(0.006, 0.015, by=0.00025) #high res sampling 163 | 164 | 165 | ### lookback period in days 166 | lookbacks <- seq(4, 25, by=1) 167 | 168 | ### parameter names for the volatility measures in calc_vols 169 | volmeasures <- c("close","rogers.satchell","parkinson","gk.yz","natr") #vol measures 170 | 171 | ### calculate volatility measures and signal candidates 172 | if(reloadall){ 173 | x_allvols <- calc_vols(volmeasures, lookbacks) 174 | x_allsigs <- calc_sigs(volmeasures, lookbacks, x_allvols, vthresh3, lthresh3) 175 | } 176 | 177 | ### add up the signals 178 | ### allvol is used in the strategy as the signal measure of low vol 179 | allvol <- calc_sigtotal(x_allsigs) 180 | 181 | ### sdp is the date range to use for stats and plotting 182 | sdp <- "2006-07-01/" # sdp = start date for plotting 183 | 184 | ### Calculate Benchmark 1&2 returns 185 | returns_benchmark1 <- stats::lag(roc_benchmark1, 0) 186 | returns_benchmark1 <- na.omit(returns_benchmark1) 187 | label_benchmark1 <- "Benchmark SPY total return" 188 | returns_benchmark2 <- stats::lag(roc_benchmark2, 0) 189 | returns_benchmark2 <- na.omit(returns_benchmark2) 190 | label_benchmark2 <- "Benchmark 2: SPY Open-Open, no divvies" 191 | 192 | 193 | 194 | ### STRATEGIES ### 195 | 196 | ### Strategy 1 High volatility, go short 197 | label_1 <- "S_1: High vol; SHORT" 198 | thr_hi_vol <- 100 199 | signal_1 <- ifelse(allvol < thr_hi_vol, 1, 0) 200 | signal_1[is.na(signal_1)] <- 0 201 | #use roc_trade2 (-1x SPY) not roc_trade1 202 | returns_1 <- roc_trade2 * stats::lag(signal_1, 2) 203 | returns_1 <- na.omit(returns_1) 204 | 205 | #plot and stats 206 | comparison_1 <- cbind(returns_1, returns_benchmark1) 207 | colnames(comparison_1) <- c(label_1, label_benchmark1) 208 | stats_rv_1 <- rbind(table.AnnualizedReturns(comparison_1[sdp]), maxDrawdown(comparison_1[sdp])) 209 | charts.PerformanceSummary(comparison_1[sdp], main = "qrvx Short component vs SPY total return") 210 | 211 | ### Strategy 2 Low volatility, go long 212 | label_2 <- "S_2: Low vol; LONG" 213 | thr_lo_vol <- 3600 214 | signal_2 <- ifelse(allvol >= thr_lo_vol, 1, 0) 215 | signal_2[is.na(signal_2)] <- 0 216 | returns_2 <- roc_trade1 * stats::lag(signal_2, 2) 217 | returns_2 <- na.omit(returns_2) 218 | 219 | #plot and stats 220 | comparison_2 <- cbind(returns_2, returns_benchmark1, returns_1) 221 | colnames(comparison_2) <- c(label_2, label_benchmark1, label_1) 222 | stats_rv_2 <- rbind(table.AnnualizedReturns(comparison_2[sdp]), maxDrawdown(comparison_2[sdp])) 223 | charts.PerformanceSummary(comparison_2[sdp], main = "qrvx_2+1 Long, Short components vs SPY") 224 | 225 | ### Strategy 3: qrvx_2+1 226 | label_3 <- "S_3: qrvx_2+1 L/S" 227 | returns_3 <- returns_1 + returns_2 #corr = -0.110 228 | returns_3 <- na.omit(returns_3) 229 | 230 | ### Strategy 4: combo SPY/qrvx 231 | label_4 <- "S_4: 35/65 combo SPY/qrvx_1+2" 232 | fraction <- 0.35 ### fraction allocated to SPY 233 | returns_4 <- fraction * returns_benchmark1 + (1 - fraction) * returns_3 234 | returns_4 <- na.omit(returns_4) 235 | 236 | #plot and stats 237 | comparison_3 <- cbind(returns_3, returns_benchmark1, returns_4, returns_1, returns_2) 238 | colnames(comparison_3) <- c(label_3, label_benchmark1, label_4, label_1, label_2) 239 | stats_rv_3 <- rbind(table.AnnualizedReturns(comparison_3[sdp]), maxDrawdown(comparison_3[sdp])) 240 | charts.PerformanceSummary(comparison_3[sdp], main = "qrvx_2+1 and combo vs SPY") 241 | 242 | ### Strategy 5 Med-High volatility (100 <= allvol < 700) 243 | label_5 <- "S_5: Med-High vol; LONG" 244 | thr_med_vol <- 700 245 | signal_5 <- ifelse( allvol >= thr_hi_vol & allvol < thr_med_vol, 1, 0) 246 | signal_5[is.na(signal_5)] <- 0 247 | returns_5 <- roc_trade1 * stats::lag(signal_5, 2) 248 | returns_5 <- na.omit(returns_5) 249 | 250 | ### Strategy 6 qrvx_51 L/S 251 | label_6 <- "S_6: qrvx_5+1 L/S" 252 | returns_6 <- returns_5 + returns_1 # corr = -0.117 253 | returns_6 <- na.omit(returns_6) 254 | 255 | label_7 <- "S_7: 35/65 combo SPY/qrvx_5+1" 256 | fraction <- 0.35 257 | returns_7 <- fraction * returns_benchmark1 + (1 - fraction) * returns_6 258 | returns_7 <- na.omit(returns_7) 259 | 260 | #plot and stats 261 | comparison_4 <- cbind(returns_6, returns_benchmark1, returns_7, returns_1, returns_5) 262 | colnames(comparison_4) <- c(label_6, label_benchmark1, label_7, label_1, label_5) 263 | stats_rv_4 <- rbind(table.AnnualizedReturns(comparison_4[sdp]), maxDrawdown(comparison_4[sdp])) 264 | charts.PerformanceSummary(comparison_4[sdp], main = "qrvx_5+1 and combo vs SPY total return") 265 | 266 | 267 | ### Strategy 8 qrvx_251 L/S 268 | label_8 <- "S_8: qrvx_2+5+1 L/L/S" 269 | returns_8 <- returns_2 + returns_5 + returns_1 # corr = -0.030 at pub 270 | returns_8 <- na.omit(returns_8) 271 | 272 | label_9 <- "S_9: 35/65 combo SPY/qrvx_2+5+1" 273 | fraction <- 0.35 274 | returns_9 <- fraction * returns_benchmark1 + (1 - fraction) * returns_8 275 | returns_9 <- na.omit(returns_9) 276 | 277 | #plot and stats 278 | comparison_5 <- cbind(returns_8, returns_benchmark1, returns_9, returns_1, returns_2, returns_5) 279 | colnames(comparison_5) <- c(label_8, label_benchmark1, label_9, label_1, label_2, label_5) 280 | stats_rv_5 <- rbind(table.AnnualizedReturns(comparison_5[sdp]), maxDrawdown(comparison_5[sdp])) 281 | charts.PerformanceSummary(comparison_5[sdp], main = "qrvx_2+5+1 and combo vs SPY total return") 282 | 283 | 284 | 285 | 286 | 287 | 288 | ### add an "exposure" metric (informative, not strictly correct) 289 | exposure <- function(vec){ sum(vec != 0) / length(vec) * 100 } 290 | ### and a couple more metrics 291 | winPercent <- function(vec){ 292 | s <- sum(vec > 0) 293 | s / (s + sum(vec < 0)) * 100 294 | } 295 | avgWin <- function(vec){ 296 | aw <- mean( na.omit(ifelse(vec>0,vec,NA))) 297 | return( aw * 100 ) 298 | } 299 | avgLoss <- function(vec){ 300 | al <- mean( na.omit(ifelse(vec<0,vec,NA))) 301 | return( al * 100 ) 302 | } 303 | extraStats <- function(vec){ 304 | ex <- exposure(vec) 305 | aw <- avgWin(vec) 306 | al <- avgLoss(vec) 307 | wp <- winPercent(vec) 308 | wl <- -(aw/al) 309 | return( paste("exp_%:", round(ex,2), " win_%:", round(wp, 2), " avgWin:", round(aw,3), " avgLoss:", round(al,3), "w/l:", round(wl, 3)) ) 310 | } 311 | 312 | print( paste("B1 -", extraStats(returns_benchmark1[sdp]) )) 313 | print( paste("S_1 -", extraStats(returns_1[sdp]) )) 314 | print( paste("S_2 -", extraStats(returns_2[sdp]) )) 315 | print( paste("S_3 -", extraStats(returns_3[sdp]) )) 316 | print( paste("S_4 -", extraStats(returns_4[sdp]) )) 317 | print( paste("S_5 -", extraStats(returns_5[sdp]) )) 318 | print( paste("S_6 -", extraStats(returns_6[sdp]) )) 319 | print( paste("S_7 -", extraStats(returns_7[sdp]) )) 320 | print( paste("S_8 -", extraStats(returns_8[sdp]) )) 321 | print( paste("S_9 -", extraStats(returns_9[sdp]) )) 322 | 323 | -------------------------------------------------------------------------------- /quant_rv_1.0.0.R: -------------------------------------------------------------------------------- 1 | ### quant_rv v1.0.0 by babbage9010 and friends 2 | ### released under MIT License 3 | 4 | # Step 1: Load necessary libraries and data 5 | library(quantmod) 6 | library(PerformanceAnalytics) 7 | 8 | start_date <- as.Date("2000-01-01") 9 | end_date <- as.Date("2021-12-31") 10 | symbol <- "SPY" # SPY ETF symbol 11 | 12 | #bab: changed the name to spy_data 13 | getSymbols(symbol, src = "yahoo", from = start_date, to = end_date, auto.assign = FALSE) -> spy_data 14 | benchmark_data <- Cl(spy_data) #bab: use SPY data, Close(Cl) for the benchmark 15 | price_data <- Op(spy_data) #bab: use new SPY data, Open for our trading 16 | 17 | # Step 2: Calculate volatility as a risk indicator 18 | lookback_period <- 20 19 | volatility <- runSD(ROC(price_data, n = 1, type = "discrete"), n = lookback_period) * sqrt(252) 20 | 21 | # Step 3: Develop the trading strategy 22 | threshold <- 0.15 23 | signal <- ifelse(volatility < threshold, 1, 0) 24 | #bab: comment out this lag line, remove it later 25 | #signal <- lag(signal, 1) # To avoid look-ahead bias 26 | signal[is.na(signal)] <- 0 27 | 28 | # Step 4: Backtest the strategy 29 | #bab: change the lag! 30 | returns <- ROC(price_data, n = 1, type = "discrete") * Lag(signal, 2) 31 | strategy_returns <- na.omit(returns) 32 | 33 | # Calculate benchmark returns 34 | benchmark_returns <- ROC(benchmark_data, n = 1, type = "discrete") 35 | #bab: add a new line to lag the benchmark too! original code missed this 36 | benchmark_returns <- Lag(benchmark_returns, 2) 37 | benchmark_returns <- na.omit(benchmark_returns) 38 | 39 | # Step 5: Evaluate performance and risk metrics 40 | #switch the order to switch colors 41 | comparison <- cbind(strategy_returns, benchmark_returns) 42 | colnames(comparison) <- c("Strategy", "Benchmark") 43 | 44 | charts.PerformanceSummary(comparison, main = "Long/Flat Strategy vs S&P 500 Benchmark") 45 | -------------------------------------------------------------------------------- /quant_rv_1.0.1.R: -------------------------------------------------------------------------------- 1 | ### quant_rv v1.0.1 by babbage9010 and friends 2 | # cleanup and stats release 3 | ### released under MIT License 4 | 5 | # Step 1: Load necessary libraries and data 6 | library(quantmod) 7 | library(PerformanceAnalytics) 8 | 9 | #bab: sensible var names, type_description 10 | date_start <- as.Date("2000-01-01") 11 | date_end <- as.Date("2021-12-31") 12 | symbol <- "SPY" # SPY ETF symbol 13 | 14 | #bab: reorient this so the variable name is in front 15 | data_spy <- getSymbols(symbol, src = "yahoo", from = date_start, to = date_end, auto.assign = FALSE) 16 | #bab: rename these, separate trade from signal from benchmark 17 | prices_benchmark <- Ad(data_spy) #SPY ETF, Adjusted(Ad) for the benchmark 18 | prices_signal <- Cl(data_spy) #SPY ETF, Close(Cl) for the signal (realized vol) 19 | prices_trade <- Op(data_spy) #SPY data, Open(Op) for our trading 20 | 21 | # Step 2: Calculate volatility as a risk indicator 22 | lookback_period <- 20 23 | #bab: rename, separate ROC components 24 | roc_signal <- ROC(prices_signal, n = 1, type = "discrete") 25 | roc_benchmark <- ROC(prices_benchmark, n = 1, type = "discrete") 26 | roc_trade <- ROC(prices_trade, n = 1, type = "discrete") 27 | #bab: vol formula now easier to read - SD of the daily ROC, annualized 28 | volatility <- runSD(roc_signal, n = lookback_period) * sqrt(252) 29 | 30 | # Step 3: Develop the trading strategy 31 | threshold <- 0.15 32 | signal <- ifelse(volatility < threshold, 1, 0) 33 | signal[is.na(signal)] <- 0 34 | 35 | # Step 4: Backtest the strategy 36 | returns_strategy <- roc_trade * Lag(signal, 2) 37 | returns_strategy <- na.omit(returns_strategy) 38 | 39 | # Calculate benchmark returns 40 | returns_benchmark <- roc_benchmark 41 | returns_benchmark <- Lag(returns_benchmark, 2) 42 | returns_benchmark <- na.omit(returns_benchmark) 43 | 44 | # Step 5: Evaluate performance and risk metrics 45 | #switch the order to switch colors 46 | comparison <- cbind(returns_strategy, returns_benchmark) 47 | colnames(comparison) <- c("Strategy", "Benchmark") 48 | #bab: new line for basic statistics in a table 49 | stats_rv <- rbind(table.AnnualizedReturns(comparison), maxDrawdown(comparison), AverageRecovery(comparison)) 50 | 51 | charts.PerformanceSummary(comparison, main = "Long/Flat Strategy vs S&P 500 Benchmark") 52 | -------------------------------------------------------------------------------- /quant_rv_1.1.0.R: -------------------------------------------------------------------------------- 1 | ### quant_rv v1.1.0 by babbage9010 and friends 2 | # explore use of QQQ and of leverage 3 | ### released under MIT License 4 | 5 | # Step 1: Load necessary libraries and data 6 | library(quantmod) 7 | library(PerformanceAnalytics) 8 | 9 | date_start <- as.Date("2006-07-01") 10 | date_end <- as.Date("2019-12-31") 11 | symbol_bench1 <- "SPY" # benchmark for comparison 12 | symbol_signal1 <- "SPY" # S&P 500 symbol (use SPY or ^GSPC) 13 | symbol_trade1 <- "SPY" # ETF to trade 14 | symbol_trade2 <- "QQQ" # ETF to trade 15 | 16 | data_spy <- getSymbols(symbol_bench1, src = "yahoo", from = date_start, to = date_end, auto.assign = FALSE) 17 | data_qqq <- getSymbols(symbol_trade2, src = "yahoo", from = date_start, to = date_end, auto.assign = FALSE) 18 | prices_benchmark <- Ad(data_spy) #SPY ETF, Adjusted(Ad) for the benchmark 19 | prices_signal <- Cl(data_spy) #SPY ETF, Close(Cl) for the signal (realized vol) 20 | prices_trade1 <- Op(data_spy) #SPY data, Open(Op) for our trading 21 | prices_trade2 <- Op(data_qqq) #QQQ data, Open(Op) for our trading 22 | 23 | # Step 2: Calculate volatility as a risk indicator 24 | lookback_period <- 20 25 | roc_signal <- ROC(prices_signal, n = 1, type = "discrete") 26 | roc_benchmark <- ROC(prices_benchmark, n = 1, type = "discrete") 27 | roc_trade1 <- ROC(prices_trade1, n = 1, type = "discrete") 28 | roc_trade2 <- ROC(prices_trade2, n = 1, type = "discrete") 29 | volatility <- runSD(roc_signal, n = lookback_period) * sqrt(252) 30 | 31 | # Step 3: Develop the trading strategy 32 | threshold <- 0.15 33 | signal <- ifelse(volatility < threshold, 1, 0) 34 | signal[is.na(signal)] <- 0 35 | 36 | # Step 4: Backtest the strategies 37 | leverage_strategy1 <- 1.0 #use this to simulate a leveraged ETF component 38 | leverage_strategy2 <- 1.0 39 | returns_strategy1 <- leverage_strategy1 * roc_trade1 * Lag(signal, 2) 40 | returns_strategy1 <- na.omit(returns_strategy1) 41 | returns_strategy2 <- leverage_strategy2 * roc_trade2 * Lag(signal, 2) 42 | returns_strategy2 <- na.omit(returns_strategy2) 43 | 44 | # Calculate benchmark returns 45 | returns_benchmark <- roc_benchmark 46 | returns_benchmark <- Lag(returns_benchmark, 2) 47 | returns_benchmark <- na.omit(returns_benchmark) 48 | 49 | # Step 5: Evaluate performance and risk metrics 50 | #switch the order to switch colors 51 | comparison <- cbind(returns_strategy1, returns_benchmark, returns_strategy2) 52 | colnames(comparison) <- c("Strategy1", "Benchmark", "Strategy2") 53 | stats_rv <- rbind(table.AnnualizedReturns(comparison), maxDrawdown(comparison), AverageRecovery(comparison)) 54 | 55 | charts.PerformanceSummary(comparison, main = "Long/Flat Strategy vs S&P 500 Benchmark") 56 | -------------------------------------------------------------------------------- /quant_rv_1.2.0.R: -------------------------------------------------------------------------------- 1 | ### quant_rv v1.2.0 by babbage9010 and friends 2 | # new setup to compare two strategies and parameters 3 | ### released under MIT License 4 | 5 | # Step 1: Load necessary libraries and data 6 | library(quantmod) 7 | library(PerformanceAnalytics) 8 | 9 | date_start <- as.Date("2006-07-01") 10 | date_end <- as.Date("2019-12-31") 11 | symbol_bench1 <- "SPY" # benchmark for comparison 12 | symbol_signal1 <- "SPY" # S&P 500 symbol (use SPY or ^GSPC) 13 | symbol_trade1 <- "SPY" # ETF to trade 14 | 15 | data_spy <- getSymbols(symbol_bench1, src = "yahoo", from = date_start, to = date_end, auto.assign = FALSE) 16 | prices_benchmark <- Ad(data_spy) #SPY ETF, Adjusted(Ad) for the benchmark 17 | prices_signal1 <- Cl(data_spy) #SPY ETF, Close(Cl) for the signal (realized vol) 18 | prices_trade1 <- Op(data_spy) #SPY data, Open(Op) for our trading 19 | 20 | # Step 2: Calculate ROC series 21 | roc_signal1 <- ROC(prices_signal1, n = 1, type = "discrete") 22 | roc_benchmark <- ROC(prices_benchmark, n = 1, type = "discrete") 23 | roc_trade1 <- ROC(prices_trade1, n = 1, type = "discrete") 24 | 25 | # Step 3: Develop the trading strategies 26 | # Strategy 1: A benchmark strategy 27 | lookback_period1 <- 20 28 | threshold1 <- 0.15 29 | label_strategy1 <- "Strategy 1: rv20d15" 30 | volatility1 <- runSD(roc_signal1, n = lookback_period1) * sqrt(252) 31 | signal_1 <- ifelse(volatility1 < threshold1, 1, 0) 32 | signal_1[is.na(signal_1)] <- 0 33 | 34 | # Strategy 2: The one plotted first, with Daily Returns 35 | lookback_period2 <- 22 36 | threshold2 <- 0.17 37 | label_strategy2 <- "Strategy 2: rv22d17" 38 | volatility2 <- runSD(roc_signal1, n = lookback_period2) * sqrt(252) 39 | signal_2 <- ifelse(volatility2 < threshold2, 1, 0) 40 | signal_2[is.na(signal_2)] <- 0 41 | 42 | # Step 4: Backtest the strategies 43 | returns_strategy1 <- roc_trade1 * Lag(signal_1, 2) 44 | returns_strategy1 <- na.omit(returns_strategy1) 45 | returns_strategy2 <- roc_trade1 * Lag(signal_2, 2) 46 | returns_strategy2 <- na.omit(returns_strategy2) 47 | 48 | # Calculate benchmark returns 49 | returns_benchmark <- roc_benchmark 50 | returns_benchmark <- Lag(returns_benchmark, 2) 51 | returns_benchmark <- na.omit(returns_benchmark) 52 | 53 | # Step 5: Evaluate performance and risk metrics 54 | # add an "exposure" metric (informative, not evaluative) 55 | exposure <- function(vec){ sum(vec != 0) / length(vec) } 56 | comparison <- cbind(returns_strategy2, returns_benchmark, returns_strategy1) 57 | colnames(comparison) <- c(label_strategy2, "Benchmark SPY total return", label_strategy1) 58 | stats_rv <- rbind(table.AnnualizedReturns(comparison), maxDrawdown(comparison)) 59 | charts.PerformanceSummary(comparison, main = "Realized Vol Strategies vs S&P 500 Benchmark") 60 | exposure_s2 <- exposure(returns_strategy2) 61 | exposure_s1 <- exposure(returns_strategy1) 62 | print( paste("Exposure for Strategy 2:", exposure_s2) ) 63 | print( paste("Exposure for Strategy 1:", exposure_s1) ) 64 | 65 | -------------------------------------------------------------------------------- /quant_rv_1.3.0.R: -------------------------------------------------------------------------------- 1 | ### quant_rv v1.3.0 by babbage9010 and friends 2 | # fix 1: use SPY adjusted for signal 3 | # fix 2: use stats::lag() instead of Lag() when calculating returns 4 | # change 1: implement multi-volatility signal for Strategy 2 5 | ### released under MIT License 6 | 7 | # Step 1: Load necessary libraries and data 8 | library(quantmod) 9 | library(PerformanceAnalytics) 10 | 11 | date_start <- as.Date("2006-07-01") 12 | date_end <- as.Date("2019-12-31") 13 | symbol_bench1 <- "SPY" # benchmark for comparison 14 | symbol_signal1 <- "SPY" # S&P 500 symbol (use SPY or ^GSPC) 15 | symbol_trade1 <- "SPY" # ETF to trade 16 | 17 | data_spy <- getSymbols(symbol_bench1, src = "yahoo", from = date_start, to = date_end, auto.assign = FALSE) 18 | prices_benchmark <- Ad(data_spy) #SPY ETF, Adjusted(Ad) for the benchmark 19 | prices_signal1 <- Ad(data_spy) #SPY ETF, Adjusted(Ad) for the signal (realized vol) 20 | prices_trade1 <- Op(data_spy) #SPY data, Open(Op) for our trading 21 | 22 | # Step 2: Calculate ROC series 23 | roc_signal1 <- ROC(prices_signal1, n = 1, type = "discrete") 24 | roc_benchmark <- ROC(prices_benchmark, n = 1, type = "discrete") 25 | roc_trade1 <- ROC(prices_trade1, n = 1, type = "discrete") 26 | 27 | # Step 3: Develop the trading strategies 28 | # Strategy 1: A benchmark strategy 29 | lookback_period1 <- 20 30 | threshold1 <- 0.15 31 | label_strategy1 <- "Strategy 1: rv20d15" 32 | volatility1 <- runSD(roc_signal1, n = lookback_period1) * sqrt(252) 33 | signal_1 <- ifelse(volatility1 < threshold1, 1, 0) 34 | signal_1[is.na(signal_1)] <- 0 35 | 36 | # Strategy 2: The one plotted first, with Daily Returns shown 37 | # we're using four measures of volatility with three lookback periods 38 | label_strategy2 <- "Strategy 2: randomized multivol" 39 | 40 | #lookback periods randomized 41 | lookback_long <- floor(runif(4, min = 20, max = 25)) #20-25 42 | lookback_med <- floor(runif(4, min = 12, max = 16)) #12-16 43 | lookback_short <- floor(runif(4, min = 4, max = 8)) #4-8 44 | 45 | #strategy volatility threshold randomized 46 | vthresh <- runif(21, min = 0.12, max = 0.17) 47 | 48 | #calculate all the volatility measures (12) 49 | vol_cc_L <- volatility(data_spy, n = lookback_long[1], calc = "close") 50 | vol_cc_M <- volatility(data_spy, n = lookback_med[1], calc = "close") 51 | vol_cc_S <- volatility(data_spy, n = lookback_short[1], calc = "close") 52 | vol_rs_L <- volatility(data_spy, n = lookback_long[2], calc = "rogers.satchell") 53 | vol_rs_M <- volatility(data_spy, n = lookback_med[2], calc = "rogers.satchell") 54 | vol_rs_S <- volatility(data_spy, n = lookback_short[2], calc = "rogers.satchell") 55 | vol_p_L <- volatility(data_spy, n = lookback_long[3], calc = "parkinson") 56 | vol_p_M <- volatility(data_spy, n = lookback_med[3], calc = "parkinson") 57 | vol_p_S <- volatility(data_spy, n = lookback_short[3], calc = "parkinson") 58 | vol_gkyz_L <- volatility(data_spy, n = lookback_long[4], calc = "gk.yz") 59 | vol_gkyz_M <- volatility(data_spy, n = lookback_med[4], calc = "gk.yz") 60 | vol_gkyz_S <- volatility(data_spy, n = lookback_short[4], calc = "gk.yz") 61 | 62 | #calculate the signals 63 | # note that volatility for Rogers-Satchell, Parkinson and GK-YZ 64 | # all generate positive and negative values, so we signal a low vol zone for those 65 | sig_cc_L <- ifelse(vol_cc_L < vthresh[1], 1, 0) 66 | sig_cc_M <- ifelse(vol_cc_M < vthresh[2], 1, 0) 67 | sig_cc_S <- ifelse(vol_cc_S < vthresh[3], 1, 0) 68 | sig_rs_L <- ifelse(vol_rs_L > -vthresh[4] & vol_rs_L < vthresh[5], 1, 0) 69 | sig_rs_M <- ifelse(vol_rs_M > -vthresh[6] & vol_rs_M < vthresh[7], 1, 0) 70 | sig_rs_S <- ifelse(vol_rs_S > -vthresh[8] & vol_rs_S < vthresh[9], 1, 0) 71 | sig_p_L <- ifelse(vol_p_L > -vthresh[10] & vol_p_L < vthresh[11], 1, 0) 72 | sig_p_M <- ifelse(vol_p_M > -vthresh[12] & vol_p_M < vthresh[13], 1, 0) 73 | sig_p_S <- ifelse(vol_p_S > -vthresh[14] & vol_p_S < vthresh[15], 1, 0) 74 | sig_gkyz_L <- ifelse(vol_gkyz_L > -vthresh[16] & vol_gkyz_L < vthresh[17], 1, 0) 75 | sig_gkyz_M <- ifelse(vol_gkyz_M > -vthresh[18] & vol_gkyz_M < vthresh[19], 1, 0) 76 | sig_gkyz_S <- ifelse(vol_gkyz_S > -vthresh[20] & vol_gkyz_S < vthresh[21], 1, 0) 77 | 78 | #add up the signals 79 | totalvol <- ( 80 | sig_cc_L 81 | + sig_cc_M 82 | + sig_cc_S 83 | + sig_rs_L 84 | + sig_rs_M 85 | + sig_rs_S 86 | + sig_p_L 87 | + sig_p_M 88 | + sig_p_S 89 | + sig_gkyz_L 90 | + sig_gkyz_M 91 | + sig_gkyz_S 92 | ) 93 | 94 | #look for any positive signal (or increase this threshold up to 12) 95 | signal_2 <- ifelse(totalvol >= 1, 1, 0) 96 | signal_2[is.na(signal_2)] <- 0 97 | 98 | # Step 4: Backtest the strategies 99 | returns_strategy1 <- roc_trade1 * stats::lag(signal_1, 2) 100 | returns_strategy1 <- na.omit(returns_strategy1) 101 | returns_strategy2 <- roc_trade1 * stats::lag(signal_2, 2) 102 | returns_strategy2 <- na.omit(returns_strategy2) 103 | 104 | # Calculate benchmark returns 105 | returns_benchmark <- roc_benchmark 106 | returns_benchmark <- stats::lag(returns_benchmark, 2) 107 | returns_benchmark <- na.omit(returns_benchmark) 108 | 109 | # Step 5: Evaluate performance and risk metrics 110 | # add an "exposure" metric (informative, not evaluative) 111 | exposure <- function(vec){ sum(vec != 0) / length(vec) } 112 | comparison <- cbind(returns_strategy2, returns_benchmark, returns_strategy1) 113 | colnames(comparison) <- c(label_strategy2, "Benchmark SPY total return", label_strategy1) 114 | stats_rv <- rbind(table.AnnualizedReturns(comparison), maxDrawdown(comparison)) 115 | charts.PerformanceSummary(comparison, main = "Realized Vol Strategies vs S&P 500 Benchmark") 116 | exposure_s2 <- exposure(returns_strategy2) 117 | exposure_s1 <- exposure(returns_strategy1) 118 | print( paste("Exposure for Strategy 2:", exposure_s2) ) 119 | print( paste("Exposure for Strategy 1:", exposure_s1) ) 120 | -------------------------------------------------------------------------------- /quant_rv_1.3.1.R: -------------------------------------------------------------------------------- 1 | ### quant_rv v1.3.1 by babbage9010 and friends 2 | # change 1: change colors: Strategy 1 is red, Benchmark is black 3 | ### released under MIT License 4 | 5 | # Step 1: Load necessary libraries and data 6 | library(quantmod) 7 | library(PerformanceAnalytics) 8 | 9 | date_start <- as.Date("2006-07-01") 10 | date_end <- as.Date("2019-12-31") 11 | symbol_bench1 <- "SPY" # benchmark for comparison 12 | symbol_signal1 <- "SPY" # S&P 500 symbol (use SPY or ^GSPC) 13 | symbol_trade1 <- "SPY" # ETF to trade 14 | 15 | data_spy <- getSymbols(symbol_bench1, src = "yahoo", from = date_start, to = date_end, auto.assign = FALSE) 16 | prices_benchmark <- Ad(data_spy) #SPY ETF, Adjusted(Ad) for the benchmark 17 | prices_signal1 <- Ad(data_spy) #SPY ETF, Adjusted(Ad) for the signal (realized vol) 18 | prices_trade1 <- Op(data_spy) #SPY data, Open(Op) for our trading 19 | 20 | # Step 2: Calculate ROC series 21 | roc_signal1 <- ROC(prices_signal1, n = 1, type = "discrete") 22 | roc_benchmark <- ROC(prices_benchmark, n = 1, type = "discrete") 23 | roc_trade1 <- ROC(prices_trade1, n = 1, type = "discrete") 24 | 25 | # Step 3: Develop the trading strategies 26 | # Strategy 1: A benchmark strategy 27 | lookback_period1 <- 20 28 | threshold1 <- 0.15 29 | label_strategy1 <- "Strategy 1: rv20d15" 30 | volatility1 <- runSD(roc_signal1, n = lookback_period1) * sqrt(252) 31 | signal_1 <- ifelse(volatility1 < threshold1, 1, 0) 32 | signal_1[is.na(signal_1)] <- 0 33 | 34 | # Strategy 2: The one plotted first, with Daily Returns shown 35 | # we're using four measures of volatility with three lookback periods 36 | label_strategy2 <- "Strategy 2: randomized multivol" 37 | 38 | #lookback periods randomized 39 | lookback_long <- floor(runif(4, min = 20, max = 25)) #20-25 40 | lookback_med <- floor(runif(4, min = 12, max = 16)) #12-16 41 | lookback_short <- floor(runif(4, min = 4, max = 8)) #4-8 42 | 43 | #strategy volatility threshold randomized 44 | vthresh <- runif(21, min = 0.12, max = 0.17) 45 | 46 | #calculate all the volatility measures (12) 47 | vol_cc_L <- volatility(data_spy, n = lookback_long[1], calc = "close") 48 | vol_cc_M <- volatility(data_spy, n = lookback_med[1], calc = "close") 49 | vol_cc_S <- volatility(data_spy, n = lookback_short[1], calc = "close") 50 | vol_rs_L <- volatility(data_spy, n = lookback_long[2], calc = "rogers.satchell") 51 | vol_rs_M <- volatility(data_spy, n = lookback_med[2], calc = "rogers.satchell") 52 | vol_rs_S <- volatility(data_spy, n = lookback_short[2], calc = "rogers.satchell") 53 | vol_p_L <- volatility(data_spy, n = lookback_long[3], calc = "parkinson") 54 | vol_p_M <- volatility(data_spy, n = lookback_med[3], calc = "parkinson") 55 | vol_p_S <- volatility(data_spy, n = lookback_short[3], calc = "parkinson") 56 | vol_gkyz_L <- volatility(data_spy, n = lookback_long[4], calc = "gk.yz") 57 | vol_gkyz_M <- volatility(data_spy, n = lookback_med[4], calc = "gk.yz") 58 | vol_gkyz_S <- volatility(data_spy, n = lookback_short[4], calc = "gk.yz") 59 | 60 | #calculate the signals 61 | # note that volatility for Rogers-Satchell, Parkinson and GK-YZ 62 | # all generate positive and negative values, so we signal a low vol zone for those 63 | sig_cc_L <- ifelse(vol_cc_L < vthresh[1], 1, 0) 64 | sig_cc_M <- ifelse(vol_cc_M < vthresh[2], 1, 0) 65 | sig_cc_S <- ifelse(vol_cc_S < vthresh[3], 1, 0) 66 | sig_rs_L <- ifelse(vol_rs_L > -vthresh[4] & vol_rs_L < vthresh[5], 1, 0) 67 | sig_rs_M <- ifelse(vol_rs_M > -vthresh[6] & vol_rs_M < vthresh[7], 1, 0) 68 | sig_rs_S <- ifelse(vol_rs_S > -vthresh[8] & vol_rs_S < vthresh[9], 1, 0) 69 | sig_p_L <- ifelse(vol_p_L > -vthresh[10] & vol_p_L < vthresh[11], 1, 0) 70 | sig_p_M <- ifelse(vol_p_M > -vthresh[12] & vol_p_M < vthresh[13], 1, 0) 71 | sig_p_S <- ifelse(vol_p_S > -vthresh[14] & vol_p_S < vthresh[15], 1, 0) 72 | sig_gkyz_L <- ifelse(vol_gkyz_L > -vthresh[16] & vol_gkyz_L < vthresh[17], 1, 0) 73 | sig_gkyz_M <- ifelse(vol_gkyz_M > -vthresh[18] & vol_gkyz_M < vthresh[19], 1, 0) 74 | sig_gkyz_S <- ifelse(vol_gkyz_S > -vthresh[20] & vol_gkyz_S < vthresh[21], 1, 0) 75 | 76 | #add up the signals 77 | totalvol <- ( 78 | sig_cc_L 79 | + sig_cc_M 80 | + sig_cc_S 81 | + sig_rs_L 82 | + sig_rs_M 83 | + sig_rs_S 84 | + sig_p_L 85 | + sig_p_M 86 | + sig_p_S 87 | + sig_gkyz_L 88 | + sig_gkyz_M 89 | + sig_gkyz_S 90 | ) 91 | 92 | #look for any positive signal (or increase this threshold up to 12) 93 | signal_2 <- ifelse(totalvol >= 1, 1, 0) 94 | signal_2[is.na(signal_2)] <- 0 95 | 96 | # Step 4: Backtest the strategies 97 | returns_strategy1 <- roc_trade1 * stats::lag(signal_1, 2) 98 | returns_strategy1 <- na.omit(returns_strategy1) 99 | returns_strategy2 <- roc_trade1 * stats::lag(signal_2, 2) 100 | returns_strategy2 <- na.omit(returns_strategy2) 101 | 102 | # Calculate benchmark returns 103 | returns_benchmark <- roc_benchmark 104 | returns_benchmark <- stats::lag(returns_benchmark, 2) 105 | returns_benchmark <- na.omit(returns_benchmark) 106 | 107 | # Step 5: Evaluate performance and risk metrics 108 | # add an "exposure" metric (informative, not evaluative) 109 | exposure <- function(vec){ sum(vec != 0) / length(vec) } 110 | comparison <- cbind(returns_benchmark, returns_strategy1,returns_strategy2) 111 | colnames(comparison) <- c("Benchmark SPY total return", label_strategy1, label_strategy2) 112 | stats_rv <- rbind(table.AnnualizedReturns(comparison), maxDrawdown(comparison)) 113 | charts.PerformanceSummary(comparison, main = "Realized Vol Strategies vs S&P 500 Benchmark") 114 | exposure_s2 <- exposure(returns_strategy2) 115 | exposure_s1 <- exposure(returns_strategy1) 116 | print( paste("Exposure for Strategy 2:", exposure_s2) ) 117 | print( paste("Exposure for Strategy 1:", exposure_s1) ) 118 | 119 | #Step 6: random generation/plotting of strategies 120 | #srs <- as.xts(returns_benchmark) 121 | comparison3 <- as.xts(returns_benchmark) 122 | for(s in 1:20){ 123 | 124 | # Strategy 2: The one plotted first, with Daily Returns shown 125 | # we're using four measures of volatility with three lookback periods 126 | label_strategy2 <- "Strategy 2: randomized multivol" 127 | 128 | #lookback periods randomized 129 | lookback_long <- floor(runif(4, min = 20, max = 25)) #20-25 130 | lookback_med <- floor(runif(4, min = 12, max = 16)) #12-16 131 | lookback_short <- floor(runif(4, min = 4, max = 8)) #4-8 132 | 133 | #strategy volatility threshold randomized 134 | vthresh <- runif(21, min = 0.12, max = 0.17) 135 | 136 | #calculate all the volatility measures (12) 137 | vol_cc_L <- volatility(data_spy, n = lookback_long[1], calc = "close") 138 | vol_cc_M <- volatility(data_spy, n = lookback_med[1], calc = "close") 139 | vol_cc_S <- volatility(data_spy, n = lookback_short[1], calc = "close") 140 | vol_rs_L <- volatility(data_spy, n = lookback_long[2], calc = "rogers.satchell") 141 | vol_rs_M <- volatility(data_spy, n = lookback_med[2], calc = "rogers.satchell") 142 | vol_rs_S <- volatility(data_spy, n = lookback_short[2], calc = "rogers.satchell") 143 | vol_p_L <- volatility(data_spy, n = lookback_long[3], calc = "parkinson") 144 | vol_p_M <- volatility(data_spy, n = lookback_med[3], calc = "parkinson") 145 | vol_p_S <- volatility(data_spy, n = lookback_short[3], calc = "parkinson") 146 | vol_gkyz_L <- volatility(data_spy, n = lookback_long[4], calc = "gk.yz") 147 | vol_gkyz_M <- volatility(data_spy, n = lookback_med[4], calc = "gk.yz") 148 | vol_gkyz_S <- volatility(data_spy, n = lookback_short[4], calc = "gk.yz") 149 | 150 | #calculate the signals 151 | # note that volatility for Rogers-Satchell, Parkinson and GK-YZ 152 | # all generate positive and negative values, so we signal a low vol zone for those 153 | sig_cc_L <- ifelse(vol_cc_L < vthresh[1], 1, 0) 154 | sig_cc_M <- ifelse(vol_cc_M < vthresh[2], 1, 0) 155 | sig_cc_S <- ifelse(vol_cc_S < vthresh[3], 1, 0) 156 | sig_rs_L <- ifelse(vol_rs_L > -vthresh[4] & vol_rs_L < vthresh[5], 1, 0) 157 | sig_rs_M <- ifelse(vol_rs_M > -vthresh[6] & vol_rs_M < vthresh[7], 1, 0) 158 | sig_rs_S <- ifelse(vol_rs_S > -vthresh[8] & vol_rs_S < vthresh[9], 1, 0) 159 | sig_p_L <- ifelse(vol_p_L > -vthresh[10] & vol_p_L < vthresh[11], 1, 0) 160 | sig_p_M <- ifelse(vol_p_M > -vthresh[12] & vol_p_M < vthresh[13], 1, 0) 161 | sig_p_S <- ifelse(vol_p_S > -vthresh[14] & vol_p_S < vthresh[15], 1, 0) 162 | sig_gkyz_L <- ifelse(vol_gkyz_L > -vthresh[16] & vol_gkyz_L < vthresh[17], 1, 0) 163 | sig_gkyz_M <- ifelse(vol_gkyz_M > -vthresh[18] & vol_gkyz_M < vthresh[19], 1, 0) 164 | sig_gkyz_S <- ifelse(vol_gkyz_S > -vthresh[20] & vol_gkyz_S < vthresh[21], 1, 0) 165 | 166 | #add up the signals 167 | totalvol <- ( 168 | sig_cc_L 169 | + sig_cc_M 170 | + sig_cc_S 171 | + sig_rs_L 172 | + sig_rs_M 173 | + sig_rs_S 174 | + sig_p_L 175 | + sig_p_M 176 | + sig_p_S 177 | + sig_gkyz_L 178 | + sig_gkyz_M 179 | + sig_gkyz_S 180 | ) 181 | 182 | #look for any positive signal (or increase this threshold up to 12) 183 | signal_2 <- ifelse(totalvol >= 1, 1, 0) 184 | signal_2[is.na(signal_2)] <- 0 185 | 186 | # Step 4: Backtest the strategies 187 | returns_strategy2 <- roc_trade1 * stats::lag(signal_2, 2) 188 | returns_strategy2 <- na.omit(returns_strategy2) 189 | 190 | rtns <- returns_strategy2 191 | comparison3 <- cbind(comparison3, rtns) 192 | print( exposure(rtns)) 193 | 194 | } 195 | charts.PerformanceSummary(comparison3, main = "Random RV Strategies vs S&P 500 Benchmark") 196 | stats_rv5 <- rbind(table.AnnualizedReturns(comparison3), maxDrawdown(comparison3)) 197 | -------------------------------------------------------------------------------- /quant_rv_1.3.2.R: -------------------------------------------------------------------------------- 1 | ### quant_rv v1.3.2 by babbage9010 and friends 2 | ### released under MIT License 3 | # changelog 4 | # 1: add second benchmark, Op-Op no dividends 5 | # 2: fix (remove) erroneous 2 day lag in the benchmark returns 6 | # 3: remove useless negative thresholds in vol signals 7 | # 4: add normalized ATR functionality, add to strategy signals 8 | # 5: revision: see #lookback periods randomized; using four lookback ranges 9 | # offering complete coverage from 4-25 days, instead of three formerly 10 | # 6: minor changes to symbol naming/loading code 11 | 12 | # Step 1: Load necessary libraries and data 13 | library(quantmod) 14 | library(PerformanceAnalytics) 15 | 16 | date_start <- as.Date("2006-07-01") 17 | date_end <- as.Date("2019-12-31") 18 | symbol_benchmark1 <- "SPY" # benchmark for comparison 19 | symbol_signal1 <- "SPY" # S&P 500 symbol (use SPY or ^GSPC) 20 | symbol_trade1 <- "SPY" # ETF to trade 21 | 22 | data_benchmark1 <- getSymbols(symbol_benchmark1, src = "yahoo", from = date_start, to = date_end, auto.assign = FALSE) 23 | #data_signal1 <- getSymbols(symbol_signal1, src = "yahoo", from = date_start, to = date_end, auto.assign = FALSE) 24 | #data_trade1 <- getSymbols(symbol_trade1, src = "yahoo", from = date_start, to = date_end, auto.assign = FALSE) 25 | data_signal1 <- data_benchmark1 #do this if only using "SPY", e.g., to avoid extra downloading 26 | data_trade1 <- data_benchmark1 27 | data_benchmark2 <- data_benchmark1 28 | prices_benchmark1 <- Ad(data_benchmark1) #Adjusted(Ad) for the #1 benchmark 29 | prices_benchmark2 <- Op(data_benchmark2) #Open(Op) for the #2 benchmark 30 | prices_signal1 <- Ad(data_signal1) #Adjusted(Ad) for the signal (realized vol) 31 | prices_trade1 <- Op(data_trade1) #Open(Op) for our trading 32 | prices_signal1Cl <- Cl(data_signal1) #Close(Cl) for the ATR normalization 33 | 34 | # Step 2: Calculate ROC series 35 | roc_signal1 <- ROC(prices_signal1, n = 1, type = "discrete") 36 | roc_benchmark1 <- ROC(prices_benchmark1, n = 1, type = "discrete") 37 | roc_benchmark2 <- ROC(prices_benchmark2, n = 1, type = "discrete") 38 | roc_trade1 <- ROC(prices_trade1, n = 1, type = "discrete") 39 | 40 | # Step 3: Develop the trading strategies 41 | # we're using five measures of volatility with four lookback periods 42 | 43 | #lookback periods randomized 44 | lookback_long <- floor(runif(5, min = 20, max = 25)) 45 | lookback_medlong <- floor(runif(5, min = 14, max = 19)) 46 | lookback_medshort <- floor(runif(5, min = 9, max = 13)) 47 | lookback_short <- floor(runif(5, min = 4, max = 8)) 48 | 49 | #calculate all five volatility measures across 4 lookback ranges (12) 50 | #cc: Close-to-Close volatility 51 | vol_cc_L <- volatility(data_signal1, n = lookback_long[1], calc = "close") 52 | vol_cc_ML <- volatility(data_signal1, n = lookback_medlong[1], calc = "close") 53 | vol_cc_MS <- volatility(data_signal1, n = lookback_medshort[1], calc = "close") 54 | vol_cc_S <- volatility(data_signal1, n = lookback_short[1], calc = "close") 55 | #rs: Rogers-Satchell volatility 56 | vol_rs_L <- volatility(data_signal1, n = lookback_long[2], calc = "rogers.satchell") 57 | vol_rs_ML <- volatility(data_signal1, n = lookback_medlong[2], calc = "rogers.satchell") 58 | vol_rs_MS <- volatility(data_signal1, n = lookback_medshort[2], calc = "rogers.satchell") 59 | vol_rs_S <- volatility(data_signal1, n = lookback_short[2], calc = "rogers.satchell") 60 | #p: Parkinson volatility 61 | vol_p_L <- volatility(data_signal1, n = lookback_long[3], calc = "parkinson") 62 | vol_p_ML <- volatility(data_signal1, n = lookback_medlong[3], calc = "parkinson") 63 | vol_p_MS <- volatility(data_signal1, n = lookback_medshort[3], calc = "parkinson") 64 | vol_p_S <- volatility(data_signal1, n = lookback_short[3], calc = "parkinson") 65 | #gkyz: Garman-Klass Yang-Zhang volatility 66 | vol_gkyz_L <- volatility(data_signal1, n = lookback_long[4], calc = "gk.yz") 67 | vol_gkyz_ML <- volatility(data_signal1, n = lookback_medlong[4], calc = "gk.yz") 68 | vol_gkyz_MS <- volatility(data_signal1, n = lookback_medshort[4], calc = "gk.yz") 69 | vol_gkyz_S <- volatility(data_signal1, n = lookback_short[4], calc = "gk.yz") 70 | 71 | #natr: normalized Average True Range volatility 72 | natr_L <- ATR(data_signal1, n=lookback_long[5], maType="ZLEMA")[ , "atr"] / prices_signal1Cl 73 | natr_ML <- ATR(data_signal1, n=lookback_medlong[5], maType="ZLEMA")[ , "atr"] / prices_signal1Cl 74 | natr_MS <- ATR(data_signal1, n=lookback_medshort[5], maType="ZLEMA")[ , "atr"] / prices_signal1Cl 75 | natr_S <- ATR(data_signal1, n=lookback_short[5], maType="ZLEMA")[ , "atr"] / prices_signal1Cl 76 | 77 | #strategy volatility thresholds, randomized 78 | vthresh <- runif(16, min = 0.12, max = 0.17) #low threshold for volatility measures 79 | lthresh <- runif(4, min = 0.010, max = 0.015) #low threshold for nATR 80 | 81 | #calculate the Vol signals 82 | sig_cc_L <- ifelse(vol_cc_L < vthresh[1], 1, 0) 83 | sig_cc_ML <- ifelse(vol_cc_ML < vthresh[2], 1, 0) 84 | sig_cc_MS <- ifelse(vol_cc_MS < vthresh[3], 1, 0) 85 | sig_cc_S <- ifelse(vol_cc_S < vthresh[4], 1, 0) 86 | sig_rs_L <- ifelse(vol_rs_L < vthresh[5], 1, 0) 87 | sig_rs_ML <- ifelse(vol_rs_ML < vthresh[6], 1, 0) 88 | sig_rs_MS <- ifelse(vol_rs_MS < vthresh[7], 1, 0) 89 | sig_rs_S <- ifelse(vol_rs_S < vthresh[8], 1, 0) 90 | sig_p_L <- ifelse(vol_p_L < vthresh[9], 1, 0) 91 | sig_p_ML <- ifelse(vol_p_ML < vthresh[10], 1, 0) 92 | sig_p_MS <- ifelse(vol_p_MS < vthresh[11], 1, 0) 93 | sig_p_S <- ifelse(vol_p_S < vthresh[12], 1, 0) 94 | sig_gkyz_L <- ifelse(vol_gkyz_L < vthresh[13], 1, 0) 95 | sig_gkyz_ML <- ifelse(vol_gkyz_ML < vthresh[14], 1, 0) 96 | sig_gkyz_MS <- ifelse(vol_gkyz_MS < vthresh[15], 1, 0) 97 | sig_gkyz_S <- ifelse(vol_gkyz_S < vthresh[16], 1, 0) 98 | 99 | sig_natr_L <- ifelse(natr_L < lthresh[1], 1, 0) 100 | sig_natr_ML <- ifelse(natr_ML < lthresh[2], 1, 0) 101 | sig_natr_MS <- ifelse(natr_MS < lthresh[3], 1, 0) 102 | sig_natr_S <- ifelse(natr_S < lthresh[4], 1, 0) 103 | 104 | #add up the signals 105 | totalvol <- ( 106 | + sig_cc_L 107 | + sig_cc_ML 108 | + sig_cc_MS 109 | + sig_cc_S 110 | + sig_rs_L 111 | + sig_rs_ML 112 | + sig_rs_MS 113 | + sig_rs_S 114 | + sig_p_L 115 | + sig_p_ML 116 | + sig_p_MS 117 | + sig_p_S 118 | + sig_gkyz_L 119 | + sig_gkyz_ML 120 | + sig_gkyz_MS 121 | + sig_gkyz_S 122 | ) 123 | 124 | totalnatr <- ( 125 | + sig_natr_L 126 | + sig_natr_ML 127 | + sig_natr_MS 128 | + sig_natr_S 129 | ) 130 | 131 | #combine the signals 132 | #look for any positive signal (ie, 1. or increase this threshold count up to 20) 133 | signal_1 <- ifelse(totalvol + totalnatr >= 1, 1, 0) 134 | signal_1[is.na(signal_1)] <- 0 135 | label_strategy1 <- "Strategy 1: Multivol 5" 136 | 137 | signal_2 <- ifelse(totalnatr >= 1, 1, 0) 138 | signal_2[is.na(signal_2)] <- 0 139 | label_strategy2 <- "Strategy 2: nATR only" 140 | 141 | signal_3 <- ifelse(totalvol >= 1, 1, 0) 142 | signal_3[is.na(signal_3)] <- 0 143 | label_strategy3 <- "Strategy 3: Multivol 4 (no nATR)" 144 | 145 | # Step 4: Backtest the strategies 146 | returns_strategy1 <- roc_trade1 * stats::lag(signal_1, 2) 147 | returns_strategy1 <- na.omit(returns_strategy1) 148 | returns_strategy2 <- roc_trade1 * stats::lag(signal_2, 2) 149 | returns_strategy2 <- na.omit(returns_strategy2) 150 | returns_strategy3 <- roc_trade1 * stats::lag(signal_3, 2) 151 | returns_strategy3 <- na.omit(returns_strategy3) 152 | 153 | # Calculate Benchmark 1&2 returns 154 | returns_benchmark1 <- stats::lag(roc_benchmark1, 0) 155 | returns_benchmark1 <- na.omit(returns_benchmark1) 156 | label_benchmark1 <- "Benchmark SPY total return" 157 | returns_benchmark2 <- stats::lag(roc_benchmark2, 0) 158 | returns_benchmark2 <- na.omit(returns_benchmark2) 159 | label_benchmark2 <- "Benchmark 2: SPY Open-Open, no divvies" 160 | 161 | # Step 5: Evaluate performance and risk metrics 162 | # add an "exposure" metric (informative, not evaluative) 163 | exposure <- function(vec){ sum(vec != 0) / length(vec) } 164 | 165 | comparison <- cbind(returns_benchmark1, returns_benchmark2, returns_strategy1, returns_strategy2, returns_strategy3) 166 | colnames(comparison) <- c(label_benchmark1, label_benchmark2, label_strategy1, label_strategy2, label_strategy3) 167 | stats_rv <- rbind(table.AnnualizedReturns(comparison), maxDrawdown(comparison)) 168 | charts.PerformanceSummary(comparison, main = "Realized Vol Strategies vs S&P 500 Benchmark") 169 | 170 | #print exposure to console in R Studio 171 | exposure_s1 <- exposure(returns_strategy1) 172 | exposure_s2 <- exposure(returns_strategy2) 173 | exposure_s3 <- exposure(returns_strategy3) 174 | print( paste("Exposure for Strategy 1:", exposure_s1) ) 175 | print( paste("Exposure for Strategy 2:", exposure_s2) ) 176 | print( paste("Exposure for Strategy 3:", exposure_s3) ) 177 | 178 | #Step 6: generate/plot 20 Multivol 5 equity curves at once 179 | comparison3 <- as.xts(returns_benchmark1) 180 | for(s in 1:20){ 181 | #repeat signal generation within the loop... 182 | #lookback periods randomized 183 | lookback_long <- floor(runif(5, min = 20, max = 25)) 184 | lookback_medlong <- floor(runif(5, min = 14, max = 19)) 185 | lookback_medshort <- floor(runif(5, min = 9, max = 13)) 186 | lookback_short <- floor(runif(5, min = 4, max = 8)) 187 | 188 | #calculate all five volatility measures across 4 lookback ranges (12) 189 | #cc: Close-to-Close volatility 190 | vol_cc_L <- volatility(data_signal1, n = lookback_long[1], calc = "close") 191 | vol_cc_ML <- volatility(data_signal1, n = lookback_medlong[1], calc = "close") 192 | vol_cc_MS <- volatility(data_signal1, n = lookback_medshort[1], calc = "close") 193 | vol_cc_S <- volatility(data_signal1, n = lookback_short[1], calc = "close") 194 | #rs: Rogers-Satchell volatility 195 | vol_rs_L <- volatility(data_signal1, n = lookback_long[2], calc = "rogers.satchell") 196 | vol_rs_ML <- volatility(data_signal1, n = lookback_medlong[2], calc = "rogers.satchell") 197 | vol_rs_MS <- volatility(data_signal1, n = lookback_medshort[2], calc = "rogers.satchell") 198 | vol_rs_S <- volatility(data_signal1, n = lookback_short[2], calc = "rogers.satchell") 199 | #p: Parkinson volatility 200 | vol_p_L <- volatility(data_signal1, n = lookback_long[3], calc = "parkinson") 201 | vol_p_ML <- volatility(data_signal1, n = lookback_medlong[3], calc = "parkinson") 202 | vol_p_MS <- volatility(data_signal1, n = lookback_medshort[3], calc = "parkinson") 203 | vol_p_S <- volatility(data_signal1, n = lookback_short[3], calc = "parkinson") 204 | #gkyz: Garman-Klass Yang-Zhang volatility 205 | vol_gkyz_L <- volatility(data_signal1, n = lookback_long[4], calc = "gk.yz") 206 | vol_gkyz_ML <- volatility(data_signal1, n = lookback_medlong[4], calc = "gk.yz") 207 | vol_gkyz_MS <- volatility(data_signal1, n = lookback_medshort[4], calc = "gk.yz") 208 | vol_gkyz_S <- volatility(data_signal1, n = lookback_short[4], calc = "gk.yz") 209 | 210 | #natr: normalized Average True Range volatility 211 | natr_L <- ATR(data_signal1, n=lookback_long[5], maType="ZLEMA")[ , "atr"] / prices_signal1Cl 212 | natr_ML <- ATR(data_signal1, n=lookback_medlong[5], maType="ZLEMA")[ , "atr"] / prices_signal1Cl 213 | natr_MS <- ATR(data_signal1, n=lookback_medshort[5], maType="ZLEMA")[ , "atr"] / prices_signal1Cl 214 | natr_S <- ATR(data_signal1, n=lookback_short[5], maType="ZLEMA")[ , "atr"] / prices_signal1Cl 215 | 216 | #strategy volatility thresholds, randomized 217 | vthresh <- runif(16, min = 0.12, max = 0.17) #low threshold for volatility measures 218 | lthresh <- runif(4, min = 0.010, max = 0.015) #low threshold for nATR 219 | 220 | #calculate the Vol signals 221 | sig_cc_L <- ifelse(vol_cc_L < vthresh[1], 1, 0) 222 | sig_cc_ML <- ifelse(vol_cc_ML < vthresh[2], 1, 0) 223 | sig_cc_MS <- ifelse(vol_cc_MS < vthresh[3], 1, 0) 224 | sig_cc_S <- ifelse(vol_cc_S < vthresh[4], 1, 0) 225 | sig_rs_L <- ifelse(vol_rs_L < vthresh[5], 1, 0) 226 | sig_rs_ML <- ifelse(vol_rs_ML < vthresh[6], 1, 0) 227 | sig_rs_MS <- ifelse(vol_rs_MS < vthresh[7], 1, 0) 228 | sig_rs_S <- ifelse(vol_rs_S < vthresh[8], 1, 0) 229 | sig_p_L <- ifelse(vol_p_L < vthresh[9], 1, 0) 230 | sig_p_ML <- ifelse(vol_p_ML < vthresh[10], 1, 0) 231 | sig_p_MS <- ifelse(vol_p_MS < vthresh[11], 1, 0) 232 | sig_p_S <- ifelse(vol_p_S < vthresh[12], 1, 0) 233 | sig_gkyz_L <- ifelse(vol_gkyz_L < vthresh[13], 1, 0) 234 | sig_gkyz_ML <- ifelse(vol_gkyz_ML < vthresh[14], 1, 0) 235 | sig_gkyz_MS <- ifelse(vol_gkyz_MS < vthresh[15], 1, 0) 236 | sig_gkyz_S <- ifelse(vol_gkyz_S < vthresh[16], 1, 0) 237 | 238 | sig_natr_L <- ifelse(natr_L < lthresh[1], 1, 0) 239 | sig_natr_ML <- ifelse(natr_ML < lthresh[2], 1, 0) 240 | sig_natr_MS <- ifelse(natr_MS < lthresh[3], 1, 0) 241 | sig_natr_S <- ifelse(natr_S < lthresh[4], 1, 0) 242 | 243 | #add up the signals 244 | totalvol <- ( 245 | + sig_cc_L 246 | + sig_cc_ML 247 | + sig_cc_MS 248 | + sig_cc_S 249 | + sig_rs_L 250 | + sig_rs_ML 251 | + sig_rs_MS 252 | + sig_rs_S 253 | + sig_p_L 254 | + sig_p_ML 255 | + sig_p_MS 256 | + sig_p_S 257 | + sig_gkyz_L 258 | + sig_gkyz_ML 259 | + sig_gkyz_MS 260 | + sig_gkyz_S 261 | ) 262 | 263 | totalnatr <- ( 264 | + sig_natr_L 265 | + sig_natr_ML 266 | + sig_natr_MS 267 | + sig_natr_S 268 | ) 269 | 270 | #look for any positive signal (or increase this threshold up to 20) 271 | #signal_2 <- ifelse(totalnatr >= 1, 1, 0) #only nATR 272 | #signal_2 <- ifelse(totalvol >= 1, 1, 0) #Multivol without nATR 273 | signal_2 <- ifelse(totalvol + totalnatr >= 1, 1, 0) #Multivol with nATR 274 | signal_2[is.na(signal_2)] <- 0 275 | 276 | # Step 4: Backtest the strategies 277 | returns_strategy2 <- roc_trade1 * stats::lag(signal_2, 2) 278 | returns_strategy2 <- na.omit(returns_strategy2) 279 | 280 | rtns <- returns_strategy2 281 | comparison3 <- cbind(comparison3, rtns) 282 | print( exposure(rtns)) 283 | 284 | } 285 | charts.PerformanceSummary(comparison3, main = "Random RV Strategies vs S&P 500 Benchmark") 286 | #comment out the "stats_rv5" line below to improve speed of script 287 | # at the expense of not having comprehensive stats to view 288 | stats_rv5 <- rbind(table.AnnualizedReturns(comparison3), maxDrawdown(comparison3)) 289 | -------------------------------------------------------------------------------- /quant_rv_1.3.3.R: -------------------------------------------------------------------------------- 1 | ### quant_rv v1.3.3 by babbage9010 and friends 2 | ### released under MIT License 3 | # changelog 4 | # 1: add a second trade symbol for Short SPY (SH) 5 | # 2: go short SPY (using SH) when not long SPY 6 | 7 | # Step 1: Load necessary libraries and data 8 | library(quantmod) 9 | library(PerformanceAnalytics) 10 | 11 | date_start <- as.Date("2006-07-01") 12 | date_end <- as.Date("2019-12-31") 13 | symbol_benchmark1 <- "SPY" # benchmark for comparison 14 | symbol_signal1 <- "SPY" # S&P 500 symbol (use SPY or ^GSPC) 15 | symbol_trade1 <- "SPY" # ETF to trade 16 | symbol_trade2 <- "SH" # ETF to trade 17 | 18 | data_benchmark1 <- getSymbols(symbol_benchmark1, src = "yahoo", from = date_start, to = date_end, auto.assign = FALSE) 19 | #data_signal1 <- getSymbols(symbol_signal1, src = "yahoo", from = date_start, to = date_end, auto.assign = FALSE) 20 | #data_trade1 <- getSymbols(symbol_trade1, src = "yahoo", from = date_start, to = date_end, auto.assign = FALSE) 21 | data_trade2 <- getSymbols(symbol_trade2, src = "yahoo", from = date_start, to = date_end, auto.assign = FALSE) 22 | data_signal1 <- data_benchmark1 #do this if only using "SPY", e.g., to avoid extra downloading 23 | data_trade1 <- data_benchmark1 24 | data_benchmark2 <- data_benchmark1 25 | prices_benchmark1 <- Ad(data_benchmark1) #Adjusted(Ad) for the #1 benchmark 26 | prices_benchmark2 <- Op(data_benchmark2) #Open(Op) for the #2 benchmark 27 | prices_signal1 <- Ad(data_signal1) #Adjusted(Ad) for the signal (realized vol) 28 | prices_trade1 <- Op(data_trade1) #Open(Op) for our trading 29 | prices_trade2 <- Op(data_trade2) #Open(Op) for our trading 30 | prices_signal1Cl <- Cl(data_signal1) #Close(Cl) for the ATR normalization 31 | 32 | # Step 2: Calculate ROC series 33 | roc_signal1 <- ROC(prices_signal1, n = 1, type = "discrete") 34 | roc_benchmark1 <- ROC(prices_benchmark1, n = 1, type = "discrete") 35 | roc_benchmark2 <- ROC(prices_benchmark2, n = 1, type = "discrete") 36 | roc_trade1 <- ROC(prices_trade1, n = 1, type = "discrete") 37 | roc_trade2 <- ROC(prices_trade2, n = 1, type = "discrete") 38 | 39 | # Step 3: Develop the trading strategies 40 | # we're using five measures of volatility with four lookback periods 41 | 42 | #lookback periods randomized 43 | lookback_long <- floor(runif(5, min = 20, max = 25)) 44 | lookback_medlong <- floor(runif(5, min = 14, max = 19)) 45 | lookback_medshort <- floor(runif(5, min = 9, max = 13)) 46 | lookback_short <- floor(runif(5, min = 4, max = 8)) 47 | 48 | #calculate all five volatility measures across 4 lookback ranges (12) 49 | #cc: Close-to-Close volatility 50 | vol_cc_L <- volatility(data_signal1, n = lookback_long[1], calc = "close") 51 | vol_cc_ML <- volatility(data_signal1, n = lookback_medlong[1], calc = "close") 52 | vol_cc_MS <- volatility(data_signal1, n = lookback_medshort[1], calc = "close") 53 | vol_cc_S <- volatility(data_signal1, n = lookback_short[1], calc = "close") 54 | #rs: Rogers-Satchell volatility 55 | vol_rs_L <- volatility(data_signal1, n = lookback_long[2], calc = "rogers.satchell") 56 | vol_rs_ML <- volatility(data_signal1, n = lookback_medlong[2], calc = "rogers.satchell") 57 | vol_rs_MS <- volatility(data_signal1, n = lookback_medshort[2], calc = "rogers.satchell") 58 | vol_rs_S <- volatility(data_signal1, n = lookback_short[2], calc = "rogers.satchell") 59 | #p: Parkinson volatility 60 | vol_p_L <- volatility(data_signal1, n = lookback_long[3], calc = "parkinson") 61 | vol_p_ML <- volatility(data_signal1, n = lookback_medlong[3], calc = "parkinson") 62 | vol_p_MS <- volatility(data_signal1, n = lookback_medshort[3], calc = "parkinson") 63 | vol_p_S <- volatility(data_signal1, n = lookback_short[3], calc = "parkinson") 64 | #gkyz: Garman-Klass Yang-Zhang volatility 65 | vol_gkyz_L <- volatility(data_signal1, n = lookback_long[4], calc = "gk.yz") 66 | vol_gkyz_ML <- volatility(data_signal1, n = lookback_medlong[4], calc = "gk.yz") 67 | vol_gkyz_MS <- volatility(data_signal1, n = lookback_medshort[4], calc = "gk.yz") 68 | vol_gkyz_S <- volatility(data_signal1, n = lookback_short[4], calc = "gk.yz") 69 | 70 | #natr: normalized Average True Range volatility 71 | natr_L <- ATR(data_signal1, n=lookback_long[5], maType="ZLEMA")[ , "atr"] / prices_signal1Cl 72 | natr_ML <- ATR(data_signal1, n=lookback_medlong[5], maType="ZLEMA")[ , "atr"] / prices_signal1Cl 73 | natr_MS <- ATR(data_signal1, n=lookback_medshort[5], maType="ZLEMA")[ , "atr"] / prices_signal1Cl 74 | natr_S <- ATR(data_signal1, n=lookback_short[5], maType="ZLEMA")[ , "atr"] / prices_signal1Cl 75 | 76 | #strategy volatility thresholds, randomized 77 | vthresh <- runif(16, min = 0.12, max = 0.17) #low threshold for volatility measures 78 | lthresh <- runif(4, min = 0.010, max = 0.015) #low threshold for nATR 79 | 80 | #calculate the Vol signals 81 | sig_cc_L <- ifelse(vol_cc_L < vthresh[1], 1, 0) 82 | sig_cc_ML <- ifelse(vol_cc_ML < vthresh[2], 1, 0) 83 | sig_cc_MS <- ifelse(vol_cc_MS < vthresh[3], 1, 0) 84 | sig_cc_S <- ifelse(vol_cc_S < vthresh[4], 1, 0) 85 | sig_rs_L <- ifelse(vol_rs_L < vthresh[5], 1, 0) 86 | sig_rs_ML <- ifelse(vol_rs_ML < vthresh[6], 1, 0) 87 | sig_rs_MS <- ifelse(vol_rs_MS < vthresh[7], 1, 0) 88 | sig_rs_S <- ifelse(vol_rs_S < vthresh[8], 1, 0) 89 | sig_p_L <- ifelse(vol_p_L < vthresh[9], 1, 0) 90 | sig_p_ML <- ifelse(vol_p_ML < vthresh[10], 1, 0) 91 | sig_p_MS <- ifelse(vol_p_MS < vthresh[11], 1, 0) 92 | sig_p_S <- ifelse(vol_p_S < vthresh[12], 1, 0) 93 | sig_gkyz_L <- ifelse(vol_gkyz_L < vthresh[13], 1, 0) 94 | sig_gkyz_ML <- ifelse(vol_gkyz_ML < vthresh[14], 1, 0) 95 | sig_gkyz_MS <- ifelse(vol_gkyz_MS < vthresh[15], 1, 0) 96 | sig_gkyz_S <- ifelse(vol_gkyz_S < vthresh[16], 1, 0) 97 | 98 | sig_natr_L <- ifelse(natr_L < lthresh[1], 1, 0) 99 | sig_natr_ML <- ifelse(natr_ML < lthresh[2], 1, 0) 100 | sig_natr_MS <- ifelse(natr_MS < lthresh[3], 1, 0) 101 | sig_natr_S <- ifelse(natr_S < lthresh[4], 1, 0) 102 | 103 | #add up the signals 104 | totalvol <- ( 105 | + sig_cc_L 106 | + sig_cc_ML 107 | + sig_cc_MS 108 | + sig_cc_S 109 | + sig_rs_L 110 | + sig_rs_ML 111 | + sig_rs_MS 112 | + sig_rs_S 113 | + sig_p_L 114 | + sig_p_ML 115 | + sig_p_MS 116 | + sig_p_S 117 | + sig_gkyz_L 118 | + sig_gkyz_ML 119 | + sig_gkyz_MS 120 | + sig_gkyz_S 121 | ) 122 | 123 | totalnatr <- ( 124 | + sig_natr_L 125 | + sig_natr_ML 126 | + sig_natr_MS 127 | + sig_natr_S 128 | ) 129 | 130 | #combine the signals 131 | #look for any positive signal (ie, 1. or increase this threshold count up to 20) 132 | signal_1 <- ifelse(totalvol + totalnatr >= 1, 1, 0) 133 | signal_1[is.na(signal_1)] <- 0 134 | label_strategy1 <- "Strategy 1: Multivol 5" 135 | 136 | signal_2 <- ifelse( !signal_1, 1, 0) 137 | signal_2[is.na(signal_2)] <- 0 138 | label_strategy2 <- "Strategy 2: Short MV5 (inverse Multvol 5)" 139 | 140 | # don't use signal_3 here 141 | #signal_3 <- ifelse(totalvol >= 1, 1, 0) 142 | #signal_3[is.na(signal_3)] <- 0 143 | label_strategy3 <- "Strategy 3: Multivol 5 Long/Short " 144 | 145 | # Step 4: Backtest the strategies 146 | returns_strategy1 <- roc_trade1 * stats::lag(signal_1, 2) 147 | returns_strategy1 <- na.omit(returns_strategy1) 148 | returns_strategy2 <- roc_trade2 * stats::lag(signal_2, 2) 149 | returns_strategy2 <- na.omit(returns_strategy2) 150 | # MV5 L/S combines Strategy_1 + _2 151 | returns_strategy3 <- returns_strategy1 + returns_strategy2 152 | returns_strategy3 <- na.omit(returns_strategy3) 153 | 154 | # Calculate Benchmark 1&2 returns 155 | returns_benchmark1 <- stats::lag(roc_benchmark1, 0) 156 | returns_benchmark1 <- na.omit(returns_benchmark1) 157 | label_benchmark1 <- "Benchmark SPY total return" 158 | returns_benchmark2 <- stats::lag(roc_benchmark2, 0) 159 | returns_benchmark2 <- na.omit(returns_benchmark2) 160 | label_benchmark2 <- "Benchmark 2: SPY Open-Open, no divvies" 161 | 162 | # Step 5: Evaluate performance and risk metrics 163 | # add an "exposure" metric (informative, not evaluative) 164 | exposure <- function(vec){ sum(vec != 0) / length(vec) } 165 | 166 | comparison <- cbind(returns_benchmark1, returns_benchmark2, returns_strategy1, returns_strategy2, returns_strategy3) 167 | colnames(comparison) <- c(label_benchmark1, label_benchmark2, label_strategy1, label_strategy2, label_strategy3) 168 | stats_rv <- rbind(table.AnnualizedReturns(comparison), maxDrawdown(comparison)) 169 | charts.PerformanceSummary(comparison, main = "Realized Vol Strategies vs S&P 500 Benchmark") 170 | 171 | #print exposure to console in R Studio 172 | exposure_s1 <- exposure(returns_strategy1) 173 | exposure_s2 <- exposure(returns_strategy2) 174 | exposure_s3 <- exposure(returns_strategy3) 175 | print( paste("Exposure for Strategy 1:", exposure_s1) ) 176 | print( paste("Exposure for Strategy 2:", exposure_s2) ) 177 | print( paste("Exposure for Strategy 3:", exposure_s3) ) 178 | 179 | #Step 6: generate/plot 20 Multivol 5 equity curves at once 180 | comparison3 <- as.xts(returns_benchmark1) 181 | for(s in 1:20){ 182 | #repeat signal generation within the loop... 183 | #lookback periods randomized 184 | lookback_long <- floor(runif(5, min = 20, max = 25)) 185 | lookback_medlong <- floor(runif(5, min = 14, max = 19)) 186 | lookback_medshort <- floor(runif(5, min = 9, max = 13)) 187 | lookback_short <- floor(runif(5, min = 4, max = 8)) 188 | 189 | #calculate all five volatility measures across 4 lookback ranges (12) 190 | #cc: Close-to-Close volatility 191 | vol_cc_L <- volatility(data_signal1, n = lookback_long[1], calc = "close") 192 | vol_cc_ML <- volatility(data_signal1, n = lookback_medlong[1], calc = "close") 193 | vol_cc_MS <- volatility(data_signal1, n = lookback_medshort[1], calc = "close") 194 | vol_cc_S <- volatility(data_signal1, n = lookback_short[1], calc = "close") 195 | #rs: Rogers-Satchell volatility 196 | vol_rs_L <- volatility(data_signal1, n = lookback_long[2], calc = "rogers.satchell") 197 | vol_rs_ML <- volatility(data_signal1, n = lookback_medlong[2], calc = "rogers.satchell") 198 | vol_rs_MS <- volatility(data_signal1, n = lookback_medshort[2], calc = "rogers.satchell") 199 | vol_rs_S <- volatility(data_signal1, n = lookback_short[2], calc = "rogers.satchell") 200 | #p: Parkinson volatility 201 | vol_p_L <- volatility(data_signal1, n = lookback_long[3], calc = "parkinson") 202 | vol_p_ML <- volatility(data_signal1, n = lookback_medlong[3], calc = "parkinson") 203 | vol_p_MS <- volatility(data_signal1, n = lookback_medshort[3], calc = "parkinson") 204 | vol_p_S <- volatility(data_signal1, n = lookback_short[3], calc = "parkinson") 205 | #gkyz: Garman-Klass Yang-Zhang volatility 206 | vol_gkyz_L <- volatility(data_signal1, n = lookback_long[4], calc = "gk.yz") 207 | vol_gkyz_ML <- volatility(data_signal1, n = lookback_medlong[4], calc = "gk.yz") 208 | vol_gkyz_MS <- volatility(data_signal1, n = lookback_medshort[4], calc = "gk.yz") 209 | vol_gkyz_S <- volatility(data_signal1, n = lookback_short[4], calc = "gk.yz") 210 | 211 | #natr: normalized Average True Range volatility 212 | natr_L <- ATR(data_signal1, n=lookback_long[5], maType="ZLEMA")[ , "atr"] / prices_signal1Cl 213 | natr_ML <- ATR(data_signal1, n=lookback_medlong[5], maType="ZLEMA")[ , "atr"] / prices_signal1Cl 214 | natr_MS <- ATR(data_signal1, n=lookback_medshort[5], maType="ZLEMA")[ , "atr"] / prices_signal1Cl 215 | natr_S <- ATR(data_signal1, n=lookback_short[5], maType="ZLEMA")[ , "atr"] / prices_signal1Cl 216 | 217 | #strategy volatility thresholds, randomized 218 | vthresh <- runif(16, min = 0.12, max = 0.17) #low threshold for volatility measures 219 | lthresh <- runif(4, min = 0.010, max = 0.015) #low threshold for nATR 220 | 221 | #calculate the Vol signals 222 | sig_cc_L <- ifelse(vol_cc_L < vthresh[1], 1, 0) 223 | sig_cc_ML <- ifelse(vol_cc_ML < vthresh[2], 1, 0) 224 | sig_cc_MS <- ifelse(vol_cc_MS < vthresh[3], 1, 0) 225 | sig_cc_S <- ifelse(vol_cc_S < vthresh[4], 1, 0) 226 | sig_rs_L <- ifelse(vol_rs_L < vthresh[5], 1, 0) 227 | sig_rs_ML <- ifelse(vol_rs_ML < vthresh[6], 1, 0) 228 | sig_rs_MS <- ifelse(vol_rs_MS < vthresh[7], 1, 0) 229 | sig_rs_S <- ifelse(vol_rs_S < vthresh[8], 1, 0) 230 | sig_p_L <- ifelse(vol_p_L < vthresh[9], 1, 0) 231 | sig_p_ML <- ifelse(vol_p_ML < vthresh[10], 1, 0) 232 | sig_p_MS <- ifelse(vol_p_MS < vthresh[11], 1, 0) 233 | sig_p_S <- ifelse(vol_p_S < vthresh[12], 1, 0) 234 | sig_gkyz_L <- ifelse(vol_gkyz_L < vthresh[13], 1, 0) 235 | sig_gkyz_ML <- ifelse(vol_gkyz_ML < vthresh[14], 1, 0) 236 | sig_gkyz_MS <- ifelse(vol_gkyz_MS < vthresh[15], 1, 0) 237 | sig_gkyz_S <- ifelse(vol_gkyz_S < vthresh[16], 1, 0) 238 | 239 | sig_natr_L <- ifelse(natr_L < lthresh[1], 1, 0) 240 | sig_natr_ML <- ifelse(natr_ML < lthresh[2], 1, 0) 241 | sig_natr_MS <- ifelse(natr_MS < lthresh[3], 1, 0) 242 | sig_natr_S <- ifelse(natr_S < lthresh[4], 1, 0) 243 | 244 | #add up the signals 245 | totalvol <- ( 246 | + sig_cc_L 247 | + sig_cc_ML 248 | + sig_cc_MS 249 | + sig_cc_S 250 | + sig_rs_L 251 | + sig_rs_ML 252 | + sig_rs_MS 253 | + sig_rs_S 254 | + sig_p_L 255 | + sig_p_ML 256 | + sig_p_MS 257 | + sig_p_S 258 | + sig_gkyz_L 259 | + sig_gkyz_ML 260 | + sig_gkyz_MS 261 | + sig_gkyz_S 262 | ) 263 | 264 | totalnatr <- ( 265 | + sig_natr_L 266 | + sig_natr_ML 267 | + sig_natr_MS 268 | + sig_natr_S 269 | ) 270 | 271 | #look for any positive signal (or increase this threshold up to 20) 272 | #signal_2 <- ifelse(totalnatr >= 1, 1, 0) #only nATR 273 | #signal_2 <- ifelse(totalvol >= 1, 1, 0) #Multivol without nATR 274 | signal_2 <- ifelse(totalvol + totalnatr >= 1, 1, 0) #Multivol 5 with nATR 275 | signal_2[is.na(signal_2)] <- 0 276 | signal_2inv <- ifelse( !signal_2 , 1, 0) #Multivol 5 inverse 277 | signal_2inv[is.na(signal_2inv)] <- 0 278 | 279 | # Step 4: Backtest the strategies 280 | returns_strategy2 <- roc_trade1 * stats::lag(signal_2, 2) 281 | returns_strategy2 <- na.omit(returns_strategy2) 282 | returns_strategy2inv <- roc_trade2 * stats::lag(signal_2inv, 2) 283 | returns_strategy2inv <- na.omit(returns_strategy2inv) 284 | returns_strategy2LS <- returns_strategy2 + returns_strategy2inv 285 | returns_strategy2LS <- na.omit(returns_strategy2LS) 286 | 287 | #rtns <- returns_strategy2 # MV5 288 | rtns <- returns_strategy2LS #MV5 L/S 289 | #rtns <- returns_strategy2inv #MV5 inv (short SPY) 290 | comparison3 <- cbind(comparison3, rtns) 291 | print( exposure(rtns)) 292 | 293 | } 294 | charts.PerformanceSummary(comparison3, main = "Random RV Strategies vs S&P 500 Benchmark") 295 | #comment out the "stats_rv5" line below to improve speed of script 296 | # at the expense of not having comprehensive stats to view 297 | stats_rv5 <- rbind(table.AnnualizedReturns(comparison3), maxDrawdown(comparison3)) 298 | -------------------------------------------------------------------------------- /quant_rv_2.0.0.R: -------------------------------------------------------------------------------- 1 | ### quant_rv v2.0.0 by babbage9010 and friends 2 | ### released under MIT License 3 | # quant_rv 2.0.0 new code base 4 | # 1: builds matrices (XTS) of volatilities and signals once that 5 | # store in environment for faster model idea testing 6 | # 2: can use all the signals (2000+) or a subset (randomized or manual) 7 | 8 | ### Step 1: Load necessary libraries and data 9 | library(quantmod) 10 | library(PerformanceAnalytics) 11 | library(dplyr) 12 | 13 | date_start <- as.Date("1992-03-01") 14 | date_end <- as.Date("2033-12-31") 15 | symbol_benchmark1 <- "SPY" # benchmark for comparison 16 | symbol_signal1 <- "SPY" # S&P 500 symbol (use SPY or ^GSPC) 17 | symbol_trade1 <- "SPY" # ETF to trade 18 | symbol_trade2 <- "SPY" # -1x ETF to trade. in real life use SH 19 | 20 | ### reloadall == TRUE is to rebuild the VOL and SIG matrices 21 | ### when changing lookback & threshold vectors 22 | ### FWIW, I just leave it FALSE and empty my environment if I want 23 | ### to rebuild the matrices 24 | reloadall <- FALSE | !exists("data_benchmark1") 25 | if(reloadall){ 26 | data_benchmark1 <- getSymbols(symbol_benchmark1, src = "yahoo", from = date_start, to = date_end, auto.assign = FALSE) 27 | data_signal1 <- getSymbols(symbol_signal1, src = "yahoo", from = date_start, to = date_end, auto.assign = FALSE) 28 | data_trade1 <- getSymbols(symbol_trade1, src = "yahoo", from = date_start, to = date_end, auto.assign = FALSE) 29 | data_trade2 <- getSymbols(symbol_trade2, src = "yahoo", from = date_start, to = date_end, auto.assign = FALSE) 30 | prices_benchmark1 <- Ad(data_benchmark1) #Adjusted(Ad) for the #1 benchmark 31 | prices_benchmark2 <- Op(data_benchmark1) #Open(Op) for the #2 benchmark 32 | prices_signal1 <- Ad(data_signal1) #Adjusted(Ad) for the signal (realized vol) 33 | prices_trade1 <- Op(data_trade1) #Open(Op) for our trading 34 | prices_trade2 <- Op(data_trade2) #Open(Op) for our trading 35 | prices_signal1Cl <- Cl(data_signal1) #Close(Cl) for the ATR normalization 36 | } 37 | 38 | ### Step 2: Calculate ROC series 39 | roc_signal1 <- ROC(prices_signal1, n = 1, type = "discrete") 40 | roc_benchmark1 <- ROC(prices_benchmark1, n = 1, type = "discrete") 41 | roc_benchmark2 <- ROC(prices_benchmark2, n = 1, type = "discrete") 42 | roc_trade1 <- ROC(prices_trade1, n = 1, type = "discrete") 43 | 44 | #HACK! SH not available in olden times, so use -1x SPY 45 | roc_trade2 <- -1 * ROC(prices_trade1, n = 1, type = "discrete") 46 | 47 | 48 | # Step 3: Function for building the volatility signals 49 | # we're using five measures of volatility with four lookback periods 50 | 51 | ### first, calculate the volatility parameter space as a big XTS 52 | calc_vols <- function(volmeas, lookbacks){ 53 | ### calculates volatilities for all the vol measures + lookbacks 54 | numvolmeas <- length(volmeas) #number of vol measures (5) 55 | numlbs <- length(lookbacks) 56 | xts_vols <- as.xts(data_signal1[,"SPY.Adjusted"]) 57 | numvols <- numvolmeas*numlbs 58 | volnames <- c(1:numvols) 59 | nas <- xts(matrix(NA,nrow(xts_vols),length(volnames)), 60 | index(xts_vols), dimnames=list(NULL,volnames)) 61 | xts_vols <- merge(xts_vols, nas) 62 | print(paste("vrows",nrow(xts_vols),"vcols",ncol(xts_vols))) 63 | vidx <- 0 64 | for(vv in volmeas){ 65 | #print(paste("vv",vv,"vidx",vidx)) 66 | if(vv != "natr"){ 67 | for(nn in 1:numlbs){ 68 | #print(paste("nn",nn,"v+n",vidx+nn,"lb",lookbacks[nn])) 69 | xts_vols[,1+vidx+nn] <- volatility(data_signal1, n = lookbacks[nn], calc = vv) 70 | } 71 | } else { 72 | for(nn in 1:numlbs){ 73 | #print(paste("nn",nn,"v+n",vidx+nn,"lb",lookbacks[nn])) 74 | xts_vols[,1+vidx+nn] <- ATR(data_signal1, n=lookbacks[nn], maType="ZLEMA")[ , "atr"] / prices_signal1Cl 75 | } 76 | } 77 | vidx <- vidx + numlbs 78 | } 79 | return(xts_vols) 80 | } 81 | 82 | ### second, calc the vol signals with a sequence of thresholds, store as XTS 83 | calc_sigs <- function(volmeas, lookbacks, thevols, vthresh, lthresh){ 84 | ### calculates all the signals: loop volmeasures, then lookbacks, then thresholds 85 | xts_sigs <- as.xts(data_signal1[,"SPY.Adjusted"]) 86 | numlbs <- length(lookbacks) 87 | numthresholds <- length(vthresh) 88 | numvols <- ncol(thevols) - 1 89 | numsigs <- numvols * numthresholds 90 | print(paste("nl",numlbs,"nt",numthresholds,"nv",numvols,"ns",numsigs)) 91 | siggnames <- c(1:numsigs) 92 | nas <- xts(matrix(NA,nrow(xts_sigs),length(siggnames)), 93 | index(xts_sigs), dimnames=list(NULL,siggnames)) 94 | xts_sigs <- merge(xts_sigs, nas) 95 | print(paste("vrows",nrow(xts_sigs),"vcols",ncol(xts_sigs))) 96 | 97 | ### make a matrix of sig references (which vol,lb,th for each sig) 98 | vidx <- 0 99 | sidx <- 0 100 | for(vv in volmeas){ 101 | print(paste("vv",vv,"vidx",vidx)) 102 | if(vv != "natr"){ 103 | for(nn in 1:numlbs){ 104 | #print(paste("nn",nn)) 105 | for(tt in 1:numthresholds){ 106 | #calc sig here 107 | #print(paste("tt",tt,"s+n+t",sidx+nn+tt,"whichvol",1+vidx+nn)) 108 | xts_sigs[,sidx+nn+tt] <- ifelse( thevols[,1+vidx+nn] < vthresh[tt], 1, 0) 109 | } 110 | sidx <- sidx + numthresholds - 1 111 | } 112 | sidx <- sidx + numlbs #4? is it numthresholds-1? or? 113 | } else { # only natr 114 | for(nn in 1:numlbs){ 115 | #print(paste("nn",nn)) 116 | for(tt in 1:numthresholds){ 117 | #calc sig here 118 | #print(paste("tt",tt,"s+n+t",sidx+nn+tt,"whichvol",1+vidx+nn)) 119 | xts_sigs[,sidx+nn+tt] <- ifelse( thevols[,1+vidx+nn] < lthresh[tt], 1, 0) 120 | } 121 | sidx <- sidx + numthresholds - 1 122 | } 123 | } 124 | vidx <- vidx + numlbs 125 | } 126 | return(xts_sigs) 127 | } 128 | 129 | ### third, calculate the signal totals for each trading day 130 | calc_sigtotal <- function(thesigs,sbst=c(0)){ 131 | ### calculate the allvol or selvol, total of positive signals 132 | ### thesigs includes a reference column of SPY values 133 | ### get rid of it for this 134 | ### sbst is a list, an optional subset of column numbers to sum sig totals across 135 | ### default is to use ALL signals available (allvol) 136 | numsigcols <- ncol(thesigs) 137 | allthesigs <- thesigs[,2:numsigcols] 138 | if(sbst[1] == 0){ 139 | therealsigs <- allthesigs 140 | } else { 141 | therealsigs <- allthesigs[,sbst] 142 | } 143 | #siggs is our signal totals to be returned as a 1 col xts object 144 | siggs <- as.xts(data_signal1[,"SPY.Adjusted"]) #match it to SPY for index 145 | sums <- xts(rowSums(therealsigs, na.rm=TRUE), index(siggs)) 146 | siggs[,1] <- sums #replace prices in siggs with signal sums 147 | return( siggs ) 148 | } 149 | 150 | ### finally, set up the vthresh and lthresh sequences 151 | ### then call the function(s) above 152 | 153 | ### vthresh and lthresh are the threshold values for signal generation 154 | ### length(vthresh) must == length(lthresh) to work right 155 | ### vthresh = thresholds for the four volatility measures 156 | #vthresh3 <- seq(0.13, 0.22, by=0.01) #lower res sampling 157 | #vthresh3 <- seq(0.13, 0.22, by=0.005) #medium res sampling 158 | vthresh3 <- seq(0.13, 0.22, by=0.0025) #high res sampling 159 | 160 | ### lthresh = thresholds for the NATR vol-like measure 161 | #lthresh3 <- seq(0.006, 0.015, by=0.00025) #lower res sampling 162 | #lthresh3 <- seq(0.006, 0.015, by=0.00025) #medium res sampling 163 | lthresh3 <- seq(0.006, 0.015, by=0.00025) #high res sampling 164 | 165 | 166 | ### lookback period in days 167 | lookbacks <- seq(4, 25, by=1) 168 | 169 | ### parameter names for the volatility measures in calc_vols 170 | volmeasures <- c("close","rogers.satchell","parkinson","gk.yz","natr") #vol measures 171 | 172 | ### calculate volatility measures and signal candidates 173 | if(reloadall){ 174 | x_allvols <- calc_vols(volmeasures, lookbacks) 175 | x_allsigs <- calc_sigs(volmeasures, lookbacks, x_allvols, vthresh3, lthresh3) 176 | } 177 | 178 | ### add up the signals 179 | ### either use ALL the signals (don't send a subset list) 180 | ### allvol is used in the strategy as the signal measure of low vol 181 | allvol <- calc_sigtotal(x_allsigs) 182 | 183 | ### or use a select (or random) subset of the signals 184 | ### example: selectsigs <- c(99,299,499,699,899,999) 185 | ### where each element is a column number in the signals matrix 186 | 187 | ### or use a random selection of signals 188 | num_random_sigs <- 20 #best to use a multiple of 5 (5 vol measures) 189 | numvol_all <- ncol(x_allsigs)-1 190 | #selectsigs <- floor(runif(num_random_sigs,min=1,max=numvol_all)) 191 | #comment out the selectsigs line you DON'T want to use 192 | 193 | ### or this routine makes sure to select equally among the five vol measures 194 | num_rnd_sigs_per_vm <- floor(num_random_sigs/5) #number of random sigs per vol measure 195 | numpervm <- numvol_all/5 196 | sigs_cc <- floor(runif(num_rnd_sigs_per_vm,min=1,max=numpervm)) #close-close 197 | sigs_rs <- floor(runif(num_rnd_sigs_per_vm,min=numpervm+1,max=2*numpervm)) #rogers-satchell 198 | sigs_pk <- floor(runif(num_rnd_sigs_per_vm,min=2*numpervm+1,max=3*numpervm)) #parkinson 199 | sigs_yz <- floor(runif(num_rnd_sigs_per_vm,min=3*numpervm+1,max=4*numpervm)) #yang-zhang 200 | sigs_tr <- floor(runif(num_rnd_sigs_per_vm,min=4*numpervm+1,max=numvol_all)) #natr 201 | selectsigs <- cbind(sigs_cc, sigs_rs, sigs_pk, sigs_yz, sigs_tr) 202 | #comment out the selectsigs line you DON'T want to use 203 | 204 | ### selvol == select vol signals, as opposed to all vol signals 205 | selvol <- calc_sigtotal(x_allsigs,selectsigs) 206 | 207 | ### print out the current selectsigs to the console 208 | ### can be used to replicate select runs 209 | ### just copy/paste from console and then 210 | ### set `selectsigs <- c(your sigs)` just above `selvol` in code 211 | #print(paste("c(",toString(selectsigs),")"),sep="") 212 | 213 | ### sdp is the date range to use for stats and plotting 214 | sdp <- "2006-07-31/2019-12-31" # sdp = start date for plotting 215 | 216 | 217 | ### Strategy logic 218 | 219 | # thr: how many positive low vol signals does it take to go long? 220 | # This strat uses selvol (selectsigs random subset) 221 | thr1 <- 1 222 | # thr == 1 works fine if only 20 signals (selectsigs) are used 223 | signal_1 <- ifelse(selvol >= thr1, 1, 0) #only 1 signal needed 224 | signal_1[is.na(signal_1)] <- 0 225 | label_strategy1 <- "Strategy 1: MV5 original (20 sigs, thr == 1)" 226 | 227 | # try setting thr2 higher when using more signals 228 | # e.g. try ~90-110 for all 4070 signals, ~30-60 for 2000 sigs, ~10-15 for 500, etc 229 | thr2 <- 100 #floor(runif(1,min=90,max=110)) #random signal thr from range 230 | signal_2 <- ifelse(allvol >= thr2, 1, 0) #allvol uses all the vol signals 231 | #signal_2 <- ifelse(selvol >= thr2, 1, 0) #selvol uses subset of vol sigs 232 | signal_2[is.na(signal_2)] <- 0 233 | label_strategy2 <- "Strategy 2: MV5_big" 234 | 235 | #signal_3 inverse MV5_2k 236 | signal_3 <- ifelse(allvol < thr2, 1, 0) 237 | signal_3[is.na(signal_3)] <- 0 238 | label_strategy3 <- "Strategy 3: Short MV5_big (inverse)" 239 | label_strategy4 <- "Strategy 4: L/S MV5_big (S2+S3)" 240 | 241 | 242 | 243 | # Step 4: Backtest the strategies 244 | returns_strategy1 <- roc_trade1 * stats::lag(signal_1, 2) 245 | returns_strategy1 <- na.omit(returns_strategy1) 246 | returns_strategy2 <- roc_trade1 * stats::lag(signal_2, 2) 247 | returns_strategy2 <- na.omit(returns_strategy2) 248 | 249 | # MV5 inverse uses -1x SPY (here as roc_trade2) 250 | returns_strategy3 <- roc_trade2 * stats::lag(signal_3, 2) 251 | returns_strategy3 <- na.omit(returns_strategy3) 252 | 253 | # MV5 L/S combines Strategy_1 + _2 254 | returns_strategy4 <- returns_strategy2 + returns_strategy3 255 | 256 | # Calculate Benchmark 1&2 returns 257 | returns_benchmark1 <- stats::lag(roc_benchmark1, 0) 258 | returns_benchmark1 <- na.omit(returns_benchmark1) 259 | label_benchmark1 <- "Benchmark SPY total return" 260 | returns_benchmark2 <- stats::lag(roc_benchmark2, 0) 261 | returns_benchmark2 <- na.omit(returns_benchmark2) 262 | label_benchmark2 <- "Benchmark 2: SPY Open-Open, no divvies" 263 | 264 | 265 | # Step 5: Evaluate performance and risk metrics 266 | 267 | #1 = MV5 original vs SPY total return and SPY open-open no dividends 268 | comparison1 <- cbind(returns_benchmark1, returns_benchmark2, returns_strategy1) 269 | colnames(comparison1) <- c(label_benchmark1, label_benchmark2, label_strategy1) 270 | 271 | #2 = MV5 original vs MV5_big vs SPY total return 272 | comparison2 <- cbind(returns_benchmark1, returns_strategy1, returns_strategy2) 273 | colnames(comparison2) <- c(label_benchmark1, label_strategy1, label_strategy2) 274 | 275 | #3 = MV5 original vs MV5_big vs MV5_big_inverse vs MV5_big_LS_combined 276 | comparison3 <- cbind(returns_benchmark1, returns_strategy1, returns_strategy2, returns_strategy3, returns_strategy4) 277 | colnames(comparison3) <- c(label_benchmark1, label_strategy1, label_strategy2, label_strategy3, label_strategy4) 278 | 279 | ### use comp to choose which comparison to display 280 | comp <- comparison3 281 | stats_rv <- rbind(table.AnnualizedReturns(comp[sdp]), maxDrawdown(comp[sdp])) 282 | charts.PerformanceSummary(comp[sdp], main = "quant_rv strategies vs SPY total return Benchmark") 283 | 284 | ### add an "exposure" metric (informative, not strictly correct) 285 | exposure <- function(vec){ sum(vec != 0) / length(vec) * 100 } 286 | ### and a couple more metrics 287 | winPercent <- function(vec){ 288 | s <- sum(vec > 0) 289 | s / (s + sum(vec < 0)) * 100 290 | } 291 | avgWin <- function(vec){ 292 | aw <- mean( na.omit(ifelse(vec>0,vec,NA))) 293 | return( aw * 100 ) 294 | } 295 | avgLoss <- function(vec){ 296 | al <- mean( na.omit(ifelse(vec<0,vec,NA))) 297 | return( al * 100 ) 298 | } 299 | extraStats <- function(vec){ 300 | ex <- exposure(vec) 301 | aw <- avgWin(vec) 302 | al <- avgLoss(vec) 303 | wp <- winPercent(vec) 304 | wl <- -(aw/al) 305 | return( paste("exp_%:", round(ex,2), " win_%:", round(wp, 2), " avgWin:", round(aw,3), " avgLoss:", round(al,3), "w/l:", round(wl, 3)) ) 306 | } 307 | 308 | print( paste("B1 -", extraStats(returns_benchmark1[sdp]) )) 309 | print( paste("B2 -", extraStats(returns_benchmark2[sdp]) )) 310 | print( paste("S1 -", extraStats(returns_strategy1[sdp]) )) 311 | print( paste("S2 -", extraStats(returns_strategy2[sdp]) )) 312 | print( paste("S3 -", extraStats(returns_strategy3[sdp]) )) 313 | print( paste("S4 -", extraStats(returns_strategy4[sdp]) )) 314 | -------------------------------------------------------------------------------- /replacing-the-40.R: -------------------------------------------------------------------------------- 1 | ### replacing-the-40.R by babbage9010 and friends 2 | ### released under MIT License 3 | # see https://returnsources.com/f/replacing-the-40 by Elliot Rozner 4 | # description:models a 60/40 portfolio using SPY/IEF and then 5 | # substitutes a simple L/S trend following portfolio for the 40% IEF portion 6 | # and then riffs on that theme a bit 7 | # originally published Feb 4 2024 8 | 9 | # Step 1: Load necessary libraries and data 10 | library(quantmod) 11 | library(PerformanceAnalytics) 12 | 13 | #dates and symbols for gathering data 14 | date_start <- as.Date("2002-07-22") #start of IEF 15 | date_end <- as.Date("2034-12-31") #a date in the future 16 | symbol_benchmark1 <- "SPY" # benchmark for comparison 17 | symbol_benchmark2 <- "IEF" # benchmark for comparison 18 | symbol_signal1 <- "SPY" # S&P 500 symbol 19 | symbol_trade1 <- "SPY" # equity ETF to trade 20 | symbol_trade2 <- "IEF" # bond ETF to trade 21 | 22 | #get data from yahoo 23 | data_benchmark1 <- getSymbols(symbol_benchmark1, src = "yahoo", from = date_start, to = date_end, auto.assign = FALSE) 24 | data_benchmark2 <- getSymbols(symbol_benchmark2, src = "yahoo", from = date_start, to = date_end, auto.assign = FALSE) 25 | data_signal1 <- getSymbols(symbol_signal1, src = "yahoo", from = date_start, to = date_end, auto.assign = FALSE) 26 | data_trade1 <- getSymbols(symbol_trade1, src = "yahoo", from = date_start, to = date_end, auto.assign = FALSE) 27 | data_trade2 <- getSymbols(symbol_trade2, src = "yahoo", from = date_start, to = date_end, auto.assign = FALSE) 28 | 29 | #use these prices 30 | prices_benchmark1 <- Ad(data_benchmark1) #Adjusted(Ad) for the #1 benchmark 31 | prices_benchmark2 <- Ad(data_benchmark2) #Adjusted(Ad) for the #2 benchmark 32 | prices_signal1 <- Ad(data_signal1) #Adjusted(Ad) for the signal 33 | prices_trade1 <- Ad(data_trade1) #Ad for our trading 34 | prices_trade2 <- Ad(data_trade2) #Ad for our trading 35 | 36 | #calculate 1 day returns (rate of change) 37 | roc_benchmark1 <- ROC(prices_benchmark1, n = 1, type = "discrete") 38 | roc_benchmark2 <- ROC(prices_benchmark2, n = 1, type = "discrete") 39 | roc_signal1 <- ROC(prices_signal1, n = 1, type = "discrete") 40 | roc_trade1 <- ROC(prices_trade1, n = 1, type = "discrete") 41 | roc_trade2 <- ROC(prices_trade2, n = 1, type = "discrete") 42 | 43 | # signal_1: the trend following strategy (per Elroz) 44 | spy8 <- SMA(prices_signal1, 8) 45 | spy16 <- SMA(prices_signal1, 16) 46 | spy32 <- SMA(prices_signal1, 32) 47 | spy64 <- SMA(prices_signal1, 64) 48 | spy128 <- SMA(prices_signal1, 128) 49 | spy256 <- SMA(prices_signal1, 256) 50 | ma_8_32 <- ifelse(spy8 >= spy32, 1, 0) 51 | ma_8_32[is.na(ma_8_32)] <- 0 52 | ma_16_64 <- ifelse(spy16 >= spy64, 1, 0) 53 | ma_16_64[is.na(ma_16_64)] <- 0 54 | ma_32_128 <- ifelse(spy32 >= spy128, 1, 0) 55 | ma_32_128[is.na(ma_32_128)] <- 0 56 | ma_64_256 <- ifelse(spy64 >= spy256, 1, 0) 57 | ma_64_256[is.na(ma_64_256)] <- 0 58 | sums <- ma_8_32 + ma_16_64 + ma_32_128 + ma_64_256 59 | signal_1 <- ifelse(sums == 4, 1, ifelse(sums == 3, 0.5, ifelse(sums == 2, 0, ifelse(sums == 1, -0.5, -1)))) 60 | returns_strategy1 <- roc_trade1 * stats::lag(signal_1, 2) 61 | returns_strategy1 <- na.omit(returns_strategy1) 62 | label_strategy1 <- "Trend portion of Replacing the 40" 63 | 64 | # signal_2: variable trend following portion, instead of 40% 65 | #shrink - a parameter representing the percentage of trend following to allow in the 40 66 | shrink <- 0.75 # 1 = no shrink (100% trend), 0 = completely shrunken (zero) trend 67 | signal_2 <- ifelse(sums == 4, 1*shrink, ifelse(sums == 3, 0.5*shrink, ifelse(sums == 2, 0*shrink, ifelse(sums == 1, -0.5*shrink, -1*shrink)))) 68 | signal_2[is.na(signal_2)] <- 0 69 | returns_strategy2 <- roc_trade1 * stats::lag(signal_2, 2) 70 | returns_strategy2 <- na.omit(returns_strategy2) 71 | label_strategy2 <- paste("Trend portion of Rt40 with shrink:",shrink) 72 | 73 | # hole-filling component (IEF into the cash component left by trend following) 74 | # note: this model uses short ETF instead of shorting, so can't use short funds as cash like Elroz suggests 75 | signal_5 <- ifelse( signal_2 > -1 & signal_2 < 1, abs(1-signal_2), 0) 76 | signal_5[is.na(signal_5)] <- 0 77 | returns_strategy5 <- roc_trade2 * stats::lag(signal_5, 2) 78 | returns_strategy5 <- na.omit(returns_strategy5) 79 | label_strategy5 <- "Fill trend hole with IEF" 80 | 81 | #signals a-e represent the components of the trend following (sums = 4,3,2,1,0) 82 | signal_a <- ifelse(sums == 4, 1, 0) 83 | returns_strategy_a <- roc_trade1 * stats::lag(signal_a, 2) 84 | signal_b <- ifelse(sums == 3, 1, 0) 85 | returns_strategy_b <- roc_trade1 * stats::lag(signal_b, 2) 86 | signal_c <- ifelse(sums == 2, 1, 0) 87 | returns_strategy_c <- roc_trade1 * stats::lag(signal_c, 2) 88 | signal_d <- ifelse(sums == 1, 1, 0) 89 | returns_strategy_d <- roc_trade1 * stats::lag(signal_d, 2) 90 | signal_e <- ifelse(sums == 0, 1, 0) 91 | returns_strategy_e <- roc_trade1 * stats::lag(signal_e, 2) 92 | 93 | #calculate benchmark returns 94 | returns_benchmark1 <- stats::lag(roc_benchmark1, 0) 95 | returns_benchmark1 <- na.omit(returns_benchmark1) 96 | label_benchmark1 <- "Benchmark SPY total return" 97 | returns_benchmark2 <- stats::lag(roc_benchmark2, 0) 98 | returns_benchmark2 <- na.omit(returns_benchmark2) 99 | label_benchmark2 <- "Benchmark IEF total return" 100 | returns_benchmark3 <- 0.6*returns_benchmark1 + 0.4*returns_benchmark2 101 | returns_benchmark3 <- na.omit(returns_benchmark3) 102 | label_benchmark3 <- "Benchmark 60/40 total return" 103 | 104 | # Strategy 3: 60/40 with Rt40-elroz 105 | returns_strategy3 <- 0.6*returns_benchmark1 + 0.4*returns_strategy1 106 | returns_strategy3 <- na.omit(returns_strategy3) 107 | label_strategy3 <- "60/40 with Rt40-elroz" 108 | 109 | # Strategy 4: 60/40 with Rt40-babb+holefill 110 | returns_strategy4 <- 0.6*returns_benchmark1 + 0.4*returns_strategy2 + 0.4*returns_strategy5 111 | returns_strategy4 <- na.omit(returns_strategy4) 112 | label_strategy4 <- paste("60/40 with Rt40-babb+holefill :: ",shrink,"HF",sep="") 113 | 114 | 115 | 116 | 117 | #combine returns into one XTS object, add column names for ploting 118 | comparison <- cbind(returns_strategy1, returns_benchmark2) 119 | colnames(comparison) <- c(label_strategy1, label_benchmark2) 120 | comparison1 <- cbind(returns_strategy1, returns_benchmark2, returns_strategy3, returns_benchmark3) 121 | colnames(comparison1) <- c(label_strategy1, label_benchmark2, label_strategy3, label_benchmark3) 122 | comparison2 <- cbind(returns_strategy_a, returns_strategy_b, returns_strategy_c, returns_strategy_d, returns_strategy_e) 123 | colnames(comparison2) <- c("sum = 4 Bullish", "sum = 3", "sum = 2", "sum = 1", "sum = 0 Bearish") 124 | comparison3 <- cbind(returns_strategy4, returns_benchmark1, returns_strategy3, returns_benchmark3, returns_benchmark2, returns_strategy5) 125 | colnames(comparison3) <- c(label_strategy4, label_benchmark1, label_strategy3, label_benchmark3, label_benchmark2, label_strategy5) 126 | 127 | #default chart and stats: uses full data downloaded 128 | #charts.PerformanceSummary(comparison, main = "Golden Death Strategy vs S&P 500 Benchmark - default") 129 | #stats_default <- rbind(table.AnnualizedReturns(comparison), maxDrawdown(comparison)) 130 | 131 | #trimmed plot and stats 132 | # sdp = start date for plotting 133 | sdp <- "2003-07-31/" #start date for our plot in this blog post 134 | charts.PerformanceSummary(comparison[sdp], main = "Trend-following portion of Rt40 (Replacing the 40)") 135 | stats_gd <- rbind(table.AnnualizedReturns(comparison[sdp]), maxDrawdown(comparison[sdp])) 136 | charts.PerformanceSummary(comparison1[sdp], main = "Rt40 and components") 137 | stats_gd1 <- rbind(table.AnnualizedReturns(comparison1[sdp]), maxDrawdown(comparison1[sdp])) 138 | charts.PerformanceSummary(comparison2[sdp], main = "Rt40 Trend components (sum = 4,3,2,1,0)") 139 | stats_gd2 <- rbind(table.AnnualizedReturns(comparison2[sdp]), maxDrawdown(comparison2[sdp])) 140 | charts.PerformanceSummary(comparison3[sdp], main = "Rt40 strategy & benchmark comparisons") 141 | stats_gd3 <- rbind(table.AnnualizedReturns(comparison3[sdp]), maxDrawdown(comparison3[sdp])) 142 | 143 | ### add an "exposure" metric (informative, not strictly correct) 144 | exposure <- function(vec){ sum(vec != 0) / length(vec) * 100 } 145 | ### and a couple more metrics 146 | winPercent <- function(vec){ 147 | s <- sum(vec > 0) 148 | s / (s + sum(vec < 0)) * 100 149 | } 150 | avgWin <- function(vec){ 151 | aw <- mean( na.omit(ifelse(vec>0,vec,NA))) 152 | return( aw * 100 ) 153 | } 154 | avgLoss <- function(vec){ 155 | al <- mean( na.omit(ifelse(vec<0,vec,NA))) 156 | return( al * 100 ) 157 | } 158 | extraStats <- function(vec){ 159 | ex <- exposure(vec) 160 | aw <- avgWin(vec) 161 | al <- avgLoss(vec) 162 | wp <- winPercent(vec) 163 | wl <- -(aw/al) 164 | return( paste("exp_%:", round(ex,2), " win_%:", round(wp, 2), " avgWin:", round(aw,3), " avgLoss:", round(al,3), "w/l:", round(wl, 3)) ) 165 | } 166 | cat(paste("Model ",shrink,"HF Rtn: ",stats_gd3[1,1]," SD: ",stats_gd3[2,1]," SR: ",stats_gd3[3,1]," MDD: ",stats_gd3[4,1], sep="")) 167 | 168 | if(FALSE){ 169 | print( paste("B1 -", extraStats(returns_benchmark1[sdp]) )) 170 | print( paste("B2 -", extraStats(returns_benchmark2[sdp]) )) 171 | print( paste("S1 -", extraStats(returns_strategy1[sdp]) )) 172 | print( paste("S2 -", extraStats(returns_strategy2[sdp]) )) 173 | print( paste("S3 -", extraStats(returns_strategy3[sdp]) )) 174 | print( paste("S4 -", extraStats(returns_strategy4[sdp]) )) 175 | print( paste("S5 -", extraStats(returns_strategy5[sdp]) )) 176 | print( paste("_a -", extraStats(returns_strategy_a[sdp]) )) 177 | print( paste("_b -", extraStats(returns_strategy_b[sdp]) )) 178 | print( paste("_c -", extraStats(returns_strategy_c[sdp]) )) 179 | print( paste("_d -", extraStats(returns_strategy_d[sdp]) )) 180 | print( paste("_e -", extraStats(returns_strategy_e[sdp]) )) 181 | } 182 | 183 | # holefill data for plot 184 | # Holefill model means we use Elroz and fill in the unused cash with IEF 185 | # The various models are scaling how much Elroz we use, from 1HF (100% Elroz as 40% of the 60/40) 186 | # to 0HF, meaning no Elroz, straight 60/40 SPY/IEF 187 | # 0HF means holefilling with IEF 188 | ### Note 1: I did this manually while testing, so just dumped in these SD and Rtn values from repeated runs 189 | ### could easily put this in a short loop. 190 | ### Note 2: I could have used any scatter plotting, but I like the 191 | ### colors in the default heatscatter so used that for fun 192 | names1 <- c("0HF", "0.1HF", "0.2HF", "0.3HF", "0.4HF", "0.5HF", "0.6HF", "0.7HF", "0.72HF", "0.74HF", "0.75HF", "0.76HF", "0.78HF", "0.8HF", "0.9HF", "0.99HF", "1HF") 193 | rtn1 <- c(0.0811, 0.0828, 0.0845, 0.0861, 0.0878, 0.0893, 0.0908, 0.0923, 0.0926, 0.0929, 0.093, 0.0932, 0.0934, 0.0937, 0.0951, 0.0963, 0.0914) 194 | sd1 <- c(0.1079, 0.1068, 0.1061, 0.1058, 0.1059, 0.1064, 0.1073, 0.1086, 0.1089, 0.1092, 0.1094, 0.1095, 0.1099, 0.1102, 0.1123, 0.1144, 0.1138) 195 | heatscatter(sd1, rtn1, cor=FALSE, main="holefill risk/reward (SD vs Ann Rtn)") 196 | -------------------------------------------------------------------------------- /rv_vs_rtns_0.0.1.R: -------------------------------------------------------------------------------- 1 | ### rv_vs_rtns_0.0.1.R by babbage9010 and friends 2 | # CORRECTED CODE BELOW (see #COMMENT blocks) 3 | # initial release 4 | # this code is really weak, I barely knew what I was doing when I 5 | # started, but it's my start. 6 | ### released under MIT License 7 | 8 | # Step 1: Load libraries and data 9 | library(quantmod) 10 | library(PerformanceAnalytics) 11 | 12 | start_date <- as.Date("2006-07-01") 13 | end_date <- as.Date("2019-12-31") 14 | 15 | getSymbols("SPY", src = "yahoo", from = start_date, to = end_date, auto.assign = FALSE) -> gspc_data 16 | pricesAd <- na.omit( Ad(gspc_data) ) 17 | pricesOp <- na.omit( Op(gspc_data) ) 18 | pricesCl <- na.omit( Cl(gspc_data) ) 19 | pricesHi <- na.omit( Hi(gspc_data) ) 20 | pricesLo <- na.omit( Lo(gspc_data) ) 21 | # choose one of those here 22 | trade_prices <- pricesOp 23 | signal_prices <- pricesAd 24 | bench_prices <- pricesAd 25 | 26 | 27 | #plot it 28 | roc1 <- ROC(signal_prices, n = 1, type = "discrete") 29 | lookbk <- 20 30 | rv20 <- runSD(roc1, n = lookbk) * sqrt(252) 31 | rs20 <- volatility(gspc_data, n=lookbk, calc="rogers.satchell") 32 | gkyz20 <- volatility(gspc_data, n=lookbk, calc="gk.yz") 33 | park20 <- volatility(gspc_data, n=lookbk, calc="parkinson") 34 | 35 | #choose one of these to uncomment 36 | x_dat <- rv20; x_dat_label = "C2C" 37 | #x_dat <- rs20; x_dat_label = "RS" 38 | #x_dat <- gkyz20; x_dat_label = "GKYZ" 39 | #x_dat <- park20; x_dat_label = "Park" 40 | 41 | vollabel = paste(x_dat_label," ",lookbk, "d vol",sep="") 42 | 43 | #y - SPY open lagged returns 44 | roc_trade1 <- ROC(trade_prices, n = 1, type = "discrete") 45 | returns_spy_open <- roc_trade1 46 | #CORRECTION: lag here was used incorrectly 47 | #NO! ORIGINAL LINE: returns_spy_open <- stats::lag(returns_spy_open, 2) 48 | returns_spy_open <- stats::lag(returns_spy_open, -2) 49 | # We normally use a two-day lag(x,2) on a signal to match it properly with Open-Open 50 | # returns from two days in the future, corresponding to reading a signal after a Close 51 | # then trading as needed on the following Open (ie, in the morning for this case). 52 | # BUT I accidentally applied the same +2 open to align the RETURNS to the volatility 53 | # measures here. This pushes the returns forward two days instead of pushing the signal 54 | # forward... meaning the signal was aligning with an Open-Open return from two days 55 | # previous, giving us an unrealistically gorgeous correlation and low vol anomaly. 56 | # Run it yourself to see that now it looks pretty close to random with this setup. 57 | # More exploration to come. 58 | y_dat <- returns_spy_open 59 | 60 | #rid of NAs to even up the data (tip: this avoids NA-related errors) 61 | dat <- as.xts(y_dat) 62 | dat <- cbind(dat,x_dat) 63 | dat <- na.omit(dat) 64 | datcore <- coredata(dat) 65 | 66 | 67 | # barcharts of SPY returns per volatility bucket 68 | pl1 <- plot(x=datcore[,2],y=datcore[,1], sub="daily data, 2006/07/01 to 2019/12/31",main = paste(sep="", vollabel," (x-axis) vs lagged SPY Open returns (y-axis)")) 69 | pl1 <- abline(reg = lm(datcore[,1] ~ datcore[,2]), col = "red", lwd = 2) 70 | 71 | # Set for four graphs, or seven including 3 mean daily SPY returns plots 72 | numrows <- 4 #either 2 or 4 please 73 | # Set up 2x2 graphical window 74 | par(mfrow = c(numrows, 2)) 75 | 76 | # Recreate all four/seven plots 77 | pl1 <- plot(x=datcore[,2],y=datcore[,1], sub=paste(sep="","daily data, ",start_date," to ",end_date),main = paste(sep="", vollabel," (x-axis) vs lagged SPY Open returns (y-axis)")) 78 | pl1 <- abline(reg = lm(datcore[,1] ~ datcore[,2]), col = "red", lwd = 2) 79 | 80 | if(numrows == 4){ 81 | pl2 <- plot.new() 82 | } 83 | #helper function 84 | winpc <- function(vec){ sum(vec > 0) / sum(vec != 0) } 85 | 86 | qnums <- c(10,30,100) #number of quantiles (buckets) (eg 10 for deciles) 87 | for(q in 1:3){ 88 | qnum <- qnums[q] 89 | xlabel = paste(vollabel," with ",qnum," vol buckets",sep="") 90 | decs <- unname(quantile(datcore[,2], probs = seq(1/qnum, 1-1/qnum, by = 1/qnum))) 91 | decs[qnum] <- max(decs) + 1 92 | decsmin <- min(decs) - 1 93 | #loop through volatility buckets to get mean returns 94 | means <- c() 95 | wins <- c() 96 | for(i in 1:qnum){ 97 | # datx = data segment from x_dat[,1] (returns) to summarize 98 | lowbound <- ifelse(i == 1, decsmin, decs[i-1]) 99 | hibound <- decs[i] 100 | datx <- ifelse( datcore[,2] >= lowbound & datcore[,2] < hibound, datcore[,1], NA) 101 | datx <- na.omit(datx) 102 | means[i] <- mean(datx) 103 | wins[i] <- winpc(datx) 104 | #print( paste("decile",i,"mean:",means[i],"vol range:",lowval,"-",hival) ) 105 | } 106 | barplot(means,xlab=xlabel,ylab="SPY mean daily return",main="Mean daily SPY returns per volatility bucket",sub="low vol on left, high vol on right") 107 | if(numrows == 4){ 108 | barplot(wins,xlab=xlabel,ylab="SPY mean daily return",main="Daily win % for SPY returns per vol bucket",sub="low vol on left, high vol on right") 109 | abline(h=c(0.54),col="red") 110 | } 111 | } 112 | -------------------------------------------------------------------------------- /rv_vs_rtns_0.0.2.R: -------------------------------------------------------------------------------- 1 | ### rv_vs_rtns_0.0.2.R by babbage9010 and friends 2 | # update code from v1 to produce plots for blog post: 3 | # https://babbage9010.wordpress.com/2023/09/11/there-is-a-low-vol-anomaly-in-spy/ 4 | # Not intuitive, but it works, like this: 5 | # 1) to reproduce the B&W plots (1 lookback period) 6 | # a) set "switchy" (Line 118) to FALSE 7 | # b) choose vol signal as x_dat (L 48-52) 8 | # c) use numcols (L 73) to choose 2 or 3 column plot 9 | # 10 | # 2) to reproduce the color, lookback spectrum plots 11 | # a) set "switchy" (L 118) to TRUE 12 | # b) choose vol signal as x_dat (L 178-183) 13 | # c) play with maximum lookback if you want (L 163) 14 | # d) to exactly duplicate Y scales, see notes (L 126-137) 15 | # and set them manually, e.g., (0.0,8.4) 16 | # 17 | ### released under MIT License 18 | 19 | # Step 1: Load libraries and data 20 | library(quantmod) 21 | library(PerformanceAnalytics) 22 | 23 | start_date <- as.Date("2006-07-01") #SPY goes back to Jan 1993 24 | end_date <- as.Date("2019-12-31") 25 | 26 | getSymbols("SPY", src = "yahoo", from = start_date, to = end_date, auto.assign = FALSE) -> gspc_data 27 | pricesAd <- na.omit( Ad(gspc_data) ) 28 | pricesOp <- na.omit( Op(gspc_data) ) 29 | pricesCl <- na.omit( Cl(gspc_data) ) 30 | pricesHi <- na.omit( Hi(gspc_data) ) 31 | pricesLo <- na.omit( Lo(gspc_data) ) 32 | # choose one of those here 33 | trade_prices <- pricesOp 34 | signal_prices <- pricesAd 35 | bench_prices <- pricesAd 36 | 37 | 38 | #plot it 39 | roc1 <- ROC(signal_prices, n = 1, type = "continuous") 40 | lookbk <- 20 41 | rv <- runSD(roc1, n = lookbk) * sqrt(252) 42 | rs <- volatility(gspc_data, n=lookbk, calc="rogers.satchell") 43 | gkyz <- volatility(gspc_data, n=lookbk, calc="gk.yz") 44 | park <- volatility(gspc_data, n=lookbk, calc="parkinson") 45 | avgvol <- (rv+rs+gkyz+park) / 4 46 | 47 | #choose one of these to uncomment 48 | x_dat <- rv; x_dat_label = "C2C" 49 | #x_dat <- rs; x_dat_label = "RS" 50 | #x_dat <- gkyz; x_dat_label = "GKYZ" 51 | #x_dat <- park; x_dat_label = "Park" 52 | #x_dat <- avgvol; x_dat_label = "AVE4" 53 | 54 | vollabel = paste(x_dat_label," ",lookbk, "d vol",sep="") 55 | 56 | #y - SPY open lagged returns 57 | roc_trade1 <- ROC(trade_prices, n = 1, type = "continuous") 58 | returns_spy_open <- roc_trade1 59 | returns_spy_open <- stats::lag(returns_spy_open, -2) #lag is -2 to properly align with vol signal 60 | # see v1 code for details 61 | y_dat <- returns_spy_open #lagged, as above 62 | 63 | #rid of NAs to even up the data (tip: this avoids NA-related errors) 64 | dat <- as.xts(y_dat) 65 | dat <- cbind(dat,x_dat) 66 | dat <- na.omit(dat) 67 | datcore <- coredata(dat) 68 | 69 | 70 | # Set for six graphs, or nine 71 | # to recreate the black&white plots in the blog post 72 | numrows <- 3 73 | numcols <- 2 #either 2 or 3 columns please 74 | # Set up 2x2 graphical window 75 | par(mfrow = c(numrows, numcols)) 76 | 77 | #qnums <- c(10,30,100) #number of quantiles (buckets) (eg 10 for deciles) 78 | qnums <- c(2,10,100) #number of quantiles (buckets) (eg 10 for deciles) 79 | for(q in 1:3){ 80 | qnum <- qnums[q] 81 | xlabel = paste(vollabel," with ",qnum," vol buckets",sep="") 82 | decs <- unname(quantile(datcore[,2], probs = seq(1/qnum, 1-1/qnum, by = 1/qnum))) 83 | decs[qnum] <- max(decs) + 1 84 | decsmin <- min(decs) - 1 85 | #loop through volatility buckets to get summed and risked returns 86 | sums <- c() 87 | annvols <- c() 88 | riskdRtns <- c() 89 | for(i in 1:qnum){ 90 | # datx = data segment from x_dat[,1] (returns) to summarize 91 | lowbound <- ifelse(i == 1, decsmin, decs[i-1]) 92 | hibound <- decs[i] 93 | datx <- ifelse( datcore[,2] >= lowbound & datcore[,2] < hibound, datcore[,1], NA) 94 | datx <- na.omit(datx) 95 | sums[i] <- sum(datx) 96 | annvols[i] <- sd(datx) * sqrt(252) 97 | riskdRtns[i] <- sums[i] / annvols[i] 98 | #print( paste("decile",i,"mean:",means[i],"vol range:",lowval,"-",hival) ) 99 | } 100 | barplot(sums,xlab=xlabel,ylab="Sum of SPY daily returns (log)",main="Sum of daily SPY log returns per volatility bucket",sub="low vol on left, high vol on right") 101 | if(numrows >= 3){ 102 | #barplot(wins,xlab=xlabel,ylab="SPY mean daily return",main="Daily win % for SPY returns per vol bucket",sub="low vol on left, high vol on right") 103 | #abline(h=c(0.54),col="red") 104 | barplot(annvols,xlab=xlabel,ylab="SPY annualized standard deviation",main="Std Dev (ann) for SPY returns per vol bucket",sub="low vol on left, high vol on right") 105 | if(numcols >= 3){ 106 | barplot(riskdRtns,xlab=xlabel,ylab="SPY risked returns (relative)",main="Relative risked returns per volatility bucket",sub="low vol on left, high vol on right") 107 | } 108 | } 109 | } 110 | 111 | # 112 | # HERE BE THE COLOR BAR CHARTS 113 | # 114 | # Use this switch to turn on(T)/off(F) this section 115 | # for some (R Studio?) reason it also seems to turn off the earlier plots 116 | # so you only get one or the other plots based on this switch 117 | # 118 | switchy <- TRUE #FALSE OR TRUE 119 | 120 | if(switchy){ 121 | # function generates the bar graph from loop below 122 | barr = function(wha="net",whichdec,signalname,value=""){ 123 | x <- lbaks 124 | if(wha=="net") { y <- decnets[whichdec,] 125 | titl <- paste(signalname,": net returns per quantile by lookback (Y scale varies)") 126 | ystuff <- list(title = "net return for Vol bucket", range = c(min(decnets[whichdec,]),max(decnets[whichdec,]))) #this automates the range max 127 | #ystuff <- list(title = "net return for Vol bucket", range = c(0.0,0.6)) #this lets you specify the range 128 | } 129 | if(wha=="vol") { y <- decvols[whichdec,] 130 | titl <- paste(signalname,": avg volatility per quantile by lookback (Y scale varies)") 131 | ystuff <- list(title = "volatility for Vol bucket", range = c(min(decvols[whichdec,]),max(decvols[whichdec,]))) 132 | #ystuff <- list(title = "volatility for Vol bucket", range = c(0.0,0.25)) #specified 133 | } 134 | if(wha=="rat") { y <- decrats[whichdec,] 135 | titl <- paste(signalname,": Return/Volatility per quantile by lookback (Y scale varies)") 136 | ystuff <- list(title = "reward/risk ratio for Vol bucket", range = c(min(decrats[whichdec,]),max(decrats[whichdec,]))) 137 | #ystuff <- list(title = "reward/risk ratio for Vol bucket", range = c(0.0,8.4)) #specified 138 | } 139 | 140 | text= y 141 | data = data.frame(x=factor(x,levels=x),text,y) 142 | 143 | fig <- plot_ly( 144 | data, name = paste("Q",whichdec,value), type = "bar", 145 | x = ~x, textposition = "outside", y= ~y, text =~text) 146 | 147 | fig <- fig %>% 148 | layout(title = titl, 149 | xaxis = list(title = "Volatility lookback period (days)"), 150 | #not working: yaxis = list(title = paste("SPY lagged O-O net return for Vol Decile ",whichdec)), 151 | yaxis = ystuff, 152 | autosize = TRUE, 153 | showlegend = TRUE) 154 | 155 | return(fig) 156 | } 157 | 158 | # Now set dec (quantiles) and lookbacks range 159 | # dec is the number of quantiles to use 160 | # (Y scale hard to read when dec > 10) 161 | dec <- 2 162 | #lookbacks plot ok as high as 100 or 200 163 | lbaks <- c(2:30) #lookbacks 164 | decnets <- c() #matrix of decile Net Return data 165 | decvols <- c() #matrix of decile returns volatility data annualized 166 | decrats <- c() #matrix of decile Ratios of returns/volatility 167 | n <- 0 168 | for(lb in lbaks){ 169 | qnum <- dec #how many quantiles this loop 170 | n <- n+1 171 | #use roc1 as above (non-lagged) 172 | rv <- runSD(roc1, n = lb) * sqrt(252) 173 | rs <- volatility(gspc_data, n=lb, calc="rogers.satchell") 174 | gkyz <- volatility(gspc_data, n=lb, calc="gk.yz") 175 | park <- volatility(gspc_data, n=lb, calc="parkinson") 176 | avg4 <- (rv+rs+gkyz+park) / 4 177 | 178 | #choose your vol measure here! using # 179 | x_dat2 <- rv; x_dat_label <- "Close2Close" 180 | #x_dat2 <- rs; x_dat_label <- "Rogers-Satchell" 181 | #x_dat2 <- park; x_dat_label <- "Parkinson" 182 | #x_dat2 <- gkyz; x_dat_label <- "GK-YZ" 183 | #x_dat2 <- avg4; x_dat_label <- "Average4" 184 | 185 | vollabel = paste(x_dat_label," ",lb, "d vol",sep="") 186 | xlabel = paste(vollabel," with ",qnum," vol buckets",sep="") 187 | datp <- as.xts(y_dat) #y_dat is lagged, as above 188 | datp <- cbind(datp,x_dat2) 189 | datp <- na.omit(datp) 190 | datcore2 <- coredata(datp) 191 | decs2 <- unname(quantile(datcore2[,2], probs = seq(1/qnum, 1-1/qnum, by = 1/qnum))) 192 | decs2[qnum] <- max(decs2) + 1 193 | decsmin <- min(decs2) - 1 194 | #loop through volatility buckets to get returns data 195 | netgain2 <- c() 196 | annvols <- c() 197 | rvratios <- c() 198 | for(i in 1:qnum){ 199 | # datx = data segment from x_dat[,1] (returns) to summarize 200 | lowbound <- ifelse(i == 1, decsmin, decs2[i-1]) 201 | hibound <- decs2[i] 202 | datx <- ifelse( datcore2[,2] >= lowbound & datcore2[,2] < hibound, datcore2[,1], NA) 203 | datx <- na.omit(datx) 204 | netgain2[i] <- sum(datx) 205 | annvols[i] <- sd(datx) * sqrt(252) 206 | rvratios[i] <- netgain2[i] / annvols[i] 207 | } 208 | decnets <- cbind(decnets,netgain2) 209 | decvols <- cbind(decvols,annvols) 210 | decrats <- cbind(decrats,rvratios) 211 | } 212 | figs1 <- list() 213 | figs2 <- list() 214 | figs3 <- list() 215 | for(x in 1:dec){ 216 | figs1[x] <- barr("net",x, x_dat_label, paste(":",round(mean(decnets[x,]),2))) 217 | figs2[x] <- barr("vol",x, x_dat_label, paste(":",round(mean(decvols[x,]),2))) 218 | figs3[x] <- barr("rat",x, x_dat_label, paste(":",round(mean(decrats[x,]),2))) 219 | print(paste("Dec:",x,"Sum:",sum(decnets[x,]),"Avg:",mean(decnets[x,]))) 220 | #print(paste("Dec:",x,"Vol:",sum(decvols[x,]),"S/V:",sum(decnets[x,])/sum(decvols[x,]))) 221 | print(paste("Dec:",x,"Vol:",sum(decvols[x,]),"S/V:",mean(decrats[x,]))) 222 | } 223 | figgy <- subplot(figs1, nrows = length(figs1), shareX = TRUE) 224 | ziggy <- subplot(figs2, nrows = length(figs2), shareX = TRUE) 225 | biggy <- subplot(figs3, nrows = length(figs3), shareX = TRUE) 226 | print(figgy) #figgy is the summed (net) returns per quantile 227 | print(ziggy) #ziggy is the std dev annualized 228 | print(biggy) #biggy is the risk-adj returns used in the blog post 229 | 230 | } #end of switchy statement 231 | par(mfrow = c(1, 1)) 232 | 233 | -------------------------------------------------------------------------------- /rv_vs_rtns_0.0.3.R: -------------------------------------------------------------------------------- 1 | ### rv_vs_rtns_0.0.3.R by babbage9010 and friends 2 | # update code from v2 to produce plots for blog post: 3 | # babbage9010.wordpress.com/2023/10/25/part-10-quant_rv-getting-somewhere-now-by-adding-normalized-atr/ 4 | # added nATR as a vol measure 5 | # Not intuitive, but it works, like this: 6 | # 1) to reproduce the B&W plots (1 lookback period) 7 | # a) set "switchy" (Line 119) to FALSE 8 | # b) choose vol signal as x_dat (L 48-53) 9 | # c) use numcols (L 74) to choose 2 or 3 column plot 10 | # 11 | # 2) to reproduce the color, lookback spectrum plots 12 | # a) set "switchy" (L 119) to TRUE 13 | # b) choose vol signal as x_dat (L 181-186) 14 | # c) play with maximum lookback if you want (L 164) 15 | # d) to exactly duplicate Y scales, see notes (L 127-138) 16 | # and set them manually, e.g., (0.0,8.4) 17 | ### released under MIT License 18 | 19 | # Step 1: Load libraries and data 20 | library(quantmod) 21 | library(PerformanceAnalytics) 22 | library(plotly) 23 | 24 | start_date <- as.Date("2006-07-01") #SPY goes back to Jan 1993 25 | end_date <- as.Date("2019-12-31") 26 | 27 | getSymbols("SPY", src = "yahoo", from = start_date, to = end_date, auto.assign = FALSE) -> spy_data 28 | pricesAd <- na.omit( Ad(spy_data) ) 29 | pricesOp <- na.omit( Op(spy_data) ) 30 | pricesCl <- na.omit( Cl(spy_data) ) 31 | pricesHi <- na.omit( Hi(spy_data) ) 32 | pricesLo <- na.omit( Lo(spy_data) ) 33 | # choose one of those here 34 | trade_prices <- pricesOp 35 | signal_prices <- pricesAd 36 | bench_prices <- pricesAd 37 | 38 | #plot it 39 | roc1 <- ROC(signal_prices, n = 1, type = "continuous") 40 | lookbk <- 20 41 | rv <- runSD(roc1, n = lookbk) * sqrt(252) 42 | rs <- volatility(spy_data, n=lookbk, calc="rogers.satchell") 43 | gkyz <- volatility(spy_data, n=lookbk, calc="gk.yz") 44 | park <- volatility(spy_data, n=lookbk, calc="parkinson") 45 | avgvol <- (rv+rs+gkyz+park) / 4 46 | nATR <- ATR(spy_data, n=lookbk, maType="ZLEMA")[ , "atr"] / pricesCl 47 | 48 | #choose one of these to uncomment 49 | #x_dat <- rv; x_dat_label = "C2C" 50 | #x_dat <- rs; x_dat_label = "RS" 51 | #x_dat <- gkyz; x_dat_label = "GKYZ" 52 | #x_dat <- park; x_dat_label = "Park" 53 | #x_dat <- avgvol; x_dat_label = "AVE4" 54 | x_dat <- nATR; x_dat_label = "nATR" 55 | 56 | vollabel = paste(x_dat_label," ",lookbk, "d vol",sep="") 57 | 58 | #y - SPY open lagged returns 59 | roc_trade1 <- ROC(trade_prices, n = 1, type = "continuous") 60 | returns_spy_open <- roc_trade1 61 | returns_spy_open <- stats::lag(returns_spy_open, -2) #lag is -2 to properly align with vol signal 62 | # see v1 code for details 63 | y_dat <- returns_spy_open #lagged, as above 64 | 65 | #rid of NAs to even up the data (tip: this avoids NA-related errors) 66 | dat <- as.xts(y_dat) 67 | dat <- cbind(dat,x_dat) 68 | dat <- na.omit(dat) 69 | datcore <- coredata(dat) 70 | 71 | 72 | # Set for six graphs, or nine 73 | # to recreate the black&white plots in the blog post 74 | numrows <- 3 75 | numcols <- 3 #either 2 or 3 columns please 76 | # Set up 2x2 graphical window 77 | par(mfrow = c(numrows, numcols)) 78 | 79 | #qnums <- c(10,30,100) #number of quantiles (buckets) (eg 10 for deciles) 80 | qnums <- c(2,10,100) #number of quantiles (buckets) (eg 10 for deciles) 81 | for(q in 1:3){ 82 | qnum <- qnums[q] 83 | xlabel = paste(vollabel," with ",qnum," vol buckets",sep="") 84 | decs <- unname(quantile(datcore[,2], probs = seq(1/qnum, 1-1/qnum, by = 1/qnum))) 85 | decs[qnum] <- max(decs) + 1 86 | decsmin <- min(decs) - 1 87 | #loop through volatility buckets to get summed and risked returns 88 | sums <- c() 89 | annvols <- c() 90 | riskdRtns <- c() 91 | for(i in 1:qnum){ 92 | # datx = data segment from x_dat[,1] (returns) to summarize 93 | lowbound <- ifelse(i == 1, decsmin, decs[i-1]) 94 | hibound <- decs[i] 95 | datx <- ifelse( datcore[,2] >= lowbound & datcore[,2] < hibound, datcore[,1], NA) 96 | datx <- na.omit(datx) 97 | sums[i] <- sum(datx) 98 | annvols[i] <- sd(datx) * sqrt(252) 99 | riskdRtns[i] <- sums[i] / annvols[i] 100 | #print( paste("decile",i,"mean:",means[i],"vol range:",lowval,"-",hival) ) 101 | } 102 | barplot(sums,xlab=xlabel,ylab="Sum of SPY daily returns (log)",main="Sum of daily SPY log returns per volatility bucket",sub="low vol on left, high vol on right") 103 | if(numrows >= 3){ 104 | #barplot(wins,xlab=xlabel,ylab="SPY mean daily return",main="Daily win % for SPY returns per vol bucket",sub="low vol on left, high vol on right") 105 | #abline(h=c(0.54),col="red") 106 | barplot(annvols,xlab=xlabel,ylab="SPY annualized standard deviation",main="Std Dev (ann) for SPY returns per vol bucket",sub="low vol on left, high vol on right") 107 | if(numcols >= 3){ 108 | barplot(riskdRtns,xlab=xlabel,ylab="SPY risked returns (relative)",main="Relative risked returns per volatility bucket",sub="low vol on left, high vol on right") 109 | } 110 | } 111 | } 112 | 113 | # 114 | # HERE BE THE COLOR BAR CHARTS 115 | # 116 | # Use this switch to turn on(T)/off(F) this section 117 | # for some (R Studio?) reason it also seems to turn off the earlier plots 118 | # so you only get one or the other plots based on this switch 119 | # 120 | switchy <- TRUE #FALSE OR TRUE 121 | 122 | if(switchy){ 123 | # function generates the bar graph from loop below 124 | barr = function(wha="net",whichdec,signalname,value=""){ 125 | x <- lbaks 126 | if(wha=="net") { y <- decnets[whichdec,] 127 | titl <- paste(signalname,": net returns per quantile by lookback (Y scale varies)") 128 | ystuff <- list(title = "net return for Vol bucket", range = c(min(decnets[whichdec,]),max(decnets[whichdec,]))) #this automates the range max 129 | #ystuff <- list(title = "net return for Vol bucket", range = c(0.0,0.6)) #this lets you specify the range 130 | } 131 | if(wha=="vol") { y <- decvols[whichdec,] 132 | titl <- paste(signalname,": avg volatility per quantile by lookback (Y scale varies)") 133 | ystuff <- list(title = "volatility for Vol bucket", range = c(min(decvols[whichdec,]),max(decvols[whichdec,]))) 134 | #ystuff <- list(title = "volatility for Vol bucket", range = c(0.0,0.25)) #specified 135 | } 136 | if(wha=="rat") { y <- decrats[whichdec,] 137 | titl <- paste(signalname,": Return/Volatility per quantile by lookback (Y scale varies)") 138 | ystuff <- list(title = "reward/risk ratio for Vol bucket", range = c(min(decrats[whichdec,]),max(decrats[whichdec,]))) 139 | #ystuff <- list(title = "reward/risk ratio for Vol bucket", range = c(0.0,8.4)) #specified 140 | } 141 | 142 | text= y 143 | data = data.frame(x=factor(x,levels=x),text,y) 144 | 145 | fig <- plot_ly( 146 | data, name = paste("Q",whichdec,value), type = "bar", 147 | x = ~x, textposition = "outside", y= ~y, text =~text) 148 | 149 | fig <- fig %>% 150 | layout(title = titl, 151 | xaxis = list(title = "Volatility lookback period (days)"), 152 | #not working: yaxis = list(title = paste("SPY lagged O-O net return for Vol Decile ",whichdec)), 153 | yaxis = ystuff, 154 | autosize = TRUE, 155 | showlegend = TRUE) 156 | 157 | return(fig) 158 | } 159 | 160 | # Now set dec (quantiles) and lookbacks range 161 | # dec is the number of quantiles to use 162 | # (Y scale hard to read when dec > 10) 163 | dec <- 2 164 | #lookbacks plot ok as high as 100 or 200 165 | lbaks <- c(2:40) #lookbacks 166 | decnets <- c() #matrix of decile Net Return data 167 | decvols <- c() #matrix of decile returns volatility data annualized 168 | decrats <- c() #matrix of decile Ratios of returns/volatility 169 | #n <- 0 170 | for(lb in lbaks){ 171 | qnum <- dec #how many quantiles this loop 172 | #n <- n+1 173 | #use roc1 as above (non-lagged) 174 | rv <- runSD(roc1, n = lb) * sqrt(252) 175 | rs <- volatility(spy_data, n=lb, calc="rogers.satchell") 176 | gkyz <- volatility(spy_data, n=lb, calc="gk.yz") 177 | park <- volatility(spy_data, n=lb, calc="parkinson") 178 | avg4 <- (rv+rs+gkyz+park) / 4 179 | nATR <- ATR(spy_data, n=lb, maType="ZLEMA")[ , "atr"] / pricesCl 180 | 181 | #choose your vol measure here! using # 182 | #x_dat2 <- rv; x_dat_label <- "Close2Close" 183 | #x_dat2 <- rs; x_dat_label <- "Rogers-Satchell" 184 | #x_dat2 <- park; x_dat_label <- "Parkinson" 185 | #x_dat2 <- gkyz; x_dat_label <- "GK-YZ" 186 | #x_dat2 <- avg4; x_dat_label <- "Average4" 187 | x_dat2 <- nATR; x_dat_label <- "nATR" 188 | 189 | vollabel = paste(x_dat_label," ",lb, "d vol",sep="") 190 | xlabel = paste(vollabel," with ",qnum," vol buckets",sep="") 191 | datp <- as.xts(y_dat) #y_dat is lagged, as above 192 | datp <- cbind(datp,x_dat2) 193 | datp <- na.omit(datp) 194 | datcore2 <- coredata(datp) 195 | decs2 <- unname(quantile(datcore2[,2], probs = seq(1/qnum, 1-1/qnum, by = 1/qnum))) 196 | decs2[qnum] <- max(decs2) + 1 197 | decsmin <- min(decs2) - 1 198 | #loop through volatility buckets to get returns data 199 | netgain2 <- c() 200 | annvols <- c() 201 | rvratios <- c() 202 | for(i in 1:qnum){ 203 | # datx = data segment from x_dat[,1] (returns) to summarize 204 | lowbound <- ifelse(i == 1, decsmin, decs2[i-1]) 205 | hibound <- decs2[i] 206 | datx <- ifelse( datcore2[,2] >= lowbound & datcore2[,2] < hibound, datcore2[,1], NA) 207 | datx <- na.omit(datx) 208 | netgain2[i] <- sum(datx) 209 | annvols[i] <- sd(datx) * sqrt(252) 210 | rvratios[i] <- netgain2[i] / annvols[i] 211 | } 212 | decnets <- cbind(decnets,netgain2) 213 | decvols <- cbind(decvols,annvols) 214 | decrats <- cbind(decrats,rvratios) 215 | print(paste(lb,i,netgain2[1], annvols[1], rvratios[1])) 216 | } 217 | figs1 <- list() 218 | figs2 <- list() 219 | figs3 <- list() 220 | for(x in 1:dec){ 221 | figs1[x] <- barr("net",x, x_dat_label, paste(":",round(mean(decnets[x,]),2))) 222 | figs2[x] <- barr("vol",x, x_dat_label, paste(":",round(mean(decvols[x,]),2))) 223 | figs3[x] <- barr("rat",x, x_dat_label, paste(":",round(mean(decrats[x,]),2))) 224 | print(paste("Dec:",x,"Sum:",sum(decnets[x,]),"Avg:",mean(decnets[x,]))) 225 | #print(paste("Dec:",x,"Vol:",sum(decvols[x,]),"S/V:",sum(decnets[x,])/sum(decvols[x,]))) 226 | print(paste("Dec:",x,"Vol:",sum(decvols[x,]),"S/V:",mean(decrats[x,]))) 227 | } 228 | figgy <- subplot(figs1, nrows = length(figs1), shareX = TRUE) 229 | ziggy <- subplot(figs2, nrows = length(figs2), shareX = TRUE) 230 | biggy <- subplot(figs3, nrows = length(figs3), shareX = TRUE) 231 | print(figgy) #figgy is the summed (net) returns per quantile 232 | print(ziggy) #ziggy is the std dev annualized 233 | print(biggy) #biggy is the risk-adj returns used in the blog post 234 | 235 | } #end of switchy statement 236 | par(mfrow = c(1, 1)) 237 | -------------------------------------------------------------------------------- /vol_compare: -------------------------------------------------------------------------------- 1 | library(quantmod) 2 | 3 | #get the data 4 | date_start <- as.Date("2006-07-01") 5 | date_end <- as.Date("2019-12-31") 6 | symbol_signal1 <- "SPY" # S&P 500 symbol (use SPY or ^GSPC) 7 | data_spy <- getSymbols(symbol_signal1, src = "yahoo", from = date_start, to = date_end, auto.assign = FALSE) 8 | 9 | #here we calculate vol 10 | volatility_20d_gkyz <- volatility(data_spy, n=20, calc = "gk.yz") 11 | volatility_20d_c2c <- volatility(data_spy, n=20, calc = "close") 12 | 13 | #for plotting, just the data 14 | vol_20day_GKYZ = coredata(volatility_20d_gkyz) 15 | vol_20day_C2C = coredata(volatility_20d_c2c) 16 | 17 | #plot it 18 | pl1 <- plot.new() 19 | pl1 <- plot(x=vol_20day_C2C,y=vol_20day_GKYZ, main = "C2C vol vs GKYZ vol") 20 | pl1 <- abline(reg = lm(vol_20day_GKYZ ~ vol_20day_C2C), col = "red", lwd = 2) 21 | 22 | #let's also look at daily returns (vol direction) 23 | roc_volatility_gkyz <- ROC(volatility_20d_gkyz, n = 1, type = "continuous") 24 | roc_volatility_c2c <- ROC(volatility_20d_c2c, n = 1, type = "continuous") 25 | #roc_volatility_gkyz <- SMA(ROC(volatility_20d_gkyz, n = 1, type = "continuous"), n = 40) 26 | #roc_volatility_c2c <- SMA(ROC(volatility_20d_c2c, n = 1, type = "continuous"), n = 40) 27 | 28 | #for plotting, just the data 29 | roc_vol_20day_GKYZ = coredata(roc_volatility_gkyz) 30 | roc_vol_20day_C2C = coredata(roc_volatility_c2c) 31 | 32 | #plot it 33 | pl2 <- plot.new() 34 | pl2 <- plot(x=roc_vol_20day_C2C,y=roc_vol_20day_GKYZ, main = "Daily Returns: C2C vol vs GKYZ vol") 35 | pl2 <- abline(reg = lm(roc_vol_20day_GKYZ ~ roc_vol_20day_C2C), col = "red", lwd = 2) 36 | -------------------------------------------------------------------------------- /vol_compare_0.0.2.R: -------------------------------------------------------------------------------- 1 | ### vol_compare v0.0.2 by babbage9010 and friends 2 | # initial release 3 | ### released under MIT License 4 | 5 | library(quantmod) 6 | 7 | #get the data 8 | date_start <- as.Date("2006-07-01") 9 | date_end <- as.Date("2019-12-31") 10 | symbol_signal1 <- "SPY" # S&P 500 symbol (use SPY or ^GSPC) 11 | data_spy <- getSymbols(symbol_signal1, src = "yahoo", from = date_start, to = date_end, auto.assign = FALSE) 12 | 13 | #here we calculate vol 14 | volatility_20d_gkyz <- volatility(data_spy, n=20, calc = "gk.yz") 15 | volatility_20d_c2c <- volatility(data_spy, n=20, calc = "close") 16 | volatility_20d_park <- volatility(data_spy, n=20, calc = "parkinson") 17 | volatility_20d_rosa <- volatility(data_spy, n=20, calc = "rogers.satchell") 18 | volatility_20d_yazh <- volatility(data_spy, n=20, calc = "yang.zhang") 19 | 20 | #for plotting, just the data 21 | vol_20day_GKYZ = coredata(volatility_20d_gkyz) 22 | vol_20day_C2C = coredata(volatility_20d_c2c) 23 | 24 | #plot it 25 | pl1 <- plot.new() 26 | pl1 <- plot(x=vol_20day_C2C,y=vol_20day_GKYZ, main = "C2C vol vs GKYZ vol") 27 | pl1 <- abline(reg = lm(vol_20day_GKYZ ~ vol_20day_C2C), col = "red", lwd = 2) 28 | 29 | #let's also look at daily returns (vol direction) 30 | roc_volatility_gkyz <- ROC(volatility_20d_gkyz, n = 1, type = "continuous") 31 | roc_volatility_c2c <- ROC(volatility_20d_c2c, n = 1, type = "continuous") 32 | roc_volatility_park <- ROC(volatility_20d_park, n = 1, type = "continuous") 33 | roc_volatility_rosa <- ROC(volatility_20d_rosa, n = 1, type = "continuous") 34 | roc_volatility_yazh <- ROC(volatility_20d_yazh, n = 1, type = "continuous") 35 | 36 | #for plotting, just the data 37 | roc_vol_20day_GKYZ = coredata(roc_volatility_gkyz) 38 | roc_vol_20day_C2C = coredata(roc_volatility_c2c) 39 | roc_vol_20day_PARK = coredata(roc_volatility_park) 40 | roc_vol_20day_ROSA = coredata(roc_volatility_rosa) 41 | roc_vol_20day_YAZH = coredata(roc_volatility_yazh) 42 | 43 | #plot it 44 | pl2 <- plot.new() 45 | pl2 <- plot(x=roc_vol_20day_C2C,y=roc_vol_20day_GKYZ, main = "Daily Returns: C2C vol vs GKYZ vol") 46 | pl2 <- abline(reg = lm(roc_vol_20day_GKYZ ~ roc_vol_20day_C2C), col = "red", lwd = 2) 47 | #pl2 <- plot(x=roc_vol_20day_PARK,y=roc_vol_20day_GKYZ, main = "Daily Returns: PARK vol vs GKYZ vol") 48 | #pl2 <- abline(reg = lm(roc_vol_20day_GKYZ ~ roc_vol_20day_PARK), col = "red", lwd = 2) 49 | 50 | comp <- c() 51 | comp <- cbind(comp, roc_vol_20day_C2C, roc_vol_20day_PARK, roc_vol_20day_ROSA, roc_vol_20day_GKYZ, roc_vol_20day_YAZH ) 52 | colnames(comp)<- c("C2C", "Parkinson", "Rogers-Satchell", "Garman-Klass,Yang-Zhang", "Yang-Zhang") 53 | #pairs(comp, lower.panel = NULL) 54 | #pairs(comp) 55 | comp <- na.omit(comp) 56 | cor <- cor(comp, method="pearson") 57 | 58 | #ok, now remove YAZH because it's too nearly identical to GKYZ, at least with default params 59 | comp2 <- c() 60 | comp2 <- cbind(comp2, roc_vol_20day_C2C, roc_vol_20day_PARK, roc_vol_20day_ROSA, roc_vol_20day_GKYZ ) 61 | colnames(comp2)<- c("C2C", "Parkinson", "Rogers-Satchell", "Garman-Klass,Yang-Zhang") 62 | #pairs(comp2, lower.panel = NULL) 63 | pairs(comp2) 64 | comp2 <- na.omit(comp2) 65 | cor2 <- cor(comp2, method="pearson") 66 | print(cor2) 67 | --------------------------------------------------------------------------------