[Returnanalytics-commits] r2751 - pkg/PerformanceAnalytics/sandbox/pulkit/week6
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Fri Aug 9 17:36:39 CEST 2013
Author: pulkit
Date: 2013-08-09 17:36:39 +0200 (Fri, 09 Aug 2013)
New Revision: 2751
Added:
pkg/PerformanceAnalytics/sandbox/pulkit/week6/DrawdownBetaMulti.R
Modified:
pkg/PerformanceAnalytics/sandbox/pulkit/week6/CDaRMultipath.R
pkg/PerformanceAnalytics/sandbox/pulkit/week6/CdaR.R
Log:
Multipath CDaR Drawdown
Modified: pkg/PerformanceAnalytics/sandbox/pulkit/week6/CDaRMultipath.R
===================================================================
--- pkg/PerformanceAnalytics/sandbox/pulkit/week6/CDaRMultipath.R 2013-08-09 13:09:18 UTC (rev 2750)
+++ pkg/PerformanceAnalytics/sandbox/pulkit/week6/CDaRMultipath.R 2013-08-09 15:36:39 UTC (rev 2751)
@@ -37,12 +37,18 @@
CdarMultiPath<-function (R,ps,sample,instr, geometric = TRUE,p = 0.95, ...)
{
+
#p = .setalphaprob(p)
R = na.omit(R)
nr = nrow(R)
- # checking if nr*p is an integer
+ # ERROR HANDLING and TESTING
+ #if(sample == instr){
+
+ #}
+
multicdar<-function(x){
+ # checking if nr*p is an integer
if((p*nr) %% 1 == 0){
drawdowns = as.matrix(Drawdowns(x))
drawdowns = drawdowns(order(drawdowns),decreasing = TRUE)
@@ -119,7 +125,8 @@
}
}
R = checkData(R, method = "matrix")
- result = matrix(nrow = 1, ncol = ncol(R))
+ result = matrix(nrow = 1, ncol = ncol(R)/sample)
+
for (i in 1:(ncol(R)/sample)) {
ret<-NULL
for(j in 1:sample){
@@ -127,8 +134,8 @@
}
result[i] <- multicdar(ret)
}
- dim(result) = c(1, NCOL(R))
- colnames(result) = colnames(R)
+ dim(result) = c(1, NCOL(R)/sample)
+ colnames(result) = colnames(R)[1:ncol(R)/sample]
rownames(result) = paste("Conditional Drawdown ",
p * 100, "%", sep = "")
return(result)
Modified: pkg/PerformanceAnalytics/sandbox/pulkit/week6/CdaR.R
===================================================================
--- pkg/PerformanceAnalytics/sandbox/pulkit/week6/CdaR.R 2013-08-09 13:09:18 UTC (rev 2750)
+++ pkg/PerformanceAnalytics/sandbox/pulkit/week6/CdaR.R 2013-08-09 15:36:39 UTC (rev 2751)
@@ -18,7 +18,7 @@
f.obj = c(rep(0,nr),rep(((1/(1-p))*(1/nr)),nr),1)
# k varies from 1:nr
- # constraint : zk -uk +y >= 0
+ # constraint : -uk +zk +y >= 0
f.con = cbind(-diag(nr),diag(nr),1)
f.dir = c(rep(">=",nr))
f.rhs = c(rep(0,nr))
@@ -41,6 +41,7 @@
f.rhs = c(f.rhs,rep(0,nr))
val = lp("min",f.obj,f.con,f.dir,f.rhs)
+ val_disp = lp("min",f.obj,f.con,f.dir,f.rhs,compute.sens = TRUE )
result = -val$objval
}
if (invert)
Added: pkg/PerformanceAnalytics/sandbox/pulkit/week6/DrawdownBetaMulti.R
===================================================================
--- pkg/PerformanceAnalytics/sandbox/pulkit/week6/DrawdownBetaMulti.R (rev 0)
+++ pkg/PerformanceAnalytics/sandbox/pulkit/week6/DrawdownBetaMulti.R 2013-08-09 15:36:39 UTC (rev 2751)
@@ -0,0 +1,159 @@
+#'@title
+#'Drawdown Beta for Multiple path
+#'
+#'@description
+#'The drawdown beta is formulated as follows
+#'
+#'\deqn{\beta_DD^i = \frac{{\sum_{s=1}^S}{\sum_{t=1}^T}p_s{q_t^\asterisk}{(w_{s,k^{\asterisk}(s,t)^i}-w_{st}^i)}}{D_{\alpha}(w^M)}}
+#' here \eqn{\beta_DD} is the drawdown beta of the instrument for multiple sample path.
+#'\eqn{k^{\asterisk}(s,t)\in{argmax_{t_{\tau}{\le}k{\le}t}}w_{sk}^p(x^\asterisk)}
+#'
+#'The numerator in \eqn{\beta_DD} is the average rate of return of the
+#'instrument over time periods corresponding to the \eqn{(1-\alpha)T} largest
+#'drawdowns of the optimal portfolio, where \eqn{w_t - w_k^{\asterisk}(t)}
+#'is the cumulative rate of return of the instrument from the optimal portfolio
+#' peak time \eqn{k^\asterisk(t)} to time t.
+#'
+#'The difference in CDaR and standard betas can be explained by the
+#'conceptual difference in beta definitions: the standard beta accounts for
+#'the fund returns over the whole return history, including the periods
+#'when the market goes up, while CDaR betas focus only on market drawdowns
+#'and, thus, are not affected when the market performs well.
+#'
+#'@param R an xts, vector, matrix, data frame, timeSeries or zoo object of asset returns
+#'@param Rm Return series of the optimal portfolio an xts, vector, matrix, data frame, timeSeries or zoo object of asset returns
+#'@param p confidence level for calculation ,default(p=0.95)
+#'@param weights portfolio weighting vector, default NULL, see Details
+#' @param geometric utilize geometric chaining (TRUE) or simple/arithmetic chaining (FALSE) to aggregate returns, default TRUE
+#' @param type The type of BetaDrawdown if specified alpha then the alpha value given is taken (default 0.95). If "average" then
+#' alpha = 0 and if "max" then alpha = 1 is taken.
+#'@param \dots any passthru variable.
+#'
+#'@references
+#'Zabarankin, M., Pavlikov, K., and S. Uryasev. Capital Asset Pricing Model
+#'(CAPM) with Drawdown Measure.Research Report 2012-9, ISE Dept., University
+#'of Florida,September 2012.
+#'
+#'@examples
+#'
+#'BetaDrawdown(edhec[,1],edhec[,2]) #expected value 0.5390431
+
+MultiBetaDrawdown<-function(R,Rm,h=0,p=0.95,weights=NULL,geometric=TRUE,type=c("alpha","average","max"),...){
+
+ # DESCRIPTION:
+ #
+ # The function is used to find the Drawdown Beta for multiple sample path.
+ #
+ # INPUT:
+ # The Return series of the portfolio and the optimal portfolio
+ # is taken as the input.
+ #
+ # OUTPUT:
+ # The Drawdown beta for multiple sample path is given as the output.
+
+
+ x = checkData(R)
+ xm = checkData(Rm)
+ columnnames = colnames(R)
+ columns = ncol(R)
+ drawdowns_m = Drawdowns(Rm)
+ type = type[1]
+ if(type=="average"){
+ p = 0
+ }
+ if(type == "max"){
+ p = 1
+ }
+ # if nr*p is not an integer
+ #f.obj = c(rep(0,nr),rep((1/(1-p))*(1/nr),nr),1)
+ drawdowns = -as.matrix(drawdowns_m)
+ # Optimization to define Q for the optimal portfolio
+ # The objective function is defined
+ f.obj = NULL
+ for(i in 1:sample){
+ for(j in 1:nr){
+ f.obj = c(f.obj,ps[i]*drawdowns[j,i])
+ }
+ }
+ f.con = NULL
+ # constraint 1: ps.qst = 1
+ for(i in 1:sample){
+ for(j in 1:nr){
+ f.con = c(f.con,ps[i])
+ }
+ }
+ f.con = matrix(f.con,nrow =1)
+ f.dir = "=="
+ f.rhs = 1
+ # constraint 2 : qst >= 0
+ for(i in 1:sample){
+ for(j in 1:nr){
+ r<-rep(0,sample*nr)
+ r[(i-1)*sample+j] = 1
+ f.con = rbind(f.con,r)
+ }
+ }
+ f.dir = c(f.dir,rep(">=",sample*nr))
+ f.rhs = c(f.rhs,rep(0,sample*nr))
+
+
+ # constraint 3 : qst =< 1/(1-alpha)*T
+ for(i in 1:sample){
+ for(j in 1:nr){
+ r<-rep(0,sample*nr)
+ r[(i-1)*sample+j] = 1
+ f.con = rbind(f.con,r)
+ }
+ }
+ f.dir = c(f.dir,rep("<=",sample*nr))
+ f.rhs = c(f.rhs,rep(1/(1-p)*nr,sample*nr))
+
+ val = lp("max",f.obj,f.con,f.dir,f.rhs)
+ q = matrix(val$solutions,ncol = sample)
+
+ # TODO INCORPORATE WEIGHTS
+
+ if(geometric){
+ cumul_xm = cumprod(xm+1)-1
+ }
+ else{
+ cumul_xm = cumsum(xm)
+ }
+ # Function to calculate Drawdown beta for multipath
+ multiDDbeta<-function(x){
+ boolean = (cummax(cumul_xm)==cumul_xm)
+ index = NULL
+ for(j in 1:nrow(Rm)){
+ if(boolean[j] == TRUE){
+ index = c(index,j)
+ b = j
+ }
+ else{
+ index = c(index,b)
+ }
+ }
+ for(i in 1:sample){
+ for(j in 1:nrow(x)){
+
+ beta_dd = (p[i]*q[j,i]*(x[index,i]-x[,i]))/CDaR(Rm,p=p)
+ return(beta_dd)
+ }
+
+ result = matrix(nrow = 1, ncol = ncol(R)/sample)
+
+ for (i in 1:(ncol(R)/sample)) {
+ ret<-NULL
+ for(j in 1:sample){
+ ret<-cbind(ret,R[,(j-1)*ncol(R)/sample+i])
+ }
+ result[i] <- multiDDbeta(ret)
+ }
+
+ dim(result) = c(1, NCOL(R)/sample)
+ colnames(result) = colnames(R)[1:ncol(R)/sample]
+ rownames(result) = paste("Conditional Drawdown ",
+
+
+}
+
+
More information about the Returnanalytics-commits
mailing list