[Splm-commits] r191 - in pkg: . R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Fri Mar 27 23:32:47 CET 2015
Author: the_sculler
Date: 2015-03-27 23:32:47 +0100 (Fri, 27 Mar 2015)
New Revision: 191
Modified:
pkg/NAMESPACE
pkg/R/sphtest.R
pkg/R/spreml.R
pkg/man/spgm.Rd
Log:
Fixed bug in balanced control
Modified: pkg/NAMESPACE
===================================================================
--- pkg/NAMESPACE 2014-12-20 00:35:54 UTC (rev 190)
+++ pkg/NAMESPACE 2015-03-27 22:32:47 UTC (rev 191)
@@ -3,6 +3,7 @@
importFrom(plm, plm.data)
importFrom(plm, plm)
importFrom(plm, pmodel.response)
+importFrom(plm, pdim)
importFrom(nlme, fdHess, lme)
import(spdep)
importFrom(ibdreg, pchibar)
Modified: pkg/R/sphtest.R
===================================================================
--- pkg/R/sphtest.R 2014-12-20 00:35:54 UTC (rev 190)
+++ pkg/R/sphtest.R 2015-03-27 22:32:47 UTC (rev 191)
@@ -1,14 +1,14 @@
-
-sphtest <- function (x, ...)
-{
- UseMethod("sphtest")
-}
-
-sphtest.formula <- function (x, data, index = NULL, listw, spatial.model = c("lag", "error", "sarar"), method = c("ML", "GM"), errors = c("KKP", "BSK"),...)
-{
- ## performs a Hausman test of a FE model with spatial lag or error
- ## against "alternative" with same spatial specification
+sphtest <- function (x, ...)
+{
+ UseMethod("sphtest")
+}
+sphtest.formula <- function (x, data, index = NULL, listw,
+ spatial.model = c("lag", "error", "sarar"),
+ method = c("ML", "GM"), errors = c("KKP", "BSK"),...) {
+ ## performs a Hausman test of a FE model with spatial lag or error
+ ## against "alternative" with same spatial specification
+
switch(match.arg(spatial.model),
lag = {
lag = TRUE
@@ -21,85 +21,68 @@
sarar = {
lag = TRUE
spatial.error = TRUE
- },
-
- )
+ })
-errors <- match.arg(errors)
+ errors <- match.arg(errors)
x0 <- update(x, .~.-1)
- method <- switch(match.arg(method),
-
- ML = {
-
- femod <- spml(x, data = data, index = index, listw = listw, lag = lag, spatial.error = spatial.error, model = "within", errors = errors)
-
- remod <- spml(x, data = data, index = index, listw = listw, lag = lag, spatial.error = spatial.error, model = "random", errors = errors)
-
- },
-
- GM = {
-
- femod <- spgm(x, data = data, index = index, listw = listw, lag = lag, spatial.error = spatial.error, model = "within", moments = "fullweights")
-
- remod <- spgm(x, data = data, index = index, listw = listw, lag = lag, spatial.error = spatial.error, model = "random", moments = "fullweights")
-
- },
+ method <- switch(match.arg(method),
+ ML = {
+ femod <- spml(x, data = data, index = index, listw = listw, lag = lag,
+ spatial.error = spatial.error, model = "within", errors = errors)
+ remod <- spml(x, data = data, index = index, listw = listw, lag = lag,
+ spatial.error = spatial.error, model = "random", errors = errors)
+ },
+ GM = {
+ femod <- spgm(x, data = data, index = index, listw = listw, lag = lag,
+ spatial.error = spatial.error, model = "within", moments = "fullweights")
+ remod <- spgm(x, data = data, index = index, listw = listw, lag = lag,
+ spatial.error = spatial.error, model = "random", moments = "fullweights")
+ },
+ stop("\n Unknown method"))
- stop("\n Unknown method")
- )
-
-
- sphtest(femod, remod, ...)
-}
-
-sphtest.splm <- function (x, x2, ...){
+ return(sphtest(femod, remod, ...))
+ }
+sphtest.splm <- function (x, x2, ...){
+ ## check that the models have the same specification but different effects
+ if (!all.equal(x$legacy, x2$legacy)) stop("The models are different")
+ if(x$ef.sph == x2$ef.sph) stop("Effects should be different")
- ## check that the models have the same specification but different effects
-
-if (!all.equal(x$legacy, x2$legacy)) stop("The model are different")
-if(x$ef.sph == x2$ef.sph) stop("Effects should be different")
-
ran <- match("random", c(x$ef.sph, x2$ef.sph))
-
-if(ran == 1){
-
+ if(ran == 1){
xwith <- x2
xbetw <- x
-
- }
-
-if(ran == 2){
-
+ }
+ if(ran == 2){
xwith <- x
xbetw <- x2
+ }
- }
-
- ## test on coefficients (excluding SAR)
- ## model order is irrelevant
+ ## test on coefficients (excluding SAR)
+ ## model order is irrelevant
- tc <- match(names(coef(xwith)), names(coef(xbetw)) )
+ tc <- match(names(coef(xwith)), names(coef(xbetw)) )
- coef.wi <- coef(xwith)
- coef.re <- coef(xbetw)[tc]
- vcov.wi <- xwith$vcov
+ coef.wi <- coef(xwith)
+ coef.re <- coef(xbetw)[tc]
+ vcov.wi <- xwith$vcov
vcov.re <- xbetw$vcov[tc,tc]
-
- dbeta <- coef.wi - coef.re
- df <- length(dbeta)
- dvcov <- vcov.re - vcov.wi
- stat <- abs(t(dbeta) %*% solve(dvcov) %*% dbeta)
- pval <- pchisq(stat, df = df, lower.tail = FALSE)
- names(stat) <- "chisq"
- parameter <- df
- names(parameter) <- "df"
- data.name <- paste(deparse(x$call$formula))
- alternative <- "one model is inconsistent"
- res <- list(statistic = stat, p.value = pval, parameter = parameter,
- method = "Hausman test for spatial models", data.name = data.name, alternative = alternative)
- class(res) <- "htest"
- return(res)
-}
+
+ dbeta <- coef.wi - coef.re
+ df <- length(dbeta)
+ dvcov <- vcov.re - vcov.wi
+ stat <- abs(t(dbeta) %*% solve(dvcov) %*% dbeta)
+ pval <- pchisq(stat, df = df, lower.tail = FALSE)
+ names(stat) <- "chisq"
+ parameter <- df
+ names(parameter) <- "df"
+ data.name <- paste(deparse(x$call$formula))
+ alternative <- "one model is inconsistent"
+ res <- list(statistic = stat, p.value = pval, parameter = parameter,
+ method = "Hausman test for spatial models",
+ data.name = data.name, alternative = alternative)
+ class(res) <- "htest"
+ return(res)
+}
Modified: pkg/R/spreml.R
===================================================================
--- pkg/R/spreml.R 2014-12-20 00:35:54 UTC (rev 190)
+++ pkg/R/spreml.R 2015-03-27 22:32:47 UTC (rev 191)
@@ -11,8 +11,6 @@
#require(maxLik)
trace <- as.numeric(!quiet)
- if (pvar)
- print("<implement pvar>")
if (!is.null(index)) {
#require(plm)
data <- plm.data(data, index)
@@ -24,7 +22,7 @@
if (!is.matrix(w)) {
if ("listw" %in% class(w)) {
# require(spdep)
- # w <- listw2mat(w)
+ w <- listw2mat(w)
}
else {
stop("w has to be either a 'matrix' or a 'listw' object")
@@ -51,7 +49,7 @@
nT <- length(ind)
# if (dim(w)[[1]] != n)
# stop("Non conformable spatial weights") # temporary: adapt to listw or mat
- balanced <- n * t == nT
+ balanced <- pdim(pmod)$balanced
if (!balanced)
stop("Estimation method unavailable for unbalanced panels")
sv.length <- switch(match.arg(errors), semsrre = 3, semsr = 2,
Modified: pkg/man/spgm.Rd
===================================================================
--- pkg/man/spgm.Rd 2014-12-20 00:35:54 UTC (rev 190)
+++ pkg/man/spgm.Rd 2015-03-27 22:32:47 UTC (rev 191)
@@ -66,7 +66,7 @@
panel data model with an additional endogeneous variable. The function then uses \code{ivsplm}
to perform the Instrumental Variables and two-stage least squares for panel data model. \code{method = "w2sls"}
corresponds to the fixed effects estimator, \code{method = "b2sls"} to the between effects model,
-\code{method = "g2sls"} to the GLS random effects model, and \code{method = "ec2sls"} to teh Baltagi's
+\code{method = "g2sls"} to the GLS random effects model, and \code{method = "ec2sls"} to the Baltagi's
EC2SLS.
When \code{spatial.error} is \code{TRUE} and \code{lag} is \code{FALSE} the model is one with spatially autocorrelated
More information about the Splm-commits
mailing list