[Uwgarp-commits] r68 - pkg/GARPFRM/R

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

Author: tfillebeen
Date: 2014-02-08 06:39:59 +0100 (Sat, 08 Feb 2014)
New Revision: 68

Modified:
   pkg/GARPFRM/R/EWMA.R
Log:
Update

Modified: pkg/GARPFRM/R/EWMA.R
===================================================================
--- pkg/GARPFRM/R/EWMA.R	2014-02-08 05:19:12 UTC (rev 67)
+++ pkg/GARPFRM/R/EWMA.R	2014-02-08 05:39:59 UTC (rev 68)
@@ -42,15 +42,11 @@
 #' @param inWnd
 #' @param cor option (default = FALSE) 
 #' @export
+#' 
+#' 
 EWMA <- function(R, lambda=0.94, inWnd=10, cor=FALSE){
-  # 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")
-  
+  # Check for lambda between 0 and 1 & inWnd must be greater than ncol(R)
+  if (((lambda<1 || lambda > 0)) & inWnd< nrow(R)) {
   # Separate data into a initializing window and a testing window
   inR = R[1:inWnd,]
   testR = R[(inWnd+1):nrow(R),]
@@ -65,25 +61,24 @@
     # Update lagCov to be covTmp from the current period
     lagCov <- covTmp[[i]]
   }
-  est <- covTmp
+  out <- covTmp
   # Properly assign list key to date
-  names(est) <- index(testR)
+  names(out) <- index(testR)
   
-  # Check correlation option
-  if(cor & ncol(R)>1) {out <- lapply(out, cov2cor)
-  class(out) <- c("EWMACor")
-  }else if(cor & ncol(R)==1) {stop("EWMA correlation is only to be estimated for two or more assets")}
+    # Check correlation option
+    if(cor & ncol(R)>1) {out <- lapply(out, cov2cor)
+    class(out) <- c("EWMACor")
+    }else if(cor & ncol(R)==1) {stop("EWMA correlation is only to be estimated for two or more assets")}
+    
+    if(cor == FALSE & ncol(R) > 1) { class(out) <- c("EWMACovar")
+    } else if (cor == FALSE & ncol(R) == 1){class(out) <- c("EWMAVar")}
+    out$y_data <- R
   
-  if(cor == FALSE & ncol(R) > 1) { class(out) <- c("EWMACovar")
-  } else if (cor == FALSE & ncol(R) == 1){class(out) <- c("EWMAVar")}
-  out$y_data <- R
-  return(out)
-  
   } 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
@@ -100,47 +95,37 @@
 #' @S3method getCov EWMACovar
 getCov.EWMACovar <- function(object, asset1, asset2){
   if(!inherits(object, "EWMACovar")) stop("object must be of class EWMACovar")
-  
-  # 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)
+    # 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)
 }
 
 #' @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(ewma_est[[1]]))
+    idx1 = grep(asset1, colnames(object[[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(ewma_est, function(object) object[,idx1])), as.Date(names(ewma_est)))
+  out = xts(unlist(lapply(object, function(object) object[idx1])), as.Date(names(object)))
   colnames(out) = paste(asset1, sep=".")
   return(out)
 }
@@ -180,7 +165,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")
@@ -191,21 +176,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$R)[idx1,idx2], lwd=2, col="red")
-}
+  abline(h=var(object$y_data)[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$R), lwd=2, col="red")
+  abline(h=var(object$y_data), lwd=2, col="red")
 }
 
 # EWMA plotting for correlation