[Returnanalytics-commits] r2581 - in pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3: . Code Test
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Jul 16 06:59:26 CEST 2013
Author: shubhanm
Date: 2013-07-16 06:59:26 +0200 (Tue, 16 Jul 2013)
New Revision: 2581
Added:
pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/Code/
pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/Code/EmaxDDGBM.R
pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/Code/chart.Autocorrelation.R
pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/Code/maxDDGBM.R
pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/Code/table.normDD.R
pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/Test/
pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/Test/test_EMaxDDGBM.R
pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/Vignette/
Log:
Added EmaxDDGBM.R along with the previous table, test on edhec, and literature
Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/Code/EmaxDDGBM.R
===================================================================
--- pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/Code/EmaxDDGBM.R (rev 0)
+++ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/Code/EmaxDDGBM.R 2013-07-16 04:59:26 UTC (rev 2581)
@@ -0,0 +1,194 @@
+#' Expected Drawdown using Brownian Motion Assumptions
+#'
+#' Works on the model specified by Maddon-Ismail
+#'
+#'
+#'
+#' @param R an xts, vector, matrix, data frame, timeSeries or zoo object of
+#' asset returns
+
+#' @author R
+#' @keywords Expected Drawdown Using Brownian Motion Assumptions
+#'
+#' @export
+table.EMaxDDGBM <-
+ function (R,digits =4)
+ {# @author
+
+ # DESCRIPTION:
+ # Downside Risk Summary: Statistics and Stylized Facts
+
+ # Inputs:
+ # R: a regular timeseries of returns (rather than prices)
+ # Output: Table of Estimated Drawdowns
+
+ y = checkData(R, method = "xts")
+ columns = ncol(y)
+ rows = nrow(y)
+ columnnames = colnames(y)
+ rownames = rownames(y)
+ T= nyears(y);
+
+ # for each column, do the following:
+ for(column in 1:columns) {
+ x = y[,column]
+ mu = Return.annualized(x, scale = NA, geometric = TRUE)
+ sig=StdDev(x)
+ gamma<-sqrt(pi/8)
+
+ if(mu==0){
+
+ Ed<-2*gamma*sig*sqrt(T)
+
+ }
+
+ else{
+
+ alpha<-mu*sqrt(T/(2*sig^2))
+
+ x<-alpha^2
+
+ if(mu>0){
+
+ mQp<-matrix(c(
+
+ 0.0005, 0.0010, 0.0015, 0.0020, 0.0025, 0.0050, 0.0075, 0.0100, 0.0125,
+
+ 0.0150, 0.0175, 0.0200, 0.0225, 0.0250, 0.0275, 0.0300, 0.0325, 0.0350,
+
+ 0.0375, 0.0400, 0.0425, 0.0450, 0.0500, 0.0600, 0.0700, 0.0800, 0.0900,
+
+ 0.1000, 0.2000, 0.3000, 0.4000, 0.5000, 1.5000, 2.5000, 3.5000, 4.5000,
+
+ 10, 20, 30, 40, 50, 150, 250, 350, 450, 1000, 2000, 3000, 4000, 5000, 0.019690,
+
+ 0.027694, 0.033789, 0.038896, 0.043372, 0.060721, 0.073808, 0.084693, 0.094171,
+
+ 0.102651, 0.110375, 0.117503, 0.124142, 0.130374, 0.136259, 0.141842, 0.147162,
+
+ 0.152249, 0.157127, 0.161817, 0.166337, 0.170702, 0.179015, 0.194248, 0.207999,
+
+ 0.220581, 0.232212, 0.243050, 0.325071, 0.382016, 0.426452, 0.463159, 0.668992,
+
+ 0.775976, 0.849298, 0.905305, 1.088998, 1.253794, 1.351794, 1.421860, 1.476457,
+
+ 1.747485, 1.874323, 1.958037, 2.020630, 2.219765, 2.392826, 2.494109, 2.565985,
+
+ 2.621743),ncol=2)
+
+
+
+ if(x<0.0005){
+
+ Qp<-gamma*sqrt(2*x)
+
+ }
+
+ if(x>0.0005 & x<5000){
+
+ Qp<-spline(log(mQp[,1]),mQp[,2],n=1,xmin=log(x),xmax=log(x))$y
+
+ }
+
+ if(x>5000){
+
+ Qp<-0.25*log(x)+0.49088
+
+ }
+
+ Ed<-(2*sig^2/mu)*Qp
+
+ }
+
+ if(mu<0){
+
+ mQn<-matrix(c(
+
+ 0.0005, 0.0010, 0.0015, 0.0020, 0.0025, 0.0050, 0.0075, 0.0100, 0.0125, 0.0150,
+
+ 0.0175, 0.0200, 0.0225, 0.0250, 0.0275, 0.0300, 0.0325, 0.0350, 0.0375, 0.0400,
+
+ 0.0425, 0.0450, 0.0475, 0.0500, 0.0550, 0.0600, 0.0650, 0.0700, 0.0750, 0.0800,
+
+ 0.0850, 0.0900, 0.0950, 0.1000, 0.1500, 0.2000, 0.2500, 0.3000, 0.3500, 0.4000,
+
+ 0.5000, 1.0000, 1.5000, 2.0000, 2.5000, 3.0000, 3.5000, 4.0000, 4.5000, 5.0000,
+
+ 0.019965, 0.028394, 0.034874, 0.040369, 0.045256, 0.064633, 0.079746, 0.092708,
+
+ 0.104259, 0.114814, 0.124608, 0.133772, 0.142429, 0.150739, 0.158565, 0.166229,
+
+ 0.173756, 0.180793, 0.187739, 0.194489, 0.201094, 0.207572, 0.213877, 0.220056,
+
+ 0.231797, 0.243374, 0.254585, 0.265472, 0.276070, 0.286406, 0.296507, 0.306393,
+
+ 0.316066, 0.325586, 0.413136, 0.491599, 0.564333, 0.633007, 0.698849, 0.762455,
+
+ 0.884593, 1.445520, 1.970740, 2.483960, 2.990940, 3.492520, 3.995190, 4.492380,
+
+ 4.990430, 5.498820),ncol=2)
+
+
+
+
+
+ if(x<0.0005){
+
+ Qn<-gamma*sqrt(2*x)
+
+ }
+
+ if(x>0.0005 & x<5000){
+
+ Qn<-spline(mQn[,1],mQn[,2],n=1,xmin=x,xmax=x)$y
+
+ }
+
+ if(x>5000){
+
+ Qn<-x+0.50
+
+ }
+
+ Ed<-(2*sig^2/mu)*(-Qn)
+
+ }
+
+ }
+
+ # return(Ed)
+
+ z = c((mu*100),
+ (sig*100),
+ (Ed*100))
+ znames = c(
+ "Annual Returns in %",
+ "Std Devetions in %",
+ "Expected Drawdown in %"
+ )
+ if(column == 1) {
+ resultingtable = data.frame(Value = z, row.names = znames)
+ }
+ else {
+ nextcolumn = data.frame(Value = z, row.names = znames)
+ resultingtable = cbind(resultingtable, nextcolumn)
+ }
+ }
+ colnames(resultingtable) = columnnames
+ ans = base::round(resultingtable, digits)
+ ans
+
+
+ }
+
+###############################################################################
+# R (http://r-project.org/)
+#
+# Copyright (c) 2004-2013
+#
+# This R package is distributed under the terms of the GNU Public License (GPL)
+# for full details see the file COPYING
+#
+# $Id: EMaxDDGBM
+#
+###############################################################################
Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/Code/chart.Autocorrelation.R
===================================================================
--- pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/Code/chart.Autocorrelation.R (rev 0)
+++ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/Code/chart.Autocorrelation.R 2013-07-16 04:59:26 UTC (rev 2581)
@@ -0,0 +1,47 @@
+#' Stacked Bar Plot of Autocorrelation Lag Coefficients
+#'
+#' A wrapper to create box and whiskers plot of comparitive inputs
+#'
+#' We have also provided controls for all the symbols and lines in the chart.
+#' One default, set by \code{as.Tufte=TRUE}, will strip chartjunk and draw a
+#' Boxplot per recommendations by Burghardt, Duncan and Liu(2013)
+#'
+#' @param R an xts, vector, matrix, data frame, timeSeries or zoo object of
+#' an asset return
+#' @return Stack Bar plot of lagged return coefficients
+#' @author R
+#' @seealso \code{\link[graphics]{boxplot}}
+#' @references Burghardt, Duncan and Liu(2013) \emph{It's the autocorrelation, stupid}. AlternativeEdge Note November, 2012 }
+#' @keywords Autocorrelation lag factors
+#' @examples
+#'
+#' data(edhec[,1])
+#' chart.Autocorrelation(edhec[,1])
+#'
+#'
+#' @export
+chart.Autocorrelation <-
+ function (R, ...)
+ { # @author R
+
+ # DESCRIPTION:
+ # A wrapper to create box and whiskers plot, of autocorrelation lag coeffiecients
+ # of the First six factors
+
+ R = checkData(R, method="xts")
+
+# Graph autos with adjacent bars using rainbow colors
+
+aa= table.Autocorrelation(R)
+barplot(as.matrix(aa), main="Auto Correlation Lag", ylab= "Value of Coefficient",
+ , xlab = "Fund Type",beside=TRUE, col=rainbow(6))
+
+ # Place the legend at the top-left corner with no frame
+ # using rainbow colors
+ legend("topright", c("1","2","3","4","5","6"), cex=0.6,
+ bty="n", fill=rainbow(6));
+
+
+
+
+}
\ No newline at end of file
Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/Code/maxDDGBM.R
===================================================================
--- pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/Code/maxDDGBM.R (rev 0)
+++ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/Code/maxDDGBM.R 2013-07-16 04:59:26 UTC (rev 2581)
@@ -0,0 +1,174 @@
+#' Expected Drawdown using Brownian Motion Assumptions
+#'
+#' Works on the model specified by Maddon-Ismail
+#'
+#'
+#'
+#' @param R an xts, vector, matrix, data frame, timeSeries or zoo object of
+#' asset returns
+
+#' @author R
+#' @keywords Expected Drawdown Using Brownian Motion Assumptions
+#'
+#' @export
+EMaxDDGBM <-
+ function (R,digits =4)
+ {# @author
+
+ # DESCRIPTION:
+ # Downside Risk Summary: Statistics and Stylized Facts
+
+ # Inputs:
+ # R: a regular timeseries of returns (rather than prices)
+ # Output: Table of Estimated Drawdowns
+
+ y = checkData(R, method = "xts")
+ columns = ncol(y)
+ rows = nrow(y)
+ columnnames = colnames(y)
+ rownames = rownames(y)
+ T= nyears(y);
+
+ # for each column, do the following:
+ for(column in 1:columns) {
+ x = y[,column]
+ mu = Return.annualized(x, scale = NA, geometric = TRUE)
+ sig=StdDev(x)
+ gamma<-sqrt(pi/8)
+
+ if(mu==0){
+
+ Ed<-2*gamma*sig*sqrt(T)
+
+ }
+
+ else{
+
+ alpha<-mu*sqrt(T/(2*sig^2))
+
+ x<-alpha^2
+
+ if(mu>0){
+
+ mQp<-matrix(c(
+
+ 0.0005, 0.0010, 0.0015, 0.0020, 0.0025, 0.0050, 0.0075, 0.0100, 0.0125,
+
+ 0.0150, 0.0175, 0.0200, 0.0225, 0.0250, 0.0275, 0.0300, 0.0325, 0.0350,
+
+ 0.0375, 0.0400, 0.0425, 0.0450, 0.0500, 0.0600, 0.0700, 0.0800, 0.0900,
+
+ 0.1000, 0.2000, 0.3000, 0.4000, 0.5000, 1.5000, 2.5000, 3.5000, 4.5000,
+
+ 10, 20, 30, 40, 50, 150, 250, 350, 450, 1000, 2000, 3000, 4000, 5000, 0.019690,
+
+ 0.027694, 0.033789, 0.038896, 0.043372, 0.060721, 0.073808, 0.084693, 0.094171,
+
+ 0.102651, 0.110375, 0.117503, 0.124142, 0.130374, 0.136259, 0.141842, 0.147162,
+
+ 0.152249, 0.157127, 0.161817, 0.166337, 0.170702, 0.179015, 0.194248, 0.207999,
+
+ 0.220581, 0.232212, 0.243050, 0.325071, 0.382016, 0.426452, 0.463159, 0.668992,
+
+ 0.775976, 0.849298, 0.905305, 1.088998, 1.253794, 1.351794, 1.421860, 1.476457,
+
+ 1.747485, 1.874323, 1.958037, 2.020630, 2.219765, 2.392826, 2.494109, 2.565985,
+
+ 2.621743),ncol=2)
+
+
+
+ if(x<0.0005){
+
+ Qp<-gamma*sqrt(2*x)
+
+ }
+
+ if(x>0.0005 & x<5000){
+
+ Qp<-spline(log(mQp[,1]),mQp[,2],n=1,xmin=log(x),xmax=log(x))$y
+
+ }
+
+ if(x>5000){
+
+ Qp<-0.25*log(x)+0.49088
+
+ }
+
+ Ed<-(2*sig^2/mu)*Qp
+
+ }
+
+ if(mu<0){
+
+ mQn<-matrix(c(
+
+ 0.0005, 0.0010, 0.0015, 0.0020, 0.0025, 0.0050, 0.0075, 0.0100, 0.0125, 0.0150,
+
+ 0.0175, 0.0200, 0.0225, 0.0250, 0.0275, 0.0300, 0.0325, 0.0350, 0.0375, 0.0400,
+
+ 0.0425, 0.0450, 0.0475, 0.0500, 0.0550, 0.0600, 0.0650, 0.0700, 0.0750, 0.0800,
+
+ 0.0850, 0.0900, 0.0950, 0.1000, 0.1500, 0.2000, 0.2500, 0.3000, 0.3500, 0.4000,
+
+ 0.5000, 1.0000, 1.5000, 2.0000, 2.5000, 3.0000, 3.5000, 4.0000, 4.5000, 5.0000,
+
+ 0.019965, 0.028394, 0.034874, 0.040369, 0.045256, 0.064633, 0.079746, 0.092708,
+
+ 0.104259, 0.114814, 0.124608, 0.133772, 0.142429, 0.150739, 0.158565, 0.166229,
+
+ 0.173756, 0.180793, 0.187739, 0.194489, 0.201094, 0.207572, 0.213877, 0.220056,
+
+ 0.231797, 0.243374, 0.254585, 0.265472, 0.276070, 0.286406, 0.296507, 0.306393,
+
+ 0.316066, 0.325586, 0.413136, 0.491599, 0.564333, 0.633007, 0.698849, 0.762455,
+
+ 0.884593, 1.445520, 1.970740, 2.483960, 2.990940, 3.492520, 3.995190, 4.492380,
+
+ 4.990430, 5.498820),ncol=2)
+
+
+
+
+
+ if(x<0.0005){
+
+ Qn<-gamma*sqrt(2*x)
+
+ }
+
+ if(x>0.0005 & x<5000){
+
+ Qn<-spline(mQn[,1],mQn[,2],n=1,xmin=x,xmax=x)$y
+
+ }
+
+ if(x>5000){
+
+ Qn<-x+0.50
+
+ }
+
+ Ed<-(2*sig^2/mu)*(-Qn)
+
+ }
+
+ }
+
+ return(Ed[1]*100)
+
+
+ }
+}
+###############################################################################
+# R (http://r-project.org/)
+#
+# Copyright (c) 2004-2013
+#
+# This R package is distributed under the terms of the GNU Public License (GPL)
+# for full details see the file COPYING
+#
+# $Id: EMaxDDGBM
+#
+###############################################################################
Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/Code/table.normDD.R
===================================================================
--- pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/Code/table.normDD.R (rev 0)
+++ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/Code/table.normDD.R 2013-07-16 04:59:26 UTC (rev 2581)
@@ -0,0 +1,99 @@
+#' To simulate net asset value (NAV) series where skewness and kurtosis are zero,
+#' we draw sample returns from a lognormal return distribution. To capture skewness
+#' and kurtosis, we sample returns from a generalised lambda distribution.The values of
+#' skewness and excess kurtosis used were roughly consistent with the range of values we
+#' observed for commodity trading advisers in our database. The NAV series is constructed
+#' from the return series. The simulated drawdowns are then derived and used to produce
+#' the theoretical drawdown distributions. A typical run usually requires 10,000
+#' iterations to produce a smooth distribution.
+#'
+#'
+#' @param R an xts, vector, matrix, data frame, timeSeries or zoo object of
+#' asset returns
+
+#' @author R
+#' @keywords Expected Drawdown Using Brownian Motion Assumptions
+#'
+#' @export
+table.NormDD <-
+ function (R,digits =4)
+ {# @author
+
+ # DESCRIPTION:
+ # Downside Risk Summary: Statistics and Stylized Facts
+
+ # Inputs:
+ # R: a regular timeseries of returns (rather than prices)
+ # Output: Table of Estimated Drawdowns
+ require("gld")
+
+ y = checkData(R, method = "xts")
+ columns = ncol(y)
+ rows = nrow(y)
+ columnnames = colnames(y)
+ rownames = rownames(y)
+ T= nyears(y);
+ n <- 1000
+ dt <- 1/T;
+ r0 <- 0;
+ s0 <- 1;
+ # for each column, do the following:
+ for(column in 1:columns) {
+ x = y[,column]
+ mu = Return.annualized(x, scale = NA, geometric = TRUE)
+ sig=StdDev.annualized(x)
+ skew = skewness(x)
+ kurt = kurtosis(x)
+ r <- matrix(0,T+1,n) # matrix to hold short rate paths
+ s <- matrix(0,T+1,n)
+ r[1,] <- r0
+ s[1,] <- s0
+ drawdown <- matrix(0,n)
+ # return(Ed)
+
+ for(j in 1:n){
+ r[2:(T+1),j]= rgl(T,mu,sig,skew,kurt)
+ for(i in 2:(T+1)){
+
+ dr <- r[i,j]*dt
+ s[i,j] <- s[i-1,j] + (dr/100)
+ }
+
+
+ drawdown[j] = as.numeric(maxdrawdown(s[,j])[1])
+ }
+ z = c((mu*100),
+ (sig*100),
+ ((mean(drawdown))))
+ znames = c(
+ "Annual Returns in %",
+ "Std Devetions in %",
+ "Normalized Drawdown Drawdown in %"
+ )
+ if(column == 1) {
+ resultingtable = data.frame(Value = z, row.names = znames)
+ }
+ else {
+ nextcolumn = data.frame(Value = z, row.names = znames)
+ resultingtable = cbind(resultingtable, nextcolumn)
+ }
+ }
+ colnames(resultingtable) = columnnames
+ ans = base::round(resultingtable, digits)
+ ans
+ # t <- seq(0, T, dt)
+ # matplot(t, r[1,1:T], type="l", lty=1, main="Short Rate Paths", ylab="rt")
+
+ }
+
+###############################################################################
+# R (http://r-project.org/)
+#
+# Copyright (c) 2004-2013
+#
+# This R package is distributed under the terms of the GNU Public License (GPL)
+# for full details see the file COPYING
+#
+# $Id: EMaxDDGBM
+#
+###############################################################################
Added: pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/Test/test_EMaxDDGBM.R
===================================================================
--- pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/Test/test_EMaxDDGBM.R (rev 0)
+++ pkg/PerformanceAnalytics/sandbox/Shubhankit/Week3/Test/test_EMaxDDGBM.R 2013-07-16 04:59:26 UTC (rev 2581)
@@ -0,0 +1,9 @@
+library(RUnit)
+library(PerformanceAnalytics)
+data(edhec[,1])
+
+test_EMaxDDGBM<-function(){
+
+ checkEqualsNumeric(EMaxDDGBM(edhec[,1])[1],1.708261,tolerance = 1.0e-6)
+
+}
\ No newline at end of file
More information about the Returnanalytics-commits
mailing list