[Uwgarp-commits] r67 - in pkg/GARPFRM: R sandbox

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Sat Feb 8 06:19:12 CET 2014


Author: rossbennett34
Date: 2014-02-08 06:19:12 +0100 (Sat, 08 Feb 2014)
New Revision: 67

Modified:
   pkg/GARPFRM/R/EWMA.R
   pkg/GARPFRM/sandbox/ross_EWMA.R
Log:
updating EWMA

Modified: pkg/GARPFRM/R/EWMA.R
===================================================================
--- pkg/GARPFRM/R/EWMA.R	2014-02-08 05:06:46 UTC (rev 66)
+++ pkg/GARPFRM/R/EWMA.R	2014-02-08 05:19:12 UTC (rev 67)
@@ -42,11 +42,15 @@
 #' @param inWnd
 #' @param cor option (default = FALSE) 
 #' @export
-#' 
-#' 
 EWMA <- function(R, lambda=0.94, inWnd=10, cor=FALSE){
-  # Check for lambda between 0 and 1 & inWnd must be greater than ncol(R)
-  if (((lambda<1 || lambda > 0)) & inWnd< nrow(R)) {
+  # I really don't like the inWnd name, it is not informative or intuitive
+  # It should be more descriptive like starting_period
+  
+  # These checks should be evaluated separately and not part of a loop
+  if(lambda > 1 | lambda < 0) stop("lambda must be in [0, 1]")
+  
+  if(inWnd < ncol(R)) stop("inWnd must be greater than number of assets in R")
+  
   # Separate data into a initializing window and a testing window
   inR = R[1:inWnd,]
   testR = R[(inWnd+1):nrow(R),]
@@ -61,9 +65,9 @@
     # Update lagCov to be covTmp from the current period
     lagCov <- covTmp[[i]]
   }
-  out <- covTmp
+  est <- covTmp
   # Properly assign list key to date
-  names(out) <- index(testR)
+  names(est) <- index(testR)
   
   # Check correlation option
   if(cor & ncol(R)>1) {out <- lapply(out, cov2cor)
@@ -78,6 +82,8 @@
   } else {
            stop("For exponential decay lambda must belong to ]0:1[ and/or window is too large") 
   }
+  # The final line of any function should be the return
+  return(out)
 }
 
 #' EWMA Volatility/Cross-Volatility
@@ -94,37 +100,47 @@
 #' @S3method getCov EWMACovar
 getCov.EWMACovar <- function(object, asset1, asset2){
   if(!inherits(object, "EWMACovar")) stop("object must be of class EWMACovar")
-    # Check if asset is a character 
-  object[[length(object)]] = NULL
-    if(is.character(asset1) & is.character(asset2)){
-      idx1 = grep(asset1, colnames(object[[1]]))
-      if(length(idx1) == 0) stop("name for asset1 not in object")
-      idx2 = grep(asset2, colnames(object[[1]]))
-      if(length(idx2) == 0) stop("name for asset2 not in object")
-    } else {
-      # Then dimensions are enough to find covar
-      idx1 = asset1
-      idx2 = asset2
-    }
-    out = xts(unlist(lapply(object, function(object) object[idx1, idx2])), as.Date(names(object)))
-    colnames(out) = paste(asset1, asset2, sep=".")
-    return(out)
+  
+  # object[[length(object)]] = NULL
+  
+  # Get the EWMA estimate from the object
+  ewma_estimate <- object$EWMA
+  
+  # Check if asset is a character 
+  if(is.character(asset1) & is.character(asset2)){
+    idx1 = grep(asset1, colnames(ewma_estimate[[1]]))
+    if(length(idx1) == 0) stop("name for asset1 not in object")
+    idx2 = grep(asset2, colnames(ewma_estimate[[1]]))
+    if(length(idx2) == 0) stop("name for asset2 not in object")
+  } else {
+    # Then dimensions are enough to find covar
+    idx1 = asset1
+    idx2 = asset2
+  }
+  out = xts(unlist(lapply(ewma_estimate, function(x) x[idx1, idx2])), as.Date(names(ewma_estimate)))
+  colnames(out) = paste(asset1, asset2, sep=".")
+  return(out)
 }
 
 #' @method getCov EWMAVar
 #' @S3method getCov EWMAVar
 getCov.EWMAVar <- function(object, asset1){
   if(!inherits(object, "EWMAVar")) stop("object must be of class EWMAVar")
+  
+  # object[[length(object)]] = NULL
+  
+  # Get the EWMA estimate from the object
+  ewma_est <- object$EWMA
+  
   # Check if asset is a character
-  object[[length(object)]] = NULL
   if(is.character(asset1)){
-    idx1 = grep(asset1, colnames(object[[1]]))
+    idx1 = grep(asset1, colnames(ewma_est[[1]]))
     if(length(idx1) == 0) stop("name for asset1 not in object")
   } else {
     # Then dimensions are enough to find covar
     idx1 = asset1
   }
-  out = xts(unlist(lapply(object, function(object) object[idx1])), as.Date(names(object)))
+  out = xts(unlist(lapply(ewma_est, function(object) object[,idx1])), as.Date(names(ewma_est)))
   colnames(out) = paste(asset1, sep=".")
   return(out)
 }
@@ -164,7 +180,7 @@
 # EWMA plotting for covar
 #' @export
 plot.EWMACovar <- function(object, asset1, asset2){
-  # Check if asset is a character 
+  # Check if asset is a character
   if(is.character(asset1) & is.character(asset2)){
     idx1 = grep(asset1, colnames(object[[1]]))
     if(length(idx1) == 0) stop("name for asset1 not in object")
@@ -175,21 +191,21 @@
     idx1 = asset1
     idx2 = asset2
   }
-  tmp = getCov(object,asset1, asset2)
+  tmp = getCov(object, asset1, asset2)
   plot(x=time(as.zoo(tmp)), y=tmp, type="l", xlab="Time", ylab="Covariance", lwd=2, col="blue",
        main="EWMA Covariance");
   grid()
-  abline(h=var(object$y_data)[idx1,idx2], lwd=2, col="red")
-  }
+  abline(h=var(object$R)[idx1,idx2], lwd=2, col="red")
+}
 
 # EWMA plotting for var
 #' @export
 plot.EWMAVar <- function(object,asset1){
-  tmp = getCov(object,asset1)
+  tmp = getCov(object, asset1)
   plot(x=time(as.zoo(tmp)),y=tmp, type="l", xlab="Time", ylab="Variance", lwd=2, col="blue",
        main="EWMA Variance");
   grid()
-  abline(h=var(object$y_data), lwd=2, col="red")
+  abline(h=var(object$R), lwd=2, col="red")
 }
 
 # EWMA plotting for correlation

Modified: pkg/GARPFRM/sandbox/ross_EWMA.R
===================================================================
--- pkg/GARPFRM/sandbox/ross_EWMA.R	2014-02-08 05:06:46 UTC (rev 66)
+++ pkg/GARPFRM/sandbox/ross_EWMA.R	2014-02-08 05:19:12 UTC (rev 67)
@@ -3,6 +3,20 @@
 data(crsp.short)
 R <- largecap.ts[, 1:4]
 
+ewma_est <- EWMA(R)
+# This is a list of two elements
+names(ewma_est)
+
+# for the EWMA estimate 
+ewma_est$EWMA
+
+# for the data
+ewma_est$R
+
+getCov(ewma_est, 1, 2)
+
+plot(ewma_est, asset1=1, asset2=2)
+
 # might need a separate function for univariate time series of returns
 
 # estimate covariance or correlation using EWMA for a multivariate data set



More information about the Uwgarp-commits mailing list