Created
November 20, 2012 03:26
-
-
Save timelyportfolio/4115759 to your computer and use it in GitHub Desktop.
Single Asset REDD-COPS
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
#explore Rolling Economic Drawdown - Controlled Optimal Portfolio Strategy (REDD-COPS) | |
#from Yang, Z. George and Zhong, Liang, | |
#Optimal Portfolio Strategy to Control Maximum Drawdown - | |
#The Case of Risk Based Dynamic Asset Allocation (February 25, 2012). | |
#Available at SSRN: http://ssrn.com/abstract=2053854 or | |
#http://dx.doi.org/10.2139/ssrn.2053854 | |
require(quantmod) | |
require(PerformanceAnalytics) | |
require(RColorBrewer) | |
#get sp500 for first attempt | |
getSymbols("^GSPC", from = "1900-01-01") | |
GSPC.monthly <- to.monthly(GSPC)[,4] | |
index(GSPC.monthly) <- as.Date(index(GSPC.monthly)) | |
roc <- ROC(GSPC.monthly, n = 1, type = "discrete") | |
#get 1 year t-bill for risk-free | |
getSymbols("GS1", src = "FRED") | |
#combine the monthly SP500 return with a monthly return of GS1 1 year treasury | |
returns <- na.omit( merge(roc, ((1+lag(GS1,1) / 100) ^ (1/12)) - 1) ) | |
cumreturns <- cumprod(1+returns) | |
#calculate REDD assuming 1st column is risky asset and 2nd is risk-free | |
REDD <- function(x, rf) { | |
rf <- rf[index(x)] | |
result <- 1 - last(x) / | |
( coredata(max(x)) * coredata(last(rf)) / coredata(first(rf[index(x[which(x==max(x))])])) ) | |
return(result) | |
} | |
#get REDD for SP500 | |
#paper says | |
#"Intuitively, a drawdown look-back period H somewhat shorter than or similar to the | |
#market decline cycle is the key to achieve optimality. Substituting EDD with a lower | |
#REDD in equation (1), we have higher risky asset allocation to improve portfolio return | |
#during a market rebound phase. In the examples followed, we'll use H = 1 year throughout." | |
GSPC.redd <- rollapplyr(cumreturns[,1], width = 12, FUN = REDD, rf=cumreturns[,2]) | |
#experiment with a couple different Sharpe options | |
GSPC.sharpe <- na.omit( runMax(lag(rollapplyr(returns[,1], width = 36, FUN = SharpeRatio, Rf = 0, p = 0.95, "StdDev"),12), | |
n = 36) ) | |
#another sharpe alternative | |
#GSPC.sharpe <- 1 - na.omit( runMin(lag(rollapplyr(returns[,1], width = 36, FUN = SharpeRatio, Rf = 0, p = 0.95, "StdDev"),12), | |
# n = 12) ) | |
#if you would like to use a constant Sharpe, specify here and uncomment | |
#the paper uses a little hindsight to use the historic 0.403 Sharpe | |
#GSPC.sharpe <- 0.403 | |
#feel free to experiment here | |
#I will specify 0.2 | |
drawdown.limit <- 0.20 | |
position.size <- as.xts(apply(( (GSPC.sharpe/drawdown.limit + 0.5) / (1-drawdown.limit^2) ) * | |
#( (drawdown.limit - GSPC.redd) / (1 - GSPC.redd) ), MARGIN = 1, FUN = max, 0), order.by = index(GSPC.redd)) | |
( (drawdown.limit - GSPC.redd) / (1 - GSPC.redd) ), MARGIN = 1, FUN = max, 0), order.by = index(GSPC.sharpe)) | |
plot(position.size) | |
sum(position.size)/NROW(position.size) | |
#charts.PerformanceSummary(merge(lag(position.size)*roc, roc)) | |
return.comps <- merge(lag(position.size)*returns[,1] + lag(1-position.size) * returns[,2], returns[,1], returns[,2]) | |
colnames(return.comps) <- c("REDD-COPS","SP500","US1Y") | |
charts.PerformanceSummary(return.comps, ylog=TRUE, | |
colorset=brewer.pal(10,"Spectral")[c(2,4,7)], #Thanksgiving but ugly colors | |
main="REDD-COPS System Test (http://ssrn.com/abstract=2053854)") |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment