public
Created

Single Asset REDD-COPS

  • Download Gist
REDD-COPS on sp500.r
R
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69
#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)")

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.