[Splm-commits] r200 - in pkg: . R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Nov 25 15:59:27 CET 2015
Author: gpiras
Date: 2015-11-25 15:59:27 +0100 (Wed, 25 Nov 2015)
New Revision: 200
Modified:
pkg/ChangeLog
pkg/DESCRIPTION
pkg/R/bsktest.R
pkg/R/fixed_effects.R
pkg/R/spfeml.R
pkg/R/spml.R
pkg/man/bsktest.Rd
Log:
changer in CLMmu
Modified: pkg/ChangeLog
===================================================================
--- pkg/ChangeLog 2015-09-09 16:47:05 UTC (rev 199)
+++ pkg/ChangeLog 2015-11-25 14:59:27 UTC (rev 200)
@@ -1,3 +1,7 @@
+
+Changes in Version 1.3-11
+ o Fixed bsktest when test is “CLMmu”. November 25, 2015 See email from Luc Anselin
+
Changes in Version 1.3-10
o Fixed a couple of degenerating matrices when K=1 in likelihoodsFE.R by adding ',drop=FALSE' to subsetting '['
Modified: pkg/DESCRIPTION
===================================================================
--- pkg/DESCRIPTION 2015-09-09 16:47:05 UTC (rev 199)
+++ pkg/DESCRIPTION 2015-11-25 14:59:27 UTC (rev 200)
@@ -1,7 +1,7 @@
Package: splm
Title: Econometric Models for Spatial Panel Data
-Version: 1.3-10
-Date: 2015-09-09
+Version: 1.3-11
+Date: 2015-11-25
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"))
Author: Giovanni Millo [aut, cre],
Modified: pkg/R/bsktest.R
===================================================================
--- pkg/R/bsktest.R 2015-09-09 16:47:05 UTC (rev 199)
+++ pkg/R/bsktest.R 2015-11-25 14:59:27 UTC (rev 200)
@@ -17,9 +17,8 @@
`bsktest.formula` <-
function(x, data, index=NULL, listw,
test=c("LMH","LM1","LM2","CLMlambda","CLMmu"),
- standardize=TRUE, ...){
+ standardize=TRUE, method = NULL, ...){
-
switch(match.arg(test), LM1 = {
bsk = slm1test(x, data, index, listw, standardize, ...)
@@ -38,7 +37,7 @@
}, CLMmu = {
- bsk = clmmtest(x, data, index, listw, ...)
+ bsk = clmmtest(x, data, index, listw, method = method,...)
})
@@ -532,15 +531,11 @@
`clmmtest` <-
-function(formula, data, index=NULL, listw, ...){
+function(formula, data, index=NULL, listw, method, ...){
+
+ml <- spfeml(formula=formula, data=data, index=index, listw=listw, model="error", effects="pooling", method = method)
-## print("uso questa")
-
-ml <- spfeml(formula=formula, data=data, index=index, listw=listw, model="error", effects="pooled")
- ## spml(formula, data=data, index=index, listw, errors = "BSK", effects = "fixed", lag = FALSE, spatial.error = TRUE)
-
if(!is.null(index)) {
- #require(plm)
data <- plm.data(data, index)
}
@@ -588,9 +583,6 @@
eme<-unlist(tapply(eML,inde,vc))
-# eme<-tapply(eML,inde1,mean)
-# emme<-eML - rep(eme,T)
-#
sigmav2<-crossprod(eML,eme)/(N*T)
sigmav4<-sigmav2^2
Modified: pkg/R/fixed_effects.R
===================================================================
--- pkg/R/fixed_effects.R 2015-09-09 16:47:05 UTC (rev 199)
+++ pkg/R/fixed_effects.R 2015-11-25 14:59:27 UTC (rev 200)
@@ -76,7 +76,7 @@
FE.out<-list(res.tfe=res.tfe, res.se.tfe=res.se.tfe, res.sfe=res.sfe, res.se.sfe=res.se.sfe, intercept=intercept, res.se.con=res.se.con,xhat=xhat,N.vars=N.vars,res.e=res.e)
}
-if (effects=="pooled") {
+if (effects=="pooling") {
xhat <- x %*% as.matrix(beta)
res.e <- y - xhat
FE.out<-list(xhat=xhat,N.vars=k,res.e=res.e)
@@ -171,7 +171,7 @@
res.e <- y - xhat - lambda * wy
FE.out<-list(res.tfe=res.tfe, res.se.tfe=res.se.tfe, res.sfe=res.sfe, res.se.sfe=res.se.sfe, intercept=intercept, res.se.con=res.se.con,xhat=xhat,N.vars=N.vars,res.e=res.e)
}
-if (effects=="pooled") {
+if (effects=="pooling") {
xhat <- x %*% as.matrix(beta)
res.e <- y - xhat - lambda* wy
FE.out<-list(xhat=xhat,N.vars=k,res.e=res.e)
Modified: pkg/R/spfeml.R
===================================================================
--- pkg/R/spfeml.R 2015-09-09 16:47:05 UTC (rev 199)
+++ pkg/R/spfeml.R 2015-11-25 14:59:27 UTC (rev 200)
@@ -1,6 +1,5 @@
-spfeml<-function(formula, data=list(), index=NULL, listw, listw2 = NULL, na.action, model = c("lag","error", "sarar"), effects = c('spfe','tpfe','sptpfe'), method="eigen", quiet = TRUE, zero.policy = NULL, interval1 = NULL, interval2 = NULL, trs1 = NULL, trs2 = NULL, tol.solve = 1e-10, control = list(), legacy = FALSE, llprof = NULL, cl = NULL, Hess = FALSE, LeeYu = FALSE, ...){
+spfeml<-function(formula, data=list(), index=NULL, listw, listw2 = NULL, na.action, model = c("lag","error", "sarar"), effects = c('spfe','tpfe','sptpfe','pooling'), method= "eigen", quiet = TRUE, zero.policy = NULL, interval1 = NULL, interval2 = NULL, trs1 = NULL, trs2 = NULL, tol.solve = 1e-10, control = list(), legacy = FALSE, llprof = NULL, cl = NULL, Hess = FALSE, LeeYu = FALSE, ...){
-
# timings <- list()
# .ptime_start <- proc.time()
@@ -47,7 +46,7 @@
#check the effects
-effects<-match.arg(effects)
+# effects<-match.arg(effects)
## check
@@ -245,7 +244,10 @@
for (i in 1:(k)) xmm[,i]<-rep(mean(x[,i]),NT)
xt<-x - xsm - xtm + xmm
}
-
+if(effects == 'pooling') {
+ yt <- y
+ xt <- x
+}
wyt<-unlist(tapply(yt,inde, function(u) lag.listw(listw,u), simplify=TRUE))
Modified: pkg/R/spml.R
===================================================================
--- pkg/R/spml.R 2015-09-09 16:47:05 UTC (rev 199)
+++ pkg/R/spml.R 2015-11-25 14:59:27 UTC (rev 200)
@@ -11,16 +11,6 @@
## check class(listw)
checklw <- function(x) {
-# if(model == "within"){
-
- # if("matrix" %in% class(x)) x <- Matrix(x)
- # if("listw" %in% class(x)) x <- listw2dgCMatrix(x)
- # if("Matrix" %in% class(x)) x <- x
-
- # else stop("'listw' has to be 'listw', 'matrix', or 'Matrix' when model is within")
-
- # }
-# else{
if(!("listw" %in% class(x))) {
if("matrix" %in% class(x)) {
@@ -39,15 +29,30 @@
## dimensions check is moved downstream
+##added by gpiras on November 25, 2015 for consistency with the test bsk
+
+
+if(model == 'pooling' && spatial.error == 'b' && lag ==FALSE){
+
+ res <- spfeml(formula=formula, data=data, index=index,
+ listw=listw, listw2=listw2, na.action,
+ model = 'error', effects = "pooling",
+ cl=cl, ...)
+}
+else{
switch(match.arg(model), within={
if(lag) {
model <- switch(match.arg(spatial.error), b="sarar",
kkp="sarar", none="lag")
} else {
+
+
model <- switch(match.arg(spatial.error), b="error",
kkp="error", none="plm")
+
+
if(model == "plm") stop("No spatial component, use plm instead")
}
effects <- switch(match.arg(effect), individual="spfe",
@@ -75,6 +80,7 @@
lag=lag, errors=errors, cl=cl, ...)
})
+}
return(res)
}
Modified: pkg/man/bsktest.Rd
===================================================================
--- pkg/man/bsktest.Rd 2015-09-09 16:47:05 UTC (rev 199)
+++ pkg/man/bsktest.Rd 2015-11-25 14:59:27 UTC (rev 200)
@@ -11,7 +11,7 @@
bsktest(x,...)
\method{bsktest}{formula}(x, data, index=NULL, listw,
test=c("LMH","LM1","LM2","CLMlambda","CLMmu"),
-standardize=TRUE, ...)
+standardize=TRUE, method = NULL, ...)
}
\arguments{
\item{x}{a \code{formula}}
@@ -21,7 +21,8 @@
\item{listw}{a \code{listw} representing the spatial structure}
\item{test}{one of \code{c("LMH","LM1","LM2","CLMlambda","CLMmu")}, the
test to be performed}
-\item{standardize}{whether to standardize the test statistic or not (applies only to LM1 and LM2)}
+\item{standardize}{whether to standardize the test statistic or not (applies only to LM1 and LM2)}
+\item{method}{select a method for ML in "CLMmu". the default is "eigen"}
\item{...}{additional arguments to be passed}
}
More information about the Splm-commits
mailing list