[Splm-commits] r154 - in pkg: . R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Mon Mar 25 23:24:28 CET 2013
Author: gpiras
Date: 2013-03-25 23:24:28 +0100 (Mon, 25 Mar 2013)
New Revision: 154
Modified:
pkg/ChangeLog
pkg/DESCRIPTION
pkg/R/likelihoodsFE.R
pkg/R/spfeml.R
pkg/R/summary.splm.R
pkg/man/effects.splm.Rd
pkg/man/spml.Rd
pkg/man/write.effects.splm.Rd
Log:
updated spfeml
Modified: pkg/ChangeLog
===================================================================
--- pkg/ChangeLog 2013-03-22 21:22:40 UTC (rev 153)
+++ pkg/ChangeLog 2013-03-25 22:24:28 UTC (rev 154)
@@ -1,3 +1,7 @@
+Changes in Version 1.0-05
+ o fixed some bugs in spfeml and update the relative function to changes in spdep (a few differences arises with the paper on JSS such as: the residuals of the sarar model and the s.e. of the spatial coefficients)
+
+
Changes in Version 1.0-03
o spreml is now visible at user level (for estimating extended specifications with AR errors)
Changes in Version 1.0-02
Modified: pkg/DESCRIPTION
===================================================================
--- pkg/DESCRIPTION 2013-03-22 21:22:40 UTC (rev 153)
+++ pkg/DESCRIPTION 2013-03-25 22:24:28 UTC (rev 154)
@@ -1,10 +1,10 @@
Package: splm
Title: Econometric Models for Spatial Panel Data
-Version: 1.0-04
+Version: 1.0-05
Date: 2012-10-24
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.
-Depends: R (>= 2.10.0), MASS, nlme, spdep, plm, Matrix, bdsmatrix, spam, ibdreg, car, lmtest, Ecdat
+Depends: R (>= 2.15.0), MASS, nlme, spdep, plm, Matrix, bdsmatrix, spam, ibdreg, car, lmtest, Ecdat
License: GPL-2
LazyLoad: yes
Modified: pkg/R/likelihoodsFE.R
===================================================================
--- pkg/R/likelihoodsFE.R 2013-03-22 21:22:40 UTC (rev 153)
+++ pkg/R/likelihoodsFE.R 2013-03-25 22:24:28 UTC (rev 154)
@@ -54,7 +54,7 @@
#opt <- nlminb(0.02138744, conclikpan, lower = interval[1], upper= interval[2], env = env)
lambda <- opt$maximum
-
+ print(lambda)
if (isTRUE(all.equal(lambda, interval[1])) || isTRUE(all.equal(lambda,interval[2])))
warning("lambda on interval bound - results should not be used")
@@ -95,8 +95,8 @@
lambda.se <- fdHess[1, 1]
sig.se <- NULL
asyvar1 <- vcov(lm.lag)
+ rest.se<- NULL
-
}
else{
@@ -132,7 +132,7 @@
sig.se <- sqrt(asyv[1, 1])
asyvar1 <- asyv[-c(1,2),-c(1,2)]
- rownames(asyvar1) <- colnames(asyvar1) <- c("lambda", colnames(xt))
+ rownames(asyvar1) <- colnames(asyvar1) <- c(colnames(xt))
}
@@ -321,17 +321,20 @@
sacsarpanel<-function (coefs, env)
{
+ lambda <- coefs[1]
+ rho <- coefs[2]
+
T<-get("T", envir = env)
SSE <- sacsarpanel_sse(coefs, env)
n <- get("n", envir = env)
s2 <- SSE/n
- ldet1 <- do_ldet(coefs[1], env, which = 1)
- ldet2 <- do_ldet(coefs[2], env, which = 2)
+ ldet1 <- do_ldet(lambda, env, which = 1)
+ ldet2 <- do_ldet(rho, env, which = 2)
- ret <-(T * (ldet1 + ldet2)) - ((n*T/2) * log(2 * pi)) - (n*T/2) * log(s2)
- - (1/(2 * (s2))) * SSE
+ ret <-(T * ldet1 + T * ldet2 - ((n*T/2) * log(2 * pi)) - (n*T/2) * log(s2)
+ - (1/(2 * (s2))) * SSE)
-if (get("verbose", envir = env)) cat("rho:", coefs[1], " lambda:", coefs[2], " function:",
+if (get("verbose", envir = env)) cat("lambda:", lambda, " rho:", rho, " function:",
ret, " Jacobian1:", ldet1, " Jacobian2:", ldet2,
" SSE:", SSE, "\n")
-ret
@@ -342,10 +345,10 @@
{
lambda <- coefs[1]
rho <- coefs[2]
- yl <- get("yt", envir = env) - lambda * get("wyt", envir = env) -
- rho * get("w2yt", envir = env) + rho * lambda * get("w2wyt",
+ yl <- get("yt", envir = env) - rho * get("wyt", envir = env) -
+ lambda * get("w2yt", envir = env) + rho * lambda * get("w2wyt",
envir = env)
- xl <- get("xt", envir = env) - rho * get("wxt", envir = env)
+ xl <- get("xt", envir = env) - lambda * get("wxt", envir = env)
xl.q <- qr.Q(qr(xl, LAPACK = get("LAPACK", envir = env)))
xl.q.yl <- crossprod(xl.q, yl)
SSE <- crossprod(yl) - crossprod(xl.q.yl)
@@ -465,8 +468,8 @@
# assign("first_time", TRUE, envir = env)
- lm.target <- lm(I(yt - lambda * wyt - rho * w2yt + rho * lambda *
- w2wyt) ~ I(xt - rho * wxt) - 1)
+ lm.target <- lm(I(yt - rho * wyt - lambda * w2yt + rho * lambda *
+ w2wyt) ~ I(xt - lambda * wxt) - 1)
r <- as.vector(residuals(lm.target))
fit <- as.vector(yt - r)
@@ -475,8 +478,8 @@
s2 <- SSE/NT
betas <- coefficients(lm.target)
names(betas) <- colnames(xt)
+ # coefs <- c(lambda, rho, betas)
coefs <- c(lambda, rho, betas)
- # coefsl <- c(rho, lambda, betas)
###Add the vc matrix exact
if(Hess){
@@ -485,8 +488,8 @@
fdHess<- solve(-(mat), tol.solve = tol.solve)
rownames(fdHess) <- colnames(fdHess) <- c("lambda", "rho",colnames(xt))
- rho.se <- fdHess[1, 1]
- lambda.se <- fdHess[2, 2]
+ rho.se <- fdHess[2,2]
+ lambda.se <- fdHess[1,1]
asyvar1 <- vcov(lm.target)
}
@@ -503,19 +506,19 @@
T<-get("T", envir = env)
NT<-get("NT", envir = env)
+ lambda <- coefs[1]
rho <- coefs[2]
- lambda <- coefs[1]
- beta <- coefs[-(1:2)]
- # SSE <- sar_sac_hess_sse_panel(rho, lambda, beta, env)
- SSE <- sar_sac_hess_sse_panel(lambda, rho, beta, env)
+ beta <- coefs[-(1:2)]
+ SSE <- sar_sac_hess_sse_panel(lambda, rho, beta, env)
+ # SSE <- sar_sac_hess_sse_panel(lambda, rho, beta, env)
n <- NT/T
# SSE<- s2 *n
s2<- SSE / n
- ldet1 <- do_ldet(rho, env, which = 1)
- ldet2 <- do_ldet(lambda, env, which = 2)
+ ldet1 <- do_ldet(lambda, env, which = 1)
+ ldet2 <- do_ldet(rho, env, which = 2)
+
ret <- T * ldet1 + T * ldet2 - ((n*T/2) * log(2 * pi)) - (n*T/2) * log(s2) - (1/(2 * s2)) * SSE
- if (get("verbose", envir = env))
- cat("rho:", rho, "lambda:", lambda, " function:", ret,
+ if (get("verbose", envir = env)) cat("rho:", rho, "lambda:", lambda, " function:", ret,
" Jacobian1:", ldet1, " Jacobian2:", ldet2, " SSE:",
SSE, "\n")
ret
@@ -523,10 +526,11 @@
sar_sac_hess_sse_panel <- function (lambda, rho, beta, env)
{
- yl <- get("yt", envir = env) - lambda * get("wyt", envir = env) -
- rho * get("w2yt", envir = env) + rho * lambda * get("w2wyt",
+ yl <- get("yt", envir = env) - rho * get("wyt", envir = env) -
+ lambda * get("w2yt", envir = env) + rho * lambda * get("w2wyt",
envir = env)
- xl <- get("xt", envir = env) - rho * get("wxt", envir = env)
+
+ xl <- get("xt", envir = env) - lambda * get("wxt", envir = env)
res <- yl - (xl %*% beta)
SSE <- c(crossprod(res))
SSE
Modified: pkg/R/spfeml.R
===================================================================
--- pkg/R/spfeml.R 2013-03-22 21:22:40 UTC (rev 153)
+++ pkg/R/spfeml.R 2013-03-25 22:24:28 UTC (rev 154)
@@ -461,7 +461,7 @@
if (model == "lag") spat.coef<-RES$lambda
if (model == "error") spat.coef<-RES$rho
-if (model == "sarar") spat.coef <- c(RES$rho, RES$lambda)
+if (model == "sarar") spat.coef <- c(RES$lambda, RES$rho)
# if (is.null(RES$lambda.se) && model=="error") Coeff<-RES$coeff
Coeff<-c(spat.coef, RES$coeff)
@@ -485,8 +485,8 @@
if(model == "sarar"){
var<-matrix(0,(ncol(RES$asyvar1)+2),(ncol(RES$asyvar1)+2))
- var[1,1]<- RES$rho.se
- var[2,2]<- RES$lambda.se
+ var[1,1]<- RES$lambda.se
+ var[2,2]<- RES$rho.se
var[((2+1):ncol(var)),((2+1):ncol(var))]<-RES$asyvar1
}
Modified: pkg/R/summary.splm.R
===================================================================
--- pkg/R/summary.splm.R 2013-03-22 21:22:40 UTC (rev 153)
+++ pkg/R/summary.splm.R 2013-03-25 22:24:28 UTC (rev 154)
@@ -26,10 +26,10 @@
colnames(object$CoefTable) <- c("Estimate")
}
- if (object$type == "fixed effects error" && object$method != "eigen") {
- lambda <- object$spat.coef
- object$lambda <- lambda
- }
+ # if (object$type == "fixed effects error" && object$method != "eigen") {
+ # lambda <- object$spat.coef
+ # object$lambda <- lambda
+ # }
if (object$type == "random effects GM" ) {
lambda <- object$rho
Modified: pkg/man/effects.splm.Rd
===================================================================
--- pkg/man/effects.splm.Rd 2013-03-22 21:22:40 UTC (rev 153)
+++ pkg/man/effects.splm.Rd 2013-03-25 22:24:28 UTC (rev 154)
@@ -55,11 +55,11 @@
data(Produc, package = "Ecdat")
data(usaww)
fm <- log(gsp) ~ log(pcap) + log(pc) + log(emp) + unemp
-lag <- spml(fm, data = Produc, listw = mat2listw(usaww), model="within", effect="twoways", lag=TRUE, method="eigen")
+lag <- spml(fm, data = Produc, listw = mat2listw(usaww), model="within", effect="twoways", lag=TRUE, method="eigen", Hess = TRUE)
summary(lag)
eff <- effects(lag)
print(eff)
-err <- spml(fm, data = Produc, listw = mat2listw(usaww), model="within", effect="time", spatial.error="b", method="eigen")
+err <- spml(fm, data = Produc, listw = mat2listw(usaww), model="within", effect="time", spatial.error="b", method="eigen", Hess = FALSE)
summary(err)
eff <- effects(err)
print(eff)
Modified: pkg/man/spml.Rd
===================================================================
--- pkg/man/spml.Rd 2013-03-22 21:22:40 UTC (rev 153)
+++ pkg/man/spml.Rd 2013-03-25 22:24:28 UTC (rev 154)
@@ -88,7 +88,7 @@
## the two standard specifications (SEM and SAR) one with FE
## and the other with RE:
## fixed effects panel with spatial errors
-fespaterr <- spml(fm, data = Produc, listw = mat2listw(usaww), model="within", spatial.error="b", Hess = TRUE)
+fespaterr <- spml(fm, data = Produc, listw = mat2listw(usaww), model="within", spatial.error="b", Hess = FALSE)
summary(fespaterr)
## random effects panel with spatial lag
respatlag <- spml(fm, data = Produc, listw = mat2listw(usaww), model="random", spatial.error="none", lag=TRUE)
Modified: pkg/man/write.effects.splm.Rd
===================================================================
--- pkg/man/write.effects.splm.Rd 2013-03-22 21:22:40 UTC (rev 153)
+++ pkg/man/write.effects.splm.Rd 2013-03-25 22:24:28 UTC (rev 154)
@@ -51,7 +51,7 @@
summary(lag)
eff <- effects(lag)
print(eff)
-err <- spml(fm, data = Produc, listw = mat2listw(usaww), model="within", effect="time", spatial.error="b", method="eigen")
+err <- spml(fm, data = Produc, listw = mat2listw(usaww), model="within", effect="time", spatial.error="b", method="eigen", Hess= FALSE)
summary(err)
eff <- effects(err)
write.effects.splm(eff)
More information about the Splm-commits
mailing list