[Gogarch-commits] r19 - in pkg: . R man

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Thu Feb 5 21:20:09 CET 2009


Author: bpfaff
Date: 2009-02-05 21:20:09 +0100 (Thu, 05 Feb 2009)
New Revision: 19

Added:
   pkg/R/Umatch.R
   pkg/R/cora.R
   pkg/man/Umatch.Rd
   pkg/man/cora.Rd
Modified:
   pkg/DESCRIPTION
   pkg/NAMESPACE
   pkg/R/Goestml-goest.R
   pkg/R/Goestnls-goest.R
   pkg/R/gogarch.R
   pkg/R/gonls.R
   pkg/man/goest-methods.Rd
Log:
Functions added for methods of moments estimator.


Modified: pkg/DESCRIPTION
===================================================================
--- pkg/DESCRIPTION	2009-02-04 18:58:22 UTC (rev 18)
+++ pkg/DESCRIPTION	2009-02-05 20:20:09 UTC (rev 19)
@@ -1,8 +1,8 @@
 Package: gogarch
-Version: 0.4-2
+Version: 0.4-5
 Type: Package
 Title: Generalized Orthogonal GARCH (GO-GARCH) models
-Date: 2009-02-04
+Date: 2009-02-05
 Author: Bernhard Pfaff
 Maintainer: Bernhard Pfaff <bernhard at pfaffikus.de>
 Depends: R (>= 2.7.0), methods, stats, fGarch

Modified: pkg/NAMESPACE
===================================================================
--- pkg/NAMESPACE	2009-02-04 18:58:22 UTC (rev 18)
+++ pkg/NAMESPACE	2009-02-05 20:20:09 UTC (rev 19)
@@ -11,7 +11,7 @@
 exportMethods(angles, cvar, ccor, ccov, coef, converged, formula, goest, logLik, M, predict, print, show, summary, t, residuals, update)
 
 ## Functions
-export(gogarch, goinit, gollh, gonls, gotheta, Rd2, UprodR, unvech, validOrthomObject, validGoinitObject)
+export(cora, gogarch, goinit, gollh, gonls, gotheta, Rd2, Umatch, UprodR, unvech, validOrthomObject, validGoinitObject)
 
 
 

Modified: pkg/R/Goestml-goest.R
===================================================================
--- pkg/R/Goestml-goest.R	2009-02-04 18:58:22 UTC (rev 18)
+++ pkg/R/Goestml-goest.R	2009-02-05 20:20:09 UTC (rev 19)
@@ -1,4 +1,14 @@
 setMethod(f = "goest", signature(object = "Goestml"), definition = function(object, initial, garchlist, ...){
+  d <- ncol(object at X)
+  if(is.null(initial)){
+    l <- d * (d - 1)/2
+    initial <- seq(3.0, 0.1, length.out = l)
+  } else {
+    l <- length(initial)
+    if (l != d * (d - 1)/2) {
+      stop(paste("\nLength of initial vector does not match implied dimension of orthogonal matrix.\n", "It should have length: ", d * (d - 1)/2, sep = ""))
+    }
+  }
   llobj <- nlminb(start = initial, objective = gollh, object = object, garchlist = garchlist, lower = 1.5e-8, upper = pi/2, ...)
   gotheta <- gotheta(llobj$par, object, garchlist)
   result <- new("Goestml", opt = llobj, estby = "maximum likelihood", gotheta)

Modified: pkg/R/Goestnls-goest.R
===================================================================
--- pkg/R/Goestnls-goest.R	2009-02-04 18:58:22 UTC (rev 18)
+++ pkg/R/Goestnls-goest.R	2009-02-05 20:20:09 UTC (rev 19)
@@ -1,11 +1,21 @@
 setMethod(f = "goest", signature(object = "Goestnls"), definition = function(object, initial, garchlist, ...){
+  d <- ncol(object at X)
+  if(is.null(initial)){
+    l <- d * (d + 1)/2
+    initial <- rep(0.1, l)
+  } else {
+    l <- length(initial)
+    if (l != d * (d + 1)/2) {
+      stop(paste("\nLength of initial vector does not match length of vech(B).\n", "It should have length: ", d * (d + 1)/2, sep = ""))
+    }
+  }
   X <- object at X
   m <- ncol(X)
   n <- nrow(X)
   Dsqr <- object at Dsqr
   Dsqri <- diag(1 / diag(Dsqr))
   P <- object at P
-  S <- X %*% P %*% Dsqri
+  S <- X %*% P %*% Dsqri 
   SSI <- list()
   length(SSI) <- n
   for(i in 1:n){

Added: pkg/R/Umatch.R
===================================================================
--- pkg/R/Umatch.R	                        (rev 0)
+++ pkg/R/Umatch.R	2009-02-05 20:20:09 UTC (rev 19)
@@ -0,0 +1,17 @@
+Umatch <- function(from, to){
+  cols <- ncol(from)
+  mat <- matrix(0, nrow = cols, ncol = cols) 
+  for(i in 1:cols){
+    inner <- colSums(to * as.vector(from[, i]))
+    maxcol <- which.max(inner)
+    mat[, i] <- to[, maxcol]
+    to <- as.matrix(to[, -maxcol])
+  }
+  signs <- matrix(sign(diag(mat)), nrow = cols, ncol = cols, byrow = TRUE)
+  mat <- mat * signs
+  if(det(mat) < 1.0){
+    colminus <- which.min(abs(colSums(mat * from)))
+    mat[, colminus] <- -1.0 * mat[, colminus]
+  }
+  return(mat)
+}

Added: pkg/R/cora.R
===================================================================
--- pkg/R/cora.R	                        (rev 0)
+++ pkg/R/cora.R	2009-02-05 20:20:09 UTC (rev 19)
@@ -0,0 +1,32 @@
+cora <- function(SSI, lag = 1){
+  lags <- abs(as.integer(lags))
+  dims <- dim(SSI)
+  Gamma <- matrix(0, nrow = dims[1], ncol = dims[2])
+  SSIp <- array(dim = dims)
+  for(i in 1:dims[3]){
+    SSIp[, ,i] <- SSI[, ,i] %*% SSI[, ,i]
+    Gamma <- Gamma + SSIp[, , i]
+  }
+  Gamma <- Gamma / dims[3]
+  Gsvd <- svd(Gamma)
+  Gsqrtinv <- Gsvd$u %*% diag(1/sqrt(Gsvd$d)) %*% t(Gsvd$u)
+  idx <- 1:dims[3]
+  if(identical(lags, as.integer(0))){
+    idx1 <- idx
+    idx2 <- idx
+  } else {
+    idx1 <- idx[-c(1:lags)]
+    idx2 <- rev(rev(idx)[-c(1:lags)])
+  }
+  nl <- length(idx1)
+  Gamma <- matrix(0, nrow = dims[1], ncol = dims[2])
+  SSIc <- array(dim = c(dims[1], dims[2], nl))
+  for(i in 1:nl){
+    SSIc[, , i] <- SSI[, , idx1[i]] %*% SSI[, , idx2[i]]
+    Gamma <- Gamma + SSIc[, , i]
+  }
+  Gamma <- Gamma / nl
+  cora <- Gsqrtinv %*% Gamma %*% Gsqrtinv
+  cora <- (cora + t(cora)) / 2
+  return(cora)
+}

Modified: pkg/R/gogarch.R
===================================================================
--- pkg/R/gogarch.R	2009-02-04 18:58:22 UTC (rev 18)
+++ pkg/R/gogarch.R	2009-02-05 20:20:09 UTC (rev 19)
@@ -1,8 +1,5 @@
 gogarch <- function(data, formula, scale = FALSE, method = c("ml", "nls"), 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)
-  if(missing(garchlist)){
-    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)
-  }
   Call <- match.call()
   d <- ncol(data)
   gini <- goinit(X = data, garchf = formula, scale = scale)

Modified: pkg/R/gonls.R
===================================================================
--- pkg/R/gonls.R	2009-02-04 18:58:22 UTC (rev 18)
+++ pkg/R/gonls.R	2009-02-05 20:20:09 UTC (rev 19)
@@ -1,7 +1,7 @@
 gonls <-
 function(params, SSI){
   B <- unvech(params)
-  n <- length(SSI[[1]]) - 1
+  n <- length(SSI[[1]])
   fl <- list()
   length(fl) <- n
   for(i in 1:n){

Added: pkg/man/Umatch.Rd
===================================================================
--- pkg/man/Umatch.Rd	                        (rev 0)
+++ pkg/man/Umatch.Rd	2009-02-05 20:20:09 UTC (rev 19)
@@ -0,0 +1,47 @@
+\name{Umatch}
+
+\encoding{latin1}
+
+\alias{Umatch}
+
+\title{
+  Matching of Orthogonal Matrices for Cayley transforms
+}
+
+\description{
+  This function matches an orthogonal matrix to the importance of the
+  columns of the matrix to which it should be matched.
+}
+
+\usage{
+Umatch(from, to)
+}
+
+\arguments{
+  \item{from}{Matrix: orthogonal}
+  \item{to}{Matrix: orthogonal}
+}
+
+\value{
+  \item{mat}{Matched matrix.}
+}
+
+\references{
+  Boswijk, H. Peter and van der Weide, Roy (2009), Method of Moments
+  Estimation of GO-GARCH Models, \emph{Working Paper}, University of
+  Amsterdam, Tinbergen Institute and World Bank.
+
+  Liebeck, H. and Osborne, A. (1991), The Generation of All Rational
+  Orthogonal Matrices, \emph{The American Mathematical Monthly},
+  \bold{98 (2)} (Feb. 1991), 131 -- 133.
+}
+
+\author{
+  Bernhard Pfaff
+}
+
+\seealso{
+  \code{\link{gogarch}}
+}
+
+\keyword{models}

Added: pkg/man/cora.Rd
===================================================================
--- pkg/man/cora.Rd	                        (rev 0)
+++ pkg/man/cora.Rd	2009-02-05 20:20:09 UTC (rev 19)
@@ -0,0 +1,61 @@
+\name{cora}
+
+\encoding{latin1}
+
+\alias{cora}
+
+\title{
+  Autocorrelations of a Matrix Process
+}
+
+\description{
+  This function computes the autocorrelation matrix for a given lag. For
+  instance, it is used for estimating GO-GARCH models whence the method
+  of moments is utilized.   
+}
+
+\usage{
+cora(SSI, lag = 1)
+}
+\arguments{
+  \item{SSI}{Array with dimension \code{dim = c(m, m, n)}}
+  \item{lag}{Integer, the lag for which the autocorrelation is computed.}
+}
+
+\details{
+  This function computes the autocorrelation matrix according to:
+
+  \deqn{
+    \hat{\Gamma}_k (s) = \frac{1}{n} \sum_{t = k + 1}^n S_t S_{t-k}
+  }
+  \deqn{
+    \hat{\Phi}_k (s) = \hat{\Gamma}_0 (s)^{-1/2} \hat{\Gamma}_k (s)
+    \hat{\Gamma}_0 (s)^{-1/2}
+  }
+  
+  It is computationally assured that \eqn{\hat{\Phi}_k (s)} is symmetric
+  by setting it equal to: \eqn{\hat{\Phi}_k (s) = \frac{1}{2}(\hat{\Phi}_k (s) +
+  \hat{\Phi}_k (s)')}. The standardization matrix \eqn{\hat{\Gamma}_0
+  (s)^{-1/2}} is derived from the singular value decomposition of the
+  co-variance matrix at lag zero.   
+}
+
+\value{
+  \item{cora}{Matrix with dimension \code{dim = c(m, m)}.}
+}
+
+\references{
+    Boswijk, H. Peter and van der Weide, Roy (2009), Method of Moments
+    Estimation of GO-GARCH Models, \emph{Working Paper}, University of
+    Amsterdam, Tinbergen Institute and World Bank.
+}
+
+\author{
+  Bernhard Pfaff
+}
+
+\seealso{
+  \code{\link{gogarch}}
+}
+
+\keyword{models}

Modified: pkg/man/goest-methods.Rd
===================================================================
--- pkg/man/goest-methods.Rd	2009-02-04 18:58:22 UTC (rev 18)
+++ pkg/man/goest-methods.Rd	2009-02-05 20:20:09 UTC (rev 19)
@@ -20,6 +20,7 @@
 \section{Methods}{
   \describe{
     \item{goest}{\code{signature(object = "Goestml")}}
+    \item{goest}{\code{signature(object = "Goestnls")}}
   }
 }
 



More information about the Gogarch-commits mailing list