[Splm-commits] r17 - pkg
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Oct 13 16:00:06 CEST 2009
Author: gpiras
Date: 2009-10-13 16:00:06 +0200 (Tue, 13 Oct 2009)
New Revision: 17
Removed:
pkg/LMHtest.R
Log:
eliminate all functions erroneously uploaded
Deleted: pkg/LMHtest.R
===================================================================
--- pkg/LMHtest.R 2009-10-13 13:59:46 UTC (rev 16)
+++ pkg/LMHtest.R 2009-10-13 14:00:06 UTC (rev 17)
@@ -1,97 +0,0 @@
-`LMHtest` <-
-function(formula, data, index=NULL, listw){
- ## depends on listw2dgCMatrix.R
- if(!is.null(index)) { ####can be deleted when using the wrapper
- require(plm)
- data <- plm.data(data, index)
- }
-
- index <- data[,1]
- tindex <- data[,2]
-
- x<-model.matrix(formula,data=data)
- y<-model.response(model.frame(formula,data=data))
- cl<-match.call()
- names(index)<-row.names(data)
- ind<-index[which(names(index)%in%row.names(x))]
- tind<-tindex[which(names(index)%in%row.names(x))]
- ## reorder data by cross-sections, then time
- oo<-order(tind,ind)
- x<-x[oo,]
- y<-y[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)
- ols<-lm(y~x)
- XpXi<-solve(crossprod(x))
- n<-dim(ols$model)[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
- bOLS<-coefficients(ols)
- e<-as.matrix(residuals(ols))
- ee<-crossprod(e)
-####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(formula), alternative="Random Regional Effects and Spatial autocorrelation")
- class(RVAL) <- "htest"
- return(RVAL)
-}
-
More information about the Splm-commits
mailing list