bptest <- function(formula, data=list())
{
	mod <- lm(formula, data=data);
	X <- model.matrix(formula, data=data);
	Z <- X;
	n <- length(X[,1]);
	k <- length(X[1,]);
	resi <- resid(mod);
	s2 <- (t(resi)%*%resi)/(n-k); 
	T <- c(1:n)
	f <- c(resi[T]^2/s2 -1);
	bp <- 1/2*t(f)%*%Z%*%solve(t(Z)%*%Z)%*%t(Z)%*%f;
	names(bp) <- "BP";
	freiheit <- c(k);
	names(freiheit) <- "df";
	RVAL <- list(statistic = bp, 
			parameter = freiheit,
			method = "Breusch-Pagan-Test",
			p.value= 1-pchisq(bp,k),
			data.name="form1");
	class(RVAL) <- "htest";

	return(RVAL);
};

custest <- function(formula, data=list())
{
	mf <- model.frame(formula, data=data);
	y <- model.response(mf);
	X <- model.matrix(formula, data=data);
	k <- length(X[1,]);
	n <- length(y);
	mod <- lm(formula, data=data);
	resi <- resid(mod);
	sq <- sqrt(sum(resi^2)/(n - k));
	cu <- 0;
	cuplot <- c(0);
	for ( i in (k:(n-1)))
	{
		mod <- lm(y[1:i] ~ X[1:i,]-1);
		beta <- coef(mod);
		DUM <- solve(t(X[1:i,])%*%X[1:i,]);
		d1 <- y[i+1] - t(X[i+1,])%*%beta;
		d2 <- sqrt(1+t(X[i+1,])%*%DUM%*%X[i+1,]);
		u <- (1/sq)*(d1/d2);
		cu <- cu + u;
		cuplot <- c(cuplot, cu);
	}
	return(cuplot);
};dwtest <- function(formula, data=list())
{
	mod <- lm(formula, data=data);
	resi <- resid(mod);
	dw <- sum((resi[2:length(resi)] - resi[1:length(resi)-1])^2)/sum(resi^2);
	names(dw) <- "DW";
	RVAL <- list(statistic = dw, 
			method = "Durbin-Watson-Test",
			p.value= 0,
			data.name=" ");
	class(RVAL) <- "htest";

	return(RVAL);
};
gqtest <- function(formula, T, data=list())
{
	mf <- model.frame(formula, data=data);
	y <- model.response(mf);
	X <- model.matrix(formula, data=data);
	n <- length(y);
	k <- length(X[1,]);
	mod1 <- lm(y[1:T] ~ X[1:T,]);
	mod2 <- lm(y[(T+1):length(y)] ~ X[(T+1):length(y),]);
	resi1 <- resid(mod1);
	resi2 <- resid(mod2);
	sresi1 <- sum(resi1^2);
	sresi2 <- sum(resi2^2);
	gq <- (sresi2/(n-T-k))/(sresi1/(T-k));
	names(gq) <- "GQ";
	freiheit <- c(T-k, n-T-k);
	names(freiheit) <- c("df1", "df2");
	RVAL <- list(statistic = gq, 
			parameter = freiheit,
			method = "Goldfeld-Quandt-Test",
			p.value= 1-pf(gq, n-T-k, T-k),
			data.name="form1");
	class(RVAL) <- "htest";

	return(RVAL);
};	harvtest <- function(formula, data=list())
{
	mf <- model.frame(formula, data=data);
	y <- model.response(mf);
	X <- model.matrix(formula, data=data);
	k <- length(X[1,]);
	n <- length(y);

	mod <- lm(formula, data=data);
	resi <- resid(mod);
	cu <- 0;
	cuplot <- c(0);
	rekres <- c(0);
	sq <- sqrt(sum(resi^2)/(n - k));
	
	for ( i in ((k+1):(n-1)))
	{
		mod <- lm(y[1:i] ~ X[1:i,]-1);
		beta <- coef(mod);
		DUM <- solve(t(X[1:i,])%*%X[1:i,]);
		d1 <- y[i+1] - t(X[i+1,])%*%beta;
		d2 <- sqrt(1+t(X[i+1,])%*%DUM%*%X[i+1,]);
		u <- (1/sq)*(d1/d2);
		cu <- cu + u;
		rekres <- c(rekres,u);
		cuplot <- c(cuplot, cu);
	}
	
	reksum <- sum((rekres - mean(rekres))^2);
	harv <- abs((cu/sqrt(n -k))/sqrt(reksum/(n-k-1)));
	names(harv) <- "HC";
	freiheit <- n-k-1;
	names(freiheit) <- "df";
	RVAL <- list(statistic = harv, 
			parameter = freiheit,
			method = "Harvey-Collier-Test",
			p.value= 1-pt(harv, n-k-1),
			data.name="formula");
	class(RVAL) <- "htest";

	return(RVAL);
};hmctest <- function(formula, T, data=list())
{
	mf <- model.frame(formula, data=data);
	y <- model.response(mf);
	X <- model.matrix(formula, data=data);
	n <- length(y);
	k <- length(X[1,]);
	mod1 <- lm(y[1:T] ~ X[1:T,]);
	mod2 <- lm(y[(T+1):length(y)] ~ X[(T+1):length(y)]);
	resi1 <- resid(mod1);
	resi2 <- resid(mod2);
	sresi1 <- sum(resi1^2);
	sresi2 <- sum(resi2^2);
	hmc <- (sresi1/T)/(sresi2/n);
	names(hmc) <- "HMC";
	RVAL <- list(statistic = hmc, 
			method = "Harrison-McCabe-Test",
			p.value= NA,
			data.name="formula");
	class(RVAL) <- "htest";

	return(RVAL);
};	raintest <- function(formula, data=list())
{
	mf <- model.frame(formula, data=data);
	y <- model.response(mf);
	X <- model.matrix(formula, data=data);
	n <- length(y);
	k <- length(X[1,]);
	g1 <- ceiling(quantile(c(1:n), probs=0.25));
	g2 <- floor(quantile(c(1:n), probs=0.75));
	n1 <- g2 - g1;
	y1 <- y[g1:g2];
	X1 <- X[g1:g2,];
	mod <- lm(formula, data=data);
	mod1 <- lm(y1 ~X1);
	sresi <- sum(resid(mod)^2);
	sresi1 <- sum(resid(mod1)^2);
	rain <- ((sresi - sresi1)/(n-n1))/(sresi1/(n1-k));	
	names(rain) <- "Rain";
	freiheit <- c((n-n1),(n1-k));
	names(freiheit) <- c("df1","df2");
	RVAL <- list(statistic = rain, 
			parameter = freiheit,
			method = "Rainbow-Test",
			p.value= 1-pf(rain, n-n1, n1-k),
			data.name="formula");
	class(RVAL) <- "htest";

	return(RVAL);
};	

reset <- function(formula,g, data=list())
{
	mf <- model.frame(formula, data=data);
	y <- model.response(mf);
	XX <- model.matrix(formula, data=data);
	n <- length(y);
	k <- length(XX[1,]);
	X <- XX[,1:g];
	Z <- XX[,(g+1):k];
	mod1 <- lm(y~X);
	mod2 <- lm(y~X+Z);
	beta1 <- coef(mod1);
	beta2 <- coef(mod2);
	res1 <- sum(resid(mod1)^2);
	res2 <- sum(resid(mod2)^2);
	df1 <- k-g;
	df2 <- n-k;
	pruefgroesse <- (res1 - res2) / res2;
	pruefgroesse <- (df2/df1)*pruefgroesse;
	names(pruefgroesse) <- "RESET";
	freiheit <- c(df1, df2);
	names(freiheit) <- c("df1","df2");
	RVAL <- list(statistic = pruefgroesse, 
			parameter = freiheit,
			method = "RESET-Test",
			p.value= 1-pf(pruefgroesse, df1, df2),
			data.name="formula");
	class(RVAL) <- "htest";
	return(RVAL);
};	


