[Splm-commits] r211 - in pkg: . R man

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Mon Nov 21 13:55:21 CET 2016


Author: the_sculler
Date: 2016-11-21 13:55:21 +0100 (Mon, 21 Nov 2016)
New Revision: 211

Added:
   pkg/R/slmtest.R
   pkg/man/slmtest.Rd
Modified:
   pkg/ChangeLog
   pkg/DESCRIPTION
   pkg/NAMESPACE
   pkg/man/bsjktest.Rd
   pkg/man/rwtest.Rd
Log:
Added slmtest() for locally robust LM tests.



Modified: pkg/ChangeLog
===================================================================
--- pkg/ChangeLog	2016-11-17 17:55:24 UTC (rev 210)
+++ pkg/ChangeLog	2016-11-21 12:55:21 UTC (rev 211)
@@ -1,3 +1,6 @@
+Changes in Version 1.4-6
+ o Added slmtest() for the (locally robust) LM test of spatial lag sub spatial error or spatial error sub spatial lag; with methods for formula and plm.
+
 Changes in Version 1.4-5
  o Added rwtest() for the randomized CD-p procedure, with methods for formula, pseries and panelmodel.
 
@@ -3,5 +6,5 @@
 Changes in Version 1.4-4
  o Fixed clmmtest() in bsktest.R (now takes residuals for the restricted model from spreml(..., errors="sem", lag=F) instead of spfeml()). Temporarily disabled standardized LM tests SLM1 and SLM2; default set at 'standardize=FALSE'in main function.
-	
+
 Changes in Version 1.4-3
  o Introduced Baltagi et al. C.3 test (RE conditional on SEM and AR(1)) after successful testing.

Modified: pkg/DESCRIPTION
===================================================================
--- pkg/DESCRIPTION	2016-11-17 17:55:24 UTC (rev 210)
+++ pkg/DESCRIPTION	2016-11-21 12:55:21 UTC (rev 211)
@@ -1,7 +1,7 @@
 Package: splm
 Title: Econometric Models for Spatial Panel Data
-Version: 1.4-5
-Date: 2016-11-17
+Version: 1.4-6
+Date: 2016-11-22
 Authors at R: c(person(given = "Giovanni", family = "Millo", role = c("aut", "cre"), email = "giovanni.millo at generali.com"),
              person(given = "Gianfranco", family = "Piras", role = c("aut"), email = "gpiras at mac.com"))
 Author: Giovanni Millo [aut, cre],

Modified: pkg/NAMESPACE
===================================================================
--- pkg/NAMESPACE	2016-11-17 17:55:24 UTC (rev 210)
+++ pkg/NAMESPACE	2016-11-21 12:55:21 UTC (rev 211)
@@ -25,7 +25,7 @@
 export(bsktest, sphtest, bsjktest, vcov.splm,
 effects.splm, print.effects.splm, slag, 
 print.splm, spml, spgm, summary.splm, sphtest,
-listw2dgCMatrix, spreml, rwtest)
+listw2dgCMatrix, spreml, rwtest, slmtest)
 
 
 
@@ -44,3 +44,5 @@
 S3method(rwtest, formula)
 S3method(rwtest, panelmodel)
 S3method(rwtest, pseries)
+S3method(slmtest, formula)
+S3method(slmtest, plm)

Added: pkg/R/slmtest.R
===================================================================
--- pkg/R/slmtest.R	                        (rev 0)
+++ pkg/R/slmtest.R	2016-11-21 12:55:21 UTC (rev 211)
@@ -0,0 +1,124 @@
+slmtest<-function (x, ...)
+ {
+    UseMethod("slmtest")
+ }
+
+slmtest.plm <- function(x, listw,
+                        test=c("lme", "lml",
+                               "rlme", "rlml"),
+                        ...)
+{
+    ## plm method for slmtest
+    return(slmtestres(mod = x, listw = listw,
+                      test = match.arg(test)))   
+}
+
+slmtest.formula <- function(formula, data, listw,
+                            model="pooling",
+                            test=c("lme", "lml",
+                                   "rlme", "rlml"),
+                            index=NULL, ...) {
+    ## estimate pooled model
+    ## (notice you get "standard" panel ordering!
+    ## i.e., id is slow and time is fast)
+    mod <- plm(formula=formula, data=data,
+               model=model, index=index, ...)
+    return(slmtestres(mod = mod, listw = listw,
+                      test = match.arg(test)))
+    }
+                      
+
+slmtestres <- function(mod, listw, test) {
+
+    ## Computing engine for slmtest; expects a 'plm' object
+    N <- pdim(mod)$nT$n
+    t. <- pdim(mod)$nT$T
+    NT <- pdim(mod)$nT$N
+
+    X <- model.matrix(mod)
+    y <- pmodel.response(mod)
+    hatY <- X %*% coef(mod)
+
+    ## check w or listw and in case transform to matrix
+    w <- listw
+    if (!is.matrix(w)) {
+        if ("listw" %in% class(w)) {
+            w <- listw2mat(w)
+        }
+        else {
+            stop("listw has to be either a 'matrix' or a 'listw' object")
+        }
+    }
+    
+    ## instead of reordering y, X, e... the 'spatial panel'
+    ## way, we just swap I and W in
+    ## making the bigW: the rest is all full panel vectors.
+    ## Optimization is here done by using sparse matrix
+    ## methods.
+    W <- as.spam(w)
+    bigW <- kronecker(W, diag.spam(1, t.)) 
+    tr <- function(x) sum(diag(x))
+    Tw <- tr(W%*%W + crossprod(W))
+    M <- diag.spam(1, NT) - X %*% solve(crossprod(X)) %*% t(X)
+    Whaty <- bigW %*% hatY
+
+    ## extract residuals as a vector (no pseries features)
+    e <- mod$residuals
+
+    sigma2 <- crossprod(e)/NT
+
+    J <- (crossprod(Whaty, M) %*% Whaty) / sigma2 + t.*Tw
+
+    switch(test, lml = {
+        statistic <- ((crossprod(e, bigW) %*% y)/sigma2)^2 / J
+        descr <- "lag"
+        rob <- ""
+    }, lme = {
+        statistic <- ((crossprod(e, bigW) %*% e)/sigma2)^2 /
+            (t. * Tw)
+        descr <- "error"
+        rob <- ""
+    }, rlml = {
+        nume <- ((crossprod(e, bigW) %*% y)/sigma2)-
+            ((crossprod(e, bigW) %*% e)/sigma2)
+        deno <- J - t.*Tw
+        statistic <- nume^2/deno
+        descr <- "lag"
+        rob <- " sub spatial error"
+    }, rlme = {
+        nume <- ((crossprod(e, bigW) %*% e)/sigma2)-
+            t.*Tw/J * ((crossprod(e, bigW) %*% y)/sigma2)
+        deno <- t.*Tw * (1 - t.*Tw/J)
+        statistic <- nume^2/deno
+        descr <- "error"
+        rob <- " sub spatial lag"
+    })
+
+    names(statistic) <- "LM"
+    df <- 1
+    names(df) <- "df"
+    model <- mod$args$model
+    pre <- if(rob == "") "" else "Locally robust "
+    transf.type <- if(model == "pooling") "" else {
+         paste("(", model, " transformation)", sep="")}     
+    alternative = paste("spatial", descr, "dependence")
+    form <- paste(deparse(substitute(formula)),
+                  transf.type)
+    
+    p.value <- pchisq(statistic, df=df, lower.tail=F)
+
+    RVAL <- list(statistic = statistic, parameter = df,
+                 method = paste(pre, "LM test for spatial ",
+                                descr, " dependence",
+                                rob, sep=""),
+        alternative = alternative, p.value = p.value, 
+        data.name = form)
+    class(RVAL) <- "htest"
+    return(RVAL)
+}
+
+## check
+## lm.LMtests(lm(fm, Produc), listw=mat2listw(kronecker(diag(1, 17), usaww)))
+## lm.LMtests(lm(fm, Produc), listw=mat2listw(kronecker(diag(1, 17), usaww)), test="LMlag")
+## lm.LMtests(lm(fm, Produc), listw=mat2listw(kronecker(diag(1, 17), usaww)), test="RLMerr")
+## lm.LMtests(lm(fm, Produc), listw=mat2listw(kronecker(diag(1, 17), usaww)), test="RLMlag")

Modified: pkg/man/bsjktest.Rd
===================================================================
--- pkg/man/bsjktest.Rd	2016-11-17 17:55:24 UTC (rev 210)
+++ pkg/man/bsjktest.Rd	2016-11-21 12:55:21 UTC (rev 211)
@@ -18,7 +18,7 @@
   \item{index}{either NULL (default) or a character vector to identify the indexes among the columns of the \code{data.frame}}
 \item{listw}{either a \code{matrix} or a \code{listw} representing the spatial structure}
 \item{test}{one of \code{c("C.1","C.2","C.3","J")}, the
-  test to be performed. "C.3" is not implemented yet.}
+  test to be performed.}
 \item{...}{additional arguments to be passed}
 }
 

Modified: pkg/man/rwtest.Rd
===================================================================
--- pkg/man/rwtest.Rd	2016-11-17 17:55:24 UTC (rev 210)
+++ pkg/man/rwtest.Rd	2016-11-21 12:55:21 UTC (rev 211)
@@ -55,7 +55,7 @@
  \item{order}{the order of neighbourhood to test for,}
  \item{mc}{the number of parallel threads to execute; defaults to 1
   (serial execution); is limited to the number of execution cores
-  actually available.}
+  actually available, and depends on operating system support.}
  \item{test}{the type of test statistic to be returned. One of 
    \itemize{
     \item \code{"rho"} for the average correlation coefficient,
@@ -116,6 +116,8 @@
  Panels, \emph{Econometric Reviews}, \bold{34}(6-10), pp. 1089--1117. 
 }
 
+\author{Giovanni Millo}
+
 \examples{
 data(Produc, package = "plm")
 data(usaww)

Added: pkg/man/slmtest.Rd
===================================================================
--- pkg/man/slmtest.Rd	                        (rev 0)
+++ pkg/man/slmtest.Rd	2016-11-21 12:55:21 UTC (rev 211)
@@ -0,0 +1,78 @@
+\name{slmtest}
+\alias{slmtest}
+\alias{slmtest.formula}
+\alias{slmtest.plm}
+
+\title{Locally robust panel Lagrange Multiplier tests for spatial dependence}
+\description{
+  Locally robust LM tests for spatial lag (error) correlation sub
+  spatial error (lag) correlation in panel models
+}
+\usage{
+slmtest(x,...)
+\method{slmtest}{formula}(formula, data, listw, model="pooling",
+ test=c("lme","lml","rlme","rlml"), index=NULL, ...)
+\method{slmtest}{plm}(x, listw,
+ test=c("lme","lml","rlme","rlml"), ...)
+}
+\arguments{
+\item{formula}{an object of class  \code{formula}}
+\item{data}{a \code{data.frame} or \code{pdata.frame} containing the
+    variables in the model}
+\item{x}{an object of class \code{plm}}
+\item{listw}{either a \code{matrix} or a \code{listw} representing the
+  spatial structure}
+\item{model}{a character value specifying the transformation to be
+  applied to the data.} 
+\item{test}{one of \code{c("lme","lml","rlme","rlml")}, the
+  test to be performed.}
+  \item{index}{either NULL (default) or a character vector to identify the indexes among the columns of the \code{data.frame}}
+\item{...}{additional arguments to be passed}
+}
+\details{
+  This tests are panel versions of the locally robust LM tests of
+  Anselin et al. (1996), based on a pooling assumption: i.e., they do
+  not allow for any kind of individual effect. Therefore it is advisable
+  to employ a within transformation whenever individual effects cannot
+  be ruled out.
+
+  It must be kept in mind that these locally robust procedures have been
+  designed for situations in which the "other" effect is not of
+  substantial magnitude, and can behave suboptimally otherwise.
+
+  Four tests are available to be chosen through the \code{test}
+  argument: \code{"lml"} for "LM lag" and, respectively, \code{"lme"}
+  for "LM error" are the standard, non-robust versions, obtained simply
+  pooling the cross-sectional versions; \code{"rlml"} and \code{"rlme"}
+  are, respectively, the locally robust test for lag, allowing for a
+  spatial error; and for error, allowing for a spatial lag.
+  
+  The \code{model} argument, specified according to the standards of
+\code{plm}, is passed on internally and employed to determine the panel
+data transformation to be applied before calculating the test. Defaults
+to \code{"pooling"} (no transformation).
+
+  }
+\value{
+an object of class \code{htest}
+}
+\references{Baltagi, B.H., Song, S.H., Jung B. and Koh, W. (2007)
+Testing panel data regression models with spatial and serial error correlation.
+\emph{Journal of Econometrics}, \bold{140}, 5-51.}
+\author{Giovanni Millo}
+%\seealso{\code{detest}}
+
+\examples{
+data(Produc, package="plm")
+data(usaww)
+fm <- log(gsp)~log(pcap)+log(pc)+log(emp)+unemp
+## robust LM test for spatial lag sub spatial error
+## model on original data, pooling hypothesis
+slmtest(fm, data=Produc, listw = usaww, test="rlml")
+## model on within-transformed (time-demeaned) data,
+## eliminates individual effects
+slmtest(fm, data=Produc, listw = usaww, test="rlml",
+  model="within")
+}
+
+\keyword{htest}



More information about the Splm-commits mailing list