[Splm-commits] r228 - in pkg: . R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Thu May 20 11:20:44 CEST 2021
Author: gpiras
Date: 2021-05-20 11:20:44 +0200 (Thu, 20 May 2021)
New Revision: 228
Modified:
pkg/DESCRIPTION
pkg/R/ivplm.b2sls.R
pkg/R/ivplm.ec2sls.R
pkg/R/ivplm.g2sls.R
pkg/R/ivplm.w2sls.R
pkg/R/ivsplm.R
pkg/R/print.splm.R
pkg/R/print.summary.splm.R
pkg/R/spgm.R
pkg/R/summary.splm.R
pkg/man/spgm.Rd
Log:
printing issues for spatial GM resolved
Modified: pkg/DESCRIPTION
===================================================================
--- pkg/DESCRIPTION 2021-03-16 09:20:02 UTC (rev 227)
+++ pkg/DESCRIPTION 2021-05-20 09:20:44 UTC (rev 228)
@@ -1,7 +1,7 @@
Package: splm
Title: Econometric Models for Spatial Panel Data
Version: 1.5-2
-Date: 2020-05-04
+Date: 2021-05-05
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"),
person("Roger", "Bivand", role = c("ctb"), email = "Roger.Bivand at nhh.no", comment=c(ORCID="0000-0003-2392-6140")))
Modified: pkg/R/ivplm.b2sls.R
===================================================================
--- pkg/R/ivplm.b2sls.R 2021-03-16 09:20:02 UTC (rev 227)
+++ pkg/R/ivplm.b2sls.R 2021-05-20 09:20:44 UTC (rev 228)
@@ -36,6 +36,8 @@
res <-spgm.tsls(sqrt(T)*as.matrix(ybetween), sqrt(T)*endogbetween, sqrt(T)*Xbetween, sqrt(T)*as.matrix(Hbetween) )
res$Hbetween <- Hbetween
+res$type <- "b2sls model without spatial lag"
+
}
else{
@@ -70,6 +72,8 @@
res<-spgm.tsls(sqrt(T)*as.matrix(ybetween), sqrt(T)*as.matrix(wybetween), sqrt(T)*Xbetween, sqrt(T)*as.matrix(Hbetween) )
res$Hbetween <- Hbetween
+res$type <- "Spatial b2sls model"
+
}
else{
@@ -124,6 +128,7 @@
res<-spgm.tsls(sqrt(T)*as.matrix(ybetween), sqrt(T)*endogbetween, sqrt(T)*Xbetween, sqrt(T)*as.matrix(Hbetween) )
res$Hbetween <- Hbetween
+res$type <- "Spatial b2sls model with additional endogenous variables"
}
}
Modified: pkg/R/ivplm.ec2sls.R
===================================================================
--- pkg/R/ivplm.ec2sls.R 2021-03-16 09:20:02 UTC (rev 227)
+++ pkg/R/ivplm.ec2sls.R 2021-05-20 09:20:44 UTC (rev 228)
@@ -72,7 +72,7 @@
res<-spgm.tsls(ystar, endogstar, xstar, Hinst = Hins, instr = TRUE )
res$sigma1<-sigma21
res$sigmav<-sigma2v1
-
+res$type <- "ec2sls model without spatial lag"
}
@@ -122,6 +122,7 @@
res$sigma1 <- sigma21
res$sigmav <- sigma2v1
+res$type <- "Spatial ec2sls model"
}
else{
@@ -192,8 +193,8 @@
res$sigma1<- sigma21
res$sigma1<- sigma2v1
+res$type <- "Spatial ec2sls model with additional endogenous variables"
-
}
}
Modified: pkg/R/ivplm.g2sls.R
===================================================================
--- pkg/R/ivplm.g2sls.R 2021-03-16 09:20:02 UTC (rev 227)
+++ pkg/R/ivplm.g2sls.R 2021-05-20 09:20:44 UTC (rev 228)
@@ -72,7 +72,7 @@
res<-spgm.tsls(ystar, endogstar, xstar, Hstar )
res$sigma1<-sigma21
res$sigmav<-sigma2v1
-
+res$type <- "g2sls model without spatial lag"
}
else{
@@ -121,7 +121,7 @@
res$sigma1 <- sigma21
res$sigmav <- sigma2v1
-
+res$type <- "Spatial g2sls model"
}
@@ -181,6 +181,7 @@
res$sigma1<- sigma21
res$sigma1<- sigma2v1
+res$type <- "Spatial g2sls model with additional endogenous variables"
}
}
Modified: pkg/R/ivplm.w2sls.R
===================================================================
--- pkg/R/ivplm.w2sls.R 2021-03-16 09:20:02 UTC (rev 227)
+++ pkg/R/ivplm.w2sls.R 2021-05-20 09:20:44 UTC (rev 228)
@@ -35,8 +35,8 @@
sigma2v1<- res$sse/ ((N * (T -1)) - ncol(as.matrix(Xwithin)) - ncol(endogwithin))
res$sigmav<- sigma2v1
res$Hwithin <- Hwithin
+res$type <- "w2sls model without spatial lag"
-
}
else{
@@ -73,6 +73,7 @@
sigma2v1<- res$sse / ((N * (T -1)) - ncol(as.matrix(Xwithin)) - 1)
res$sigmav <- sigma2v1
res$Hwithin <- Hwithin
+res$type <- "Spatial w2sls model"
}
else{
@@ -130,6 +131,7 @@
sigma2v1<- res$sse / ((N * (T -1)) - ncol(as.matrix(Xwithin)) - ncol(endogwithin))
res$sigmav <- sigma2v1
res$Hwithin <- Hwithin
+res$type <- "Spatial w2sls model with additional endogenous variables"
}
}
Modified: pkg/R/ivsplm.R
===================================================================
--- pkg/R/ivsplm.R 2021-03-16 09:20:02 UTC (rev 227)
+++ pkg/R/ivsplm.R 2021-05-20 09:20:44 UTC (rev 228)
@@ -1,4 +1,8 @@
-ivsplm <-function(formula,data=list(), index=NULL, endog = NULL, instruments= NULL, method = c("w2sls", "b2sls", "g2sls", "ec2sls"), lag = FALSE, listw = listw, effects = NULL, lag.instruments = FALSE){
+ivsplm <-function(formula,data=list(), index=NULL,
+ endog = NULL, instruments= NULL,
+ method = c("w2sls", "b2sls", "g2sls", "ec2sls"),
+ lag = FALSE, listw = listw,
+ effects = NULL, lag.instruments = FALSE){
# If the user do not make any choice in terms of method, when effects is Fixed the function calculates the w2sls. On the other hand, when effects is random the function calculates the ec2sls
if(length(method) !=1 && effects == "fixed") method <- "w2sls"
@@ -95,16 +99,28 @@
switch(method,
w2sls = {
- result <- ivplm.w2sls(Y = y, X = x, H = instruments, endog = endog, lag = lag, listw = Ws, lag.instruments = lag.instruments, T = T, N = N, NT = NT)
+ result <- ivplm.w2sls(Y = y, X = x, H = instruments, endog = endog,
+ lag = lag, listw = Ws,
+ lag.instruments = lag.instruments,
+ T = T, N = N, NT = NT)
},
b2sls = {
- result <- ivplm.b2sls(Y = y,X =x, H = instruments, endog = endog, lag = lag, listw = Ws, lag.instruments = lag.instruments, T = T, N = N, NT = NT)
+ result <- ivplm.b2sls(Y = y,X =x, H = instruments, endog = endog,
+ lag = lag, listw = Ws,
+ lag.instruments = lag.instruments,
+ T = T, N = N, NT = NT)
},
ec2sls = {
- result <- ivplm.ec2sls(Y = y,X =x, H = instruments, endog = endog, lag = lag, listw = Ws, lag.instruments = lag.instruments, T = T, N = N, NT = NT)
+ result <- ivplm.ec2sls(Y = y, X =x, H = instruments, endog = endog,
+ lag = lag, listw = Ws,
+ lag.instruments = lag.instruments,
+ T = T, N = N, NT = NT)
},
g2sls = {
- result <-ivplm.g2sls(Y = y,X =x, H = instruments, endog = endog, lag = lag, listw = Ws, lag.instruments = lag.instruments, T = T, N = N, NT = NT )
+ result <-ivplm.g2sls(Y = y,X =x, H = instruments, endog = endog,
+ lag = lag, listw = Ws,
+ lag.instruments = lag.instruments,
+ T = T, N = N, NT = NT )
},
stop("...\nUnknown method\n"))
@@ -115,7 +131,5 @@
result$listw_style <- NULL
result$call <- match.call()
-
-class(result) <- "stsls"
result
}
Modified: pkg/R/print.splm.R
===================================================================
--- pkg/R/print.splm.R 2021-03-16 09:20:02 UTC (rev 227)
+++ pkg/R/print.splm.R 2021-05-20 09:20:44 UTC (rev 228)
@@ -1,35 +1,37 @@
-`print.splm` <-
-function(x, digits = max(3, getOption("digits") - 3), ...) {
- cat("\nCall:\n", deparse(x$call), "\n\n", sep = "")
- if (length(coef(x))) {
- cat("Coefficients:\n")
- print.default(format(coef(x), digits = digits), print.gap = 2,
- quote = FALSE)
- } else {
- cat("No coefficients\n")
- }
-
- ## add printing of error variance parameters
- cat("\n")
- ec <- x$errcomp
- if (length(ec)) {
- cat("Error covariance parameters:\n")
- print.default(format(ec, digits = digits), print.gap = 2,
- quote = FALSE)
- }
-
- 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)
-}
-
+`print.splm` <-
+function(x, digits = max(3, getOption("digits") - 3), ...) {
+
+
+ cat("\nCall:\n", deparse(x$call), "\n\n", sep = "")
+ if (length(coef(x))) {
+ cat("Coefficients:\n")
+ print.default(format(coef(x), digits = digits), print.gap = 2,
+ quote = FALSE)
+ } else {
+ cat("No coefficients\n")
+ }
+
+ ## add printing of error variance parameters
+ cat("\n")
+ ec <- x$errcomp
+ if (length(ec)) {
+ cat("Error covariance parameters:\n")
+ print.default(format(ec, digits = digits), print.gap = 2,
+ quote = FALSE)
+ }
+
+ 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)
+}
+
Modified: pkg/R/print.summary.splm.R
===================================================================
--- pkg/R/print.summary.splm.R 2021-03-16 09:20:02 UTC (rev 227)
+++ pkg/R/print.summary.splm.R 2021-05-20 09:20:44 UTC (rev 228)
@@ -1,13 +1,16 @@
`print.summary.splm` <- function(x, digits=max(3, getOption("digits") - 2),
width=getOption("width"), ...) {
- ## manage model description
+ ## manage model description (changed BY GP 081321)
if(grepl("random", x$type)) {
## "random" models by spreml() have a more complicated description
+
m.des <- x$type.des
} else {
+
m.des <- paste("Spatial panel", x$type,"model\n")
}
+ if (is.character(x$est.meth)) m.des <- x$type
cat(paste(m.des, "\n"))
## print call
@@ -21,6 +24,28 @@
print(sumres(x))
## if model is of 'random' type ex spreml():
+ if(is.character(x$est.meth)){
+
+ if(is.numeric(x$lambda)) {
+ cat("\nEstimated spatial coefficient, variance components and theta:\n")
+ print(x$lambda)
+ }
+
+ ## print spatial lag coefficient for 'random' models
+ if("lambda" %in% dimnames(x$CoefTable)[[1]]) {
+ cat("\nSpatial autoregressive coefficient:\n")
+ printCoefmat(x$CoefTable["lambda", , drop=FALSE], digits=digits, signif.legend=FALSE)
+ }
+
+ ## print betas (w/o spatial coefs)
+ cat("\nCoefficients:\n")
+ spat.nam <- dimnames(x$CoefTable)[[1]] %in% c("rho","lambda")
+ printCoefmat(x$CoefTable[!spat.nam, , drop=FALSE], digits=digits)
+ cat("\n")
+
+ }
+
+ else{
if(grepl("random", x$type)) {
## print error components' table for 'random' models
@@ -69,6 +94,7 @@
cat("\n")
}
+ }
invisible(x)
}
Modified: pkg/R/spgm.R
===================================================================
--- pkg/R/spgm.R 2021-03-16 09:20:02 UTC (rev 227)
+++ pkg/R/spgm.R 2021-05-20 09:20:44 UTC (rev 228)
@@ -1,7 +1,10 @@
`spgm` <-
function(formula, data=list(), index=NULL, listw =NULL, listw2 = NULL,
- model=c("within","random"), lag = FALSE, spatial.error=TRUE,
- moments = c("initial", "weights", "fullweights"), endog = NULL, instruments= NULL, lag.instruments = FALSE, verbose = FALSE, method = c("w2sls", "b2sls", "g2sls", "ec2sls"), control = list(), optim.method = "nlminb", pars = NULL){
+ model = c("within","random"), lag = FALSE, spatial.error=TRUE,
+ moments = c("initial", "weights", "fullweights"), endog = NULL,
+ instruments= NULL, lag.instruments = FALSE, verbose = FALSE,
+ method = c("w2sls", "b2sls", "g2sls", "ec2sls"), control = list(),
+ optim.method = "nlminb", pars = NULL){
## translation for uniformity
effects <- switch(match.arg(model), within="fixed", random="random")
@@ -41,8 +44,9 @@
-
-if(model == "fixed" & !isTRUE(attr(terms(formula), "intercept")) ) formula <- as.formula(paste(attr(terms(formula),"variables")[1+attr(terms(formula),"response")], paste(attr(terms(formula),"term.labels"), collapse="+"), sep="~"))
+if(length(model) !=1) model <- "within"
+if((model == "within") && ((attr(terms(formula), "intercept"))==1 ))
+ formula <- as.formula(paste(attr(terms(formula),"variables")[1+attr(terms(formula),"response")], paste(attr(terms(formula),"term.labels"), collapse="+"), sep="~"))
@@ -50,9 +54,12 @@
cl<-match.call()
if(!spatial.error){
- results<-ivsplm(formula = formula, effects = effects, data=data, index = index, endog = endog, instruments = instruments, method = method, lag = lag, listw = listw, lag.instruments = lag.instruments)
+ results<-ivsplm(formula = formula, effects = effects,
+ data=data, index = index, endog = endog,
+ instruments = instruments, method = method,
+ lag = lag, listw = listw, lag.instruments = lag.instruments)
- results$type <- "lag GM"
+
}
@@ -60,17 +67,31 @@
else{
-if(!lag) results <- sperrorgm(formula = formula, data = data, index = index, listw = listw, moments = moments, endog = endog, instruments = instruments, verbose = verbose, effects = effects, control = control, lag.instruments = lag.instruments, optim.method = optim.method, pars = pars)
+if(!lag) results <- sperrorgm(formula = formula, data = data, index = index,
+ listw = listw, moments = moments, endog = endog,
+ instruments = instruments, verbose = verbose,
+ effects = effects, control = control,
+ lag.instruments = lag.instruments,
+ optim.method = optim.method, pars = pars)
#, initial.GMerror = initial.GMerror
-else results <- spsarargm(formula = formula, data = data, index = index, listw = listw, listw2 = listw2, moments = moments, lag = lag, endog = endog, instruments = instruments, verbose = verbose, effects = effects, control = control, lag.instruments = lag.instruments, optim.method = optim.method, pars = pars, twow = twow)
+else results <- spsarargm(formula = formula, data = data, index = index,
+ listw = listw, listw2 = listw2,
+ moments = moments, lag = lag, endog = endog,
+ instruments = instruments, verbose = verbose,
+ effects = effects, control = control,
+ lag.instruments = lag.instruments,
+ optim.method = optim.method, pars = pars, twow = twow)
}
-
+#results$lag <- lag
+#results$error <- error
results$call <- cl
results$ef.sph<- effects
results$legacy <- c(lag, spatial.error)
results$endog <- endog
+results$est.meth <- "GM"
+class(results) <- c("splm")
results
}
@@ -161,7 +182,7 @@
- result <- list(coefficients = biv, var = varb, sse = sse,
+ result <- list(coefficients = biv, vcov = varb, sse = sse,
residuals = as.numeric(ehat), df = df, Zp = Zp, readout = readout)
result
@@ -169,7 +190,13 @@
-sperrorgm<-function(formula, data = list(), index = NULL, listw , moments = c("initial","weights","fullweights"), endog = NULL, instruments = NULL, verbose = FALSE, effects = c("fixed","random"), control = list(), lag.instruments = lag.instruments, optim.method = optim.method, pars = pars ){
+sperrorgm<-function(formula, data = list(),
+ index = NULL, listw ,
+ moments = c("initial","weights","fullweights"),
+ endog = NULL, instruments = NULL, verbose = FALSE,
+ effects = c("fixed","random"), control = list(),
+ lag.instruments = lag.instruments,
+ optim.method = optim.method, pars = pars ){
effects<-match.arg(effects)
moments<-match.arg(moments)
@@ -224,7 +251,7 @@
if(!is.null(endog)){
endog <- as.matrix(lm(endog, data, na.action = na.fail, method = "model.frame"))
-if(is.null(instruments)) stop("No instruments specified for the additional variable")
+if(is.null(instruments)) stop("No instruments specified for the additional endogenous variable")
else instruments <- as.matrix(lm(instruments, data, na.action = na.fail, method = "model.frame"))
}
@@ -253,7 +280,9 @@
result <- lm(ywithin ~ Xwithin[,-del] -1)
}
-else result <- ivplm.w2sls(Y = y, X =x, H = instruments, endog = endog, lag = FALSE, listw = Ws, lag.instruments = lag.instruments, T, N, NT)
+else result <- ivplm.w2sls(Y = y, X =x, H = instruments, endog = endog,
+ lag = FALSE, listw = Ws,
+ lag.instruments = lag.instruments, T, N, NT)
res <- as.matrix(residuals(result))
@@ -270,9 +299,12 @@
pars <- c(r.init, v.init)
}
-if (optim.method == "nlminb") estim1 <- nlminb(pars, arg, v = Gg, verbose = verbose, control = control, lower=c(-0.999,0), upper=c(0.999, Inf))
+if (optim.method == "nlminb") estim1 <- nlminb(pars, arg, v = Gg,
+ verbose = verbose, control = control,
+ lower=c(-0.999,0), upper=c(0.999, Inf))
-else estim1 <- optim(pars, arg, v = Gg, verbose = verbose, control = control, method = optim.method)
+else estim1 <- optim(pars, arg, v = Gg, verbose = verbose, control = control,
+ method = optim.method)
finrho=estim1$par[1]
finsigmaV=estim1$par[2]
@@ -294,8 +326,8 @@
if (is.null(endog)){
-result<-lm(as.matrix(yf)~as.matrix(xf)-1)
-vcov<-vcov(result)
+result <- lm(as.matrix(yf)~as.matrix(xf)-1)
+vcov <- vcov(result)
betaGLS <- coefficients(result)
names(betaGLS)<-colnames(xf)
@@ -305,14 +337,12 @@
colnames(errcomp)<-"Estimate"
model.data <- data.frame(cbind(y,x[,-1]))
- type <- "fixed effects GM"
+ type <- "Spatial fixed effects error model (GM estimation)"
spmod <- list(coefficients= betaGLS, errcomp=errcomp,
vcov=vcov, vcov.errcomp=NULL,
residuals=residuals(result), fitted.values=(y-as.vector(residuals(result))),
- sigma2=crossprod(residuals(result))/result$df.residual, type=type, rho=errcomp, model=model.data, logLik=NULL)
- class(spmod) <- "splm"
- return(spmod)
-
+ sigma2=crossprod(residuals(result))/result$df.residual,
+ type=type, rho=errcomp, model=model.data, logLik=NULL)
}
@@ -320,9 +350,8 @@
endogl <- as.matrix(Ws %*% endog)
endogt <- endog - finrho* endogl
+ endogf<-panel.transformations(endogt,indic, type= "within")
-endogf<-panel.transformations(endogt,indic, type= "within")
-
instwithin <- result$Hwithin
# instwithin<-cbind(xf, wxf, instwithin)
instwithin<-cbind(xf, instwithin)
@@ -344,19 +373,18 @@
names(betaGLS) <- nam.beta
errcomp<-rbind(finrho,finsigmaV)
nam.errcomp <- c("rho","sigma^2_v")
+ rownames(errcomp) <- nam.errcomp
+ colnames(errcomp)<-"Estimate"
model.data <- data.frame(cbind(y,x[,-1]))
- type <- "fixed effects GM"
+ type <- "Spatial fixed effects error model with additional endogenous variables (GM estimation)"
spmod <- list(coefficients=betaGLS, errcomp= errcomp,
vcov=covbeta, vcov.errcomp=NULL,
residuals=as.vector(egls), fitted.values=fv,
- sigma2=SGLS, type=type, rho=errcomp[1], model=model.data, logLik=NULL)
- class(spmod) <- "splm"
- return(spmod)
-
-
+ sigma2=SGLS, type=type, rho=errcomp, model=model.data, sigmav = errcomp[2] , logLik=NULL)
+
}
- return(spmod)
+
},
random = {
@@ -377,8 +405,12 @@
}
- if (optim.method == "nlminb") estim1 <- nlminb(pars, arg, v = Gg, verbose = verbose, control = control, lower=c(-0.999,0), upper=c(0.999,Inf))
-else estim1 <- optim(pars, arg, v = Gg, verbose = verbose, control = control, method = optim.method)
+ if (optim.method == "nlminb") estim1 <- nlminb(pars, arg, v = Gg,
+ verbose = verbose,
+ control = control,
+ lower=c(-0.999,0), upper=c(0.999,Inf))
+else estim1 <- optim(pars, arg, v = Gg, verbose = verbose,
+ control = control, method = optim.method)
urub<-res- estim1$par[1]*Gg$ub
Q1urQ1ub<-Gg$Q1u - estim1$par[1]*Gg$Q1ub
@@ -511,7 +543,7 @@
ytmt<-tapply(yt, indic, mean)
ytNT<-rep(ytmt, T)
-yf<-(yt - theta*ytNT)
+yf<-(yt - as.numeric(theta)*ytNT)
dm1<- function(A) rep(unlist(tapply(A, indic, mean, simplify=TRUE)), T)
xtNT<-apply(xt,2,dm1)
@@ -540,14 +572,13 @@
colnames(errcomp)<-"Estimate"
model.data <- data.frame(cbind(y,x))
sigma2 <- SGLS
- type <- "random effects GM"
+ type <- "Spatial random effects error model (GM estimation)"
spmod <- list(coefficients=betaGLS, errcomp=errcomp,
vcov=covbeta, vcov.errcomp=NULL,
residuals=as.vector(egls), fitted.values=fv,
sigma2=sigma2,type=type, rho=errcomp, model=model.data,
call=cl, logLik=NULL, coy=yt, cox=xt, rhs=k)
- class(spmod) <- "splm"
- return(spmod)
+
}
@@ -593,14 +624,12 @@
colnames(errcomp)<-"Estimate"
model.data <- data.frame(cbind(y,x))
sigma2 <- SGLS
- type <- "random effects GM"
+ type <- "Spatial random effects error model with additional endogenous variables (GM estimation)"
spmod <- list(coefficients=betaGLS, errcomp=errcomp,
vcov=covbeta, vcov.errcomp=NULL,
residuals=as.vector(egls), fitted.values=fv,
sigma2=sigma2,type=type, rho=errcomp, model=model.data,
call=cl, logLik=NULL, coy=yt, cox=xt, rhs=k)
- class(spmod) <- "splm"
- return(spmod)
}
@@ -618,46 +647,15 @@
-# Hmatrices <- function(Ws, x, Xwithin, Xbetween, del, delb, NT){
-
-# WX <- as.matrix(Ws %*% x)
-# WWX <-as.matrix(Ws %*% WX)
-# WX <- WX[,-del]
-# WWX <- WWX[,-del]
-# HX <- cbind(WX, WWX)
+spsarargm<-function(formula, data = list(),
+ index = NULL, listw, listw2 = NULL,
+ moments = c("initial", "weights", "fullweights"),
+ lag= FALSE, endog = NULL, instruments = NULL,
+ verbose = FALSE, effects = c("fixed","random"),
+ control = list(), lag.instruments = lag.instruments,
+ optim.method = optim.method, pars = pars, twow ){
-# WXwithin <- as.matrix(Ws %*% Xwithin)
-# WWXwithin <- as.matrix(Ws %*% WXwithin)
-# WXwithin<-WXwithin[,-del]
-# WWXwithin<-WWXwithin[,-del]
-
-# # spms <- function(q) tapply(q, indic, mean)
-
-# Xbetweennt<-matrix(,NT, ncol(Xbetween))
-# for (i in 1:ncol(Xbetween)) Xbetweennt[,i]<-rep(Xbetween[,i], T)
-# if (colnames(x)[1] == "(Intercept)") Xbetweennt <- Xbetweennt[,-1]
-
-
-# WXbetween <- as.matrix(Ws %*% Xbetweennt)
-# if(length(delb)==0) WXbetween<-WXbetween
-# else WXbetween<-WXbetween[,-delb]
-# WWXbetween <- as.matrix(Ws %*% WXbetween)
-# if(length(delb)==0) WWXbetween<-WWXbetween
-# else WWXbetween<-WWXbetween[,-delb]
-
-# Hwithin<-cbind(Xwithin[,-del],WXwithin, WWXwithin)
-# Hbetween<-cbind(1, Xbetweennt,WXbetween, WWXbetween)
-# Hgls<-cbind(1, Hwithin, Hbetween[,-1])
-
-# Hmatr <- list(Hwithin, Hbetween, Hgls)
-
-# }
-
-
-spsarargm<-function(formula, data = list(), index = NULL, listw, listw2 = NULL, moments = c("initial", "weights", "fullweights"), lag= FALSE, endog = NULL, instruments = NULL, verbose = FALSE, effects = c("fixed","random"), control = list(), lag.instruments = lag.instruments, optim.method = optim.method, pars = pars, twow ){
-
-
effects<-match.arg(effects)
moments<-match.arg(moments)
indes<-index
@@ -715,7 +713,7 @@
if(!is.null(endog)){
endog <- as.matrix(lm(endog, data, na.action = na.fail, method = "model.frame"))
-if(is.null(instruments)) stop("No instruments specified for the additional variable")
+if(is.null(instruments)) stop("No instruments specified for the additional endogenous variables")
else instruments <- as.matrix(lm(instruments, data, na.action = na.fail, method = "model.frame"))
}
@@ -814,14 +812,12 @@
rownames(errcomp) <- nam.errcomp
colnames(errcomp)<-"Estimate"
model.data <- data.frame(cbind(y,x))
-
- type <- "fixed effects GM"
+#print(betaGLS)
+ type <- "Spatial fixed effects SARAR model (GM estimation)"
spmod <- list(coefficients=betaGLS, errcomp=errcomp,
vcov=covbeta, vcov.errcomp=NULL,
residuals=as.numeric(egls), fitted.values=fv,
- sigma2=SGLS,type=type, rho=errcomp, model=model.data, logLik=NULL, coy=yt, cox=xt, rhs=k)
- class(spmod) <- "splm"
- return(spmod)
+ sigma2=SGLS,type=type, rho=errcomp, model=model.data, logLik=NULL, coy=yt, cox=xt, rhs=k, type = type)
}
@@ -854,15 +850,12 @@
colnames(errcomp)<-"Estimate"
model.data <- data.frame(cbind(y,x))
- type <- "fixed effects GM"
+ type <- "Spatial fixed effects SARAR model with additional endogenous variables (GM estimation)"
spmod <- list(coefficients=betaGLS, errcomp= errcomp,
vcov= covbeta, vcov.errcomp=NULL,
residuals=as.numeric(egls), fitted.values=fv,
- sigma2=SGLS,type=type, rho=errcomp, model=model.data, logLik=NULL, coy=yt, cox=xt, rhs=k)
- class(spmod) <- "splm"
- return(spmod)
-
-
+ sigma2=SGLS,type=type, rho=errcomp, model=model.data, logLik=NULL, coy=yt, cox=xt, rhs=k, type = type)
+
}
},
@@ -973,7 +966,7 @@
ytmt<-tapply(yt, indic, mean)
ytNT<-rep(ytmt, T)
- yf<-(yt - theta*ytNT)
+ yf<-(yt - as.numeric(theta)*ytNT)
dm1<- function(A) rep(unlist(tapply(A, indic, mean, simplify=TRUE)), T)
xtNT<-apply(xt,2,dm1)
@@ -1007,13 +1000,11 @@
colnames(errcomp)<-"Estimate"
model.data <- data.frame(cbind(y,x))
- type <- "random effects GM"
+ type <- "Spatial random effects SARAR model (GM estimation)"
spmod <- list(coefficients=betaGLS, errcomp=errcomp,
vcov=covbeta, vcov.errcomp=NULL,
residuals=as.numeric(egls), fitted.values=fv,
- sigma2=SGLS,type=type, rho=errcomp, model=model.data, logLik=NULL, coy=yt, cox=xt, rhs=k)
- class(spmod) <- "splm"
- return(spmod)
+ sigma2=SGLS,type=type, rho=errcomp, model=model.data, logLik=NULL, coy=yt, cox=xt, rhs=k, type = type)
}
@@ -1049,14 +1040,12 @@
colnames(errcomp)<-"Estimate"
model.data <- data.frame(cbind(y,x))
- type <- "random effects GM"
+ type <- "Spatial random effects SARAR model with additional endogenous variables (GM estimation)"
spmod <- list(coefficients=betaGLS, errcomp= errcomp,
vcov= covbeta, vcov.errcomp=NULL,
residuals=as.numeric(egls), fitted.values=fv,
- sigma2=SGLS,type=type, rho=errcomp, model=model.data, logLik=NULL, coy=yt, cox=xt, rhs=k)
- class(spmod) <- "splm"
- return(spmod)
-
+ sigma2=SGLS,type=type, rho=errcomp, model=model.data, logLik=NULL, coy=yt, cox=xt, rhs=k, type = type)
+
}
},
stop("...\nUnknown method\n"))
Modified: pkg/R/summary.splm.R
===================================================================
--- pkg/R/summary.splm.R 2021-03-16 09:20:02 UTC (rev 227)
+++ pkg/R/summary.splm.R 2021-05-20 09:20:44 UTC (rev 228)
@@ -1,76 +1,75 @@
-`summary.splm` <-
-function(object,...){
-
- ## summary method for splm objects
- ## adds incrementally to the model object, as summary.plm does
- ## structure remains the same for all type but 'spsegm' (symultaneous equations requires a special printing)
- ## to date, only balanced panels are allowed for 'splm'
- balanced <- TRUE #attr(object,"pdim")$balanced
- model.name <- object$type #attr(object,"pmodel")$model
- effect <- "individual" #attr(object,"pmodel")$effect
- ## make coefficients' table if vcov exist
- if (!is.null(object$vcov)) {
+`summary.splm` <-
+function(object,...){
+
+ ## summary method for splm objects
+ ## adds incrementally to the model object, as summary.plm does
+ ## structure remains the same for all type but 'spsegm' (symultaneous equations requires a special printing)
+ ## to date, only balanced panels are allowed for 'splm'
+ balanced <- TRUE #attr(object,"pdim")$balanced
+ model.name <- object$type #attr(object,"pmodel")$model
+ effect <- "individual" #attr(object,"pmodel")$effect
+ est.meth <- object$est.meth
+ ## make coefficients' table if vcov exist
+ if (!is.null(object$vcov)) {
std.err <- sqrt(diag(object$vcov))
#if(object$type == "fixed effects sarar") std.err <- c(object$se.spat, sqrt(diag(object$vcov)))
- #vcov(object) doesn't work
+ #vcov(object) doesn't work
b <- coefficients(object)
- z <- b/std.err
- p <- 2*pnorm(abs(z),lower.tail=FALSE)
- CoefTable <- cbind(b,std.err,z,p)
- colnames(CoefTable) <- c("Estimate","Std. Error","t-value","Pr(>|t|)")
- object$CoefTable <- CoefTable
+ z <- b/std.err
+ p <- 2*pnorm(abs(z),lower.tail=FALSE)
+ CoefTable <- cbind(b,std.err,z,p)
+ colnames(CoefTable) <- c("Estimate","Std. Error","t-value","Pr(>|t|)")
+ object$CoefTable <- CoefTable
}
- else {
- object$CoefTable <- cbind(coefficients(object))
- colnames(object$CoefTable) <- c("Estimate")
- }
-
- # 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
- object$lambda <- lambda
- }
+ else {
+ object$CoefTable <- cbind(coefficients(object))
+ colnames(object$CoefTable) <- c("Estimate")
+ }
- if (object$type == "fixed effects GM" ) {
+ # if (object$type == "fixed effects error" && object$method != "eigen") {
+ # lambda <- object$spat.coef
+ # object$lambda <- lambda
+ # }
+
+ if (grepl("(GM estimation)", object$type)) {
lambda <- object$rho
+ #print(lambda)
object$lambda <- lambda
}
-
- ## make AR coefficient of y's table
- if(!is.null(object$vcov.arcoef)) {
- std.err1 <- sqrt(diag(object$vcov.arcoef))
- ar <- object$arcoef
- z <- ar/std.err1
- p <- 2*pnorm(abs(z),lower.tail=FALSE)
- ARCoefTable <- cbind(ar,std.err1,z,p)
- colnames(ARCoefTable) <- c("Estimate","Std. Error","t-value","Pr(>|t|)")
- object$ARCoefTable <- ARCoefTable
- }
-
-
- ## make error comps' table
- if(!is.null(object$vcov.errcomp)) {
- std.err2 <- sqrt(diag(object$vcov.errcomp))
- ec <- object$errcomp
- z <- ec/std.err2
- p <- 2*pnorm(abs(z),lower.tail=FALSE)
- ErrCompTable <- cbind(ec,std.err2,z,p)
- colnames(ErrCompTable) <- c("Estimate","Std. Error","t-value","Pr(>|t|)")
- object$ErrCompTable <- ErrCompTable
- }
-
- object$ssr <- sum(residuals(object)^2)
- object$tss <- tss(object$model[[1]])
- object$rsqr <- 1-object$ssr/object$tss
- object$fstatistic <- "nil" #Ftest(object)
- class(object) <- c("summary.splm","splm")
- object
-
-}
-
+
+
+ ## make AR coefficient of y's table
+ if(!is.null(object$vcov.arcoef)) {
+ std.err1 <- sqrt(diag(object$vcov.arcoef))
+ ar <- object$arcoef
+ z <- ar/std.err1
+ p <- 2*pnorm(abs(z),lower.tail=FALSE)
+ ARCoefTable <- cbind(ar,std.err1,z,p)
+ colnames(ARCoefTable) <- c("Estimate","Std. Error","t-value","Pr(>|t|)")
+ object$ARCoefTable <- ARCoefTable
+ }
+
+
+ ## make error comps' table
+ if(!is.null(object$vcov.errcomp)) {
+ std.err2 <- sqrt(diag(object$vcov.errcomp))
+ ec <- object$errcomp
+ z <- ec/std.err2
+ p <- 2*pnorm(abs(z),lower.tail=FALSE)
+ ErrCompTable <- cbind(ec,std.err2,z,p)
+ colnames(ErrCompTable) <- c("Estimate","Std. Error","t-value","Pr(>|t|)")
+ object$ErrCompTable <- ErrCompTable
+ }
+
+ object$ssr <- sum(residuals(object)^2)
+ object$tss <- tss(object$model[[1]])
+ object$rsqr <- 1-object$ssr/object$tss
+ object$est.meth <- est.meth
+ object$fstatistic <- "nil" #Ftest(object)
+ class(object) <- c("summary.splm","splm")
+ object
+
+}
+
Modified: pkg/man/spgm.Rd
===================================================================
--- pkg/man/spgm.Rd 2021-03-16 09:20:02 UTC (rev 227)
+++ pkg/man/spgm.Rd 2021-05-20 09:20:44 UTC (rev 228)
@@ -15,7 +15,7 @@
\deqn{ \epsilon_N = (e_T \otimes I_N ) \mu_N + \nu_N }
where \eqn{ \rho}, and the variance components \eqn{\sigma^2_\mu} and \eqn{\sigma^2_\nu}
-are estimated by GM, and the model coefficients by a feasible GLS estimator. The model can also include
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/splm -r 228
More information about the Splm-commits
mailing list