[Splm-commits] r93 - in pkg: . R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Fri Dec 17 18:49:08 CET 2010
Author: the_sculler
Date: 2010-12-17 18:49:08 +0100 (Fri, 17 Dec 2010)
New Revision: 93
Removed:
pkg/R/semarREmod.R
pkg/R/semarmod.R
Modified:
pkg/DESCRIPTION
pkg/NAMESPACE
pkg/R/print.splm.R
pkg/man/spreml.Rd
Log:
Added doc for sphtest, lrtest; fixed DESCRIPTION and NAMESPACE; updated version number
Modified: pkg/DESCRIPTION
===================================================================
--- pkg/DESCRIPTION 2010-12-14 23:01:04 UTC (rev 92)
+++ pkg/DESCRIPTION 2010-12-17 17:49:08 UTC (rev 93)
@@ -1,6 +1,6 @@
Package: splm
Title: Econometric Models for Spatial Panel Data
-Version: 0.2-02
+Version: 0.2-03
Date: 2010-09-22
Author: Giovanni Millo <giovanni.millo at generali.com>, Gianfranco Piras <gpiras at mac.com>
Maintainer: Giovanni Millo <giovanni.millo at generali.com>
Modified: pkg/NAMESPACE
===================================================================
--- pkg/NAMESPACE 2010-12-14 23:01:04 UTC (rev 92)
+++ pkg/NAMESPACE 2010-12-17 17:49:08 UTC (rev 93)
@@ -7,7 +7,9 @@
export(bsjktest, bsktest,
effects.splm, print.effects.splm, write.effects.splm,
-print.splm,spfeml,spregm,spreml,spsegm,summary.splm, spseml, spsegm, spreml, spfeml, spregm, spfegm,listw2dgCMatrix)
+print.splm,spfeml,spregm,spreml,spsegm,summary.splm,
+spseml, spsegm, spreml, spfeml, spregm, spfegm,
+lrtest.splm, sphtest, listw2dgCMatrix)
@@ -19,3 +21,6 @@
S3method(bsktest,formula)
S3method(bsktest,lm)
S3method(bsktest, splm)
+S3method(sphtest,formula)
+S3method(sphtest, splm)
+
Modified: pkg/R/print.splm.R
===================================================================
--- pkg/R/print.splm.R 2010-12-14 23:01:04 UTC (rev 92)
+++ pkg/R/print.splm.R 2010-12-17 17:49:08 UTC (rev 93)
@@ -21,6 +21,15 @@
else cat("No error covariance parameters\n")
cat("\n")
+ ## add printing of spatial autoregressive parameter
+ ar <- x$arcoef
+ if (length(ar)) {
+ cat("\n")
+ cat("Spatial autoregressive parameter:\n")
+ print.default(format(ar, digits = digits), print.gap = 2,
+ quote = FALSE)
+ }
+
invisible(x)
}
Deleted: pkg/R/semarREmod.R
===================================================================
--- pkg/R/semarREmod.R 2010-12-14 23:01:04 UTC (rev 92)
+++ pkg/R/semarREmod.R 2010-12-17 17:49:08 UTC (rev 93)
@@ -1,119 +0,0 @@
-semarREmod<-function(X, y, ind, tind, n, k, t, nT, w, coef0=rep(0,3),
- hess=FALSE, trace=trace, x.tol=1.5e-18, rel.tol=1e-15, ...) {
- ## spatial- and time- error autoregressive, random effects panel model estimation
- ## following Appendix A.2 in Baltagi, Song, Jung and Koh WP, version May 2004
-
- ## V matrix, as V/sigma.e^2 in BJSK 2007
- Vmat<-function(rho,t) {
- V1<-matrix(ncol=t,nrow=t)
- for(i in 1:t) V1[i,]<-rho^abs(1:t-i)
- V <- (1/(1-rho^2)) * V1
- }
-
- ## spatial lag operator
- B<-function(lambda) diag(1,n)-lambda*w
-
- ## determinant of B
- detB<-function(lambda) det(B(lambda)) # use more efficient versions from Elhorst
-
- ## some useful pieces:
- alfa2<-function(rho) (1+rho)/(1-rho)
- d2<-function(rho,t) alfa2(rho)+t-1
- Jt<-matrix(1,ncol=t,nrow=t)
- In<-diag(1,n)
-
- ## second determinant in (A.17)
- det2<-function(phi,rho,lambda,t) det( d2(rho,t)* (1-rho)^2*phi*In+solve(crossprod(B(lambda))))
- ## Z0 for (A.13)
- Z0 <- function(phi,rho,lambda,t) solve(d2(rho,t)*(1-rho)^2*phi*In + solve(crossprod(B(lambda))) )
-
- ## inverse of Sigma
- invSigma <- function(phi, rho, lambda, n, t) {
- invVmat<-solve(Vmat(rho,t))
- BB<-crossprod(B(lambda))
- invSi1<-kronecker(invVmat,BB)
- invSi2<-1/(d2(rho,t)*(1-rho)^2)
- invSi3<-kronecker( solve(Vmat(rho,t),Jt)%*%invVmat, Z0(phi,rho,lambda,t)-BB )
- invSigma <- invSi1 + invSi2*invSi3
- invSigma
- }
-
-
- ## concentrated likelihood
- ll.c<-function(phirholambda,y,X,n,t,w) {
- phi<-phirholambda[1]
- rho<-phirholambda[2]
- lambda<-phirholambda[3]
-
- ## perform GLS
- sigma.1<-invSigma(phi,rho,lambda,n,t)
- b.hat<-solve( crossprod(X,sigma.1)%*%X, crossprod(X,sigma.1)%*%y )
- ehat<-y-X%*%b.hat
- sigma2ehat<-(crossprod(ehat,sigma.1)%*%ehat)/(n*t)
- bhat<-list(betahat=b.hat,e=ehat,sigma2=sigma2ehat)
- e <- bhat[[2]]
- s2e <- bhat[[3]]
-
- uno <- n/2*log(1-rho)
- due <- -1/2*log(det2(phi,rho,lambda,t))
- tre <- -(n*t)/2*log(s2e)
- quattro <- (t-1)*log(detB(lambda))
- cinque <- -1/(2*s2e)*crossprod(e,sigma.1)%*%e
-
- const <- -(n*t)/2*log(2*pi)
- ll.c <- const+uno+due+tre+quattro+cinque
- llc <- - ll.c
-
- }
-
-
- myphirholambda0 <- coef0
-
- optimum<-nlminb(myphirholambda0, ll.c,
- lower=c(1e-8,-0.999,-0.999), upper=c(10e8,0.999,0.999),
- control=list(x.tol=x.tol, rel.tol=rel.tol, trace=trace),
- y=y, X=X, n=n, t=t, w=w, ...)
-
-
- myphirholambda<-optimum$par
- myll <- optimum$objective
-
- ## optimal values of parms:
- phi<-myphirholambda[1]
- rho<-myphirholambda[2]
- lambda<-myphirholambda[3]
-
- ## perform GLS
- sigma.1<-invSigma(phi,rho,lambda,n,t)
- b.hat<-solve( crossprod(X,sigma.1)%*%X, crossprod(X,sigma.1)%*%y )
- ehat<-y-X%*%b.hat
- sigma2ehat<-crossprod(ehat,sigma.1)%*%ehat/(n*t)
- beta<-list(betahat=b.hat,e=ehat,sigma2=sigma2ehat)
-
-
- ## names for coefs and error comp.s
- nam.beta <- dimnames(X)[[2]]
- nam.errcomp <- c("phi","rho","lambda")
-
- ## calc. cov(b) by GLS
- covB<-as.numeric(beta[[3]])*solve(crossprod(X,invSigma(phi, rho, lambda, n, t))%*%X)
- dimnames(covB) <- list(nam.beta, nam.beta)
-
- ## calc. cov(phi,rho,lambda) by numerical Hessian
- covPRL <- solve(-fdHess(myphirholambda, function(x) -ll.c(x,y,X,n,t,w))$Hessian)
- dimnames(covPRL) <- list(nam.errcomp, nam.errcomp)
-
- ## make (separate) coefficients' vectors
- betas <- as.vector(beta[[1]])
- errcomp <- c(phi, rho, lambda)
- names(betas) <- nam.beta
- names(errcomp) <- nam.errcomp
-
- RES <- list(betas=betas, errcomp=errcomp,
- covB=covB, covPRL=covPRL, ll=myll)
-
- return(RES)
-
- }
-
-
Deleted: pkg/R/semarmod.R
===================================================================
--- pkg/R/semarmod.R 2010-12-14 23:01:04 UTC (rev 92)
+++ pkg/R/semarmod.R 2010-12-17 17:49:08 UTC (rev 93)
@@ -1,103 +0,0 @@
-`semarmod` <-
-function(X, y, ind, tind, n, k, t, nT, w, coef0=rep(0,3),
- hess=FALSE, trace=trace, x.tol=1.5e-18, rel.tol=1e-15, ...) {
- ## spatial- and time- error autoregressive (pooling) panel model estimation
- ## modified by restriction (phi=0) from Appendix A.2 in Baltagi, Song,
- ## Jung and Koh WP, version May 2004; restricted likelihood in (3.15).
-
- ## V matrix, as V/sigma.e^2 in BJSK 2007
- Vmat<-function(rho,t) {
- V1<-matrix(ncol=t,nrow=t)
- for(i in 1:t) V1[i,]<-rho^abs(1:t-i)
- V <- (1/(1-rho^2)) * V1
- }
-
- ## spatial lag operator
- B<-function(lambda) diag(1,n)-lambda*w
-
- ## determinant of B
- detB<-function(lambda) det(B(lambda)) # use more efficient versions from Elhorst
-
- ## inverse of Sigma
- invSigma <- function(rho, lambda, n, t) {
- invVmat<-solve(Vmat(rho,t))
- BB<-crossprod(B(lambda))
- invSigma<-kronecker(invVmat,BB)
- invSigma
- }
-
-
- ## concentrated likelihood
- ll.c<-function(rholambda,y,X,n,t,w) {
- rho<-rholambda[1]
- lambda<-rholambda[2]
-
- ## beta_hat as GLS estimator and error variance estimator
- sigma.1<-invSigma(rho,lambda,n,t)
- b.hat<-solve( crossprod(X,sigma.1)%*%X, crossprod(X,sigma.1)%*%y )
- ehat<-y-X%*%b.hat
- sigma2ehat<-crossprod(ehat,sigma.1)%*%ehat/(n*t)
- bhat<-list(betahat=b.hat,e=ehat,sigma2=sigma2ehat)
- e <- bhat[[2]]
- s2e <- bhat[[3]]
-
- uno <- n/2*log(1-rho^2)
- tre <- -(n*t)/2*log(s2e)
- quattro <- t*log(detB(lambda))
- cinque <- -1/(2*s2e)*crossprod(e,invSigma(rho, lambda, n, t))%*%e
- const <- -(n*t)/2*log(2*pi)
-
- ll.c<-const+uno+tre+quattro+cinque
- llc <- -ll.c
-
- }
-
- ## iterate (=traballa) until convergence:
-
- myrholambda0 <- coef0
-
- optimum<-nlminb(myrholambda0, ll.c,
- lower=c(-0.999,-0.999), upper=c(0.999,0.999),
- control=list(x.tol=x.tol, rel.tol=rel.tol, trace=trace),
- y=y, X=X, n=n, t=t, w=w, ...)
-
-
- myrholambda<-optimum$par
- myll <- optimum$objective
-
- ## optimal values of parms:
- rho<-myrholambda[1]
- lambda<-myrholambda[2]
-
- ## perform GLS
- sigma.1<-invSigma(rho,lambda,n,t)
- b.hat<-solve( crossprod(X,sigma.1)%*%X, crossprod(X,sigma.1)%*%y )
- ehat<-y-X%*%b.hat
- sigma2ehat<-crossprod(ehat,sigma.1)%*%ehat/(n*t)
- beta<-list(betahat=b.hat,e=ehat,sigma2=sigma2ehat)
-
-
- ## names for coefs and error comp.s
- nam.beta <- dimnames(X)[[2]]
- nam.errcomp <- c("rho","lambda")
-
- ## calc. cov(b) by GLS
- covB<-as.numeric(beta[[3]])*solve(crossprod(X,invSigma(rho, lambda, n, t))%*%X)
- dimnames(covB) <- list(nam.beta, nam.beta)
-
- ## calc. cov(phi,rho,lambda) by numerical Hessian
- covPRL <- solve(-fdHess(myrholambda, function(x) -ll.c(x,y,X,n,t,w))$Hessian)
- dimnames(covPRL) <- list(nam.errcomp, nam.errcomp)
-
- ## make (separate) coefficients' vectors
- betas <- as.vector(beta[[1]])
- errcomp <- c(rho, lambda)
- names(betas) <- nam.beta
- names(errcomp) <- nam.errcomp
-
- RES <- list(betas=betas, errcomp=errcomp,
- covB=covB, covPRL=covPRL, ll=myll)
-
- return(RES)
- }
-
Modified: pkg/man/spreml.Rd
===================================================================
--- pkg/man/spreml.Rd 2010-12-14 23:01:04 UTC (rev 92)
+++ pkg/man/spreml.Rd 2010-12-17 17:49:08 UTC (rev 93)
@@ -23,8 +23,9 @@
\usage{
-spreml(formula, data, index = NULL, w, lag=FALSE,
- errors = c("semsrre","semsr","srre","semre","re","sr","sem"),
+spreml(formula, data, index = NULL, w, w2=w, lag=FALSE,
+ errors = c("semsrre","semsr","srre","semre",
+ "re", "sr", "sem","ols", "sem2re"),
pvar = FALSE, hess=FALSE, quiet=TRUE,
initval = c("zeros", "estimate"),
x.tol=1.5e-18, rel.tol=1e-15,
@@ -36,8 +37,9 @@
in the model. When the obect is a \code{\link{data.frame}}, the first two columns may contain the indexes. See \code{index}}
\item{index}{if not NULL (default), a character vector to identify the indexes among the columns of the \code{\link{data.frame}}}
\item{w}{an object of class \code{listw} or a \code{matrix}}
- \item{lag}{default=\code{FALSE}. If \code{TRUE}, a spatial lag of the dependent variable is added: Not yet implemented}
- \item{errors}{one of \code{c("semsrre","semsr","srre","semre","re","sr","sem")}. See details.}
+ \item{w2}{an object of class \code{listw} or a \code{matrix}}
+ \item{lag}{default=\code{FALSE}. If \code{TRUE}, a spatial lag of the dependent variable is added.}
+ \item{errors}{one of \code{c("semsrre","semsr","srre","semre","re","sr","sem", "ols", "sem2re")}. See details.}
\item{pvar}{if \code{TRUE} the \code{pvar} function is called}
\item{hess}{if \code{TRUE} use numerical Hessian instead of GLS for the standard errors of the estimates}
\item{quiet}{if \code{FALSE} report function and parameters values during optimization}
@@ -59,7 +61,10 @@
\code{"semre"} individual random effects and spatial correlation;
\code{"re"} individual random effects;
\code{"sr"} serial correlation;
- \code{"sem"} spatial correlation.
+ \code{"sem"} spatial correlation.
+ \code{"ols"} none (spherical residuals).
+ \code{"sem2re"} spatial correlation in both individual random effects
+ and idiosncratic errors (Kapoor, Kelejian and Prucha's specification).
}
\value{
An object of class \code{"splm"}.
@@ -95,8 +100,13 @@
data(usaww)
Produc <- Produc[Produc$year<1974, ]
fm <- log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp
+## the two standard specifications:
+## random effects panel with spatial errors
respaterr <- spreml(fm, data = Produc, w = usaww, errors="semre")
summary(respaterr)
+## random effects panel with spatial lag
+respatlag <- spreml(fm, data = Produc, w = usaww, errors="re", lag=TRUE)
+summary(respatlag)
}
\keyword{spatial}
\ No newline at end of file
More information about the Splm-commits
mailing list