[Returnanalytics-commits] r3025 - pkg/PerformanceAnalytics/sandbox/pulkit/R

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Sun Sep 8 14:58:12 CEST 2013


Author: pulkit
Date: 2013-09-08 14:58:11 +0200 (Sun, 08 Sep 2013)
New Revision: 3025

Modified:
   pkg/PerformanceAnalytics/sandbox/pulkit/R/BenchmarkPlots.R
   pkg/PerformanceAnalytics/sandbox/pulkit/R/BenchmarkSR.R
   pkg/PerformanceAnalytics/sandbox/pulkit/R/DrawdownBeta.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/ProbSharpeRatio.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/table.Penance.R
Log:
Handling NA values and other errors in Triple Penance and Benchmark Plots

Modified: pkg/PerformanceAnalytics/sandbox/pulkit/R/BenchmarkPlots.R
===================================================================
--- pkg/PerformanceAnalytics/sandbox/pulkit/R/BenchmarkPlots.R	2013-09-08 11:27:58 UTC (rev 3024)
+++ pkg/PerformanceAnalytics/sandbox/pulkit/R/BenchmarkPlots.R	2013-09-08 12:58:11 UTC (rev 3025)
@@ -47,6 +47,9 @@
 #'chart.BenchmarkSR(edhec,vs="strategies")
 #'chart.BenchmarkSR(edhec,vs="sharpe")
 #'
+#'data(managers)
+#'chart.BenchmarkSR(managers,vs="strategies")
+#'
 #'@export
 
 chart.BenchmarkSR<-function(R=NULL,S=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,...){
@@ -69,7 +72,7 @@
   if(!is.null(R)){
     x = checkData(R)
     columns = ncol(x)
-    avgSR = mean(SharpeRatio(R))
+    avgSR = mean(SharpeRatio(R,FUN="StdDev"))
   }
   else{
     if(is.null(avgSR) | is.null(S)){

Modified: pkg/PerformanceAnalytics/sandbox/pulkit/R/BenchmarkSR.R
===================================================================
--- pkg/PerformanceAnalytics/sandbox/pulkit/R/BenchmarkSR.R	2013-09-08 11:27:58 UTC (rev 3024)
+++ pkg/PerformanceAnalytics/sandbox/pulkit/R/BenchmarkSR.R	2013-09-08 12:58:11 UTC (rev 3025)
@@ -25,6 +25,8 @@
 #'
 #'data(edhec)
 #'BenchmarkSR(edhec) #expected 0.393797
+#'data(managers)
+#'BenchmarkSR(managers) # expected 0.8110536
 #'
 #'@export
 #'
@@ -44,7 +46,7 @@
   if(columns == 1){
     stop("The number of return series should be greater than 1")
   }
-  SR = SharpeRatio(x)
+  SR = SharpeRatio(x,FUN="StdDev")
   sr_avg = mean(SR)
   corr = table.Correlation(R,R)
   corr_avg = 0

Modified: pkg/PerformanceAnalytics/sandbox/pulkit/R/DrawdownBeta.R
===================================================================
--- pkg/PerformanceAnalytics/sandbox/pulkit/R/DrawdownBeta.R	2013-09-08 11:27:58 UTC (rev 3024)
+++ pkg/PerformanceAnalytics/sandbox/pulkit/R/DrawdownBeta.R	2013-09-08 12:58:11 UTC (rev 3025)
@@ -115,7 +115,6 @@
             }
         }
         beta_dd = sum((as.numeric(x[index])-x)*q)/CDaR(Rm,p=p)
-        print((as.numeric(x[index])-x)*q)
         return(beta_dd)
     }
 

Modified: pkg/PerformanceAnalytics/sandbox/pulkit/R/GoldenSection.R
===================================================================
--- pkg/PerformanceAnalytics/sandbox/pulkit/R/GoldenSection.R	2013-09-08 11:27:58 UTC (rev 3024)
+++ pkg/PerformanceAnalytics/sandbox/pulkit/R/GoldenSection.R	2013-09-08 12:58:11 UTC (rev 3025)
@@ -23,7 +23,7 @@
 #' @references Bailey, David H. and Lopez de Prado, Marcos, Drawdown-Based Stop-Outs and the "Triple Penance" Rule(January 1, 2013).
 #' 
 #'@export
-golden_section<-function(a,b,minimum = TRUE,function_name,...){
+golden_section<-function(a,b,function_name,minimum = TRUE,...){
 
     # DESCRIPTION
     # A function to perform the golden search algorithm on the provided function

Modified: pkg/PerformanceAnalytics/sandbox/pulkit/R/MaxDD.R
===================================================================
--- pkg/PerformanceAnalytics/sandbox/pulkit/R/MaxDD.R	2013-09-08 11:27:58 UTC (rev 3024)
+++ pkg/PerformanceAnalytics/sandbox/pulkit/R/MaxDD.R	2013-09-08 12:58:11 UTC (rev 3025)
@@ -50,7 +50,7 @@
 #' MaxDD(edhec,0.95,"ar")
 #' MaxDD(edhec[,1],0.95,"normal") #expected values 4.241799 6.618966
 #'@export
-MaxDD<-function(R,confidence,type=c("ar","normal"),...)
+MaxDD<-function(R,confidence=0.95,type=c("ar","normal"),...)
 {
   
   # DESCRIPTION:
@@ -65,36 +65,35 @@
   
   # FUNCTION:
   x = checkData(R)
-  
+  x = na.omit(x) 
   if(ncol(x)==1 || is.null(R) || is.vector(R)){
-    type = type[1] 
     calcul = FALSE
     for(i in (1:length(x))){
       if(!is.na(x[i])){
         calcul = TRUE
       }
     }
-    x = na.omit(x)
     if(!calcul){
       result = NA
     }
     else{
-      if(type=="ar"){  
+      if(type[1]=="ar"){  
         result = get_minq(x,confidence)
         }
-      if(type=="normal"){
+      if(type[1]=="normal"){
           result = dd_norm(x,confidence)
       }
     }
 
     return(result)
   }
-    if(type=="ar"){
+    if(type[1]=="ar"){
         result = apply(x,MARGIN = 2,get_minq,confidence)
     }
-    if(type=="normal"){
+    if(type[1]=="normal"){
         result = apply(x,MARGIN = 2,dd_norm,confidence)
     }
+    result = round(result,3)
   rownames(result) = c("MaxDD(in %)","t*")
   return(result)  
 }

Modified: pkg/PerformanceAnalytics/sandbox/pulkit/R/MinTRL.R
===================================================================
--- pkg/PerformanceAnalytics/sandbox/pulkit/R/MinTRL.R	2013-09-08 11:27:58 UTC (rev 3024)
+++ pkg/PerformanceAnalytics/sandbox/pulkit/R/MinTRL.R	2013-09-08 12:58:11 UTC (rev 3025)
@@ -51,6 +51,9 @@
 #'MinTrackRecord(edhec[,1],refSR=0.1,Rf = 0.04/12)
 #'MinTrackRecord(refSR = 1/12^0.5,Rf = 0,p=0.95,sr = 2/12^0.5,sk=-0.72,kr=5.78)
 #'MinTrackRecord(edhec[,1:2],refSR = c(0.28,0.24))
+#'
+#'data(managers)
+#'MinTrackRecord(managers,refSR = 0)
 #'@export
 #'
 MinTrackRecord<-function(R = NULL, refSR,Rf=0,p = 0.95, weights = NULL,sr = NULL,sk = NULL, kr = NULL, ...){

Modified: pkg/PerformanceAnalytics/sandbox/pulkit/R/ProbSharpeRatio.R
===================================================================
--- pkg/PerformanceAnalytics/sandbox/pulkit/R/ProbSharpeRatio.R	2013-09-08 11:27:58 UTC (rev 3024)
+++ pkg/PerformanceAnalytics/sandbox/pulkit/R/ProbSharpeRatio.R	2013-09-08 12:58:11 UTC (rev 3025)
@@ -44,7 +44,10 @@
 #' data(edhec)
 #' ProbSharpeRatio(edhec[,1],refSR = 0.23) 
 #' ProbSharpeRatio(refSR = 1/12^0.5,Rf = 0,p=0.95,sr = 2/12^0.5,sk=-0.72,kr=5.78,n=59)
-#' ProbSharpeRatio(edhec[,1:2],refSR = c(0.28,0.24)) 
+#' ProbSharpeRatio(edhec[,1:2],refSR = c(0.28,0.24))
+#'
+#' data(managers)
+#' ProbSharpeRatio(managers,0)
 #'@export
 
 ProbSharpeRatio<-

Modified: pkg/PerformanceAnalytics/sandbox/pulkit/R/SRIndifferenceCurve.R
===================================================================
--- pkg/PerformanceAnalytics/sandbox/pulkit/R/SRIndifferenceCurve.R	2013-09-08 11:27:58 UTC (rev 3024)
+++ pkg/PerformanceAnalytics/sandbox/pulkit/R/SRIndifferenceCurve.R	2013-09-08 12:58:11 UTC (rev 3025)
@@ -46,7 +46,8 @@
 #' 
 #'data(edhec)
 #'chart.SRIndifference(edhec)
-#' 
+#'data(managers)
+#'chart.SRIndifference(managers) 
 #'@export 
 
 chart.SRIndifference<-function(R,reference.grid = TRUE, ylab = NULL,xlab = NULL,main = "Sharpe Ratio Indifference Curve",element.color = "darkgrey",lwd = 2,pch = 1,cex = 1,cex.axis = 0.8,cex.lab = 1,cex.main = 1,ylim = NULL,xlim = NULL,...){
@@ -74,7 +75,7 @@
   if(columns == 1){  
     stop("The number of return series should be greater 1 ")
   }
-  SR = SharpeRatio(x)
+  SR = SharpeRatio(x,FUN="StdDev")
   sr_avg = mean(SR)
   corr = table.Correlation(R,R)
   corr_avg = 0

Modified: pkg/PerformanceAnalytics/sandbox/pulkit/R/TriplePenance.R
===================================================================
--- pkg/PerformanceAnalytics/sandbox/pulkit/R/TriplePenance.R	2013-09-08 11:27:58 UTC (rev 3024)
+++ pkg/PerformanceAnalytics/sandbox/pulkit/R/TriplePenance.R	2013-09-08 12:58:11 UTC (rev 3025)
@@ -61,15 +61,27 @@
     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){
+   if(phi>=0 & mu >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)
+        minQ = golden_section(0,bets,getQ,TRUE,phi,mu,sigma,dp0,confidence)
+    }
+    else{
+    if(phi<0){
+        warning(paste("NaN produced because phi < 0 ",colnames(x)))
+    }
+    if(mu<0){
+        warning(paste("NaN produced because mu < 0 ",colnames(x)))
+    }
+        minQ = list(value=NaN,x=NaN)
+    }
     return(c(-minQ$value*100,minQ$x))
 }
 
@@ -120,11 +132,23 @@
     dp0 = 0
     q_value = 0
     bets = 0
+    if(phi >=0 & mu >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)
+        TuW = golden_section(bets-1,bets,diff_Q,TRUE,phi,mu,sigma,dp0,confidence)
+    }
+    else{
+    if(phi<0){
+        warning(paste("NaN produced because phi < 0 ",colnames(x)))
+    }
+    if(mu<0){
+        warning(paste("NaN produced because mu < 0 ",colnames(x)))
+    }
+ 
+        TuW = list(x=NaN)
+    }
     return(TuW$x)
 }
 

Modified: pkg/PerformanceAnalytics/sandbox/pulkit/R/TuW.R
===================================================================
--- pkg/PerformanceAnalytics/sandbox/pulkit/R/TuW.R	2013-09-08 11:27:58 UTC (rev 3024)
+++ pkg/PerformanceAnalytics/sandbox/pulkit/R/TuW.R	2013-09-08 12:58:11 UTC (rev 3025)
@@ -37,9 +37,9 @@
 #' TuW(edhec[,1],0.95,"normal") # expected value 103.2573 
 #'@export
 
-TuW<-function(R,confidence,type=c("ar","normal"),...){
+TuW<-function(R,confidence=0.95,type=c("ar","normal"),...){
   x = checkData(R)
-  type = type[1] 
+  x = na.omit(x)
   if(ncol(x)==1 || is.null(R) || is.vector(R)){ 
     calcul = FALSE
     for(i in (1:length(x))){
@@ -47,30 +47,30 @@
         calcul = TRUE
       }
     }
-    x = na.omit(x)
     if(!calcul){
       result = NA
     }
     else{
-        if(type=="ar"){
+        if(type[1]=="ar"){
             result = get_TuW(x,confidence)
         }
-        if(type=="normal"){
+        if(type[1]=="normal"){
             result = tuw_norm(x,confidence)
         }
     }
     return(result)
   }
     else{
-        if(type=="ar"){
+        if(type[1]=="ar"){
             result=apply(x,MARGIN = 2, get_TuW,confidence)
         }
-        if(type=="normal"){
+        if(type[1]=="normal"){
              result=apply(x,MARGIN = 2, tuw_norm,confidence)
         }
                    
       result<-as.data.frame(result)
       result<-t(result)
+      result<-round(result,3)
       rownames(result)=paste("Max Time Under Water")
       return(result)
     }

Modified: pkg/PerformanceAnalytics/sandbox/pulkit/R/table.Penance.R
===================================================================
--- pkg/PerformanceAnalytics/sandbox/pulkit/R/table.Penance.R	2013-09-08 11:27:58 UTC (rev 3024)
+++ pkg/PerformanceAnalytics/sandbox/pulkit/R/table.Penance.R	2013-09-08 12:58:11 UTC (rev 3025)
@@ -26,6 +26,7 @@
   #
   # Function:
   x = checkData(R)
+  x = na.omit(x)
   columns = ncol(x) 
   columnnames = colnames(x)
   rownames = c("mean","stdDev","phi","sigma","MaxDD(in %)","t*","MaxTuW","Penance")



More information about the Returnanalytics-commits mailing list