[Returnanalytics-commits] r3531 - in pkg/PerformanceAnalytics: R sandbox

[noreply at r-forge.r-project.org]

Author: peter_carl
Date: 2014-09-12 00:16:59 +0200 (Fri, 12 Sep 2014)
New Revision: 3531

Modified:
   pkg/PerformanceAnalytics/R/maxDrawdown.R
   pkg/PerformanceAnalytics/sandbox/refactored.Portfolio.rebalancing.R
Log:
- added AverageLength function
- added documentation for additional drawdown functions

Modified: pkg/PerformanceAnalytics/R/maxDrawdown.R
===================================================================
--- pkg/PerformanceAnalytics/R/maxDrawdown.R	2014-09-11 22:16:10 UTC (rev 3530)
+++ pkg/PerformanceAnalytics/R/maxDrawdown.R	2014-09-11 22:16:59 UTC (rev 3531)
@@ -44,15 +44,6 @@
 maxDrawdown <- function (R, weights=NULL, geometric = TRUE, invert=TRUE, ...)
 { # @author Peter Carl
 	
-	# DESCRIPTION:
-	# To find the maximum drawdown in a return series, we need to first
-	# calculate the cumulative returns and the maximum cumulative return to
-	# that point.  Any time the cumulative returns dips below the maximum
-	# cumulative returns, it's a drawdown.  Drawdowns are measured as a
-	# percentage of that maximum cumulative return, in effect, measured from
-	# peak equity.
-	
-	# FUNCTION:
 	if (is.vector(R) || ncol(R)==1 ) {
 		R = na.omit(R)
         drawdown = Drawdowns(R, geometric = geometric)
@@ -156,13 +147,6 @@
 DrawdownDeviation <-
 function (R, ...) {
 
-    # Calculates a standard deviation-type statistic using individual drawdowns.
-    # 
-    # DD = sqrt(sum[j=1,2,...,d](D_j^2/n)) where
-    # D_j = jth drawdown over the entire period
-    # d = total number of drawdowns in entire period
-    # n = number of observations
-
     R = checkData(R)
 
     dd <- function(R) {
@@ -180,7 +164,7 @@
     return (result)
 }
 
-#' Calculates the average of the observed drawdowns.
+#' Calculates the average depth of the observed drawdowns.
 #' 
 #' ADD = abs(sum[j=1,2,...,d](D_j/d)) where
 #' D'_j = jth drawdown over entire period
@@ -189,6 +173,7 @@
 #' @param R an xts, vector, matrix, data frame, timeSeries or zoo object of
 #' asset returns
 #' @param \dots any other passthru parameters
+#' @author Peter Carl
 #' @export 
 AverageDrawdown <-
 function (R, ...) {
@@ -216,17 +201,17 @@
     return (result)
 }
 
-#' @rdname AverageDrawdown
+#' Calculates the average length (in periods) of the observed recovery period.
+#' 
+#' Similar to \code{\link{AverageDrawdown}}, which calculates the average depth of drawdown, this function calculates the average length of the recovery period of the drawdowns observed.
+#' @param R an xts, vector, matrix, data frame, timeSeries or zoo object of
+#' asset returns
+#' @param \dots any other passthru parameters
+#' @author Peter Carl
 #' @export 
 AverageRecovery <-
 function (R, ...) {
 
-    # Calculates the average length (in months) of the observed recovery period.
-    # 
-    # ADD = abs(sum[j=1,2,...,d](D_j/d)) where
-    # D'_j = jth drawdown over entire period
-    # d = total number of drawdowns in the entire period
-
     R = checkData(R)
 
     ar <- function(R) {
@@ -244,8 +229,35 @@
     rownames(result) = "Average Recovery"
     return (result)
 }
+#' Calculates the average length (in periods) of the observed drawdowns.
+#' 
+#' Similar to \code{\link{AverageDrawdown}}, which calculates the average depth of drawdown, this function calculates the average length of the drawdowns observed.
+#' @param R an xts, vector, matrix, data frame, timeSeries or zoo object of
+#' asset returns
+#' @param \dots any other passthru parameters
+#' @author Peter Carl
+#' @export 
+AverageLength <-
+function (R, ...) {
 
+    R = checkData(R)
 
+    ar <- function(R) {
+        R = na.omit(R)
+        Dj = findDrawdowns(as.matrix(R))$return
+        Dr = findDrawdowns(as.matrix(R))$length
+        d = length(Dr[Dj<0])
+        result = abs(sum(Dr[Dj<0]/d))
+        return(result)
+    }
+
+    result = apply(R, MARGIN = 2, ar)
+    dim(result) = c(1,NCOL(R))
+    colnames(result) = colnames(R)
+    rownames(result) = "Average Recovery"
+    return (result)
+}
+
 ###############################################################################
 # R (http://r-project.org/) Econometrics for Performance and Risk Analysis
 #

Modified: pkg/PerformanceAnalytics/sandbox/refactored.Portfolio.rebalancing.R
===================================================================
--- pkg/PerformanceAnalytics/sandbox/refactored.Portfolio.rebalancing.R	2014-09-11 22:16:10 UTC (rev 3530)
+++ pkg/PerformanceAnalytics/sandbox/refactored.Portfolio.rebalancing.R	2014-09-11 22:16:59 UTC (rev 3531)
@@ -72,9 +72,9 @@
     weights = rep(1/NCOL(R), NCOL(R))
   }
   if(is.vector(weights)) { # weights are a vector
-    if(is.na(endpoints)) { # and endpoints are not specified 
+    if(is.na(on)) { # and endpoints are not specified 
       # then use the weights only at the beginning of the returns series, without rebalancing
-      weights = xts(weights, order.by=as.Date(start_date))
+      weights = xts(matrix(weights, nrow=1), order.by=as.Date(start_date))
     }
     else { # and endpoints are specified
       #  generate a time series of the given weights at the endpoints
@@ -111,10 +111,16 @@
   # loop over rebalance periods
   start_date=index(weights)[1]
 
-  for(i in 1:(NROW(weights)-1)) {
-    # identify rebalance from and to dates (weights[i,], weights[i+1])
-    from = as.Date(index(weights[i,]))+1
-    to = as.Date(index(weights[i+1,]))
+    if(NROW(weights)>1)
+      for(i in 1:(NROW(weights)-1)) {
+      # identify rebalance from and to dates (weights[i,], weights[i+1])
+        from = as.Date(index(weights[i,]))+1
+        to = as.Date(index(weights[i+1,]))
+      }
+    else{
+      from = as.Date(index(weights[1,]))+1
+      to=NULL
+    }
     returns = R[paste0(from,"::",to)]
     #print(returns)