Skip to content

Commit e279d86

Browse files
rsbivandrsbivand
committed
pre annotate_impact_factors
1 parent 8ce139c commit e279d86

File tree

3 files changed

+44
-15
lines changed

3 files changed

+44
-15
lines changed

‎DESCRIPTION‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,6 @@
11
Package: spatialreg
22
Version: 1.3-7
3-
Date: 2025-04-25
3+
Date: 2025-06-10
44
Title: Spatial Regression Analysis
55
Encoding: UTF-8
66
Authors@R: c(person("Roger", "Bivand", role = c("cre", "aut"), email = "[email protected]", comment=c(ORCID="0000-0003-2392-6140")),
@@ -30,7 +30,7 @@ Depends: R (>= 3.3.0), spData (>= 2.3.1), Matrix, sf
3030
Imports: spdep (>= 1.3-11), coda, methods, MASS, boot, splines, LearnBayes,
3131
nlme, multcomp
3232
Suggests: parallel, RSpectra, tmap, foreign, spam, knitr, lmtest, expm,
33-
sandwich, rmarkdown, igraph (>= 2.0.0), tinytest
33+
sandwich, rmarkdown, igraph (>= 2.0.0), tinytest, codingMatrices
3434
Description: A collection of all the estimation functions for spatial cross-sectional models (on lattice/areal data using spatial weights matrices) contained up to now in 'spdep'. These model fitting functions include maximum likelihood methods for cross-sectional models proposed by 'Cliff' and 'Ord' (1973, ISBN:0850860369) and (1981, ISBN:0850860814), fitting methods initially described by 'Ord' (1975) <doi:10.1080/01621459.1975.10480272>. The models are further described by 'Anselin' (1988) <doi:10.1007/978-94-015-7799-1>. Spatial two stage least squares and spatial general method of moment models initially proposed by 'Kelejian' and 'Prucha' (1998) <doi:10.1023/A:1007707430416> and (1999) <doi:10.1111/1468-2354.00027> are provided. Impact methods and MCMC fitting methods proposed by 'LeSage' and 'Pace' (2009) <doi:10.1201/9781420064254> are implemented for the family of cross-sectional spatial regression models. Methods for fitting the log determinant term in maximum likelihood and MCMC fitting are compared by 'Bivand et al.' (2013) <doi:10.1111/gean.12008>, and model fitting methods by 'Bivand' and 'Piras' (2015) <doi:10.18637/jss.v063.i18>; both of these articles include extensive lists of references. A recent review is provided by 'Bivand', 'Millo' and 'Piras' (2021) <doi:10.3390/math9111276>. 'spatialreg' >= 1.1-* corresponded to 'spdep' >= 1.1-1, in which the model fitting functions were deprecated and passed through to 'spatialreg', but masked those in 'spatialreg'. From versions 1.2-*, the functions have been made defunct in 'spdep'. From version 1.3-6, add Anselin-Kelejian (1997) test to `stsls` for residual spatial autocorrelation <doi:10.1177/016001769702000109>.
3535
License: GPL-2
3636
URL: https://github.com/r-spatial/spatialreg/, https://r-spatial.github.io/spatialreg/

‎R/SLX_WX.R‎

Lines changed: 34 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -272,27 +272,56 @@ impacts.SlX <- function(obj, ...) {
272272
stopifnot(!is.null(attr(obj, "mixedImps")))
273273
n <- nrow(obj$model)
274274
k <- obj$qr$rank
275-
impactsWX(attr(obj, "mixedImps"), n, k, type="SlX", method="glht")
275+
impactsWX(attr(obj, "mixedImps"), n, k, type="SlX", method="glht",
276+
have_factor_preds=attr(obj, "have_factor_preds"))
276277
}
277278

278279

279-
impactsWX <- function(obj, n, k, type="SlX", method="glht") {
280+
impactsWX <- function(obj, n, k, type="SlX", method="glht", have_factor_preds=FALSE) {
280281
imps <- lapply(obj, function(x) x[, 1])
282+
bnames <- rownames(obj[[1]])
283+
bnames <- update_bnames(bnames, have_factor_preds=have_factor_preds)
281284
names(imps) <- c("direct", "indirect", "total")
282-
attr(imps, "bnames") <- rownames(obj[[1]])
285+
attr(imps, "bnames") <- bnames
283286
ses <- lapply(obj, function(x) x[, 2])
284287
names(ses) <- c("direct", "indirect", "total")
285-
attr(ses, "bnames") <- rownames(obj[[1]])
288+
attr(ses, "bnames") <- bnames
286289
res <- list(impacts=imps, se=ses)
287290
attr(res, "n") <- n
288291
attr(res, "k") <- k
289292
attr(res, "type") <- type
290293
attr(res, "method") <- method
291-
attr(res, "bnames") <- rownames(obj[[1]])
294+
attr(res, "bnames") <- bnames
292295
class(res) <- "WXimpact"
293296
res
294297
}
295298

299+
update_bnames <- function(bnames, have_factor_preds=FALSE) {
300+
interactions <- length(grep(":", bnames)) > 0L
301+
b_suffix <- rep("dy/dx", length(bnames))
302+
if (have_factor_preds && !interactions) {
303+
factnames <- attr(have_factor_preds, "factnames")
304+
xlevels <- attr(have_factor_preds, "xlevels")
305+
contrasts <- attr(have_factor_preds, "contrasts")
306+
for (pred in seq(along=factnames)) {
307+
npred <- grep(factnames[pred], bnames)
308+
xlpred <- xlevels[[pred]]
309+
cpred <- contrasts[[pred]]
310+
if (length(npred) == length(xlpred)) {
311+
b_suffix[npred] <- xlpred
312+
} else {
313+
switch(cpred,
314+
contr.treatment = ,
315+
code_control = ,
316+
code_diff =
317+
)
318+
}
319+
}
320+
}
321+
bnames <- paste(bnames, b_suffix)
322+
bnames
323+
}
324+
296325

297326
print.WXimpact <- function(x, ...) {
298327
mat <- lagImpactMat(x$impacts)

‎inst/tinytest/test_Durbin_factor.R‎

Lines changed: 8 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -3,33 +3,33 @@ data(oldcol, package="spdep")
33
lw <- spdep::nb2listw(COL.nb)
44
COL.OLD$fEW <- factor(COL.OLD$EW)
55
COL.OLD$fDISCBD <- ordered(cut(COL.OLD$DISCBD, c(0, 1.5, 3, 4.5, 6)))
6-
f <- formula(CRIME ~ INC + HOVAL + fDISCBD*fEW)
6+
f <- formula(CRIME ~ INC + HOVAL + fDISCBD + fEW)
77
expect_warning(COL.SLX0 <- lmSLX(f, data=COL.OLD, lw, Durbin=TRUE))
8-
expect_warning(COL.SLX1 <- lmSLX(f, data=COL.OLD, lw, Durbin=~ INC + HOVAL + fDISCBD*fEW))
8+
expect_warning(COL.SLX1 <- lmSLX(f, data=COL.OLD, lw, Durbin=~ INC + HOVAL + fDISCBD + fEW))
99
expect_warning(COL.SLX2 <- lmSLX(f, data=COL.OLD, lw, Durbin=~ INC + HOVAL + fEW))
1010
expect_silent(COL.SLX3 <- lmSLX(f, data=COL.OLD, lw, Durbin=~ INC + HOVAL))
1111
expect_warning(COL.err0 <- errorsarlm(f, data=COL.OLD, lw, Durbin=TRUE))
12-
expect_warning(COL.err1 <- errorsarlm(f, data=COL.OLD, lw, Durbin=~ INC + HOVAL + fDISCBD*fEW))
12+
expect_warning(COL.err1 <- errorsarlm(f, data=COL.OLD, lw, Durbin=~ INC + HOVAL + fDISCBD + fEW))
1313
expect_warning(COL.err2 <- errorsarlm(f, data=COL.OLD, lw, Durbin=~ INC + HOVAL + fDISCBD))
1414
expect_silent(COL.err3 <- errorsarlm(f, data=COL.OLD, lw, Durbin=~ INC + HOVAL))
1515
expect_warning(COL.lag0 <- lagsarlm(f, data=COL.OLD, lw, Durbin=TRUE))
16-
expect_warning(COL.lag1 <- lagsarlm(f, data=COL.OLD, lw, Durbin=~ INC + HOVAL + fDISCBD*fEW))
16+
expect_warning(COL.lag1 <- lagsarlm(f, data=COL.OLD, lw, Durbin=~ INC + HOVAL + fDISCBD + fEW))
1717
expect_warning(COL.lag2 <- lagsarlm(f, data=COL.OLD, lw, Durbin=~ INC + HOVAL + fDISCBD))
1818
expect_silent(COL.lag3 <- lagsarlm(f, data=COL.OLD, lw, Durbin=~ INC + HOVAL))
1919
expect_warning(COL.sac0 <- sacsarlm(f, data=COL.OLD, lw, Durbin=TRUE))
20-
expect_warning(COL.sac1 <- sacsarlm(f, data=COL.OLD, lw, Durbin=~ INC + HOVAL + fDISCBD*fEW))
20+
expect_warning(COL.sac1 <- sacsarlm(f, data=COL.OLD, lw, Durbin=~ INC + HOVAL + fDISCBD + fEW))
2121
expect_warning(COL.sac2 <- sacsarlm(f, data=COL.OLD, lw, Durbin=~ INC + HOVAL + fDISCBD))
2222
expect_silent(COL.sac3 <- sacsarlm(f, data=COL.OLD, lw, Durbin=~ INC + HOVAL))
2323
expect_warning(COL.lag0 <- spBreg_lag(f, data=COL.OLD, lw, Durbin=TRUE))
24-
expect_warning(COL.lag1 <- spBreg_lag(f, data=COL.OLD, lw, Durbin=~ INC + HOVAL + fDISCBD*fEW))
24+
expect_warning(COL.lag1 <- spBreg_lag(f, data=COL.OLD, lw, Durbin=~ INC + HOVAL + fDISCBD + fEW))
2525
expect_warning(COL.lag2 <- spBreg_lag(f, data=COL.OLD, lw, Durbin=~ INC + HOVAL + fDISCBD))
2626
expect_silent(COL.lag3 <- spBreg_lag(f, data=COL.OLD, lw, Durbin=~ INC + HOVAL))
2727
expect_warning(COL.err0 <- spBreg_err(f, data=COL.OLD, lw, Durbin=TRUE))
28-
expect_warning(COL.err1 <- spBreg_err(f, data=COL.OLD, lw, Durbin=~ INC + HOVAL + fDISCBD*fEW))
28+
expect_warning(COL.err1 <- spBreg_err(f, data=COL.OLD, lw, Durbin=~ INC + HOVAL + fDISCBD + fEW))
2929
expect_warning(COL.err2 <- spBreg_err(f, data=COL.OLD, lw, Durbin=~ INC + HOVAL + fDISCBD))
3030
expect_silent(COL.err3 <- spBreg_err(f, data=COL.OLD, lw, Durbin=~ INC + HOVAL))
3131
expect_warning(COL.sac0 <- spBreg_sac(f, data=COL.OLD, lw, Durbin=TRUE))
32-
expect_warning(COL.sac1 <- spBreg_sac(f, data=COL.OLD, lw, Durbin=~ INC + HOVAL + fDISCBD*fEW))
32+
expect_warning(COL.sac1 <- spBreg_sac(f, data=COL.OLD, lw, Durbin=~ INC + HOVAL + fDISCBD + fEW))
3333
expect_warning(COL.sac2 <- spBreg_sac(f, data=COL.OLD, lw, Durbin=~ INC + HOVAL + fDISCBD))
3434
expect_silent(COL.sac3 <- spBreg_sac(f, data=COL.OLD, lw, Durbin=~ INC + HOVAL))
3535

0 commit comments

Comments
 (0)