[Uwgarp-commits] r63 - in pkg/GARPFRM: . R sandbox
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sat Feb 8 01:38:45 CET 2014
Author: tfillebeen
Date: 2014-02-08 01:38:44 +0100 (Sat, 08 Feb 2014)
New Revision: 63
Modified:
pkg/GARPFRM/NAMESPACE
pkg/GARPFRM/R/EWMA.R
pkg/GARPFRM/R/garch11.R
pkg/GARPFRM/sandbox/test_EWMA_GARCH.R
Log:
Modified EWMA
Modified: pkg/GARPFRM/NAMESPACE
===================================================================
--- pkg/GARPFRM/NAMESPACE 2014-02-07 21:58:42 UTC (rev 62)
+++ pkg/GARPFRM/NAMESPACE 2014-02-08 00:38:44 UTC (rev 63)
@@ -1,8 +1,10 @@
-S3method(fGarch11,DCCfit)
+S3method(fcstGarch11,DCCfit)
S3method(getAlphas,capm_mlm)
S3method(getAlphas,capm_uv)
S3method(getBetas,capm_mlm)
S3method(getBetas,capm_uv)
+S3method(getCov,EWMACovar)
+S3method(getCov,EWMAVar)
S3method(getStatistics,capm_mlm)
S3method(getStatistics,capm_uv)
S3method(hypTest,capm_mlm)
@@ -10,11 +12,14 @@
export(CAPM)
export(EWMA)
export(chartSML)
-export(fGarch11)
+export(fcstGarch11)
export(garch11)
export(getAlphas)
export(getBetas)
+export(getCov)
export(getStatistics)
export(hypTest)
+export(plot.EWMACovar)
+export(plot.EWMAVar)
export(plot.capm_mlm)
export(plot.capm_uv)
Modified: pkg/GARPFRM/R/EWMA.R
===================================================================
--- pkg/GARPFRM/R/EWMA.R 2014-02-07 21:58:42 UTC (rev 62)
+++ pkg/GARPFRM/R/EWMA.R 2014-02-08 00:38:44 UTC (rev 63)
@@ -1,40 +1,147 @@
-#' Exponential Weight Moving Average (EWMA)
+# EWMA <- function(object, lambda=0.96, cor=FALSE) {
+# if ((lambda<1 || lambda > 0)){
+# object.names = colnames(object)
+# t.object = nrow(object)
+# k.object = ncol(object)
+# object = as.matrix(object)
+# t.names = rownames(object)
+#
+# covEWMA = array(,c(t.object,k.object,k.object))
+# # Note it is unconditional cov
+# cov.f = var(object)
+# FF = (object[1,]- mean(object)) %*% t(object[1,]- mean(object))
+# covEWMA[1,,] = (1-lambda)*FF + lambda*cov.f
+# for (i in 2:t.object) {
+# FF = (object[i,]- mean(object)) %*% t(object[i,]- mean(object))
+# print(FF)
+# covEWMA[i,,] = (1-lambda)*FF + lambda*covEWMA[(i-1),,]
+# }
+#
+# } else {
+# stop("exp-decay lambda must be ]0:1[")
+# }
+#
+# dimnames(covEWMA) = list(t.names, object.names, object.names)
+#
+# if(cor) {
+# corEWMA = covEWMA
+# for (i in 1:dim(corEWMA)[1]) {
+# corEWMA[i, , ] = cov2cor(covEWMA[i, ,])
+# }
+# return(corEWMA)
+# } else{
+# return(covEWMA)
+# }
+# }
+#' Exponential Weighted Moving Average (EWMA)
#'
-#' Description of EWMA. The function handles UV and MLE objects and returns either cov or cor.
+#' Description of EWMA. The function handles UV and MLM objects and returns either cov/cor.
#'
-#' @param object EWMA (either cov or corr, default = cov)
+#' @param R
+#' @param lambda
+#' @param inWnd
+#' @param cor option (default = FALSE)
#' @export
-EWMA <- function(object, lambda=0.96, cor=FALSE) {
- if ((is.data.frame(object)) & (lambda<1 || lambda > 0)){
- object.names = colnames(object)
- t.object = nrow(object)
- k.object = ncol(object)
- object = as.matrix(object)
- t.names = rownames(object)
-
- covEWMA = array(,c(t.object,k.object,k.object))
- # Note it is unconditional cov
- cov.f = var(object)
- FF = (object[1,]- mean(object)) %*% t(object[1,]- mean(object))
- covEWMA[1,,] = (1-lambda)*FF + lambda*cov.f
- for (i in 2:t.object) {
- FF = (object[i,]- mean(object)) %*% t(object[i,]- mean(object))
- covEWMA[i,,] = (1-lambda)*FF + lambda*covEWMA[(i-1),,]
- }
-
+#'
+#'
+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)) {
+ # Separate data into a initializing window and a testing window
+ inR = R[1:inWnd,]
+ testR = R[(inWnd+1):nrow(R),]
+
+ # Initialization of covariance matrix
+ lagCov = cov(inR)
+ covTmp = vector("list", nrow(testR))
+ for(i in 1:nrow(testR)){
+ # Extract R for the ith time step
+ tmpR = testR[i,]
+ covTmp[[i]] = lambda * (t(tmpR)%*%tmpR) + (1 - lambda) * lagCov
+ # Update lagCov to be covTmp from the current period
+ lagCov <- covTmp[[i]]
+ }
+ out <- covTmp
+ # Properly assign list key to date
+ names(out) <- index(testR)
+ # Check correlation option
+ if(cor) out <- lapply(out, cov2cor)
+
+ if(ncol(R) > 1) { class(out) <- c("EWMACovar")
+ } else if (ncol(R) == 1){class(out) <- c("EWMAVar")}
+ out$y_data <- R
+ return(out)
+
+ } else {
+ stop("For exponential decay lambda must belong to ]0:1[ ")
+ }
+}
+
+#' EWMA volatility/cross-volatility
+#'
+#' Description of EWMA Vola
+#'
+#' @param object a EWMA object created by \code{\link{EWMA}}
+#' @export
+getCov <- function(object, asset1, asset2){
+ UseMethod("getCov")
+}
+
+#' @method getCov EWMACovar
+#' @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
+ 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 {
- stop("object handled as data.frame class || exp-decay lambda must be ]0:1[")
+ # Then dimensions are enough to find covar
+ idx1 = asset1
+ idx2 = asset2
}
+ out = xts(unlist(lapply(object, function(object) object[idx1, idx2])), as.Date(index(object)))
+ colnames(out) = paste(asset1, asset2, sep=".")
+ return(out)
+}
- dimnames(covEWMA) = list(t.names, object.names, object.names)
-
- if(cor) {
- corEWMA = covEWMA
- for (i in 1:dim(corEWMA)[1]) {
- corEWMA[i, , ] = cov2cor(covEWMA[i, ,])
- }
- return(corEWMA)
- } else{
- return(covEWMA)
- }
+#' @method getCov EWMAVar
+#' @S3method getCov EWMAVar
+getCov.EWMAVar <- function(object, asset1){
+ if(!inherits(object, "EWMAVar")) stop("object must be of class EWMAVar")
+ # Check if asset is a character
+ if(is.character(asset1)){
+ 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(object, function(object) object[idx1])), as.Date(index(object)))
+ colnames(out) = paste(asset1, sep=".")
+ return(out)
+}
+
+
+# EWMA plotting for covar
+#' @export
+plot.EWMACovar <- function(object, asset1, asset2){
+ tmp = getCov(object,asset1, asset2)
+ plot(y=tmp, type="l", xlab="Time", ylab="Covar", lwd=2, col="blue",
+ main="EWMA Covar");
+ grid()
+ abline(h=var(object$y_data)[1,2], lwd=2, col="red")
+ }
+
+# EWMA plotting for var
+#' @export
+plot.EWMAVar <- function(object,asset1, asset2){
+ tmp = getCov(object,asset1)
+ plot(y=tmp, type="l", xlab="Time", ylab="Var", lwd=2, col="blue",
+ main="EWMA Var");
+ grid()
+ abline(h=var(object$y_data), lwd=2, col="red")
+}
+
Modified: pkg/GARPFRM/R/garch11.R
===================================================================
--- pkg/GARPFRM/R/garch11.R 2014-02-07 21:58:42 UTC (rev 62)
+++ pkg/GARPFRM/R/garch11.R 2014-02-08 00:38:44 UTC (rev 63)
@@ -25,13 +25,13 @@
#'
#' @param object a garch11 object created by \code{\link{GARCH(1,1)}}
#' @export
-fGarch11 <- function(object,window){
- UseMethod("fGarch11")
+fcstGarch11 <- function(object, window){
+ UseMethod("fcstGarch11")
}
-#' @method fGarch11 Dccfit
-#' @S3method fGarch11 DCCfit
-fGarch11.DCCfit <- function(object,window = 100){
+#' @method fcstGarch11 Dccfit
+#' @S3method fcstGarch11 DCCfit
+fcstGarch11.DCCfit <- function(object,window = 100){
result = dccforecast(garch11, n.ahead=window)
return(result)
}
\ No newline at end of file
Modified: pkg/GARPFRM/sandbox/test_EWMA_GARCH.R
===================================================================
--- pkg/GARPFRM/sandbox/test_EWMA_GARCH.R 2014-02-07 21:58:42 UTC (rev 62)
+++ pkg/GARPFRM/sandbox/test_EWMA_GARCH.R 2014-02-08 00:38:44 UTC (rev 63)
@@ -47,7 +47,7 @@
par(mfrow=c(1,1))
# Calculate EWMA cov and cor, applying default lambda - 0.96
-covEwma <- EWMA(as.data.frame(temp))
+covEwma <- EWMA(temp)
# Extract conditional var and cor
assetCondCov <- covEwma[,2,1];
More information about the Uwgarp-commits
mailing list