[Gogarch-commits] r22 - in pkg: . R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Feb 10 20:48:53 CET 2009
Author: bpfaff
Date: 2009-02-10 20:48:53 +0100 (Tue, 10 Feb 2009)
New Revision: 22
Added:
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
Removed:
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-formula.R
pkg/R/GoGARCH-predict.R
pkg/R/GoGARCH-residuals.R
pkg/R/GoGARCH-show.R
pkg/R/GoGARCH-summary.R
pkg/R/Goestica-ccor.R
pkg/R/Goestica-ccov.R
pkg/R/Goestica-coef.R
pkg/R/Goestica-converged.R
pkg/R/Goestica-cvar.R
pkg/R/Goestica-formula.R
pkg/R/Goestica-goest.R
pkg/R/Goestica-predict.R
pkg/R/Goestica-residuals.R
pkg/R/Goestica-show.R
pkg/R/Goestica-summary.R
pkg/R/Goestica-update.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-formula.R
pkg/R/Goestml-goest.R
pkg/R/Goestml-logLik.R
pkg/R/Goestml-predict.R
pkg/R/Goestml-residuals.R
pkg/R/Goestml-show.R
pkg/R/Goestml-summary.R
pkg/R/Goestml-update.R
pkg/R/Goestmm-ccor.R
pkg/R/Goestmm-ccov.R
pkg/R/Goestmm-coef.R
pkg/R/Goestmm-converged.R
pkg/R/Goestmm-cvar.R
pkg/R/Goestmm-formula.R
pkg/R/Goestmm-goest.R
pkg/R/Goestmm-predict.R
pkg/R/Goestmm-residuals.R
pkg/R/Goestmm-show.R
pkg/R/Goestmm-summary.R
pkg/R/Goestmm-update.R
pkg/R/Goestnls-ccor.R
pkg/R/Goestnls-ccov.R
pkg/R/Goestnls-coef.R
pkg/R/Goestnls-converged.R
pkg/R/Goestnls-cvar.R
pkg/R/Goestnls-formula.R
pkg/R/Goestnls-goest.R
pkg/R/Goestnls-predict.R
pkg/R/Goestnls-residuals.R
pkg/R/Goestnls-show.R
pkg/R/Goestnls-summary.R
pkg/R/Goestnls-update.R
pkg/R/Gogarch-update.R
pkg/R/Goinit-class.R
pkg/R/Goinit-show.R
pkg/R/Gopredict-ccor.R
pkg/R/Gopredict-ccov.R
pkg/R/Gopredict-cvar.R
pkg/R/Gopredict-show.R
pkg/R/Gosum-show.R
pkg/R/Orthom-M.R
pkg/R/Orthom-class.R
pkg/R/Orthom-print.R
pkg/R/Orthom-show.R
pkg/R/Orthom-t.R
pkg/R/Rd2.R
pkg/R/Umatch.R
pkg/R/UprodR.R
pkg/R/cora.R
pkg/R/gogarch.R
pkg/R/goinit.R
pkg/R/gollh.R
pkg/R/gonls.R
pkg/R/gotheta.R
pkg/R/unvech.R
Modified:
pkg/DESCRIPTION
Log:
Reorganization of R files.
Modified: pkg/DESCRIPTION
===================================================================
--- pkg/DESCRIPTION 2009-02-10 18:42:18 UTC (rev 21)
+++ pkg/DESCRIPTION 2009-02-10 19:48:53 UTC (rev 22)
@@ -1,5 +1,5 @@
Package: gogarch
-Version: 0.5-9
+Version: 0.6-0
Type: Package
Title: Generalized Orthogonal GARCH (GO-GARCH) models
Date: 2009-02-10
Added: pkg/R/Functions.R
===================================================================
--- pkg/R/Functions.R (rev 0)
+++ pkg/R/Functions.R 2009-02-10 19:48:53 UTC (rev 22)
@@ -0,0 +1,202 @@
+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)
+ gomod <- new("GoGARCH", gini)
+ if(method == "ml"){
+ goestml <- new("Goestml", gomod)
+ gogarch <- goest(object = goestml, initial = initial, garchlist = garchlist, ...)
+ }
+ if(method == "nls"){
+ goestnls <- new("Goestnls", gomod)
+ gogarch <- goest(object = goestnls, initial = initial, garchlist = garchlist, ...)
+ }
+ if(method == "mm"){
+ goestmm <- new("Goestmm", gomod)
+ gogarch <- goest(object = goestmm, lag.max = lag.max, garchlist = garchlist, ...)
+ }
+ if(method == "ica"){
+ goestica <- new("Goestica", gomod)
+ gogarch <- goest(object = goestica, initial = initial, garchlist = garchlist, ...)
+ }
+ gogarch at CALL <- Call
+ gogarch at name <- deparse(substitute(data))
+ return(gogarch)
+}
+
+Umatch <- function(from, to){
+ cols <- ncol(from)
+ mat <- matrix(0, nrow = cols, ncol = cols)
+ for(i in 1:cols){
+ inner <- abs(colSums(from[, i] * to))
+ maxcol <- which.max(inner)
+ mat[, i] <- to[, maxcol]
+ to <- as.matrix(to[, -c(maxcol)])
+ }
+ signs <- matrix(sign(diag(mat)), nrow = cols, ncol = cols, byrow = TRUE)
+ mat <- signs * mat
+ if(det(mat) < 0.0){
+ colminus <- which.min(abs(colSums(from * mat)))
+ mat[, colminus] <- -1.0 * mat[, colminus]
+ }
+ return(mat)
+}
+
+UprodR <-
+function(theta){
+ theta <- as.vector(theta)
+ l <- length(theta)
+ d <- as.integer(0.5 + sqrt(0.5^2 + 2*l))
+ if(l != d * (d - 1) / 2){
+ stop("\nLength of theta does not match implied dimension of U.\n")
+ }
+ Id <- diag(d)
+ U <- Id
+ rc <- combn(x = d, m = 2)
+ idx <- seq(along.with = theta)
+ Rs <- lapply(idx, function(x){
+ tmp <- Id
+ tmp[rc[, x], rc[, x]] <- Rd2(theta = theta[x])
+ return(tmp)
+ })
+ for(i in 1:l) U <- U %*% Rs[[i]]
+ result <- new("Orthom", M = U)
+ return(result)
+}
+
+Rd2 <-
+function(theta){
+ theta <- as.vector(theta)
+ if(length(theta) > 1){
+ stop("\nLength of argument 'theta' should be one.\n")
+ }
+ if((theta <= 0) | (theta > pi/2)){
+ stop("\nTheta should be in the interval [0, pi/2).\n")
+ }
+ R <- matrix(c(cos(theta), sin(theta), -sin(theta), cos(theta)), ncol = 2, nrow = 2)
+ return(R)
+}
+
+cora <- function(SSI, lag = 1, standardize = TRUE){
+ lag <- abs(as.integer(lag))
+ 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(lag, as.integer(0))){
+ idx1 <- idx
+ idx2 <- idx
+ } else {
+ idx1 <- idx[-c(1:lag)]
+ idx2 <- rev(rev(idx)[-c(1:lag)])
+ }
+ 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
+ if(standardize){
+ cora <- Gsqrtinv %*% Gamma %*% Gsqrtinv
+ } else {
+ cora <- Gamma
+ }
+ cora <- (cora + t(cora)) / 2
+ return(cora)
+}
+
+goinit <- function(X, garchf = ~ garch(1, 1), scale = FALSE){
+ dname <- deparse(substitute(X))
+ X <- as.matrix(X)
+ if(ncol(X) > nrow(X)){
+ stop("\nMatrix has more columns than rows.\n")
+ }
+ garchf <- as.formula(garchf)
+ if(scale){
+ X <- scale(X)
+ }
+ V <- t(X) %*% X / nrow(X)
+ svd <- svd(V)
+ P <- svd$u
+ Dsqr <- diag(sqrt(svd$d))
+ result <- new("Goinit", X = X, V = V, P = P, Dsqr = Dsqr, garchf = garchf, name = dname)
+ return(result)
+}
+
+gollh <-
+function(params, object, garchlist){
+ gotheta <- gotheta(theta = params, object = object, garchlist = garchlist)
+ m <- ncol(object at X)
+ n <- nrow(object at X)
+ H <- matrix(unlist(lapply(gotheta at models, function(x) x at h.t)), ncol = m, nrow = n)
+ Hinv <- 1.0 / H
+ arg1 <- n * m * log(2 * pi)
+ arg2 <- log(det(gotheta at Z %*% t(gotheta at Z))) * n
+ arg3 <- sum(log(apply(H, 1, prod)))
+ arg4 <- sum(rowSums(gotheta at Y * Hinv * gotheta at Y))
+ ll <- -0.5 * (arg1 + arg2 + arg3 + arg4)
+ negll <- -1.0 * ll
+ return(negll)
+}
+
+gonls <-
+function(params, SSI){
+ B <- unvech(params)
+ n <- length(SSI[[1]])
+ fl <- list()
+ length(fl) <- n
+ for(i in 1:n){
+ M <- (SSI[[1]][[i]] - B %*% SSI[[2]][[i]] %*% B)
+ fl[[i]] <- M %*% M
+ }
+ f <- sum(unlist(lapply(fl, function(x) sum(diag(x))))) / n
+ return(f)
+}
+
+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")))) {
+ stop("\nObject is neither of class 'Goinit', 'GoGARCH' or 'Goestml'.\n")
+ }
+ l <- length(theta)
+ d <- as.integer(0.5 + sqrt(0.5^2 + 2 * l))
+ if (l != d * (d - 1)/2) {
+ stop(paste("\nLength of theta does not match implied dimension of orthogonal matrix.\n", "It should have length: ", d, sep = ""))
+ }
+ m <- ncol(object at X)
+ n <- nrow(object at X)
+ U <- UprodR(theta)@M
+ 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 = 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))
+ names(Ht) <- rownames(object at X)
+ 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 <-
+function(v){
+ v <- as.vector(v)
+ l <- length(v)
+ n <- -(1 - sqrt(1 + 8 * l)) / 2
+ if(n %% 1 != 0.0){
+ stop("\nCannot produce symmetric matrix, check length of v.\n")
+ }
+ X <- matrix(NA, ncol = n, nrow = n)
+ X[lower.tri(X, diag = TRUE)] <- v
+ X[upper.tri(X)] <- X[lower.tri(X)]
+ return(X)
+}
Deleted: pkg/R/GoGARCH-ccor.R
===================================================================
--- pkg/R/GoGARCH-ccor.R 2009-02-10 18:42:18 UTC (rev 21)
+++ pkg/R/GoGARCH-ccor.R 2009-02-10 19:48:53 UTC (rev 22)
@@ -1,14 +0,0 @@
-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)
-})
Deleted: pkg/R/GoGARCH-ccov.R
===================================================================
--- pkg/R/GoGARCH-ccov.R 2009-02-10 18:42:18 UTC (rev 21)
+++ pkg/R/GoGARCH-ccov.R 2009-02-10 19:48:53 UTC (rev 22)
@@ -1,14 +0,0 @@
-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)
-})
Deleted: pkg/R/GoGARCH-coef.R
===================================================================
--- pkg/R/GoGARCH-coef.R 2009-02-10 18:42:18 UTC (rev 21)
+++ pkg/R/GoGARCH-coef.R 2009-02-10 19:48:53 UTC (rev 22)
@@ -1,7 +0,0 @@
-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)
- rownames(garchc) <- paste("y", 1:nrow(garchc), sep = "")
- return(garchc)
-})
-
Deleted: pkg/R/GoGARCH-converged.R
===================================================================
--- pkg/R/GoGARCH-converged.R 2009-02-10 18:42:18 UTC (rev 21)
+++ pkg/R/GoGARCH-converged.R 2009-02-10 19:48:53 UTC (rev 22)
@@ -1,6 +0,0 @@
-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)
-})
Deleted: pkg/R/GoGARCH-cvar.R
===================================================================
--- pkg/R/GoGARCH-cvar.R 2009-02-10 18:42:18 UTC (rev 21)
+++ pkg/R/GoGARCH-cvar.R 2009-02-10 19:48:53 UTC (rev 22)
@@ -1,8 +0,0 @@
-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)
-})
Deleted: pkg/R/GoGARCH-formula.R
===================================================================
--- pkg/R/GoGARCH-formula.R 2009-02-10 18:42:18 UTC (rev 21)
+++ pkg/R/GoGARCH-formula.R 2009-02-10 19:48:53 UTC (rev 22)
@@ -1,4 +0,0 @@
-setMethod("formula", signature(x = "GoGARCH"), function(x, ...)
- x at garchf
-)
-
Deleted: pkg/R/GoGARCH-predict.R
===================================================================
--- pkg/R/GoGARCH-predict.R 2009-02-10 18:42:18 UTC (rev 21)
+++ pkg/R/GoGARCH-predict.R 2009-02-10 19:48:53 UTC (rev 22)
@@ -1,18 +0,0 @@
-setMethod(f = "predict", signature(object = "GoGARCH"), definition = function(object, n.ahead = 10, ...){
- n.ahead <- abs(as.integer(n.ahead))
- m <- ncol(object at X)
- n <- nrow(object at X)
- Z <- object at Z
- delta <- object at models[[1]]@fit$params$params["delta"]
- predictions <- lapply(object at models, predict, n.ahead = n.ahead)
- mean.pred.y <- matrix(unlist(lapply(predictions, function(x) x[, 1])), ncol = m)
- mean.pred.x <- mean.pred.y %*% Z
- rownames(mean.pred.x) <- seq(from = 1, to = n.ahead) + n
- colnames(mean.pred.x) <- paste(colnames(object at X), ".f", sep = "")
- h.pred.y <- matrix(unlist(lapply(predictions, function(x) x[, 3]^delta)), ncol = m)
- H.pred.y <- data.frame(t(h.pred.y))
- H.pred.x <- lapply(H.pred.y, function(x) Z %*% diag(x) %*% t(Z))
- names(H.pred.x) <- rownames(mean.pred.x)
- fcst <- new("Gopredict", Hf = H.pred.x, Xf = mean.pred.x, CGARCHF = predictions)
- return(fcst)
-})
Deleted: pkg/R/GoGARCH-residuals.R
===================================================================
--- pkg/R/GoGARCH-residuals.R 2009-02-10 18:42:18 UTC (rev 21)
+++ pkg/R/GoGARCH-residuals.R 2009-02-10 19:48:53 UTC (rev 22)
@@ -1,12 +0,0 @@
-setMethod(f = "residuals", signature(object = "GoGARCH"), definition = function(object, standardize = FALSE){
- 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
- rownames(resm) <- rownames(object at X)
- return(resm)
-})
-
-
Deleted: pkg/R/GoGARCH-show.R
===================================================================
--- pkg/R/GoGARCH-show.R 2009-02-10 18:42:18 UTC (rev 21)
+++ pkg/R/GoGARCH-show.R 2009-02-10 19:48:53 UTC (rev 22)
@@ -1,29 +0,0 @@
-setMethod(f = "show", signature(object = "GoGARCH"), definition = function(object){
- title <- "*** GO-GARCH ***"
- stars <- paste(rep("*", nchar(title)), collapse = "")
- cat("\n")
- cat(paste(stars, "\n"))
- cat(paste(title, "\n"))
- cat(paste(stars, "\n"))
- cat("\n")
- cat(paste("Components estimated by:", object at estby))
- cat("\n")
- cat(paste("Dimension of data matrix:", paste("(", nrow(object at X), " x ", ncol(object at X), ").", sep = "")))
- cat("\n")
- cat(paste("Formula for component GARCH models:", paste(as.character(object at garchf), collapse = " "), "\n"))
- cat("\n")
- if(length(object at U) != 0){
- cat("Orthogonal Matrix U:\n")
- print(object at U)
- cat("\n")
- cat("Linar Map Z:\n")
- print(object at Z)
- cat("\n")
- }
- cat("Estimated GARCH coefficients:\n")
- print(coef(object))
- cat("\n")
- cat("Convergence codes of component GARCH models:\n")
- print(converged(object))
- invisible(object)
-})
Deleted: pkg/R/GoGARCH-summary.R
===================================================================
--- pkg/R/GoGARCH-summary.R 2009-02-10 18:42:18 UTC (rev 21)
+++ pkg/R/GoGARCH-summary.R 2009-02-10 19:48:53 UTC (rev 22)
@@ -1,12 +0,0 @@
-setMethod(f = "summary", signature(object = "GoGARCH"), definition = function(object){
- name <- object at name
- method <- object at estby
- model <- object at garchf
- garchc <- lapply(object at models, function(x) x at fit$matcoef)
- ynames <- paste("y", 1:ncol(object at X), sep = "")
- names(garchc) <- paste("Component GARCH model of", ynames)
- garchc <- garchc
- Zinv <- solve(object at Z)
- gosum <- new("Gosum", name = name, method = method, model = model, garchc = garchc, Zinv = Zinv)
- return(gosum)
-})
Deleted: pkg/R/Goestica-ccor.R
===================================================================
--- pkg/R/Goestica-ccor.R 2009-02-10 18:42:18 UTC (rev 21)
+++ pkg/R/Goestica-ccor.R 2009-02-10 19:48:53 UTC (rev 22)
@@ -1,3 +0,0 @@
-setMethod(f = "ccor", signature(object = "Goestica"), definition = function(object){
- ccor(as(object, "GoGARCH"))
-})
Deleted: pkg/R/Goestica-ccov.R
===================================================================
--- pkg/R/Goestica-ccov.R 2009-02-10 18:42:18 UTC (rev 21)
+++ pkg/R/Goestica-ccov.R 2009-02-10 19:48:53 UTC (rev 22)
@@ -1,3 +0,0 @@
-setMethod(f = "ccov", signature(object = "Goestica"), definition = function(object){
- ccov(as(object, "GoGARCH"))
-})
Deleted: pkg/R/Goestica-coef.R
===================================================================
--- pkg/R/Goestica-coef.R 2009-02-10 18:42:18 UTC (rev 21)
+++ pkg/R/Goestica-coef.R 2009-02-10 19:48:53 UTC (rev 22)
@@ -1,4 +0,0 @@
-setMethod(f = "coef", signature(object = "Goestica"), definition = function(object){
- callNextMethod()
-})
-
Deleted: pkg/R/Goestica-converged.R
===================================================================
--- pkg/R/Goestica-converged.R 2009-02-10 18:42:18 UTC (rev 21)
+++ pkg/R/Goestica-converged.R 2009-02-10 19:48:53 UTC (rev 22)
@@ -1,3 +0,0 @@
-setMethod(f = "converged", signature(object = "Goestica"), definition = function(object){
- converged(as(object, "GoGARCH"))
-})
Deleted: pkg/R/Goestica-cvar.R
===================================================================
--- pkg/R/Goestica-cvar.R 2009-02-10 18:42:18 UTC (rev 21)
+++ pkg/R/Goestica-cvar.R 2009-02-10 19:48:53 UTC (rev 22)
@@ -1,3 +0,0 @@
-setMethod(f = "cvar", signature(object = "Goestica"), definition = function(object){
- cvar(as(object, "GoGARCH"))
-})
Deleted: pkg/R/Goestica-formula.R
===================================================================
--- pkg/R/Goestica-formula.R 2009-02-10 18:42:18 UTC (rev 21)
+++ pkg/R/Goestica-formula.R 2009-02-10 19:48:53 UTC (rev 22)
@@ -1,3 +0,0 @@
-setMethod("formula", signature(x = "Goestica"), function(x, ...)
- x at garchf
-)
Deleted: pkg/R/Goestica-goest.R
===================================================================
--- pkg/R/Goestica-goest.R 2009-02-10 18:42:18 UTC (rev 21)
+++ pkg/R/Goestica-goest.R 2009-02-10 19:48:53 UTC (rev 22)
@@ -1,20 +0,0 @@
-setMethod(f = "goest", signature(object = "Goestica"), definition = function(object, initial, garchlist, ...){
- X <- object at X
- m <- ncol(X)
- n <- nrow(X)
- P <- object at P
- Id <- diag(m)
- Dsqr <- object at Dsqr
- ica <- fastICA(X, n.comp = m, ...)
- W <- ica$W
- Z <- P %*% Dsqr %*% t(P) %*% W
- Zinv <- solve(Z)
- Y <- X %*% Zinv
- 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))
- names(Ht) <- rownames(object at X)
- 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)
-})
Deleted: pkg/R/Goestica-predict.R
===================================================================
--- pkg/R/Goestica-predict.R 2009-02-10 18:42:18 UTC (rev 21)
+++ pkg/R/Goestica-predict.R 2009-02-10 19:48:53 UTC (rev 22)
@@ -1,3 +0,0 @@
-setMethod(f = "predict", signature(object = "Goestica"), definition = function(object, n.ahead = 10, ...){
- callNextMethod()
-})
Deleted: pkg/R/Goestica-residuals.R
===================================================================
--- pkg/R/Goestica-residuals.R 2009-02-10 18:42:18 UTC (rev 21)
+++ pkg/R/Goestica-residuals.R 2009-02-10 19:48:53 UTC (rev 22)
@@ -1,5 +0,0 @@
-setMethod(f = "residuals", signature(object = "Goestica"), definition = function(object, standardize = FALSE){
- callNextMethod(object = object, standardize = standardize)
-})
-
-
Deleted: pkg/R/Goestica-show.R
===================================================================
--- pkg/R/Goestica-show.R 2009-02-10 18:42:18 UTC (rev 21)
+++ pkg/R/Goestica-show.R 2009-02-10 19:48:53 UTC (rev 22)
@@ -1,3 +0,0 @@
-setMethod(f = "show", signature(object = "Goestica"), definition = function(object){
- callNextMethod()
-})
Deleted: pkg/R/Goestica-summary.R
===================================================================
--- pkg/R/Goestica-summary.R 2009-02-10 18:42:18 UTC (rev 21)
+++ pkg/R/Goestica-summary.R 2009-02-10 19:48:53 UTC (rev 22)
@@ -1,3 +0,0 @@
-setMethod(f = "summary", signature(object = "Goestica"), definition = function(object){
- callNextMethod()
-})
Deleted: pkg/R/Goestica-update.R
===================================================================
--- pkg/R/Goestica-update.R 2009-02-10 18:42:18 UTC (rev 21)
+++ pkg/R/Goestica-update.R 2009-02-10 19:48:53 UTC (rev 22)
@@ -1,17 +0,0 @@
-setMethod("update", signature(object = "Goestica"), function(object, formula., ..., evaluate = TRUE){
- call <- object at CALL
- extras <- match.call(expand.dots = FALSE)$...
- if (!missing(formula.))
- call$formula <- update.formula(formula(object), formula.)
- if (length(extras) > 0) {
- existing <- !is.na(match(names(extras), names(call)))
- for (a in names(extras)[existing]) call[[a]] <- extras[[a]]
- if (any(!existing)) {
- call <- c(as.list(call), extras[!existing])
- call <- as.call(call)
- }
- }
- if (evaluate)
- eval(call, parent.frame())
- else call
-})
Deleted: pkg/R/Goestml-angles.R
===================================================================
--- pkg/R/Goestml-angles.R 2009-02-10 18:42:18 UTC (rev 21)
+++ pkg/R/Goestml-angles.R 2009-02-10 19:48:53 UTC (rev 22)
@@ -1,5 +0,0 @@
-setMethod(f = "angles", signature = "Goestml", definition = function(object){
- angles <- object at opt$par
- names(angles) <- paste("angle", seq(along.with = angles), sep = "")
- return(angles)
-})
Deleted: pkg/R/Goestml-ccor.R
===================================================================
--- pkg/R/Goestml-ccor.R 2009-02-10 18:42:18 UTC (rev 21)
+++ pkg/R/Goestml-ccor.R 2009-02-10 19:48:53 UTC (rev 22)
@@ -1,3 +0,0 @@
-setMethod(f = "ccor", signature(object = "Goestml"), definition = function(object){
- ccor(as(object, "GoGARCH"))
-})
Deleted: pkg/R/Goestml-ccov.R
===================================================================
--- pkg/R/Goestml-ccov.R 2009-02-10 18:42:18 UTC (rev 21)
+++ pkg/R/Goestml-ccov.R 2009-02-10 19:48:53 UTC (rev 22)
@@ -1,3 +0,0 @@
-setMethod(f = "ccov", signature(object = "Goestml"), definition = function(object){
- ccov(as(object, "GoGARCH"))
-})
Deleted: pkg/R/Goestml-coef.R
===================================================================
--- pkg/R/Goestml-coef.R 2009-02-10 18:42:18 UTC (rev 21)
+++ pkg/R/Goestml-coef.R 2009-02-10 19:48:53 UTC (rev 22)
@@ -1,4 +0,0 @@
-setMethod(f = "coef", signature(object = "Goestml"), definition = function(object){
- callNextMethod()
-})
-
Deleted: pkg/R/Goestml-converged.R
===================================================================
--- pkg/R/Goestml-converged.R 2009-02-10 18:42:18 UTC (rev 21)
+++ pkg/R/Goestml-converged.R 2009-02-10 19:48:53 UTC (rev 22)
@@ -1,3 +0,0 @@
-setMethod(f = "converged", signature(object = "Goestml"), definition = function(object){
- converged(as(object, "GoGARCH"))
-})
Deleted: pkg/R/Goestml-cvar.R
===================================================================
--- pkg/R/Goestml-cvar.R 2009-02-10 18:42:18 UTC (rev 21)
+++ pkg/R/Goestml-cvar.R 2009-02-10 19:48:53 UTC (rev 22)
@@ -1,3 +0,0 @@
-setMethod(f = "cvar", signature(object = "Goestml"), definition = function(object){
- cvar(as(object, "GoGARCH"))
-})
Deleted: pkg/R/Goestml-formula.R
===================================================================
--- pkg/R/Goestml-formula.R 2009-02-10 18:42:18 UTC (rev 21)
+++ pkg/R/Goestml-formula.R 2009-02-10 19:48:53 UTC (rev 22)
@@ -1,3 +0,0 @@
-setMethod("formula", signature(x = "Goestml"), function(x, ...)
- x at garchf
-)
Deleted: pkg/R/Goestml-goest.R
===================================================================
--- pkg/R/Goestml-goest.R 2009-02-10 18:42:18 UTC (rev 21)
+++ pkg/R/Goestml-goest.R 2009-02-10 19:48:53 UTC (rev 22)
@@ -1,16 +0,0 @@
-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)
- return(result)
-})
Deleted: pkg/R/Goestml-logLik.R
===================================================================
--- pkg/R/Goestml-logLik.R 2009-02-10 18:42:18 UTC (rev 21)
+++ pkg/R/Goestml-logLik.R 2009-02-10 19:48:53 UTC (rev 22)
@@ -1,7 +0,0 @@
-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)
-})
Deleted: pkg/R/Goestml-predict.R
===================================================================
--- pkg/R/Goestml-predict.R 2009-02-10 18:42:18 UTC (rev 21)
+++ pkg/R/Goestml-predict.R 2009-02-10 19:48:53 UTC (rev 22)
@@ -1,3 +0,0 @@
-setMethod(f = "predict", signature(object = "Goestml"), definition = function(object, n.ahead = 10, ...){
- callNextMethod()
-})
Deleted: pkg/R/Goestml-residuals.R
===================================================================
--- pkg/R/Goestml-residuals.R 2009-02-10 18:42:18 UTC (rev 21)
+++ pkg/R/Goestml-residuals.R 2009-02-10 19:48:53 UTC (rev 22)
@@ -1,5 +0,0 @@
-setMethod(f = "residuals", signature(object = "Goestml"), definition = function(object, standardize = FALSE){
- callNextMethod(object = object, standardize = standardize)
-})
-
-
Deleted: pkg/R/Goestml-show.R
===================================================================
--- pkg/R/Goestml-show.R 2009-02-10 18:42:18 UTC (rev 21)
+++ pkg/R/Goestml-show.R 2009-02-10 19:48:53 UTC (rev 22)
@@ -1,3 +0,0 @@
-setMethod(f = "show", signature(object = "Goestml"), definition = function(object){
- callNextMethod()
-})
Deleted: pkg/R/Goestml-summary.R
===================================================================
--- pkg/R/Goestml-summary.R 2009-02-10 18:42:18 UTC (rev 21)
+++ pkg/R/Goestml-summary.R 2009-02-10 19:48:53 UTC (rev 22)
@@ -1,3 +0,0 @@
-setMethod(f = "summary", signature(object = "Goestml"), definition = function(object){
- callNextMethod()
-})
Deleted: pkg/R/Goestml-update.R
===================================================================
--- pkg/R/Goestml-update.R 2009-02-10 18:42:18 UTC (rev 21)
+++ pkg/R/Goestml-update.R 2009-02-10 19:48:53 UTC (rev 22)
@@ -1,17 +0,0 @@
-setMethod("update", signature(object = "Goestml"), function(object, formula., ..., evaluate = TRUE){
- call <- object at CALL
- extras <- match.call(expand.dots = FALSE)$...
- if (!missing(formula.))
- call$formula <- update.formula(formula(object), formula.)
- if (length(extras) > 0) {
- existing <- !is.na(match(names(extras), names(call)))
- for (a in names(extras)[existing]) call[[a]] <- extras[[a]]
- if (any(!existing)) {
- call <- c(as.list(call), extras[!existing])
- call <- as.call(call)
- }
- }
- if (evaluate)
- eval(call, parent.frame())
- else call
-})
Deleted: pkg/R/Goestmm-ccor.R
===================================================================
--- pkg/R/Goestmm-ccor.R 2009-02-10 18:42:18 UTC (rev 21)
+++ pkg/R/Goestmm-ccor.R 2009-02-10 19:48:53 UTC (rev 22)
@@ -1,3 +0,0 @@
-setMethod(f = "ccor", signature(object = "Goestmm"), definition = function(object){
- ccor(as(object, "GoGARCH"))
-})
Deleted: pkg/R/Goestmm-ccov.R
===================================================================
--- pkg/R/Goestmm-ccov.R 2009-02-10 18:42:18 UTC (rev 21)
+++ pkg/R/Goestmm-ccov.R 2009-02-10 19:48:53 UTC (rev 22)
@@ -1,3 +0,0 @@
-setMethod(f = "ccov", signature(object = "Goestmm"), definition = function(object){
- ccov(as(object, "GoGARCH"))
-})
Deleted: pkg/R/Goestmm-coef.R
===================================================================
--- pkg/R/Goestmm-coef.R 2009-02-10 18:42:18 UTC (rev 21)
+++ pkg/R/Goestmm-coef.R 2009-02-10 19:48:53 UTC (rev 22)
@@ -1,4 +0,0 @@
-setMethod(f = "coef", signature(object = "Goestmm"), definition = function(object){
- callNextMethod()
-})
-
Deleted: pkg/R/Goestmm-converged.R
===================================================================
--- pkg/R/Goestmm-converged.R 2009-02-10 18:42:18 UTC (rev 21)
+++ pkg/R/Goestmm-converged.R 2009-02-10 19:48:53 UTC (rev 22)
@@ -1,3 +0,0 @@
-setMethod(f = "converged", signature(object = "Goestmm"), definition = function(object){
- converged(as(object, "GoGARCH"))
-})
Deleted: pkg/R/Goestmm-cvar.R
===================================================================
--- pkg/R/Goestmm-cvar.R 2009-02-10 18:42:18 UTC (rev 21)
+++ pkg/R/Goestmm-cvar.R 2009-02-10 19:48:53 UTC (rev 22)
@@ -1,3 +0,0 @@
-setMethod(f = "cvar", signature(object = "Goestmm"), definition = function(object){
- cvar(as(object, "GoGARCH"))
-})
Deleted: pkg/R/Goestmm-formula.R
===================================================================
--- pkg/R/Goestmm-formula.R 2009-02-10 18:42:18 UTC (rev 21)
+++ pkg/R/Goestmm-formula.R 2009-02-10 19:48:53 UTC (rev 22)
@@ -1,3 +0,0 @@
-setMethod("formula", signature(x = "Goestmm"), function(x, ...)
- x at garchf
-)
Deleted: pkg/R/Goestmm-goest.R
===================================================================
--- pkg/R/Goestmm-goest.R 2009-02-10 18:42:18 UTC (rev 21)
+++ pkg/R/Goestmm-goest.R 2009-02-10 19:48:53 UTC (rev 22)
@@ -1,50 +0,0 @@
-setMethod(f = "goest", signature(object = "Goestmm"), definition = function(object, lag.max, garchlist, ...){
- lag.max <- abs(as.integer(lag.max))
- X <- object at X
- m <- ncol(X)
- n <- nrow(X)
- P <- object at P
- Id <- diag(m)
- Dsqr <- object at Dsqr
- S <- P %*% Dsqr %*% t(P)
- Sinv <- solve(S)
- S <- X %*% Sinv
- if(lag.max < 1){
- U <- Id
- Umatched <- list(U)
- weights <- 1
- } else {
- SSI <- array(dim = c(m, m, n))
- for(i in 1:n){
- 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){
- 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[[1]] <- Umatch(Id, Ul[[1]])
- Sm <- matrix(0, nrow = m, ncol = m)
- for(i in 1:lag.max){
- Ul[[i]] <- Umatch(Ul[[1]], Ul[[i]])
- mmprod <- weights[i] * (Id - Ul[[i]]) %*% solve(Id + Ul[[i]])
- Sm <- Sm + mmprod
- }
- Umatched <- Ul
- U <- (Id - Sm) %*% solve(Id + Sm)
- }
- Y <- S %*% U
- Z <- P %*% Dsqr %*% t(P) %*% t(U)
- 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))
- names(Ht) <- rownames(object at X)
- 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)
-})
Deleted: pkg/R/Goestmm-predict.R
===================================================================
--- pkg/R/Goestmm-predict.R 2009-02-10 18:42:18 UTC (rev 21)
+++ pkg/R/Goestmm-predict.R 2009-02-10 19:48:53 UTC (rev 22)
@@ -1,3 +0,0 @@
-setMethod(f = "predict", signature(object = "Goestmm"), definition = function(object, n.ahead = 10, ...){
- callNextMethod()
-})
Deleted: pkg/R/Goestmm-residuals.R
===================================================================
--- pkg/R/Goestmm-residuals.R 2009-02-10 18:42:18 UTC (rev 21)
+++ pkg/R/Goestmm-residuals.R 2009-02-10 19:48:53 UTC (rev 22)
@@ -1,5 +0,0 @@
-setMethod(f = "residuals", signature(object = "Goestmm"), definition = function(object, standardize = FALSE){
- callNextMethod(object = object, standardize = standardize)
-})
-
-
Deleted: pkg/R/Goestmm-show.R
===================================================================
--- pkg/R/Goestmm-show.R 2009-02-10 18:42:18 UTC (rev 21)
+++ pkg/R/Goestmm-show.R 2009-02-10 19:48:53 UTC (rev 22)
@@ -1,3 +0,0 @@
-setMethod(f = "show", signature(object = "Goestmm"), definition = function(object){
- callNextMethod()
-})
Deleted: pkg/R/Goestmm-summary.R
===================================================================
--- pkg/R/Goestmm-summary.R 2009-02-10 18:42:18 UTC (rev 21)
+++ pkg/R/Goestmm-summary.R 2009-02-10 19:48:53 UTC (rev 22)
@@ -1,3 +0,0 @@
-setMethod(f = "summary", signature(object = "Goestmm"), definition = function(object){
- callNextMethod()
-})
Deleted: pkg/R/Goestmm-update.R
===================================================================
--- pkg/R/Goestmm-update.R 2009-02-10 18:42:18 UTC (rev 21)
+++ pkg/R/Goestmm-update.R 2009-02-10 19:48:53 UTC (rev 22)
@@ -1,17 +0,0 @@
-setMethod("update", signature(object = "Goestmm"), function(object, formula., ..., evaluate = TRUE){
- call <- object at CALL
- extras <- match.call(expand.dots = FALSE)$...
- if (!missing(formula.))
- call$formula <- update.formula(formula(object), formula.)
- if (length(extras) > 0) {
- existing <- !is.na(match(names(extras), names(call)))
- for (a in names(extras)[existing]) call[[a]] <- extras[[a]]
- if (any(!existing)) {
- call <- c(as.list(call), extras[!existing])
- call <- as.call(call)
- }
- }
- if (evaluate)
- eval(call, parent.frame())
- else call
-})
Deleted: pkg/R/Goestnls-ccor.R
===================================================================
--- pkg/R/Goestnls-ccor.R 2009-02-10 18:42:18 UTC (rev 21)
+++ pkg/R/Goestnls-ccor.R 2009-02-10 19:48:53 UTC (rev 22)
@@ -1,3 +0,0 @@
-setMethod(f = "ccor", signature(object = "Goestnls"), definition = function(object){
- ccor(as(object, "GoGARCH"))
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/gogarch -r 22
More information about the Gogarch-commits
mailing list