## tvpTest.ssc			functions for testing parameter constancy
## author: Jiahui Wang and Eric Zivot
## updated
## April 4, 2003
##		Added critical values for Hansen tests
## April 2, 2003
##		Fixed names for test statistics
## March 25, 2003 by Eric Zivot
##		Added function to compute Hansen test
##
tvpTest = 
##
## This function implements the Nyblom (1989) test for the
## constancy of parameters of linear regression over time.
## 
## Input: an "OLS" object as returned by the OLS() function.
##
## Reference:
## Nyblom, Jukka (1989). ``Testing for the constancy of 
##   parameters over time'', Journal of the American Statistical
##   association, 84 (405), 223-230.
##
function(object)
{
	resid = residuals(object)
	if (is(resid, "timeSeries")) {
		resid = seriesData(resid)
	}
	sigma = sqrt(sum(resid^2)/object$df.resid)
	x = model.matrix(object)
	n = length(resid)
	SnI = n * object$R
	ex = (x * as.vector(resid))[n:1, , drop=F]
	ex = colCumsums(ex)/sigma
	L = sum(diag(SnI %*% crossprod(ex)))
	ans = list(n=n, L=L, p=ncol(x))
	oldClass(ans) = "tvpTest"
	ans
}

"print.tvpTest" =
function(x, digits=4, ...)
{
	stat = x$L / (x$n^2)
	stat = format(round(stat, digits=digits))
	kVec = c(1,2,3,4,6,8,10)
	qMat = matrix(c(0.461, 0.743,
                   0.748, 1.074,
                   1.000, 1.359,
                   1.237, 1.623,
                   1.686, 2.117,
                   2.116, 2.584,
                   2.533, 3.035), byrow=T, ncol=2)
	if (p <- match(x$p, kVec, nomatch=0)) {
		qVal = qMat[p,]
	}
	cat("\nTest for Constancy of Regression Parameters: Nyblom Test\n\n")
	cat("Null Hypothesis: constant parameters\n")
	cat("\nTest Statistics: ")
	if (p) {
		if (stat > qVal[2]) {
			stat = paste(stat, "**", sep="")
		}
		else if (stat > qVal[1]) {
			stat = paste(stat, "*", sep="")
		}
	}
	cat(stat, "\n")
	cat(" * : significant at 5% level\n")
	cat("** : significant at 1% level\n")
	cat("\n Total Observ.:", x$n, "\n")
	invisible()
}

HansenTest =
##
## This function implements Hansen's tests for parameter constancy over time in the
## linear regression model.
## 
## Input an "OLS" object returned from the FinMetrics function OLS
##
## Reference: Hansen, B. (1992). "Testing for Parameter Instability in Linear Models,"
## Journal of Policy Modeling, 14, 517-533.
##
function(object) {
	resid = residuals(object)
	if (is(resid, "timeSeries")) {
		resid = seriesData(resid)
	}
	call = object$call
	var.names = names(object$coef)
	test.names = c(var.names,"sigma^2")
	x = model.matrix(object)
	n = length(resid)
	sigma2 = sum(resid^2)/n
	fi = (x * as.vector(resid))[n:1, , drop=F]
	fi = cbind(fi,(resid^2 - sigma2)[n:1])
	si = colCumsums(fi)
	vi = colSums(fi^2)
	V.inv = solve(crossprod(fi))
	li.stats = colSums(si^2)/(n*vi)
	names(li.stats) = test.names
	lc.stat = sum(diag(V.inv %*% crossprod(si)))/n
	ans = list(li.stats=li.stats,
			    lc.stat=lc.stat,
				 call=call)
	oldClass(ans) = "HansenTest"
	ans 
}

"print.HansenTest" =
function(x, digits=4, ...)
{
	coef.stat = x$li.stats
	joint.stat = format(round(x$lc.stat,digits=digits))
	
	q = length(coef.stat)	
	kVec = 1:20
	qMat = matrix(c(0.353, 0.470, 0.748,
                   0.610, 0.749, 1.07,
                   0.846, 1.01, 1.35,
                   1.07,  1.24, 1.60,
                   1.28,  1.47, 1.88,
                   1.49,  1.68, 2.12,
					  1.69,  1.90, 2.35,
					  1.89,  2.11, 2.59,
					  2.10,  2.32, 2.82,
					  2.29,  2.54, 3.05,
					  2.49,  2.75, 3.27,
					  2.69,  2.96, 3.51,
					  2.89,  3.15, 3.69,
					  3.08,  3.34, 3.90,
					  3.26,  3.54, 4.07,
					  3.46,  3.75, 4.30,
					  3.64,  3.95, 4.51,
					  3.83,  4.14, 4.73,
					  4.03,  4.33, 4.92,
                   4.22,  4.52, 5.13), byrow=T, ncol=3)
	colIds(qMat) = c("10%","5%","1%")
	cat("\nTest for Constancy of Regression Parameters: Hansen Tests\n\n")
	cat("Null Hypothesis: constant parameters\n")
	cat("\nCall:\n")
	dput(x$call)
	cat("\nIndividual Coefficient Test Statistics:\n")
	print(signif(coef.stat, digits=digits))
	cat("\nCritical Values:\n")
	print(qMat[1,])
	cat("\nJoint Test Statistic: ")
	cat(joint.stat, "\n")
	if (q < 20) {
		cat("\nCritical Values:\n")
		print(qMat[q,])
	}
	invisible()
}