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

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Wed Apr 13 18:08:04 CEST 2011


Author: gpiras
Date: 2011-04-13 18:08:03 +0200 (Wed, 13 Apr 2011)
New Revision: 95

Modified:
   pkg/ChangeLog
   pkg/DESCRIPTION
   pkg/NAMESPACE
   pkg/R/.Rapp.history
   pkg/R/utilities_GM.R
   pkg/man/bsjktest.Rd
   pkg/man/print.splm.Rd
   pkg/man/spfeml.Rd
   pkg/man/splm-package.Rd
   pkg/man/spreml.Rd
   pkg/man/spsegm.Rd
   pkg/man/spseml.Rd
   pkg/man/summary.effects.splm.Rd.old
   pkg/man/summary.splm.Rd
Log:
importFrom(stats, model.matrix, model.response, aggregate, effects)
import(nlme)
import(spdep)
import(Matrix)
importFrom(bdsmatrix,bdsmatrix)
importFrom(MASS,ginv)

export(bsjktest, bsktest, 
effects.splm, print.effects.splm, write.effects.splm, 
print.splm, spfeml, spgm, spreml, summary.splm,
spseml, spsegm, lrtest.splm, sphtest, listw2dgCMatrix)



S3method(print,splm)
S3method(print,summary.splm)
S3method(bsjktest,formula)
S3method(effects,splm)
S3method(print,effects.splm)
S3method(bsktest,formula)
S3method(bsktest,lm)
S3method(bsktest, splm)
S3method(sphtest,formula)
S3method(sphtest, splm)



Modified: pkg/ChangeLog
===================================================================
--- pkg/ChangeLog	2011-04-05 21:10:47 UTC (rev 94)
+++ pkg/ChangeLog	2011-04-13 16:08:03 UTC (rev 95)
@@ -1,3 +1,10 @@
+Changes in Version 0.8-01
+  o added spgm: general function that deals with all the GM estimators
+  o added the methodologies in Mutl and Pfaffermeyer (2011) and Piras (2011) 
+  for the estimation of the GM models sperrorgm and spsarargm
+  o includes the following estimators: ivplm.w2sls, ivplm.b2sls, ivplm.ec2sls, ivplm.g2sls
+  along with ivsplm that is the wrapper to use them. 
+  
 Changes in Version 0.2-04
   o dependency changed from kinship to bdsmatrix; removed require(kinship) from all functions
 

Modified: pkg/DESCRIPTION
===================================================================
--- pkg/DESCRIPTION	2011-04-05 21:10:47 UTC (rev 94)
+++ pkg/DESCRIPTION	2011-04-13 16:08:03 UTC (rev 95)
@@ -1,7 +1,7 @@
 Package: splm
 Title: Econometric Models for Spatial Panel Data
-Version: 0.2-04
-Date: 2010-09-22
+Version: 0.8-01
+Date: 2011-04-13
 Author: Giovanni Millo <giovanni.millo at generali.com>, Gianfranco Piras <gpiras at mac.com>
 Maintainer: Giovanni Millo <giovanni.millo at generali.com>
 Description: ML and GM estimation and diagnostic testing of econometric models for spatial panel data.

Modified: pkg/NAMESPACE
===================================================================
--- pkg/NAMESPACE	2011-04-05 21:10:47 UTC (rev 94)
+++ pkg/NAMESPACE	2011-04-13 16:08:03 UTC (rev 95)
@@ -7,9 +7,8 @@
 
 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,
-lrtest.splm, sphtest, listw2dgCMatrix)
+print.splm, spfeml, spgm, spreml, summary.splm,
+spseml, spsegm, lrtest.splm, sphtest, listw2dgCMatrix)
 
 
 

Modified: pkg/R/.Rapp.history
===================================================================
--- pkg/R/.Rapp.history	2011-04-05 21:10:47 UTC (rev 94)
+++ pkg/R/.Rapp.history	2011-04-13 16:08:03 UTC (rev 95)
@@ -1,9 +1,6 @@
 system.time()
 help(time)
 proc.time()
-proc.time()
-proc.time()
-proc.time()
 date()
 date()[4]
 sys.time()

Modified: pkg/R/utilities_GM.R
===================================================================
--- pkg/R/utilities_GM.R	2011-04-05 21:10:47 UTC (rev 94)
+++ pkg/R/utilities_GM.R	2011-04-13 16:08:03 UTC (rev 95)
@@ -13,7 +13,9 @@
 
 `arg` <-
 function (rhopar, v, verbose = verbose) 
-{
+{
+	
+	#print(v$bigG)
     vv <-  v$bigG %*% c(rhopar[1], rhopar[1]^2, rhopar[2]) - v$smallg
     value <- sum(vv^2)
     if (verbose) 
@@ -21,8 +23,21 @@
             rhopar[2], "\n")
     value
 }
-
 
+
+`argmod` <-
+function (rhopar,  v,rhoin,sig, verbose = verbose) 
+{
+#	print(v$bigG)
+    vv <-  v$GG %*% c(rhoin, rhoin^2, sig,rhopar[1]) - v$gg
+    value <- sum(vv^2)
+    if (verbose) 
+        cat("function:", value, "rho:", rhopar[1], "sig2:", 
+            rhopar[2], "\n")
+    value
+}
+
+
 `arg1` <-
 function (rhopar, v, ss,SS,T, verbose = verbose) 
 {
@@ -56,10 +71,49 @@
 		rhopar[2], "\n")
     value
 }
+
 
+#`arg1` <-
+#function (rhopar, v, T, verbose = verbose) 
+#{
+##	Ga<-cbind( (1/(T-1))*ss^2,0)
+#	Ga<-cbind( (1/(T-1))*rhopar[2]^2,0)
+##	Gb<-cbind( 0, SS^2)
+#	Gb<-cbind( 0, rhopar[3]^2)
+#	Gc<-rbind(Ga,Gb)
+#	Gamma<-kronecker(Gc,diag(3)) 
+#	Gammainv<-solve(Gamma)
+#    vv <-  v$GG %*% c(rhopar[1], rhopar[1]^2, rhopar[2], rhopar[3]) - v$gg
+#    value <- t(vv)%*% Gammainv %*% vv
+#    if (verbose) 
+#	cat("function:", value, "rho:", rhopar[1], "sig2:", 
+#		rhopar[2], "\n")
+#    value
+#}
+#
+#
+#
+#`arg2` <-
+#function (rhopar, v, T,TW, verbose = verbose) 
+#{
+#	Ga<-cbind( (1/(T-1))*rhopar[2]^2,0)
+##	Gb<-cbind( 0, SS^2)
+#	Gb<-cbind( 0, rhopar[3]^2)
+#	Gc<-rbind(Ga,Gb)
+#	Gamma<-kronecker(Gc,TW) 
+#
+#	Gammainv<-solve(Gamma)
+#    vv <-  v$GG %*% c(rhopar[1], rhopar[1]^2, rhopar[2], rhopar[3]) - v$gg
+#    value <- t(vv)%*% Gammainv %*% vv
+#    if (verbose) 
+#	cat("function:", value, "rho:", rhopar[1], "sig2:", 
+#		rhopar[2], "\n")
+#    value
+#}
 
 
 
+
 `arg3` <-
 function (rhopar, v, ss,T,TW, verbose = verbose) 
 {
@@ -81,18 +135,10 @@
 	ind<-seq(1,T)
 	inde<-rep(ind,each=N)
 	NT<-N*T
-#ub<-matrix(,NT,1)
-#for (i in 1:T) ub[(N*i-N+1):(N*i),]<-lag.listw(listw,u[(N*i-N+1):(N*i)])
-#ubb<-matrix(,NT,1)
-#for (i in 1:T) ubb[(N*i-N+1):(N*i),]<-lag.listw(listw,ub[(N*i-N+1):(N*i)])
-#ubmt<-matrix(,N,1)
-#for (i in 1:N) ubmt[i,]<-mean(ub[seq.int(from=i,to=NT,by=N)])
-#ubbmt<-matrix(,N,1)		
-#for (i in 1:N) ubbmt[i,]<-mean(ubb[seq.int(from=i,to=NT,by=N)])
-#umt<-matrix(,N,1)		
-#for (i in 1:N) umt[i,]<-mean(u[seq.int(from=i,to=NT,by=N)])
-	ub<-unlist(tapply(u,inde, function(TT) lag.listw(listw,TT), simplify=TRUE))###Wu
-	ubb<-unlist(tapply(ub,inde, function(TT) lag.listw(listw,TT), simplify=TRUE))###WWu
+	
+	ub<-lag.listwpanel(listw, u, inde)	
+	ubb<-lag.listwpanel(listw, ub, inde)
+	
 	ind1<-seq(1,N)
 	inde1<-rep(ind1,T)
 	umt<-tapply(u, inde1, mean) 
@@ -111,19 +157,49 @@
 	uQ0u<-crossprod(u,Q0u)
 	ubbQ0ub<-crossprod(ubb,Q0ub)
 	uQ0ubb<-crossprod(u,Q0ubb)
-	tr <- matrix(0, N, 1)
-	for (i in 1:N) {
-        tr[i] <- sum(listw$weights[[i]]^2)
-	}      
-	trwpw <- sum(tr)
+	trwpw<-sum(unlist(listw$weights)^2)
 	G1c<-(1/(N*(T-1)))*rbind(2*uQ0ub, 2*ubbQ0ub,(uQ0ubb+ubQ0ub) )
 	G2c<- (-1/(N*(T-1)))* rbind(ubQ0ub,ubbQ0ubb,ubQ0ubb)
 	G3c<- rbind(1,trwpw/N, 0)
 	G<-cbind(G1c,G2c,G3c)	
 	g<-(1/(N*(T-1)))*rbind(uQ0u,ubQ0ub,uQ0ub)
+#	print(G)
+#	print(g)
 	output<-list(bigG=G, smallg=g, Q1u=umNT,Q1ub=ubmNT,Q1ubb=ubbmNT, ub=ub,ubb=ubb,TR=trwpw)
 }
 
+`fswithin` <-
+function(listw,u,N,T){
+	ind<-seq(1,T)
+	inde<-rep(ind,each=N)
+	NT<-N*T
+	ub<-lag.listwpanel(listw, u, inde)
+	ubb<-lag.listwpanel(listw, ub, inde)
+
+	uu<-crossprod(u)
+	uub<-crossprod(u, ub)
+	uubb<-crossprod(u, ubb)
+	ububb<-crossprod(ub, ubb)
+	ubbubb<-crossprod(ubb)
+	ubub<-crossprod(ub)
+	ubbu<-crossprod(ubb, u)
+	ubu<-crossprod(ub, u)
+	ubbub<-crossprod(ubb, ub)
+
+	trwpw<-sum(unlist(listw$weights)^2)
+	G1c<-(1/(N*(T-1)))*rbind(2*uub, 2*ubbub,(uubb+ ubub))
+	G2c<- (-1/(N*(T-1)))* rbind(ubub,ubbubb, ububb)
+	G3c<- rbind(1,trwpw/N, 0)
+
+	G<-cbind(G1c,G2c,G3c)	
+	g<-(1/(N*(T-1)))*rbind(uu, ubub, uub)
+	
+#	print(G)
+#	print(g)
+	output<-list(bigG=G, smallg=g,TR=trwpw)
+}
+
+
 `Ggsararsp` <-
 function (W, u, zero.policy = FALSE) 
 {
@@ -189,7 +265,31 @@
 }
 
 
+`pwbetween` <-
+function(bigG, smallg, u, N, T,TR,listw){
 
+	ub<-lag.listw(listw, u)
+	ubb<-lag.listw(listw, ub)
+
+	uQ1u<-crossprod(u,u)
+	uQ1ub<-crossprod(u,ub)
+	ubbQ1ub<-crossprod(ubb,ub)
+	ubbQ1ubb<-crossprod(ubb,ubb)
+	uQ1ubb<-crossprod(u,ubb)
+	ubQ1ub<-crossprod(ub,ub)
+	ubQ1ubb<-crossprod(ub,ubb)
+	G1c1<-rbind(2*uQ1ub, 2*ubbQ1ub,  (uQ1ubb + ubQ1ub))/N
+	G1c2<-rbind(ubQ1ub, ubbQ1ubb, ubQ1ubb)/-N
+	G1c3<-rbind(1,TR/N,0)
+	G1c<-cbind(G1c1,G1c2,rep(0,3),G1c3)
+	g1<-rbind(uQ1u, ubQ1ub, uQ1ub)/N
+	GG<-rbind(cbind(bigG,rep(0,3)),G1c)
+	#print(GG)
+	gg<-rbind(smallg,g1)
+	out<-list(GG=GG,gg=gg)
+}
+
+
 `tslssp` <-
 function(y,yend,X,Zinst,robust=FALSE) {
 	Q <- cbind(X,Zinst)

Modified: pkg/man/bsjktest.Rd
===================================================================
--- pkg/man/bsjktest.Rd	2011-04-05 21:10:47 UTC (rev 94)
+++ pkg/man/bsjktest.Rd	2011-04-13 16:08:03 UTC (rev 95)
@@ -44,8 +44,8 @@
 Produc <- Produc[Produc$year<1975, ]
 data(usaww)
 fm <- log(gsp)~log(pcap)+log(pc)+log(emp)+unemp
-test1<-bsjktest(fm,data=Produc, w=usaww,
-  test="C.1")
-test1
+\dontrun{test1<-bsjktest(fm,data=Produc, w=usaww,
+  test="C.1")}
+\dontrun{test1}
 }
 \keyword{htest}

Modified: pkg/man/print.splm.Rd
===================================================================
--- pkg/man/print.splm.Rd	2011-04-05 21:10:47 UTC (rev 94)
+++ pkg/man/print.splm.Rd	2011-04-13 16:08:03 UTC (rev 95)
@@ -33,7 +33,7 @@
 }
 
 \seealso{
-  \code{\link{spreml}}, \code{\link{spregm}}, \code{\link{spreml}}
+  \code{\link{spreml}}, \code{\link{spgm}}, \code{\link{spreml}}
 }
 \author{ Giovanni Millo \email{Giovanni\_Millo at Generali.com}, Gianfranco Piras\email{gpiras at mac.com}}
 
@@ -41,7 +41,7 @@
 data(Produc, package = "Ecdat") 
 data(usaww)
 Produc <- Produc[Produc$year<1975, ] 
-GM<-spregm(log(gsp)~log(pcap)+log(pc)+log(emp)+unemp, data=Produc,w=usaww,method="fulweigh")
+GM<-spgm(log(gsp)~log(pcap)+log(pc)+log(emp)+unemp, data=Produc, listw = usaww, moments="fullweights", spatial.error= TRUE)
 summary(GM)
 }
 \keyword{spatial}
\ No newline at end of file

Modified: pkg/man/spfeml.Rd
===================================================================
--- pkg/man/spfeml.Rd	2011-04-05 21:10:47 UTC (rev 94)
+++ pkg/man/spfeml.Rd	2011-04-13 16:08:03 UTC (rev 95)
@@ -105,7 +105,7 @@
 \author{ Gianfranco Piras \email{gpiras at mac.com}}
 
 \seealso{
-  \code{\link{spreml}}, \code{\link{spregm}}, \code{\link{effects}}
+  \code{\link{spreml}}, \code{\link{spgm}}, \code{\link{effects}}
 }
 \examples{
 data(Produc, package = "Ecdat")

Modified: pkg/man/splm-package.Rd
===================================================================
--- pkg/man/splm-package.Rd	2011-04-05 21:10:47 UTC (rev 94)
+++ pkg/man/splm-package.Rd	2011-04-13 16:08:03 UTC (rev 95)
@@ -75,7 +75,7 @@
 data(usaww)
 Produc <- Produc[Produc$year<1975, ] 
 fm <- log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp
-GM<-spregm(log(gsp)~log(pcap)+log(pc)+log(emp)+unemp, data=Produc,w=usaww,method="fulweigh")
+GM<-spgm(log(gsp)~log(pcap)+log(pc)+log(emp) + unemp, data = Produc, listw = usaww, moments = "fullweights", spatial.error = TRUE)
 summary(GM)
 respaterr <- spreml(fm, data = Produc, w = usaww, errors="semre")
 summary(respaterr)

Modified: pkg/man/spreml.Rd
===================================================================
--- pkg/man/spreml.Rd	2011-04-05 21:10:47 UTC (rev 94)
+++ pkg/man/spreml.Rd	2011-04-13 16:08:03 UTC (rev 95)
@@ -93,7 +93,7 @@
 
 \author{Giovanni Millo}
 
-\seealso{\code{\link{spregm}}, \code{\link{spfeml}}}
+\seealso{\code{\link{spgm}}, \code{\link{spfeml}}}
 
 \examples{
 data(Produc, package = "Ecdat")
@@ -105,8 +105,8 @@
 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)
+\dontrun{respatlag <- spreml(fm, data = Produc, w = usaww, errors="re", lag=TRUE)}
+\dontrun{summary(respatlag)}
 }
 
 \keyword{spatial}
\ No newline at end of file

Modified: pkg/man/spsegm.Rd
===================================================================
--- pkg/man/spsegm.Rd	2011-04-05 21:10:47 UTC (rev 94)
+++ pkg/man/spsegm.Rd	2011-04-13 16:08:03 UTC (rev 95)
@@ -90,7 +90,7 @@
 \author{Gianfranco Piras\email{gpiras at mac.com}}
 
 \seealso{
-\code{\link{spregm}}
+\code{\link{spgm}}
 }
 \examples{
 data(Produc, package = "Ecdat")

Modified: pkg/man/spseml.Rd
===================================================================
--- pkg/man/spseml.Rd	2011-04-05 21:10:47 UTC (rev 94)
+++ pkg/man/spseml.Rd	2011-04-13 16:08:03 UTC (rev 95)
@@ -83,7 +83,7 @@
 \author{Gianfranco Piras\email{gpiras at mac.com}}
 
 \seealso{
-\code{\link{spregm}}
+\code{\link{spgm}}
 }
 \examples{
 data(Produc, package = "Ecdat")

Modified: pkg/man/summary.effects.splm.Rd.old
===================================================================
--- pkg/man/summary.effects.splm.Rd.old	2011-04-05 21:10:47 UTC (rev 94)
+++ pkg/man/summary.effects.splm.Rd.old	2011-04-13 16:08:03 UTC (rev 95)
@@ -36,7 +36,7 @@
 }
 
 \seealso{
-  \code{\link{spreml}}, \code{\link{spregm}}, \code{\link{lagsarlm}},
+  \code{\link{spreml}}, \code{\link{lagsarlm}},
   \code{\link{errorsarlm}}, \code{\link{spreml}}, \code{\link{effects}}
 }
 \author{Gianfranco Piras\email{gpiras at mac.com}}

Modified: pkg/man/summary.splm.Rd
===================================================================
--- pkg/man/summary.splm.Rd	2011-04-05 21:10:47 UTC (rev 94)
+++ pkg/man/summary.splm.Rd	2011-04-13 16:08:03 UTC (rev 95)
@@ -38,8 +38,7 @@
 }
 
 \seealso{
-  \code{\link{spreml}}, \code{\link{spregm}}, 
- \code{\link{spreml}}, \code{\link{effects}}
+  \code{\link{spreml}}, \code{\link{spgm}}, \code{\link{effects}}
 }
 \author{ Giovanni Millo \email{Giovanni\_Millo at Generali.com}, Gianfranco Piras\email{gpiras at mac.com}}
 
@@ -47,7 +46,7 @@
 data(Produc, package = "Ecdat") 
 data(usaww)
 Produc <- Produc[Produc$year<1975, ] 
-GM<-spregm(log(gsp)~log(pcap)+log(pc)+log(emp)+unemp, data=Produc,w=usaww,method="fulweigh")
+GM<-spgm(log(gsp)~log(pcap)+log(pc)+log(emp)+unemp, data=Produc, listw = usaww, moments = "fullweights", spatial.error = TRUE)
 summary(GM)
 }
 



More information about the Splm-commits mailing list