[Uwgarp-commits] r128 - in pkg/GARPFRM: . R

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

Author: rossbennett34
Date: 2014-03-23 17:26:12 +0100 (Sun, 23 Mar 2014)
New Revision: 128

Modified:
   pkg/GARPFRM/DESCRIPTION
   pkg/GARPFRM/R/rollFUN.R
Log:
Revising rollCor and rollCov to handle any number of columns

Modified: pkg/GARPFRM/DESCRIPTION
===================================================================
--- pkg/GARPFRM/DESCRIPTION	2014-03-23 04:13:33 UTC (rev 127)
+++ pkg/GARPFRM/DESCRIPTION	2014-03-23 16:26:12 UTC (rev 128)
@@ -23,3 +23,5 @@
     'efficient_frontier.R'
     'rollFUN.R'
     'volatility.R'
+    'boot.R'
+    'utils.R'

Modified: pkg/GARPFRM/R/rollFUN.R
===================================================================
--- pkg/GARPFRM/R/rollFUN.R	2014-03-23 04:13:33 UTC (rev 127)
+++ pkg/GARPFRM/R/rollFUN.R	2014-03-23 16:26:12 UTC (rev 128)
@@ -1,8 +1,24 @@
 
+.rollCov <- function(R, width){
+  # if(!inherits(R, c("xts", "zoo"))) stop("x must be an xts or zoo object")
+  # R should be an xts object with 2 columns
+  n <- nrow(R)
+  out <- vector("numeric", n)
+  for(i in width:n){
+    tmpR <- R[(i-width+1):i,]
+    out[i] <- cov(tmpR[,1], tmpR[,2])
+  }
+  # pad with leading NA
+  for(i in 1:(width-1)){
+    out[i] <- NA
+  }
+  out
+}
+
 #' Rolling Covariance Estimate
 #' 
-#' This function calculates the covariance estimate of the returns of two 
-#' assets over a rolling window
+#' This function calculates the covariance estimate between the returns of a 
+#' pair of assets over a rolling window.
 #' 
 #' @param R xts or zoo object of asset returns
 #' @param width width of rolling window
@@ -10,16 +26,43 @@
 #' @seealso \code{\link{cov}}
 #' @examples
 #' data(crsp_weekly)
-#' R <- largecap_weekly[,1:2]
+#' R <- largecap_weekly[,1:4]
 #' tail(rollCov(R, 10))
 #' @export
 rollCov <- function(R, width){
   if(!inherits(R, c("xts", "zoo"))) stop("x must be an xts or zoo object")
+  if(ncol(R) < 2) stop("R must have 2 or more columns of asset returns")
+  
+  cnames <- colnames(R)
+  if(ncol(R) == 2){
+    out <- .rollCov(R=R, width=width)
+    out_names <- paste(cnames[1], cnames[2], sep=".")
+  } else if(ncol(R) > 2){
+    out <- matrix(0, nrow=nrow(R), ncol=choose(ncol(R), 2))
+    out_names <- vector("numeric", ncol(out))
+    k <- 1
+    for(i in 1:(ncol(R)-1)){
+      for(j in (i+1):ncol(R)){
+        out[, k] <- .rollCov(R=cbind(R[,i], R[,j]), width=width)
+        out_names[k] <- paste(cnames[i], cnames[j], sep=".")
+        k <- k + 1
+      }
+    }
+  }
+  # convert to xts and return
+  out <- xts(out, index(R))
+  colnames(out) <- out_names
+  return(out)
+}
+
+.rollCor <- function(R, width){
+  if(!inherits(R, c("xts", "zoo"))) stop("x must be an xts or zoo object")
+  # R should be an xts object with 2 columns
   n <- nrow(R)
-  out <- xts(vector("numeric", n), index(R))
+  out <- vector("numeric", n)
   for(i in width:n){
     tmpR <- R[(i-width+1):i,]
-    out[i] <- cov(tmpR[,1], tmpR[,2])
+    out[i] <- cor(tmpR[,1], tmpR[,2])
   }
   # pad with leading NA
   for(i in 1:(width-1)){
@@ -30,8 +73,8 @@
 
 #' Rolling Correlation Estimate
 #' 
-#' This function calculates the correlation estimate of the returns of two 
-#' assets over a rolling window
+#' This function calculates the correlation estimate between the returns of a 
+#' pair of assets over a rolling window.
 #' 
 #' @param R xts or zoo object of asset returns
 #' @param width width of rolling window
@@ -39,22 +82,33 @@
 #' @seealso \code{\link{cor}}
 #' @examples
 #' data(crsp_weekly)
-#' R <- largecap_weekly[,1:2]
+#' R <- largecap_weekly[,1:4]
 #' tail(rollCor(R, 10))
 #' @export
 rollCor <- function(R, width){
   if(!inherits(R, c("xts", "zoo"))) stop("x must be an xts or zoo object")
-  n <- nrow(R)
-  out <- xts(vector("numeric", n), index(R))
-  for(i in width:n){
-    tmpR <- R[(i-width+1):i,]
-    out[i] <- cor(tmpR[,1], tmpR[,2])
+  if(ncol(R) < 2) stop("R must have 2 or more columns of asset returns")
+  
+  cnames <- colnames(R)
+  if(ncol(R) == 2){
+    out <- .rollCor(R=R, width=width)
+    out_names <- paste(cnames[1], cnames[2], sep=".")
+  } else if(ncol(R) > 2){
+    out <- matrix(0, nrow=nrow(R), ncol=choose(ncol(R), 2))
+    out_names <- vector("numeric", ncol(out))
+    k <- 1
+    for(i in 1:(ncol(R)-1)){
+      for(j in (i+1):ncol(R)){
+        out[, k] <- .rollCor(R=cbind(R[,i], R[,j]), width=width)
+        out_names[k] <- paste(cnames[i], cnames[j], sep=".")
+        k <- k + 1
+      }
+    }
   }
-  # pad with leading NA
-  for(i in 1:(width-1)){
-    out[i] <- NA
-  }
-  out
+  # convert to xts and return
+  out <- xts(out, index(R))
+  colnames(out) <- out_names
+  return(out)
 }
 
 # rollSD function for a univariate R
@@ -63,7 +117,6 @@
   # this function should generally not be called by the user and we will check
   # for xts or zoo object in rollSD which calls .rollSD
   n <- length(R)
-  # out <- xts(vector("numeric", n), index(R))
   out <- vector("numeric", n)
   for(i in width:n){
     tmpR <- R[(i-width+1):i,1]