[Splm-commits] r192 - in pkg: . R

[noreply at r-forge.r-project.org]

Author: the_sculler
Date: 2015-03-28 00:41:32 +0100 (Sat, 28 Mar 2015)
New Revision: 192

Modified:
   pkg/ChangeLog
   pkg/DESCRIPTION
   pkg/R/spreml.R
Log:
Completed implementation of plm data interface in spreml.R


Modified: pkg/ChangeLog
===================================================================
--- pkg/ChangeLog	2015-03-27 22:32:47 UTC (rev 191)
+++ pkg/ChangeLog	2015-03-27 23:41:32 UTC (rev 192)
@@ -1,3 +1,6 @@
+Changes in Version 1.3-8
+ o Completed implementation of 'plm' infrastructure in spreml; now works with data.frames plus (possibly implicit) indices or pdata.frames indifferently.
+
 Changes in Version 1.3-7
  o Added slag() method for spatially lagging a vector or a pseries
 

Modified: pkg/DESCRIPTION
===================================================================
--- pkg/DESCRIPTION	2015-03-27 22:32:47 UTC (rev 191)
+++ pkg/DESCRIPTION	2015-03-27 23:41:32 UTC (rev 192)
@@ -1,7 +1,7 @@
 Package: splm
 Title: Econometric Models for Spatial Panel Data
-Version: 1.3-7
-Date: 2014-12-18
+Version: 1.3-8
+Date: 2015-03-27
 Authors at R: c(person(given = "Giovanni", family = "Millo", role = c("aut", "cre"), email = "giovanni.millo at generali.com"),
              person(given = "Gianfranco", family = "Piras", role = c("aut"), email = "gpiras at mac.com"))
 Description: ML and GM estimation and diagnostic testing of econometric models for spatial panel data.

Modified: pkg/R/spreml.R
===================================================================
--- pkg/R/spreml.R	2015-03-27 22:32:47 UTC (rev 191)
+++ pkg/R/spreml.R	2015-03-27 23:41:32 UTC (rev 192)
@@ -6,38 +6,40 @@
           initval = c("zeros", "estimate"),
           x.tol = 1.5e-18, rel.tol = 1e-15, ...)
 {
-    ## mod from spreml5.R to include experimental versions of functions in /optim
 
-    #require(maxLik)
-
     trace <- as.numeric(!quiet)
     if (!is.null(index)) {
         #require(plm)
         data <- plm.data(data, index)
     }
-    index <- data[, 1]
-    tindex <- data[, 2]
+    #index <- data[, 1]
+    #tindex <- data[, 2]
     cl <- match.call()
-    #require(nlme)
+ 
     if (!is.matrix(w)) {
         if ("listw" %in% class(w)) {
- #           require(spdep)
-            w <- listw2mat(w)
+             w <- listw2mat(w)
         }
         else {
             stop("w has to be either a 'matrix' or a 'listw' object")
         }
     }
-    if (dim(data)[[1]] != length(index))
-        stop("Non conformable arguments")
+    #if (dim(data)[[1]] != length(index))
+    #    stop("Non conformable arguments")
 #    X <- model.matrix(formula, data = data)
 #    y <- model.response(model.frame(formula, data = data))
+
+    ## data management through plm functions
     pmod <- plm(formula, data, model="pooling")
     X <- model.matrix(pmod)
     y <- pmodel.response(pmod)
-    names(index) <- row.names(data)
-    ind <- index[which(names(index) %in% row.names(X))]
-    tind <- tindex[which(names(index) %in% row.names(X))]
+    
+    #names(index) <- row.names(data)
+    #ind <- index[which(names(index) %in% row.names(X))]
+    #tind <- tindex[which(names(index) %in% row.names(X))]
+
+    ind <- attr(pmod$model, "index")[, 1]
+    tind <- attr(pmod$model, "index")[, 2]
     oo <- order(tind, ind)
     X <- X[oo, , drop=FALSE]
     y <- y[oo]
@@ -47,11 +49,16 @@
     k <- dim(X)[[2]]
     t <- max(tapply(X[, 1], ind, length))
     nT <- length(ind)
-#    if (dim(w)[[1]] != n)
-#        stop("Non conformable spatial weights") # temporary: adapt to listw or mat
+
+    ## check compatibility of weights matrix
+    if (dim(w)[[1]] != n) stop("Non conformable spatial weights")
+
+    ## check if balanced
     balanced <- pdim(pmod)$balanced
     if (!balanced)
         stop("Estimation method unavailable for unbalanced panels")
+
+    ## manage initial values
     sv.length <- switch(match.arg(errors), semsrre = 3, semsr = 2,
           srre = 2, semre = 2, re = 1, sr = 1, sem = 1, ols = 0,
           sem2srre = 3, sem2re = 2)
@@ -90,6 +97,8 @@
             }
         })
     }
+
+    ## switch actual estimator function
     if (lag) {
         est.fun <- switch(match.arg(errors), semsrre = {
            saremsrREmod
@@ -132,12 +141,13 @@
             semmod
         }, ols = {
             olsmod
-            #stop("No lag and no covariance parameters selected: use lm()")
         }, sem2re = {
             sem2REmod
         })
         arcoef <- NULL
     }
+
+    ## estimate and get results
     RES <- est.fun(X, y, ind, tind, n, k, t, nT, w = w, w2 = w2,
                    coef0 = coef0, hess = hess, trace = trace,
                    x.tol = x.tol, rel.tol = rel.tol, ...)
@@ -146,7 +156,8 @@
     nam.rows <- dimnames(X)[[1]]
     names(y.hat) <- nam.rows
     names(res) <- nam.rows
-    model.data <- data.frame(cbind(y, X[, -1]))
+    model.data <- data.frame(cbind(y, X[, -1])) # fix case with no intercept
+                                                # using has.intercept
     dimnames(model.data)[[1]] <- nam.rows
     type <- "random effects ML"
     sigma2v <- RES$sigma2