[Gogarch-commits] r23 - in pkg: . R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Feb 11 21:17:20 CET 2009
Author: bpfaff
Date: 2009-02-11 21:17:19 +0100 (Wed, 11 Feb 2009)
New Revision: 23
Added:
pkg/R/Methods-plot.R
pkg/R/Methods-resid.R
pkg/inst/
Modified:
pkg/DESCRIPTION
pkg/NAMESPACE
pkg/R/All-classes.R
pkg/R/All-generics.R
pkg/R/Functions.R
pkg/R/Methods-M.R
pkg/R/Methods-angles.R
pkg/R/Methods-ccor.R
pkg/R/Methods-ccov.R
pkg/R/Methods-coef.R
pkg/R/Methods-converged.R
pkg/R/Methods-cvar.R
pkg/R/Methods-formula.R
pkg/R/Methods-goest.R
pkg/R/Methods-logLik.R
pkg/R/Methods-predict.R
pkg/R/Methods-print.R
pkg/R/Methods-residuals.R
pkg/R/Methods-show.R
pkg/R/Methods-summary.R
pkg/R/Methods-t.R
pkg/R/Methods-update.R
pkg/R/Validation.R
pkg/man/GoGARCH-class.Rd
pkg/man/Goestica-class.Rd
pkg/man/Goestml-class.Rd
pkg/man/Goestmm-class.Rd
pkg/man/Goestnls-class.Rd
pkg/man/goest-methods.Rd
pkg/man/gogarch.Rd
Log:
Methods plot and resid added, Rd improved.
Modified: pkg/DESCRIPTION
===================================================================
--- pkg/DESCRIPTION 2009-02-10 19:48:53 UTC (rev 22)
+++ pkg/DESCRIPTION 2009-02-11 20:17:19 UTC (rev 23)
@@ -1,14 +1,13 @@
Package: gogarch
-Version: 0.6-0
+Version: 0.6-6
Type: Package
Title: Generalized Orthogonal GARCH (GO-GARCH) models
-Date: 2009-02-10
+Date: 2009-02-11
Author: Bernhard Pfaff
Maintainer: Bernhard Pfaff <bernhard at pfaffikus.de>
-Depends: R (>= 2.7.0), methods, stats, fGarch, fastICA
+Depends: R (>= 2.7.0), methods, stats, graphics, fGarch, fastICA
Suggests: vars
Description: Implementation of the GO-GARCH model class
License: GPL (>= 2)
LazyLoad: yes
LazyLoad: yes
-
Modified: pkg/NAMESPACE
===================================================================
--- pkg/NAMESPACE 2009-02-10 19:48:53 UTC (rev 22)
+++ pkg/NAMESPACE 2009-02-11 20:17:19 UTC (rev 23)
@@ -2,13 +2,14 @@
import(methods)
## Import functions
-importFrom(stats, coef, formula, logLik, predict, residuals, update)
+importFrom(stats, coef, formula, logLik, predict, residuals, resid, ts, as.ts, update)
+importFrom(graphics, plot)
## Classes
exportClasses(Goestml, Goestmm, Goestnls, GoGARCH, Goinit, Gopredict, Gosum, Orthom)
## Methods
-exportMethods(angles, cvar, ccor, ccov, coef, converged, formula, goest, logLik, M, predict, print, show, summary, t, residuals, update)
+exportMethods(angles, cvar, ccor, ccov, coef, converged, formula, goest, logLik, M, plot, predict, print, show, summary, t, residuals, resid, update)
## Functions
export(cora, gogarch, goinit, gollh, gonls, gotheta, Rd2, Umatch, UprodR, unvech, validOrthomObject, validGoinitObject)
Modified: pkg/R/All-classes.R
===================================================================
--- pkg/R/All-classes.R 2009-02-10 19:48:53 UTC (rev 22)
+++ pkg/R/All-classes.R 2009-02-11 20:17:19 UTC (rev 23)
@@ -15,6 +15,10 @@
##
setClass(Class = "Goestica", representation(ica = "list"), contains = "GoGARCH")
##
+## Class definition of GO-GARCH objects, estimated by Methods of Moments
+##
+setClass(Class = "Goestmm", representation(weights = "numeric", Umatched = "list"), contains = "GoGARCH")
+##
## Class definition of GO-GARCH objects, estimated by Maximum-Likelihood
##
setClass(Class = "Goestml", representation(opt = "list"), contains = "GoGARCH")
@@ -23,10 +27,6 @@
##
setClass(Class = "Goestnls", representation(nls = "list"), contains = "GoGARCH")
##
-## Class definition of GO-GARCH objects, estimated by Methods of Moments
-##
-setClass(Class = "Goestmm", representation(weights = "numeric", Umatched = "list"), contains = "GoGARCH")
-##
## Class definition for summary objects from GoGARCH
##
setClass(Class = "Gosum", representation(name = "character", method = "character", model = "formula", garchc = "list", Zinv = "matrix"))
Modified: pkg/R/All-generics.R
===================================================================
--- pkg/R/All-generics.R 2009-02-10 19:48:53 UTC (rev 22)
+++ pkg/R/All-generics.R 2009-02-11 20:17:19 UTC (rev 23)
@@ -3,10 +3,6 @@
##
setGeneric("goest", function(object, ...) standardGeneric("goest"))
##
-## Generic definition for extracting object at M for objects of class Orthom
-##
-setGeneric("M", function(object, ...) standardGeneric("M"))
-##
## Generic definition for extracting Euler angles
##
setGeneric("angles", function(object, ...) standardGeneric("angles"))
@@ -27,13 +23,21 @@
##
setGeneric("converged", function(object, ...) standardGeneric("converged"))
##
-## Setting Generics for coef, residuals, logLik and t
+## Generic definition for extracting object at M for objects of class Orthom
##
+setGeneric("M", function(object, ...) standardGeneric("M"))
+##
+## Setting Generics for coef, formula, logLik,
+## plot, predict, residuals, resid, summary, t
+## and update
+##
setGeneric("coef")
setGeneric("formula")
setGeneric("logLik")
+setGeneric("plot")
setGeneric("predict")
setGeneric("residuals")
+setGeneric("resid")
setGeneric("summary")
setGeneric("t")
setGeneric("update")
Modified: pkg/R/Functions.R
===================================================================
--- pkg/R/Functions.R 2009-02-10 19:48:53 UTC (rev 22)
+++ pkg/R/Functions.R 2009-02-11 20:17:19 UTC (rev 23)
@@ -1,4 +1,25 @@
-gogarch <- function(data, formula, scale = FALSE, method = c("ica", "mm", "ml", "nls"), lag.max = 1, initial = NULL, garchlist = list(init.rec = "mci", delta = 2, skew = 1, shape = 4, cond.dist = "norm", include.mean = FALSE, include.delta = NULL, include.skew = NULL, include.shape = NULL, leverage = NULL, trace = FALSE, algorithm = "nlminb", hessian = "ropt", control = list(), title = NULL, description = NULL), ...){
+##
+## This file includes the following functions:
+## ===========================================
+##
+## gogarch
+## Umatch
+## UprodR
+## Rd2
+## cora
+## goinit
+## gollh
+## gonls
+## gotheta
+## unvech
+##
+## ============================================
+##
+##
+## gogarch: main function for estimating GO-GARCH models
+##
+gogarch <-
+function(data, formula, scale = FALSE, method = c("ica", "mm", "ml", "nls"), lag.max = 1, initial = NULL, garchlist = list(init.rec = "mci", delta = 2, skew = 1, shape = 4, cond.dist = "norm", include.mean = FALSE, include.delta = NULL, include.skew = NULL, include.shape = NULL, leverage = NULL, trace = FALSE, algorithm = "nlminb", hessian = "ropt", control = list(), title = NULL, description = NULL), ...){
method <- match.arg(method)
Call <- match.call()
gini <- goinit(X = data, garchf = formula, scale = scale)
@@ -23,8 +44,12 @@
gogarch at name <- deparse(substitute(data))
return(gogarch)
}
-
-Umatch <- function(from, to){
+##
+## Umatch: Matching of orthogonal matrices. This function is employed
+## whence GO-GARCH models are estimated by methods of moments
+##
+Umatch <-
+function(from, to){
cols <- ncol(from)
mat <- matrix(0, nrow = cols, ncol = cols)
for(i in 1:cols){
@@ -41,7 +66,9 @@
}
return(mat)
}
-
+##
+## UprodR: This function computes an orthogonal matrix as the product of two-dimensional rotation matrices.
+##
UprodR <-
function(theta){
theta <- as.vector(theta)
@@ -63,7 +90,9 @@
result <- new("Orthom", M = U)
return(result)
}
-
+##
+## Rd2: This function returns a two-dimensional rotation matrix for a given Euler angle.
+##
Rd2 <-
function(theta){
theta <- as.vector(theta)
@@ -76,8 +105,13 @@
R <- matrix(c(cos(theta), sin(theta), -sin(theta), cos(theta)), ncol = 2, nrow = 2)
return(R)
}
-
-cora <- function(SSI, lag = 1, standardize = TRUE){
+##
+## cora: Computation of autocorrelations/autocovariances of a matrix process.
+## This function is utilized whence a GO-GARCH model is estimated by the
+## methods of moments
+##
+cora <-
+function(SSI, lag = 1, standardize = TRUE){
lag <- abs(as.integer(lag))
dims <- dim(SSI)
Gamma <- matrix(0, nrow = dims[1], ncol = dims[2])
@@ -113,8 +147,11 @@
cora <- (cora + t(cora)) / 2
return(cora)
}
-
-goinit <- function(X, garchf = ~ garch(1, 1), scale = FALSE){
+##
+## goinit: Function for creating an object of class "Goinit"
+##
+goinit <-
+function(X, garchf = ~ garch(1, 1), scale = FALSE){
dname <- deparse(substitute(X))
X <- as.matrix(X)
if(ncol(X) > nrow(X)){
@@ -131,7 +168,10 @@
result <- new("Goinit", X = X, V = V, P = P, Dsqr = Dsqr, garchf = garchf, name = dname)
return(result)
}
-
+##
+## gollh: The log-likelihood function of GO-GARCH models.
+## This function is employed whence GO-GARCH models are estimated by Maximum Likelihood
+##
gollh <-
function(params, object, garchlist){
gotheta <- gotheta(theta = params, object = object, garchlist = garchlist)
@@ -147,7 +187,10 @@
negll <- -1.0 * ll
return(negll)
}
-
+##
+## gonls: The target function to be minimized whence GO-GARCH models are estimated
+## by non-linear least-squares.
+##
gonls <-
function(params, SSI){
B <- unvech(params)
@@ -161,7 +204,10 @@
f <- sum(unlist(lapply(fl, function(x) sum(diag(x))))) / n
return(f)
}
-
+##
+## gotheta: For a given vector of Euler angles, this function computes a GO-GARCH model.
+## The function is called during estimation of GO-GARCH models by maximum likelihood.
+##
gotheta <-
function(theta, object, garchlist = list(init.rec = "mci", delta = 2, skew = 1, shape = 4, cond.dist = "norm", include.mean = FALSE, include.delta = NULL, include.skew = NULL, include.shape = NULL, leverage = NULL, trace = FALSE, algorithm = "nlminb", hessian = "ropt", control = list(), title = NULL, description = NULL)){
if(!any(inherits(object, what = c("Goinit", "GoGARCH", "Goestml")))) {
@@ -186,7 +232,9 @@
result <- new("GoGARCH", U = U, Z = Z, Y = Y, H = Ht, models = fitted, X = object at X, P = object at P, Dsqr = object at Dsqr, V = object at V, garchf = object at garchf, name = object at name, CALL = match.call())
return(result)
}
-
+##
+## unvech: Reverts the vech-operator and returns a symmetric matrix
+##
unvech <-
function(v){
v <- as.vector(v)
Modified: pkg/R/Methods-M.R
===================================================================
--- pkg/R/Methods-M.R 2009-02-10 19:48:53 UTC (rev 22)
+++ pkg/R/Methods-M.R 2009-02-11 20:17:19 UTC (rev 23)
@@ -1 +1,7 @@
+##
+## Methods for returning the orthogonal matrix "M"
+## ===============================================
+##
+## Method definition for objects of class "Orthom"
+##
setMethod(f = "M", signature(object = "Orthom"), function(object) object at M)
Modified: pkg/R/Methods-angles.R
===================================================================
--- pkg/R/Methods-angles.R 2009-02-10 19:48:53 UTC (rev 22)
+++ pkg/R/Methods-angles.R 2009-02-11 20:17:19 UTC (rev 23)
@@ -1,3 +1,9 @@
+##
+## Methods for returning the Euler angles
+## ======================================
+##
+## Method definition for objects of class "Goestml"
+##
setMethod(f = "angles", signature = "Goestml", definition = function(object){
angles <- object at opt$par
names(angles) <- paste("angle", seq(along.with = angles), sep = "")
Modified: pkg/R/Methods-ccor.R
===================================================================
--- pkg/R/Methods-ccor.R 2009-02-10 19:48:53 UTC (rev 22)
+++ pkg/R/Methods-ccor.R 2009-02-11 20:17:19 UTC (rev 23)
@@ -1,3 +1,9 @@
+##
+## Methods for returning the conditional correlations
+## ==================================================
+##
+## Method definition for objects of class "GoGARCH"
+##
setMethod(f = "ccor", signature(object = "GoGARCH"), definition = function(object){
m <- ncol(object at X)
d <- m * (m - 1) / 2
@@ -10,25 +16,41 @@
names <- mgrid[lower.tri(mgrid)]
colnames(ccor) <- names
rownames(ccor) <- rownames(object at X)
+ ccor <- as.ts(ccor)
return(ccor)
})
-
+##
+## Method definition for objects of class "Goestica"
+## "Goestica" extends directly "GoGARCH"
+##
setMethod(f = "ccor", signature(object = "Goestica"), definition = function(object){
ccor(as(object, "GoGARCH"))
})
-
+##
+## Method definition for objects of class "Goestmm"
+## "Goestmm" extends directly "GoGARCH"
+##
setMethod(f = "ccor", signature(object = "Goestmm"), definition = function(object){
ccor(as(object, "GoGARCH"))
})
-
+##
+## Method definition for objects of class "Goestnls"
+## "Goestnls" extends directly "GoGARCH"
+##
setMethod(f = "ccor", signature(object = "Goestnls"), definition = function(object){
ccor(as(object, "GoGARCH"))
})
-
+##
+## Method definition for objects of class "Goestml"
+## "Goestml" extends directly "GoGARCH"
+##
setMethod(f = "ccor", signature(object = "Goestml"), definition = function(object){
ccor(as(object, "GoGARCH"))
})
-
+##
+## Method definition for objects of class "Gopredict"
+## "Gopredict" objects are returned by method "predict"
+##
setMethod(f = "ccor", signature(object = "Gopredict"), definition = function(object){
m <- ncol(object at Xf)
d <- m * (m - 1) / 2
Modified: pkg/R/Methods-ccov.R
===================================================================
--- pkg/R/Methods-ccov.R 2009-02-10 19:48:53 UTC (rev 22)
+++ pkg/R/Methods-ccov.R 2009-02-11 20:17:19 UTC (rev 23)
@@ -1,3 +1,9 @@
+##
+## Methods for returning the conditional covariances
+## =================================================
+##
+## Method definition for objects of class "GoGARCH"
+##
setMethod(f = "ccov", signature(object = "GoGARCH"), definition = function(object){
m <- ncol(object at X)
d <- m * (m - 1) / 2
@@ -10,25 +16,41 @@
names <- mgrid[lower.tri(mgrid)]
colnames(ccov) <- names
rownames(ccov) <- rownames(object at X)
+ ccov <- as.ts(ccov)
return(ccov)
})
-
+##
+## Method definition for objects of class "Goestica"
+## "Goestica" extends directly "GoGARCH"
+##
setMethod(f = "ccov", signature(object = "Goestica"), definition = function(object){
ccov(as(object, "GoGARCH"))
})
-
+##
+## Method definition for objects of class "Goestmm"
+## "Goestmm" extends directly "GoGARCH"
+##
setMethod(f = "ccov", signature(object = "Goestmm"), definition = function(object){
ccov(as(object, "GoGARCH"))
})
-
+##
+## Method definition for objects of class "Goestnls"
+## "Goestnls" extends directly "GoGARCH"
+##
setMethod(f = "ccov", signature(object = "Goestnls"), definition = function(object){
ccov(as(object, "GoGARCH"))
})
-
+##
+## Method definition for objects of class "Goestml"
+## "Goestml" extends directly "GoGARCH"
+##
setMethod(f = "ccov", signature(object = "Goestml"), definition = function(object){
ccov(as(object, "GoGARCH"))
})
-
+##
+## Method definition for objects of class "Gopredict"
+## "Gopredict" objects are returned by method "predict"
+##
setMethod(f = "ccov", signature(object = "Gopredict"), definition = function(object){
m <- ncol(object at Xf)
d <- m * (m - 1) / 2
Modified: pkg/R/Methods-coef.R
===================================================================
--- pkg/R/Methods-coef.R 2009-02-10 19:48:53 UTC (rev 22)
+++ pkg/R/Methods-coef.R 2009-02-11 20:17:19 UTC (rev 23)
@@ -1,3 +1,9 @@
+##
+## Methods for returning the coefficients of the component GARCH models
+## ====================================================================
+##
+## Method definition for objects of class "GoGARCH"
+##
setMethod(f = "coef", signature(object = "GoGARCH"), definition = function(object){
garchc <- matrix(unlist(lapply(object at models, coef)), nrow = ncol(object at X), byrow = TRUE)
colnames(garchc) <- names(object at models[[1]]@fit$par)
@@ -4,19 +10,31 @@
rownames(garchc) <- paste("y", 1:nrow(garchc), sep = "")
return(garchc)
})
-
+##
+## Method definition for objects of class "Goestica"
+## "Goestica" extends directly "GoGARCH"
+##
setMethod(f = "coef", signature(object = "Goestica"), definition = function(object){
callNextMethod()
})
-
+##
+## Method definition for objects of class "Goestmm"
+## "Goestmm" extends directly "GoGARCH"
+##
setMethod(f = "coef", signature(object = "Goestmm"), definition = function(object){
callNextMethod()
})
-
+##
+## Method definition for objects of class "Goestnls"
+## "Goestnls" extends directly "GoGARCH"
+##
setMethod(f = "coef", signature(object = "Goestnls"), definition = function(object){
callNextMethod()
})
-
+##
+## Method definition for objects of class "Goestml"
+## "Goestml" extends directly "GoGARCH"
+##
setMethod(f = "coef", signature(object = "Goestml"), definition = function(object){
callNextMethod()
})
Modified: pkg/R/Methods-converged.R
===================================================================
--- pkg/R/Methods-converged.R 2009-02-10 19:48:53 UTC (rev 22)
+++ pkg/R/Methods-converged.R 2009-02-11 20:17:19 UTC (rev 23)
@@ -1,3 +1,9 @@
+##
+## Methods for returning the convergence codes of the component GARCH models
+## =========================================================================
+##
+## Method definition for objects of class "GoGARCH"
+##
setMethod(f = "converged", signature(object = "GoGARCH"), definition = function(object, ...){
conv <- c(unlist(lapply(object at models, function(x) x at fit$convergence)))
cnames <- paste("y", seq(along.with = conv), sep = "")
@@ -4,19 +10,31 @@
names(conv) <- cnames
return(conv)
})
-
+##
+## Method definition for objects of class "Goestica"
+## "Goestica" extends directly "GoGARCH"
+##
setMethod(f = "converged", signature(object = "Goestica"), definition = function(object){
converged(as(object, "GoGARCH"))
})
-
+##
+## Method definition for objects of class "Goestmm"
+## "Goestmm" extends directly "GoGARCH"
+##
setMethod(f = "converged", signature(object = "Goestmm"), definition = function(object){
converged(as(object, "GoGARCH"))
})
-
+##
+## Method definition for objects of class "Goestnls"
+## "Goestnls" extends directly "GoGARCH"
+##
setMethod(f = "converged", signature(object = "Goestnls"), definition = function(object){
converged(as(object, "GoGARCH"))
})
-
+##
+## Method definition for objects of class "Goestml"
+## "Goestml" extends directly "GoGARCH"
+##
setMethod(f = "converged", signature(object = "Goestml"), definition = function(object){
converged(as(object, "GoGARCH"))
})
Modified: pkg/R/Methods-cvar.R
===================================================================
--- pkg/R/Methods-cvar.R 2009-02-10 19:48:53 UTC (rev 22)
+++ pkg/R/Methods-cvar.R 2009-02-11 20:17:19 UTC (rev 23)
@@ -1,3 +1,9 @@
+##
+## Methods for returning the conditional variances
+## ================================================
+##
+## Method definition for objects of class "GoGARCH"
+##
setMethod(f = "cvar", signature(object = "GoGARCH"), definition = function(object){
m <- ncol(object at X)
n <- nrow(object at X)
@@ -4,25 +10,41 @@
cvar <- matrix(c(unlist(lapply(object at H, function(x) diag(x)))), ncol = m, nrow = n, byrow = TRUE)
colnames(cvar) <- paste("V.", colnames(object at X), sep = "")
rownames(cvar) <- rownames(object at X)
+ cvar <- as.ts(cvar)
return(cvar)
})
-
+##
+## Method definition for objects of class "Goestica"
+## "Goestica" extends directly "GoGARCH"
+##
setMethod(f = "cvar", signature(object = "Goestica"), definition = function(object){
cvar(as(object, "GoGARCH"))
})
-
+##
+## Method definition for objects of class "Goestmm"
+## "Goestmm" extends directly "GoGARCH"
+##
setMethod(f = "cvar", signature(object = "Goestmm"), definition = function(object){
cvar(as(object, "GoGARCH"))
})
-
+##
+## Method definition for objects of class "Goestnls"
+## "Goestnls" extends directly "GoGARCH"
+##
setMethod(f = "cvar", signature(object = "Goestnls"), definition = function(object){
cvar(as(object, "GoGARCH"))
})
-
+##
+## Method definition for objects of class "Goestml"
+## "Goestml" extends directly "GoGARCH"
+##
setMethod(f = "cvar", signature(object = "Goestml"), definition = function(object){
cvar(as(object, "GoGARCH"))
})
-
+##
+## Method definition for objects of class "Gopredict"
+## "Gopredict" objects are returned by method "predict"
+##
setMethod(f = "cvar", signature(object = "Gopredict"), definition = function(object){
m <- ncol(object at Xf)
n <- nrow(object at Xf)
Modified: pkg/R/Methods-formula.R
===================================================================
--- pkg/R/Methods-formula.R 2009-02-10 19:48:53 UTC (rev 22)
+++ pkg/R/Methods-formula.R 2009-02-11 20:17:19 UTC (rev 23)
@@ -1,19 +1,33 @@
+##
+## Methods for returning the formula of the GARCH model
+## ====================================================
+##
+## Method definition for objects of class "GoGARCH"
+##
setMethod("formula", signature(x = "GoGARCH"), function(x, ...)
x at garchf
)
-
+##
+## Method definition for objects of class "Goestica"
+##
setMethod("formula", signature(x = "Goestica"), function(x, ...)
x at garchf
)
-
+##
+## Method definition for objects of class "Goestmm"
+##
setMethod("formula", signature(x = "Goestmm"), function(x, ...)
x at garchf
)
-
+##
+## Method definition for objects of class "Goestnls"
+##
setMethod("formula", signature(x = "Goestnls"), function(x, ...)
x at garchf
)
-
+##
+## Method definition for objects of class "Goestml"
+##
setMethod("formula", signature(x = "Goestml"), function(x, ...)
x at garchf
)
Modified: pkg/R/Methods-goest.R
===================================================================
--- pkg/R/Methods-goest.R 2009-02-10 19:48:53 UTC (rev 22)
+++ pkg/R/Methods-goest.R 2009-02-11 20:17:19 UTC (rev 23)
@@ -1,3 +1,11 @@
+##
+## Methods for estimating GO-GARCH models
+## ==================================================
+##
+##
+## Method definition for objects of class "Goestica"
+## "Goestica" extends directly "GoGARCH"
+##
setMethod(f = "goest", signature(object = "Goestica"), definition = function(object, initial, garchlist, ...){
X <- object at X
m <- ncol(X)
@@ -18,8 +26,10 @@
result <- new("Goestica", ica = ica, estby = "fast ICA", U = W, Z = Z, Y = Y, H = Ht, models = fitted, X = object at X, P = object at P, Dsqr = object at Dsqr, V = object at V, garchf = object at garchf, name = object at name)
return(result)
})
-
-
+##
+## Method definition for objects of class "Goestmm"
+## "Goestmm" extends directly "GoGARCH"
+##
setMethod(f = "goest", signature(object = "Goestmm"), definition = function(object, lag.max, garchlist, ...){
lag.max <- abs(as.integer(lag.max))
X <- object at X
@@ -41,15 +51,15 @@
SSI[, , i] <- S[i, ] %*% t(S[i, ]) - diag(m)
}
Phil <- lapply(1:lag.max, function(x) cora(SSI, lag = x))
- svd <- lapply(Phil, function(x) eigen(x, symmetric = TRUE))
- evmin <- unlist(lapply(svd, function(x){
+ evs <- lapply(Phil, function(x) eigen(x, symmetric = TRUE))
+ evmin <- unlist(lapply(evs, function(x){
sel <- combn(1:m, 2)
diffs2 <- (x$values[sel[1, ]] - x$values[sel[2, ]])^2
min(diffs2)
}))
denom <- sum(evmin)
weights <- evmin / denom
- Ul <- lapply(svd, function(x) x$vectors)
+ Ul <- lapply(evs, function(x) x$vectors)
Ul[[1]] <- Umatch(Id, Ul[[1]])
Sm <- matrix(0, nrow = m, ncol = m)
for(i in 1:lag.max){
@@ -70,8 +80,10 @@
result <- new("Goestmm", weights = weights, Umatched = Umatched, estby = "Methods of Moments", U = U, Z = Z, Y = Y, H = Ht, models = fitted, X = object at X, P = object at P, Dsqr = object at Dsqr, V = object at V, garchf = object at garchf, name = object at name)
return(result)
})
-
-
+##
+## Method definition for objects of class "Goestnls"
+## "Goestnls" extends directly "GoGARCH"
+##
setMethod(f = "goest", signature(object = "Goestnls"), definition = function(object, initial, garchlist, ...){
d <- ncol(object at X)
if(is.null(initial)){
@@ -98,9 +110,9 @@
SSI0 <- SSI[-1]
SSI1 <- SSI[-n]
SSI <- list(SSI0 = SSI0, SSI1 = SSI1)
- nlsobj <- nlminb(start = initial, objective = gonls, SSI = SSI, ...)
+ nlsobj <- optim(par = initial, fn = gonls, SSI = SSI, ...)
B <- unvech(nlsobj$par)
- U <- svd(B)$u
+ U <- eigen(B)$vectors
Z <- P %*% Dsqr %*% t(U)
Y <- S %*% U
fitted <- apply(Y, 2, function(x) do.call("garchFit", c(list(formula = object at garchf, data = quote(x)), garchlist)))
@@ -111,7 +123,10 @@
result <- new("Goestnls", nls = nlsobj, estby = "non-linear Least-Squares", U = U, Z = Z, Y = Y, H = Ht, models = fitted, X = object at X, P = object at P, Dsqr = object at Dsqr, V = object at V, garchf = object at garchf, name = object at name)
return(result)
})
-
+##
+## Method definition for objects of class "Goestml"
+## "Goestml" extends directly "GoGARCH"
+##
setMethod(f = "goest", signature(object = "Goestml"), definition = function(object, initial, garchlist, ...){
d <- ncol(object at X)
if(is.null(initial)){
Modified: pkg/R/Methods-logLik.R
===================================================================
--- pkg/R/Methods-logLik.R 2009-02-10 19:48:53 UTC (rev 22)
+++ pkg/R/Methods-logLik.R 2009-02-11 20:17:19 UTC (rev 23)
@@ -1,3 +1,9 @@
+##
+## Methods for returning an informal "logLik" object
+## =================================================
+##
+## Method definition for objects of class "Goestml"
+##
setMethod(f = "logLik", signature = "Goestml", definition = function(object){
r <- -1.0 * object at opt$objective
df <- ncol(object at X) * sum(object at models[[1]]@fit$params$include) + length(angles(object))
Added: pkg/R/Methods-plot.R
===================================================================
--- pkg/R/Methods-plot.R (rev 0)
+++ pkg/R/Methods-plot.R 2009-02-11 20:17:19 UTC (rev 23)
@@ -0,0 +1,45 @@
+##
+## Methods for plotting GO-GARCH models
+## ====================================
+##
+## Method definition for objects of class "GoGARCH"
+##
+setMethod(f = "plot", signature(x = "GoGARCH", y = "missing"), definition = function(x, main = NULL, ...){
+ if(is.null(main)){
+ main <- paste("Conditional correlations of", x at name)
+ }
+ x <- ccor(x)
+ plot(x, main = main, ...)
+})
+##
+## Method definition for objects of class "Goestica"
+## "Goestica" extends directly "GoGARCH"
+##
+setMethod(f = "plot", signature(x = "Goestica", y = "missing"), definition = function(x, main = NULL, ...){
+ x <- as(x, "GoGARCH")
+ plot(x, main = main, ...)
+})
+##
+## Method definition for objects of class "Goestmm"
+## "Goestmm" extends directly "GoGARCH"
+##
+setMethod(f = "plot", signature(x = "Goestmm", y = "missing"), definition = function(x, main = NULL, ...){
+ x <- as(x, "GoGARCH")
+ plot(x, main = main, ...)
+})
+##
+## Method definition for objects of class "Goestnls"
+## "Goestnls" extends directly "GoGARCH"
+##
+setMethod(f = "plot", signature(x = "Goestnls", y = "missing"), definition = function(x, main = NULL, ...){
+ x <- as(x, "GoGARCH")
+ plot(x, main = main, ...)
+})
+##
+## Method definition for objects of class "Goestml"
+## "Goestml" extends directly "GoGARCH"
+##
+setMethod(f = "plot", signature(x = "Goestml", y = "missing"), definition = function(x, main = NULL, ...){
+ x <- as(x, "GoGARCH")
+ plot(x, main = main, ...)
+})
Modified: pkg/R/Methods-predict.R
===================================================================
--- pkg/R/Methods-predict.R 2009-02-10 19:48:53 UTC (rev 22)
+++ pkg/R/Methods-predict.R 2009-02-11 20:17:19 UTC (rev 23)
@@ -1,3 +1,11 @@
+##
+## Methods for obtaining predictions from GO-GARCH models
+## ======================================================
+##
+## Method definition for objects of class "GoGARCH"
+## The method "predict" returns an object of class "Gopredict" for
+## which a "show" method exists.
+##
setMethod(f = "predict", signature(object = "GoGARCH"), definition = function(object, n.ahead = 10, ...){
n.ahead <- abs(as.integer(n.ahead))
m <- ncol(object at X)
@@ -16,19 +24,31 @@
fcst <- new("Gopredict", Hf = H.pred.x, Xf = mean.pred.x, CGARCHF = predictions)
return(fcst)
})
-
+##
+## Method definition for objects of class "Goestica"
+## "Goestica" extends directly "GoGARCH"
+##
setMethod(f = "predict", signature(object = "Goestica"), definition = function(object, n.ahead = 10, ...){
callNextMethod()
})
-
+##
+## Method definition for objects of class "Goestmm"
+## "Goestmm" extends directly "GoGARCH"
+##
setMethod(f = "predict", signature(object = "Goestmm"), definition = function(object, n.ahead = 10, ...){
callNextMethod()
})
-
+##
+## Method definition for objects of class "Goestnls"
+## "Goestnls" extends directly "GoGARCH"
+##
setMethod(f = "predict", signature(object = "Goestnls"), definition = function(object, n.ahead = 10, ...){
callNextMethod()
})
-
+##
+## Method definition for objects of class "Goestml"
+## "Goestml" extends directly "GoGARCH"
+##
setMethod(f = "predict", signature(object = "Goestml"), definition = function(object, n.ahead = 10, ...){
callNextMethod()
})
Modified: pkg/R/Methods-print.R
===================================================================
--- pkg/R/Methods-print.R 2009-02-10 19:48:53 UTC (rev 22)
+++ pkg/R/Methods-print.R 2009-02-11 20:17:19 UTC (rev 23)
@@ -1 +1,7 @@
+##
+## Methods for printing objects
+## ============================
+##
+## Method definition for objects of class "Orthom"
+##
setMethod(f = "print", signature(x = "Orthom"), function(x, ...) print(x at M, ...))
Added: pkg/R/Methods-resid.R
===================================================================
--- pkg/R/Methods-resid.R (rev 0)
+++ pkg/R/Methods-resid.R 2009-02-11 20:17:19 UTC (rev 23)
@@ -0,0 +1,48 @@
+##
+## Methods for returning the residuals of the GO-GARCH model
+## =========================================================
+##
+## Method definition for objects of class "GoGARCH"
+##
+setMethod(f = "resid", signature(object = "GoGARCH"), definition = function(object){
+ m <- ncol(object at X)
+ n <- nrow(object at X)
+ svd <- lapply(object at H, svd)
+ Vsqrinv <- lapply(svd, function(x) x$u %*% diag(1 / sqrt(x$d)) %*% t(x$u))
+ resm <- matrix(0.0, nrow = n, ncol = m)
+ for(i in 1:n){
+ resm[i, ] <- Vsqrinv[[i]] %*% object at X[i, ]
+ }
+ colnames(resm) <- paste(colnames(object at X), "resid", sep = ".")
+ rownames(resm) <- rownames(object at X)
+ resm <- as.ts(resm)
+ return(resm)
+})
+##
+## Method definition for objects of class "Goestica"
+## "Goestica" extends directly "GoGARCH"
+##
+setMethod(f = "resid", signature(object = "Goestica"), definition = function(object, standardize = FALSE){
+ callNextMethod()
+})
+##
+## Method definition for objects of class "Goestmm"
+## "Goestmm" extends directly "GoGARCH"
+##
+setMethod(f = "resid", signature(object = "Goestmm"), definition = function(object){
+ callNextMethod()
+})
+##
+## Method definition for objects of class "Goestnls"
+## "Goestnls" extends directly "GoGARCH"
+##
+setMethod(f = "resid", signature(object = "Goestnls"), definition = function(object){
+ callNextMethod()
+})
+##
+## Method definition for objects of class "Goestml"
+## "Goestml" extends directly "GoGARCH"
+##
+setMethod(f = "resid", signature(object = "Goestml"), definition = function(object){
+ callNextMethod()
+})
Modified: pkg/R/Methods-residuals.R
===================================================================
--- pkg/R/Methods-residuals.R 2009-02-10 19:48:53 UTC (rev 22)
+++ pkg/R/Methods-residuals.R 2009-02-11 20:17:19 UTC (rev 23)
@@ -1,26 +1,48 @@
-setMethod(f = "residuals", signature(object = "GoGARCH"), definition = function(object, standardize = FALSE){
+##
+## Methods for returning the residuals of the GO-GARCH model
+## =========================================================
+##
+## Method definition for objects of class "GoGARCH"
+##
+setMethod(f = "residuals", signature(object = "GoGARCH"), definition = function(object){
m <- ncol(object at X)
n <- nrow(object at X)
- resl <- lapply(object at models, residuals, standardize = standardize)
- resm <- matrix(c(unlist(resl)), ncol = m, nrow = n)
- ynames <- paste("y", 1:2, sep = "")
- colnames(resm) <- ynames
+ svd <- lapply(object at H, svd)
+ Vsqrinv <- lapply(svd, function(x) x$u %*% diag(1 / sqrt(x$d)) %*% t(x$u))
+ resm <- matrix(0.0, nrow = n, ncol = m)
+ for(i in 1:n){
+ resm[i, ] <- Vsqrinv[[i]] %*% object at X[i, ]
+ }
+ colnames(resm) <- paste(colnames(object at X), "resid", sep = ".")
rownames(resm) <- rownames(object at X)
+ resm <- as.ts(resm)
return(resm)
})
-
+##
+## Method definition for objects of class "Goestica"
+## "Goestica" extends directly "GoGARCH"
+##
setMethod(f = "residuals", signature(object = "Goestica"), definition = function(object, standardize = FALSE){
- callNextMethod(object = object, standardize = standardize)
+ callNextMethod()
})
-
-setMethod(f = "residuals", signature(object = "Goestmm"), definition = function(object, standardize = FALSE){
- callNextMethod(object = object, standardize = standardize)
+##
+## Method definition for objects of class "Goestmm"
+## "Goestmm" extends directly "GoGARCH"
+##
+setMethod(f = "residuals", signature(object = "Goestmm"), definition = function(object){
+ callNextMethod()
})
-
-setMethod(f = "residuals", signature(object = "Goestnls"), definition = function(object, standardize = FALSE){
- callNextMethod(object = object, standardize = standardize)
+##
+## Method definition for objects of class "Goestnls"
+## "Goestnls" extends directly "GoGARCH"
+##
+setMethod(f = "residuals", signature(object = "Goestnls"), definition = function(object){
+ callNextMethod()
})
-
-setMethod(f = "residuals", signature(object = "Goestml"), definition = function(object, standardize = FALSE){
- callNextMethod(object = object, standardize = standardize)
+##
+## Method definition for objects of class "Goestml"
+## "Goestml" extends directly "GoGARCH"
+##
+setMethod(f = "residuals", signature(object = "Goestml"), definition = function(object){
+ callNextMethod()
})
Modified: pkg/R/Methods-show.R
===================================================================
--- pkg/R/Methods-show.R 2009-02-10 19:48:53 UTC (rev 22)
+++ pkg/R/Methods-show.R 2009-02-11 20:17:19 UTC (rev 23)
@@ -1,3 +1,9 @@
+##
+## Methods for showing S4-class objects
+## ====================================
+##
+## Method definition for objects of class "GoGARCH"
+##
setMethod(f = "show", signature(object = "GoGARCH"), definition = function(object){
title <- "*** GO-GARCH ***"
stars <- paste(rep("*", nchar(title)), collapse = "")
@@ -27,25 +33,41 @@
print(converged(object))
invisible(object)
})
-
+##
+## Method definition for objects of class "Goestica"
+## "Goestica" extends directly "GoGARCH"
+##
setMethod(f = "show", signature(object = "Goestica"), definition = function(object){
callNextMethod()
})
-
+##
+## Method definition for objects of class "Goestmm"
+## "Goestmm" extends directly "GoGARCH"
+##
setMethod(f = "show", signature(object = "Goestmm"), definition = function(object){
callNextMethod()
})
-
+##
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/gogarch -r 23
More information about the Gogarch-commits
mailing list