[Returnanalytics-commits] r2569 - in pkg/PerformanceAnalytics/sandbox/pulkit: . week1/vignette week3_4/code week5
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sun Jul 14 20:55:50 CEST 2013
Author: pulkit
Date: 2013-07-14 20:55:50 +0200 (Sun, 14 Jul 2013)
New Revision: 2569
Added:
pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/
pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/DD2.py
pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/DD3.py
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/run.py
pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/table.Penance.R
pkg/PerformanceAnalytics/sandbox/pulkit/week5/
pkg/PerformanceAnalytics/sandbox/pulkit/week5/redd.R
Removed:
pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/TriplePenanceRule.R
Modified:
pkg/PerformanceAnalytics/sandbox/pulkit/week1/vignette/ProbSharpe.Rnw
Log:
added files for Rolling economic Drawdown
Modified: pkg/PerformanceAnalytics/sandbox/pulkit/week1/vignette/ProbSharpe.Rnw
===================================================================
--- pkg/PerformanceAnalytics/sandbox/pulkit/week1/vignette/ProbSharpe.Rnw 2013-07-14 12:57:39 UTC (rev 2568)
+++ pkg/PerformanceAnalytics/sandbox/pulkit/week1/vignette/ProbSharpe.Rnw 2013-07-14 18:55:50 UTC (rev 2569)
@@ -58,7 +58,7 @@
$\hat{\gamma{_3}}$ and $\hat{\gamma{_4}}$ are the skewness and kurtosis respectively.
It is not unusual to find strategies with irregular trading frequencies, such as weekly strategies that may not trade for a month. This poses a problem when computing an annualized Sharpe ratio, and there is no consensus as how skill should be measured in the context of irregular bets. Because PSR measures skill in probabilistic terms, it is invariant to calendar conventions. All calculations are done in the original frequency
-of the data, and there is no annualization.
+of the data, and there is no annualization. The Reference Sharpe Ratio is also given in the non-annualized form and should be greater than the Observed Sharpe Ratio.
<<>>=
data(edhec)
@@ -73,7 +73,7 @@
\deqn{MinTRL = n^\ast = 1+\biggl[1-\hat{\gamma_3}\hat{SR}+\frac{\hat{\gamma_4}}{4}\hat{SR^2}\biggr]\biggl(\frac{Z_\alpha}{\hat{SR}-SR^\ast}\biggr)^2}
-$\gamma{_3}$ and $\gamma{_4}$ are the skewness and kurtosis respectively. It is important to note that MinTRL is expressed in terms of number of observations, not annual or calendar terms.
+$\gamma{_3}$ and $\gamma{_4}$ are the skewness and kurtosis respectively. It is important to note that MinTRL is expressed in terms of number of observations, not annual or calendar terms. All the values used in the above formula are non-annualized, in the same frequency as that of the returns.
<<>>=
data(edhec)
Copied: pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/DD2.py (from rev 2567, pkg/PerformanceAnalytics/sandbox/pulkit/week3/code/DD2.py)
===================================================================
--- pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/DD2.py (rev 0)
+++ pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/DD2.py 2013-07-14 18:55:50 UTC (rev 2569)
@@ -0,0 +1,70 @@
+#!/usr/bin/env python
+# On 20121230
+# Get maximum drawdown
+# by MLdP <lopezdeprado at lbl.gov>
+from scipy.stats import norm
+#---------------------------------------------------------------
+def main():
+ #1) Parameters
+ phi=.5 # AR(1) coefficient
+ mu=1 # unconditional mean
+ sigma=2 # Standard deviation of the random shock
+ dPi0=1 # Bet at origin (initialization of AR(1))
+ confidence=.95 # Confidence level for quantile
+ #2) Compute MinQ
+ t,minQ=getMinQ(phi,mu,sigma,dPi0,confidence)
+ print 'MinQ = '+str(minQ)
+ print 'Time at MinQ = '+str(t)
+ print 'MaxDD = '+str(max(0,-minQ))
+ return
+#---------------------------------------------------------------
+def getMinQ(phi,mu,sigma,dPi0,confidence):
+ # Compute MinQ
+ q,bets=0,0
+ #1) Determine extremes of search
+ while not q>0:
+ bets+=1
+ q=getQ(bets,phi,mu,sigma,dPi0,confidence)
+ #2) Compute min of q
+ kargs={'args':(phi,mu,sigma,dPi0,confidence)}
+ t,minQ=goldenSection(getQ,0,bets,**kargs)
+ return t,minQ
+#---------------------------------------------------------------
+def getQ(bets,phi,mu,sigma,dPi0,confidence):
+ # Compute analytical solution to quantile
+ #1) Mean
+ mean=(phi**(bets+1)-phi)/(1-phi)*(dPi0-mu)+mu*bets
+ #2) Variance
+ var=sigma**2/(phi-1)**2
+ var*=(phi**(2*(bets+1))-1)/(phi**2-1)-2*(phi**(bets+1)-1)/(phi-1)+bets+1
+ #3) Quantile
+ q=mean+norm.ppf(1-confidence,0,1)*var**.5
+ return q
+#---------------------------------------------------------------
+def goldenSection(obj,a,b,**kargs):
+ # Golden section method. Maximum if kargs['minimum']==False is passed
+ from math import log,ceil
+ tol,sign,args=1.0e-9,1,None
+ if 'minimum' in kargs and kargs['minimum']==False:sign=-1
+ if 'args' in kargs:args=kargs['args']
+ numIter=int(ceil(-2.078087*log(tol/abs(b-a))))
+ r=0.618033989
+ c=1.0-r
+ # Initialize
+ x1=r*a+c*b;x2=c*a+r*b
+ f1=sign*obj(x1,*args);f2=sign*obj(x2,*args)
+ # Loop
+ for i in range(numIter):
+ if f1>f2:
+ a=x1
+ x1=x2;f1=f2
+ x2=c*a+r*b;f2=sign*obj(x2,*args)
+ else:
+ b=x2
+ x2=x1;f2=f1
+ x1=r*a+c*b;f1=sign*obj(x1,*args)
+ if f1<f2:return x1,sign*f1
+ else:return x2,sign*f2
+#---------------------------------------------------------------
+# Boilerplate
+if __name__=='__main__':main()
Copied: pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/DD3.py (from rev 2567, pkg/PerformanceAnalytics/sandbox/pulkit/week3/code/DD3.py)
===================================================================
--- pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/DD3.py (rev 0)
+++ pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/DD3.py 2013-07-14 18:55:50 UTC (rev 2569)
@@ -0,0 +1,71 @@
+#!/usr/bin/env python
+# On 20121230
+# Get maximum time under the water
+# by MLdP <lopezdeprado at lbl.gov>
+from scipy.stats import norm
+#---------------------------------------------------------------
+def main():
+ #1) Parameters
+ phi=.5 # AR(1) coefficient
+ mu=1 # unconditional mean
+ sigma=2 # Standard deviation of the random shock
+ dPi0=1 # Bet at origin (initialization of AR(1))
+ confidence=.95 # Confidence level for quantile
+ #2) Compute TuW
+ tuw=getTuW(phi,mu,sigma,dPi0,confidence)
+ print 'MaxTuW = '+str(tuw)
+ return
+#---------------------------------------------------------------
+def getTuW(phi,mu,sigma,dPi0,confidence):
+ # Compute TuW
+ q,bets=0,0
+ #1) Determine extremes of search
+ while not q>0:
+ bets+=1
+ q=getQ(bets,phi,mu,sigma,dPi0,confidence)
+ #2) Compute root of q polynomial
+ kargs={'args':(phi,mu,sigma,dPi0,confidence)}
+ tuw,q=goldenSection(diff,bets-1,bets,**kargs)
+ return tuw
+#---------------------------------------------------------------
+def getQ(bets,phi,mu,sigma,dPi0,confidence):
+ # Compute analytical solution to quantile
+ #1) Mean
+ mean=(phi**(bets+1)-phi)/(1-phi)*(dPi0-mu)+mu*bets
+ #2) Variance
+ var=sigma**2/(phi-1)**2
+ var*=(phi**(2*(bets+1))-1)/(phi**2-1)-2*(phi**(bets+1)-1)/(phi-1)+bets+1
+ #3) Quantile
+ q=mean+norm.ppf(1-confidence,0,1)*var**.5
+ return q
+#---------------------------------------------------------------
+def diff(bets,phi,mu,sigma,dPi0,confidence):
+ return abs(getQ(bets,phi,mu,sigma,dPi0,confidence))
+#---------------------------------------------------------------
+def goldenSection(obj,a,b,**kargs):
+ # Golden section method. Maximum if kargs['minimum']==False is passed
+ from math import log,ceil
+ tol,sign,args=1.0e-9,1,None
+ if 'minimum' in kargs and kargs['minimum']==False:sign=-1
+ if 'args' in kargs:args=kargs['args']
+ numIter=int(ceil(-2.078087*log(tol/abs(b-a))))
+ r=0.618033989
+ c=1.0-r
+ # Initialize
+ x1=r*a+c*b;x2=c*a+r*b
+ f1=sign*obj(x1,*args);f2=sign*obj(x2,*args)
+ # Loop
+ for i in range(numIter):
+ if f1>f2:
+ a=x1
+ x1=x2;f1=f2
+ x2=c*a+r*b;f2=sign*obj(x2,*args)
+ else:
+ b=x2
+ x2=x1;f2=f1
+ x1=r*a+c*b;f1=sign*obj(x1,*args)
+ if f1<f2:return x1,sign*f1
+ else:return x2,sign*f2
+#---------------------------------------------------------------
+# Boilerplate
+if __name__=='__main__':main()
Copied: pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/GoldenSection.R (from rev 2528, pkg/PerformanceAnalytics/sandbox/pulkit/week3/code/GoldenSection.R)
===================================================================
--- pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/GoldenSection.R (rev 0)
+++ pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/GoldenSection.R 2013-07-14 18:55:50 UTC (rev 2569)
@@ -0,0 +1,68 @@
+#' @title
+#' Golden Section Algorithm
+#'
+#' @description
+#' @reference Bailey, David H. and Lopez de Prado, Marcos, Drawdown-Based Stop-Outs and the ‘Triple Penance’ Rule(January 1, 2013).
+#'
+#'@param a initial point
+#'@param b final point
+#'@param minimum TRUE to calculate the minimum and FALSE to calculate the Maximum
+#'@param function_name The name of the function
+
+golden_section<-function(a,b,minimum = TRUE,function_name,...){
+
+ # DESCRIPTION
+ # A function to perform the golden search algorithm on the provided function
+
+ # Inputs:
+ #
+ # a: The starting point
+ #
+ # b: The end point
+ #
+ # minimum: If we want to calculate the minimum set minimum= TRUE(default)
+ #
+ # function_name: The name of the function
+
+ FUN = match.fun(function_name)
+ tol = 10^-9
+ sign = 1
+
+ if(!minimum){
+ sign = -1
+ }
+ N = round(ceiling(-2.078087*log(tol/abs(b-a))))
+ r = 0.618033989
+ c = 1.0 - r
+ x1 = r*a + c*b
+ x2 = c*a + r*b
+ f1 = sign * FUN(x1,...)
+ f2 = sign * FUN(x2,...)
+ for(i in 1:N){
+ if(f1>f2){
+ a = x1
+ x1 = x2
+ f1 = f2
+ x2 = c*a+r*b
+ f2 = sign*FUN(x2,...)
+ }
+ else{
+ b = x2
+ x2 = x1
+ f2 = f1
+ x1 = r*a + c*b
+ f1 = sign*FUN(x1,...)
+ }
+ }
+ if(f1<f2){
+ return(list(value=sign*f1,x=x1))
+ }
+ else{
+ return(list(value=sign*f2,x=x2))
+ }
+}
+
+
+
+
+
Copied: pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/MaxDD.R (from rev 2534, pkg/PerformanceAnalytics/sandbox/pulkit/week3/code/MaxDD.R)
===================================================================
--- pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/MaxDD.R (rev 0)
+++ pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/MaxDD.R 2013-07-14 18:55:50 UTC (rev 2569)
@@ -0,0 +1,40 @@
+
+#' @title
+#' Triple Penance Rule
+#'
+#' @description
+#' \code{MaxDD} calculates the Maximum drawdown for a particular confidence interval.
+#'
+#' @param R Returns
+#' @param confidence the confidence interval
+#'
+#' @reference Bailey, David H. and Lopez de Prado, Marcos, Drawdown-Based Stop-Outs and the ‘Triple Penance’ Rule(January 1, 2013).
+
+MaxDD<-function(R,confidence,...)
+{
+ x = checkData(R)
+
+ if(ncol(x)==1 || is.null(R) || is.vector(R)){
+
+ calcul = FALSE
+ for(i in (1:length(x))){
+ if(!is.na(x[i])){
+ calcul = TRUE
+ }
+ }
+ x = na.omit(x)
+ if(!calcul){
+ result = NA
+ }
+ else{
+ result = get_minq(x,confidence)
+ }
+ return(result)
+ }
+
+ result = apply(x,MARGIN = 2,get_minq,confidence)
+ rownames(result) = c("MaxDD(in %)","t*")
+ return(result)
+}
+
+
Copied: pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/MonteSimulTriplePenance.R (from rev 2536, pkg/PerformanceAnalytics/sandbox/pulkit/week3/code/MonteSimulTriplePenance.R)
===================================================================
--- pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/MonteSimulTriplePenance.R (rev 0)
+++ pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/MonteSimulTriplePenance.R 2013-07-14 18:55:50 UTC (rev 2569)
@@ -0,0 +1,34 @@
+#' @title
+#' Monte Carlo Simulation for the Triple Penance Rule
+#'
+#' @param R Hedge Fund log Returns
+#'
+#' @reference Bailey, David H. and Lopez de Prado, Marcos, Drawdown-Based Stop-Outs and the ‘Triple Penance’ Rule(January 1, 2013).
+
+
+
+monte_simul<-function(size){
+
+ phi = 0.5
+ mu = 1
+ sigma = 2
+ dp0 = 1
+ bets = 25
+ confidence = 0.95
+
+ q_value = getQ(bets, phi, mu, sigma, dp0, confidence)
+ ms = NULL
+
+ for(i in 1:size){
+ ms[i] = sum((1-phi)*mu + rnorm(bets)*sigma + delta*phi)
+ }
+ q_ms = quantile(ms,(1-confidence)*100)
+ diff = q_value - q_ms
+
+ print(q_value)
+ print(q_ms)
+ print(q_value - q_ms)
+}
+
+
+
Copied: pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/TriplePenance.R (from rev 2528, pkg/PerformanceAnalytics/sandbox/pulkit/week3/code/TriplePenance.R)
===================================================================
--- pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/TriplePenance.R (rev 0)
+++ pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/TriplePenance.R 2013-07-14 18:55:50 UTC (rev 2569)
@@ -0,0 +1,86 @@
+get_minq<-function(R,confidence){
+
+ # DESCRIPTION:
+ # A function to get the maximum drawdown for first order serially autocorrelated
+ # returns from the quantile function defined for accumulated returns for a
+ # particular confidence interval
+
+ # Inputs:
+ # R: The function takes Returns as the input
+ #
+ # confidence: The confidence interval of the input.
+ x = checkData(R)
+ mu = mean(x, na.rm = TRUE)
+ sigma_infinity = StdDev(x)
+ phi = cov(x[-1],x[-length(x)])/(cov(x[-length(x)]))
+ sigma = sigma_infinity*((1-phi^2)^0.5)
+ dp0 = 0
+ q_value = 0
+ bets = 0
+ while(q_value <= 0){
+ bets = bets + 1
+ q_value = getQ(bets, phi, mu, sigma, dp0, confidence)
+ }
+ minQ = golden_section(0,bets,TRUE,getQ,phi,mu,sigma,dp0,confidence)
+ return(c(-minQ$value*100,minQ$x))
+}
+
+
+getQ<-function(bets,phi,mu,sigma,dp0,confidence){
+
+ # DESCRIPTION:
+ # A function to get the quantile function for cumulative returns
+ # and a particular confidence interval.
+
+ # Inputs:
+ # bets: The number fo steps
+ #
+ # phi: The coefficient for AR[1]
+ #
+ # mu: The mean of the returns
+ #
+ # sigma: The standard deviation of the returns
+ #
+ # dp0: The r0 or the first return
+ #
+ # confidence: The confidence level of the quantile function
+ mu_new = (phi^(bets+1)-phi)/(1-phi)*(dp0-mu)+mu*bets
+ var = sigma^2/(phi-1)^2
+ var = var*((phi^(2*(bets+1))-1)/(phi^2-1)-2*(phi^(bets+1)-1)/(phi-1)+bets +1)
+ q_value = mu_new + qnorm(1-confidence)*(var^0.5)
+ return(q_value)
+}
+get_TuW<-function(R,confidence){
+
+ # DESCRIPTION:
+ # A function to generate the time under water
+ #
+ # Inputs:
+ # R: The function takes Returns as the input.
+ #
+ # confidence: Confidence level of the quantile function
+
+
+ x = checkData(R)
+ mu = mean(x, na.rm = TRUE)
+ sigma_infinity = StdDev(x)
+ phi = cov(x[-1],x[-length(x)])/(cov(x[-length(x)]))
+ sigma = sigma_infinity*((1-phi^2)^0.5)
+
+ dp0 = 0
+ q_value = 0
+ bets = 0
+ while(q_value <= 0){
+ bets = bets + 1
+ q_value = getQ(bets, phi, mu, sigma, dp0, confidence)
+ }
+ TuW = golden_section(bets-1,bets,TRUE,diff_Q,phi,mu,sigma,dp0,confidence)
+ return(TuW$x)
+}
+
+
+
+diff_Q<-function(bets,phi,mu,sigma,dp0,confidence){
+ return(abs(getQ(bets,phi,mu,sigma,dp0,confidence)))
+}
+
Deleted: pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/TriplePenanceRule.R
===================================================================
--- pkg/PerformanceAnalytics/sandbox/pulkit/week3/code/TriplePenanceRule.R 2013-07-02 17:06:54 UTC (rev 2489)
+++ pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/TriplePenanceRule.R 2013-07-14 18:55:50 UTC (rev 2569)
@@ -1,227 +0,0 @@
-library(PerformanceAnalytics)
-data(edhec)
-#' @title
-#' Triple Penance Rule
-#'
-#' @description
-#' \code{TriplePenance} calculates the Maximum drawdown and the maximum
-#' Time under water for a particular confidence interval. These concepts
-#' are intenately related through the "triple penance" rule which states
-#' that under standard portfolio theory assumptions, it takes three times
-#' longer to recover from the expected maximum drawdown than the time it
-#' takes to produce it, with the same confidence level. The framework is
-#' generalized to deal with the case of first-order auto-correlated cashflows
-#'
-#' @param R Hedge Fund log Returns
-#'
-#' @reference Bailey, David H. and Lopez de Prado, Marcos, Drawdown-Based Stop-Outs and the ‘Triple Penance’ Rule(January 1, 2013).
-
-TriplePenance<-function(R,confidence,...)
-{
- x = checkData(R)
- columns = ncol(x)
- i = 0
- tp = data.frame()
- d = data.frame()
- for(i in 1:columns){
- column_MinQ <- get_minq(x[,i],confidence)
- column_TuW = get_TuW(x[,i],confidence)
- tp <- rbind(tp,c(column_MinQ,column_TuW,column_MinQ[5]/column_TuW))
- }
- table.TriplePenance(R,tp)
- #return(tp)
-}
-get_minq<-function(R,confidence){
-
- # DESCRIPTION:
- # A function to get the maximum drawdown for first order serially autocorrelated
- # returns from the quantile function defined for accumulated returns for a
- # particular confidence interval
-
- # Inputs:
- # R: The function takes Returns as the input
- #
- # confidence: The confidence interval of the input.
- x = checkData(R)
- mu = mean(x, na.rm = TRUE)
- sigma_infinity = StdDev(x)
- phi = cov(x[-1],x[-length(x)])/(cov(x[-length(x)]))
- sigma = sigma_infinity*((1-phi^2)^0.5)
- dp0 = 0
- q_value = 0
- bets = 0
- while(q_value <= 0){
- bets = bets + 1
- q_value = getQ(bets, phi, mu, sigma, dp0, confidence)
- }
- minQ = golden_section(x,0,bets,TRUE,getQ,confidence)
- return(c(mu,sigma_infinity,phi,sigma,-minQ$minQ*100,minQ$t))
-}
-
-
-getQ<-function(bets,phi,mu,sigma,dp0,confidence){
-
- # DESCRIPTION:
- # A function to get the quantile function for cumulative returns
- # and a particular confidence interval.
-
- # Inputs:
- # bets: The number fo steps
- #
- # phi: The coefficient for AR[1]
- #
- # mu: The mean of the returns
- #
- # sigma: The standard deviation of the returns
- #
- # dp0: The r0 or the first return
- #
- # confidence: The confidence level of the quantile function
- mu_new = (phi^(bets+1)-phi)/(1-phi)*(dp0-mu)+mu*bets
- var = sigma^2/(phi-1)^2
- var = var*((phi^(2*(bets+1))-1)/(phi^2-1)-2*(phi^(bets+1)-1)/(phi-1)+bets +1)
- q_value = mu_new + qnorm(1-confidence)*(var^0.5)
- return(q_value)
-}
-
-
-get_TuW<-function(R,confidence){
-
- # DESCRIPTION:
- # A function to generate the time under water
- #
- # Inputs:
- # R: The function takes Returns as the input.
- #
- # confidence: Confidence level of the quantile function
-
-
- x = checkData(R)
- mu = mean(x, na.rm = TRUE)
- sigma_infinity = StdDev(x)
- phi = cov(x[-1],x[-length(x)])/(cov(x[-length(x)]))
- sigma = sigma_infinity*((1-phi^2)^0.5)
-
- dp0 = 0
- q_value = 0
- bets = 0
- while(q_value <= 0){
- bets = bets + 1
- q_value = getQ(bets, phi, mu, sigma, dp0, confidence)
- }
- TuW = golden_section(x,bets-1,bets,TRUE,diff,confidence)
- return(TuW$t)
-}
-
-diff<-function(bets,phi,mu,sigma,dp0,confidence){
- return(abs(getQ(bets,phi,mu,sigma,dp0,confidence)))
-}
-
-golden_section<-function(R,a,b,minimum = TRUE,function_name,confidence,...){
-
- # DESCRIPTION
- # A function to perform the golden search algorithm on the provided function
-
- # Inputs:
- # R: Return series
- #
- # a: The starting point
- #
- # b: The end point
- #
- # minimum: If we want to calculate the minimum set minimum= TRUE(default)
- #
- # function_name: The name of the function
-
- x = checkData(R)
- mu = mean(x, na.rm = TRUE)
- sigma_infinity = StdDev(x)
- phi = cov(x[-1],x[-length(x)])/(cov(x[-length(x)]))
- sigma = sigma_infinity*((1-phi^2)^0.5)
-
- dp0 = 0
- FUN = match.fun(function_name)
- tol = 10^-9
- sign = 1
-
- if(!minimum){
- sign = -1
- }
- N = round(ceiling(-2.078087*log(tol/abs(b-a))))
- r = 0.618033989
- c = 1.0 - r
- x1 = r*a + c*b
- x2 = c*a + r*b
- f1 = sign * FUN(x1,phi,mu,sigma,dp0,confidence)
- f2 = sign * FUN(x2,phi,mu,sigma,dp0,confidence)
- for(i in 1:N){
- if(f1>f2){
- a = x1
- x1 = x2
- f1 = f2
- x2 = c*a+r*b
- f2 = sign*FUN(x2,phi,mu,sigma,dp0,confidence)
- }
- else{
- b = x2
- x2 = x1
- f2 = f1
- x1 = r*a + c*b
- f1 = sign*FUN(x1,phi,mu,sigma,dp0,confidence)
- }
- }
- if(f1<f2){
- return(list(minQ=sign*f1,t=x1))
- }
- else{
- return(list(minQ=sign*f2,t=x2))
- }
-}
-
-monte_simul<-function(size){
-
- phi = 0.5
- mu = 1
- sigma = 2
- dp0 = 1
- bets = 25
- confidence = 0.95
-
- q_value = getQ(bets, phi, mu, sigma, dp0, confidence)
- ms = NULL
-
- for(i in 1:size){
- ms[i] = sum((1-phi)*mu + rnorm(bets)*sigma + delta*phi)
- }
- q_ms = quantile(ms,(1-confidence)*100)
- diff = q_value - q_ms
-
- print(q_value)
- print(q_ms)
- print(q_value - q_ms)
-}
-
-table.TriplePenance<-function(R,tp){
-
- # DESCRIPTION:
- # Maximum Drawdown and Time under Water considering first-order serial correlation
- #
- # Input:
- # R log returns
- #
- # Output:
- # Creates a Table showing mean stdDev phi sigma MaxDD t* MaxTuW and Penance
- #
- # Function:
- row.names(tp)<-colnames(R)
- colnames(tp) = c("mean","stdDev","phi","sigma","MaxDD(in %)","t*","MaxTuW","Penance")
- print(tp)
-
-}
-
-# plots a table similar to Table 3 in the paper Drawdown-Based Stop-outs and "The Triple Penance" Rule
-
-TriplePenance(edhec,0.95)
-
-
-
Copied: pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/TuW.R (from rev 2534, pkg/PerformanceAnalytics/sandbox/pulkit/week3/code/TuW.R)
===================================================================
--- pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/TuW.R (rev 0)
+++ pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/TuW.R 2013-07-14 18:55:50 UTC (rev 2569)
@@ -0,0 +1,43 @@
+#' @title
+#' Time Under Water
+#'
+#' @description
+#' \code{TriplePenance} calculates the maximum
+#' Time under water for a particular confidence interval.
+#'
+#' @param R return series
+#' @param confidence the confidence interval
+#'
+#' @reference Bailey, David H. and Lopez de Prado, Marcos, Drawdown-Based Stop-Outs and the ‘Triple Penance’ Rule(January 1, 2013).
+
+TuW<-function(R,confidence,...){
+ x = checkData(R)
+
+ if(ncol(x)==1 || is.null(R) || is.vector(R)){
+
+ calcul = FALSE
+ for(i in (1:length(x))){
+ if(!is.na(x[i])){
+ calcul = TRUE
+ }
+ }
+ x = na.omit(x)
+ if(!calcul){
+ result = NA
+ }
+ else{
+ result = get_TuW(x,confidence)
+ }
+ return(result)
+ }
+ else{
+ result=apply(x,MARGIN = 2, get_TuW,confidence)
+ result<-as.data.frame(result)
+ result<-t(result)
+ rownames(result)=paste("Max Time Under Water")
+ return(result)
+ }
+
+ }
+
+
Copied: pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/chart.Penance.R (from rev 2544, pkg/PerformanceAnalytics/sandbox/pulkit/week3/code/chart.Penance.R)
===================================================================
--- pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/chart.Penance.R (rev 0)
+++ pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/chart.Penance.R 2013-07-14 18:55:50 UTC (rev 2569)
@@ -0,0 +1,29 @@
+#'@title
+#'Penance vs phi plot
+#'
+#'A plot for Penance vs phi for the given portfolio
+#'
+#'@param R an xts, vector, matrix, data frame,
+#'timeSeries or zoo object of asset returns.
+#'@param confidence the confidence level
+#'
+#'@reference Bailey, David H. and Lopez de Prado, Marcos,Drawdown-Based Stop-Outs and the ‘Triple Penance’ Rule(January 1, 2013).
+
+chart.Penance<-function(R,confidence,...){
+ x = checkData(R)
+ columns = ncol(x)
+ columnnames = colnames(x)
+ phi = 1:columns
+ penance = 1:columns
+ for(column in 1:columns){
+ phi[column] = cov(x[,column][-1],x[,column][-length(x[,column])])/(cov(x[,column][-length(x[,column])]))
+ penance[column]<-get_minq(x[,column],confidence)[1]/get_TuW(x[,column],confidence)
+ }
+ plot(x=phi,y=penance,xlab="Phi",ylab = "Penance",main="Penance vs Phi")
+ text(phi,penance,columnnames,pos = 4)
+}
+
+
+
+
+
Copied: pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/data1.csv (from rev 2567, pkg/PerformanceAnalytics/sandbox/pulkit/week3/code/data1.csv)
===================================================================
--- pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/data1.csv (rev 0)
+++ pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/data1.csv 2013-07-14 18:55:50 UTC (rev 2569)
@@ -0,0 +1,27 @@
+Code,Mean,StDev,Phi,Sigma,t-Stat(Phi)
+HFRIFOF Index,0.005516691,0.016969081,0.35942732,0.015835089,6.246140275
+HFRIFWI Index,0.008881851,0.020176781,0.304802238,0.019216682,5.190679363
+HFRIEHI Index,0.009858566,0.026444472,0.26510117,0.025498305,4.460055655
+HFRIMI Index,0.009527016,0.021496073,0.184350274,0.021127643,3.041856755
+HFRIFOFD Index,0.005179518,0.017416384,0.353548291,0.016291569,6.129496094
+HFRIDSI Index,0.009621101,0.018800339,0.545792492,0.015753187,10.56122157
+HFRIEMNI Index,0.005182009,0.009427888,0.164396537,0.009299616,2.703456292
+HFRIFOFC Index,0.004809119,0.011620459,0.455662847,0.01034398,8.302257893
+HFRIEDI Index,0.009536151,0.019247216,0.391629021,0.01770981,6.902140563
+HFRIMTI Index,0.008528045,0.021556689,-0.0188129,0.021552874,-0.305148009
+HFRIFIHY Index,0.007177975,0.017707746,0.483806908,0.015497372,8.972011994
+HFRIFI Index,0.006855376,0.012881753,0.505908165,0.011111637,9.587381222
+HFRIRVA Index,0.008020951,0.012975483,0.452790992,0.011569158,8.242977673
+HFRIMAI Index,0.007142082,0.010437017,0.298219544,0.009962104,5.067023312
+HFRICAI Index,0.007122016,0.019973858,0.578004656,0.016299336,11.48654001
+HFRIEM Index,0.010352034,0.041000178,0.359277175,0.038262633,6.243082394
+HFRIEMA Index,0.007989882,0.038243416,0.311226738,0.036344083,5.310865179
+HFRISHSE Index,-0.001675503,0.053512968,0.090737496,0.053292219,1.477615589
+HFRIEMLA Index,0.011074013,0.05084986,0.196931418,0.04985408,3.257468873
+HFRIFOFS Index,0.006834983,0.024799788,0.323053217,0.023470043,5.536016371
+HFRIENHI Index,0.010092318,0.036682513,0.201118844,0.035932974,3.329910279
+HFRIFWIG Index,0.009382896,0.035972197,0.231372973,0.034996096,3.857301725
+HFRIFOFM Index,0.005607926,0.015907089,0.042154535,0.015892949,0.684239764
+HFRIFWIC Index,0.008947104,0.039009601,0.050499002,0.038959829,0.820004462
+HFRIFWIJ Index,0.008423965,0.03629762,0.0953987,0.036132072,1.554206093
+HFRISTI Index,0.011075118,0.046441033,0.160831261,0.04583646,2.642789417
Copied: pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/run.py (from rev 2567, pkg/PerformanceAnalytics/sandbox/pulkit/week3/code/run.py)
===================================================================
--- pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/run.py (rev 0)
+++ pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/run.py 2013-07-14 18:55:50 UTC (rev 2569)
@@ -0,0 +1,51 @@
+#!/usr/bin/env python
+# On 20121230
+# MaxDD, t* and MaxTuW for HFR series
+# by MLdP <lopezdeprado at lbl.gov>
+import DD2,DD3 # These are the two modules in Appendices 9 and 10
+#---------------------------------------------------------------
+def isNumber(input):
+ # Determines whether input is a number
+ try:
+ float(input)
+ return True
+ except:
+ return False
+#---------------------------------------------------------------
+def main():
+ #1) Parameters
+ path=''
+ inFileName='data1.csv'
+ outFileName='Results1.csv'
+ fields=['Code','Mean','Phi','Sigma']
+ confidence=.95
+ dPi0=0
+ #2) Read file
+ inFile=open(path+inFileName,'r')
+ outFile=open(path+outFileName,'w')
+ headers=inFile.readline().split(',')
+ indices=[headers.index(i) for i in fields]
+ for line in inFile:
+ #3) Get Input
+ params={}
+ line=line[:-1].split(',')
+ for i in indices:
+ if isNumber(line[i])==True:
+ params[headers[i]]=float(line[i])
+ else:
+ params[headers[i]]=line[i]
+ #4) Compute MaxDD,MaxTuW
+ if params['Mean']>0 and params['Phi']>=0:
+ t,minQ=DD2.getMinQ(params['Phi'],params['Mean'],params['Sigma'],dPi0,confidence)
+ maxDD=max(0,-minQ)
+ maxTuW=DD3.getTuW(params['Phi'],params['Mean'],params['Sigma'],dPi0,confidence)
+ else:
+ maxDD,t,maxTuW='--','--','--'
+ #5) Store result
+ msg=params['Code']+','+str(maxDD)+','+str(t)+','+str(maxTuW)
+ outFile.writelines(msg+'\n')
+ print msg
+ return
+#---------------------------------------------------------------
+# Boilerplate
+if __name__=='__main__':main()
Copied: pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/table.Penance.R (from rev 2534, pkg/PerformanceAnalytics/sandbox/pulkit/week3/code/table.Penance.R)
===================================================================
--- pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/table.Penance.R (rev 0)
+++ pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/table.Penance.R 2013-07-14 18:55:50 UTC (rev 2569)
@@ -0,0 +1,45 @@
+#' @title
+#' Table for displaying the Mximum Drawdown and the Time under Water
+#'
+#' @description
+#' \code{table.Penance} Displays the table showing mean,Standard Deviation , phi, sigma , MaxDD,time at which MaxDD occurs, MaxTuW and the penance.
+#'
+#' @param R Returns
+#' @param confidence the confidence interval
+#'
+#' @reference Bailey, David H. and Lopez de Prado, Marcos, Drawdown-Based Stop-Outs and the ‘Triple Penance’ Rule(January 1, 2013).
+
+table.Penance<-function(R,confidence){
+ # DESCRIPTION:
+ # Maximum Drawdown and Time under Water considering first-order serial correlation
+ #
+ # Input:
+ # R log returns
+ #
+ # Output:
+ # Creates a Table showing mean stdDev phi sigma MaxDD t* MaxTuW and Penance
+ #
+ # Function:
+ x = checkData(R)
+ columns = ncol(x)
+ columnnames = colnames(x)
+ rownames = c("mean","stdDev","phi","sigma","MaxDD(in %)","t*","MaxTuW","Penance")
+ for(column in 1:columns){
+ phi = cov(x[,column][-1],x[,column][-length(x[,column])])/(cov(x[,column][-length(x[,column])]))
+ sigma_infinity = StdDev(x[,column])
+ sigma = sigma_infinity*((1-phi^2)^0.5)
+ column_MinQ<-c(mean(x[,column]),sigma_infinity,phi,sigma)
+ column_MinQ <- c(column_MinQ,get_minq(x[,column],confidence))
+ column_TuW = get_TuW(x[,column],confidence)
+ v = c(column_MinQ,column_TuW,column_MinQ[5]/column_TuW)
+ if(column == 1){
+ result = data.frame(Value = v, row.names = rownames)
+ }
+ else{
+ nextcolumn = data.frame(Value = v,row.names = rownames)
+ result = cbind(result,nextcolumn)
+ }
+ }
+ colnames(result) = columnnames
+ result
+}
Added: pkg/PerformanceAnalytics/sandbox/pulkit/week5/redd.R
===================================================================
--- pkg/PerformanceAnalytics/sandbox/pulkit/week5/redd.R (rev 0)
+++ pkg/PerformanceAnalytics/sandbox/pulkit/week5/redd.R 2013-07-14 18:55:50 UTC (rev 2569)
@@ -0,0 +1,85 @@
+#'@title Calculate the Rolling Economic Drawdown
+#'
+#'@description
+#'\code{rollDrawdown} calculates the Rolling Economic Drawdown(REDD) for
+#' a return series.To calculate the rolling economic drawdown cumulative
+#' return and rolling economic max is calculated for each point. The risk
+#' free return(rf) and the lookback period(h) is taken as the input.
+#'
+#'@param R an xts, vector, matrix, data frame, timeseries, or zoo object of asset return.
+#'@param weights portfolio weighting vector, default NULL
+#'@param geometric utilize geometric chaining (TRUE) or simple/arithmetic chaining(FALSE)
+#'to aggregate returns, default is TRUE
+#'@param rf risk free rate can be vector such as government security rate of return
+#'@param h lookback period
+#'@param \dots any other passthru 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)
+#' @export
+rollDrawdown<-function(R,Rf,h, geometric = TRUE, weights = NULL,...)
+{
+
+ # DESCRIPTION:
+ # calculates the Rolling Economic Drawdown(REDD) for
+ # a return series.To calculate the rolling economic drawdown cumulative
+ # return and rolling economic max is calculated for each point. The risk
+ # free return(rf) and the lookback period(h) is taken as the input.
+
+ # FUNCTION:
+ x = checkData(R)
+ columns = ncol(x)
+ rowx = nrow(x)
+ columnnames = colnames(x)
+ rf = checkData(rf)
+ rowr = nrow(rf)
+ if(rowr != 1 ){
+ if(rowr != rowx){
+ warning("The number of rows of the returns and the risk free rate do not match")
+ }
+ }
+ REDD<-function(x,geometric){
+ if(geometric)
+ Return.cumulative = cumprod(1+x)
+ else Return.cumulative = 1 + cumsum(x)
+ l = length(Return.cumulative)
+ REM = max(Return.cumulative*(1+rf)^(l-c(1:l)))
+ result = 1 - Return.cumulative[l]/REM
+ }
+
+ for(column in 1:columns){
+ column.drawdown <- apply.rolling(x[,column],width = h, FUN = REDD, geometric = geometric)
+ if(column == 1)
+ rolldrawdown = column.drawdown
+ else rolldrawdown = merge(rolldrawdown, column.drawdown)
+ }
+ colnames(rolldrawdown) = columnnames
+ rolldrawdown = reclass(rolldrawdown, x)
+ return(rolldrawdown)
+}
+chart.REDD<-function(R,rf,h, geometric = TRUE,legend.loc = NULL, colorset = (1:12),...)
+{
+#DESCRIPTION:
+#A function to create the chart for the rolling economic drawdown
+#
+ # calculates the Rolling Economic Drawdown(REDD) for
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/returnanalytics -r 2569
More information about the Returnanalytics-commits
mailing list