[Returnanalytics-commits] r2604 - in pkg/PerformanceAnalytics/sandbox/pulkit: week1/code week2/code week3_4/code week5

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Sat Jul 20 12:26:32 CEST 2013


Author: pulkit
Date: 2013-07-20 12:26:32 +0200 (Sat, 20 Jul 2013)
New Revision: 2604

Modified:
   pkg/PerformanceAnalytics/sandbox/pulkit/week1/code/MinTRL.R
   pkg/PerformanceAnalytics/sandbox/pulkit/week1/code/ProbSharpeRatio.R
   pkg/PerformanceAnalytics/sandbox/pulkit/week2/code/BenchmarkSR.R
   pkg/PerformanceAnalytics/sandbox/pulkit/week2/code/SRIndifferenceCurve.R
   pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/chart.Penance.R
   pkg/PerformanceAnalytics/sandbox/pulkit/week5/redd.R
Log:
taking refSR as a vector input and some documentation changes

Modified: pkg/PerformanceAnalytics/sandbox/pulkit/week1/code/MinTRL.R
===================================================================
--- pkg/PerformanceAnalytics/sandbox/pulkit/week1/code/MinTRL.R	2013-07-19 20:54:26 UTC (rev 2603)
+++ pkg/PerformanceAnalytics/sandbox/pulkit/week1/code/MinTRL.R	2013-07-20 10:26:32 UTC (rev 2604)
@@ -1,7 +1,7 @@
 #'@title Minimum Track Record Length
 #'
 #'@description
-#'Minimum Track Record Length will tell us “How long should a track record be in 
+#'Minimum Track Record Length tells us “How long should a track record be in 
 #'order to have statistical confidence that its Sharpe ratio is above a given 
 #'threshold? ". If a track record is shorter than MinTRL, we do not have enough
 #'confidence that the observed Sharpe Ratio is above the designated threshold.
@@ -16,16 +16,27 @@
 #'It is important to note that MinTRL is expressed in terms of number of observations,
 #'not annual or calendar terms.
 #'
+#'The sharpe ratio , skewness and kurtosis can be directly given if the return series 
+#'is not available using the input parameters sr,sk and kr. If the return series 
+#'is available these parameters can be left.
+#'
+#'weights will be needed to be entered if a portfolio's MinTRL is to be calculated
+#'else weight can be left as NULL.
+#'
 #'@aliases MinTrackRecord
 #'
 #'@param R an xts, vector, matrix, data frame, timeSeries or zoo object of asset return 
 #'@param Rf the risk free rate of return
-#'@param refSR the reference Sharpe Ratio,in the same periodicity as the returns(non-annualized)
+#'@param refSR the reference Sharpe Ratio, can be a single value or a vector for a multicolumn
+#'  return series.Should be non-annualized , in the same periodicity as the returns.
 #'@param p the confidence level
 #'@param weights the weights for the portfolio
-#'@param sr Sharpe Ratio,in the same periodicity as the returns(non-annualized)
-#'@param sk Skewness, in the same periodicity as the returns(non-annualized)
-#'@param kr Kurtosis, in the same periodicity as the returns(non-annualized)
+#'@param sr Sharpe Ratio,in the same periodicity as the returns(non-annualized).
+#'To be given in case the return series is not given.
+#'@param sk Skewness, in the same periodicity as the returns(non-annualized).
+#'To be given in case the return series is not given.
+#'@param kr Kurtosis, in the same periodicity as the returns(non-annualized).
+#'To be given in case the return series is not given.
 #'
 #'@reference Bailey, David H. and Lopez de Prado, Marcos, \emph{The Sharpe Ratio 
 #'Efficient Frontier} (July 1, 2012). Journal of Risk, Vol. 15, No. 2, Winter
@@ -34,9 +45,10 @@
 #'@examples
 #'
 #'data(edhec)
-#'MinTrackRecord(edhec[,1],refSR=0.20)
-
-
+#'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))
+#'@export
 MinTrackRecord<-function(R = NULL, refSR,Rf=0,p = 0.95, weights = NULL,sr = NULL,sk = NULL, kr = NULL, ...){
     columns = 1
     columnnames = NULL
@@ -65,7 +77,12 @@
         }
 
     columnnames = colnames(x)
- 
+        if(length(refSR)==1){
+          refSR = rep(refSR,columns)
+        }
+        if(length(refSR)!=columns){
+          stop("Reference Sharpe Ratio should be given for each series")
+        }
     }
     # If R is passed as null checking for sharpe ratio , skewness and kurtosis 
     else{
@@ -73,23 +90,19 @@
              stop("You must either pass R or the Sharpe ratio, Skewness, Kurtosis,n etc")
         }
     }
-    #If weights are not taken into account a message is displayed
-    #if(is.null(weights)){
-     #   message("no weights passed,will calculate Minimum Track Record Length for each column")
-    #}
-   
+    
     if(!is.null(dim(Rf))){
         Rf = checkData(Rf)
     }
     #If the refSR is greater than SR an error is displayed
-    if(refSR>sr){
+    if(length(which(refSR>sr))!=0){
         stop("The Reference Sharpe Ratio should be less than the Observed Sharpe Ratio")
     }
 
     result = 1 + (1 - sk*sr + ((kr-1)/4)*sr^2)*(qnorm(p)/(sr-refSR))^2
     if(!is.null(dim(result))){ 
-        colnames(result) = columnnames
-        rownames(result) = paste("Minimum Track Record Length(p=",round(p*100,1),"%):")
+      colnames(result) = paste(columnnames,"(SR >",refSR,")") 
+      rownames(result) = paste("Probabilistic Sharpe Ratio(p=",round(p*100,1),"%):")
     }
     return(result)
 }

Modified: pkg/PerformanceAnalytics/sandbox/pulkit/week1/code/ProbSharpeRatio.R
===================================================================
--- pkg/PerformanceAnalytics/sandbox/pulkit/week1/code/ProbSharpeRatio.R	2013-07-19 20:54:26 UTC (rev 2603)
+++ pkg/PerformanceAnalytics/sandbox/pulkit/week1/code/ProbSharpeRatio.R	2013-07-20 10:26:32 UTC (rev 2604)
@@ -7,23 +7,29 @@
 #' corrected, atemporal measure of performance expressed in terms of 
 #' probability of skill. The reference Sharpe Ratio should be less than 
 #' the Observed Sharpe Ratio.
+#' 
 #' \deqn{\hat{PSR}(SR^\ast) = Z\biggl[\frac{(\hat{SR}-SR^\ast)\sqrt{n-1}}{\sqrt{1-\hat{\gamma_3}SR^\ast + \frac{\hat{\gamma_4}-1}{4}\hat{SR^2}}}\biggr]}
 
 #' Here $n$ is the track record length or the number of data points. It can be daily,weekly or yearly depending on the input given
 
 #' $\hat{\gamma{_3}}$ and $\hat{\gamma{_4}}$ are the skewness and kurtosis respectively.
-
 #'
+#'
 #' @aliases ProbSharpeRatio
 #'
 #' @param R an xts, vector, matrix, data frame, timeSeries or zoo object of asset return 
 #' @param Rf the risk free rate of return
-#' @param refSR the reference Sharpe Ratio, in the same periodicity as the returns(non-annualized)
-#' @param the confidence level
+#' @param refSR the reference Sharpe Ratio, can be a single value or a vector for a multicolumn
+#'  return series.Should be non-annualized , in the same periodicity as the returns.
+#' @param p the confidence level
 #' @param weights the weights for the portfolio
-#' @param sr Sharpe Ratio, in the same periodicity as the returns(non-annualized)
-#' @param sk Skewness, in the same periodicity as the returns(non-annualized)
-#' @param kr Kurtosis, in the same periodicity as the returns(non-annualized)
+#' @param sr Sharpe Ratio, in the same periodicity as the returns(non-annualized).
+#' To be given in case the return series is not given.
+#' @param sk Skewness, in the same periodicity as the returns(non-annualized).
+#' To be given in case the return series is not given.
+#' @param kr Kurtosis, in the same periodicity as the returns(non-annualized).
+#' To be given in case the return series is not given.
+#' @param n track record length. To be given in case the return series is not given.
 #'
 #' @references Bailey, David H. and Lopez de Prado, Marcos, \emph{The Sharpe Ratio 
 #' Efficient Frontier} (July 1, 2012). Journal of Risk, Vol. 15, No. 2, Winter
@@ -34,10 +40,10 @@
 #' @examples
 #'
 #' data(edhec)
-#' ProbSharpeRatio(edhec[,1],refSR = 0.28) 
-#' ProbSharpeRatio(edhec,reSR = 0.28,Rf = 0.06)
+#' 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<-
 function(R = NULL, refSR,Rf=0,p = 0.95, weights = NULL,n = NULL,sr = NULL,sk = NULL, kr = NULL, ...){
     columns = 1
@@ -67,6 +73,13 @@
         }
 
     columnnames = colnames(x)
+        if(length(refSR)==1){
+          refSR = rep(refSR,columns)
+        }
+        if(length(refSR)!=columns){
+          stop("Reference Sharpe Ratio should be given for each series")
+        }
+        
  
     }
     # If R is passed as null checking for sharpe ratio , skewness and kurtosis 
@@ -76,21 +89,17 @@
              stop("You must either pass R or the Sharpe ratio, Skewness, Kurtosis,n etc")
        }
     }
-    #If weights are not taken into account a message is displayed
-#    if(is.null(weights)){
- #       message("no weights passed,will calculate Probability Sharpe Ratio for each column")
-  #  }
    
     if(!is.null(dim(Rf))){
         Rf = checkData(Rf)
     }
     #If the Reference Sharpe Ratio is greater than the Observred Sharpe Ratio an error is displayed
-    if(refSR>sr){
+    if(length(which(refSR>sr))!=0){
         stop("The Reference Sharpe Ratio should be less than the Observed Sharpe Ratio")
     }
     result = pnorm(((sr - refSR)*(n-1)^(0.5))/(1-sr*sk+sr^2*(kr-1)/4)^(0.5))
     if(!is.null(dim(result))){ 
-        colnames(result) = columnnames
+        colnames(result) = paste(columnnames,"(SR >",refSR,")") 
         rownames(result) = paste("Probabilistic Sharpe Ratio(p=",round(p*100,1),"%):")
     }
     return(result)

Modified: pkg/PerformanceAnalytics/sandbox/pulkit/week2/code/BenchmarkSR.R
===================================================================
--- pkg/PerformanceAnalytics/sandbox/pulkit/week2/code/BenchmarkSR.R	2013-07-19 20:54:26 UTC (rev 2603)
+++ pkg/PerformanceAnalytics/sandbox/pulkit/week2/code/BenchmarkSR.R	2013-07-20 10:26:32 UTC (rev 2604)
@@ -44,4 +44,4 @@
   corr_avg = corr_avg*2/(columns*(columns-1))
   SR_Benchmark = sr_avg*sqrt(columns/(1+(columns-1)*corr_avg[1,1]))
   return(SR_Benchmark)
-}
\ No newline at end of file
+}

Modified: pkg/PerformanceAnalytics/sandbox/pulkit/week2/code/SRIndifferenceCurve.R
===================================================================
--- pkg/PerformanceAnalytics/sandbox/pulkit/week2/code/SRIndifferenceCurve.R	2013-07-19 20:54:26 UTC (rev 2603)
+++ pkg/PerformanceAnalytics/sandbox/pulkit/week2/code/SRIndifferenceCurve.R	2013-07-20 10:26:32 UTC (rev 2604)
@@ -58,7 +58,7 @@
   if(is.null(xlab)){
     xlab = "Candidate's Strategy's Sharpe Ratio"
   }
-  #plot(SR_i,corr_range,type="l",xlab = xlab,ylab = ylab,main="Sharpe Ratio Indifference Curve")
+  plot(SR_i,corr_range,type="l",xlab = xlab,ylab = ylab,main="Sharpe Ratio Indifference Curve")
   #OR we can use ggplot2 for much better plots
-  qplot(SR_i,corr_range,geom="line",xlab=xlab,ylab=ylab,main="Sharpe Ratio IndifferenceCurve",margins=TRUE,facet="grid")+stat_summary()
-}
\ No newline at end of file
+  #qplot(SR_i,corr_range,geom="line",xlab=xlab,ylab=ylab,main="Sharpe Ratio IndifferenceCurve",margins=TRUE,facet="grid")+stat_summary()
+}

Modified: pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/chart.Penance.R
===================================================================
--- pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/chart.Penance.R	2013-07-19 20:54:26 UTC (rev 2603)
+++ pkg/PerformanceAnalytics/sandbox/pulkit/week3_4/code/chart.Penance.R	2013-07-20 10:26:32 UTC (rev 2604)
@@ -19,8 +19,8 @@
         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)
+    plot(x=phi,y=penance,xlab="Phi",ylab = "Penance",main="Penance vs Phi",pch=2)
+    text(phi,penance,columnnames,pos = 4,col=c(1:columns))
 }
 
 

Modified: pkg/PerformanceAnalytics/sandbox/pulkit/week5/redd.R
===================================================================
--- pkg/PerformanceAnalytics/sandbox/pulkit/week5/redd.R	2013-07-19 20:54:26 UTC (rev 2603)
+++ pkg/PerformanceAnalytics/sandbox/pulkit/week5/redd.R	2013-07-20 10:26:32 UTC (rev 2604)
@@ -30,18 +30,24 @@
     columns = ncol(x)
     rowx = nrow(x)
     columnnames = colnames(x)
-    rf = checkData(rf)
-    rowr = nrow(rf)
+    rf = checkData(Rf)
+    rowr = length(Rf)
     if(rowr != 1 && rowr != rowx ){
-            warning("The number of rows of the returns and the risk free rate do not match")
-        }
+      stop("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)))
+        if(rowr == 1){
+          REM = max(Return.cumulative*(1+rf)^(l-c(1:l)))
+        }
+        else{
+          prodRf = prod(1+rf)
+          REM = max(Return.cumulative*prodRf)
+        }
         result = 1 - Return.cumulative[l]/REM
     }
 



More information about the Returnanalytics-commits mailing list