[Returnanalytics-commits] r2417 - in pkg/PerformanceAnalytics/sandbox/pulkit: . week1 week1/code week1/vignette
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Mon Jun 24 20:48:29 CEST 2013
Author: pulkit
Date: 2013-06-24 20:48:28 +0200 (Mon, 24 Jun 2013)
New Revision: 2417
Added:
pkg/PerformanceAnalytics/sandbox/pulkit/week1/
pkg/PerformanceAnalytics/sandbox/pulkit/week1/code/
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.PSR.R
pkg/PerformanceAnalytics/sandbox/pulkit/week1/code/chart.SharpeEfficient.R
pkg/PerformanceAnalytics/sandbox/pulkit/week1/tests/
pkg/PerformanceAnalytics/sandbox/pulkit/week1/vignette/
pkg/PerformanceAnalytics/sandbox/pulkit/week1/vignette/ProbSharpe.Rnw
pkg/PerformanceAnalytics/sandbox/pulkit/week1/vignette/ProbSharpe.pdf
Log:
created week1 file
Added: pkg/PerformanceAnalytics/sandbox/pulkit/week1/code/MinTRL.R
===================================================================
--- pkg/PerformanceAnalytics/sandbox/pulkit/week1/code/MinTRL.R (rev 0)
+++ pkg/PerformanceAnalytics/sandbox/pulkit/week1/code/MinTRL.R 2013-06-24 18:48:28 UTC (rev 2417)
@@ -0,0 +1,78 @@
+#'@title Minimum Track Record Length
+#'
+#'@description
+#'“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 ̂ is above the designated threshold
+#'
+#'@aliases MinTrackRecord
+#'
+#'@param R the return series
+#'@param Rf the risk free rate of return
+#'@param refSR the reference Sharpe Ratio
+#'@param p the confidence level
+#'@param weights the weights for the portfolio
+#'@param sr Sharpe Ratio
+#'@param sk Skewness
+#'@param kr Kurtosis
+#'
+#'@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
+#' 2012/13
+#'@keywords ts multivariate distribution models
+#'@examples
+#'
+#'data(edhec)
+#'MinTrackRecord(edhec[,1],0.20)
+
+
+MinTrackRecord<-function(R = NULL, refSR,Rf=0,p = 0.95, weights = NULL,sr = NULL,sk = NULL, kr = NULL, ...){
+ columns = 1
+ columnnames = NULL
+ #Error handling if R is not NULL
+ if(!is.null(R)){
+ x = checkData(R)
+ columns = ncol(x)
+ n = nrow(x)
+ #Checking if the weights are provided or not
+ if(!is.null(weights)){
+ if(length(weights)!=columns){
+ stop("number of items in weights is not equal to the number of columns in R")
+ }
+ else{
+ # A potfolio is constructed by applying the weights
+ x = Return.portfolio(R,weights)
+ sr = SharpeRatio(x, Rf, p, "StdDev")
+ sk = skewness(x)
+ kr = kurtosis(x)
+ }
+ }
+ else{
+ sr = SharpeRatio(x, Rf, p, "StdDev")
+ sk = skewness(x)
+ kr = kurtosis(x)
+ }
+
+ columnnames = colnames(x)
+
+ }
+ # If R is passed as null checking for sharpe ratio , skewness and kurtosis
+ else{
+ if(is.null(sr) | is.null(sk) | is.null(kr)){
+ 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)
+ 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),"%):")
+ }
+ return(result)
+}
+
Added: pkg/PerformanceAnalytics/sandbox/pulkit/week1/code/PSRopt.R
===================================================================
--- pkg/PerformanceAnalytics/sandbox/pulkit/week1/code/PSRopt.R (rev 0)
+++ pkg/PerformanceAnalytics/sandbox/pulkit/week1/code/PSRopt.R 2013-06-24 18:48:28 UTC (rev 2417)
@@ -0,0 +1,179 @@
+#'@title Implementation of PSR Portfolio Optimization
+#'@description
+#'Maximizing for PSR leads to better diversified and more balanced hedge fund allocations compared to the concentrated outcomes of Sharpe ratio maximization.We would like to find the vector of weights that maximize the expression.Gradient Ascent Logic is used to compute the weights using the Function PsrPortfolio
+#'
+#'@aliases PsrPortfolio
+#'
+#'@param R The return series
+#'@param refSR The benchmark Sharpe Ratio
+#'@param bounds The bounds for the weights
+#'@param MaxIter The Maximum number of iterations
+#'@param delta The value of delta Z
+#'
+#'@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
+#'2012/13
+#'
+#'@keywords ts multivariate distribution models
+#'
+#'@examples
+#'
+#'data(edhec)
+#'PsrPortfolio(edhec)
+
+PsrPortfolio<-function(R,refSR=0,bounds=NULL,MaxIter = 1000,delta = 0.005){
+
+ x = checkData(R)
+ columns = ncol(x)
+ n = nrow(x)
+ columnnames = colnames(x)
+
+
+ if(is.null(bounds)){
+ message("Bounds not given assumeing bounds to be (0,1) for each weight")
+ bounds = matrix(rep(c(0,1),columns),nrow = columns,byrow = TRUE)
+ }
+
+ #Optimization Function
+ optimize<-function(){
+ weights = rep(1,columns)/columns
+ d1z = 0
+ z = 0
+ iter = 0
+ mean = NULL
+ for(column in 1:columns){
+ mean = c(mean,mean(x[,column]))
+ }
+ while(TRUE){
+ if(iter == MaxIter) break
+ dZ = get_d1Zs(mean,weights)
+ if(dZ$z<z | checkBounds(weights)==FALSE){
+ break
+ }
+ z = dZ$z
+
+ d1z = dZ$d1Z
+ iter = iter + 1
+ weights_new = stepSize(weights,d1z)
+ if(is.null(weights_new)) break
+ weights = weights_new
+ }
+ return(weights)
+ }
+ # To Check the bounds of the weights
+ checkBounds<-function(weights){
+ flag = TRUE
+ for(i in 1:columns){
+ if(weights[i] < bounds[i,1]) flag = FALSE
+
+ if(weights[i] > bounds[i,1]) flag = FALSE
+ }
+ return(TRUE)
+ }
+
+ #Calculate the step size to change the weights
+ stepSize<-function(weights,d1Z){
+ if(length(which(d1Z!=0)) == 0){
+ return(NULL)
+ }
+ weights[which(abs(d1Z)==max(abs(d1Z)))] = weights[which(abs(d1Z)==max(abs(d1Z)))]+(delta/d1Z[which(abs(d1Z)==max(abs(d1Z)))])
+ weights = weights/sum(weights)
+ return(weights)
+
+ }
+ #To get the first differentials
+ get_d1Zs<-function(mean,weights){
+ d1Z = NULL
+ m = NULL
+ x_portfolio = Return.portfolio(x,weights)
+ mu = mean(x_portfolio)
+ sd = StdDev(x_portfolio)
+ sk = skewness(x_portfolio)
+ kr = kurtosis(x_portfolio)
+ stats = c(mu,sd,sk,kr)
+ m = c(stats[1],stats[2]^2,stats[3]*(stats[2]^3),stats[4]*(stats[2]^4))
+ SR = get_SR(stats,n)
+ meanSR = SR$meanSR
+ sigmaSR = SR$sigmaSR
+
+ for(i in 1:columns){
+ d1Z = c(d1Z,get_d1Z(stats,m,meanSR,sigmaSR,mean,weights,i))
+ }
+ dZ = list("d1Z"=d1Z,"z"=meanSR/sigmaSR)
+
+ return(dZ)
+ }
+ #To get the dZ/dw for each weight
+ get_d1Z<-function(stats,m,meanSR,sigmaSR,mean,weights,index){
+ d1Mu = get_d1Mu(mean,index)
+ d1Sigma = get_d1Sigma(stats[2],mean,weights,index)
+ d1Skew = get_d1Skew(d1Sigma,stats[2],mean,weights,index,m[2])
+ d1Kurt = get_d1Kurt(d1Sigma,stats[2],mean,weights,index,m[3])
+ d1meanSR = (d1Mu*stats[2]-d1Sigma*stats[1])/stats[2]^2
+ d1sigmaSR = (d1Kurt * meanSR^2+2*meanSR*d1meanSR*(stats[4]-1))/4
+ d1sigmaSR = d1sigmaSR - d1Skew*meanSR+d1meanSR*stats[3]
+ d1sigmaSR = d1sigmaSR/(2*sigmaSR*(n-1))
+ d1Z = (d1meanSR*sigmaSR-d1sigmaSR*(meanSR-refSR))/sigmaSR^2
+ return(d1Z)
+ }
+
+ get_d1Mu<-function(mean,index){
+ return(mean[index])
+ }
+
+ get_d1Sigma<-function(sigma,mean,weights,index){
+ return(get_dnMoments(mean,weights,2,1,index)/(2*sigma))
+ }
+
+ get_d1Skew<-function(d1Sigma,sigma,mean,weights,index,m3){
+ d1Skew = get_dnMoments(mean,weights,3,1,index)*sigma^3
+ d1Skew = d1Skew - 3*(sigma^2)*d1Sigma*m3
+ d1Skew = d1Skew/sigma^6
+ return(d1Skew)
+ }
+
+ get_d1Kurt<-function(d1Sigma,sigma,mean,weights,index,m4){
+ d1Kurt = get_dnMoments(mean,weights,4,1,index)*sigma^4
+ d1Kurt = d1Kurt - 4*(sigma^3)*d1Sigma*m4
+ d1Kurt = d1Kurt/sigma^8
+ return(d1Kurt)
+ }
+ #To get the differential of the moments
+ get_dnMoments<-function(mean,weights,mOrder,dOrder,index){
+ sum = 0
+ x0 = 1
+ for(i in 0:(dOrder-1)){
+ x0 = x0*(mOrder-i)
+ }
+ x_mat = as.matrix(na.omit(x))
+ for(i in 1:n){
+ x1 = 0
+ x2 = (x_mat[i,index]-mean[index])^dOrder
+ for(j in 1:columns){
+ x1 = x1 + weights[j]*(x_mat[i,j]-mean[j])
+ }
+ sum = sum + x2*x1^(mOrder-dOrder)
+ }
+ return(x0*sum/n)
+ }
+
+ # TO get meanSR and sigmaSR
+ get_SR<-function(stats,n){
+ meanSR = stats[1]/stats[2]
+ sigmaSR = ((1-meanSR*stats[3]+(meanSR^2)*(stats[4]-1)/4)/(n-1))^0.5
+ SR<-list("meanSR"=meanSR,"sigmaSR"=sigmaSR)
+ return(SR)
+ }
+
+ weights = optimize()
+ result = matrix(weights,nrow = columns)
+ rownames(result) = columnnames
+ colnames(result) = "weight"
+ return(result)
+}
+
+
+
+
+
+
Added: pkg/PerformanceAnalytics/sandbox/pulkit/week1/code/ProbSharpeRatio.R
===================================================================
--- pkg/PerformanceAnalytics/sandbox/pulkit/week1/code/ProbSharpeRatio.R (rev 0)
+++ pkg/PerformanceAnalytics/sandbox/pulkit/week1/code/ProbSharpeRatio.R 2013-06-24 18:48:28 UTC (rev 2417)
@@ -0,0 +1,85 @@
+#'@title Probabilistic Sharpe Ratio
+#'
+#'@description
+#'Given a predefined benchmark Sharpe ratio ,the observed Sharpe Ratio
+#'can be expressed in probabilistic terms known as the Probabilistic Sharpe Ratio
+#'PSR takes higher moments into account and delivers a corrected, atemporal
+#'measure of performance expressed in terms of probability of skill.
+#'
+#'@aliases ProbSharpeRatio
+#'
+#'@param R the return series
+#'@param Rf the risk free rate of return
+#'@param refSR the reference Sharpe Ratio
+#'@param the confidence level
+#'@param weights the weights for the portfolio
+#'@param sr Sharpe Ratio
+#'@param sk Skewness
+#'@param kr Kurtosis
+#'
+#'@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
+#' 2012/13
+#'
+#'@keywords ts multivariate distribution models
+#'
+#'@examples
+#'
+#'data(edhec)
+#'ProbSharpeRatio(edhec[,1],refSR = 0.28)
+#'ProbSharpeRatio(edhec,reSR = 0.28,Rf = 0.06)
+
+
+ProbSharpeRatio<-
+function(R = NULL, refSR,Rf=0,p = 0.95, weights = NULL,n = NULL,sr = NULL,sk = NULL, kr = NULL, ...){
+ columns = 1
+ columnnames = NULL
+ #Error handling if R is not NULL
+ if(!is.null(R)){
+ x = checkData(R)
+ columns = ncol(x)
+ n = nrow(x)
+ #Checking if the weights are provided or not
+ if(!is.null(weights)){
+ if(length(weights)!=columns){
+ stop("number of items in weights is not equal to the number of columns in R")
+ }
+ else{
+ # A potfolio is constructed by applying the weights
+ x = Return.portfolio(R,weights)
+ sr = SharpeRatio(x, Rf, p, "StdDev")
+ sk = skewness(x)
+ kr = kurtosis(x)
+ }
+ }
+ else{
+ sr = SharpeRatio(x, Rf, p, "StdDev")
+ sk = skewness(x)
+ kr = kurtosis(x)
+ }
+
+ columnnames = colnames(x)
+
+ }
+ # If R is passed as null checking for sharpe ratio , skewness and kurtosis
+ else{
+
+ if(is.null(sr) | is.null(sk) | is.null(kr) | is.null(n)){
+ 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)
+ 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
+ rownames(result) = paste("Probabilistic Sharpe Ratio(p=",round(p*100,1),"%):")
+ }
+ return(result)
+
+}
Added: pkg/PerformanceAnalytics/sandbox/pulkit/week1/code/chart.PSR.R
===================================================================
--- pkg/PerformanceAnalytics/sandbox/pulkit/week1/code/chart.PSR.R (rev 0)
+++ pkg/PerformanceAnalytics/sandbox/pulkit/week1/code/chart.PSR.R 2013-06-24 18:48:28 UTC (rev 2417)
@@ -0,0 +1,35 @@
+#'@title Probabilistic Sharpe Ratio
+#'@description
+#'Given a predefined
+#'benchmark4 Sharpe ratio (), the observed Sharpe Ratiô can be expressed
+#' in probabilistic
+#'
+#'@param R the return series
+#'@param Rf the risk free rate of return
+#'@param refSR the reference Sharpe Ratio
+#'@param the confidence level
+#'@param weights the weights for the portfolio
+chart.PSR<-function(x,Rf,refSR,p=0.95,...){
+ for(column in 1:columns){
+ column.probsharpe <- psr(x[,column],Rf,p,refSR)
+ column.mintrack <- mintrl(x[,column],Rf,p,refSR)
+ if(column == 1){
+ probsharpe = column.probsharpe
+ mintrack = column.mintrack
+ }
+ else {
+ probsharpe = merge(probsharpe, column.probsharpe)
+ mintrack = merge(mintrack, column.mintrack)
+ }
+
+ }
+
+ probsharpe = rbind(probsharpe,mintrack)
+
+ colnames(probsharpe) = columnnames
+ probsharpe = reclass(probsharpe, x)
+ rownames(probsharpe)=c("PSR","MinTRL")
+ return(probsharpe)
+
+}
+
Added: pkg/PerformanceAnalytics/sandbox/pulkit/week1/code/chart.SharpeEfficient.R
===================================================================
--- pkg/PerformanceAnalytics/sandbox/pulkit/week1/code/chart.SharpeEfficient.R (rev 0)
+++ pkg/PerformanceAnalytics/sandbox/pulkit/week1/code/chart.SharpeEfficient.R 2013-06-24 18:48:28 UTC (rev 2417)
@@ -0,0 +1,5 @@
+chart.SharpeEfficientFrontier<-function(R){
+
+ x = checkData(R)
+ columns = ncol(x)
+ com
Added: pkg/PerformanceAnalytics/sandbox/pulkit/week1/vignette/ProbSharpe.Rnw
===================================================================
--- pkg/PerformanceAnalytics/sandbox/pulkit/week1/vignette/ProbSharpe.Rnw (rev 0)
+++ pkg/PerformanceAnalytics/sandbox/pulkit/week1/vignette/ProbSharpe.Rnw 2013-06-24 18:48:28 UTC (rev 2417)
@@ -0,0 +1,100 @@
+\documentclass[12pt,letterpaper,english]{article}
+\usepackage{times}
+\usepackage[T1]{fontenc}
+\IfFileExists{url.sty}{\usepackage{url}}
+ {\newcommand{\url}{\texttt}}
+
+\usepackage{babel}
+\usepackage{Rd}
+
+\usepackage{Sweave}
+\SweaveOpts{engine=R,eps = FALSE}
+%\VignetteIndexEntry{Probabilistic Sharpe Ratio}
+%\VignetteDepends{PerformanceAnalytics}
+%\VignetteKeywords{Probabilistic Sharpe Ratio,Minimum Track Record Length,risk,benchmark,portfolio}
+%\VignettePackage{PerformanceAnalytics}
+
+\begin{document}
+\SweaveOpts{concordance=TRUE}
+
+\title{ Probabilistic Sharpe Ratio }
+
+% \keywords{Probabilistic Sharpe Ratio,Minimum Track Record Length,risk,benchmark,portfolio}
+
+\makeatletter
+\makeatother
+\maketitle
+
+\begin{abstract}
+
+ This vignette gives an overview of the Probabilistic Sharpe Ratio , Minimum Track Record Length and the Probabilistic Sharpe Ratio Optimization technique used to find the optimal portfolio that maximizes the Probabilistic Sharpe Ratio. It gives an overview of the usability of the functions and its application"
+
+\end{abstract}
+
+<<echo = FALSE >>=
+library(PerformanceAnalytics)
+@
+
+
+<<echo=FALSE>>=
+source("/home/pulkit/workspace/GSOC/PerformanceAnalytics/sandbox/pulkit/ProbSharpeRatio.R")
+@
+
+<<echo=FALSE>>=
+source("/home/pulkit/workspace/GSOC/PerformanceAnalytics/sandbox/pulkit/MinTRL.R")
+@
+
+<<echo=FALSE>>=
+source("/home/pulkit/workspace/GSOC/PerformanceAnalytics/sandbox/pulkit/PSRopt.R")
+@
+
+\section{Probabilistic Sharpe Ratio}
+ Given a predefined benchmark Sharpe ratio $SR^\ast$ , the observed Sharpe ratio $\hat{SR}$ can be expressed in probabilistic terms as
+
+ \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.
+ 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.
+
+<<>>=
+data(edhec)
+ProbSharpeRatio(edhec,refSR = 0.28)
+@
+
+\section{Minimum Track Record Length}
+
+If a track record is shorter than Minimum Track Record Length(MinTRL), we do
+not have enough confidence that the observed $\hat{SR}$ is above the designated threshold
+$SR^\ast$. Minimum Track Record Length is given by the following expression.
+
+\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.
+
+<<>>=
+data(edhec)
+MinTrackRecord(edhec,refSR = 0.28)
+@
+
+\section{Probabilistic Sharpe Ratio Optimal Portfolio}
+
+We would like to find the vector of weights that maximize the expression
+
+ \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]}
+
+where $\sigma = \sqrt{E[(r-\mu)^2]}$ ,its standard deviation.$\gamma_3=\frac{E\biggl[(r-\mu)^3\biggr]}{\sigma^3}$ its skewness,$\gamma_4=\frac{E\biggl[(r-\mu)^4\biggr]}{\sigma^4}$ its kurtosis and $SR = \frac{\mu}{\sigma}$ its Sharpe Ratio.
+
+Because $\hat{PSR}(SR^\ast)=Z[\hat{Z^\ast}]$ is a monotonic increasing function of
+$\hat{Z^\ast}$. This optimal vector is invariant of the value adopted by the parameter $SR^\ast$.
+
+
+<<>>=
+data(edhec)
+PsrPortfolio(edhec)
+@
+
+\end{document}
+
Added: pkg/PerformanceAnalytics/sandbox/pulkit/week1/vignette/ProbSharpe.pdf
===================================================================
(Binary files differ)
Property changes on: pkg/PerformanceAnalytics/sandbox/pulkit/week1/vignette/ProbSharpe.pdf
___________________________________________________________________
Added: svn:mime-type
+ application/octet-stream
More information about the Returnanalytics-commits
mailing list