[Splm-commits] r189 - in pkg: . R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sat Oct 18 18:31:48 CEST 2014
Author: the_sculler
Date: 2014-10-18 18:31:48 +0200 (Sat, 18 Oct 2014)
New Revision: 189
Added:
pkg/R/nonexportedSpdepFuns.R
Removed:
pkg/R/nonexportedSpdepFuns.R
Modified:
pkg/ChangeLog
pkg/DESCRIPTION
pkg/R/sarREmod.R
pkg/R/sarem2REmod.R
pkg/R/sarem2srREmod.R
pkg/R/saremREmod.R
pkg/R/saremmod.R
pkg/R/saremsrREmod.R
pkg/R/saremsrmod.R
pkg/R/sarmod.R
pkg/R/sarsrREmod.R
pkg/R/sarsrmod.R
pkg/R/sem2REmod.R
pkg/R/sem2srREmod.R
pkg/R/semREmod.R
pkg/R/semmod.R
pkg/R/semsrREmod.R
pkg/R/semsrmod.R
Log:
Fixed usage of w vs. w2 in spreml()-related estimator functions
Modified: pkg/ChangeLog
===================================================================
--- pkg/ChangeLog 2014-07-16 16:42:49 UTC (rev 188)
+++ pkg/ChangeLog 2014-10-18 16:31:48 UTC (rev 189)
@@ -1,22 +1,25 @@
-Changes in Version 1.3.3
+Changes in Version 1.3-5
+ o Fixed usage of w viz. w2 in spreml estimators
+
+Changes in Version 1.3-3
o Implemented new personal information with Authors at R, according to Hornik et al., R Journal 2012(1). Scaled dependence back on R 2.12.0 (because of Authors at R infrastructure) from R 3.0.1. Eliminated calls to nonexported objects from 'spdep' by: 1) eliminating "dead" if condition in spfeml() (spdep:::.spdepOptions); 2) adding local (nonexported) version of the two nonexported functions spdep:::can.be.simmed and spdep:::jacobianSetup (in script nonexportedSpdepFuns.R). Removed write.effects().
-Changes in Version 1.3.2
+Changes in Version 1.3-2
o Reduced dependencies through selective imports, cleaned up the code from 'require' calls. Now depends only on 'spdep', imports (or importsFrom) plm, maxLik, MASS, bdsmatrix, ibdreg, nlme, Matrix, spam.
-Changes in Version 1.3.00
+Changes in Version 1.3-0
o All changes documented in: Piras, G. “Impact estimates for static panel data models in R”. url: http://rri.wvu.edu/wp-content/uploads/2012/11/Piras_ImpactEstimatesForStaticSpatial2013-05.pdf fixed thanks to the email from Viton
-Changes in Version 1.2.00
+Changes in Version 1.2-0
o All changes documented in: Piras, G. “Impact estimates for static panel data models in R”. url: http://rri.wvu.edu/wp-content/uploads/2012/11/Piras_ImpactEstimatesForStaticSpatial2013-05.pdf
o Rewrote a new framework to deal with GM estimation using exclusively sparse Matrices. This new framework has multiple improvements in terms both of timing and improvements with respect to the previous version. Most of the changes are reported in a file SPGM - structure.doc available from G. Piras. I am also planning to write a paper showing most of the new functionality. Basically, most of the options available from sphet have been included also in spgm.
-Changes in Version 1.1.00
+Changes in Version 1.1-0
o revised all random effects estimators as per paper submitted to CSDA. Sparse matrix methods, flexible optimizers, SAREM2SRRE and SEM2SRRE models have been added. Datasets and weights for Rice Farming and Italian Insurance examples have been added.
-Changes in Version 1.0-05
+Changes in Version 1.0-5
o fixed some bugs in spfeml and update the relative function to changes in spdep (a few differences arises with the paper on JSS such as: the residuals of the sarar model and the s.e. of the spatial coefficients)
Modified: pkg/DESCRIPTION
===================================================================
--- pkg/DESCRIPTION 2014-07-16 16:42:49 UTC (rev 188)
+++ pkg/DESCRIPTION 2014-10-18 16:31:48 UTC (rev 189)
@@ -1,7 +1,7 @@
Package: splm
Title: Econometric Models for Spatial Panel Data
-Version: 1.3-3
-Date: 2014-7-16
+Version: 1.3-5
+Date: 2014-10-18
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.
Deleted: pkg/R/nonexportedSpdepFuns.R
===================================================================
--- pkg/R/nonexportedSpdepFuns.R 2014-07-16 16:42:49 UTC (rev 188)
+++ pkg/R/nonexportedSpdepFuns.R 2014-10-18 16:31:48 UTC (rev 189)
@@ -1,138 +0,0 @@
-## from spdep_0.5-74, copies of non-exported functions
-
-can.be.simmed <- function (listw)
-{
- res <- is.symmetric.nb(listw$neighbours, FALSE)
- if (res) {
- if (attr(listw$weights, "mode") == "general")
- res <- attr(listw$weights, "glistsym")
- }
- else return(res)
- res
-}
-
-jacobianSetup <- function (method, env, con, pre_eig = NULL, trs = NULL, interval = NULL,
- which = 1)
-{
- switch(method, eigen = {
- if (get("verbose", envir = env)) cat("neighbourhood matrix eigenvalues\n")
- if (is.null(pre_eig)) {
- eigen_setup(env, which = which)
- } else {
- eigen_pre_setup(env, pre_eig = pre_eig, which = which)
- }
- er <- get("eig.range", envir = env)
- if (is.null(interval)) interval <- c(er[1] + .Machine$double.eps,
- er[2] - .Machine$double.eps)
- }, Matrix = {
- if (get("listw", envir = env)$style %in% c("W", "S") &&
- !get("can.sim", envir = env)) stop("Matrix method requires symmetric weights")
- if (get("listw", envir = env)$style %in% c("B", "C",
- "U") && !(is.symmetric.glist(get("listw", envir = env)$neighbours,
- get("listw", envir = env)$weights))) stop("Matrix method requires symmetric weights")
- if (get("verbose", envir = env)) cat("sparse matrix Cholesky decomposition\n")
- Imult <- con$Imult
- if (is.null(interval)) {
- if (get("listw", envir = env)$style == "B") {
- Imult <- ceiling((2/3) * max(sapply(get("listw",
- envir = env)$weights, sum)))
- interval <- c(-0.5, +0.25)
- } else interval <- c(-1, 0.999)
- }
- if (is.null(con$super)) con$super <- as.logical(NA)
- Matrix_setup(env, Imult, con$super, which = which)
- }, Matrix_J = {
- if (get("listw", envir = env)$style %in% c("W", "S") &&
- !get("can.sim", envir = env)) stop("Matrix method requires symmetric weights")
- if (get("listw", envir = env)$style %in% c("B", "C",
- "U") && !(is.symmetric.glist(get("listw", envir = env)$neighbours,
- get("listw", envir = env)$weights))) stop("Matrix method requires symmetric weights")
- if (get("verbose", envir = env)) cat("sparse matrix Cholesky decomposition\n")
- if (is.null(interval)) {
- if (get("listw", envir = env)$style == "B") {
- interval <- c(-0.5, +0.25)
- } else interval <- c(-1, 0.999)
- }
- if (is.null(con$super)) con$super <- FALSE
- Matrix_J_setup(env, super = con$super, which = which)
- }, spam = {
- ##if (!require(spam)) stop("spam not available") # spam is imported
- if (get("listw", envir = env)$style %in% c("W", "S") &&
- !get("can.sim", envir = env)) stop("spam method requires symmetric weights")
- if (get("listw", envir = env)$style %in% c("B", "C",
- "U") && !(is.symmetric.glist(get("listw", envir = env)$neighbours,
- get("listw", envir = env)$weights))) stop("spam method requires symmetric weights")
- if (get("verbose", envir = env)) cat("sparse matrix Cholesky decomposition\n")
- spam_setup(env, pivot = con$spamPivot, which = which)
- if (is.null(interval)) interval <- c(-1, 0.999)
- }, spam_update = {
- ##if (!require(spam)) stop("spam not available") # idem
- if (get("listw", envir = env)$style %in% c("W", "S") &&
- !get("can.sim", envir = env)) stop("spam method requires symmetric weights")
- if (get("listw", envir = env)$style %in% c("B", "C",
- "U") && !(is.symmetric.glist(get("listw", envir = env)$neighbours,
- get("listw", envir = env)$weights))) stop("spam method requires symmetric weights")
- if (get("verbose", envir = env)) cat("sparse matrix Cholesky decomposition\n")
- spam_update_setup(env, in_coef = con$in_coef, pivot = con$spamPivot,
- which = which)
- if (is.null(interval)) interval <- c(-1, 0.999)
- }, Chebyshev = {
- if (get("listw", envir = env)$style %in% c("W", "S") &&
- !get("can.sim", envir = env)) stop("Chebyshev method requires symmetric weights")
- if (get("listw", envir = env)$style %in% c("B", "C",
- "U") && !(is.symmetric.glist(get("listw", envir = env)$neighbours,
- get("listw", envir = env)$weights))) stop("Chebyshev method requires symmetric weights")
- if (get("verbose", envir = env)) cat("sparse matrix Chebyshev approximation\n")
- cheb_setup(env, q = con$cheb_q, which = which)
- if (is.null(interval)) interval <- c(-1, 0.999)
- }, MC = {
- if (!get("listw", envir = env)$style %in% c("W")) stop("MC method requires row-standardised weights")
- if (get("verbose", envir = env)) cat("sparse matrix Monte Carlo approximation\n")
- mcdet_setup(env, p = con$MC_p, m = con$MC_m, which = which)
- if (is.null(interval)) interval <- c(-1, 0.999)
- }, LU = {
- if (get("verbose", envir = env)) cat("sparse matrix LU decomposition\n")
- LU_setup(env, which = which)
- if (is.null(interval)) interval <- c(-1, 0.999)
- }, LU_prepermutate = {
- if (get("verbose", envir = env)) cat("sparse matrix LU decomposition\n")
- LU_prepermutate_setup(env, coef = con$in_coef, order = con$LU_order,
- which = which)
- if (is.null(interval)) interval <- c(-1, 0.999)
- }, moments = {
- if (get("verbose", envir = env)) cat("Smirnov/Anselin (2009) trace approximation\n")
- moments_setup(env, trs = trs, m = con$MC_m, p = con$MC_p,
- type = con$type, correct = con$correct, trunc = con$trunc,
- which = which)
- if (is.null(interval)) interval <- c(-1, 0.999)
- }, SE_classic = {
- if (get("verbose", envir = env)) cat("SE toolbox classic grid\n")
- if (is.null(interval)) interval <- c(-1, 0.999)
- if (con$SE_method == "MC" && !get("listw", envir = env)$style %in%
- c("W")) stop("MC method requires row-standardised weights")
- SE_classic_setup(env, SE_method = con$SE_method, p = con$MC_p,
- m = con$MC_m, nrho = con$nrho, interpn = con$interpn,
- interval = interval, SElndet = con$SElndet, which = which)
- }, SE_whichMin = {
- if (get("verbose", envir = env)) cat("SE toolbox which.min grid\n")
- if (is.null(interval)) interval <- c(-1, 0.999)
- if (con$SE_method == "MC" && !get("listw", envir = env)$style %in%
- c("W")) stop("MC method requires row-standardised weights")
- SE_whichMin_setup(env, SE_method = con$SE_method, p = con$MC_p,
- m = con$MC_m, nrho = con$nrho, interpn = con$interpn,
- interval = interval, SElndet = con$SElndet, which = which)
- }, SE_interp = {
- if (get("verbose", envir = env)) cat("SE toolbox which.min grid\n")
- if (is.null(interval)) interval <- c(-1, 0.999)
- if (con$SE_method == "MC" && !get("listw", envir = env)$style %in%
- c("W")) stop("MC method requires row-standardised weights")
- SE_interp_setup(env, SE_method = con$SE_method, p = con$MC_p,
- m = con$MC_m, nrho = con$nrho, interval = interval,
- which = which)
- }, stop("...\n\nUnknown method\n"))
- interval
-}
-
-
-
-
Added: pkg/R/nonexportedSpdepFuns.R
===================================================================
--- pkg/R/nonexportedSpdepFuns.R (rev 0)
+++ pkg/R/nonexportedSpdepFuns.R 2014-10-18 16:31:48 UTC (rev 189)
@@ -0,0 +1,138 @@
+## from spdep_0.5-74, copies of non-exported functions
+
+can.be.simmed <- function (listw)
+{
+ res <- is.symmetric.nb(listw$neighbours, FALSE)
+ if (res) {
+ if (attr(listw$weights, "mode") == "general")
+ res <- attr(listw$weights, "glistsym")
+ }
+ else return(res)
+ res
+}
+
+jacobianSetup <- function (method, env, con, pre_eig = NULL, trs = NULL, interval = NULL,
+ which = 1)
+{
+ switch(method, eigen = {
+ if (get("verbose", envir = env)) cat("neighbourhood matrix eigenvalues\n")
+ if (is.null(pre_eig)) {
+ eigen_setup(env, which = which)
+ } else {
+ eigen_pre_setup(env, pre_eig = pre_eig, which = which)
+ }
+ er <- get("eig.range", envir = env)
+ if (is.null(interval)) interval <- c(er[1] + .Machine$double.eps,
+ er[2] - .Machine$double.eps)
+ }, Matrix = {
+ if (get("listw", envir = env)$style %in% c("W", "S") &&
+ !get("can.sim", envir = env)) stop("Matrix method requires symmetric weights")
+ if (get("listw", envir = env)$style %in% c("B", "C",
+ "U") && !(is.symmetric.glist(get("listw", envir = env)$neighbours,
+ get("listw", envir = env)$weights))) stop("Matrix method requires symmetric weights")
+ if (get("verbose", envir = env)) cat("sparse matrix Cholesky decomposition\n")
+ Imult <- con$Imult
+ if (is.null(interval)) {
+ if (get("listw", envir = env)$style == "B") {
+ Imult <- ceiling((2/3) * max(sapply(get("listw",
+ envir = env)$weights, sum)))
+ interval <- c(-0.5, +0.25)
+ } else interval <- c(-1, 0.999)
+ }
+ if (is.null(con$super)) con$super <- as.logical(NA)
+ Matrix_setup(env, Imult, con$super, which = which)
+ }, Matrix_J = {
+ if (get("listw", envir = env)$style %in% c("W", "S") &&
+ !get("can.sim", envir = env)) stop("Matrix method requires symmetric weights")
+ if (get("listw", envir = env)$style %in% c("B", "C",
+ "U") && !(is.symmetric.glist(get("listw", envir = env)$neighbours,
+ get("listw", envir = env)$weights))) stop("Matrix method requires symmetric weights")
+ if (get("verbose", envir = env)) cat("sparse matrix Cholesky decomposition\n")
+ if (is.null(interval)) {
+ if (get("listw", envir = env)$style == "B") {
+ interval <- c(-0.5, +0.25)
+ } else interval <- c(-1, 0.999)
+ }
+ if (is.null(con$super)) con$super <- FALSE
+ Matrix_J_setup(env, super = con$super, which = which)
+ }, spam = {
+ ##if (!require(spam)) stop("spam not available") # spam is imported
+ if (get("listw", envir = env)$style %in% c("W", "S") &&
+ !get("can.sim", envir = env)) stop("spam method requires symmetric weights")
+ if (get("listw", envir = env)$style %in% c("B", "C",
+ "U") && !(is.symmetric.glist(get("listw", envir = env)$neighbours,
+ get("listw", envir = env)$weights))) stop("spam method requires symmetric weights")
+ if (get("verbose", envir = env)) cat("sparse matrix Cholesky decomposition\n")
+ spam_setup(env, pivot = con$spamPivot, which = which)
+ if (is.null(interval)) interval <- c(-1, 0.999)
+ }, spam_update = {
+ ##if (!require(spam)) stop("spam not available") # idem
+ if (get("listw", envir = env)$style %in% c("W", "S") &&
+ !get("can.sim", envir = env)) stop("spam method requires symmetric weights")
+ if (get("listw", envir = env)$style %in% c("B", "C",
+ "U") && !(is.symmetric.glist(get("listw", envir = env)$neighbours,
+ get("listw", envir = env)$weights))) stop("spam method requires symmetric weights")
+ if (get("verbose", envir = env)) cat("sparse matrix Cholesky decomposition\n")
+ spam_update_setup(env, in_coef = con$in_coef, pivot = con$spamPivot,
+ which = which)
+ if (is.null(interval)) interval <- c(-1, 0.999)
+ }, Chebyshev = {
+ if (get("listw", envir = env)$style %in% c("W", "S") &&
+ !get("can.sim", envir = env)) stop("Chebyshev method requires symmetric weights")
+ if (get("listw", envir = env)$style %in% c("B", "C",
+ "U") && !(is.symmetric.glist(get("listw", envir = env)$neighbours,
+ get("listw", envir = env)$weights))) stop("Chebyshev method requires symmetric weights")
+ if (get("verbose", envir = env)) cat("sparse matrix Chebyshev approximation\n")
+ cheb_setup(env, q = con$cheb_q, which = which)
+ if (is.null(interval)) interval <- c(-1, 0.999)
+ }, MC = {
+ if (!get("listw", envir = env)$style %in% c("W")) stop("MC method requires row-standardised weights")
+ if (get("verbose", envir = env)) cat("sparse matrix Monte Carlo approximation\n")
+ mcdet_setup(env, p = con$MC_p, m = con$MC_m, which = which)
+ if (is.null(interval)) interval <- c(-1, 0.999)
+ }, LU = {
+ if (get("verbose", envir = env)) cat("sparse matrix LU decomposition\n")
+ LU_setup(env, which = which)
+ if (is.null(interval)) interval <- c(-1, 0.999)
+ }, LU_prepermutate = {
+ if (get("verbose", envir = env)) cat("sparse matrix LU decomposition\n")
+ LU_prepermutate_setup(env, coef = con$in_coef, order = con$LU_order,
+ which = which)
+ if (is.null(interval)) interval <- c(-1, 0.999)
+ }, moments = {
+ if (get("verbose", envir = env)) cat("Smirnov/Anselin (2009) trace approximation\n")
+ moments_setup(env, trs = trs, m = con$MC_m, p = con$MC_p,
+ type = con$type, correct = con$correct, trunc = con$trunc,
+ which = which)
+ if (is.null(interval)) interval <- c(-1, 0.999)
+ }, SE_classic = {
+ if (get("verbose", envir = env)) cat("SE toolbox classic grid\n")
+ if (is.null(interval)) interval <- c(-1, 0.999)
+ if (con$SE_method == "MC" && !get("listw", envir = env)$style %in%
+ c("W")) stop("MC method requires row-standardised weights")
+ SE_classic_setup(env, SE_method = con$SE_method, p = con$MC_p,
+ m = con$MC_m, nrho = con$nrho, interpn = con$interpn,
+ interval = interval, SElndet = con$SElndet, which = which)
+ }, SE_whichMin = {
+ if (get("verbose", envir = env)) cat("SE toolbox which.min grid\n")
+ if (is.null(interval)) interval <- c(-1, 0.999)
+ if (con$SE_method == "MC" && !get("listw", envir = env)$style %in%
+ c("W")) stop("MC method requires row-standardised weights")
+ SE_whichMin_setup(env, SE_method = con$SE_method, p = con$MC_p,
+ m = con$MC_m, nrho = con$nrho, interpn = con$interpn,
+ interval = interval, SElndet = con$SElndet, which = which)
+ }, SE_interp = {
+ if (get("verbose", envir = env)) cat("SE toolbox which.min grid\n")
+ if (is.null(interval)) interval <- c(-1, 0.999)
+ if (con$SE_method == "MC" && !get("listw", envir = env)$style %in%
+ c("W")) stop("MC method requires row-standardised weights")
+ SE_interp_setup(env, SE_method = con$SE_method, p = con$MC_p,
+ m = con$MC_m, nrho = con$nrho, interval = interval,
+ which = which)
+ }, stop("...\n\nUnknown method\n"))
+ interval
+}
+
+
+
+
Modified: pkg/R/sarREmod.R
===================================================================
--- pkg/R/sarREmod.R 2014-07-16 16:42:49 UTC (rev 188)
+++ pkg/R/sarREmod.R 2014-10-18 16:31:48 UTC (rev 189)
@@ -57,7 +57,7 @@
} # lag-specific line
## lag y once for all
- wy <- Wy(y, w2, tind) # lag-specific line
+ wy <- Wy(y, w, tind) # lag-specific line
## the sigma matrix is inverted during the GLS step and not before as
## in the other cases, to take advantage of specialized methods in the
@@ -125,7 +125,7 @@
e <- glsres[["ehat"]]
s2e <- glsres[["sigma2"]]
## calc ll
- zero <- t*ldetB(psi, w2) # lag-specific line (else zero <- 0)
+ zero <- t*ldetB(psi, w) # lag-specific line (else zero <- 0)
due <- detSigma(phi, n, t)
tre <- -(n * t)/2 * log(s2e)
cinque <- -1/(2 * s2e) * crossprod(e, solve(sigma, e))
Modified: pkg/R/sarem2REmod.R
===================================================================
--- pkg/R/sarem2REmod.R 2014-07-16 16:42:49 UTC (rev 188)
+++ pkg/R/sarem2REmod.R 2014-10-18 16:31:48 UTC (rev 189)
@@ -61,7 +61,7 @@
lambda <- philambda[2]
psi <- philambda[3] # lag-specific line
## calc inverse sigma
- sigma.1 <- invSigma(philambda, n, t., w)
+ sigma.1 <- invSigma(philambda, n, t., w2)
## lag y
Ay <- y - psi * wy # lag-specific line
## do GLS step to get e, s2e
@@ -69,8 +69,8 @@
e <- glsres[["ehat"]]
s2e <- glsres[["sigma2"]]
## calc ll
- zero <- t.*ldetB(psi, w2) # lag-specific line (else zero <- 0)
- due <- detSigma(phi, lambda, n, t., w)
+ zero <- t.*ldetB(psi, w) # lag-specific line (else zero <- 0)
+ due <- detSigma(phi, lambda, n, t., w2)
tre <- -n * t./2 * log(s2e)
quattro <- -1/(2 * s2e) * t(e) %*% sigma.1 %*% e
const <- -(n * t.)/2 * log(2 * pi)
@@ -122,7 +122,7 @@
}
## lag y once for all
- wy <- Wy(y, w2, tind) # lag-specific line
+ wy <- Wy(y, w, tind) # lag-specific line
## optimization
@@ -176,7 +176,7 @@
## one last GLS step at optimal vcov parms
- sigma.1 <- invSigma(myparms, n, t., w)
+ sigma.1 <- invSigma(myparms, n, t., w2)
Ay <- y - myparms[length(myparms)] * wy # lag-specific line
beta <- GLSstep(X, Ay, sigma.1)
Modified: pkg/R/sarem2srREmod.R
===================================================================
--- pkg/R/sarem2srREmod.R 2014-07-16 16:42:49 UTC (rev 188)
+++ pkg/R/sarem2srREmod.R 2014-10-18 16:31:48 UTC (rev 189)
@@ -143,7 +143,7 @@
}
## lag y once for all
- wy <- Wy(y, w2, tind) # lag-specific line
+ wy <- Wy(y, w, tind) # lag-specific line
## optimization
@@ -197,7 +197,7 @@
}
## one last GLS step at optimal vcov parms
- sigma.1 <- invSigma(myparms, n, t., w)
+ sigma.1 <- invSigma(myparms, n, t., w2)
Ay <- y - myparms[length(myparms)] * wy # lag-specific line
beta <- GLSstep(X, Ay, sigma.1)
Modified: pkg/R/saremREmod.R
===================================================================
--- pkg/R/saremREmod.R 2014-07-16 16:42:49 UTC (rev 188)
+++ pkg/R/saremREmod.R 2014-10-18 16:31:48 UTC (rev 189)
@@ -180,7 +180,7 @@
}
## one last GLS step at optimal vcov parms
- sigma.1 <- invSigma(myparms, n, t., w)
+ sigma.1 <- invSigma(myparms, n, t., w2)
Ay <- y - myparms[length(myparms)] * wy # lag-specific line
beta <- GLSstep(X, Ay, sigma.1)
Modified: pkg/R/saremmod.R
===================================================================
--- pkg/R/saremmod.R 2014-07-16 16:42:49 UTC (rev 188)
+++ pkg/R/saremmod.R 2014-10-18 16:31:48 UTC (rev 189)
@@ -50,7 +50,7 @@
lambda <- lambdapsi[1]
psi <- lambdapsi[2] # lag-specific line
## calc inverse sigma
- sigma.1 <- invSigma(lambdapsi, n, t., w)
+ sigma.1 <- invSigma(lambdapsi, n, t., w2)
## lag y
Ay <- y - psi * wy # lag-specific line
## do GLS step to get e, s2e
@@ -58,8 +58,8 @@
e <- glsres[["ehat"]]
s2e <- glsres[["sigma2"]]
## calc ll
- zero <- t.*ldetB(psi, w2) # lag-specific line (else zero <- 0)
- due <- detSigma(lambda, t., w)
+ zero <- t.*ldetB(psi, w) # lag-specific line (else zero <- 0)
+ due <- detSigma(lambda, t., w2)
tre <- -n * t./2 * log(s2e)
quattro <- -1/(2 * s2e) * t(e) %*% sigma.1 %*% e
const <- -(n * t.)/2 * log(2 * pi)
@@ -110,7 +110,7 @@
}
## lag y once for all
- wy <- Wy(y, w2, tind) # lag-specific line
+ wy <- Wy(y, w, tind) # lag-specific line
## optimization
@@ -163,7 +163,7 @@
}
## one last GLS step at optimal vcov parms
- sigma.1 <- invSigma(myparms, n, t., w)
+ sigma.1 <- invSigma(myparms, n, t., w2)
Ay <- y - myparms[length(myparms)] * wy # lag-specific line
beta <- GLSstep(X, Ay, sigma.1)
Modified: pkg/R/saremsrREmod.R
===================================================================
--- pkg/R/saremsrREmod.R 2014-07-16 16:42:49 UTC (rev 188)
+++ pkg/R/saremsrREmod.R 2014-10-18 16:31:48 UTC (rev 189)
@@ -156,7 +156,7 @@
}
## lag y once for all
- wy <- Wy(y, w2, tind) # lag-specific line
+ wy <- Wy(y, w, tind) # lag-specific line
## optimization
@@ -209,7 +209,7 @@
}
## one last GLS step at optimal vcov parms
- sigma.1 <- invSigma(myparms, n, t., w)
+ sigma.1 <- invSigma(myparms, n, t., w2)
Ay <- y - myparms[length(myparms)] * wy # lag-specific line
beta <- GLSstep(X, Ay, sigma.1)
Modified: pkg/R/saremsrmod.R
===================================================================
--- pkg/R/saremsrmod.R 2014-07-16 16:42:49 UTC (rev 188)
+++ pkg/R/saremsrmod.R 2014-10-18 16:31:48 UTC (rev 189)
@@ -130,7 +130,7 @@
}
## lag y once for all
- wy <- Wy(y, w2, tind) # lag-specific line
+ wy <- Wy(y, w, tind) # lag-specific line
## optimization
@@ -183,7 +183,7 @@
}
## one last GLS step at optimal vcov parms
- sigma.1 <- invSigma(myparms, n, t., w)
+ sigma.1 <- invSigma(myparms, n, t., w2)
Ay <- y - myparms[length(myparms)] * wy # lag-specific line
beta <- GLSstep(X, Ay, sigma.1)
Modified: pkg/R/sarmod.R
===================================================================
--- pkg/R/sarmod.R 2014-07-16 16:42:49 UTC (rev 188)
+++ pkg/R/sarmod.R 2014-10-18 16:31:48 UTC (rev 189)
@@ -83,7 +83,7 @@
}
## lag y once for all
- wy <- Wy(y, w2, tind) # lag-specific line
+ wy <- Wy(y, w, tind) # lag-specific line
## max likelihood
optimum <- nlminb(start = myparms0, objective = ll.c,
Modified: pkg/R/sarsrREmod.R
===================================================================
--- pkg/R/sarsrREmod.R 2014-07-16 16:42:49 UTC (rev 188)
+++ pkg/R/sarsrREmod.R 2014-10-18 16:31:48 UTC (rev 189)
@@ -54,7 +54,7 @@
} # lag-specific line
## lag y once for all
- wy <- Wy(y, w2, tind) # lag-specific line
+ wy <- Wy(y, w, tind) # lag-specific line
## the sigma matrix is inverted during the GLS step and not before as
## in the other cases, to take advantage of specialized methods in the
@@ -122,7 +122,7 @@
e <- glsres[["ehat"]]
s2e <- glsres[["sigma2"]]
## calc ll
- zero <- t*ldetB(psi, w2) # lag-specific line (else zero <- 0)
+ zero <- t*ldetB(psi, w) # lag-specific line (else zero <- 0)
uno <- n/2 * log(1 - rho^2)
due <- -n/2 * log(d2(rho, t) * (1 - rho)^2 * phi + 1)
tre <- -(n * t)/2 * log(s2e)
Modified: pkg/R/sarsrmod.R
===================================================================
--- pkg/R/sarsrmod.R 2014-07-16 16:42:49 UTC (rev 188)
+++ pkg/R/sarsrmod.R 2014-10-18 16:31:48 UTC (rev 189)
@@ -57,7 +57,7 @@
} # lag-specific line
## lag y once for all
- wy <- Wy(y, w2, tind) # lag-specific line
+ wy <- Wy(y, w, tind) # lag-specific line
## the sigma matrix is inverted during the GLS step and not before as
## in the other cases, to take advantage of specialized methods in the
@@ -122,7 +122,7 @@
e <- glsres[["ehat"]]
s2e <- glsres[["sigma2"]]
## calc ll
- zero <- t*ldetB(psi, w2) # lag-specific line (else zero <- 0)
+ zero <- t*ldetB(psi, w) # lag-specific line (else zero <- 0)
uno <- n/2 * log(1 - rho^2)
tre <- -(n * t)/2 * log(s2e)
cinque <- -1/(2 * s2e) * crossprod(e, solve(sigma, e))
Modified: pkg/R/sem2REmod.R
===================================================================
--- pkg/R/sem2REmod.R 2014-07-16 16:42:49 UTC (rev 188)
+++ pkg/R/sem2REmod.R 2014-10-18 16:31:48 UTC (rev 189)
@@ -18,7 +18,10 @@
## - make list of results
## now using flex optimization and sparse matrix methods
-
+
+ ## if w2!=w has been specified, then let w=w2
+ w <- w2
+
## set names for final parms vectors
nam.beta <- dimnames(X)[[2]]
nam.errcomp <- c("phi", "rho")
Modified: pkg/R/sem2srREmod.R
===================================================================
--- pkg/R/sem2srREmod.R 2014-07-16 16:42:49 UTC (rev 188)
+++ pkg/R/sem2srREmod.R 2014-10-18 16:31:48 UTC (rev 189)
@@ -19,6 +19,9 @@
## - make list of results
## needs ldetB(), xprodB()
+
+ ## if w2!=w has been specified, then let w=w2
+ w <- w2 # uses only w2, but just in case...
## set names for final parms vectors
nam.beta <- dimnames(X)[[2]]
@@ -171,7 +174,7 @@
}
## one last GLS step at optimal vcov parms
- sigma.1 <- invSigma(myparms, n, t., w)
+ sigma.1 <- invSigma(myparms, n, t., w2)
beta <- GLSstep(X, y, sigma.1)
## final vcov(beta)
Modified: pkg/R/semREmod.R
===================================================================
--- pkg/R/semREmod.R 2014-07-16 16:42:49 UTC (rev 188)
+++ pkg/R/semREmod.R 2014-10-18 16:31:48 UTC (rev 189)
@@ -17,9 +17,9 @@
## - calc final covariances
## - make list of results
- # mark
- #print("uso versione 0") # done from saremsrREmod4.R
-
+ ## if w2!=w has been specified, then let w=w2
+ w <- w2
+
## set names for final parms vectors
nam.beta <- dimnames(X)[[2]]
nam.errcomp <- c("phi", "rho")
Modified: pkg/R/semmod.R
===================================================================
--- pkg/R/semmod.R 2014-07-16 16:42:49 UTC (rev 188)
+++ pkg/R/semmod.R 2014-10-18 16:31:48 UTC (rev 189)
@@ -17,6 +17,9 @@
## - calc final covariances
## - make list of results
+ ## if w2!=w has been specified, then let w=w2
+ w <- w2
+
## set names for final parms vectors
nam.beta <- dimnames(X)[[2]]
nam.errcomp <- c("rho")
Modified: pkg/R/semsrREmod.R
===================================================================
--- pkg/R/semsrREmod.R 2014-07-16 16:42:49 UTC (rev 188)
+++ pkg/R/semsrREmod.R 2014-10-18 16:31:48 UTC (rev 189)
@@ -30,7 +30,10 @@
## needs ldetB(), solveB(), xprodB()
##
## almost no gain on medium-sized listwNY example, T=3
-
+
+ ## if w2!=w has been specified, then let w=w2
+ w <- w2 # uses w2 everywhere, but just to be sure...
+
## set names for final parms vectors
nam.beta <- dimnames(X)[[2]]
nam.errcomp <- c("phi", "psi", "rho")
@@ -183,7 +186,7 @@
}
## one last GLS step at optimal vcov parms
- sigma.1 <- invSigma(myparms, n, t., w)
+ sigma.1 <- invSigma(myparms, n, t., w2)
beta <- GLSstep(X, y, sigma.1)
## final vcov(beta)
Modified: pkg/R/semsrmod.R
===================================================================
--- pkg/R/semsrmod.R 2014-07-16 16:42:49 UTC (rev 188)
+++ pkg/R/semsrmod.R 2014-10-18 16:31:48 UTC (rev 189)
@@ -17,8 +17,8 @@
## - calc final covariances
## - make list of results
- # mark
- #print("uso versione 0")
+ ## if w2!=w has been specified, then let w=w2
+ w <- w2
## set names for final parms vectors
nam.beta <- dimnames(X)[[2]]
More information about the Splm-commits
mailing list