[Returnanalytics-commits] r2489 - in pkg/PerformanceAnalytics/sandbox/pulkit: . week2/code week3 week3/code
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Jul 2 19:06:55 CEST 2013
Author: pulkit
Date: 2013-07-02 19:06:54 +0200 (Tue, 02 Jul 2013)
New Revision: 2489
Added:
pkg/PerformanceAnalytics/sandbox/pulkit/week3/
pkg/PerformanceAnalytics/sandbox/pulkit/week3/code/
pkg/PerformanceAnalytics/sandbox/pulkit/week3/code/TriplePenanceRule.R
pkg/PerformanceAnalytics/sandbox/pulkit/week3/tests/
pkg/PerformanceAnalytics/sandbox/pulkit/week3/vignette/
Modified:
pkg/PerformanceAnalytics/sandbox/pulkit/week2/code/BenchmarkPlots.R
pkg/PerformanceAnalytics/sandbox/pulkit/week2/code/BenchmarkSR.R
Log:
Added code for Triple Penance Rule
Modified: pkg/PerformanceAnalytics/sandbox/pulkit/week2/code/BenchmarkPlots.R
===================================================================
--- pkg/PerformanceAnalytics/sandbox/pulkit/week2/code/BenchmarkPlots.R 2013-07-02 11:37:45 UTC (rev 2488)
+++ pkg/PerformanceAnalytics/sandbox/pulkit/week2/code/BenchmarkPlots.R 2013-07-02 17:06:54 UTC (rev 2489)
@@ -23,10 +23,7 @@
rho = seq(0,1,length.out=30)
SR_B = avgSR*sqrt(columns/(1+(columns-1)*rho))
- df1<-data.frame(x=rho,y=SR_B)
- df1$model<-"A"
- df2<-data.frame(x=corr_avg[1,1],y=BenchmanrkSR(R))
- df2$model<-"B"
- dfc<-rbind(df1,df2)
- ggplot(dfc,aes(x,y,group=model)) +geom_point()+geom_line()+xlab("Correlation")+ylab("Benchmark Sharpe Ratio")+ggtitle("Benchmark SR vs Correlation")
-}
+ plot(rho,SR_B,type="l",xlab="Correlation",ylab="Benchmark Sharpe Ratio",main="Benchmark Sharpe Ratio vs Correlation")
+ points(corr_avg[1,1],BenchmarkSR(R),col="blue",pch=10)
+ text(corr_avg[1,1],BenchmarkSR(R),"Original Point",pos=4)
+}
\ No newline at end of file
Modified: pkg/PerformanceAnalytics/sandbox/pulkit/week2/code/BenchmarkSR.R
===================================================================
--- pkg/PerformanceAnalytics/sandbox/pulkit/week2/code/BenchmarkSR.R 2013-07-02 11:37:45 UTC (rev 2488)
+++ pkg/PerformanceAnalytics/sandbox/pulkit/week2/code/BenchmarkSR.R 2013-07-02 17:06:54 UTC (rev 2489)
@@ -25,7 +25,7 @@
#'
#'@export
#'
-BenchmanrkSR<-function(R){
+BenchmarkSR<-function(R){
x = checkData(R)
columns = ncol(x)
#TODO : What to do if the number of columns is only one ?
@@ -42,6 +42,6 @@
}
}
corr_avg = corr_avg*2/(columns*(columns-1))
- SR_Benchmark = sr_avg*sqrt(columns/(1+(columns-1))*corr_avg[1,1])
+ SR_Benchmark = sr_avg*sqrt(columns/(1+(columns-1)*corr_avg[1,1]))
return(SR_Benchmark)
}
\ No newline at end of file
Added: pkg/PerformanceAnalytics/sandbox/pulkit/week3/code/TriplePenanceRule.R
===================================================================
--- pkg/PerformanceAnalytics/sandbox/pulkit/week3/code/TriplePenanceRule.R (rev 0)
+++ pkg/PerformanceAnalytics/sandbox/pulkit/week3/code/TriplePenanceRule.R 2013-07-02 17:06:54 UTC (rev 2489)
@@ -0,0 +1,227 @@
+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)
+
+
+
More information about the Returnanalytics-commits
mailing list