[Splm-commits] r18 - pkg
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Oct 13 16:00:23 CEST 2009
Author: gpiras
Date: 2009-10-13 16:00:22 +0200 (Tue, 13 Oct 2009)
New Revision: 18
Removed:
pkg/LMHtest.model.R
Log:
eliminate all functions erroneously uploaded
Deleted: pkg/LMHtest.model.R
===================================================================
--- pkg/LMHtest.model.R 2009-10-13 14:00:06 UTC (rev 17)
+++ pkg/LMHtest.model.R 2009-10-13 14:00:22 UTC (rev 18)
@@ -1,102 +0,0 @@
-`LMHtest.model` <-
-function(x, listw, index){
-## depends on listw2dgCMatrix.R
-
-if(!inherits(x,"lm")) stop("argument should be an object of class lm")
-
- if(is.null(index)) stop("index should be specified to retrieve information on time and cross-sectional dimentions")
-
- if(!inherits(listw,"listw")) stop("object w should be of class listw")
-
- ind <- index[,1]
- tind <- index[,2]
-
-###extract objects from x
- y<-model.response(x$model)
- e<-as.matrix(residuals(x))
- ee<-crossprod(e)
- n<-dim(x$model)[1]
- bOLS<-coefficients(x)
- form<-x$call
- x<-model.matrix(eval(x$call),x$model)
- #print(x)
- XpXi<-solve(crossprod(x))
-
- cl<-match.call()
- ## reorder data by cross-sections, then time
- oo<-order(tind,ind)
- x<-x[oo,]
- y<-y[oo]
- e<-e[oo]
- ind<-ind[oo]
- tind<-tind[oo]
-
- ## det. number of groups and df
- N<-length(unique(ind))
- k<-dim(x)[[2]]
- ## det. max. group numerosity
- T<-max(tapply(x[,1],ind,length))
- ## det. total number of obs. (robust vs. unbalanced panels)
- NT<-length(ind)
-#print(c(N,k,T,NT))
-# print(ols$model)
-# k<-dim(ols$model)[2]-1
- indic<-seq(1,T)
- inde<-as.numeric(rep(indic,each=N)) ####indicator to get the cross-sectional observations
- ind1<-seq(1,N)
- inde1<-as.numeric(rep(ind1,T)) ####indicator to get the time periods observations
-####calculate the elements of LMj, LM1, SLM1
-
- JIe<-tapply(e,inde1,sum)
- JIe<-rep(JIe,T) ####calculates (J_T kronecker I_N)*u
- G<-(crossprod(e,JIe)/crossprod(e))-1 ###calculate G in LMj (same notation as in the paper)
-tr<-function(R) sum(diag(R))
- LM1<-sqrt((NT/(2*(T-1))))*as.numeric(G) ###same notation as in Baltagi et al.
-
-
-####calculate the elements of LMj, LM1, SLM1
- Wst<-listw2dgCMatrix(listw) ###transform the listw object in a sparse matrix
- Ws<-t(Wst) ### this is the real W since listw2dgCMatrix generate W'
- WWp<-(Ws+Wst)/2 ##generate (W+W')/2
-yy<-function(q){ #### for very big dimension of the data this can be changed looping over the rows and columns of W or either the listw object
- wq<-WWp%*%q
- wq<-as.matrix(wq)
- }
- IWWpe<-unlist(tapply(e,inde,yy)) ####calculates (I_T kronecker (W+W')/2)*u
- H<-crossprod(e,IWWpe)/crossprod(e) #calculate H (same notation as in the paper)
- W2<-Ws%*%Ws ####generate W^2
- WW<-crossprod(Ws) ####generate W'*W
- b<-tr(W2+WW) ###generates b (same notation as the paper)
-# LMj<-(NT/(2*(T-1)))*as.numeric(G)^2 + ((N^2*T)/b)*as.numeric(H)^2 ###LMj as in the paper
- LM2<-sqrt((N^2*T)/b)*as.numeric(H)^2 ###same notation as in Baltagi et al.
-if (LM1<=0){
- if (LM2<=0) JOINT<-0
- else JOINT<-LM2^2
- } ####this is chi-square_m in teh notation of the paper.
- else{
- if (LM2<=0) JOINT<-LM1^2
- else JOINT<-LM1^2 + LM2^2
- }
-STAT<- qchisq(0.05,1,lower.tail=FALSE)
-STAT1<- qchisq(0.05,2,lower.tail=FALSE)
-if (JOINT>=2.952) {
- if (JOINT<7.289 & JOINT>=4.321) pval<-0.05
- if (JOINT >= 7.289) pval<-0.01
- if (JOINT<= 4.321) pval<-0.1
- }
-else pval<-1
-
- statistics<-JOINT
-
- names(statistics)="LM-H"
- method<- "Baltagi, Song and Koh LM-H one-sided joint test"
- #alt<-"serial corr. in error terms, sub RE and spatial dependence"
- ##(insert usual htest features)
- dname <- deparse(formula)
- RVAL <- list(statistic = statistics,
- method = method,
- p.value = pval, data.name=deparse(form), alternative="Random Regional Effects and Spatial autocorrelation")
- class(RVAL) <- "htest"
- return(RVAL)
-}
-
More information about the Splm-commits
mailing list