[Splm-commits] r187 - in pkg: . R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Jul 16 16:59:18 CEST 2014
Author: the_sculler
Date: 2014-07-16 16:59:16 +0200 (Wed, 16 Jul 2014)
New Revision: 187
Added:
pkg/R/nonexportedSpdepFuns.R
Modified:
pkg/ChangeLog
pkg/DESCRIPTION
pkg/R/spfeml.R
Log:
Eliminated calls to nonexported objects from 'spdep'.
Modified: pkg/ChangeLog
===================================================================
--- pkg/ChangeLog 2014-07-16 12:14:07 UTC (rev 186)
+++ pkg/ChangeLog 2014-07-16 14:59:16 UTC (rev 187)
@@ -1,5 +1,5 @@
Changes in Version 1.3.3
- o Implemented new personal information with Authors at R, according to Hornik et al., R Journal 2012(1).
+ 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).
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.
Modified: pkg/DESCRIPTION
===================================================================
--- pkg/DESCRIPTION 2014-07-16 12:14:07 UTC (rev 186)
+++ pkg/DESCRIPTION 2014-07-16 14:59:16 UTC (rev 187)
@@ -5,7 +5,7 @@
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.
-Depends: R (>= 3.0.1), spdep
+Depends: R (>= 2.12.0), spdep
Imports: plm, maxLik, MASS, bdsmatrix, ibdreg, nlme, Matrix, spam
License: GPL-2
LazyLoad: yes
Added: pkg/R/nonexportedSpdepFuns.R
===================================================================
--- pkg/R/nonexportedSpdepFuns.R (rev 0)
+++ pkg/R/nonexportedSpdepFuns.R 2014-07-16 14:59:16 UTC (rev 187)
@@ -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/spfeml.R
===================================================================
--- pkg/R/spfeml.R 2014-07-16 12:14:07 UTC (rev 186)
+++ pkg/R/spfeml.R 2014-07-16 14:59:16 UTC (rev 187)
@@ -20,9 +20,9 @@
if (length(noNms <- namc[!namc %in% nmsC]))
warning("unknown names in control: ", paste(noNms, collapse = ", "))
- if (is.null(quiet))
- quiet <- !get("verbose", envir = spdep:::.spdepOptions)
- stopifnot(is.logical(quiet))
+## if (is.null(quiet)) # now this has a default in spml(), hence it never is
+## quiet <- !get("verbose", envir = spdep:::.spdepOptions)
+## stopifnot(is.logical(quiet))
if (is.null(zero.policy))
zero.policy <- get.ZeroPolicyOption()
@@ -111,7 +111,7 @@
can.sim <- FALSE
if (listw$style %in% c("W", "S"))
- can.sim <- spdep:::can.be.simmed(listw)
+ can.sim <- can.be.simmed(listw)
if (!is.null(na.act)) {
subset <- !(1:length(listw$neighbours) %in% na.act)
listw <- subset(listw, subset, zero.policy = zero.policy)
@@ -140,7 +140,7 @@
can.sim2 <- FALSE
if (listw2$style %in% c("W", "S"))
- can.sim2 <- spdep:::can.be.simmed(listw2)
+ can.sim2 <- can.be.simmed(listw2)
if (!is.null(na.act)) {
subset <- !(1:length(listw2$neighbours) %in% na.act)
listw2 <- subset(listw2, subset, zero.policy = zero.policy)
@@ -320,7 +320,7 @@
cat(paste("\nSpatial fixed effects model\n", "Jacobian calculated using "))
if(model == "lag"){
- interval1 <- spdep:::jacobianSetup(method, env, con, pre_eig = con$pre_eig, trs = trs1, interval = interval1)
+ interval1 <- jacobianSetup(method, env, con, pre_eig = con$pre_eig, trs = trs1, interval = interval1)
assign("interval1", interval1, envir = env)
@@ -332,9 +332,9 @@
if(model == "sarar"){
- interval1 <- spdep:::jacobianSetup(method, env, con, pre_eig = con$pre_eig1, trs = trs1, interval = interval1, which = 1)
+ interval1 <- jacobianSetup(method, env, con, pre_eig = con$pre_eig1, trs = trs1, interval = interval1, which = 1)
assign("interval1", interval1, envir = env)
- interval2 <- spdep:::jacobianSetup(method, env, con, pre_eig = con$pre_eig2, trs = trs2, interval = interval2, which = 2)
+ interval2 <- jacobianSetup(method, env, con, pre_eig = con$pre_eig2, trs = trs2, interval = interval2, which = 2)
assign("interval2", interval2, envir = env)
# nm <- paste(method, "set_up", sep = "_")
# timings[[nm]] <- proc.time() - .ptime_start
@@ -351,7 +351,7 @@
if (model=='error'){
- interval1 <- spdep:::jacobianSetup(method, env, con, pre_eig = con$pre_eig, trs = trs1, interval = interval1)
+ interval1 <- jacobianSetup(method, env, con, pre_eig = con$pre_eig, trs = trs1, interval = interval1)
assign("interval1", interval1, envir = env)
# nm <- paste(method, "set_up", sep = "_")
# timings[[nm]] <- proc.time() - .ptime_start
More information about the Splm-commits
mailing list