[Returnanalytics-commits] r2716 - pkg/PerformanceAnalytics/sandbox/pulkit/week6
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sun Aug 4 18:00:36 CEST 2013
Author: pulkit
Date: 2013-08-04 18:00:35 +0200 (Sun, 04 Aug 2013)
New Revision: 2716
Added:
pkg/PerformanceAnalytics/sandbox/pulkit/week6/DrawdownBeta.R
Modified:
pkg/PerformanceAnalytics/sandbox/pulkit/week6/CDaRMultipath.R
pkg/PerformanceAnalytics/sandbox/pulkit/week6/CdaR.R
Log:
Added files for drawdown beta
Modified: pkg/PerformanceAnalytics/sandbox/pulkit/week6/CDaRMultipath.R
===================================================================
--- pkg/PerformanceAnalytics/sandbox/pulkit/week6/CDaRMultipath.R 2013-08-03 14:00:31 UTC (rev 2715)
+++ pkg/PerformanceAnalytics/sandbox/pulkit/week6/CDaRMultipath.R 2013-08-04 16:00:35 UTC (rev 2716)
@@ -13,12 +13,12 @@
#'
#' \deqn{Q = \left\{ \left\{ q_st\right\}_{s,t=1}^{S,T} | \sum_{s = 1}^S \sum_{t = 1}^T{p_s}{q_st} = 1, 0{\leq}q_st{\leq}\frac{1}{(1-\alpha)T}, s = 1....S, t = 1.....T \right\}}
#'
-#' For \eqn{\alpha = 1} , \eqn{D_\alpha(w)} is defined by (3) with the constraint \eqn{0{\leq}q_st{\leq}\frac{1}{(1-\alpha)T}},
-#' in Q replaced by \eqn{q_st{\geq}0}
+#' For \eqn{\alpha = 1} , \eqn{D_\alpha(w)} is defined by (3) with the constraint
+#' \eqn{0{\leq}q_st{\leq}\frac{1}{(1-\alpha)T}}, in Q replaced by \eqn{q_st{\geq}0}
#'
-#' As in the case of a single sample-path, the CDaR definition includes two special cases : (i) for \eqn{\alpha = 1},
-#' \eqn{D_1(w)} is the maximum drawdown, also called drawdown from peak-to-valley, and (ii) for \eqn{\alpha} = 0, \eqn{D_\alpha(w)}
-#' is the average drawdown
+#' As in the case of a single sample-path, the CDaR definition includes two special cases :
+#' (i) for \eqn{\alpha = 1},\eqn{D_1(w)} is the maximum drawdown, also called drawdown from
+#' peak-to-valley, and (ii) for \eqn{\alpha} = 0, \eqn{D_\alpha(w)} is the average drawdown
#'
#'@param R an xts, vector, matrix,data frame, timeSeries or zoo object of multiple sample path returns
#'@param ps the probability for each sample path
@@ -41,26 +41,26 @@
R = na.omit(R)
nr = nrow(R)
# checking if nr*p is an integer
- drawdowns = -as.matrix(Drawdowns(R))
+
+ multicdar<-function(x){
if((p*nr) %% 1 == 0){
- drawdowns = as.matrix(Drawdowns(R))
+ drawdowns = as.matrix(Drawdowns(x))
drawdowns = drawdowns(order(drawdowns),decreasing = TRUE)
# average of the drawdowns greater the (1-alpha).100% largest drawdowns
- result = (1/((1-p)*nr(R)))*sum(drawdowns[((1-p)*nr):nr])
+ result = (1/((1-p)*nr(x)))*sum(drawdowns[((1-p)*nr):nr])
}
else{ # 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(x))
-
# 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[i,j])
+ f.obj = c(f.obj,ps[i]*drawdowns[j,i])
}
}
- print(f.obj)
-
+ f.con = NULL
# constraint 1: ps.qst = 1
for(i in 1:sample){
for(j in 1:nr){
@@ -68,17 +68,17 @@
}
}
f.con = matrix(f.con,nrow =1)
- f.dir = "="
+ 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)*s+j] = 1
+ r[(i-1)*sample+j] = 1
f.con = rbind(f.con,r)
}
}
- f.dir = c(f.dir,">=",sample*nr)
+ f.dir = c(f.dir,rep(">=",sample*nr))
f.rhs = c(f.rhs,rep(0,sample*nr))
@@ -86,11 +86,11 @@
for(i in 1:sample){
for(j in 1:nr){
r<-rep(0,sample*nr)
- r[(i-1)*s+j] = 1
+ r[(i-1)*sample+j] = 1
f.con = rbind(f.con,r)
}
}
- f.dir = c(f.dir,"<=",sample*nr)
+ f.dir = c(f.dir,rep("<=",sample*nr))
f.rhs = c(f.rhs,rep(1/(1-p)*nr,sample*nr))
# constraint 1:
@@ -114,20 +114,22 @@
# f.con = rbind(f.con,cbind(diag(nr),matrix(0,nr,nr),1))
# f.dir = c(rep(">=",nr))
# f.rhs = c(f.rhs,rep(0,nr))
-
val = lp("max",f.obj,f.con,f.dir,f.rhs)
result = val$objval
}
-
- R = checkData(R, method = "matrix")
+}
+ R = checkData(R, method = "matrix")
result = matrix(nrow = 1, ncol = ncol(R))
- for (i in 1:ncol(R)) {
- result[i] <- CDD(R[, i, drop = FALSE], p = p,
- geometric = geometric, invert = invert, ... = ...)
+ 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] <- multicdar(ret)
}
dim(result) = c(1, NCOL(R))
colnames(result) = colnames(R)
rownames(result) = paste("Conditional Drawdown ",
p * 100, "%", sep = "")
return(result)
-}
\ No newline at end of file
+}
Modified: pkg/PerformanceAnalytics/sandbox/pulkit/week6/CdaR.R
===================================================================
--- pkg/PerformanceAnalytics/sandbox/pulkit/week6/CdaR.R 2013-08-03 14:00:31 UTC (rev 2715)
+++ pkg/PerformanceAnalytics/sandbox/pulkit/week6/CdaR.R 2013-08-04 16:00:35 UTC (rev 2716)
@@ -12,36 +12,36 @@
result = -(1/((1-p)*nr))*sum(drawdowns[((p)*nr):nr])
}
else{
-
- result = ES(Drawdowns(R),p=p,method="historical")
+ # CDaR using the CVaR function
+ # result = ES(Drawdowns(R),p=p,method="historical")
# if nr*p is not an integer
-# f.obj = c(rep(0,nr),rep((1/(1-p))*(1/nr),nr),1)
+ f.obj = c(rep(0,nr),rep(((1/(1-p))*(1/nr)),nr),1)
# k varies from 1:nr
# constraint : zk -uk +y >= 0
-# f.con = cbind(-diag(nr),diag(nr),1)
-# f.dir = c(rep(">=",nr))
-# f.rhs = c(rep(0,nr))
+ f.con = cbind(-diag(nr),diag(nr),1)
+ f.dir = c(rep(">=",nr))
+ f.rhs = c(rep(0,nr))
# constraint : uk -uk-1 >= -rk
-# ut = diag(nr)
-# ut[-1,-nr] = ut[-1,-nr] - diag(nr - 1)
-# f.con = rbind(f.con,cbind(ut,matrix(0,nr,nr),1))
-# f.dir = c(rep(">=",nr))
-# f.rhs = c(f.rhs,-R)
+ ut = diag(nr)
+ ut[-1,-nr] = ut[-1,-nr] - diag(nr - 1)
+ f.con = rbind(f.con,cbind(ut,matrix(0,nr,nr),0))
+ f.dir = c(rep(">=",nr))
+ f.rhs = c(f.rhs,-R)
# constraint : zk >= 0
-# f.con = rbind(f.con,cbind(matrix(0,nr,nr),diag(nr),1))
-# f.dir = c(rep(">=",nr))
-# f.rhs = c(f.rhs,rep(0,nr))
+ f.con = rbind(f.con,cbind(matrix(0,nr,nr),diag(nr),0))
+ f.dir = c(rep(">=",nr))
+ f.rhs = c(f.rhs,rep(0,nr))
# constraint : uk >= 0
-# f.con = rbind(f.con,cbind(diag(nr),matrix(0,nr,nr),1))
-# f.dir = c(rep(">=",nr))
-# f.rhs = c(f.rhs,rep(0,nr))
+ f.con = rbind(f.con,cbind(diag(nr),matrix(0,nr,nr),0))
+ f.dir = c(rep(">=",nr))
+ f.rhs = c(f.rhs,rep(0,nr))
-# val = lp("min",f.obj,f.con,f.dir,f.rhs)
-# result = val$objval
+ val = lp("min",f.obj,f.con,f.dir,f.rhs)
+ result = -val$objval
}
if (invert)
result <- -result
@@ -58,7 +58,7 @@
}
dim(result) = c(1, NCOL(R))
colnames(result) = colnames(R)
- rownames(result) = paste("Conditional Drawdown ", p*100, "%", sep = "")
+ rownames(result) = paste("Conditional Drawdown ", round(p,3)*100, "%", sep = "")
}
else {
portret <- Return.portfolio(R, weights = weights,
Added: pkg/PerformanceAnalytics/sandbox/pulkit/week6/DrawdownBeta.R
===================================================================
--- pkg/PerformanceAnalytics/sandbox/pulkit/week6/DrawdownBeta.R (rev 0)
+++ pkg/PerformanceAnalytics/sandbox/pulkit/week6/DrawdownBeta.R 2013-08-04 16:00:35 UTC (rev 2716)
@@ -0,0 +1,83 @@
+#'@title
+#'Drawdown Beta for single path
+#'
+#'@description
+#'The drawdown beta is formulated as follows
+#'
+#'\deqn{\beta_DD = \frac{{\sum_{t=1}^T}{q_t^\asterisk}{(w_{k^{\asterisk}(t)}-w_t)}}{D_{\alpha}(w^M)}}
+#' here \eqn{\beta_DD} is the drawdown beta of the instrument.
+#'\eqn{k^{\asterisk}(t)\in{argmax_{t_{\tau}{\le}k{\le}t}}w_k^M}
+#'
+#'\eqn{q_t^\asterisk=1/((1-\alpha)T)} if \eqn{d_t^M} is one of the
+#'\eqn{(1-\alpha)T} largest drawdowns \eqn{d_1^{M} ,......d_t^M} of the
+#'optimal portfolio and \eqn{q_t^\asterisk = 0} otherwise. It is assumed
+#'that \eqn{D_\alpha(w^M) {\neq} 0} and that \eqn{q_t^\asterisk} and
+#'\eqn{k^{\asterisk}(t) are uniquely determined for all \eqn{t = 1....T}
+#'
+#'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 invert TRUE/FALSE whether to invert the drawdown measure. see Details.
+#'@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.
+
+BetaDrawdown<-function(R,Rm,h,p=0.95,weights=NULL,geometric=TRUE,invert=TRUE,...){
+
+ x = checkData(R)
+ xm = checkData(Rm)
+ columnnames = colnames(R)
+ columns = ncol(R)
+ drawdowns_m = Drawdowns(Rm)
+ if(!is.null(weights)){
+ x = Returns.portfolio(R,weights)
+ }
+ if(geometric){
+ cumul_x = cumprod(x+1)-1
+ }
+ else{
+ cumul_x = cumsum(x)
+ }
+ beta<-function(x){
+ q = NULL
+ q_quantile = quantile(drawdowns_m,1-p)
+ for(i in 1:nrow(Rm)){
+
+ if(drawdowns_m[i]<q_quantile){
+ q = c(q,i)
+ }
+ else q = c(q,0)
+ }
+ beta_dd = sum((x[which(x==max(xm))]-x)[q])/CDaR(Rm,p=p)
+ }
+
+ for(column in columns){
+ column.beta = beta(x[,column])
+ if(column == 1){
+ beta = column.beta
+ }
+ else beta = merge(beta,column.beta)
+ }
+ if(invert){
+ }
+ colnames(beta) = columnnames
+ beta = reclass(beta,R)
+ return(beta)
+
+}
More information about the Returnanalytics-commits
mailing list