R/gogarch-ica.R

In rgarch: Flexible GARCH modelling in R

#################################################################################
##
##   R package rgarch by Alexios Ghalanos Copyright (C) 2008, 2009, 2010, 2011
##   This file is part of the R package rgarch.
##
##   The R package rgarch is free software: you can redistribute it and/or modify
##   it under the terms of the GNU General Public License as published by
##   the Free Software Foundation, either version 3 of the License, or
##   (at your option) any later version.
##
##   The R package rgarch is distributed in the hope that it will be useful,
##   but WITHOUT ANY WARRANTY; without even the implied warranty of
##   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
##   GNU General Public License for more details.
##
#################################################################################

#------------------------------------------------------------------------------
# ICA Algorithms/GO-GARCH
#------------------------------------------------------------------------------
.makeiid = function(X, method="fastica", ica.fix = list(), scale = FALSE, demean = FALSE, ...)
{
	X 	= as.matrix(X)
	m 	= dim(X)[2]
	n 	= dim(X)[1]
	if(!is.null(ica.fix$A)){
		A = as.matrix(ica.fix$A)
		if(dim(A)[1] != m | dim(A)[2] != m) stop("\nwrong dimension for A matrix provided in ica.fix\n", call.  = FALSE)
		if(!is.null(ica.fix$K)){
			K = as.matrix(ica.fix$K)
			if(dim(K)[1] != m | dim(K)[2] != m) stop("\nwrong dimension for K matrix provided in ica.fix\n", call.  = FALSE)
		}
		W = solve(A)
		Y = X%*%W
		K = K
		Z = A
		return(list(Y = Y, Zinv = W, Z = Z, W = W, A = A, K = K))
	}
	##if(demean) muR = apply(X, 2, "mean") else muR = rep(0, m)
	##if(scale)  sdR = apply(X, 2, "sd") 	 else sdR = rep(1, m)
	ica 	= switch(method,
			fastica = .fastica(X, demean = demean, ...),
			fastICA = .fastICA(X, ...),
			jade = .jadeica(X, ...),
			pearson = .pearsonica(X, ...),
			radical = .radical(X, demean = demean, ...))
	W = ica$W
	K = ica$K
	Z = ica$A
	A = ica$A
	Y = ica$Y
	return(list(Y = Y, Zinv = W, Z = Z, W = W, A = A, K = K))
}

.fastICA = function(x, ...)
{
	if(!exists("fastICA")) {
		require('fastICA')
	}
	ans = fastICA(X = x, n.comp = dim(x)[2], ...)
	W = (ans$W)
	A = (ans$A)
	Y = (ans$S)
	K = (ans$K)
	return(list(W = W, A = A, Y = Y, K = K))
}

.fastica = function(x, ...)
{	
	ans = fastica(X = t(x), n.comp = dim(x)[1], ...)
	W = t(ans$W)
	A = t(ans$A)
	Y = t(ans$S)
	K = t(ans$whiteningMatrix)
	return(list(W = W, A = A, Y = Y, K = K))
}

.radical = function(x, ...)
{
	ans = radical(X = t(x), ...)
	W = t(ans$W)
	A = t(ans$A)
	Y = t(ans$S)
	K = t(ans$whiteningMatrix)
	return(list(W = W, A = A, Y = Y, K = K))
}


.jadeica = function(x, ...)
{
	if(!exists("JADE")) {
		require('JADE')
	}
	m = dim(x)[2]
	n = dim(x)[1]
	# maxiter = 10000,eps=1/(100*sqrt(n))
	jadeica = JADE(x, n.comp = m, maxiter = 10000, eps=1/(100*sqrt(n)), ...)
	W = t(jadeica$W)
	A = t(jadeica$A)
	Y = jadeica$S
	return(list(W = W, A = A, Y = Y, K = NULL))
}

.pearsonica = function(x, ...)
{
	if(!exists("PearsonICA")) {
		require('PearsonICA')
	}
	m = dim(x)[2]
	n = dim(x)[1]
	pica = PearsonICA(x, n.comp = m, row.norm = FALSE, maxit = 1800, tol = 1e-10, border.base = c(2.6, 4), 
			border.slope = c(0, 1), verbose = TRUE, w.init = NULL, na.rm = FALSE, 
			whitening.only = FALSE, PCA.only = FALSE)
	W = pica$W
	A = pica$A
	Y = pica$S
	K = pica$whitemat
	return(list(W = W, A = A, Y = Y, K = K))
}