Single Asset REDD-COPS

REDD-COPS on sp500.r

#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)")