From a64311a17ece74614ab140e2c8fac0037f226e2f Mon Sep 17 00:00:00 2001 From: Roger Bivand Date: Tue, 7 Nov 2023 08:37:08 +0100 Subject: [PATCH] add zero.policy pass-through, start zero.policy attribute changes --- NEWS.md | 2 ++ R/kpgm_new.R | 4 ++-- R/predict.sarlm.R | 12 ++++++------ man/GMerrorsar.Rd | 2 +- man/gstsls.Rd | 2 +- vignettes/sids_models.Rmd | 2 +- 6 files changed, 13 insertions(+), 11 deletions(-) diff --git a/NEWS.md b/NEWS.md index d1603b9..4d8b2ea 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,7 @@ # Version 1.2-10 (development) +* added `zero.policy` pass-through to `spdep::mat2listw` calls in `predict.Sarlm` and to `spdep::sn2listw` in `sids_models.Rmd` + * corrected #19 because the fitted model weights component is never NULL, but may have a single unique value # Version 1.2-9 (2023-05-25) diff --git a/R/kpgm_new.R b/R/kpgm_new.R index 4c2ad94..2413ffb 100644 --- a/R/kpgm_new.R +++ b/R/kpgm_new.R @@ -21,7 +21,7 @@ GMerrorsar <- function(#W, y, X, formula, data = list(), listw, na.action=na.fail, - zero.policy=NULL, method="nlminb", arnoldWied=FALSE, + zero.policy=attr(listw, "zero.policy"), method="nlminb", arnoldWied=FALSE, control=list(), pars=NULL, scaleU=FALSE, verbose=NULL, legacy=FALSE, se.lambda=TRUE, returnHcov=FALSE, pWOrder=250, tol.Hcov=1.0e-10) { # ols <- lm(I(y) ~ I(X) - 1) @@ -518,7 +518,7 @@ impacts.Gmsar <- function(obj, ..., n=NULL, tr=NULL, R=NULL, listw=NULL, ####SARAR model gstsls<-function (formula, data = list(), listw, listw2=NULL, - na.action = na.fail, zero.policy = NULL, pars=NULL, scaleU=FALSE, + na.action = na.fail, zero.policy = attr(listw, "zero.policy"), pars=NULL, scaleU=FALSE, control = list(), verbose = NULL, method = "nlminb", robust = FALSE, legacy = FALSE, W2X = TRUE ) { diff --git a/R/predict.sarlm.R b/R/predict.sarlm.R index 0324619..626e2b3 100644 --- a/R/predict.sarlm.R +++ b/R/predict.sarlm.R @@ -193,7 +193,7 @@ predict.Sarlm <- function(object, newdata=NULL, listw=NULL, pred.type="TS", all. W <- as(listw, "CsparseMatrix") W <- W[region.id, region.id] style <- listw$style - listw <- mat2listw(W, row.names = region.id, style = style) # re-normalize to keep the style + listw <- mat2listw(W, row.names = region.id, style = style, zero.policy=zero.policy) # re-normalize to keep the style rm(W) # avoid the use of a wrong W } } @@ -247,7 +247,7 @@ predict.Sarlm <- function(object, newdata=NULL, listw=NULL, pred.type="TS", all. W <- as(listw.mixed, "CsparseMatrix") W <- W[region.id.mixed, region.id.mixed] style <- listw.mixed$style - listw.mixed <- mat2listw(W, row.names = region.id.mixed, style = style) # re-normalize to keep the style + listw.mixed <- mat2listw(W, row.names = region.id.mixed, style = style, zero.policy=zero.policy) # re-normalize to keep the style rm(W) # avoid the use of a wrong W } } @@ -540,7 +540,7 @@ predict.Sarlm <- function(object, newdata=NULL, listw=NULL, pred.type="TS", all. for (i in 1:nrow(newdata)) { region.id.temp <- c(region.id.data, region.id.newdata[i]) Wi <- W[region.id.temp, region.id.temp] - listwi <- mat2listw(Wi, row.names = region.id.temp, style = style) # re-normalize + listwi <- mat2listw(Wi, row.names = region.id.temp, style = style, zero.policy=zero.policy) # re-normalize if (power) Wi <- as(listwi, "CsparseMatrix") Xi <- rbind(Xs, Xo[i,]) @@ -564,7 +564,7 @@ predict.Sarlm <- function(object, newdata=NULL, listw=NULL, pred.type="TS", all. for (i in 1:nrow(newdata)) { region.id.temp <- c(region.id.data, region.id.newdata[i]) Wi <- W[region.id.temp, region.id.temp] - listwi <- mat2listw(Wi, row.names = region.id.temp, style = style) # re-normalize + listwi <- mat2listw(Wi, row.names = region.id.temp, style = style, zero.policy=zero.policy) # re-normalize Wi <- as(listwi, "CsparseMatrix") Xi <- rbind(Xs, Xo[i,]) # compute TC1 for S and o units @@ -599,7 +599,7 @@ predict.Sarlm <- function(object, newdata=NULL, listw=NULL, pred.type="TS", all. for (i in 1:nrow(newdata)) { region.id.temp <- c(region.id.data, region.id.newdata[i]) Wi <- W[region.id.temp, region.id.temp] - listwi <- mat2listw(Wi, row.names = region.id.temp, style = style) # re-normalize + listwi <- mat2listw(Wi, row.names = region.id.temp, style = style, zero.policy=zero.policy) # re-normalize Wi <- as(listwi, "CsparseMatrix") Xi <- rbind(Xs, Xo[i,]) is.data <- 1:length(ys) @@ -633,7 +633,7 @@ predict.Sarlm <- function(object, newdata=NULL, listw=NULL, pred.type="TS", all. for (i in 1:nrow(newdata)) { region.id.temp <- c(region.id.data, region.id.newdata[i]) Wi <- W[region.id.temp, region.id.temp] - listwi <- mat2listw(Wi, row.names = region.id.temp, style = style) # re-normalize + listwi <- mat2listw(Wi, row.names = region.id.temp, style = style, zero.policy=zero.policy) # re-normalize Wi <- as(listwi, "CsparseMatrix") Xi <- rbind(Xs, Xo[i,]) # compute TC1 for S and o units diff --git a/man/GMerrorsar.Rd b/man/GMerrorsar.Rd index a66e126..7fe716f 100644 --- a/man/GMerrorsar.Rd +++ b/man/GMerrorsar.Rd @@ -17,7 +17,7 @@ } \usage{ GMerrorsar(formula, data = list(), listw, na.action = na.fail, - zero.policy = NULL, method="nlminb", arnoldWied=FALSE, + zero.policy = attr(listw, "zero.policy"), method="nlminb", arnoldWied=FALSE, control = list(), pars, scaleU=FALSE, verbose=NULL, legacy=FALSE, se.lambda=TRUE, returnHcov=FALSE, pWOrder=250, tol.Hcov=1.0e-10) \method{summary}{Gmsar}(object, correlation = FALSE, Hausman=FALSE, ...) diff --git a/man/gstsls.Rd b/man/gstsls.Rd index f5ae8c0..3fc0093 100644 --- a/man/gstsls.Rd +++ b/man/gstsls.Rd @@ -8,7 +8,7 @@ } \usage{ gstsls(formula, data = list(), listw, listw2 = NULL, na.action = na.fail, - zero.policy = NULL, pars=NULL, scaleU=FALSE, control = list(), + zero.policy = attr(listw, "zero.policy"), pars=NULL, scaleU=FALSE, control = list(), verbose=NULL, method="nlminb", robust=FALSE, legacy=FALSE, W2X=TRUE) \method{impacts}{Gmsar}(obj, \dots, n = NULL, tr = NULL, R = NULL, listw = NULL, evalues=NULL, tol = 1e-06, empirical = FALSE, Q=NULL) diff --git a/vignettes/sids_models.Rmd b/vignettes/sids_models.Rmd index dcb0640..6267e3d 100644 --- a/vignettes/sids_models.Rmd +++ b/vignettes/sids_models.Rmd @@ -97,7 +97,7 @@ n <- nc$BIR74 el1 <- min(dij)/dij el2 <- sqrt(n[sids.nhbr$to]/n[sids.nhbr$from]) sids.nhbr$weights <- el1*el2 -sids.nhbr.listw <- sn2listw(sids.nhbr) +sids.nhbr.listw <- sn2listw(sids.nhbr, style="B", zero.policy=TRUE) ``` The first model (I) is a null model with just an intercept, the second