[Returnanalytics-commits] r2794 - in pkg/PerformanceAnalytics/sandbox/pulkit: . R data src vignettes week1/code week1/vignette week2/code week2/vignette week3_4/code week3_4/vignette week5 week6 week7
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Fri Aug 16 10:53:23 CEST 2013
Author: pulkit
Date: 2013-08-16 10:53:23 +0200 (Fri, 16 Aug 2013)
New Revision: 2794
Added:
pkg/PerformanceAnalytics/sandbox/pulkit/R/BenchmarkPlots.R
pkg/PerformanceAnalytics/sandbox/pulkit/R/BenchmarkSR.R
pkg/PerformanceAnalytics/sandbox/pulkit/R/CDaRMultipath.R
pkg/PerformanceAnalytics/sandbox/pulkit/R/CdaR.R
pkg/PerformanceAnalytics/sandbox/pulkit/R/DrawdownBeta.R
pkg/PerformanceAnalytics/sandbox/pulkit/R/DrawdownBetaMulti.R
pkg/PerformanceAnalytics/sandbox/pulkit/R/Drawdownalpha.R
pkg/PerformanceAnalytics/sandbox/pulkit/R/EDDCOPS.R
pkg/PerformanceAnalytics/sandbox/pulkit/R/Edd.R
pkg/PerformanceAnalytics/sandbox/pulkit/R/ExtremeDrawdown.R
pkg/PerformanceAnalytics/sandbox/pulkit/R/GoldenSection.R
pkg/PerformanceAnalytics/sandbox/pulkit/R/MaxDD.R
pkg/PerformanceAnalytics/sandbox/pulkit/R/MinTRL.R
pkg/PerformanceAnalytics/sandbox/pulkit/R/MonteSimulTriplePenance.R
pkg/PerformanceAnalytics/sandbox/pulkit/R/PSRopt.R
pkg/PerformanceAnalytics/sandbox/pulkit/R/ProbSharpeRatio.R
pkg/PerformanceAnalytics/sandbox/pulkit/R/REDDCOPS.R
pkg/PerformanceAnalytics/sandbox/pulkit/R/REM.R
pkg/PerformanceAnalytics/sandbox/pulkit/R/SRIndifferenceCurve.R
pkg/PerformanceAnalytics/sandbox/pulkit/R/TriplePenance.R
pkg/PerformanceAnalytics/sandbox/pulkit/R/TuW.R
pkg/PerformanceAnalytics/sandbox/pulkit/R/chart.Penance.R
pkg/PerformanceAnalytics/sandbox/pulkit/R/chart.REDD.R
pkg/PerformanceAnalytics/sandbox/pulkit/R/chart.SharpeEfficient.R
pkg/PerformanceAnalytics/sandbox/pulkit/R/edd.R
pkg/PerformanceAnalytics/sandbox/pulkit/R/redd.R
pkg/PerformanceAnalytics/sandbox/pulkit/R/table.PSR.R
pkg/PerformanceAnalytics/sandbox/pulkit/R/table.Penance.R
pkg/PerformanceAnalytics/sandbox/pulkit/data/
pkg/PerformanceAnalytics/sandbox/pulkit/data/data.csv
pkg/PerformanceAnalytics/sandbox/pulkit/data/data1.csv
pkg/PerformanceAnalytics/sandbox/pulkit/data/data3.csv
pkg/PerformanceAnalytics/sandbox/pulkit/data/ret.csv
pkg/PerformanceAnalytics/sandbox/pulkit/src/moment.c
pkg/PerformanceAnalytics/sandbox/pulkit/vignettes/ProbSharpe.Rnw
pkg/PerformanceAnalytics/sandbox/pulkit/vignettes/REDDCOPS.Rnw
pkg/PerformanceAnalytics/sandbox/pulkit/vignettes/SharepRatioEfficientFrontier.Rnw
pkg/PerformanceAnalytics/sandbox/pulkit/vignettes/TriplePenance.Rnw
Removed:
pkg/PerformanceAnalytics/sandbox/pulkit/week1/code/MinTRL.R
pkg/PerformanceAnalytics/sandbox/pulkit/week1/code/PSRopt.R
pkg/PerformanceAnalytics/sandbox/pulkit/week1/code/ProbSharpeRatio.R
pkg/PerformanceAnalytics/sandbox/pulkit/week1/code/chart.SharpeEfficient.R
pkg/PerformanceAnalytics/sandbox/pulkit/week1/code/data.csv
pkg/PerformanceAnalytics/sandbox/pulkit/week1/code/moment.c
pkg/PerformanceAnalytics/sandbox/pulkit/week1/code/table.PSR.R
pkg/PerformanceAnalytics/sandbox/pulkit/week1/vignette/ProbSharpe.Rnw
pkg/PerformanceAnalytics/sandbox/pulkit/week2/code/BenchmarkPlots.R
pkg/PerformanceAnalytics/sandbox/pulkit/week2/code/BenchmarkSR.R
pkg/PerformanceAnalytics/sandbox/pulkit/week2/code/SRIndifferenceCurve.R
pkg/PerformanceAnalytics/sandbox/pulkit/week2/vignette/SharepRatioEfficientFrontier.Rnw
pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/GoldenSection.R
pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/MaxDD.R
pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/MonteSimulTriplePenance.R
pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/TriplePenance.R
pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/TuW.R
pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/chart.Penance.R
pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/data1.csv
pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/table.Penance.R
pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/vignette/TriplePenance.Rnw
pkg/PerformanceAnalytics/sandbox/pulkit/week5/EDDCOPS.R
pkg/PerformanceAnalytics/sandbox/pulkit/week5/REDDCOPS.R
pkg/PerformanceAnalytics/sandbox/pulkit/week5/REDDCOPS.Rnw
pkg/PerformanceAnalytics/sandbox/pulkit/week5/REM.R
pkg/PerformanceAnalytics/sandbox/pulkit/week5/chart.REDD.R
pkg/PerformanceAnalytics/sandbox/pulkit/week5/edd.R
pkg/PerformanceAnalytics/sandbox/pulkit/week5/redd.R
pkg/PerformanceAnalytics/sandbox/pulkit/week5/ret.csv
pkg/PerformanceAnalytics/sandbox/pulkit/week6/CDaRMultipath.R
pkg/PerformanceAnalytics/sandbox/pulkit/week6/CdaR.R
pkg/PerformanceAnalytics/sandbox/pulkit/week6/DrawdownBeta.R
pkg/PerformanceAnalytics/sandbox/pulkit/week6/DrawdownBetaMulti.R
pkg/PerformanceAnalytics/sandbox/pulkit/week6/Drawdownalpha.R
pkg/PerformanceAnalytics/sandbox/pulkit/week6/data.csv
pkg/PerformanceAnalytics/sandbox/pulkit/week7/ExtremeDrawdown.R
Modified:
pkg/PerformanceAnalytics/sandbox/pulkit/week1/vignette/ProbSharpe.pdf
Log:
Moving files into R directory
Copied: pkg/PerformanceAnalytics/sandbox/pulkit/R/BenchmarkPlots.R (from rev 2790, pkg/PerformanceAnalytics/sandbox/pulkit/week2/code/BenchmarkPlots.R)
===================================================================
--- pkg/PerformanceAnalytics/sandbox/pulkit/R/BenchmarkPlots.R (rev 0)
+++ pkg/PerformanceAnalytics/sandbox/pulkit/R/BenchmarkPlots.R 2013-08-16 08:53:23 UTC (rev 2794)
@@ -0,0 +1,145 @@
+#'@title Benchmark Sharpe Ratio Plots
+#'
+#'@description
+#'Benchmark Sharpe Ratio Plots are used to give the relation ship between the
+#'Benchmark Sharpe Ratio and average correlation,average sharpe ratio or the number of #'strategies keeping other parameters constant. Here average Sharpe ratio , average #'correlation stand for the average of all the strategies in the portfolio. The original
+#'point of the return series is also shown on the plots.
+#'
+#'The equation for the Benchamark Sharpe Ratio is.
+#'
+#'\deqn{SR_B = \overline{SR}\sqrt{\frac{S}{1+(S-1)\overline{\rho}}}}
+#'
+#'Here \eqn{S} is the number of strategies and \eqn{\overline{\rho}} is the average
+#'correlation across off diagonal elements and is given by
+#'
+#'\deqn{\overline{\rho} = \frac{2\sum_{s=1}^{S} \sum_{t=s+1}^{S} \rho_{S,t}}{S(S-1)}}
+#'
+#'@param R an xts, vector, matrix, data frame, timeSeries or zoo object of
+#' asset returns
+#'@param ylab set the y-axis label, as in \code{\link{plot}}
+#'@param xlab set the x-axis label, as in \code{\link{plot}}
+#'@param main set the chart title, as in \code{\link{plot}}
+#'@param element.color set the element.color value as in \code{\link{plot}}
+#'@param lwd set the width of the line, as in \code{\link{plot}}
+#'@param pch set the pch value, as in \code{\link{plot}}
+#'@param cex set the cex value, as in \code{\link{plot}}
+#'@param cex.axis set the cex.axis value, as in \code{\link{plot}}
+#'@param cex.main set the cex.main value, as in \code{\link{plot}}
+#'@param vs The values against which benchmark SR has to be plotted. can be
+#'"sharpe","correlation" or "strategies"
+#'@param ylim set the ylim value, as in \code{\link{plot}}
+#'@param xlim set the xlim value, as in \code{\link{plot}}
+
+#'@references
+#'Bailey, David H. and Lopez de Prado, Marcos, The Strategy Approval Decision:
+#'A Sharpe Ratio Indifference Curve Approach (January 2013). Algorithmic Finance,
+#'Vol. 2, No. 1 (2013).
+#'
+#'@seealso \code{\link{plot}}
+#'@keywords ts multivariate distribution models hplot
+#'@examples
+#'
+#'chart.BenchmarkSR(edhec,vs="strategies")
+#'chart.BenchmarkSR(edhec,vs="sharpe")
+#'@export
+
+chart.BenchmarkSR<-function(R=NULL,main=NULL,ylab = NULL,xlab = NULL,element.color="darkgrey",lwd = 2,pch = 1,cex = 1,cex.axis=0.8,cex.lab = 1,cex.main = 1,vs=c("sharpe","correlation","strategies"),xlim = NULL,ylim = NULL,...){
+
+ # DESCRIPTION:
+ # Draws Benchmark SR vs various variables such as average sharpe ,
+ # average correlation and the number of strategies
+
+ # INPUT:
+ # The Return Series of the portfolio is taken as the input. The Return
+ # Series can be an xts, vector, matrix, data frame, timeSeries or zoo object of
+ # asset returns.
+
+ # All other inputs are the same as "plot" and are principally included
+ # so that some sensible defaults could be set.
+
+ # vs parameter takes the value against which benchmark sr has to be plotted
+
+ # FUNCTION:
+ if(!is.null(R)){
+ x = checkData(R)
+ columns = ncol(x)
+ avgSR = mean(SharpeRatio(R))
+ }
+ else{
+ if(is.null(avgSR) | is.null(S)){
+ stop("The average SR and the number of strategies should not be NULL")
+ }
+
+ }
+ corr = table.Correlation(edhec,edhec)
+ corr_avg = 0
+ for(i in 1:(columns-1)){
+ for(j in (i+1):columns){
+ corr_avg = corr_avg + corr[(i-1)*columns+j,]
+ }
+ }
+ corr_avg = corr_avg*2/(columns*(columns-1))
+ if(vs=="sharpe"){
+ if(is.null(ylab)){
+ ylab = "Benchmark Sharpe Ratio"
+ }
+ if(is.null(xlab)){
+ xlab = "Average Sharpe Ratio"
+ }
+ if(is.null(main)){
+ main = "Benchmark Sharpe Ratio vs Average Sharpe Ratio"
+ }
+ sr = seq(0,1,length.out=30)
+ SR_B = sr*sqrt(columns/(1+(columns-1)*corr_avg[1,1]))
+ plot(sr,SR_B,type="l",xlab=xlab,ylab=ylab,main=main,lwd = lwd,pch=pch,cex = cex,cex.lab = cex.lab)
+ points(avgSR,BenchmarkSR(R),col="blue",pch=10)
+ text(avgSR,BenchmarkSR(R),"Return Series ",pos=4)
+ }
+ if(vs=="correlation"){
+
+ if(is.null(ylab)){
+ ylab = "Benchmark Sharpe Ratio"
+ }
+ if(is.null(xlab)){
+ xlab = "Average Correlation"
+ }
+ if(is.null(main)){
+ main = "Benchmark Sharpe Ratio vs Correlation"
+ }
+ rho = seq(0,1,length.out=30)
+ SR_B = avgSR*sqrt(columns/(1+(columns-1)*rho))
+ plot(rho,SR_B,type="l",xlab=xlab,ylab=ylab,main=main,lwd = lwd,pch=pch,cex = cex,cex.lab = cex.lab)
+ points(corr_avg[1,1],BenchmarkSR(R),col="blue",pch=10)
+ text(corr_avg[1,1],BenchmarkSR(R),"Return Series ",pos=4)
+ }
+ if(vs=="strategies"){
+
+ if(is.null(ylab)){
+ ylab = "Benchmark Sharpe Ratio"
+ }
+ if(is.null(xlab)){
+ xlab = "Number of Strategies"
+ }
+ if(is.null(main)){
+ main = "Benchmark Sharpe Ratio vs Number of Strategies"
+ }
+ n = seq(2,100,length.out=20)
+ SR_B = avgSR*sqrt(n/(1+(n-1)*corr_avg[1,1]))
+ plot(n,SR_B,type="l",xlab=xlab,ylab=ylab,main=main,lwd = lwd,pch=pch,cex = cex,cex.lab = cex.lab)
+ points(columns,BenchmarkSR(R),col="blue",pch=10)
+ text(columns,BenchmarkSR(R),"Return Series ",pos=4)
+ }
+
+}
+
+###############################################################################
+# R (http://r-project.org/) Econometrics for Performance and Risk Analysis
+#
+# Copyright (c) 2004-2013 Peter Carl and Brian G. Peterson
+#
+# This R package is distributed under the terms of the GNU Public License (GPL)
+# for full details see the file COPYING
+#
+# $Id: BenchmarkSRPlots.R $
+#
+###############################################################################
Copied: pkg/PerformanceAnalytics/sandbox/pulkit/R/BenchmarkSR.R (from rev 2790, pkg/PerformanceAnalytics/sandbox/pulkit/week2/code/BenchmarkSR.R)
===================================================================
--- pkg/PerformanceAnalytics/sandbox/pulkit/R/BenchmarkSR.R (rev 0)
+++ pkg/PerformanceAnalytics/sandbox/pulkit/R/BenchmarkSR.R 2013-08-16 08:53:23 UTC (rev 2794)
@@ -0,0 +1,70 @@
+#'@title
+#'Benchmark Sharpe Ratio
+#'
+#'@description
+#'The benchmark SR is a linear function of the average
+#' SR of the individual strategies, and a decreasing
+#' convex function of the number of strategies and the
+#' average pairwise correlation. The Returns are given as
+#' the input with the benchmark Sharpe Ratio as the output.
+#'
+#'@aliases BenchmarkSR
+#'\deqn{SR_B = \bar{SR}\sqrt{\frac{S}{1+(S-1)\bar{\rho}}}}
+#'
+#'Here \eqn{\bar{SR}} is the average SR of the portfolio and \eqn{\bar{\rho}}
+#'is the average correlation across off-diagonal elements
+#'
+#'@param R a vector, matrix, data frame,timeseries or zoo object of asset returns
+#'
+#'@references
+#'Bailey, David H. and Lopez de Prado, Marcos, The Strategy Approval Decision:
+#'A Sharpe Ratio Indifference Curve Approach (January 2013). Algorithmic Finance,
+#'Vol. 2, No. 1 (2013).
+#'
+#'@examples
+#'
+#'data(edhec)
+#'BenchmarkSR(edhec) #expected 0.393797
+#'
+#'@export
+#'
+BenchmarkSR<-function(R){
+ # DESCRIPTION:
+ # Returns the Value of the Benchmark Sharpe Ratio.
+
+ # INPUT:
+ # The return series of all the series in the portfolio is taken as the input
+ # The return series can be a vector, matrix, data frame,timeseries or zoo
+ # object of asset returns.
+
+ # FUNCTION:
+ x = checkData(R)
+ columns = ncol(x)
+ #TODO : What to do if the number of columns is only one ?
+ if(columns == 1){
+ stop("The number of return series should be greater than 1")
+ }
+ SR = SharpeRatio(x)
+ sr_avg = mean(SR)
+ corr = table.Correlation(edhec,edhec)
+ corr_avg = 0
+ for(i in 1:(columns-1)){
+ for(j in (i+1):columns){
+ corr_avg = corr_avg + corr[(i-1)*columns+j,1]
+ }
+ }
+ corr_avg = corr_avg*2/(columns*(columns-1))
+ SR_Benchmark = sr_avg*sqrt(columns/(1+(columns-1)*corr_avg))
+ return(SR_Benchmark)
+}
+###############################################################################
+# R (http://r-project.org/) Econometrics for Performance and Risk Analysis
+#
+# Copyright (c) 2004-2013 Peter Carl and Brian G. Peterson
+#
+# This R package is distributed under the terms of the GNU Public License (GPL)
+# for full details see the file COPYING
+#
+# $Id: BenchmarkSR.R $
+#
+###############################################################################
\ No newline at end of file
Copied: pkg/PerformanceAnalytics/sandbox/pulkit/R/CDaRMultipath.R (from rev 2790, pkg/PerformanceAnalytics/sandbox/pulkit/week6/CDaRMultipath.R)
===================================================================
--- pkg/PerformanceAnalytics/sandbox/pulkit/R/CDaRMultipath.R (rev 0)
+++ pkg/PerformanceAnalytics/sandbox/pulkit/R/CDaRMultipath.R 2013-08-16 08:53:23 UTC (rev 2794)
@@ -0,0 +1,142 @@
+#'@title
+#'Conditional Drawdown at Risk for Multiple Sample Path
+#'
+#'@desctipion
+#'
+#' For a given \eqn{\alpha \epsilon [0,1]} in the multiple sample-paths setting,CDaR,
+#' denoted by \eqn{D_{\alpha}(w)}, is the average of \eqn{(1-\alpha).100\%} drawdowns
+#' of the set {d_st|t=1,....T,s = 1,....S}, and is defined by
+#'
+#' \deqn{D_\alpha(w) = \max_{{q_st}{\epsilon}Q}{\sum_{s=1}^S}{\sum_{t=1}^T}{p_s}{q_st}{d_st}},
+#'
+#' where
+#'
+#' \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}
+#'
+#' 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
+#'@param scen the number of scenarios in the Return series
+#'@param instr the number of instruments in the Return series
+#'@param geometric utilize geometric chaining (TRUE) or simple/arithmetic
+#'chaining (FALSE) to aggregate returns, default TRUE
+#'@param p confidence level for calculation ,default(p=0.95)
+#'@param \dots any other passthru parameters
+#'
+#'@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
+
+
+CdarMultiPath<-function (R,ps,sample, geometric = TRUE,p = 0.95, ...)
+{
+
+ #p = .setalphaprob(p)
+ R = na.omit(R)
+ nr = nrow(R)
+
+ # 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)
+ # average of the drawdowns greater the (1-alpha).100% largest drawdowns
+ 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[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))
+
+ # constraint 1:
+ # f.con = cbind(-diag(nr),diag(nr),1)
+ # f.dir = c(rep(">=",nr))
+ # f.rhs = c(rep(0,nr))
+
+ #constatint 2:
+ # 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)
+
+ #constraint 3:
+ # 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))
+
+ #constraint 4:
+ # 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")
+ 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] <- multicdar(ret)
+ }
+ 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)
+}
Copied: pkg/PerformanceAnalytics/sandbox/pulkit/R/CdaR.R (from rev 2790, pkg/PerformanceAnalytics/sandbox/pulkit/week6/CdaR.R)
===================================================================
--- pkg/PerformanceAnalytics/sandbox/pulkit/R/CdaR.R (rev 0)
+++ pkg/PerformanceAnalytics/sandbox/pulkit/R/CdaR.R 2013-08-16 08:53:23 UTC (rev 2794)
@@ -0,0 +1,73 @@
+CDaR<-function (R, weights = NULL, geometric = TRUE, invert = TRUE, p = 0.95, ...)
+{
+ #p = .setalphaprob(p)
+ if (is.vector(R) || ncol(R) == 1) {
+ R = na.omit(R)
+ nr = nrow(R)
+ # checking if nr*p is an integer
+ if((p*nr) %% 1 == 0){
+ drawdowns = -Drawdowns(R)
+ drawdowns = drawdowns[order(drawdowns),increasing = TRUE]
+ print(drawdowns)
+ # average of the drawdowns greater the (1-alpha).100% largest drawdowns
+ result = -(1/((1-p)*nr))*sum(drawdowns[((p)*nr):nr])
+ }
+ else{
+ # 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)
+
+ # k varies from 1:nr
+ # constraint : -uk +zk +y >= 0
+ 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),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),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),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)
+ val_disp = lp("min",f.obj,f.con,f.dir,f.rhs,compute.sens = TRUE )
+ result = -val$objval
+ }
+ if (invert)
+ result <- -result
+
+ return(result)
+ }
+ else {
+ R = checkData(R, method = "matrix")
+ if (is.null(weights)) {
+ result = matrix(nrow = 1, ncol = ncol(R))
+ for (i in 1:ncol(R)) {
+ result[i] <- CDaR(R[, i, drop = FALSE], p = p,
+ geometric = geometric, invert = invert, ... = ...)
+ }
+ dim(result) = c(1, NCOL(R))
+ colnames(result) = colnames(R)
+ rownames(result) = paste("Conditional Drawdown ", round(p,3)*100, "%", sep = "")
+ }
+ else {
+ portret <- Return.portfolio(R, weights = weights,
+ geometric = geometric)
+ result <- CDaR(portret, p = p, geometric = geometric,
+ invert = invert, ... = ...)
+ }
+ return(result)
+ }
+}
Copied: pkg/PerformanceAnalytics/sandbox/pulkit/R/DrawdownBeta.R (from rev 2790, pkg/PerformanceAnalytics/sandbox/pulkit/week6/DrawdownBeta.R)
===================================================================
--- pkg/PerformanceAnalytics/sandbox/pulkit/R/DrawdownBeta.R (rev 0)
+++ pkg/PerformanceAnalytics/sandbox/pulkit/R/DrawdownBeta.R 2013-08-16 08:53:23 UTC (rev 2794)
@@ -0,0 +1,130 @@
+#'@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 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
+
+BetaDrawdown<-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.
+ #
+ # INPUT:
+ # The Return series of the portfolio and the optimal portfolio
+ # is taken as the input.
+ #
+ # OUTPUT:
+ # The Drawdown beta 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(!is.null(weights)){
+ x = Returns.portfolio(R,weights)
+ }
+ if(geometric){
+ cumul_x = cumprod(x+1)-1
+ cumul_xm = cumprod(xm+1)-1
+ }
+ else{
+ cumul_x = cumsum(x)
+ cumul_xm = cumsum(xm)
+ }
+ DDbeta<-function(x){
+ q = NULL
+ q_quantile = quantile(drawdowns_m,1-p)
+ print(drawdowns_m)
+ for(i in 1:nrow(Rm)){
+
+ if(drawdowns_m[i]<q_quantile){
+ q = c(q,1/((1-p)*nrow(x)))
+ }
+ else q=c(q,0)
+ }
+ 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)
+ }
+ }
+ beta_dd = sum((as.numeric(x[index])-x)*q)/CDaR(Rm,p=p)
+ print((as.numeric(x[index])-x)*q)
+ return(beta_dd)
+ }
+
+ for(column in 1:columns){
+ column.beta = DDbeta(cumul_x[,column])
+ if(column == 1){
+ beta = column.beta
+ }
+ else{
+ beta = cbind(beta,column.beta)
+ }
+ }
+
+ if(columns==1){
+ return(beta)
+ }
+ colnames(beta) = columnnames
+ rownames(beta) = paste("Drawdown Beta (p =",p*100,"%)")
+ beta = reclass(beta,R)
+ return(beta)
+
+}
+
+
Copied: pkg/PerformanceAnalytics/sandbox/pulkit/R/DrawdownBetaMulti.R (from rev 2790, pkg/PerformanceAnalytics/sandbox/pulkit/week6/DrawdownBetaMulti.R)
===================================================================
--- pkg/PerformanceAnalytics/sandbox/pulkit/R/DrawdownBetaMulti.R (rev 0)
+++ pkg/PerformanceAnalytics/sandbox/pulkit/R/DrawdownBetaMulti.R 2013-08-16 08:53:23 UTC (rev 2794)
@@ -0,0 +1,164 @@
+#'@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
+#'MultiBetaDrawdown(cbind(edhec,edhec),cbind(edhec[,2],edhec[,2]),sample = 2,ps=c(0.4,0.6))
+#'BetaDrawdown(edhec[,1],edhec[,2]) #expected value 0.5390431
+
+MultiBetaDrawdown<-function(R,Rm,sample,ps,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]
+ nr = nrow(Rm)
+ 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$solution,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(i in 1:sample){
+ for(j in 1:nrow(Rm)){
+ if(boolean[j,i] == TRUE){
+ index = c(index,j)
+ b = j
+ }
+ else{
+ index = c(index,b)
+ }
+ }
+ }
+ index = matrix(index,ncol = sample)
+ beta_dd = 0
+ for(i in 1:sample){
+ beta_dd = beta_dd + sum(ps[i]*q[,i]*(as.numeric(x[index[,i],i])-x[,i]))
+ }
+ beta_dd = beta_dd/CdarMultiPath(Rm,ps=ps,p=p,sample = sample)
+ return(beta_dd)
+ }
+
+ result = NULL
+
+ 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 <-c(result, multiDDbeta(ret))
+ }
+ result = matrix(result,nrow = 1)
+ colnames(result) = colnames(R)[1:(ncol(R)/sample)]
+ #colnames(result) = colnames(R)[1:ncol(R)/sample]
+ rownames(result) = paste("Conditional Drawdown","(",p*100,"%)",sep="")
+ return(result)
+ }
+
+
+
+
Copied: pkg/PerformanceAnalytics/sandbox/pulkit/R/Drawdownalpha.R (from rev 2790, pkg/PerformanceAnalytics/sandbox/pulkit/week6/Drawdownalpha.R)
===================================================================
--- pkg/PerformanceAnalytics/sandbox/pulkit/R/Drawdownalpha.R (rev 0)
+++ pkg/PerformanceAnalytics/sandbox/pulkit/R/Drawdownalpha.R 2013-08-16 08:53:23 UTC (rev 2794)
@@ -0,0 +1,84 @@
+#' @title
+#' Drawdown alpha
+#'
+#' @description
+#' Then the difference between the actual rate of return and the rate of
+#' return of the instrument estimated by \eqn{\beta_DD{w_T}} is called CDaR
+#' alpha and is given by
+#'
+#' \deqn{\alpha_DD = w_T - \beta_DD{w_T^M}}
+#'
+#' here \eqn{\beta_DD} is the beta drawdown. The code for beta drawdown can
+#' be found here \code{BetaDrawdown}.
+#'
+#' Postive \eqn{\alpha_DD} implies that the instrument did better than it was
+#' predicted, and consequently, \eqn{\alpha_DD} can be used as a performance
+#' measure to rank instrument and to identify those that outperformed their
+#' CAPM predictions
+#'
+#'
+#'@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
+#'
+#'AlphaDrawdown(edhec[,1],edhec[,2]) ## expected value : 0.5141929
+#'
+#'AlphaDrawdown(edhec[,1],edhec[,2],type="max") ## expected value : 0.8983177
+#'
+#'AlphaDrawdown(edhec[,1],edhec[,2],type="average") ## expected value : 1.692592
+#'@export
+
+
+AlphaDrawdown<-function(R,Rm,p=0.95,weights = NULL,geometric = TRUE,type=c("alpha","average","max"),...){
+ # DESCRIPTION:
+ # This function calculates the drawdown alpha given the return series
+ # and the optimal return series
+ #
+ # INPUTS:
+ # The return series of the portfolio , the return series of the optimal
+ # portfolio. The confidence level, the weights and the type of cumulative
+ # returns.
+
+ # OUTPUT:
+ # The drawdown alpha is given as the output
+
+
+ # TODO ERROR HANDLING
+ if(ncol(R) != ncol(Rm)){
+ stop("The number of columns in R and Rm should be equal")
+ }
+ x = checkData(R)
+ xm = checkData(Rm)
+ beta = BetaDrawdown(R,Rm,p = p,weights=weights,geometric=geometric,type=type,...)
+ if(!is.null(weights)){
+ x = Returns.portfolio(R,weights)
+ }
+ if(geometric){
+ cumul_x = cumprod(x+1)-1
+ cumul_xm = cumprod(xm+1)-1
+ }
+ else{
+ cumul_x = cumsum(x)
+ cumul_xm = cumsum(xm)
+ }
+ x_expected = mean(cumul_x)
+ xm_expected = mean(cumul_xm)
+ alpha = x_expected - beta*xm_expected
+ return(alpha)
+}
+
+
+
+
+
Copied: pkg/PerformanceAnalytics/sandbox/pulkit/R/EDDCOPS.R (from rev 2790, pkg/PerformanceAnalytics/sandbox/pulkit/week5/EDDCOPS.R)
===================================================================
--- pkg/PerformanceAnalytics/sandbox/pulkit/R/EDDCOPS.R (rev 0)
+++ pkg/PerformanceAnalytics/sandbox/pulkit/R/EDDCOPS.R 2013-08-16 08:53:23 UTC (rev 2794)
@@ -0,0 +1,86 @@
+#'@title
+#'Economic Drawdown Controlled Optimal Portfolio Strategy
+#'
+#'@description
+#'The Economic Drawdown Controlled Optimal Portfolio Strategy(EDD-COPS) has
+#'the portfolio fraction allocated to single risky asset as:
+#'
+#' \deqn{x_t = Max\left\{0,\biggl(\frac{\lambda/\sigma + 1/2}{1-\delta.\gamma}\biggr).\biggl[\frac{\delta-EDD(t)}{1-EDD(t)}\biggr]\right\}}
+#'
+#' The risk free asset accounts for the rest of the portfolio allocation \eqn{x_f = 1 - x_t}.
+#'
+#'
+#'@param R an xts, vector, matrix, data frame, timeSeries or zoo object of
+#' asset returns
+#'@param delta Drawdown limit
+#'@param gamma (1-gamma) is the investor risk aversion
+#'else the return series will be used
+#'@param Rf risk free rate can be vector such as government security rate of return.
+#'@param h Look back period
+#'@param geomtric geometric utilize geometric chaining (TRUE) or simple/arithmetic #'chaining(FALSE) to aggregate returns, default is TRUE.
+#'@param ... any other variable
+#'
+#'@references Yang, Z. George and Zhong, Liang, Optimal Portfolio Strategy to
+#'Control Maximum Drawdown - The Case of Risk Based Dynamic Asset Allocation (February 25, 2012)
+#'
+#'
+#'@examples
+#'
+#' # with S&P 500 data and T-bill data
+#'
+#'dt<-read.zoo("returns.csv",sep=",",header = TRUE)
+#'dt<-as.xts(dt)
+#'EDDCOPS(dt[,1],delta = 0.33,gamma = 0.7,Rf = (1+dt[,2])^(1/12)-1,geometric = TRUE)
+#'
+#'data(edhec)
+#'EDDCOPS(edhec,delta = 0.1,gamma = 0.7,Rf = 0)
+#'@export
+#'
+
+EDDCOPS<-function(R ,delta,gamma,Rf,geometric = TRUE,...){
+ # DESCRIPTION
+ # Calculates the dynamic weights for single and double risky asset portfolios
+ # using Economic Drawdown
+
+ # INPUT:
+ # The Return series ,drawdown limit, risk aversion,risk free rate are
+ # given as the input
+
+ # FUNCTION:
+ x = checkData(R)
+ rf = checkData(Rf)
+ columns = ncol(x)
+ columnnames = colnames(x)
+ sharpe = SharpeRatio.annualized(x,Rf)
+
+ sd = StdDev.annualized(R)
+ dynamicPort<-function(x){
+ factor = (sharpe[,column]/sd[,column]+0.5)/(1-delta*gamma)
+ xt = ifelse(factor*(delta-x)/(1-x)>0,factor*(delta-x)/(1-x),0)
+ return(xt)
+ }
+
+ edd = EconomicDrawdown(R,Rf,geometric)
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/returnanalytics -r 2794
More information about the Returnanalytics-commits
mailing list