[Gogarch-commits] r14 - in pkg: . R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Thu Jan 29 23:56:41 CET 2009
Author: bpfaff
Date: 2009-01-29 23:56:41 +0100 (Thu, 29 Jan 2009)
New Revision: 14
Added:
pkg/R/GoGARCH-ccor.R
pkg/R/GoGARCH-ccov.R
pkg/R/GoGARCH-coef.R
pkg/R/GoGARCH-converged.R
pkg/R/GoGARCH-cvar.R
pkg/R/GoGARCH-residuals.R
pkg/R/Goestml-angles.R
pkg/R/Goestml-ccor.R
pkg/R/Goestml-ccov.R
pkg/R/Goestml-coef.R
pkg/R/Goestml-converged.R
pkg/R/Goestml-cvar.R
pkg/R/Goestml-logLik.R
pkg/R/Goestml-residuals.R
pkg/R/Goestml-show.R
Modified:
pkg/DESCRIPTION
pkg/NAMESPACE
pkg/R/All-classes.R
pkg/R/All-generics.R
pkg/R/GoGARCH-show.R
pkg/R/Goestml-goest.R
pkg/R/Orthom-M.R
pkg/R/Orthom-print.R
pkg/R/Orthom-show.R
pkg/R/Orthom-t.R
pkg/R/gogarch.R
pkg/R/gotheta.R
pkg/man/GoGARCH-class.Rd
pkg/man/Goestml-class.Rd
pkg/man/goest-methods.Rd
Log:
Classes, methods and functions added.
Modified: pkg/DESCRIPTION
===================================================================
--- pkg/DESCRIPTION 2009-01-27 20:18:28 UTC (rev 13)
+++ pkg/DESCRIPTION 2009-01-29 22:56:41 UTC (rev 14)
@@ -1,12 +1,12 @@
Package: gogarch
-Version: 0.1-6
+Version: 0.2-8
Type: Package
Title: Generalized Orthogonal GARCH (GO-GARCH) models
-Date: 2009-01-27
+Date: 2009-01-29
Author: Bernhard Pfaff
Maintainer: Bernhard Pfaff <bernhard at pfaffikus.de>
-Depends: R (>= 2.7.0), methods, fGarch
+Depends: R (>= 2.7.0), stats, methods, fGarch
Suggests: vars
Description: Implementation of the GO-GARCH model class.
License: GPL (>= 2)
-LazyLoad: yes
+LazyLoad: no
Modified: pkg/NAMESPACE
===================================================================
--- pkg/NAMESPACE 2009-01-27 20:18:28 UTC (rev 13)
+++ pkg/NAMESPACE 2009-01-29 22:56:41 UTC (rev 14)
@@ -1,12 +1,45 @@
-##
-import(methods)
+## Import packages
+import("methods")
-## Functions
-export(goest, gogarch, goinit, gollh, gotheta, M, Rd2, t, UprodR, unvech, validOrthomObject, validGoinitObject)
+## Import functions
+importFrom("stats",
+ "coef",
+ "logLik",
+ "residuals",
+ "resid")
## Classes
-exportClasses("Goestml", "GoGARCH", "Goinit", "Orthom")
+exportClasses("Goestml",
+ "GoGARCH",
+ "Goinit",
+ "Orthom")
## Methods
-exportMethods("goest", "M", "print", "show", "t")
+exportMethods("angles",
+ "cvar",
+ "ccor",
+ "ccov",
+ "coef",
+ "converged",
+ "goest",
+ "logLik",
+ "M",
+ "print",
+ "show",
+ "t",
+ "residuals",
+ "resid")
+## Functions
+export("gogarch",
+ "goinit",
+ "gollh",
+ "gotheta",
+ "Rd2",
+ "UprodR",
+ "unvech",
+ "validOrthomObject",
+ "validGoinitObject")
+
+
+
Modified: pkg/R/All-classes.R
===================================================================
--- pkg/R/All-classes.R 2009-01-27 20:18:28 UTC (rev 13)
+++ pkg/R/All-classes.R 2009-01-29 22:56:41 UTC (rev 14)
@@ -5,7 +5,7 @@
##
## Class definition of GO-GARCH objects
##
-setClass(Class = "GoGARCH", representation(Z = "matrix", Y = "matrix", H = "list", models = "list", estby = "character"), contains = "Goinit")
+setClass(Class = "GoGARCH", representation(Z = "matrix", Y = "matrix", H = "list", models = "list", estby = "character", CALL = "call"), contains = "Goinit")
##
## Class definition of GO-GARCH objects, estimated by Maximum-Likelihood
##
Modified: pkg/R/All-generics.R
===================================================================
--- pkg/R/All-generics.R 2009-01-27 20:18:28 UTC (rev 13)
+++ pkg/R/All-generics.R 2009-01-29 22:56:41 UTC (rev 14)
@@ -6,3 +6,23 @@
## 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"))
+##
+## Generic definition for extracting the conditional variances
+##
+setGeneric("cvar", function(object, ...) standardGeneric("cvar"))
+##
+## Generic definition for extracting the conditional covariances
+##
+setGeneric("ccov", function(object, ...) standardGeneric("ccov"))
+##
+## Generic definition for extracting the conditional correlations
+##
+setGeneric("ccor", function(object, ...) standardGeneric("ccor"))
+##
+## Generic definition for extracting convergence codes
+##
+setGeneric("converged", function(object, ...) standardGeneric("converged"))
Added: pkg/R/GoGARCH-ccor.R
===================================================================
--- pkg/R/GoGARCH-ccor.R (rev 0)
+++ pkg/R/GoGARCH-ccor.R 2009-01-29 22:56:41 UTC (rev 14)
@@ -0,0 +1,14 @@
+setMethod(f = "ccor", signature(object = "GoGARCH"), definition = function(object){
+ m <- ncol(object at X)
+ d <- m * (m - 1) / 2
+ n <- nrow(object at X)
+ cnames <- colnames(object at X)
+ ccor <- matrix(c(unlist(lapply(object at H, function(x) cov2cor(x)[lower.tri(x)]))), ncol = d, nrow = n, byrow = TRUE)
+ ngrid <- data.frame(expand.grid(cnames, cnames), stringsAsFactors = FALSE)
+ mgrid <- paste(ngrid[, 1], ngrid[, 2], sep = " & ")
+ mgrid <- matrix(mgrid, nrow = m, ncol = m)
+ names <- mgrid[lower.tri(mgrid)]
+ colnames(ccor) <- names
+ rownames(ccor) <- rownames(object at X)
+ return(ccor)
+})
Added: pkg/R/GoGARCH-ccov.R
===================================================================
--- pkg/R/GoGARCH-ccov.R (rev 0)
+++ pkg/R/GoGARCH-ccov.R 2009-01-29 22:56:41 UTC (rev 14)
@@ -0,0 +1,14 @@
+setMethod(f = "ccov", signature(object = "GoGARCH"), definition = function(object){
+ m <- ncol(object at X)
+ d <- m * (m - 1) / 2
+ n <- nrow(object at X)
+ cnames <- colnames(object at X)
+ ccov <- matrix(c(unlist(lapply(object at H, function(x) x[lower.tri(x)]))), ncol = d, nrow = n, byrow = TRUE)
+ ngrid <- data.frame(expand.grid(cnames, cnames), stringsAsFactors = FALSE)
+ mgrid <- paste(ngrid[, 1], ngrid[, 2], sep = " & ")
+ mgrid <- matrix(mgrid, nrow = m, ncol = m)
+ names <- mgrid[lower.tri(mgrid)]
+ colnames(ccov) <- names
+ rownames(ccov) <- rownames(object at X)
+ return(ccov)
+})
Added: pkg/R/GoGARCH-coef.R
===================================================================
--- pkg/R/GoGARCH-coef.R (rev 0)
+++ pkg/R/GoGARCH-coef.R 2009-01-29 22:56:41 UTC (rev 14)
@@ -0,0 +1,7 @@
+setMethod(f = "coef", signature(object = "GoGARCH"), definition = function(object){
+ garchc <- matrix(unlist(lapply(object at models, function(x) coef(x))), nrow = ncol(object at X), byrow = TRUE)
+ colnames(garchc) <- names(object at models[[1]]@fit$par)
+ rownames(garchc) <- paste("y", 1:nrow(garchc), sep = "")
+ return(garchc)
+})
+
Added: pkg/R/GoGARCH-converged.R
===================================================================
--- pkg/R/GoGARCH-converged.R (rev 0)
+++ pkg/R/GoGARCH-converged.R 2009-01-29 22:56:41 UTC (rev 14)
@@ -0,0 +1,6 @@
+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 = "")
+ names(conv) <- cnames
+ return(conv)
+})
Added: pkg/R/GoGARCH-cvar.R
===================================================================
--- pkg/R/GoGARCH-cvar.R (rev 0)
+++ pkg/R/GoGARCH-cvar.R 2009-01-29 22:56:41 UTC (rev 14)
@@ -0,0 +1,8 @@
+setMethod(f = "cvar", signature(object = "GoGARCH"), definition = function(object){
+ m <- ncol(object at X)
+ n <- nrow(object at X)
+ 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)
+ return(cvar)
+})
Added: pkg/R/GoGARCH-residuals.R
===================================================================
--- pkg/R/GoGARCH-residuals.R (rev 0)
+++ pkg/R/GoGARCH-residuals.R 2009-01-29 22:56:41 UTC (rev 14)
@@ -0,0 +1,22 @@
+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, ...)
+ resm <- matrix(c(unlist(resl)), ncol = m, nrow = n)
+ ynames <- paste("y", 1:2, sep = "")
+ colnames(resm) <- ynames
+ rownames(resm) <- rownames(object at X)
+ return(resm)
+})
+
+setMethod(f = "resid", signature(object = "GoGARCH"), definition = function(object, ...){
+ m <- ncol(object at X)
+ n <- nrow(object at X)
+ resl <- lapply(object at models, residuals, ...)
+ resm <- matrix(c(unlist(resl)), ncol = m, nrow = n)
+ ynames <- paste("y", 1:2, sep = "")
+ colnames(resm) <- ynames
+ rownames(resm) <- rownames(object at X)
+ return(resm)
+})
+
Modified: pkg/R/GoGARCH-show.R
===================================================================
--- pkg/R/GoGARCH-show.R 2009-01-27 20:18:28 UTC (rev 13)
+++ pkg/R/GoGARCH-show.R 2009-01-29 22:56:41 UTC (rev 14)
@@ -1,4 +1,4 @@
-setMethod(f = "show", signature = "GoGARCH", definition = function(object){
+setMethod(f = "show", signature(object = "GoGARCH"), definition = function(object){
title <- "*** GO-GARCH ***"
stars <- paste(rep("*", nchar(title)), collapse = "")
cat("\n")
@@ -20,9 +20,9 @@
print(solve(object at Z), quote = FALSE)
cat("\n")
}
- garchc <- matrix(unlist(lapply(object at models, function(x) coef(x))), nrow = ncol(object at X), byrow = TRUE)
- colnames(garchc) <- names(object at models[[1]]@fit$par)
- rownames(garchc) <- paste("y", 1:nrow(garchc), sep = "")
cat("Estimated GARCH coefficients:\n")
- print(garchc)
+ print(coef(object))
+ cat("\n")
+ cat("Convergence codes of component GARCH models:\n")
+ print(converged(object))
})
Added: pkg/R/Goestml-angles.R
===================================================================
--- pkg/R/Goestml-angles.R (rev 0)
+++ pkg/R/Goestml-angles.R 2009-01-29 22:56:41 UTC (rev 14)
@@ -0,0 +1,5 @@
+setMethod(f = "angles", signature = "Goestml", definition = function(object){
+ angles <- object at opt$par
+ names(angles) <- paste("angle", seq(along.with = angles), sep = "")
+ return(angles)
+})
Added: pkg/R/Goestml-ccor.R
===================================================================
--- pkg/R/Goestml-ccor.R (rev 0)
+++ pkg/R/Goestml-ccor.R 2009-01-29 22:56:41 UTC (rev 14)
@@ -0,0 +1,3 @@
+setMethod(f = "ccor", signature(object = "Goestml"), definition = function(object){
+ ccor(as(object, "GoGARCH"))
+})
Added: pkg/R/Goestml-ccov.R
===================================================================
--- pkg/R/Goestml-ccov.R (rev 0)
+++ pkg/R/Goestml-ccov.R 2009-01-29 22:56:41 UTC (rev 14)
@@ -0,0 +1,3 @@
+setMethod(f = "ccov", signature(object = "Goestml"), definition = function(object){
+ ccov(as(object, "GoGARCH"))
+})
Added: pkg/R/Goestml-coef.R
===================================================================
--- pkg/R/Goestml-coef.R (rev 0)
+++ pkg/R/Goestml-coef.R 2009-01-29 22:56:41 UTC (rev 14)
@@ -0,0 +1,4 @@
+setMethod(f = "coef", signature(object = "Goestml"), definition = function(object){
+ coef(as(object, "GoGARCH"))
+})
+
Added: pkg/R/Goestml-converged.R
===================================================================
--- pkg/R/Goestml-converged.R (rev 0)
+++ pkg/R/Goestml-converged.R 2009-01-29 22:56:41 UTC (rev 14)
@@ -0,0 +1,3 @@
+setMethod(f = "converged", signature(object = "Goestml"), definition = function(object){
+ converged(as(object, "GoGARCH"))
+})
Added: pkg/R/Goestml-cvar.R
===================================================================
--- pkg/R/Goestml-cvar.R (rev 0)
+++ pkg/R/Goestml-cvar.R 2009-01-29 22:56:41 UTC (rev 14)
@@ -0,0 +1,3 @@
+setMethod(f = "cvar", signature(object = "Goestml"), definition = function(object){
+ cvar(as(object, "GoGARCH"))
+})
Modified: pkg/R/Goestml-goest.R
===================================================================
--- pkg/R/Goestml-goest.R 2009-01-27 20:18:28 UTC (rev 13)
+++ pkg/R/Goestml-goest.R 2009-01-29 22:56:41 UTC (rev 14)
@@ -1,4 +1,4 @@
-setMethod(f = "goest", signature = c(object = "Goestml", initial = "numeric", garchlist = "list"), definition = function(object, initial, garchlist, ...){
+setMethod(f = "goest", signature(object = "Goestml", initial = "numeric", garchlist = "list"), definition = function(object, initial, garchlist, ...){
llobj <- nlminb(start = initial, objective = gollh, object = object, garchlist = garchlist, lower = 1.5e-8, upper = pi/2, ...)
gotheta <- gotheta(llobj$par, object)
result <- new("Goestml", opt = llobj, estby = "maximum likelihood", gotheta)
Added: pkg/R/Goestml-logLik.R
===================================================================
--- pkg/R/Goestml-logLik.R (rev 0)
+++ pkg/R/Goestml-logLik.R 2009-01-29 22:56:41 UTC (rev 14)
@@ -0,0 +1,7 @@
+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))
+ attr(r, "df") <- df
+ class(r) <- "logLik"
+ return(r)
+})
Added: pkg/R/Goestml-residuals.R
===================================================================
--- pkg/R/Goestml-residuals.R (rev 0)
+++ pkg/R/Goestml-residuals.R 2009-01-29 22:56:41 UTC (rev 14)
@@ -0,0 +1,9 @@
+setMethod(f = "residuals", signature(object = "Goestml"), definition = function(object, ...){
+ residuals(as(object, "GoGARCH"), ...)
+})
+
+
+setMethod(f = "resid", signature(object = "Goestml"), definition = function(object, ...){
+ resid(as(object, "GoGARCH"), ...)
+})
+
Added: pkg/R/Goestml-show.R
===================================================================
--- pkg/R/Goestml-show.R (rev 0)
+++ pkg/R/Goestml-show.R 2009-01-29 22:56:41 UTC (rev 14)
@@ -0,0 +1,3 @@
+setMethod(f = "show", signature(object = "Goestml"), definition = function(object){
+ show(as(object, "GoGARCH"))
+})
Modified: pkg/R/Orthom-M.R
===================================================================
--- pkg/R/Orthom-M.R 2009-01-27 20:18:28 UTC (rev 13)
+++ pkg/R/Orthom-M.R 2009-01-29 22:56:41 UTC (rev 14)
@@ -1,4 +1,4 @@
##
## M-method for objects of class Orthom
##
-setMethod(f = "M", signature = "Orthom", function(object) object at M)
+setMethod(f = "M", signature(object = "Orthom"), function(object) object at M)
Modified: pkg/R/Orthom-print.R
===================================================================
--- pkg/R/Orthom-print.R 2009-01-27 20:18:28 UTC (rev 13)
+++ pkg/R/Orthom-print.R 2009-01-29 22:56:41 UTC (rev 14)
@@ -1,4 +1,4 @@
##
## print-method for objects of class Orthom
##
-setMethod(f = "print", signature = "Orthom", function(x, ...) print(x at M, ...))
+setMethod(f = "print", signature(x = "Orthom"), function(x, ...) print(x at M, ...))
Modified: pkg/R/Orthom-show.R
===================================================================
--- pkg/R/Orthom-show.R 2009-01-27 20:18:28 UTC (rev 13)
+++ pkg/R/Orthom-show.R 2009-01-29 22:56:41 UTC (rev 14)
@@ -1,4 +1,4 @@
##
## show-method for objects of class Orthom
##
-setMethod(f = "show", signature = "Orthom", function(object) print(object at M))
+setMethod(f = "show", signature(object = "Orthom"), function(object) print(object at M))
Modified: pkg/R/Orthom-t.R
===================================================================
--- pkg/R/Orthom-t.R 2009-01-27 20:18:28 UTC (rev 13)
+++ pkg/R/Orthom-t.R 2009-01-29 22:56:41 UTC (rev 14)
@@ -1,4 +1,4 @@
##
## Transpose method for objects of class Orthom
##
-setMethod("t", "Orthom", function(x) t(x at M))
+setMethod("t", signature(x = "Orthom"), function(x) t(x at M))
Modified: pkg/R/gogarch.R
===================================================================
--- pkg/R/gogarch.R 2009-01-27 20:18:28 UTC (rev 13)
+++ pkg/R/gogarch.R 2009-01-29 22:56:41 UTC (rev 14)
@@ -1,5 +1,6 @@
gogarch <- function(data, formula, scale = FALSE, method = c("ml"), 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()
d <- ncol(data)
if(is.null(initial)){
l <- d * (d - 1)/2
@@ -16,5 +17,6 @@
goestml <- new("Goestml", gomod)
gogarch <- goest(object = goestml, initial = initial, garchlist = garchlist, ...)
}
+ gogarch at CALL <- Call
return(gogarch)
}
Modified: pkg/R/gotheta.R
===================================================================
--- pkg/R/gotheta.R 2009-01-27 20:18:28 UTC (rev 13)
+++ pkg/R/gotheta.R 2009-01-29 22:56:41 UTC (rev 14)
@@ -14,7 +14,7 @@
Z <- object at P %*% object at Dsqr %*% t(U)
Zinv <- solve(Z)
Y <- object at X %*% Zinv
- fitted <- apply(Y, 2, function(x) do.call("garchFit", c(list(formula = object at garchf, data = x), garchlist)))
+ fitted <- apply(Y, 2, function(x) do.call("garchFit", c(list(formula = object at garchf, data = quote(x)), garchlist)))
H <- matrix(unlist(lapply(fitted, function(x) x at h.t)), ncol = m, nrow = n)
Hdf <- data.frame(t(H))
Ht <- lapply(Hdf, function(x) Z %*% diag(x) %*% t(Z))
Modified: pkg/man/GoGARCH-class.Rd
===================================================================
--- pkg/man/GoGARCH-class.Rd 2009-01-27 20:18:28 UTC (rev 13)
+++ pkg/man/GoGARCH-class.Rd 2009-01-29 22:56:41 UTC (rev 14)
@@ -6,6 +6,13 @@
\alias{GoGARCH-class}
\alias{show,GoGARCH-method}
+\alias{cvar,GoGARCH-method}
+\alias{ccov,GoGARCH-method}
+\alias{ccor,GoGARCH-method}
+\alias{coef,GoGARCH-method}
+\alias{converged,GoGARCH-method}
+\alias{residuals,GoGARCH-method}
+\alias{resid,GoGARCH-method}
\title{Class "GoGARCH": Estimated GO-GARCH Models}
@@ -28,6 +35,8 @@
\item{\code{models}:}{Object of class \code{"list"}: List of
univariate GARCH model fits.}
\item{\code{estby}:}{Object of class \code{"character"}: Estimation method.}
+ \item{\code{CALL}:}{Object of class \code{"call"}: Result of
+ \code{match.call} in generating function.}
\item{\code{X}:}{Object of class \code{"matrix"}: The data matrix.}
\item{\code{V}:}{Object of class \code{"matrix"}: Covariance matrix
of \code{X}.}
@@ -46,7 +55,14 @@
\section{Methods}{
\describe{
- \S4method{show}{show-method for objects of class \code{GoGARCH}.}
+ \item{cvar}{Returns the conditional variances.}
+ \item{ccov}{Returns the conditional co-variances.}
+ \item{ccor}{Returns the conditional correlations.}
+ \item{coef}{Returns the coeffiecients of the component GARCH models.}
+ \item{converged}{Returns the convergence codes of the component
+ GARCH models.}
+ \item{residuals}{Returns the residuals of the component GARCH models.}
+ \item{show}{show-method for objects of class \code{GoGARCH}.}
}
}
Modified: pkg/man/Goestml-class.Rd
===================================================================
--- pkg/man/Goestml-class.Rd 2009-01-27 20:18:28 UTC (rev 13)
+++ pkg/man/Goestml-class.Rd 2009-01-29 22:56:41 UTC (rev 14)
@@ -5,9 +5,24 @@
\encoding{latin1}
\alias{Goestml-class}
+\alias{angles}
+\alias{cvar}
+\alias{ccov}
+\alias{ccor}
+\alias{converged}
+\alias{logLik}
+\alias{angles,Goestml-method}
+\alias{cvar,Goestml-method}
+\alias{ccor,Goestml-method}
+\alias{ccov,Goestml-method}
+\alias{coef,Goestml-method}
+\alias{converged,Goestml-method}
+\alias{logLik,Goestml-method}
+\alias{residuals,Goestml-method}
+\alias{resid,Goestml-method}
+\alias{show,Goestml-method}
-\title{Class "Goestml": GO-GARCH models estimated by
- Maximum-Likelihood}
+\title{Class "Goestml": GO-GARCH models estimated by Maximum-Likelihood}
\description{This class contains the \code{GoGARCH} class and has the
outcome of \code{optim} as an additional slot.
@@ -47,7 +62,19 @@
}
\section{Methods}{
-No methods defined with class "Goestml" in the signature.
+ \describe{
+ \item{angles}{Returns the Eulerian angles.}
+ \item{cvar}{Returns the conditional variances.}
+ \item{ccor}{Returns the conditional correlations.}
+ \item{ccov}{Returns the conditional covariances.}
+ \item{coef}{Returns the coeffiecients of the component GARCH models.}
+ \item{converged}{Returns the convergence codes of the component
+ GARCH models.}
+ \item{goest}{ML-Estimation of Go-GARCH models.}
+ \item{logLik}{Returns the value of the log-Likelihood function.}
+ \item{residuals}{Returns the residuals of the component GARCH models.}
+ \item{show}{show-method for objects of class \code{Goestml}.}
+ }
}
\author{
@@ -56,7 +83,8 @@
\seealso{
- \code{\linkS4class{GoGARCH}}, \code{\linkS4class{Goinit}}
+ \code{\linkS4class{GoGARCH}}, \code{\linkS4class{Goinit}},
+ \code{\link{goest-methods}}
}
\keyword{classes}
Modified: pkg/man/goest-methods.Rd
===================================================================
--- pkg/man/goest-methods.Rd 2009-01-27 20:18:28 UTC (rev 13)
+++ pkg/man/goest-methods.Rd 2009-01-29 22:56:41 UTC (rev 14)
@@ -18,12 +18,16 @@
}
\section{Methods}{
-\describe{
-\item{object = "Goestml", initial = "numeric", garchlist =
- "list"}{The starting values for the Euler angles are provided in
+ \describe{
+ \item{goest}{\code{signature(object = "Goestml", initial = "numeric", garchlist = "list")}}
+ }
+}
+
+\details{
+ The starting values for the Euler angles are provided in the argument
\code{initial} and the list \code{garchlist} contains the elements
- that are passed \code{garchFit}.}
-}}
+ that are passed \code{garchFit}.
+}
\author{
Bernhard Pfaff
More information about the Gogarch-commits
mailing list