[Splm-commits] r190 - in pkg: . R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sat Dec 20 01:35:55 CET 2014
Author: the_sculler
Date: 2014-12-20 01:35:54 +0100 (Sat, 20 Dec 2014)
New Revision: 190
Added:
pkg/R/slag.R
pkg/man/slag.Rd
Modified:
pkg/ChangeLog
pkg/DESCRIPTION
pkg/NAMESPACE
pkg/R/spreml.R
Log:
Implemented plm data infrastructure in spreml.R and added slag() method
Modified: pkg/ChangeLog
===================================================================
--- pkg/ChangeLog 2014-10-18 16:31:48 UTC (rev 189)
+++ pkg/ChangeLog 2014-12-20 00:35:54 UTC (rev 190)
@@ -1,3 +1,9 @@
+Changes in Version 1.3-7
+ o Added slag() method for spatially lagging a vector or a pseries
+
+Changes in Version 1.3-6
+ o Implemented plm data infrastructure in spreml; now accepts any panel function in formula, e.g. diff() or Within()
+
Changes in Version 1.3-5
o Fixed usage of w viz. w2 in spreml estimators
Modified: pkg/DESCRIPTION
===================================================================
--- pkg/DESCRIPTION 2014-10-18 16:31:48 UTC (rev 189)
+++ pkg/DESCRIPTION 2014-12-20 00:35:54 UTC (rev 190)
@@ -1,7 +1,7 @@
Package: splm
Title: Econometric Models for Spatial Panel Data
-Version: 1.3-5
-Date: 2014-10-18
+Version: 1.3-7
+Date: 2014-12-18
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"))
Description: ML and GM estimation and diagnostic testing of econometric models for spatial panel data.
Modified: pkg/NAMESPACE
===================================================================
--- pkg/NAMESPACE 2014-10-18 16:31:48 UTC (rev 189)
+++ pkg/NAMESPACE 2014-12-20 00:35:54 UTC (rev 190)
@@ -1,6 +1,8 @@
importFrom(stats, model.matrix, model.response, aggregate, effects)
importFrom(stats, optim, nlminb)
importFrom(plm, plm.data)
+importFrom(plm, plm)
+importFrom(plm, pmodel.response)
importFrom(nlme, fdHess, lme)
import(spdep)
importFrom(ibdreg, pchibar)
@@ -12,7 +14,7 @@
export(bsktest, sphtest, bsjktest, vcov.splm,
-effects.splm, print.effects.splm,
+effects.splm, print.effects.splm, slag,
print.splm, spml, spgm, summary.splm, sphtest, listw2dgCMatrix, spreml)
@@ -27,3 +29,4 @@
S3method(sphtest, formula)
S3method(sphtest, splm)
S3method(impacts, splm)
+S3method(slag, pseries)
Added: pkg/R/slag.R
===================================================================
--- pkg/R/slag.R (rev 0)
+++ pkg/R/slag.R 2014-12-20 00:35:54 UTC (rev 190)
@@ -0,0 +1,94 @@
+## spatial lag of object according to listw or matrix
+
+slag <- function(x, listw, maxlag=1, ...) {
+ UseMethod("slag")
+}
+
+slag.default <- function(x, listw, maxlag=1, index, ...){
+ ## needs a vector and a well-specified index
+ if(length(x)!=length(index)) {
+ stop("Argument and index lengths differ")
+ }
+ wx <- slagres(x=x, tind=index, listw=listw, maxlag=maxlag, ...)
+ return(wx)
+}
+
+slag.pseries <- function(x, listw, maxlag=1, ...) {
+ ## retrieve index attribute from pseries
+ #ind <- attr(x, "index")[,1]
+ tind <- attr(x, "index")[,2]
+
+ wx <- slagres(x=x, tind=tind, listw=listw, maxlag=maxlag, ...)
+
+ ## make it a regular pseries
+ attr(wx, "index") <- attr(x, "index")
+ class(wx) <- c("pseries", class(wx))
+
+ return(wx)
+}
+
+slagres <- function(x, tind, listw, maxlag, ...) {
+ ## all calculations done inside here
+ ## check and if necessary transform
+ if(class(listw)[1]=="matrix") {
+ listw <- mat2listw(listw, ...)
+ }
+ ## if maxlag>1 then make higher-order W
+ if(maxlag>1) {
+ listw <- mat2listw(wlag(listw, maxlag))
+ }
+
+ ## unique values
+ #unind <- unique(ind)
+ tunind <- unique(tind)
+
+ wx <- rep(NA, length(x))
+
+ for(t. in 1:length(tunind)) {
+ tpos <- tind==tunind[t.]
+ xt <- x[tpos]
+ wxt <- lag.listw(listw, xt)
+ wx[tpos] <- wxt
+ }
+ return(wx)
+}
+
+wlag<-function(x, maxlag, std=TRUE) {
+ ## accepts nb, listw or matrix
+ ## returns the proximity matrix of all neighbours up to order=maxlag
+ #require(spdep)
+
+ ## convert in neighbours list
+ cl1 <- class(x)[1]
+ x <- switch(cl1,
+ nb={x},
+ matrix={mat2listw(x)$neighbours},
+ listw={x$neighbours})
+
+ n<-length(x)
+
+ mynb<-nblag(x,maxlag=maxlag)
+
+ mytot<-vector("list",n)
+
+ for(i in 1:n) {
+ mytot[[i]]<-mynb[[1]][[i]]
+ for(j in 2:maxlag) mytot[[i]]<-c(mytot[[i]],mynb[[j]][[i]])
+ ## reorder
+ mytot[[i]]<-mytot[[i]][order(mytot[[i]])]
+ }
+
+ ## make lagged proximity matrix
+ lagmat<-matrix(0,ncol=n,nrow=n)
+ for(i in 1:n) lagmat[i,mytot[[i]]]<-1
+
+ ## row-std. if requested
+ if(std) lagmat<-lagmat/apply(lagmat,1,sum)
+
+ return(lagmat)
+ }
+
+
+
+
+
Modified: pkg/R/spreml.R
===================================================================
--- pkg/R/spreml.R 2014-10-18 16:31:48 UTC (rev 189)
+++ pkg/R/spreml.R 2014-12-20 00:35:54 UTC (rev 190)
@@ -32,8 +32,11 @@
}
if (dim(data)[[1]] != length(index))
stop("Non conformable arguments")
- X <- model.matrix(formula, data = data)
- y <- model.response(model.frame(formula, data = data))
+# X <- model.matrix(formula, data = data)
+# y <- model.response(model.frame(formula, data = data))
+ pmod <- plm(formula, data, model="pooling")
+ X <- model.matrix(pmod)
+ y <- pmodel.response(pmod)
names(index) <- row.names(data)
ind <- index[which(names(index) %in% row.names(X))]
tind <- tindex[which(names(index) %in% row.names(X))]
Added: pkg/man/slag.Rd
===================================================================
--- pkg/man/slag.Rd (rev 0)
+++ pkg/man/slag.Rd 2014-12-20 00:35:54 UTC (rev 190)
@@ -0,0 +1,37 @@
+\name{slag}
+\alias{slag}
+\alias{slag.default}
+\alias{slag.pseries}
+
+\title{Spatial lag operator}
+\description{
+ Spatial lagging method for vectors or \code{pseries} objects.
+}
+\usage{
+\method{slag}{pseries}(x, listw, maxlag, ...)
+}
+\arguments{
+ \item{x}{an object of class \code{pseries}}
+ \item{listw}{an object of class \code{listw}}
+ \item{maxlag}{the spatial lag order (including lower)}
+\item{...}{additional arguments to be passed}
+}
+
+\value{
+a \code{pseries}
+}
+
+
+\author{Giovanni Millo}
+
+\examples{
+data(Produc, package="plm")
+data(usaww)
+usalw <- mat2listw(usaww)
+fm <- log(gsp)~log(pcap)+log(pc)+log(emp)+unemp+slag(log(pcap),
+ listw=usalw)
+slxmod <- spreml(fm, data=Produc, w = usaww,
+ model="pooling", lag=FALSE, errors="ols")
+}
+
+\keyword{slag}
More information about the Splm-commits
mailing list