From noreply at r-forge.r-project.org  Tue Apr 29 17:33:26 2025
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Tue, 29 Apr 2025 17:33:26 +0200 (CEST)
Subject: [Splm-commits] r260 - in pkg: . R
Message-ID: <20250429153326.E3897180AE0@r-forge.r-project.org>

Author: gpiras
Date: 2025-04-29 17:33:26 +0200 (Tue, 29 Apr 2025)
New Revision: 260

Modified:
   pkg/ChangeLog
   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/spgm.R
   pkg/R/utilities_GM.R
Log:
commit changes mail from K. Fourrey

Modified: pkg/ChangeLog
===================================================================
--- pkg/ChangeLog	2023-12-11 15:04:29 UTC (rev 259)
+++ pkg/ChangeLog	2025-04-29 15:33:26 UTC (rev 260)
@@ -1,3 +1,6 @@
+Changes in Version 1.6-6
+ o See mail Kevin Fourrey 
+
 Changes in Version 1.5-0
  o Fixed effects methods (spfeml) are now based on the data transformation infrastructure of plm, so that (as already happens in spreml) calls to panel functions in the formula are supported: e.g., to slag() to do Spatial Durbin models 
 

Modified: pkg/DESCRIPTION
===================================================================
--- pkg/DESCRIPTION	2023-12-11 15:04:29 UTC (rev 259)
+++ pkg/DESCRIPTION	2025-04-29 15:33:26 UTC (rev 260)
@@ -1,7 +1,7 @@
 Package: splm
 Title: Econometric Models for Spatial Panel Data
-Version: 1.6-5
-Date: 2023-12-11
+Version: 1.6-6
+Date: 2025-04-29
 Authors at R: c(person(given = "Giovanni", family = "Millo", role = c("aut", "cre"), email = "giovanni.millo at deams.units.it"),
              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	2023-12-11 15:04:29 UTC (rev 259)
+++ pkg/R/ivplm.b2sls.R	2025-04-29 15:33:26 UTC (rev 260)
@@ -19,7 +19,13 @@
     
     colnmx <- colnames(X)
     colnamesbx <- paste("lag_", colnames(xdur), sep="")
-    wx <- listw %*% xdur
+    
+    wx <- do.call(rbind, lapply(1:t, function(i) {
+      idx <- ((i - 1) * N + 1):(i * N)
+      listw %*% xdur[idx, ]
+    }))
+    
+    #wx <- listw %*% xdur
     X <- cbind(X, wx)
     Xbetween <- panel.transformations(X, indic, type= "between")
     colnames(Xbetween) <- c(colnmx, colnamesbx)
@@ -40,8 +46,13 @@
     colnmx <- colnames(X)
     
     if(colnmx[1] == "(Intercept)"){
-    
-        wx <- listw %*% X[,-1]
+      
+      wx <- do.call(rbind, lapply(1:t, function(i) {
+        idx <- ((i - 1) * N + 1):(i * N)
+        listw %*% xdur[idx, ]
+      }))
+      
+        wx <- wx[,-1]
         colnameswx <- paste("lag_", colnames(X)[-1], sep = "")
         xdu <- cbind(xdu, wx)
         colnames(xdu) <- c(colnmx, colnameswx)
@@ -48,8 +59,14 @@
         
     }
     else{
+      
+      wx <- do.call(rbind, lapply(1:t, function(i) {
+        idx <- ((i - 1) * N + 1):(i * N)
+        listw %*% X[idx, ]
+      }))
+      
     
-      wx <- listw %*% X
+      #wx <- listw %*% X
       colnameswx <- paste("lag_", colnames(X), sep = "")
       xdu <- cbind(xdu, wx)
       colnames(xdu) <- c(colnmx, colnameswx)

Modified: pkg/R/ivplm.ec2sls.R
===================================================================
--- pkg/R/ivplm.ec2sls.R	2023-12-11 15:04:29 UTC (rev 259)
+++ pkg/R/ivplm.ec2sls.R	2025-04-29 15:33:26 UTC (rev 260)
@@ -24,7 +24,14 @@
     
     colnmx <- colnames(X)
     colnameswx <- paste("lag_", colnames(xdur), sep="")
-    wx <- listw %*% xdur
+    
+    wx <- do.call(rbind, lapply(1:t, function(i) {
+      idx <- ((i - 1) * N + 1):(i * N)
+      listw %*% xdur[idx, ]
+    }))
+    
+    
+    #wx <- listw %*% xdur
     X <- cbind(X, wx)
     
     transx   <- panel.transformations(X,indic, type= "both")
@@ -48,11 +55,23 @@
     colnmx <- colnames(X)
     
     if(colnames(X)[1] == "(Intercept)"){
-      wx <- listw %*% X[,-1]  
+      
+      wx <- do.call(rbind, lapply(1:t, function(i) {
+        idx <- ((i - 1) * N + 1):(i * N)
+        listw %*% X[idx, ]
+      }))
+      
+      wx <- wx[,-1]  
       colnameswx <- paste("lag_", colnames(X)[-1], sep="")
     }   
     else {
-      wx <- listw %*% X
+      
+      wx <- do.call(rbind, lapply(1:t, function(i) {
+        idx <- ((i - 1) * N + 1):(i * N)
+        listw %*% X[idx, ]
+      }))
+      
+      #wx <- listw %*% X
       colnameswx <- paste("lag_", colnames(X), sep="")
     }
     
@@ -133,9 +152,11 @@
 
 else{
 	
-     wy        <- listw %*%  Y
-     wywithin  <- listw %*% ywithin
-     wywithin  <- as.matrix(wywithin)
+  wy <- matrix(listw %*% matrix(Y, nrow = N, ncol = t), ncol = 1)
+     #wy        <- listw %*%  Y
+  wywithin <- matrix(listw %*% matrix(ywithin, nrow = N, ncol = t), ncol = 1)
+     #wywithin  <- listw %*% ywithin
+     #wywithin  <- as.matrix(wywithin)
      colnames(wywithin)<-"lambda"
   	 wybetween <- listwnn %*% as.matrix(ybetween)
      colnames(wybetween) <- ("lambda")
@@ -150,12 +171,38 @@
 
   if(twow){
     
-    WXwithin <- listw %*%  Xwithin
-    WWXwithin <- listw %*% WXwithin
-    W2Xwithin <- listw2 %*%  Xwithin
-    W2WXwithin <- listw2 %*% WXwithin
-    W2WWXwithin <- listw2 %*% WWXwithin
     
+    WXwithin <- do.call(rbind, lapply(1:t, function(i) {
+      idx <- ((i - 1) * N + 1):(i * N)
+      listw %*% Xwithin[idx, ]
+    }))
+    
+    WWXwithin <- do.call(rbind, lapply(1:t, function(i) {
+      idx <- ((i - 1) * N + 1):(i * N)
+      listw %*% WXwithin[idx, ]
+    }))
+    
+    W2Xwithin <- do.call(rbind, lapply(1:t, function(i) {
+      idx <- ((i - 1) * N + 1):(i * N)
+      listw2 %*% Xwithin[idx, ]
+    }))
+    
+    W2WXwithin <- do.call(rbind, lapply(1:t, function(i) {
+      idx <- ((i - 1) * N + 1):(i * N)
+      listw2 %*% WXwithin[idx, ]
+    }))
+    
+    W2WWXwithin <- do.call(rbind, lapply(1:t, function(i) {
+      idx <- ((i - 1) * N + 1):(i * N)
+      listw2 %*% WWXwithin[idx, ]
+    }))
+    
+    #WXwithin <- listw %*%  Xwithin
+    #WWXwithin <- listw %*% WXwithin
+    #W2Xwithin <- listw2 %*%  Xwithin
+    #W2WXwithin <- listw2 %*% WXwithin
+    #W2WWXwithin <- listw2 %*% WWXwithin
+    
     WXbetween <- listwnn %*%  Xbetween
     WWXbetween <- listwnn %*% WXbetween
     W2Xbetween <- listw2nn %*%  Xbetween
@@ -168,8 +215,19 @@
   }
   else{
     
-    WXwithin <- listw %*%  Xwithin
-    WWXwithin <- listw %*% WXwithin
+    WXwithin <- do.call(rbind, lapply(1:t, function(i) {
+      idx <- ((i - 1) * N + 1):(i * N)
+      listw %*% Xwithin[idx, ]
+    }))
+    
+    WWXwithin <- do.call(rbind, lapply(1:t, function(i) {
+      idx <- ((i - 1) * N + 1):(i * N)
+      listw %*% WXwithin[idx, ]
+    }))
+    
+    
+    #WXwithin <- listw %*%  Xwithin
+    #WWXwithin <- listw %*% WXwithin
     Hwithin <-cbind(as.matrix(WXwithin), as.matrix(WWXwithin))
     
     WXbetween <- listwnn %*%  Xbetween
@@ -219,12 +277,38 @@
 
 if(twow){
   
-  WXwithin <- listw %*%  Xwithin
-  WWXwithin <- listw %*% WXwithin
-  W2Xwithin <- listw2 %*%  Xwithin
-  W2WXwithin <- listw2 %*% WXwithin
-  W2WWXwithin <- listw2 %*% WWXwithin
+  WXwithin <- do.call(rbind, lapply(1:t, function(i) {
+    idx <- ((i - 1) * N + 1):(i * N)
+    listw %*% Xwithin[idx, ]
+  }))
   
+  WWXwithin <- do.call(rbind, lapply(1:t, function(i) {
+    idx <- ((i - 1) * N + 1):(i * N)
+    listw %*% WXwithin[idx, ]
+  }))
+  
+  W2Xwithin <- do.call(rbind, lapply(1:t, function(i) {
+    idx <- ((i - 1) * N + 1):(i * N)
+    listw2 %*% Xwithin[idx, ]
+  }))
+  
+  W2WXwithin <- do.call(rbind, lapply(1:t, function(i) {
+    idx <- ((i - 1) * N + 1):(i * N)
+    listw2 %*% WXwithin[idx, ]
+  }))
+  
+  W2WWXwithin <- do.call(rbind, lapply(1:t, function(i) {
+    idx <- ((i - 1) * N + 1):(i * N)
+    listw2 %*% WWXwithin[idx, ]
+  }))
+  
+  
+  #WXwithin <- listw %*%  Xwithin
+  #WWXwithin <- listw %*% WXwithin
+  #W2Xwithin <- listw2 %*%  Xwithin
+  #W2WXwithin <- listw2 %*% WXwithin
+  #W2WWXwithin <- listw2 %*% WWXwithin
+  
   WXbetween <- listwnn %*%  Xbetween
   WWXbetween <- listwnn %*% WXbetween
   W2Xbetween <- listw2nn %*%  Xbetween
@@ -237,8 +321,19 @@
 }
 else{
   
-  WXwithin <- listw %*%  Xwithin
-  WWXwithin <- listw %*% WXwithin
+  WXwithin <- do.call(rbind, lapply(1:t, function(i) {
+    idx <- ((i - 1) * N + 1):(i * N)
+    listw %*% Xwithin[idx, ]
+  }))
+  
+  WWXwithin <- do.call(rbind, lapply(1:t, function(i) {
+    idx <- ((i - 1) * N + 1):(i * N)
+    listw %*% WXwithin[idx, ]
+  }))
+  
+  
+  #WXwithin <- listw %*%  Xwithin
+  #WWXwithin <- listw %*% WXwithin
   Hwithin <-cbind(Hwithin, as.matrix(WXwithin), as.matrix(WWXwithin))
   
   WXbetween <- listwnn %*%  Xbetween

Modified: pkg/R/ivplm.g2sls.R
===================================================================
--- pkg/R/ivplm.g2sls.R	2023-12-11 15:04:29 UTC (rev 259)
+++ pkg/R/ivplm.g2sls.R	2025-04-29 15:33:26 UTC (rev 260)
@@ -23,7 +23,13 @@
     
     colnmx <- colnames(X)
     colnameswx <- paste("lag_", colnames(xdur), sep="")
-    wx <- listw %*% xdur
+    
+    wx <- do.call(rbind, lapply(1:t, function(i) {
+      idx <- ((i - 1) * N + 1):(i * N)
+      listw %*% xdur[idx, ]
+    }))
+    
+    #wx <- listw %*% xdur
     X <- cbind(X, wx)
 
     transx   <- panel.transformations(X,indic, type= "both")
@@ -47,11 +53,23 @@
     colnmx <- colnames(X)
     
     if(colnames(X)[1] == "(Intercept)"){
-      wx <- listw %*% X[,-1]  
+    
+      wx <- do.call(rbind, lapply(1:t, function(i) {
+        idx <- ((i - 1) * N + 1):(i * N)
+        listw %*% xdur[idx, ]
+      }))
+      
+      wx <- wx[,-1]  
       colnameswx <- paste("lag_", colnames(X)[-1], sep="")
     }   
     else {
-      wx <- listw %*% X
+      
+      wx <- do.call(rbind, lapply(1:t, function(i) {
+        idx <- ((i - 1) * N + 1):(i * N)
+        listw %*% X[idx, ]
+      }))
+      
+      #wx <- listw %*% X
       colnameswx <- paste("lag_", colnames(X), sep="")
       }
     
@@ -133,11 +151,14 @@
 }
 
 else{
-       wy <- listw %*% Y
-       wy <- as.matrix(wy)
+  
+       wy <- matrix(listw %*% matrix(Y, nrow = N, ncol = t), ncol = 1)
+       #wy <- listw %*% Y
+       #wy <- as.matrix(wy)
        colnames(wy)<-"lambda"  
-	     wywithin <- listw %*% ywithin
-       wywithin <- as.matrix(wywithin)
+       wywithin <- matrix(listw %*% matrix(ywithin, nrow = N, ncol = t), ncol = 1)   
+	     #wywithin <- listw %*% ywithin
+       #wywithin <- as.matrix(wywithin)
        colnames(wywithin)<-"lambda"
   	   wybetween <- listwnn %*%  as.matrix(ybetween)
        colnames(wybetween) <- "lambda"
@@ -152,12 +173,38 @@
 	  
 	  if(twow){
 	    
-	    WXwithin <- listw %*%  Xwithin
-	    WWXwithin <- listw %*% WXwithin
-	    W2Xwithin <- listw2 %*%  Xwithin
-	    W2WXwithin <- listw2 %*% WXwithin
-	    W2WWXwithin <- listw2 %*% WWXwithin
+	    WXwithin <- do.call(rbind, lapply(1:t, function(i) {
+	      idx <- ((i - 1) * N + 1):(i * N)
+	      listw %*% Xwithin[idx, ]
+	    }))
 	    
+	    WWXwithin <- do.call(rbind, lapply(1:t, function(i) {
+	      idx <- ((i - 1) * N + 1):(i * N)
+	      listw %*% WXwithin[idx, ]
+	    }))
+	    
+	    W2Xwithin <- do.call(rbind, lapply(1:t, function(i) {
+	      idx <- ((i - 1) * N + 1):(i * N)
+	      listw2 %*% Xwithin[idx, ]
+	    }))
+	    
+	    W2WXwithin <- do.call(rbind, lapply(1:t, function(i) {
+	      idx <- ((i - 1) * N + 1):(i * N)
+	      listw2 %*% WXwithin[idx, ]
+	    }))
+	    
+	    W2WWXwithin <- do.call(rbind, lapply(1:t, function(i) {
+	      idx <- ((i - 1) * N + 1):(i * N)
+	      listw2 %*% WWXwithin[idx, ]
+	    }))
+	    
+	    
+	    #WXwithin <- listw %*%  Xwithin
+	    #WWXwithin <- listw %*% WXwithin
+	    #W2Xwithin <- listw2 %*%  Xwithin
+	    #W2WXwithin <- listw2 %*% WXwithin
+	    #W2WWXwithin <- listw2 %*% WWXwithin
+	    
 	    WXbetween <- listwnn %*%  Xbetween
 	    WWXbetween <- listwnn %*% WXbetween
 	    W2Xbetween <- listw2nn %*%  Xbetween
@@ -170,8 +217,20 @@
 	    }
 	  else{
 	    
-	    WXwithin <- listw %*%  Xwithin
-	    WWXwithin <- listw %*% WXwithin
+	    WXwithin <- do.call(rbind, lapply(1:t, function(i) {
+	      idx <- ((i - 1) * N + 1):(i * N)
+	      listw %*% Xwithin[idx, ]
+	    }))
+	    
+	    WWXwithin <- do.call(rbind, lapply(1:t, function(i) {
+	      idx <- ((i - 1) * N + 1):(i * N)
+	      listw %*% WXwithin[idx, ]
+	    }))
+	    
+	    
+	    
+	    #WXwithin <- listw %*%  Xwithin
+	    #WWXwithin <- listw %*% WXwithin
 	    Hwithin <-cbind(as.matrix(WXwithin), as.matrix(WWXwithin))
 
 	    WXbetween <- listwnn %*%  Xbetween
@@ -225,12 +284,38 @@
 
 if(twow){
   
-  WXwithin <- listw %*%  Xwithin
-  WWXwithin <- listw %*% WXwithin
-  W2Xwithin <- listw2 %*%  Xwithin
-  W2WXwithin <- listw2 %*% WXwithin
-  W2WWXwithin <- listw2 %*% WWXwithin
+  WXwithin <- do.call(rbind, lapply(1:t, function(i) {
+    idx <- ((i - 1) * N + 1):(i * N)
+    listw %*% Xwithin[idx, ]
+  }))
   
+  WWXwithin <- do.call(rbind, lapply(1:t, function(i) {
+    idx <- ((i - 1) * N + 1):(i * N)
+    listw %*% WXwithin[idx, ]
+  }))
+  
+  W2Xwithin <- do.call(rbind, lapply(1:t, function(i) {
+    idx <- ((i - 1) * N + 1):(i * N)
+    listw2 %*% Xwithin[idx, ]
+  }))
+  
+  W2WXwithin <- do.call(rbind, lapply(1:t, function(i) {
+    idx <- ((i - 1) * N + 1):(i * N)
+    listw2 %*% WXwithin[idx, ]
+  }))
+  
+  W2WWXwithin <- do.call(rbind, lapply(1:t, function(i) {
+    idx <- ((i - 1) * N + 1):(i * N)
+    listw2 %*% WWXwithin[idx, ]
+  }))
+  
+  
+  #WXwithin <- listw %*%  Xwithin
+  #WWXwithin <- listw %*% WXwithin
+  #W2Xwithin <- listw2 %*%  Xwithin
+  #W2WXwithin <- listw2 %*% WXwithin
+  #W2WWXwithin <- listw2 %*% WWXwithin
+  
   WXbetween <- listwnn %*%  Xbetween
   WWXbetween <- listwnn %*% WXbetween
   W2Xbetween <- listw2nn %*%  Xbetween
@@ -243,8 +328,18 @@
 }
 else{
   
-  WXwithin <- listw %*%  Xwithin
-  WWXwithin <- listw %*% WXwithin
+  WXwithin <- do.call(rbind, lapply(1:t, function(i) {
+    idx <- ((i - 1) * N + 1):(i * N)
+    listw %*% Xwithin[idx, ]
+  }))
+  
+  WWXwithin <- do.call(rbind, lapply(1:t, function(i) {
+    idx <- ((i - 1) * N + 1):(i * N)
+    listw %*% WXwithin[idx, ]
+  }))
+  
+  #WXwithin <- listw %*%  Xwithin
+  #WWXwithin <- listw %*% WXwithin
   Hwithin <-cbind(Hwithin, as.matrix(WXwithin), as.matrix(WWXwithin))
   
   WXbetween <- listwnn %*%  Xbetween

Modified: pkg/R/ivplm.w2sls.R
===================================================================
--- pkg/R/ivplm.w2sls.R	2023-12-11 15:04:29 UTC (rev 259)
+++ pkg/R/ivplm.w2sls.R	2025-04-29 15:33:26 UTC (rev 260)
@@ -17,7 +17,13 @@
     
     colnmx <- colnames(X)
     colnameswx <- paste("lag_", colnames(xdur), sep="")
-    wx <- listw %*% xdur
+    
+    wx <- do.call(rbind, lapply(1:t, function(i) {
+      idx <- ((i - 1) * N + 1):(i * N)
+      listw %*% xdur[idx, ]
+    }))
+    
+    #wx <- listw %*% xdur
     colnames(wx) <- colnameswx
     X <- cbind(X, wx)
     Xwithin <- panel.transformations(X, indic, type = "within")
@@ -31,7 +37,13 @@
   else{
     
    colnmx <- colnames(X)
-   wx <- listw %*% X
+   
+   wx <- do.call(rbind, lapply(1:t, function(i) {
+     idx <- ((i - 1) * N + 1):(i * N)
+     listw %*% X[idx, ]
+   }))
+   
+   #wx <- listw %*% X
    colnameswx <- paste("lag_", colnames(X), sep="")
    X <- cbind(X, wx)
    Xwithin <- panel.transformations(X, indic, type = "within")
@@ -88,7 +100,8 @@
 	
 else{
 
-   wywithin <- listw %*% as.matrix(ywithin)
+  wywithin <- matrix(listw %*% matrix(ywithin, nrow = N, ncol = t), ncol = 1)
+   #wywithin <- listw %*% as.matrix(ywithin)
    wywithin <- as.matrix(wywithin)
    colnames(wywithin)<-"lambda"
    
@@ -99,19 +112,61 @@
             
       if(twow){
 
-   	WXwithin <- listw %*%  Xwithin
-    WWXwithin <- listw %*% WXwithin
-	  W2Xwithin <- listw2 %*%  Xwithin
-    W2WXwithin <- listw2 %*% WXwithin
-    W2WWXwithin <- listw2 %*% WWXwithin
+        WXwithin <- do.call(rbind, lapply(1:t, function(i) {
+          idx <- ((i - 1) * N + 1):(i * N)
+          listw %*% Xwithin[idx, ]
+        }))
+        
+   	#WXwithin <- listw %*%  Xwithin
+   	
+        WWXwithin <- do.call(rbind, lapply(1:t, function(i) {
+          idx <- ((i - 1) * N + 1):(i * N)
+          listw %*% WXwithin[idx, ]
+        }))
+        
+    #WWXwithin <- listw %*% WXwithin
+        
+        W2Xwithin <- do.call(rbind, lapply(1:t, function(i) {
+          idx <- ((i - 1) * N + 1):(i * N)
+          listw2 %*% Xwithin[idx, ]
+        }))
+        
+        W2WXwithin <- do.call(rbind, lapply(1:t, function(i) {
+          idx <- ((i - 1) * N + 1):(i * N)
+          listw2 %*% WXwithin[idx, ]
+        }))
+        
+        W2WWXwithin <- do.call(rbind, lapply(1:t, function(i) {
+          idx <- ((i - 1) * N + 1):(i * N)
+          listw2 %*% WWXwithin[idx, ]
+        }))
+        
+        
+	#  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))
 
             }
 else{
+  
+  WXwithin <- do.call(rbind, lapply(1:t, function(i) {
+    idx <- ((i - 1) * N + 1):(i * N)
+    listw %*% Xwithin[idx, ]
+  }))
+  
+  #WXwithin <- listw %*%  Xwithin
+  
+  WWXwithin <- do.call(rbind, lapply(1:t, function(i) {
+    idx <- ((i - 1) * N + 1):(i * N)
+    listw %*% WXwithin[idx, ]
+  }))
+  
+  
 
-	WXwithin <- listw %*%  Xwithin
-  WWXwithin <- listw %*% WXwithin
+	#WXwithin <- listw %*%  Xwithin
+  #WWXwithin <- listw %*% WXwithin
  	Hwithin <-cbind(as.matrix(WXwithin), as.matrix(WWXwithin))
 
  	}
@@ -136,20 +191,61 @@
 			Hwithin <-panel.transformations(H, indic, type= "within")
 
             if(twow){
+              WXwithin <- do.call(rbind, lapply(1:t, function(i) {
+                idx <- ((i - 1) * N + 1):(i * N)
+                listw %*% Xwithin[idx, ]
+              }))
+              
+              #WXwithin <- listw %*%  Xwithin
+              
+              WWXwithin <- do.call(rbind, lapply(1:t, function(i) {
+                idx <- ((i - 1) * N + 1):(i * N)
+                listw %*% WXwithin[idx, ]
+              }))
+              
+              #WWXwithin <- listw %*% WXwithin
+              
+              W2Xwithin <- do.call(rbind, lapply(1:t, function(i) {
+                idx <- ((i - 1) * N + 1):(i * N)
+                listw2 %*% Xwithin[idx, ]
+              }))
+              
+              W2WXwithin <- do.call(rbind, lapply(1:t, function(i) {
+                idx <- ((i - 1) * N + 1):(i * N)
+                listw2 %*% WXwithin[idx, ]
+              }))
+              
+              W2WWXwithin <- do.call(rbind, lapply(1:t, function(i) {
+                idx <- ((i - 1) * N + 1):(i * N)
+                listw2 %*% WWXwithin[idx, ]
+              }))
+              
+	  #WXwithin <- listw %*%  Xwithin
+    #WWXwithin <- listw %*% WXwithin
+	  #W2Xwithin <- listw2 %*%  Xwithin
+    #W2WXwithin <- listw2 %*% WXwithin
+    #W2WWXwithin <- listw2 %*% WWXwithin
             	
-	  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
+  
+  WXwithin <- do.call(rbind, lapply(1:t, function(i) {
+    idx <- ((i - 1) * N + 1):(i * N)
+    listw %*% Xwithin[idx, ]
+  }))
+  
+  #WXwithin <- listw %*%  Xwithin
+  
+  WWXwithin <- do.call(rbind, lapply(1:t, function(i) {
+    idx <- ((i - 1) * N + 1):(i * N)
+    listw %*% WXwithin[idx, ]
+  }))
+  
+	#  WXwithin <- listw %*%  Xwithin
+   # WWXwithin <- listw %*% WXwithin
  	  Hwithin <-cbind(Hwithin, as.matrix(WXwithin), as.matrix(WWXwithin))
  	
  	}

Modified: pkg/R/ivsplm.R
===================================================================
--- pkg/R/ivsplm.R	2023-12-11 15:04:29 UTC (rev 259)
+++ pkg/R/ivsplm.R	2025-04-29 15:33:26 UTC (rev 260)
@@ -55,17 +55,17 @@
 
 #### creating the block diagonal matrix for the lag model and for additional instruments
 
-  I_T <- Diagonal(t)
-  Ws  <- kronecker(I_T, listw)
+#  I_T <- Diagonal(t)
+ # Ws  <- kronecker(I_T, listw)
   
-  if(twow)  W2  <- kronecker(I_T, listw2)
-  else      W2  <- NULL
+  if(twow)  listw2  <- listw2
+  else      listw2  <- NULL
 
   
 }
 else{
-  Ws <- NULL
-  W2  <- NULL
+  listw <- NULL
+  listw2  <- NULL
 }
   
 	#if not lag, check if there are endogenous 
@@ -82,14 +82,42 @@
     if(lag.instruments){
       
       instruments <- as.matrix(lm(instruments, data, na.action = na.fail, method = "model.frame"))  
-      winst <- Ws %*% instruments
-      wwinst <- Ws %*% winst
       
+      winst <- do.call(rbind, lapply(1:t, function(i) {
+        idx <- ((i - 1) * N + 1):(i * N)
+        listw %*% instruments[idx, ]
+      }))
+      wwinst <- do.call(rbind, lapply(1:t, function(i) {
+        idx <- ((i - 1) * N + 1):(i * N)
+        listw %*% winst[idx, ]
+      }))
+      
+      
+      #winst <- Ws %*% instruments
+      #wwinst <- Ws %*% winst
+      
       if(twow){
-      W2 <- kronecker(I_T, listw2)
-      w2inst <-   Ws %*% instruments
-      w2ws.inst <- W2 %*% winst
-      w2ww.inst <- W2 %*% wwinst
+        
+        w2inst <- do.call(rbind, lapply(1:t, function(i) {
+          idx <- ((i - 1) * N + 1):(i * N)
+          listw2 %*% instruments[idx, ]
+        }))
+        
+        w2ws.inst <- do.call(rbind, lapply(1:t, function(i) {
+          idx <- ((i - 1) * N + 1):(i * N)
+          listw2 %*% winst[idx, ]
+        }))
+        
+        w2ww.inst <- do.call(rbind, lapply(1:t, function(i) {
+          idx <- ((i - 1) * N + 1):(i * N)
+          listw2 %*% wwinst[idx, ]
+        }))
+        
+        
+      #W2 <- kronecker(I_T, listw2)
+      #w2inst <-   Ws %*% instruments
+      #w2ws.inst <- W2 %*% winst
+      #w2ww.inst <- W2 %*% wwinst
       instruments <- cbind(instruments, winst, wwinst, w2inst, w2ws.inst, w2ww.inst)
       }
       
@@ -109,7 +137,7 @@
 w2sls = {
 
   	result <- ivplm.w2sls(Y = y, X = x, H = instruments, endog = endog, 
-	                      twow = twow, lag = lag, listw = Ws, listw2 = W2,
+	                      twow = twow, lag = lag, listw = listw, listw2 = listw2,
 	                      lag.instruments = lag.instruments,
 	                      t = t, N = N, NT = NT, 
 	                      Durbin = Durbin, xdur = xdur)
@@ -116,7 +144,7 @@
 	},
 b2sls = {
 	result <- ivplm.b2sls(Y = y, X = x, H = instruments, endog = endog, 
-	                      twow = twow, lag = lag, listw = Ws, listw2 = W2,
+	                      twow = twow, lag = lag, listw = listw, listw2 = listw2,
 	                      lag.instruments = lag.instruments,
 	                      t = t, N = N, NT = NT, 
 	                      Durbin = Durbin, xdur = xdur)
@@ -123,7 +151,7 @@
 	},
 ec2sls = {
 	result <- ivplm.ec2sls(Y = y, X = x, H = instruments, endog = endog, 
-	                       twow = twow, lag = lag, listw = Ws, listw2 = W2,
+	                       twow = twow, lag = lag, listw = listw, listw2 = listw2,
 	                       lag.instruments = lag.instruments,
 	                       t = t, N = N, NT = NT, 
 	                       Durbin = Durbin, xdur = xdur)
@@ -130,7 +158,7 @@
 	},
 g2sls = {
 	result <-ivplm.g2sls(Y = y, X = x, H = instruments, endog = endog, 
-	                     twow = twow, lag = lag, listw = Ws, listw2 = W2,
+	                     twow = twow, lag = lag, listw = listw, listw2 = listw2,
 	                     lag.instruments = lag.instruments,
 	                     t = t, N = N, NT = NT, 
 	                     Durbin = Durbin, xdur = xdur)

Modified: pkg/R/spgm.R
===================================================================
--- pkg/R/spgm.R	2023-12-11 15:04:29 UTC (rev 259)
+++ pkg/R/spgm.R	2025-04-29 15:33:26 UTC (rev 260)
@@ -257,8 +257,10 @@
   balanced<-N*t==NT
 if(!balanced) stop("Estimation method unavailable for unbalanced panels")
 
-I_T <- Diagonal(t)
-Ws <- kronecker(I_T, listw)
+  
+  #N.B. listw to be replaced everywhere
+#I_T <- Diagonal(t)
+#Ws <- kronecker(I_T, listw)
 
 
 if(!is.null(endog)){
@@ -268,8 +270,19 @@
 	}
 
 if(lag.instruments){
-  winst <- Ws %*% instruments
-  wwinst <- Ws %*% winst
+  
+  winst <- do.call(rbind, lapply(1:t, function(i) {
+    idx <- ((i - 1) * N + 1):(i * N)
+    listw %*% instruments[idx, ]
+  }))
+  
+  wwinst <- do.call(rbind, lapply(1:t, function(i) {
+    idx <- ((i - 1) * N + 1):(i * N)
+    listw %*% winst[idx, ]
+  }))
+  
+  # winst <- Ws %*% instruments
+  # wwinst <- Ws %*% winst
   instruments <- cbind(instruments, winst, wwinst)
 }
 
@@ -295,7 +308,13 @@
       xdur <- as.matrix(lm(Durbin, data, na.action = na.fail, method="model.frame"))
       colnmx <- colnames(x)
       colnameswx <- paste("lag_", colnames(xdur), sep="")
-      wx <- Ws %*% xdur
+      
+      wx <- do.call(rbind, lapply(1:t, function(i) {
+        idx <- ((i - 1) * N + 1):(i * N)
+        listw %*% xdur[idx, ]
+      }))
+      
+     # wx <- Ws %*% xdur
       x <- as.matrix(cbind(x, wx))
       colnames(x) <- c(colnmx, colnameswx)
      
@@ -306,13 +325,21 @@
       
       if(colnmx[1] == "(Intercept)"){
         
-        wx <- Ws %*% x[,-1]
+        wx <- do.call(rbind, lapply(1:t, function(i) {
+          idx <- ((i - 1) * N + 1):(i * N)
+          listw %*% x[idx, ]
+        }))
+        wx <- wx[,-1]
+        #wx <- Ws %*% x[,-1]
         colnameswx <- paste("lag_", colnames(x)[-1], sep = "")
         
       }
       else{
-        
-        wx <- Ws %*% x
+        wx <- do.call(rbind, lapply(1:t, function(i) {
+          idx <- ((i - 1) * N + 1):(i * N)
+          listw %*% x[idx, ]
+        }))
+        #wx <- Ws %*% x
         colnameswx <- paste("lag_", colnames(x), sep = "")
         
       }
@@ -332,7 +359,7 @@
 
                   else 	{
                     result <- ivplm.w2sls(Y = y, X = x, H = instruments, endog = endog, 
-                                              twow = FALSE, lag = FALSE, listw = Ws,  listw2 = NULL,
+                                              twow = FALSE, lag = FALSE, listw = listw,  listw2 = NULL,
                                               lag.instruments = lag.instruments,  t = t, N = N, NT = NT, 
                                               Durbin = Durbin, xdur = xdur)
                     
@@ -342,13 +369,18 @@
                   }
 	  
 	  res <- as.matrix(residuals(result))
+##check this
+Gg <- fswithin(listw, res, N, t)
 
-Gg<-fswithin(Ws, res, N, t)
 
 if(is.null(pars)) {
-	
-    wres <- as.matrix(Ws %*% res)
+  
+  wres <- matrix(listw %*% matrix(res, nrow = N, ncol = t), ncol = 1)
+  
+  
+   # wres <- as.matrix(Ws %*% res)
     r.init <- solve(crossprod(res),crossprod(res,wres))
+    
 if(is.null(endog))	v.init <- crossprod(res)/NT	
 else    	        v.init <- result$sigmav
 	pars <- c(r.init, v.init)	
@@ -364,9 +396,20 @@
 	 finrho=estim1$par[1]
 	 finsigmaV=estim1$par[2]
 
-   wy <- as.matrix(Ws %*% y)
+	 
+	 wy <- matrix(listw %*% matrix(y, nrow = N, ncol = t), ncol = 1)
+	 
+	 
+   #wy <- as.matrix(Ws %*% y)
    yt <- y-finrho*wy
-   xl<- as.matrix(Ws %*%  x)
+   
+   xl <- do.call(rbind, lapply(1:t, function(i) {
+     idx <- ((i - 1) * N + 1):(i * N)
+     listw %*% x[idx, ]
+   }))
+   
+  
+   #xl<- as.matrix(Ws %*%  x)
    #print(head(xl))
    xt <- x-finrho*xl
 
@@ -376,7 +419,14 @@
 	xf<-xf[,-del]
 	xf<-as.matrix(xf)
 	colnames(xf) <- colnames(x)[-del]
-	wxf <- as.matrix(Ws %*% xf)
+	
+	wxf <- do.call(rbind, lapply(1:t, function(i) {
+	  idx <- ((i - 1) * N + 1):(i * N)
+	  listw %*% xf[idx, ]
+	}))
+	
+	
+	#wxf <- as.matrix(Ws %*% xf)
 
 if (is.null(endog)){
 
@@ -402,8 +452,14 @@
 	}
 
 else{
-	
-   endogl <- as.matrix(Ws %*% endog)
+  
+  endogl <- do.call(rbind, lapply(1:t, function(i) {
+    idx <- ((i - 1) * N + 1):(i * N)
+    listw %*% endog[idx, ]
+  }))
+  
+  
+   #endogl <- as.matrix(Ws %*% endog)
    endogt <- endog - finrho* endogl
    endogf <- panel.transformations(endogt,indic, type= "within")
 
@@ -451,7 +507,14 @@
       xdur <- as.matrix(lm(Durbin, data, na.action = na.fail, method="model.frame"))
       colnmx <- colnames(x)
       colnameswx <- paste("lag_", colnames(xdur), sep="")
-      wx <- Ws %*% xdur
+      
+      ###### restart from here!    
+      wx <- do.call(rbind, lapply(1:t, function(i) {
+        idx <- ((i - 1) * N + 1):(i * N)
+        listw %*% xdur[idx, ]
+      }))
+      
+      #wx <- Ws %*% xdur
       x <- as.matrix(cbind(x, wx))
       colnames(x) <- c(colnmx, colnameswx)
       
@@ -462,13 +525,23 @@
       
       if(colnmx[1] == "(Intercept)"){
         
-        wx <- Ws %*% x[,-1]
+        wx <- do.call(rbind, lapply(1:t, function(i) {
+          idx <- ((i - 1) * N + 1):(i * N)
+          listw %*% x[idx, ]
+        }))
+        
+        wx <- wx[,-1]
         colnameswx <- paste("lag_", colnames(x)[-1], sep = "")
         
       }
       else{
         
-        wx <- Ws %*% x
+        wx <- do.call(rbind, lapply(1:t, function(i) {
+          idx <- ((i - 1) * N + 1):(i * N)
+          listw %*% x[idx, ]
+        }))
+        
+        #wx <- Ws %*% x
         colnameswx <- paste("lag_", colnames(x), sep = "")
         
       }
@@ -481,12 +554,16 @@
   
 result<-lm(y~x-1) 
 #print(coefficients((result)))
-res<-as.matrix(residuals(result))
-Gg<-fs(Ws,res,N,t)
+res <- as.matrix(residuals(result))
+Gg  <- fs(listw, res, N, t)
+#print(Gg)
 
 ## parameter initial values 
  if(is.null(pars)) {
-    wres <- as.matrix(Ws %*% res)
+   
+   wres <- matrix(listw %*% matrix(res, nrow = N, ncol = t), ncol = 1)
+   
+    #wres <- as.matrix(Ws %*% res)
     r.init <- solve(crossprod(res),crossprod(res,wres))
 	v.init <- crossprod(res)/NT	
 	pars <- c(r.init, v.init)	
@@ -496,13 +573,16 @@
  if (optim.method == "nlminb") estim1 <- nlminb(pars, arg, v = Gg, 
                                                 verbose = verbose, 
                                                 control = control, 
-                                                lower=c(-0.999,0), upper=c(0.999,Inf))
+                                                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
-S1 <- crossprod(urub, Q1urQ1ub)/N
+S1 <- as.numeric(crossprod(urub, Q1urQ1ub)/N)
 
 switch(moments, 
 	  
@@ -517,8 +597,8 @@
     weights = {
     	
   	   Ggw<-pw(bigG=Gg$bigG, smallg=Gg$smallg, Q1u=Gg$Q1u,Q1ub=Gg$Q1ub,Q1ubb=Gg$Q1ubb, u=res, ub=Gg$ub,ubb=Gg$ubb,N=N, TR=Gg$TR)
-      pars2<-c(estim1$par[1],estim1$par[2],S1)
-
+      pars2<-c(estim1$par[1],estim1$par[2], S1)
+      
  if (optim.method == "nlminb") estim2 <- nlminb(pars2, arg1, v = Ggw,t=t,ss=estim1$par[2] ,SS=S1, verbose = verbose, control = control, lower=c(-0.999,0,0), upper=c(0.999,Inf,Inf))
  else      estim2 <- optim(pars2, arg1, v = Ggw,t=t,ss=estim1$par[2] ,SS=S1, verbose = verbose, control = control, method = optim.method)
 
@@ -530,11 +610,12 @@
     
     fullweights = {
 
-	   Ggw<-pw(bigG=Gg$bigG, smallg=Gg$smallg, Q1u=Gg$Q1u,Q1ub=Gg$Q1ub,Q1ubb=Gg$Q1ubb, u=res, ub=Gg$ub,ubb=Gg$ubb,N=N, TR=Gg$TR)
-      weights<-tw(listw, N)
-      pars2<-c(estim1$par[1],estim1$par[2],S1)
-
-      if (optim.method == "nlminb") estim3 <-nlminb(pars2, arg2, v = Ggw, t=t, 
+	   Ggw <- pw(bigG=Gg$bigG, smallg=Gg$smallg, Q1u=Gg$Q1u,Q1ub=Gg$Q1ub,Q1ubb=Gg$Q1ubb, u=res, ub=Gg$ub,ubb=Gg$ubb,N=N, TR=Gg$TR)
+      weights <- tw(listw, N)
+      pars2<-c(estim1$par[1],estim1$par[2], S1)
+#print(pars2)
+ 
+           if (optim.method == "nlminb") estim3 <-nlminb(pars2, arg2, v = Ggw, t=t, 
                                                ss=estim1$par[2] ,SS=S1, TW=weights$TW, 
                                                verbose = verbose, control = control, 
                                                lower=c(-0.999,0,0), upper=c(0.999,Inf,Inf))
@@ -558,10 +639,10 @@
 else{
  
 result1<-ivplm.w2sls(Y = y,X =x, H = instruments, endog = endog, twow = FALSE, 
-                     lag = FALSE, listw = Ws,  listw2 = NULL, lag.instruments = lag.instruments, 
+                     lag = FALSE, listw = listw,  listw2 = NULL, lag.instruments = lag.instruments, 
                      t, N, NT, Durbin = Durbin, xdur = xdur)
 result2<-ivplm.b2sls(Y = y,X =x, H = instruments, endog = endog,  twow = FALSE,
-                     lag = FALSE, listw = Ws, listw2 = NULL, lag.instruments = lag.instruments,
+                     lag = FALSE, listw = listw, listw2 = NULL, lag.instruments = lag.instruments,
                      t, N, NT, Durbin = Durbin, xdur = xdur)
 
 
@@ -574,13 +655,16 @@
 res1<-as.matrix(as.numeric(residuals(result1)))
 res2<-as.matrix(as.numeric(residuals(result2)))
 
-Gg<-fswithin(Ws,res1,N,t)
+Gg<-fswithin(listw,res1,N,t)
 
 if(is.null(pars)) {
-    wres <- as.matrix(Ws %*% res1)
+  
+  wres <- matrix(listw %*% matrix(res1, nrow = N, ncol = t), ncol = 1)
+  
+    #wres <- as.matrix(Ws %*% res1)
     r.init <- solve(crossprod(res1),crossprod(res1,wres))
-	v.init <- result1$sigmav	
-	pars <- c(r.init, v.init)	
+	  v.init <- result1$sigmav	
+  	pars <- c(r.init, v.init)	
 }
 
 
@@ -595,12 +679,12 @@
                      control = control, 
                      method = optim.method)
 
+Wres2  <- listw %*% res2
 
-Wres2 <- as.matrix(listw %*% res2)
+#Wres2 <- as.matrix(listw %*% res2)
 urhoWu<-res2 - estim1$par[1] * Wres2
-finsigma1<-crossprod(urhoWu)/N
+finsigma1<- as.numeric(crossprod(urhoWu)/N)
 
-
 switch(moments, 
 	  
 	  initial = {
@@ -615,6 +699,8 @@
     	
     	Ggw<-pwbetween(bigG=Gg$bigG, smallg=Gg$smallg, 
     	               u=res2, N=N, t=t, TR=Gg$TR, listw = listw)
+    	
+    	print(Ggw)
       pars2<-c(estim1$par[1],estim1$par[2],finsigma1)
 
  if (optim.method == "nlminb")  estim2 <- nlminb(pars2, arg1, v = Ggw, t=t, 
@@ -667,9 +753,21 @@
 	}
 
 theta<- 1-(sqrt(finsigmaV)/sqrt(finsigma1))	
-wy <- as.matrix(Ws %*% y)
+
[TRUNCATED]

To get the complete diff run:
    svnlook diff /svnroot/splm -r 260