Equity Backtesting

Simple 52-Week Price Range Backtest

Project Description

One of the most powerful forces that influence stock prices is momentum. As stocks reach or hit new highs, investors gravitate to the popular stock, increasing buying pressure, causing the stock price to rise even higher. This effect is particularly noticeable in growth stocks where a level of exponential momentum is already expected.

There are a number of trading strategies that use the 52-week high of a stock price as a momentum indicator. Many of these look at whether a stock is reaching 80% of it’s 52-week high indicating renewed buying pressure. An interesting trading strategy is to examine the 52-week high and low in relation to the current stock price to identify positive momentum. The belief is that stocks that score 82% or better in this formula tend to outperform the market.

The formula is relatively simple: (Current Stock Price - 52-Week Low) / (52-Week High - 52-Week Low)

The formula provides the 52-Week price range and the relative placement of the current stock price within that range.

This project will be a simple test for momentum using a 52-Week Price Range strategy with a threshold of 82%. There are 251 trading days in a calendar year so we will use that number as our range for determining the 52-Week High and Low. A 3 month return on the stock will be calculated along with an optimal return which identifies the highest return possible within the 3 month period.

The source data will be the backtest environment created in the previous project, Build Backtest Environment. Recall that the environment contains historical pricing data from 2007-2016. We also have a symbols table that contains all of the stocks that were successfully loaded in the environment.

As before, we will be using the quantmod package to retrieve data from the backtest environment.

Libraries Required

library(quantmod)   # Quantitative financial strategies
library(dplyr)      # Data manipulation
library(lubridate)  # Date and time processing
library(knitr)      # Dynamic report generation

Working directory

setwd("U:/Equity Backtesting")

Prepare the Environment

We will require the two files previously created in order to perform the backtest. To access the environment we created we simply need to load the environment file. The symbols table is in the form of an .rds.

Load Backtest Environment

load("Environments/bt_env_2007_2016.Rdata")

Read Backtest Symbols Table

bt_env_symbols <- readRDS("Symbols/bt_env_symbols.rds")

We can check to make sure that the data is loaded correctly and contains expected values. This time we can look for symbols that start with “VM”.

Verify Backtest Environment

ls(bt_env_2007_2016, pattern = "^VM")
## [1] "VMC" "VMI" "VMW"

Verify Data in Backtest Environment

kable(head(bt_env_2007_2016$VMW, 10))
VMW.Open VMW.High VMW.Low VMW.Close VMW.Volume VMW.Adjusted
52.11 59.87 51.50 57.71 10678500 57.71
60.99 61.49 52.71 56.99 6919500 56.99
59.00 59.00 54.45 55.55 3086100 55.55
56.05 57.50 55.61 57.33 2140900 57.33
57.25 66.59 56.50 65.99 7369700 65.99
70.18 73.95 66.56 66.85 10144400 66.85
68.07 70.88 65.01 70.20 4347000 70.20
70.20 72.65 69.45 71.30 3812400 71.30
71.73 73.35 71.01 72.30 2393300 72.30
71.90 72.10 66.50 69.78 3664100 69.78

Verify Backtest Symbols

kable(head(bt_env_symbols, 10))
Symbol Sector Industry Name Exchange
AAAP Health Care Major Pharmaceuticals Advanced Accelerator Applications S.A. NASDAQ
AAL Transportation Air Freight/Delivery Services American Airlines Group, Inc. NASDAQ
AAME Finance Life Insurance Atlantic American Corporation NASDAQ
AAOI Technology Semiconductors Applied Optoelectronics, Inc. NASDAQ
AAON Capital Goods Industrial Machinery/Components AAON, Inc. NASDAQ
AAPC Consumer Services Services-Misc. Amusement & Recreation Atlantic Alliance Partnership Corp. NASDAQ
AAPL Technology Computer Manufacturing Apple Inc. NASDAQ
AAWW Transportation Transportation Services Atlas Air Worldwide Holdings NASDAQ
ABAC Consumer Non-Durables Farming/Seeds/Milling Aoxin Tianli Group, Inc. NASDAQ
ABAX Capital Goods Industrial Machinery/Components ABAXIS, Inc. NASDAQ 
## [1] "Number of Backtest Symbols: 4667"

Process for 52-Week Price Range

The first step in the processing is to retrieve the desired symbol data from the backtest environment. This is accomplished using the following:

get(symbol_name, source_environment)

The next steps are to generate the 52-Week High and Low stock prices. We will use the runMax() and runMin() functions in quantmod to determine the respective values using a range of 251 days to create an equitable period for all stocks.

Using the returned values, the 52-Week price range value will be calculated and a signal threshold of 82% will be set. All calculations will be made using the adjusted closing price.

We do need to determine if there are enough observations to perform the calculations so we will exclude any stocks that do not have 251 observation points from the analysis.

If the number of observations is sufficient for the analysis the results will be placed in a data frame and then processed. The processing consists of the following:

The data is grouped and filtered to keep only one occurrence of the signal threshold in order to test the signal as a trigger for initiating a buy condition for the stock. The data frame created is then joined to a master data frame which will contain all occurrences of the signal threshold being met for the first time in a given month.

Create Symbol Array

bt_symbols <- bt_env_symbols$Symbol

Price Range Signal Gather Loop

j <- 1

for(i in 1:length(bt_symbols)) {
        
        sym_sum  <- get(bt_symbols[i], envir = bt_env_2007_2016)
        
        if(nrow(sym_sum) >= 251) {
                
                sym_sum  <- data.frame(na.approx(sym_sum))
        
                colnames(sym_sum) <- c("Open", "High", "Low", "Close", "Volume", "AdjClose")
        
                sym_sum <- sym_sum %>%
                           mutate(Date = as.Date(rownames(.)),
                                  Symbol = bt_symbols[i],
                                  Hi_52wk = runMax(AdjClose, n = 251, cumulative = FALSE),
                                  Lo_52wk = runMin(AdjClose, n = 251, cumulative = FALSE),
                                  Mo_52wk = (AdjClose - Lo_52wk) / (Hi_52wk - Lo_52wk)) %>%
                           filter(Mo_52wk >= .82) %>%
                           mutate(Year = year(Date),
                                  Mnth = month(Date)) %>%
                           group_by(Year, Mnth) %>%
                           slice(1L) %>%
                           ungroup() %>%
                           select(Symbol, Date, Mo_52wk)
                           
                if(j == 1) { mmt_frame <- sym_sum } else
                           { mmt_frame <- bind_rows(mmt_frame, sym_sum) }

                j <- j + 1
        
        }
        
}
Symbol Date Mo_52wk
AAL 2010-01-28 0.8342105
AAL 2010-02-01 0.9552632
AAL 2010-03-01 1.0000000
AAL 2010-04-01 0.9069374
AAL 2010-05-03 0.9052453
AAL 2010-06-01 0.9720177
AAL 2010-07-07 0.8367816
AAL 2010-08-02 0.9663342
AAL 2010-09-01 0.8312500
AAL 2010-10-12 0.8300000 
## [1] "Symbols meeting threshold: 4147"

Process for Returns

The goal for the backtest is to determine if a 52-Week price range trigger of 82%, indicating a buy signal, is a potential predictor for positive returns based on the expectation of increased momentum and buying pressure for a stock. For this example, we will look at a 3 month return from the date of the trigger.

Using the backtest environment again, we will retrieve the adjusted closing prices beginning with the date of the trigger and ending 3 months after. If the trigger date is such that the calculated end data is greater than 12/30/2016, the last trading day of 2016 and the last date in our backtest environment, the recorded returns will be NA.

During the 3 month testing window, it can be expected that the stock price will have volatility and that the starting and ending prices for the window may not reflect the low and high stock prices observed. To determine the potential for returns, we will also record the highest stock price during the window. It is possible that a 3 month return may show a negative value but there is an opportunity for a positive return within the window.

The momentum data frame will be updated with the following:

Add Fields to mmt_frame

mmt_frame <- mmt_frame %>%
             mutate(Trigger_Cl = 0,
                    Period_Cl  = 0,
                    Return_3mt = 0,
                    Period_Hi  = 0,
                    Return_Hi  = 0,
                    Volume_Min = 0,
                    Volume_Avg = 0)
Symbol Date Mo_52wk Trigger_Cl Period_Cl Return_3mt Period_Hi Return_Hi Volume_Min Volume_Avg
AAL 2010-01-28 0.8342105 0 0 0 0 0 0 0
AAL 2010-02-01 0.9552632 0 0 0 0 0 0 0
AAL 2010-03-01 1.0000000 0 0 0 0 0 0 0
AAL 2010-04-01 0.9069374 0 0 0 0 0 0 0
AAL 2010-05-03 0.9052453 0 0 0 0 0 0 0

Generating the returns requires a processing loop to retrieve the symbol and date of the trigger. A target end date is generated for the 3 month window. Each month, on average, contains 4.33 weeks. So a 3 month testing window will consist of 13 weeks.

If the calculated end date falls outside the range of the backtest environment, we simply set a value of NA to the desired fields. If the date range is within the backtest environment range, we can process the record and retrieve/calculate the statistics. We will be using the adjusted close field for all of the data points.

Generate Returns

for(i in 1:nrow(mmt_frame)) {
        
        Symbol   <- mmt_frame$Symbol[i]
        Beg_Date <- as.Date(mmt_frame$Date[i])
        End_Date <- Beg_Date + dweeks(13)
        
        if(End_Date > "2016-12-31") {
                
                mmt_frame$Trigger_Cl[i]     <- NA
                mmt_frame$Period_Cl[i]      <- NA
                mmt_frame$Return_3mt[i]     <- NA
                mmt_frame$Period_Hi[i]      <- NA
                mmt_frame$Return_Hi[i]      <- NA
                mmt_frame$Volume_Min[i]     <- NA
                mmt_frame$Volume_Avg[i]     <- NA
                
        } 
        else {
                
                sym_sum    <- get(Symbol, envir = bt_env_2007_2016)
                
                date_range <- paste(as.character(Beg_Date),"/",as.character(End_Date), sep = "")
                
                sym_sum    <- data.frame(sym_sum[date_range])
                
                colnames(sym_sum) <- c("Open", "High", "Low", "Close", "Volume", "AdjClose")
                
                mmt_frame$Trigger_Cl[i] <- as.numeric(sym_sum$AdjClose[1])
                mmt_frame$Period_Cl[i]  <- as.numeric(sym_sum$AdjClose[nrow(sym_sum)])
                
                mmt_frame$Return_3mt[i] <- round((mmt_frame$Period_Cl[i]  - mmt_frame$Trigger_Cl[i])
                                                 / mmt_frame$Trigger_Cl[i], 3)
                
                mmt_frame$Period_Hi[i]  <- max(sym_sum$AdjClose)
                
                mmt_frame$Return_Hi[i]  <- round((mmt_frame$Period_Hi[i]  - mmt_frame$Trigger_Cl[i])
                                                 / mmt_frame$Trigger_Cl[i], 3)
                
                mmt_frame$Volume_Min[i] <- min(sym_sum$Volume)
                mmt_frame$Volume_Avg[i] <- round(mean(sym_sum$Volume),0)

        }
}
Symbol Date Mo_52wk Trigger_Cl Period_Cl Return_3mt Period_Hi Return_Hi Volume_Min Volume_Avg
AAL 2010-01-28 0.8342105 5.14 7.33 0.426 7.95 0.547 2837000 11838827
AAL 2010-02-01 0.9552632 5.60 7.39 0.320 7.95 0.420 2837000 11569186
AAL 2010-03-01 1.0000000 7.69 8.83 0.148 8.83 0.148 2837000 11914875
AAL 2010-04-01 0.9069374 7.40 8.65 0.169 10.74 0.451 3534900 13088125
AAL 2010-05-03 0.9052453 7.39 10.64 0.440 10.91 0.476 5781100 11206086
AAL 2010-06-01 0.9720177 8.64 9.04 0.046 10.91 0.263 3411600 9376537
AAL 2010-07-07 0.8367816 9.32 9.23 -0.010 10.91 0.171 3230200 7538443
AAL 2010-08-02 0.9663342 10.64 11.66 0.096 12.00 0.128 2231500 6826200
AAL 2010-09-01 0.8312500 9.56 11.26 0.178 12.07 0.263 2231500 5930728
AAL 2010-10-12 0.8300000 9.55 10.97 0.149 12.07 0.264 1899200 5516156

Once the data has been retrieved and the desired information stored in the data frame we can filter to remove records that do not meet our acceptance criteria. We will define the rejection criteria as the following:

The purpose of the acceptance criteria is to eliminate irregularly traded stocks which might otherwise skew the results.

Clean Momentum Frame

mmt_final <- mmt_frame %>%
             filter(complete.cases(.),
                    Trigger_Cl >= 5,
                    Trigger_Cl < 1000,
                    Volume_Min > 50000,
                    Volume_Avg >= 100000)
Symbol Date Mo_52wk Trigger_Cl Period_Cl Return_3mt Period_Hi Return_Hi Volume_Min Volume_Avg
AAL 2010-01-28 0.8342105 5.14 7.33 0.426 7.95 0.547 2837000 11838827
AAL 2010-02-01 0.9552632 5.60 7.39 0.320 7.95 0.420 2837000 11569186
AAL 2010-03-01 1.0000000 7.69 8.83 0.148 8.83 0.148 2837000 11914875
AAL 2010-04-01 0.9069374 7.40 8.65 0.169 10.74 0.451 3534900 13088125
AAL 2010-05-03 0.9052453 7.39 10.64 0.440 10.91 0.476 5781100 11206086
AAL 2010-06-01 0.9720177 8.64 9.04 0.046 10.91 0.263 3411600 9376537
AAL 2010-07-07 0.8367816 9.32 9.23 -0.010 10.91 0.171 3230200 7538443
AAL 2010-08-02 0.9663342 10.64 11.66 0.096 12.00 0.128 2231500 6826200
AAL 2010-09-01 0.8312500 9.56 11.26 0.178 12.07 0.263 2231500 5930728
AAL 2010-10-12 0.8300000 9.55 10.97 0.149 12.07 0.264 1899200 5516156 
## [1] "Total Remaining Records: 78937"

Review Results

The first thing we will review is the overall 3 month totals based on the adjusted closing prices from the beginning and end of the test window.

The function, Three_Month_Stats(), will generate the summary statistics for each of the final signal data frames and print the results.

3 Month Return Function

Three_Month_Stats <- function(temp_frame) {
        
        pos_ret_3mt <- nrow(temp_frame %>%
                            filter(Return_3mt > 0))

        neg_ret_3mt <- nrow(temp_frame %>%
                            filter(Return_3mt <= 0))

        pos_pct_3mt <- round(pos_ret_3mt / nrow(temp_frame), 3)

        avg_ret_3mt <- round(mean(temp_frame$Return_3mt), 3)

        avg_pos_ret <- round(mean(temp_frame$Return_3mt[temp_frame$Return_3mt > 0]), 3)
        avg_neg_ret <- round(mean(temp_frame$Return_3mt[temp_frame$Return_3mt <= 0]), 3)
        
        
        print(paste("  Total Positive Returns:", pos_ret_3mt))
        print(paste("  Total Negative Returns:", neg_ret_3mt))
        print(paste("Percent Positive Returns:", pos_pct_3mt))
        print(paste("          Average Return:", avg_ret_3mt))
        print(paste(" Average Positive Return:", avg_pos_ret))
        print(paste(" Average Negative Return:", avg_neg_ret))

}

3 Month Returns

Three_Month_Stats(mmt_final)
## [1] "  Total Positive Returns: 44514"
## [1] "  Total Negative Returns: 34423"
## [1] "Percent Positive Returns: 0.564"
## [1] "          Average Return: 0.021"
## [1] " Average Positive Return: 0.124"
## [1] " Average Negative Return: -0.112"

The 52 Week Price Range signal resulted in an average return of 2.1% with 56.4% of observations resulting in a positive return at the end of the testing window.

Now we can look at whether there was a potential for higher returns by looking at the period high stock price observed within the testing period instead of using the testing window closing price.

The function, Three_Month_Period(), will generate the summary statistics using the high stock price in the testing period to determine returns.

3 Month Period Returns

Three_Month_Period <- function(temp_frame) {
        
        pos_ret_per <- nrow(temp_frame %>%
                            filter(Return_Hi > 0))

        neg_ret_per <- nrow(temp_frame %>%
                            filter(Return_Hi <= 0))

        pos_pct_per <- round(pos_ret_per / nrow(temp_frame), 3)

        avg_ret_per <- round(mean(temp_frame$Return_Hi[temp_frame$Return_Hi > 0]), 3) 
        
        
        print(paste("  Total Positive Returns:", pos_ret_per))
        print(paste("  Total Negative Returns:", neg_ret_per))
        print(paste("Percent Positive Returns:", pos_pct_per))
        print(paste(" Average Positive Return:", avg_ret_per))

}

3 Month Period Returns

Three_Month_Period(mmt_final)
## [1] "  Total Positive Returns: 73461"
## [1] "  Total Negative Returns: 5476"
## [1] "Percent Positive Returns: 0.931"
## [1] " Average Positive Return: 0.127"

The 52 Week Price Range signal yielded a potential average return for positive stocks of 12.7%. This is a slight improvement on the same statistic observed when using the ending price to calculate returns. There is also an improvement in the percentage of positive returns to 93.1%.

Of course, using the average return potentially creates a false expectation of returns because large outliers can skew the statistical result. So we can look at the positive returns broken out by percentages of occurence. This helps identify a potential threshold for returns within the 3 month window that could be used as an exit point for the stock. That is, if we employ a strategy that sought a 5% return from the entry point of the stock, triggered by the 52-Week Price Range threshold, what would be the percentage of investments that would yield the desired return?

52 Week Quantiles for Positive Period Returns

quantile(mmt_final$Return_Hi[mmt_final$Return_Hi > 0], prob = seq(0, 1, length = 11), type = 5)
##    0%   10%   20%   30%   40%   50%   60%   70%   80%   90%  100% 
## 0.001 0.018 0.036 0.054 0.073 0.093 0.117 0.146 0.189 0.265 5.722

More than 70% of all observations had a 5% return or better. And around 45% had a return of 10% or better.

Finally, let’s look at the average positive returns by the price range signal using three levels:

52 Week Signal: 82-88%

round(mean(mmt_final$Return_Hi[mmt_final$Return_Hi >   0 &
                               mmt_final$Mo_52wk   < .88]), 3)
## [1] 0.13

There is a 13.0% return for stocks meeting the threshold range between 82% and 88%.

52 Week Signal: 88-94%

round(mean(mmt_final$Return_Hi[mmt_final$Return_Hi >    0 &
                               mmt_final$Mo_52wk   >= .88 &
                               mmt_final$Mo_52wk   <  .94]), 3)
## [1] 0.129

There is a 12.9% return for stocks meeting the threshold range between 88% and 94%.

52 Week Signal: 94-100%

round(mean(mmt_final$Return_Hi[mmt_final$Return_Hi >    0 &
                               mmt_final$Mo_52wk   >= .94]), 3)
## [1] 0.122

There is a 12.2% return for stocks meeting the threshold range between 94% and 100%.

Conclusion

For the case of the 52-Week Price Range trigger, it appears that the lower range of the trigger values generates the highest potential for returns. This makes sense in that the higher values are already closer to the 52-Week high and would have, in theory, less room to realize gains as the 52-Week high acts as a potential barrier.

Overall, using the price range formula does result in a large percentage of potential gains and a reasonable expectation of returns. As before, using the information from the backtest symbol table, a comparison can be made across industries and sectors to determine if there are differences worth exploring.

Another interesting possibility would be to shorten the range from 52-Weeks to 26-Weeks to capture shorter term momentum swings.

Lastly, since this type of momentum strategy is particularly useful to growth stocks, restricting the sampling to those stocks with positive Earnings Per Share growth seems appropriate to test.

sessionInfo()
## R version 3.4.0 (2017-04-21)
## Platform: x86_64-w64-mingw32/x64 (64-bit)
## Running under: Windows 10 x64 (build 15063)
## 
## Matrix products: default
## 
## locale:
## [1] LC_COLLATE=English_United States.1252 
## [2] LC_CTYPE=English_United States.1252   
## [3] LC_MONETARY=English_United States.1252
## [4] LC_NUMERIC=C                          
## [5] LC_TIME=English_United States.1252    
## 
## attached base packages:
## [1] stats     graphics  grDevices utils     datasets  methods   base     
## 
## other attached packages:
## [1] knitr_1.16      lubridate_1.6.0 dplyr_0.5.0     quantmod_0.4-9 
## [5] TTR_0.23-1      xts_0.9-7       zoo_1.8-0      
## 
## loaded via a namespace (and not attached):
##  [1] Rcpp_0.12.11     magrittr_1.5     lattice_0.20-35  R6_2.2.1        
##  [5] rlang_0.1.1      stringr_1.2.0    highr_0.6        tools_3.4.0     
##  [9] grid_3.4.0       DBI_0.6-1        htmltools_0.3.6  lazyeval_0.2.0  
## [13] yaml_2.1.14      rprojroot_1.2    digest_0.6.12    assertthat_0.2.0
## [17] tibble_1.3.3     evaluate_0.10    rmarkdown_1.5    stringi_1.1.5   
## [21] compiler_3.4.0   backports_1.1.0