[Splm-commits] r176 - pkg/R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Nov 6 17:37:25 CET 2013
Author: gpiras
Date: 2013-11-06 17:37:24 +0100 (Wed, 06 Nov 2013)
New Revision: 176
Modified:
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
Log:
sparse matrices
Modified: pkg/R/ivplm.b2sls.R
===================================================================
--- pkg/R/ivplm.b2sls.R 2013-07-25 22:37:44 UTC (rev 175)
+++ pkg/R/ivplm.b2sls.R 2013-11-06 16:37:24 UTC (rev 176)
@@ -1,9 +1,15 @@
-ivplm.b2sls<-function(Y,X,H,endog, ind, tind, lag=FALSE, listw){
+###### 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){
+
+indic <- rep(1:N,T)
+
##transform y
-ybetween<-panel.transformations(Y,ind, type= "between")
+ybetween<-panel.transformations(Y,indic, type= "between")
+ndim <- length(ybetween)
+listwnn <- listw[1:ndim, 1:ndim]
-Xbetween<-panel.transformations(X,ind, type= "between")
+Xbetween<-panel.transformations(X,indic, type= "between")
colnames(Xbetween)<-colnames(X)
if (colnames(Xbetween)[1] == "(Intercept)") Xbetween<-Xbetween[,-1]
@@ -14,80 +20,111 @@
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))
+}
-if(!lag){
-##transform the instruments H
- Hbetween<-panel.transformations(H,ind, type= "between")
- endogbetween<-panel.transformations(endog,ind, type= "between")
+ endogbetween<-panel.transformations(endog,indic, type= "between")
colnames(endogbetween)<-colnames(endog)
-##tsls
-res<-spgm.tsls(sqrt(length(unique(tind)))*as.matrix(ybetween), sqrt(length(unique(tind)))*endogbetween, sqrt(length(unique(tind)))*Xbetween, sqrt(length(unique(tind)))*as.matrix(Hbetween) )
-#print(res$coefficients)
+
+res <-spgm.tsls(sqrt(T)*as.matrix(ybetween), sqrt(T)*endogbetween, sqrt(T)*Xbetween, sqrt(T)*as.matrix(Hbetween) )
+res$Hbetween <- Hbetween
}
-
else{
- wybetween <- lag.listw(listw, as.matrix(ybetween))
- colnames(wybetween) <- ("lambda")
-
+ wybetween <- listwnn %*% as.matrix(ybetween)
+ wybetween <- as.matrix(wybetween)
+ colnames(wybetween) <- ("lambda")
if(is.null(endog)){
-
- WXbetween <- matrix(nrow = nrow(Xbetween), ncol = ncol(Xbetween))
- WWXbetween <- matrix(nrow = nrow(Xbetween), ncol = ncol(WXbetween))
-for (i in 1:ncol(Xbetween)) {
- wx <- lag.listw(listw,Xbetween[,i])
- wwx <- lag.listw(listw,wx)
- if (any(is.na(wx)))
- stop("NAs in lagged independent variable")
- WXbetween[, i] <- wx
- WWXbetween[, i] <- wwx
- }
+
+ if(twow){
+
+ 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))
+
+ }
+else{
+
+ WXbetween <- as.matrix(listwnn %*% Xbetween)
+ WWXbetween <- as.matrix(listwnn %*% WXbetween)
Hbetween<-cbind(WXbetween, WWXbetween)
+
+ }
-res<-spgm.tsls(sqrt(length(unique(tind)))*as.matrix(ybetween), sqrt(length(unique(tind)))*as.matrix(wybetween), sqrt(length(unique(tind)))*Xbetween, sqrt(length(unique(tind)))*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
}
else{
- WXbetween <- matrix(nrow = nrow(Xbetween), ncol = ncol(Xbetween))
- WWXbetween <- matrix(nrow = nrow(Xbetween), ncol = ncol(WXbetween))
-for (i in 1:ncol(Xbetween)) {
- wx <- lag.listw(listw,Xbetween[,i])
- wwx <- lag.listw(listw,wx)
- if (any(is.na(wx)))
- stop("NAs in lagged independent variable")
- WXbetween[, i] <- wx
- WWXbetween[, i] <- wwx
- }
-
- ##transform the instruments H
- Hbetween<-panel.transformations(H,ind, type= "between")
+ Hbetween <- panel.transformations(H,indic, type= "between")
+
+if(lag.instruments ) {
+
+ L.Hbetween <- listwnn %*% Hbetween
+ L2.Hbetween <- listwnn %*% L.Hbetween
-Hbetween<-cbind(Hbetween, WXbetween, WWXbetween)
+ 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))
+}
-##transform the endogenous variables endog
- endogbetween<-panel.transformations(endog,ind, type= "between")
+ if(twow){
+ listw2nn <- listw2[1:ndim, 1:ndim]
+ WXbetween <- listwnn %*% Xbetween
+ WWXbetween <- listwnn %*% WXbetween
+ W2Xbetween <- listw2nn %*% Xbetween
+ W2WXbetween <- listw2nn %*% WXbetween
+ W2WWXbetween <- listw2nn %*% WWXbetween
+
+ Hbetween <-cbind(Hbetween, as.matrix(WXbetween), as.matrix(WWXbetween), as.matrix(W2Xbetween), as.matrix(W2WXbetween), as.matrix(W2WWXbetween))
+
+ }
+else{
+
+ WXbetween <- listwnn %*% Xbetween
+ WWXbetween <- listwnn %*% WXbetween
+ Hbetween <-cbind(Hbetween, as.matrix(WXbetween), as.matrix(WWXbetween))
+
+ }
+
+ ##transform the endogenous variables endog
+ endogbetween<-panel.transformations(endog,indic, type= "between")
endogbetween<-cbind(endogbetween, wybetween)
-if(is.null(colnames(endog))) colnames(endogbetween)<-c(rep("endog", (ncol(endogbetween)-1)), "lambda")
-else colnames(endogbetween)<-c(colnames(endog), "lambda")
+colnames(endogbetween)<-c(colnames(endog), "lambda")
-res<-spgm.tsls(sqrt(length(unique(tind)))*as.matrix(ybetween), sqrt(length(unique(tind)))*endogbetween, sqrt(length(unique(tind)))*Xbetween, sqrt(length(unique(tind)))*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
@@ -95,3 +132,4 @@
+
Modified: pkg/R/ivplm.ec2sls.R
===================================================================
--- pkg/R/ivplm.ec2sls.R 2013-07-25 22:37:44 UTC (rev 175)
+++ pkg/R/ivplm.ec2sls.R 2013-11-06 16:37:24 UTC (rev 176)
@@ -1,53 +1,66 @@
-ivplm.ec2sls<-function(Y,X,H,endog, ind, tind, lag=FALSE, listw){
- N<-length(unique(ind))
- T<-length(unique(tind))
- indt<-rep(seq(1,N), T)
- tindt<-rep(seq(1,T), each = N)
- tord<-order(indt,tindt)
+# # # # # ec 2sls
+ivplm.ec2sls <- function(Y,X,H = NULL, endog = NULL, lag=FALSE, listw, lag.instruments, T = T, N = N, NT = NT ){
+
+indic <- rep(1:N,T)
+listwnn <- listw[1:N, 1:N]
+
##transform y
-transy<-panel.transformations(Y,ind, type= "both")
+transy<-panel.transformations(Y,indic, type= "both")
ybetween<-transy[[2]]
ywithin<-transy[[1]]
-ybetweennt<- rep(ybetween, each=length(unique(tind)))
+ybetweennt<- rep(ybetween, T)
##transform X
-transx<-panel.transformations(X,ind, type= "both")
+transx<-panel.transformations(X,indic, type= "both")
Xbetween<-transx[[2]]
Xwithin<-transx[[1]]
colnames(Xwithin)<-colnames(X)
colnames(Xbetween)<-colnames(X)
-Xbetweennt<-matrix(,nrow(Xwithin), ncol(Xbetween))
-for (i in 1:ncol(Xbetween)) Xbetweennt[,i]<-rep(Xbetween[,i],each= length(unique(tind)))
+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,ind, type= "both")
+transH<-panel.transformations(H,indic, type= "both")
Hbetween<-transH[[2]]
Hwithin<-transH[[1]]
-Hbetweennt<-matrix(,nrow(Hwithin), ncol(Hbetween))
-for (i in 1:ncol(Hbetween)) Hbetweennt[,i]<-rep(Hbetween[,i],each= length(unique(tind)))
+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,ind, type= "both")
+transendog<-panel.transformations(endog,indic, type= "both")
endogbetween<-transendog[[2]]
endogwithin<-transendog[[1]]
-endogbetweennt<-matrix(,length(ind), ncol(endogbetween))
-for (i in 1:ncol(endogbetween)) endogbetweennt[,i]<-rep(endogbetween[,i],each= length(unique(tind)))
+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 / ((length(unique(ind)) * (length(unique(tind)) -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(length(unique(tind)))*as.matrix(ybetween), sqrt(length(unique(tind)))*as.matrix(endogbetween), sqrt(length(unique(tind)))*Xbetween, sqrt(length(unique(tind)))*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
@@ -55,9 +68,7 @@
xstar<-Xwithin/sqrt(sigma2v1) + Xbetweennt/sqrt(sigma21)
endogstar<-endogwithin/sqrt(sigma2v1) + endogbetweennt/sqrt(sigma21)
-
-Hins<-cbind(Xwithin,Xbetweennt,Hwithin,Hbetweennt)
-
+Hins <- cbind(Xwithin,Xbetweennt,Hwithin,Hbetweennt)
res<-spgm.tsls(ystar, endogstar, xstar, Hinst = Hins, instr = TRUE )
res$sigma1<-sigma21
res$sigmav<-sigma2v1
@@ -66,126 +77,118 @@
else{
- wy<-lag.listwpanel(listw, Y, tind)
- wy<-wy[tord]
+
+ wy <- listw %*% Y
- wywithin <- lag.listwpanel(listw, ywithin, tind)
- wywithin <-wywithin[tord]
+ wywithin <- listw %*% ywithin
wywithin <- as.matrix(wywithin)
colnames(wywithin)<-"lambda"
- wybetween <- lag.listw(listw, as.matrix(ybetween))
+
+ wybetween <- listwnn %*% as.matrix(ybetween)
colnames(wybetween) <- ("lambda")
+
+ WXwithin <- as.matrix(listw %*% Xwithin)
+ WWXwithin <- as.matrix(listw %*% WXwithin)
+ WXbetween <- as.matrix(listwnn %*% Xbetween)
+ WWXbetween <- as.matrix(listwnn %*% WXbetween)
- WXwithin <- matrix(nrow = nrow(Xwithin), ncol = ncol(Xwithin))
- WWXwithin <- matrix(nrow = nrow(Xwithin), ncol = ncol(Xwithin))
-
-for (i in 1:ncol(Xwithin)) {
- wx<- lag.listwpanel(listw, Xwithin[,i], tind)
- wwx<- lag.listwpanel(listw, wx, tind)
-
- if (any(is.na(wx)))
- stop("NAs in lagged independent variable")
- WXwithin[, i] <- wx
- WWXwithin[, i] <- wwx
- }
-
-WXwithin <- WXwithin[tord,]
-WWXwithin <- WWXwithin[tord,]
-
-
-
- WXbetween <- matrix(nrow = nrow(Xbetween), ncol = ncol(Xbetween))
- WWXbetween <- matrix(nrow = nrow(Xbetween), ncol = ncol(WXbetween))
-for (i in 1:ncol(Xbetween)) {
- wx <- lag.listw(listw,Xbetween[,i])
- wwx <- lag.listw(listw,wx)
- if (any(is.na(wx)))
- stop("NAs in lagged independent variable")
- WXbetween[, i] <- wx
- WWXbetween[, i] <- wwx
- }
-
-
if(is.null(endog)){
-
Hwithin<-cbind(WXwithin, WWXwithin)
-
resw<-spgm.tsls(ywithin, wywithin, Xwithin, Hwithin)
-sigma2v1<- resw$sse / ((length(unique(ind)) * (length(unique(tind)) -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(length(unique(tind)))*as.matrix(ybetween), sqrt(length(unique(tind)))*as.matrix(wybetween), sqrt(length(unique(tind)))*Xbetween, sqrt(length(unique(tind)))*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(wybetween, each=length(unique(tind)))/sqrt(sigma21)
+endogstar<-wywithin/sqrt(sigma2v1) + rep(as.matrix(wybetween), T)/sqrt(as.numeric(sigma21))
endogstar<-as.matrix(endogstar)
colnames(endogstar)<-"lambda"
-Hbetweennt<-matrix(,length(ind), ncol(Hbetween))
-for (i in 1:ncol(Hbetween)) Hbetweennt[,i]<-rep(Hbetween[,i],each= length(unique(tind)))
+Hbetweennt<-matrix(,NT, ncol(Hbetween))
+for (i in 1:ncol(Hbetween)) Hbetweennt[,i]<-rep(Hbetween[,i],T)
-A<-cbind(1, Xwithin, Xbetweennt, Hwithin, Hbetweennt)
+A <- cbind(1, Xwithin, Xbetweennt, Hwithin, Hbetweennt)
-
res <- spgm.tsls(ystar, endogstar, xstar, Hinst = A, instr = TRUE)
res$sigma1 <- sigma21
res$sigmav <- sigma2v1
+}
+else{
+transH <- panel.transformations(H,indic, type= "both")
+Hbetween <- transH[[2]]
+Hwithin<-transH[[1]]
-}
+if(lag.instruments ) {
+
+ L.Hwithin <- as.matrix(listw %*% Hwithin)
+ L2.Hwithin <- as.matrix(listw %*% L.Hwithin)
+ Hwithin <- cbind(Hwithin, L.Hwithin, L2.Hwithin)
-else{
+ L.Hbetween <- as.matrix(listwnn %*% Hbetween)
+ L2.Hbetween <- as.matrix(listwnn %*% L.Hbetween)
+ Hbetween <- cbind(Hbetween, L.Hbetween, L2.Hbetween)
+
+}
+Hbetweennt<-matrix(,NT, ncol(Hbetween))
+for (i in 1:ncol(Hbetween)) Hbetweennt[,i]<-rep(Hbetween[,i], T)
-transH<-panel.transformations(H,ind, type= "both")
-Hbetween<-transH[[2]]
-Hwithin<-transH[[1]]
-Hbetweennt<-matrix(,length(ind), ncol(Hbetween))
-for (i in 1:ncol(Hbetween)) Hbetweennt[,i]<-rep(Hbetween[,i],each= length(unique(tind)))
-
Hwithin<-cbind(Hwithin, WXwithin, WWXwithin)
-transendog<-panel.transformations(endog,ind, type= "both")
+transendog<-panel.transformations(endog,indic, type= "both")
endogbetween<-transendog[[2]]
endogwithin<-transendog[[1]]
-endogbetweennt<-matrix(,length(ind), ncol(endogbetween))
-for (i in 1:ncol(endogbetween)) endogbetweennt[,i]<-rep(endogbetween[,i],each= length(unique(tind)))
+# endogbetweennt<-matrix(,NT, ncol(endogbetween))
+# for (i in 1:ncol(endogbetween)) endogbetweennt[,i]<-rep(endogbetween[,i], T)
+
endogwithin<-cbind(endogwithin, wywithin)
+colnames(endogwithin) <- c(colnames(endog), "lambda")
resw<-spgm.tsls(as.matrix(ywithin), as.matrix(endogwithin), Xwithin, Hwithin )
-sigma2v1<-resw$sse / ((length(unique(ind)) * (length(unique(tind)) -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)
-endogbetween<-cbind(endogbetween, wybetween)
+Hbetween <- cbind(Hbetween, WXbetween, WWXbetween)
+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)
-resb<-spgm.tsls(sqrt(length(unique(tind)))*as.matrix(ybetween), sqrt(length(unique(tind)))*as.matrix(endogbetween), sqrt(length(unique(tind)))*Xbetween, sqrt(length(unique(tind)))*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
+
ystar<-ywithin/sqrt(sigma2v1) + ybetweennt/sqrt(sigma21)
xstar<-Xwithin/sqrt(sigma2v1) + Xbetweennt/sqrt(sigma21)
-endogstar<-endogwithin/sqrt(sigma2v1) + rep(endogbetween, each=length(unique(tind)))/sqrt(sigma21)
+# print(dim(endogwithin))
+# print(dim(as.matrix(endogbetween)))
+endogstar<-endogwithin/sqrt(sigma2v1) + as.matrix(endogbetweennt)/sqrt(as.numeric(sigma21))
+# print(sigma2v1)
+# print(sigma21)
-Hbetweennt<-matrix(,length(ind), ncol(Hbetween))
-for (i in 1:ncol(Hbetween)) Hbetweennt[,i]<-rep(Hbetween[,i],each= length(unique(tind)))
+Hbetweennt<-matrix(,NT, ncol(Hbetween))
+for (i in 1:ncol(Hbetween)) Hbetweennt[,i]<-rep(Hbetween[,i], T)
A<-cbind(1,Xwithin[,-del],Xbetweennt[,-del], Hwithin, Hbetweennt)
res <- spgm.tsls(ystar, endogstar, xstar, Hinst = A, instr = TRUE)
+# print(res$coefficients)
res$sigma1<- sigma21
res$sigma1<- sigma2v1
@@ -198,3 +201,6 @@
res
}
+
+
+
Modified: pkg/R/ivplm.g2sls.R
===================================================================
--- pkg/R/ivplm.g2sls.R 2013-07-25 22:37:44 UTC (rev 175)
+++ pkg/R/ivplm.g2sls.R 2013-11-06 16:37:24 UTC (rev 176)
@@ -1,53 +1,64 @@
-ivplm.g2sls<-function(Y,X,H,endog, ind, tind, lag=FALSE, listw){
+# # # # # g2sls
- N<-length(unique(ind))
- T<-length(unique(tind))
- indt<-rep(seq(1,N), T)
- tindt<-rep(seq(1,T), each = N)
- tord<-order(indt,tindt)
+ivplm.g2sls <-function(Y,X,H = NULL,endog = NULL, lag=FALSE, listw, lag.instruments, T = T, N = N, NT = NT){
+indic <- rep(1:N,T)
+listwnn <- listw[1:N,1:N]
##transform y
-transy<-panel.transformations(Y,ind, type= "both")
+transy<-panel.transformations(Y,indic, type= "both")
ybetween<-transy[[2]]
ywithin<-transy[[1]]
-ybetweennt<- rep(ybetween, each=length(unique(tind)))
+ybetweennt<- rep(ybetween, T)
##transform X
-transx<-panel.transformations(X,ind, type= "both")
+transx<-panel.transformations(X,indic, type= "both")
Xbetween<-transx[[2]]
Xwithin<-transx[[1]]
colnames(Xwithin)<-colnames(X)
colnames(Xbetween)<-colnames(X)
-Xbetweennt<-matrix(,nrow(Xwithin), ncol(Xbetween))
-for (i in 1:ncol(Xbetween)) Xbetweennt[,i]<-rep(Xbetween[,i],each= length(unique(tind)))
+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,ind, type= "both")
+transH<-panel.transformations(H, indic, type= "both")
Hbetween<-transH[[2]]
Hwithin<-transH[[1]]
-Hbetweennt<-matrix(,nrow(Hwithin), ncol(Hbetween))
-for (i in 1:ncol(Hbetween)) Hbetweennt[,i]<-rep(Hbetween[,i],each= length(unique(tind)))
+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,ind, type= "both")
+transendog<-panel.transformations(endog, indic, type= "both")
endogbetween<-transendog[[2]]
endogwithin<-transendog[[1]]
-endogbetweennt<-matrix(,length(ind), ncol(endogbetween))
-for (i in 1:ncol(endogbetween)) endogbetweennt[,i]<-rep(endogbetween[,i],each= length(unique(tind)))
+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 / ((length(unique(ind)) * (length(unique(tind)) -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(length(unique(tind)))*as.matrix(ybetween), sqrt(length(unique(tind)))*as.matrix(endogbetween), sqrt(length(unique(tind)))*Xbetween, sqrt(length(unique(tind)))*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
@@ -65,46 +76,20 @@
}
else{
- wy<-lag.listwpanel(listw, Y, tind)
- wy<-wy[tord]
-
- wywithin <- lag.listwpanel(listw, ywithin, tind)
- wywithin <-wywithin[tord]
+ wy<-listw %*% Y
+ wy <- as.matrix(wy)
+ colnames(wy)<-"lambda"
+ wywithin <- listw %*% ywithin
wywithin <- as.matrix(wywithin)
colnames(wywithin)<-"lambda"
- wybetween <- lag.listw(listw, as.matrix(ybetween))
- colnames(wybetween) <- ("lambda")
+ wybetween <- listwnn %*% as.matrix(ybetween)
+ colnames(wybetween) <- "lambda"
+ WXwithin <- as.matrix(listw %*% Xwithin)
+ WWXwithin <- as.matrix(listw %*% WXwithin)
- WXwithin <- matrix(nrow = nrow(Xwithin), ncol = ncol(Xwithin))
- WWXwithin <- matrix(nrow = nrow(Xwithin), ncol = ncol(Xwithin))
-
-for (i in 1:ncol(Xwithin)) {
- wx<- lag.listwpanel(listw, Xwithin[,i], tind)
- wwx<- lag.listwpanel(listw, wx, tind)
-
- if (any(is.na(wx)))
- stop("NAs in lagged independent variable")
- WXwithin[, i] <- wx
- WWXwithin[, i] <- wwx
- }
-
-WXwithin <- WXwithin[tord,]
-WWXwithin <- WWXwithin[tord,]
-
-
-
- WXbetween <- matrix(nrow = nrow(Xbetween), ncol = ncol(Xbetween))
- WWXbetween <- matrix(nrow = nrow(Xbetween), ncol = ncol(WXbetween))
-for (i in 1:ncol(Xbetween)) {
- wx <- lag.listw(listw,Xbetween[,i])
- wwx <- lag.listw(listw,wx)
- if (any(is.na(wx)))
- stop("NAs in lagged independent variable")
- WXbetween[, i] <- wx
- WWXbetween[, i] <- wwx
- }
-
+ WXbetween <- as.matrix(listwnn %*% Xbetween)
+ WWXbetween <- as.matrix(listwnn %*% WXbetween)
if(is.null(endog)){
@@ -112,23 +97,23 @@
resw<-spgm.tsls(ywithin, wywithin, Xwithin, Hwithin)
-sigma2v1<- resw$sse / ((length(unique(ind)) * (length(unique(tind)) -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(length(unique(tind)))*as.matrix(ybetween), sqrt(length(unique(tind)))*as.matrix(wybetween), sqrt(length(unique(tind)))*Xbetween, sqrt(length(unique(tind)))*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(wybetween, each=length(unique(tind)))/sqrt(sigma21)
+endogstar<-wywithin/sqrt(sigma2v1) + rep(as.matrix(wybetween), T)/sqrt(as.numeric(sigma21))
endogstar<-as.matrix(endogstar)
colnames(endogstar)<-"lambda"
-Hbetweennt<-matrix(,length(ind), ncol(Hbetween))
-for (i in 1:ncol(Hbetween)) Hbetweennt[,i]<-rep(Hbetween[,i],each= length(unique(tind)))
+Hbetweennt<-matrix(,NT, ncol(Hbetween))
+for (i in 1:ncol(Hbetween)) Hbetweennt[,i]<-rep(Hbetween[,i], T)
Hstar<-Hwithin/sqrt(sigma2v1) + Hbetweennt/sqrt(sigma21)
@@ -142,39 +127,53 @@
else{
-transH<-panel.transformations(H,ind, type= "both")
+transH<-panel.transformations(H, indic, type= "both")
Hbetween<-transH[[2]]
Hwithin<-transH[[1]]
-Hbetweennt<-matrix(,length(ind), ncol(Hbetween))
-for (i in 1:ncol(Hbetween)) Hbetweennt[,i]<-rep(Hbetween[,i],each= length(unique(tind)))
+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)
+
+}
+
+
+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,ind, type= "both")
+transendog<-panel.transformations(endog, indic, type= "both")
endogbetween<-transendog[[2]]
endogwithin<-transendog[[1]]
-endogbetweennt<-matrix(,length(ind), ncol(endogbetween))
-for (i in 1:ncol(endogbetween)) endogbetweennt[,i]<-rep(endogbetween[,i],each= length(unique(tind)))
endogwithin<-cbind(endogwithin, wywithin)
resw<-spgm.tsls(as.matrix(ywithin), as.matrix(endogwithin), Xwithin, Hwithin )
-sigma2v1<-resw$sse / ((length(unique(ind)) * (length(unique(tind)) -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)
-endogbetween<-cbind(endogbetween, wybetween)
+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(length(unique(tind)))*as.matrix(ybetween), sqrt(length(unique(tind)))*as.matrix(endogbetween), sqrt(length(unique(tind)))*Xbetween, sqrt(length(unique(tind)))*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
ystar<-ywithin/sqrt(sigma2v1) + ybetweennt/sqrt(sigma21)
xstar<-Xwithin/sqrt(sigma2v1) + Xbetweennt/sqrt(sigma21)
-endogstar<-endogwithin/sqrt(sigma2v1) + rep(endogbetween, each=length(unique(tind)))/sqrt(sigma21)
+endogstar<-endogwithin/sqrt(sigma2v1) + endogbetweennt/sqrt(sigma21)
-Hbetweennt<-matrix(,length(ind), ncol(Hbetween))
-for (i in 1:ncol(Hbetween)) Hbetweennt[,i]<-rep(Hbetween[,i],each= length(unique(tind)))
+Hbetweennt<-matrix(,NT, ncol(Hbetween))
+for (i in 1:ncol(Hbetween)) Hbetweennt[,i]<-rep(Hbetween[,i], T)
Hstar<- Hwithin/sqrt(sigma2v1) + Hbetweennt/sqrt(sigma21)
Modified: pkg/R/ivplm.w2sls.R
===================================================================
--- pkg/R/ivplm.w2sls.R 2013-07-25 22:37:44 UTC (rev 175)
+++ pkg/R/ivplm.w2sls.R 2013-11-06 16:37:24 UTC (rev 176)
@@ -1,154 +1,140 @@
-ivplm.w2sls<-function(Y,X,H,endog, ind, tind, lag=FALSE, listw){
+###### within 2sls
+ivplm.w2sls <- function(Y,X,H = NULL, endog = NULL, lag=FALSE, listw, lag.instruments,T,N,NT, twow = FALSE, listw2 = NULL){
- N<-length(unique(ind))
- T<-length(unique(tind))
- indt<-rep(seq(1,N), T)
- tindt<-rep(seq(1,T), each = N)
- tord<-order(indt,tindt)
+indic <- rep(1:N,T)
+##transform y and X
+ywithin <-panel.transformations(Y,indic, type= "within")
+Xwithin <- panel.transformations(X, indic, type= "within")
-
-##transform y
-transy<-panel.transformations(Y,ind, type= "both")
-ybetween<-transy[[2]]
-ywithin<-transy[[1]]
-
-
-##transform X
-transx<-panel.transformations(X,ind, type= "both")
-Xbetween<-transx[[2]]
-Xwithin<-transx[[1]]
colnames(Xwithin)<-colnames(X)
-colnames(Xbetween)<-colnames(X)
-del<- which(diag(var(Xwithin))==0)
+del <- which(diag(var(Xwithin)) == 0)
+Xwithin <- Xwithin[,-del]
-
if(!lag){
-
##transform the instruments H
-transH<-panel.transformations(H,ind, type= "both")
-Hbetween<-transH[[2]]
-Hwithin<-transH[[1]]
+Hwithin <-panel.transformations(H, indic, type= "within")
+if(lag.instruments) {
+
+ L.Hwithin <- as.matrix(listw %*% Hwithin)
+ L2.Hwithin <- as.matrix(listw %*% L.Hwithin)
+ Hwithin <- cbind(Hwithin, as.matrix(L.Hwithin), as.matrix(L2.Hwithin))
+
+}
+
+
##transform the endogenous variables endog
-transendog<-panel.transformations(endog,ind, type= "both")
-endogbetween<-transendog[[2]]
-endogwithin<-transendog[[1]]
+endogwithin <-panel.transformations(endog, indic, type= "within")
colnames(endogwithin)<-colnames(endog)
-colnames(endogbetween)<-colnames(endog)
-
-
-res<-spgm.tsls(as.matrix(ywithin), as.matrix(endogwithin), Xwithin, as.matrix(Hwithin) )
-#print(res$coefficients)
-varb<-res$var *res$df /((length(unique(ind)) * (length(unique(tind)) -1)) - ncol(as.matrix(Xwithin[,-del])) - ncol(endogwithin))
-
+res<-spgm.tsls(as.matrix(ywithin), as.matrix(endogwithin), Xwithin, as.matrix(Hwithin))
+varb<-res$var *res$df /((N * (T -1)) - ncol(as.matrix(Xwithin)) - ncol(endogwithin))
res$var<-varb
+sigma2v1<- res$sse/ ((N * (T -1)) - ncol(as.matrix(Xwithin)) - ncol(endogwithin))
+res$sigmav<- sigma2v1
+res$Hwithin <- Hwithin
-sigma2v1<- res$sse / ((length(unique(ind)) * (length(unique(tind)) -1)) - ncol(as.matrix(Xwithin[,-del])) - ncol(endogwithin))
-res$sigmav<- sigma2v1
-
-
-res
}
else{
-
- wywithin <- lag.listwpanel(listw, ywithin, tind)
- wywithin <-wywithin[tord]
+
+ wywithin <- listw %*% as.matrix(ywithin)
wywithin <- as.matrix(wywithin)
colnames(wywithin)<-"lambda"
-
if(is.null(endog)){
-
-
- WXwithin <- matrix(nrow = nrow(Xwithin), ncol = ncol(Xwithin))
- WWXwithin <- matrix(nrow = nrow(Xwithin), ncol = ncol(Xwithin))
-
-for (i in 1:ncol(Xwithin)) {
- wx<- lag.listwpanel(listw, Xwithin[,i], tind)
- wwx<- lag.listwpanel(listw, wx, tind)
-
- if (any(is.na(wx)))
- stop("NAs in lagged independent variable")
- WXwithin[, i] <- wx
- WWXwithin[, i] <- wwx
- }
-
-Hwithin<-cbind(WXwithin, WWXwithin)
-Hwithin<-Hwithin[tord,]
-
+ if(twow){
+
+ WXwithin <- listw %*% Xwithin
+ WWXwithin <- listw %*% WXwithin
+ W2Xwithin <- listw2 %*% Xwithin
+ W2WXwithin <- listw2 %*% WXwithin
+ W2WWXwithin <- listw2 %*% WWXwithin
+
+ Hwithin <-cbind(as.matrix(WXwithin), as.matrix(WWXwithin), as.matrix(W2Xwithin), as.matrix(W2WXwithin), as.matrix(W2WWXwithin))
-res<-spgm.tsls(ywithin, wywithin, Xwithin, Hwithin )
+ }
+else{
+
+ WXwithin <- listw %*% Xwithin
+ WWXwithin <- listw %*% WXwithin
+ Hwithin <-cbind(as.matrix(WXwithin), as.matrix(WWXwithin))
+
+ }
-varb<-res$var *res$df / ((length(unique(ind)) * (length(unique(tind)) -1)) - ncol(as.matrix(Xwithin[,-del])) - 1)
+res<-spgm.tsls(ywithin, wywithin, Xwithin, Hwithin)
+varb<-res$var *res$df / ((N * (T -1)) - ncol(as.matrix(Xwithin)) - 1)
res$var<-varb
-
-sigma2v1<- res$sse / ((length(unique(ind)) * (length(unique(tind)) -1)) - ncol(as.matrix(Xwithin[,-del])) - 1)
-res$sigmav<- sigma2v1
-
+sigma2v1<- res$sse / ((N * (T -1)) - ncol(as.matrix(Xwithin)) - 1)
+res$sigmav <- sigma2v1
+res$Hwithin <- Hwithin
}
else{
+
+ Hwithin <-panel.transformations(H, indic, type= "within")
+
+if(lag.instruments ) {
+ L.Hwithin <- listw %*% Hwithin
+ L2.Hwithin <- listw %*% L.Hwithin
- WXwithin <- matrix(nrow = nrow(Xwithin), ncol = ncol(Xwithin))
- WWXwithin <- matrix(nrow = nrow(Xwithin), ncol = ncol(Xwithin))
-for (i in 1:ncol(Xwithin)) {
- wx<- lag.listwpanel(listw, Xwithin[,i], tind)
- wwx<- lag.listwpanel(listw, wx, tind)
-
- if (any(is.na(wx)))
- stop("NAs in lagged independent variable")
- WXwithin[, i] <- wx
- WWXwithin[, i] <- wwx
- }
+ if(twow){
+
+ w2.Hwithin <- as.matrix(listw2 %*% Hwithin)
+ w2w.Hwithin <- as.matrix(listw2 %*% L.Hwithin)
+ w2ww.Hwithin <- as.matrix(listw2 %*% L2.Hwithin)
+ Hwithin <- cbind(Hwithin, as.matrix(L.Hwithin), as.matrix(L2.Hwithin), w2.Hwithin, w2w.Hwithin, w2ww.Hwithin)
-WXwithin<-WXwithin[tord,]
-WWXwithin<-WWXwithin[tord,]
+ }
+
+ else Hwithin <- cbind(Hwithin, as.matrix(L.Hwithin), as.matrix(L2.Hwithin))
+}
-##transform the instruments H
-transH<-panel.transformations(H,ind, type= "both")
-Hbetween<-transH[[2]]
-Hwithin<-transH[[1]]
+ if(twow){
+
+ WXwithin <- listw %*% Xwithin
+ WWXwithin <- listw %*% WXwithin
+ W2Xwithin <- listw2 %*% Xwithin
+ W2WXwithin <- listw2 %*% WXwithin
+ W2WWXwithin <- listw2 %*% WWXwithin
+
+ Hwithin <-cbind(Hwithin, as.matrix(WXwithin), as.matrix(WWXwithin), as.matrix(W2Xwithin), as.matrix(W2WXwithin), as.matrix(W2WWXwithin))
+
+ }
+else{
+
+ WXwithin <- listw %*% Xwithin
+ WWXwithin <- listw %*% WXwithin
+ Hwithin <-cbind(Hwithin, as.matrix(WXwithin), as.matrix(WWXwithin))
+
+ }
-Hwithin<-cbind(Hwithin, WXwithin, WWXwithin)
-##transform the endogenous variables endog
-transendog<-panel.transformations(endog,ind, type= "both")
-endogbetween<-transendog[[2]]
-endogwithin<-transendog[[1]]
+endogwithin <- panel.transformations(endog, indic, type= "within")
-colnames(endogbetween)<-colnames(endog)
+endogwithin <-cbind(endogwithin, wywithin)
+colnames(endogwithin)<-c(colnames(endog), "lambda")
+colnames(Xwithin)<-colnames(X)[-del]
-
-endogwithin<-cbind(endogwithin, wywithin)
-
-if(is.null(colnames(endog))) colnames(endogwithin)<-c(rep("endog", (ncol(endogwithin)-1)), "lambda")
-else colnames(endogwithin)<-c(colnames(endog), "lambda")
-
-colnames(Xwithin)<-colnames(X)
-
-
res<-spgm.tsls(ywithin, endogwithin, Xwithin, Hwithin)
-
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/splm -r 176
More information about the Splm-commits
mailing list