[Splm-commits] r251 - in pkg: R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Nov 22 17:19:11 CET 2022
Author: gpiras
Date: 2022-11-22 17:19:10 +0100 (Tue, 22 Nov 2022)
New Revision: 251
Modified:
pkg/R/impacts.splm.R
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/spgm.R
pkg/R/utilities_GM.R
pkg/R/vcov.splm.R
pkg/man/spgm.Rd
Log:
add the Durbin model to the GMM functions
Modified: pkg/R/impacts.splm.R
===================================================================
--- pkg/R/impacts.splm.R 2022-11-03 15:29:49 UTC (rev 250)
+++ pkg/R/impacts.splm.R 2022-11-22 16:19:10 UTC (rev 251)
@@ -1,4 +1,4 @@
-impacts.splm<-function(obj, listw = NULL, time = NULL, ..., tr=NULL, R=200, type="mult", empirical=FALSE, Q=NULL){
+impacts.splm <- function(obj, listw = NULL, time = NULL, ..., tr=NULL, R=200, type="mult", empirical=FALSE, Q=NULL){
if(is.null(listw) && is.null(tr)) stop("either listw or tr should be provided")
Modified: pkg/R/ivplm.b2sls.R
===================================================================
--- pkg/R/ivplm.b2sls.R 2022-11-03 15:29:49 UTC (rev 250)
+++ pkg/R/ivplm.b2sls.R 2022-11-22 16:19:10 UTC (rev 251)
@@ -1,8 +1,11 @@
###### between 2sls
-ivplm.b2sls <- function(Y,X,H = NULL, endog = NULL, lag=FALSE, listw, lag.instruments, T = T, N = N, NT = NT, twow = FALSE, listw2 = NULL){
+ivplm.b2sls <- function(Y,X,H = NULL, endog = NULL,
+ twow, lag = FALSE, listw = NULL, listw2 = NULL,
+ lag.instruments = NULL, t = t, N = N, NT = NT, Durbin = FALSE, xdur){
-indic <- rep(1:N,T)
+indic <- rep(1:N,t)
+xdu <- X
##transform y
ybetween<-panel.transformations(Y,indic, type= "between")
@@ -9,33 +12,96 @@
ndim <- length(ybetween)
listwnn <- listw[1:ndim, 1:ndim]
-Xbetween<-panel.transformations(X,indic, type= "between")
-colnames(Xbetween)<-colnames(X)
-if (colnames(Xbetween)[1] == "(Intercept)") Xbetween<-Xbetween[,-1]
-delb<-as.numeric(which(diag(var(Xbetween))==0))
-if(length(delb)==0) Xbetween<-Xbetween
-else Xbetween<-Xbetween[,-delb]
+if(isTRUE(Durbin) | inherits(Durbin, "formula")){
+
+ if(inherits(Durbin, "formula")){
+
+ colnmx <- colnames(X)
+ colnamesbx <- paste("lag_", colnames(xdur), sep="")
+ wx <- listw %*% xdur
+ X <- cbind(X, wx)
+ Xbetween <- panel.transformations(X, indic, type= "between")
+ colnames(Xbetween) <- c(colnmx, colnamesbx)
+
+ if (colnames(Xbetween)[1] == "(Intercept)") Xbetween <- Xbetween[,-1]
+ delb <- as.numeric(which(diag(var(Xbetween)) == 0))
+ if(length(delb) == 0) Xbetween <- Xbetween
+ else Xbetween <- Xbetween[,-delb]
+
+ if (colnmx[1] == "(Intercept)") Xbetween <- cbind(1, Xbetween)
+ colnames(Xbetween)[1] <- "(Intercept)"
+ xdu <- cbind(xdu, wx)
+ colnames(xdu) <- c(colnmx, colnamesbx)
+
+ }
+ else{
+
+ colnmx <- colnames(X)
+
+ if(colnmx[1] == "(Intercept)"){
+
+ wx <- listw %*% X[,-1]
+ colnameswx <- paste("lag_", colnames(X)[-1], sep = "")
+ xdu <- cbind(xdu, wx)
+ colnames(xdu) <- c(colnmx, colnameswx)
+
+ }
+ else{
+
+ wx <- listw %*% X
+ colnameswx <- paste("lag_", colnames(X), sep = "")
+ xdu <- cbind(xdu, wx)
+ colnames(xdu) <- c(colnmx, colnameswx)
+
+ }
+
+ X <- cbind(X, wx)
+
+ Xbetween <- panel.transformations(X, indic, type = "between")
+ colnames(Xbetween) <- c(colnmx, colnameswx)
+
+ if (colnames(Xbetween)[1] == "(Intercept)") Xbetween <- Xbetween[,-1]
+ delb <- as.numeric(which(diag(var(Xbetween)) == 0))
+ if(length(delb) == 0) Xbetween <- Xbetween
+ else Xbetween <- Xbetween[,-delb]
+ #print(colxbeet)
+ if (colnmx[1] == "(Intercept)") Xbetween <- cbind(1, Xbetween)
+ colnames(Xbetween)[1] <- "(Intercept)"
+
+ }
+}
+else{
+
+ colnmx <- colnames(X)
+ Xbetween <- panel.transformations(X, indic, type = "between")
+ colnames(Xbetween) <- colnmx
+
+ if (colnames(Xbetween)[1] == "(Intercept)") Xbetween <- Xbetween[,-1]
+ delb <- as.numeric(which(diag(var(Xbetween)) == 0))
+ if(length(delb) == 0) Xbetween <- Xbetween
+ else Xbetween <- Xbetween[,-delb]
+
+ if (colnmx[1] == "(Intercept)") Xbetween <- cbind(1, Xbetween)
+ colnames(Xbetween)[1] <- "(Intercept)"
+# xdu <- cbind(xdu, wx)
+# colnames(xdu) <- c(colnmx, colnameswx)
+
+}
-if (colnames(X)[1] == "(Intercept)") Xbetween<-cbind(1,Xbetween)
-colnames(Xbetween)[1]<-"(Intercept)"
+
if(!lag){
##transform the instruments H and the endogenous variable
Hbetween<-panel.transformations(H,indic, type= "between")
- if(lag.instruments ) {
-
- L.Hbetween <- listwnn %*% Hbetween
- L2.Hbetween <- listwnn %*% L.Hbetween
- Hbetween <- cbind(Hbetween, as.matrix(L.Hbetween), as.matrix(L2.Hbetween))
-}
-
+#transorm the endogenous
endogbetween<-panel.transformations(endog,indic, type= "between")
colnames(endogbetween)<-colnames(endog)
-res <-spgm.tsls(sqrt(T)*as.matrix(ybetween), sqrt(T)*endogbetween, sqrt(T)*Xbetween, sqrt(T)*as.matrix(Hbetween) )
+res <-spgm.tsls(sqrt(t)*as.matrix(ybetween), sqrt(t)*endogbetween, sqrt(t)*Xbetween, sqrt(t)*as.matrix(Hbetween) )
res$Hbetween <- Hbetween
+res$xdu <- xdu
res$type <- "b2sls model without spatial lag"
}
@@ -44,34 +110,36 @@
wybetween <- listwnn %*% as.matrix(ybetween)
wybetween <- as.matrix(wybetween)
- colnames(wybetween) <- ("lambda")
+ colnames(wybetween) <- ("lambda")
if(is.null(endog)){
-
- if(twow){
+ #no external instruments
+
+ if(twow){
- listw2nn <- listw2[1:ndim, 1:ndim]
- WXbetween <- listwnn %*% Xbetween
- WWXbetween <- listwnn %*% WXbetween
- W2Xbetween <- listw2nn %*% Xbetween
- W2WXbetween <- listw2nn %*% WXbetween
- W2WWXbetween <- listw2nn %*% WWXbetween
+ listw2nn <- listw2[1:ndim, 1:ndim]
+ WXbetween <- listwnn %*% Xbetween
+ WWXbetween <- listwnn %*% WXbetween
+ W2Xbetween <- listw2nn %*% Xbetween
+ W2WXbetween <- listw2nn %*% WXbetween
+ W2WWXbetween <- listw2nn %*% WWXbetween
- Hbetween <-cbind(as.matrix(WXbetween), as.matrix(WWXbetween), as.matrix(W2Xbetween), as.matrix(W2WXbetween), as.matrix(W2WWXbetween))
+ Hbetween <- cbind(as.matrix(WXbetween), as.matrix(WWXbetween), as.matrix(W2Xbetween), as.matrix(W2WXbetween), as.matrix(W2WWXbetween))
}
else{
- WXbetween <- as.matrix(listwnn %*% Xbetween)
+ WXbetween <- as.matrix(listwnn %*% Xbetween)
WWXbetween <- as.matrix(listwnn %*% WXbetween)
-Hbetween<-cbind(WXbetween, WWXbetween)
+ Hbetween <- cbind(WXbetween, WWXbetween)
}
-res<-spgm.tsls(sqrt(T)*as.matrix(ybetween), sqrt(T)*as.matrix(wybetween), sqrt(T)*Xbetween, sqrt(T)*as.matrix(Hbetween) )
+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$xdu <- xdu
res$type <- "Spatial b2sls model"
}
@@ -80,29 +148,12 @@
Hbetween <- panel.transformations(H,indic, type= "between")
-if(lag.instruments ) {
-
- L.Hbetween <- listwnn %*% Hbetween
- L2.Hbetween <- listwnn %*% L.Hbetween
- if(twow){
- listw2nn <- listw2[1:ndim, 1:ndim]
- w2.Hbetween <- as.matrix(listw2nn %*% Hbetween)
- w2w.Hbetween <- as.matrix(listw2nn %*% L.Hbetween)
- w2ww.Hbetween <- as.matrix(listw2nn %*% L2.Hbetween)
- Hbetween <- cbind(Hbetween, as.matrix(L.Hbetween), as.matrix(L2.Hbetween), w2.Hbetween, w2w.Hbetween, w2ww.Hbetween)
-
- }
-
- else Hbetween <- cbind(Hbetween, as.matrix(L.Hbetween), as.matrix(L2.Hbetween))
-}
-
-
if(twow){
listw2nn <- listw2[1:ndim, 1:ndim]
- WXbetween <- listwnn %*% Xbetween
+ WXbetween <- listwnn %*% Xbetween
WWXbetween <- listwnn %*% WXbetween
- W2Xbetween <- listw2nn %*% Xbetween
+ W2Xbetween <- listw2nn %*% Xbetween
W2WXbetween <- listw2nn %*% WXbetween
W2WWXbetween <- listw2nn %*% WWXbetween
@@ -112,7 +163,7 @@
else{
WXbetween <- listwnn %*% Xbetween
- WWXbetween <- listwnn %*% WXbetween
+ WWXbetween <- listwnn %*% WXbetween
Hbetween <-cbind(Hbetween, as.matrix(WXbetween), as.matrix(WWXbetween))
}
@@ -126,8 +177,9 @@
-res<-spgm.tsls(sqrt(T)*as.matrix(ybetween), sqrt(T)*endogbetween, sqrt(T)*Xbetween, sqrt(T)*as.matrix(Hbetween) )
+res<-spgm.tsls(sqrt(t)*as.matrix(ybetween), sqrt(t)*endogbetween, sqrt(t)*Xbetween, sqrt(t)*as.matrix(Hbetween) )
res$Hbetween <- Hbetween
+res$xdu <- xdu
res$type <- "Spatial b2sls model with additional endogenous variables"
}
}
Modified: pkg/R/ivplm.ec2sls.R
===================================================================
--- pkg/R/ivplm.ec2sls.R 2022-11-03 15:29:49 UTC (rev 250)
+++ pkg/R/ivplm.ec2sls.R 2022-11-22 16:19:10 UTC (rev 251)
@@ -1,66 +1,120 @@
# # # # # ec 2sls
-ivplm.ec2sls <- function(Y,X,H = NULL, endog = NULL, lag=FALSE, listw, lag.instruments, T = T, N = N, NT = NT ){
+ivplm.ec2sls <- function(Y,X,H = NULL, endog = NULL,
+ twow, lag = FALSE, listw = NULL, listw2 = NULL,
+ lag.instruments = NULL, t, N, NT, Durbin = FALSE, xdur){
-indic <- rep(1:N,T)
+indic <- rep(1:N,t)
listwnn <- listw[1:N, 1:N]
+if(twow) listw2nn <- listw2[1:N,1:N]
##transform y
transy<-panel.transformations(Y,indic, type= "both")
ybetween<-transy[[2]]
ywithin<-transy[[1]]
-ybetweennt<- rep(ybetween, T)
+ybetweennt<- rep(ybetween, t)
-##transform X
-transx<-panel.transformations(X,indic, type= "both")
-Xbetween<-transx[[2]]
-Xwithin<-transx[[1]]
-colnames(Xwithin)<-colnames(X)
-colnames(Xbetween)<-colnames(X)
-Xbetweennt<-matrix(,NT, ncol(Xbetween))
-for (i in 1:ncol(Xbetween)) Xbetweennt[,i]<-rep(Xbetween[,i], T)
-del<- which(diag(var(Xwithin))==0)
-colnames(Xbetweennt)<-colnames(X)
-if(!lag){
-##transform the instruments H
-transH<-panel.transformations(H,indic, type= "both")
-Hbetween<-transH[[2]]
-Hwithin<-transH[[1]]
+#check if the model is durbin and include the spatial lags
-if(lag.instruments ) {
-
- L.Hwithin <- listw %*% Hwithin
- L2.Hwithin <- listw %*% L.Hwithin
- Hwithin <- cbind(Hwithin, as.matrix(L.Hwithin), as.matrix(L2.Hwithin))
-
- L.Hbetween <- listwnn %*% Hbetween
- L2.Hbetween <- listwnn %*% L.Hbetween
- Hbetween <- cbind(Hbetween, as.matrix(L.Hbetween), as.matrix(L2.Hbetween))
-
+if(isTRUE(Durbin) | inherits(Durbin, "formula")){
+
+ if(inherits(Durbin, "formula")){
+
+ colnmx <- colnames(X)
+ colnameswx <- paste("lag_", colnames(xdur), sep="")
+ wx <- listw %*% xdur
+ X <- cbind(X, wx)
+
+ transx <- panel.transformations(X,indic, type= "both")
+
+ Xbetween <- transx[[2]]
+ Xwithin <- transx[[1]]
+
+
+ colnames(Xwithin) <- c(colnmx, colnameswx)
+ colnames(Xbetween) <- c(colnmx, colnameswx)
+
+ Xbetweennt<-matrix(,NT, ncol(Xbetween))
+ for (i in 1:ncol(Xbetween)) Xbetweennt[,i]<-rep(Xbetween[,i], t)
+ del <- which(diag(var(Xwithin))==0)
+ colnames(Xbetweennt)<- c(colnmx, colnameswx)
+
+
+ }
+ else{
+
+ colnmx <- colnames(X)
+
+ if(colnames(X)[1] == "(Intercept)"){
+ wx <- listw %*% X[,-1]
+ colnameswx <- paste("lag_", colnames(X)[-1], sep="")
+ }
+ else {
+ wx <- listw %*% X
+ colnameswx <- paste("lag_", colnames(X), sep="")
+ }
+
+
+ X <- cbind(X, wx)
+
+ transx <- panel.transformations(X,indic, type= "both")
+
+ Xbetween <- transx[[2]]
+ Xwithin <- transx[[1]]
+
+ colnames(Xwithin) <- c(colnmx, colnameswx)
+ colnames(Xbetween) <- c(colnmx, colnameswx)
+ Xbetweennt<-matrix(,NT, ncol(Xbetween))
+ for (i in 1:ncol(Xbetween)) Xbetweennt[,i]<-rep(Xbetween[,i], t)
+ del <- which(diag(var(Xwithin))==0)
+ colnames(Xbetweennt) <- c(colnmx, colnameswx)
+
+
+ }
}
+else{
+
+ transx<-panel.transformations(X,indic, type= "both")
+ Xbetween<-transx[[2]]
+ Xwithin<-transx[[1]]
+ colnames(Xwithin)<-colnames(X)
+ colnames(Xbetween)<-colnames(X)
+ Xbetweennt<-matrix(,NT, ncol(Xbetween))
+ for (i in 1:ncol(Xbetween)) Xbetweennt[,i]<-rep(Xbetween[,i], t)
+ del <- which(diag(var(Xwithin))==0)
+ colnames(Xbetweennt) <- colnames(X)
+
+
+
+}
-Hbetweennt<-matrix(,NT, ncol(Hbetween))
-for (i in 1:ncol(Hbetween)) Hbetweennt[,i]<-rep(Hbetween[,i],T)
+if(!lag){
+##transform the instruments H
+transH <- panel.transformations(H,indic, type= "both")
+Hbetween <- transH[[2]]
+Hwithin <- transH[[1]]
+Hbetweennt <- matrix(,NT, ncol(Hbetween))
+for (i in 1:ncol(Hbetween)) Hbetweennt[,i] <- rep(Hbetween[,i],t)
##transform the endogenous variables endog
-transendog<-panel.transformations(endog,indic, type= "both")
-endogbetween<-transendog[[2]]
-endogwithin<-transendog[[1]]
-endogbetweennt<-matrix(,NT, ncol(endogbetween))
-for (i in 1:ncol(endogbetween)) endogbetweennt[,i]<-rep(endogbetween[,i],T)
-colnames(endogbetweennt)<-colnames(endog)
-colnames(endogwithin)<-colnames(endog)
+transendog <- panel.transformations(endog,indic, type= "both")
+endogbetween <- transendog[[2]]
+endogwithin <- transendog[[1]]
+endogbetweennt <- matrix(,NT, ncol(endogbetween))
+for (i in 1:ncol(endogbetween)) endogbetweennt[,i]<-rep(endogbetween[,i],t)
+colnames(endogbetweennt) <- colnames(endog)
+colnames(endogwithin) <- colnames(endog)
#W2SLS
resw<-spgm.tsls(as.matrix(ywithin), endogwithin, Xwithin, Hwithin )
-sigma2v1<-resw$sse / ((N * (T -1)) - ncol(as.matrix(Xwithin[,-del])) - ncol(endogwithin))
+sigma2v1<-resw$sse / ((N * (t -1)) - ncol(as.matrix(Xwithin[,-del])) - ncol(endogwithin))
#B2SLS
-resb<-spgm.tsls(sqrt(T)*as.matrix(ybetween), sqrt(T)*as.matrix(endogbetween), sqrt(T)*Xbetween, sqrt(T)*as.matrix(Hbetween) )
+resb<-spgm.tsls(sqrt(t)*as.matrix(ybetween), sqrt(t)*as.matrix(endogbetween), sqrt(t)*Xbetween, sqrt(t)*as.matrix(Hbetween) )
sigma21<-resb$sse / resb$df
@@ -69,7 +123,8 @@
endogstar<-endogwithin/sqrt(sigma2v1) + endogbetweennt/sqrt(sigma21)
Hins <- cbind(Xwithin,Xbetweennt,Hwithin,Hbetweennt)
-res<-spgm.tsls(ystar, endogstar, xstar, Hinst = Hins, instr = TRUE )
+res <- spgm.tsls(ystar, endogstar, xstar, Hinst = Hins, instr = TRUE)
+
res$sigma1<-sigma21
res$sigmav<-sigma2v1
res$type <- "ec2sls model without spatial lag"
@@ -78,48 +133,74 @@
else{
- wy <- listw %*% Y
-
- wywithin <- listw %*% ywithin
- wywithin <- as.matrix(wywithin)
+ wy <- listw %*% Y
+ wywithin <- listw %*% ywithin
+ wywithin <- as.matrix(wywithin)
colnames(wywithin)<-"lambda"
-
- wybetween <- listwnn %*% as.matrix(ybetween)
+ wybetween <- listwnn %*% as.matrix(ybetween)
colnames(wybetween) <- ("lambda")
- WXwithin <- as.matrix(listw %*% Xwithin)
- WWXwithin <- as.matrix(listw %*% WXwithin)
+ #WXwithin <- as.matrix(listw %*% Xwithin)
+ #WWXwithin <- as.matrix(listw %*% WXwithin)
- WXbetween <- as.matrix(listwnn %*% Xbetween)
- WWXbetween <- as.matrix(listwnn %*% WXbetween)
+ #WXbetween <- as.matrix(listwnn %*% Xbetween)
+ #WWXbetween <- as.matrix(listwnn %*% WXbetween)
if(is.null(endog)){
-Hwithin<-cbind(WXwithin, WWXwithin)
+ if(twow){
+
+ WXwithin <- listw %*% Xwithin
+ WWXwithin <- listw %*% WXwithin
+ W2Xwithin <- listw2 %*% Xwithin
+ W2WXwithin <- listw2 %*% WXwithin
+ W2WWXwithin <- listw2 %*% WWXwithin
+
+ WXbetween <- listwnn %*% Xbetween
+ WWXbetween <- listwnn %*% WXbetween
+ W2Xbetween <- listw2nn %*% Xbetween
+ W2WXbetween <- listw2nn %*% WXbetween
+ W2WWXbetween <- listw2nn %*% WWXbetween
+
+ Hwithin <-cbind(as.matrix(WXwithin), as.matrix(WWXwithin), as.matrix(W2Xwithin), as.matrix(W2WXwithin), as.matrix(W2WWXwithin))
+ Hbetween <-cbind(as.matrix(WXbetween), as.matrix(WWXbetween), as.matrix(W2Xbetween), as.matrix(W2WXbetween), as.matrix(W2WWXbetween))
+
+ }
+ else{
+
+ WXwithin <- listw %*% Xwithin
+ WWXwithin <- listw %*% WXwithin
+ Hwithin <-cbind(as.matrix(WXwithin), as.matrix(WWXwithin))
+
+ WXbetween <- listwnn %*% Xbetween
+ WWXbetween <- listwnn %*% WXbetween
+ Hbetween <-cbind(as.matrix(WXbetween), as.matrix(WWXbetween))
+
+ }
+
+
+
+
resw<-spgm.tsls(ywithin, wywithin, Xwithin, Hwithin)
+sigma2v1<- resw$sse / ((N * (t -1)) - ncol(as.matrix(Xwithin[,-del])) - 1)
-sigma2v1<- resw$sse / ((N * (T -1)) - ncol(as.matrix(Xwithin[,-del])) - 1)
-
-Hbetween<-cbind(WXbetween, WWXbetween)
-
-resb<-spgm.tsls(sqrt(T)*as.matrix(ybetween), sqrt(T)*as.matrix(wybetween), sqrt(T)*Xbetween, sqrt(T)*as.matrix(Hbetween) )
+resb<-spgm.tsls(sqrt(t)*as.matrix(ybetween), sqrt(t)*as.matrix(wybetween), sqrt(t)*Xbetween, sqrt(t)*as.matrix(Hbetween) )
sigma21<-resb$sse / resb$df
ystar<-ywithin/sqrt(sigma2v1) + ybetweennt/sqrt(sigma21)
xstar<-Xwithin/sqrt(sigma2v1) + Xbetweennt/sqrt(sigma21)
-endogstar<-wywithin/sqrt(sigma2v1) + rep(as.matrix(wybetween), T)/sqrt(as.numeric(sigma21))
+endogstar<-wywithin/sqrt(sigma2v1) + rep(as.matrix(wybetween), t)/sqrt(as.numeric(sigma21))
endogstar<-as.matrix(endogstar)
colnames(endogstar)<-"lambda"
Hbetweennt<-matrix(,NT, ncol(Hbetween))
-for (i in 1:ncol(Hbetween)) Hbetweennt[,i]<-rep(Hbetween[,i],T)
+for (i in 1:ncol(Hbetween)) Hbetweennt[,i]<-rep(Hbetween[,i],t)
A <- cbind(1, Xwithin, Xbetweennt, Hwithin, Hbetweennt)
res <- spgm.tsls(ystar, endogstar, xstar, Hinst = A, instr = TRUE)
-
res$sigma1 <- sigma21
res$sigmav <- sigma2v1
res$type <- "Spatial ec2sls model"
@@ -130,25 +211,46 @@
transH <- panel.transformations(H,indic, type= "both")
Hbetween <- transH[[2]]
Hwithin<-transH[[1]]
+Hbetweennt<-matrix(,NT, ncol(Hbetween))
+for (i in 1:ncol(Hbetween)) Hbetweennt[,i]<-rep(Hbetween[,i], t)
-if(lag.instruments ) {
-
- L.Hwithin <- as.matrix(listw %*% Hwithin)
- L2.Hwithin <- as.matrix(listw %*% L.Hwithin)
- Hwithin <- cbind(Hwithin, L.Hwithin, L2.Hwithin)
- L.Hbetween <- as.matrix(listwnn %*% Hbetween)
- L2.Hbetween <- as.matrix(listwnn %*% L.Hbetween)
- Hbetween <- cbind(Hbetween, L.Hbetween, L2.Hbetween)
-
+#Hwithin<-cbind(Hwithin, WXwithin, WWXwithin)
+
+if(twow){
+
+ WXwithin <- listw %*% Xwithin
+ WWXwithin <- listw %*% WXwithin
+ W2Xwithin <- listw2 %*% Xwithin
+ W2WXwithin <- listw2 %*% WXwithin
+ W2WWXwithin <- listw2 %*% WWXwithin
+
+ WXbetween <- listwnn %*% Xbetween
+ WWXbetween <- listwnn %*% WXbetween
+ W2Xbetween <- listw2nn %*% Xbetween
+ W2WXbetween <- listw2nn %*% WXbetween
+ W2WWXbetween <- listw2nn %*% WWXbetween
+
+ Hwithin <-cbind(Hwithin, as.matrix(WXwithin), as.matrix(WWXwithin), as.matrix(W2Xwithin), as.matrix(W2WXwithin), as.matrix(W2WWXwithin))
+ Hbetween <-cbind(Hbetween, as.matrix(WXbetween), as.matrix(WWXbetween), as.matrix(W2Xbetween), as.matrix(W2WXbetween), as.matrix(W2WWXbetween))
+
}
+else{
+
+ WXwithin <- listw %*% Xwithin
+ WWXwithin <- listw %*% WXwithin
+ Hwithin <-cbind(Hwithin, as.matrix(WXwithin), as.matrix(WWXwithin))
+
+ WXbetween <- listwnn %*% Xbetween
+ WWXbetween <- listwnn %*% WXbetween
+ Hbetween <-cbind(Hbetween, as.matrix(WXbetween), as.matrix(WWXbetween))
+
+}
-Hbetweennt<-matrix(,NT, ncol(Hbetween))
-for (i in 1:ncol(Hbetween)) Hbetweennt[,i]<-rep(Hbetween[,i], T)
-Hwithin<-cbind(Hwithin, WXwithin, WWXwithin)
+
transendog<-panel.transformations(endog,indic, type= "both")
endogbetween<-transendog[[2]]
endogwithin<-transendog[[1]]
@@ -160,7 +262,7 @@
colnames(endogwithin) <- c(colnames(endog), "lambda")
resw<-spgm.tsls(as.matrix(ywithin), as.matrix(endogwithin), Xwithin, Hwithin )
-sigma2v1<-resw$sse / ((N * (T -1)) - ncol(as.matrix(Xwithin[,-del])) - ncol(endogwithin))
+sigma2v1<-resw$sse / ((N * (t -1)) - ncol(as.matrix(Xwithin[,-del])) - ncol(endogwithin))
Hbetween <- cbind(Hbetween, WXbetween, WWXbetween)
@@ -167,10 +269,10 @@
endogbetween <- cbind(endogbetween, as.matrix(wybetween))
colnames(endogbetween) <- c(colnames(endog), "lambda")
endogbetweennt<-matrix(,NT, ncol(endogbetween))
-for (i in 1:ncol(endogbetween)) endogbetweennt[,i]<-rep(endogbetween[,i], T)
+for (i in 1:ncol(endogbetween)) endogbetweennt[,i]<-rep(endogbetween[,i], t)
-resb<-spgm.tsls(sqrt(T)*as.matrix(ybetween), sqrt(T)*as.matrix(endogbetween), sqrt(T)*Xbetween, sqrt(T)*as.matrix(Hbetween))
+resb<-spgm.tsls(sqrt(t)*as.matrix(ybetween), sqrt(t)*as.matrix(endogbetween), sqrt(t)*Xbetween, sqrt(t)*as.matrix(Hbetween))
sigma21<-resb$sse / resb$df
@@ -184,7 +286,7 @@
# print(sigma21)
Hbetweennt<-matrix(,NT, ncol(Hbetween))
-for (i in 1:ncol(Hbetween)) Hbetweennt[,i]<-rep(Hbetween[,i], T)
+for (i in 1:ncol(Hbetween)) Hbetweennt[,i]<-rep(Hbetween[,i], t)
A<-cbind(1,Xwithin[,-del],Xbetweennt[,-del], Hwithin, Hbetweennt)
Modified: pkg/R/ivplm.g2sls.R
===================================================================
--- pkg/R/ivplm.g2sls.R 2022-11-03 15:29:49 UTC (rev 250)
+++ pkg/R/ivplm.g2sls.R 2022-11-22 16:19:10 UTC (rev 251)
@@ -1,26 +1,96 @@
# # # # # g2sls
-ivplm.g2sls <-function(Y,X,H = NULL,endog = NULL, lag=FALSE, listw, lag.instruments, T = T, N = N, NT = NT){
+ivplm.g2sls <-function(Y,X,H = NULL, endog = NULL,
+ twow, lag = FALSE, listw = NULL, listw2 = NULL,
+ lag.instruments = NULL, t, N, NT, Durbin = FALSE, xdur){
-indic <- rep(1:N,T)
+indic <- rep(1:N,t)
listwnn <- listw[1:N,1:N]
+if(twow) listw2nn <- listw2[1:N,1:N]
+
##transform y
transy<-panel.transformations(Y,indic, type= "both")
ybetween<-transy[[2]]
ywithin<-transy[[1]]
-ybetweennt<- rep(ybetween, T)
+ybetweennt<- rep(ybetween, t)
-##transform X
-transx<-panel.transformations(X,indic, type= "both")
-Xbetween<-transx[[2]]
-Xwithin<-transx[[1]]
-colnames(Xwithin)<-colnames(X)
-colnames(Xbetween)<-colnames(X)
-Xbetweennt<-matrix(,NT, ncol(Xbetween))
-for (i in 1:ncol(Xbetween)) Xbetweennt[,i]<-rep(Xbetween[,i],T)
-del<- which(diag(var(Xwithin))==0)
-colnames(Xbetweennt)<-colnames(X)
+#check if the model is durbin and include the spatial lags
+
+if(isTRUE(Durbin) | inherits(Durbin, "formula")){
+
+ if(inherits(Durbin, "formula")){
+
+ colnmx <- colnames(X)
+ colnameswx <- paste("lag_", colnames(xdur), sep="")
+ wx <- listw %*% xdur
+ X <- cbind(X, wx)
+
+ transx <- panel.transformations(X,indic, type= "both")
+
+ Xbetween <- transx[[2]]
+ Xwithin <- transx[[1]]
+
+
+ colnames(Xwithin) <- c(colnmx, colnameswx)
+ colnames(Xbetween) <- c(colnmx, colnameswx)
+
+ Xbetweennt<-matrix(,NT, ncol(Xbetween))
+ for (i in 1:ncol(Xbetween)) Xbetweennt[,i]<-rep(Xbetween[,i], t)
+ del <- which(diag(var(Xwithin))==0)
+ colnames(Xbetweennt)<- c(colnmx, colnameswx)
+
+
+ }
+ else{
+
+ colnmx <- colnames(X)
+
+ if(colnames(X)[1] == "(Intercept)"){
+ wx <- listw %*% X[,-1]
+ colnameswx <- paste("lag_", colnames(X)[-1], sep="")
+ }
+ else {
+ wx <- listw %*% X
+ colnameswx <- paste("lag_", colnames(X), sep="")
+ }
+
+
+ X <- cbind(X, wx)
+
+ transx <- panel.transformations(X,indic, type= "both")
+
+ Xbetween <- transx[[2]]
+ Xwithin <- transx[[1]]
+
+ colnames(Xwithin) <- c(colnmx, colnameswx)
+ colnames(Xbetween) <- c(colnmx, colnameswx)
+ Xbetweennt<-matrix(,NT, ncol(Xbetween))
+ for (i in 1:ncol(Xbetween)) Xbetweennt[,i]<-rep(Xbetween[,i], t)
+ del <- which(diag(var(Xwithin))==0)
+ colnames(Xbetweennt) <- c(colnmx, colnameswx)
+
+
+ }
+}
+else{
+
+ transx<-panel.transformations(X,indic, type= "both")
+ Xbetween<-transx[[2]]
+ Xwithin<-transx[[1]]
+ colnames(Xwithin)<-colnames(X)
+ colnames(Xbetween)<-colnames(X)
+ Xbetweennt<-matrix(,NT, ncol(Xbetween))
+ for (i in 1:ncol(Xbetween)) Xbetweennt[,i]<-rep(Xbetween[,i], t)
+ del <- which(diag(var(Xwithin))==0)
+ colnames(Xbetweennt) <- colnames(X)
+
+
+
+}
+
+
+
if(!lag){
##transform the instruments H
@@ -27,28 +97,15 @@
transH<-panel.transformations(H, indic, type= "both")
Hbetween<-transH[[2]]
Hwithin<-transH[[1]]
-
-if(lag.instruments ) {
-
- L.Hwithin <- listw %*% Hwithin
- L2.Hwithin <- listw %*% L.Hwithin
- Hwithin <- cbind(Hwithin, as.matrix(L.Hwithin), as.matrix(L2.Hwithin))
-
- L.Hbetween <- listwnn %*% Hbetween
- L2.Hbetween <- listwnn %*% L.Hbetween
- Hbetween <- cbind(Hbetween, as.matrix(L.Hbetween), as.matrix(L2.Hbetween))
-
-}
-
Hbetweennt<-matrix(,NT, ncol(Hbetween))
for (i in 1:ncol(Hbetween)) Hbetweennt[,i]<-rep(Hbetween[,i], T)
##transform the endogenous variables endog
-transendog<-panel.transformations(endog, indic, type= "both")
-endogbetween<-transendog[[2]]
-endogwithin<-transendog[[1]]
+transendog <- panel.transformations(endog, indic, type= "both")
+endogbetween <- transendog[[2]]
+endogwithin <- transendog[[1]]
endogbetweennt<-matrix(,NT, ncol(endogbetween))
-for (i in 1:ncol(endogbetween)) endogbetweennt[,i] <- rep(endogbetween[,i], T)
+for (i in 1:ncol(endogbetween)) endogbetweennt[,i] <- rep(endogbetween[,i], t)
colnames(endogbetweennt)<-colnames(endog)
colnames(endogwithin)<-colnames(endog)
@@ -55,10 +112,10 @@
#W2SLS
resw<-spgm.tsls(as.matrix(ywithin), endogwithin, Xwithin, Hwithin )
-sigma2v1<-resw$sse / ((N * (T -1)) - ncol(as.matrix(Xwithin[,-del])) - ncol(endogwithin))
+sigma2v1<-resw$sse / ((N * (t -1)) - ncol(as.matrix(Xwithin[,-del])) - ncol(endogwithin))
#B2SLS
-resb<-spgm.tsls(sqrt(T)*as.matrix(ybetween), sqrt(T)*as.matrix(endogbetween), sqrt(T)*Xbetween, sqrt(T)*as.matrix(Hbetween) )
+resb<-spgm.tsls(sqrt(t)*as.matrix(ybetween), sqrt(t)*as.matrix(endogbetween), sqrt(t)*Xbetween, sqrt(t)*as.matrix(Hbetween) )
sigma21<-resb$sse / resb$df
@@ -76,49 +133,79 @@
}
else{
- wy<-listw %*% Y
+ wy <- listw %*% Y
wy <- as.matrix(wy)
- colnames(wy)<-"lambda"
- wywithin <- listw %*% ywithin
- wywithin <- as.matrix(wywithin)
- colnames(wywithin)<-"lambda"
- wybetween <- listwnn %*% as.matrix(ybetween)
- colnames(wybetween) <- "lambda"
+ colnames(wy)<-"lambda"
+ wywithin <- listw %*% ywithin
+ wywithin <- as.matrix(wywithin)
+ colnames(wywithin)<-"lambda"
+ wybetween <- listwnn %*% as.matrix(ybetween)
+ colnames(wybetween) <- "lambda"
- WXwithin <- as.matrix(listw %*% Xwithin)
- WWXwithin <- as.matrix(listw %*% WXwithin)
+ #WXwithin <- as.matrix(listw %*% Xwithin)
+ #WWXwithin <- as.matrix(listw %*% WXwithin)
- WXbetween <- as.matrix(listwnn %*% Xbetween)
- WWXbetween <- as.matrix(listwnn %*% WXbetween)
+ #WXbetween <- as.matrix(listwnn %*% Xbetween)
+ #WWXbetween <- as.matrix(listwnn %*% WXbetween)
if(is.null(endog)){
+
+ if(twow){
+
+ WXwithin <- listw %*% Xwithin
+ WWXwithin <- listw %*% WXwithin
+ W2Xwithin <- listw2 %*% Xwithin
+ W2WXwithin <- listw2 %*% WXwithin
+ W2WWXwithin <- listw2 %*% WWXwithin
+
+ WXbetween <- listwnn %*% Xbetween
+ WWXbetween <- listwnn %*% WXbetween
+ W2Xbetween <- listw2nn %*% Xbetween
+ W2WXbetween <- listw2nn %*% WXbetween
+ W2WWXbetween <- listw2nn %*% WWXbetween
+
+ Hwithin <-cbind(as.matrix(WXwithin), as.matrix(WWXwithin), as.matrix(W2Xwithin), as.matrix(W2WXwithin), as.matrix(W2WWXwithin))
+ Hbetween <-cbind(as.matrix(WXbetween), as.matrix(WWXbetween), as.matrix(W2Xbetween), as.matrix(W2WXbetween), as.matrix(W2WWXbetween))
+
+ }
+ else{
+
+ WXwithin <- listw %*% Xwithin
+ WWXwithin <- listw %*% WXwithin
+ Hwithin <-cbind(as.matrix(WXwithin), as.matrix(WWXwithin))
-Hwithin<-cbind(WXwithin, WWXwithin)
+ WXbetween <- listwnn %*% Xbetween
+ WWXbetween <- listwnn %*% WXbetween
+ Hbetween <-cbind(as.matrix(WXbetween), as.matrix(WWXbetween))
+
+ }
+
+
+
resw<-spgm.tsls(ywithin, wywithin, Xwithin, Hwithin)
-sigma2v1<- resw$sse / ((N * (T -1)) - ncol(as.matrix(Xwithin[,-del])) - 1)
+sigma2v1<- resw$sse / ((N * (t -1)) - ncol(as.matrix(Xwithin[,-del])) - 1)
-Hbetween<-cbind(WXbetween, WWXbetween)
-resb<-spgm.tsls(sqrt(T)*as.matrix(ybetween), sqrt(T)*as.matrix(wybetween), sqrt(T)*Xbetween, sqrt(T)*as.matrix(Hbetween) )
+
+resb<-spgm.tsls(sqrt(t)*as.matrix(ybetween), sqrt(t)*as.matrix(wybetween), sqrt(t)*Xbetween, sqrt(t)*as.matrix(Hbetween) )
sigma21<-resb$sse / resb$df
ystar<-ywithin/sqrt(sigma2v1) + ybetweennt/sqrt(sigma21)
xstar<-Xwithin/sqrt(sigma2v1) + Xbetweennt/sqrt(sigma21)
-endogstar<-wywithin/sqrt(sigma2v1) + rep(as.matrix(wybetween), T)/sqrt(as.numeric(sigma21))
+endogstar<-wywithin/sqrt(sigma2v1) + rep(as.matrix(wybetween), t)/sqrt(as.numeric(sigma21))
endogstar<-as.matrix(endogstar)
colnames(endogstar)<-"lambda"
Hbetweennt<-matrix(,NT, ncol(Hbetween))
-for (i in 1:ncol(Hbetween)) Hbetweennt[,i]<-rep(Hbetween[,i], T)
+for (i in 1:ncol(Hbetween)) Hbetweennt[,i]<-rep(Hbetween[,i], t)
-Hstar<-Hwithin/sqrt(sigma2v1) + Hbetweennt/sqrt(sigma21)
+Hstar <- Hwithin/sqrt(sigma2v1) + Hbetweennt/sqrt(sigma21)
res <- spgm.tsls(ystar, endogstar, xstar, Hstar)
-
res$sigma1 <- sigma21
res$sigmav <- sigma2v1
res$type <- "Spatial g2sls model"
@@ -130,42 +217,61 @@
transH<-panel.transformations(H, indic, type= "both")
Hbetween<-transH[[2]]
Hwithin<-transH[[1]]
+Hbetweennt<-matrix(, NT, ncol(Hbetween))
+for (i in 1:ncol(Hbetween)) Hbetweennt[,i]<-rep(Hbetween[,i], t)
-if(lag.instruments ) {
-
- L.Hwithin <- as.matrix(listw %*% Hwithin)
- L2.Hwithin <- as.matrix(listw %*% L.Hwithin)
- Hwithin <- cbind(Hwithin, L.Hwithin, L2.Hwithin)
+#Hwithin<-cbind(Hwithin, WXwithin, WWXwithin)
- L.Hbetween <- as.matrix(listwnn %*% Hbetween)
- L2.Hbetween <- as.matrix(listwnn %*% L.Hbetween)
- Hbetween <- cbind(Hbetween, L.Hbetween, L2.Hbetween)
-
+
+if(twow){
+
+ WXwithin <- listw %*% Xwithin
+ WWXwithin <- listw %*% WXwithin
+ W2Xwithin <- listw2 %*% Xwithin
+ W2WXwithin <- listw2 %*% WXwithin
+ W2WWXwithin <- listw2 %*% WWXwithin
+
+ WXbetween <- listwnn %*% Xbetween
+ WWXbetween <- listwnn %*% WXbetween
+ W2Xbetween <- listw2nn %*% Xbetween
+ W2WXbetween <- listw2nn %*% WXbetween
+ W2WWXbetween <- listw2nn %*% WWXbetween
+
+ Hwithin <-cbind(Hwithin, as.matrix(WXwithin), as.matrix(WWXwithin), as.matrix(W2Xwithin), as.matrix(W2WXwithin), as.matrix(W2WWXwithin))
+ Hbetween <-cbind(Hbetween, as.matrix(WXbetween), as.matrix(WWXbetween), as.matrix(W2Xbetween), as.matrix(W2WXbetween), as.matrix(W2WWXbetween))
+
}
+else{
+
+ WXwithin <- listw %*% Xwithin
+ WWXwithin <- listw %*% WXwithin
+ Hwithin <-cbind(Hwithin, as.matrix(WXwithin), as.matrix(WWXwithin))
+
+ WXbetween <- listwnn %*% Xbetween
+ WWXbetween <- listwnn %*% WXbetween
+ Hbetween <-cbind(Hbetween, as.matrix(WXbetween), as.matrix(WWXbetween))
+
+}
-Hbetweennt<-matrix(, NT, ncol(Hbetween))
-for (i in 1:ncol(Hbetween)) Hbetweennt[,i]<-rep(Hbetween[,i], T)
-Hwithin<-cbind(Hwithin, WXwithin, WWXwithin)
-
transendog<-panel.transformations(endog, indic, type= "both")
endogbetween<-transendog[[2]]
endogwithin<-transendog[[1]]
+
+
endogwithin<-cbind(endogwithin, wywithin)
-
resw<-spgm.tsls(as.matrix(ywithin), as.matrix(endogwithin), Xwithin, Hwithin )
-sigma2v1<-resw$sse / ((N * (T -1)) - ncol(as.matrix(Xwithin[,-del])) - ncol(endogwithin))
+sigma2v1<-resw$sse / ((N * (t -1)) - ncol(as.matrix(Xwithin[,-del])) - ncol(endogwithin))
-Hbetween<-cbind(Hbetween, as.matrix(WXbetween), as.matrix(WWXbetween))
+
endogbetween<-cbind(endogbetween, as.matrix(wybetween))
endogbetweennt<-matrix(,NT, ncol(endogbetween))
-for (i in 1:ncol(endogbetween)) endogbetweennt[,i]<-rep(endogbetween[,i], T)
-
-resb<-spgm.tsls(sqrt(T)*as.matrix(ybetween), sqrt(T)*as.matrix(endogbetween), sqrt(T)*Xbetween, sqrt(T)*as.matrix(Hbetween))
+for (i in 1:ncol(endogbetween)) endogbetweennt[,i]<-rep(endogbetween[,i], t)
+resb<-spgm.tsls(sqrt(t)*as.matrix(ybetween), sqrt(t)*as.matrix(endogbetween), sqrt(t)*Xbetween, sqrt(t)*as.matrix(Hbetween))
sigma21<-resb$sse / resb$df
ystar<-ywithin/sqrt(sigma2v1) + ybetweennt/sqrt(sigma21)
@@ -173,14 +279,13 @@
endogstar<-endogwithin/sqrt(sigma2v1) + endogbetweennt/sqrt(sigma21)
Hbetweennt<-matrix(,NT, ncol(Hbetween))
-for (i in 1:ncol(Hbetween)) Hbetweennt[,i]<-rep(Hbetween[,i], T)
+for (i in 1:ncol(Hbetween)) Hbetweennt[,i]<-rep(Hbetween[,i], t)
Hstar<- Hwithin/sqrt(sigma2v1) + Hbetweennt/sqrt(sigma21)
res <- spgm.tsls(ystar, endogstar, xstar, Hstar)
-
res$sigma1<- sigma21
-res$sigma1<- sigma2v1
+res$sigmav<- sigma2v1
res$type <- "Spatial g2sls model with additional endogenous variables"
}
}
Modified: pkg/R/ivplm.w2sls.R
===================================================================
--- pkg/R/ivplm.w2sls.R 2022-11-03 15:29:49 UTC (rev 250)
+++ pkg/R/ivplm.w2sls.R 2022-11-22 16:19:10 UTC (rev 251)
@@ -1,40 +1,87 @@
###### within 2sls
-ivplm.w2sls <- function(Y,X,H = NULL, endog = NULL, lag=FALSE, listw, lag.instruments,T,N,NT, twow = FALSE, listw2 = NULL){
+ivplm.w2sls <- function(Y,X,H = NULL, endog = NULL,
+ twow, lag = FALSE, listw = NULL, listw2 = NULL,
+ lag.instruments = NULL, t, N, NT, Durbin = FALSE, xdur){
+indic <- rep(1:N,t)
-indic <- rep(1:N,T)
+xdu <- X
+#print(head(xdu))
##transform y and X
-ywithin <-panel.transformations(Y,indic, type= "within")
-Xwithin <- panel.transformations(X, indic, type= "within")
-colnames(Xwithin)<-colnames(X)
-del <- which(diag(var(Xwithin)) == 0)
-Xwithin <- Xwithin[,-del]
-# print(Xwithin[1:5,])
+ywithin <- panel.transformations(Y, indic, type = "within")
+#transorm x incuding durbin
+if(isTRUE(Durbin) | inherits(Durbin, "formula")){
+
+ if(inherits(Durbin, "formula")){
+
+ colnmx <- colnames(X)
+ colnameswx <- paste("lag_", colnames(xdur), sep="")
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/splm -r 251
More information about the Splm-commits
mailing list