Skip to content

Commit 1fa07f2

Browse files
rsbivandrsbivand
committed
Merge branch 'annotate_impact_factors' of github.com:r-spatial/spatialreg into annotate_impact_factors
2 parents c18ab65 + 315492f commit 1fa07f2

File tree

6 files changed

+194
-371
lines changed

6 files changed

+194
-371
lines changed

‎DESCRIPTION‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -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/

‎NEWS.md‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,7 @@
11
# Version 1.3-7 (development)
22

3+
* suggest `codingMatrices` to expand examples with factors (categorical variables)
4+
35
* introduce warnings for factors (categorical variables) in Durbin models (`errorsarlm`, `lagsarlm`, `sacsarlm`, `spBreg_lag`, `spBreg_err`, `spBreg_sac` and `lm.SLX`)
46

57
* convert `error` to `Rf_error` in `src/ml_sse.c` to accommodate R_NO_REMAP

‎R/ML_models.R‎

Lines changed: 41 additions & 150 deletions
Original file line numberDiff line numberDiff line change
@@ -109,57 +109,21 @@ errorsarlm <- function(formula, data = list(), listw, na.action, weights=NULL,
109109
dvars <- c(NCOL(x), 0L)
110110

111111
if (is.formula(Durbin) || isTRUE(Durbin)) {
112-
prefix <- "lag"
113-
if (isTRUE(Durbin)) {
114-
WX <- create_WX(x, listw, zero.policy=zero.policy,
115-
prefix=prefix)
116-
} else {
117-
data1 <- data
118-
if (!is.null(na.act) && (inherits(na.act, "omit") ||
119-
inherits(na.act, "exclude"))) {
120-
data1 <- data1[-c(na.act),]
121-
}
122-
dmf <- lm(Durbin, data1, na.action=na.fail,
123-
method="model.frame")
124-
formula_durbin_factors <- have_factor_preds_mf(dmf)
125-
if (formula_durbin_factors)
126-
warn_factor_preds(formula_durbin_factors)
127-
# dmf <- lm(Durbin, data, na.action=na.action,
128-
# method="model.frame")
129-
fx <- try(model.matrix(Durbin, dmf), silent=TRUE)
130-
if (inherits(fx, "try-error"))
131-
stop("Durbin variable mis-match")
132-
WX <- create_WX(fx, listw, zero.policy=zero.policy,
133-
prefix=prefix)
134-
inds <- match(substring(colnames(WX), 5,
135-
nchar(colnames(WX))), colnames(x))
136-
if (anyNA(inds)) stop("WX variables not in X: ",
137-
paste(substring(colnames(WX), 5,
138-
nchar(colnames(WX)))[is.na(inds)], collapse=" "))
139-
icept <- grep("(Intercept)", colnames(x))
140-
iicept <- length(icept) > 0L
141-
if (iicept) {
142-
xn <- colnames(x)[-1]
143-
} else {
144-
xn <- colnames(x)
145-
}
146-
wxn <- substring(colnames(WX), nchar(prefix)+2,
147-
nchar(colnames(WX)))
148-
zero_fill <- NULL
149-
if (length((which(!(xn %in% wxn)))) > 0L)
150-
zero_fill <- length(xn) + (which(!(xn %in% wxn)))
151-
}
152-
dvars <- c(NCOL(x), NCOL(WX))
153-
if (is.formula(Durbin)) {
154-
attr(dvars, "f") <- Durbin
155-
attr(dvars, "inds") <- inds
156-
attr(dvars, "zero_fill") <- zero_fill
157-
attr(dvars, "formula_durbin_factors") <- formula_durbin_factors
158-
}
159-
x <- cbind(x, WX)
160-
m <- NCOL(x)
161-
rm(WX)
162-
}
112+
res <- create_Durbin(Durbin=Durbin,
113+
have_factor_preds=have_factor_preds, x=x, listw=listw,
114+
zero.policy=zero.policy, data=data, na.act=na.act,
115+
formula=formula)
116+
x <- res$x
117+
dvars <- res$dvars
118+
inds <-attr(dvars, "inds")
119+
xn <- attr(dvars, "xn")
120+
wxn <- attr(dvars, "wxn")
121+
zero_fill <- attr(dvars, "zero_fill")
122+
formula_durbin_factors <- attr(dvars, "formula_durbin_factors")
123+
attr(dvars, "xn") <- NULL
124+
attr(dvars, "wxn") <- NULL
125+
}
126+
163127
# added aliased after trying boston with TOWN dummy
164128
lm.base <- lm(y ~ x - 1, weights=weights)
165129
aliased <- is.na(coefficients(lm.base))
@@ -640,54 +604,19 @@ lagsarlm <- function(formula, data = list(), listw,
640604
dvars <- c(NCOL(x), 0L)
641605
#FIXME
642606
if (is.formula(Durbin) || isTRUE(Durbin)) {
643-
prefix <- "lag"
644-
if (isTRUE(Durbin)) {
645-
WX <- create_WX(x, listw, zero.policy=zero.policy,
646-
prefix=prefix)
647-
} else {
648-
data1 <- data
649-
if (!is.null(na.act) && (inherits(na.act, "omit") ||
650-
inherits(na.act, "exclude"))) {
651-
data1 <- data1[-c(na.act),]
652-
}
653-
dmf <- lm(Durbin, data1, na.action=na.fail,
654-
method="model.frame")
655-
formula_durbin_factors <- have_factor_preds_mf(dmf)
656-
if (formula_durbin_factors)
657-
warn_factor_preds(formula_durbin_factors)
658-
fx <- try(model.matrix(Durbin, dmf), silent=TRUE)
659-
if (inherits(fx, "try-error"))
660-
stop("Durbin variable mis-match")
661-
WX <- create_WX(fx, listw, zero.policy=zero.policy,
662-
prefix=prefix)
663-
inds <- match(substring(colnames(WX), 5,
664-
nchar(colnames(WX))), colnames(x))
665-
if (anyNA(inds)) stop("WX variables not in X: ",
666-
paste(substring(colnames(WX), 5,
667-
nchar(colnames(WX)))[is.na(inds)], collapse=" "))
668-
icept <- grep("(Intercept)", colnames(x))
669-
iicept <- length(icept) > 0L
670-
if (iicept) {
671-
xn <- colnames(x)[-1]
672-
} else {
673-
xn <- colnames(x)
674-
}
675-
wxn <- substring(colnames(WX), nchar(prefix)+2,
676-
nchar(colnames(WX)))
677-
zero_fill <- NULL
678-
if (length((which(!(xn %in% wxn)))) > 0L)
679-
zero_fill <- length(xn) + (which(!(xn %in% wxn)))
680-
}
681-
dvars <- c(NCOL(x), NCOL(WX))
682-
if (is.formula(Durbin)) {
683-
attr(dvars, "f") <- Durbin
684-
attr(dvars, "inds") <- inds
685-
attr(dvars, "zero_fill") <- zero_fill
686-
attr(dvars, "formula_durbin_factors") <- formula_durbin_factors
687-
}
688-
x <- cbind(x, WX)
689-
m <- NCOL(x)
690-
rm(WX)
607+
res <- create_Durbin(Durbin=Durbin,
608+
have_factor_preds=have_factor_preds, x=x, listw=listw,
609+
zero.policy=zero.policy, data=data, na.act=na.act,
610+
formula=formula)
611+
x <- res$x
612+
dvars <- res$dvars
613+
inds <-attr(dvars, "inds")
614+
xn <- attr(dvars, "xn")
615+
wxn <- attr(dvars, "wxn")
616+
zero_fill <- attr(dvars, "zero_fill")
617+
formula_durbin_factors <- attr(dvars, "formula_durbin_factors")
618+
attr(dvars, "xn") <- NULL
619+
attr(dvars, "wxn") <- NULL
691620
}
692621
# added aliased after trying boston with TOWN dummy
693622
lm.base <- lm(y ~ x - 1)
@@ -1010,57 +939,19 @@ sacsarlm <- function(formula, data = list(), listw, listw2=NULL, na.action,
1010939
dvars <- c(m, 0L)
1011940
# if (type != "sac") {
1012941
if (is.formula(Durbin) || isTRUE(Durbin)) {
1013-
prefix <- "lag"
1014-
if (isTRUE(Durbin)) {
1015-
if (have_factor_preds) warn_factor_preds(have_factor_preds)
1016-
WX <- create_WX(x, listw, zero.policy=zero.policy,
1017-
prefix=prefix)
1018-
} else {
1019-
data1 <- data
1020-
if (!is.null(na.act) && (inherits(na.act, "omit") ||
1021-
inherits(na.act, "exclude"))) {
1022-
data1 <- data1[-c(na.act),]
1023-
}
1024-
dmf <- lm(Durbin, data1, na.action=na.fail,
1025-
method="model.frame")
1026-
formula_durbin_factors <- have_factor_preds_mf(dmf)
1027-
if (formula_durbin_factors)
1028-
warn_factor_preds(formula_durbin_factors)
1029-
# dmf <- lm(Durbin, data, na.action=na.action,
1030-
# method="model.frame")
1031-
fx <- try(model.matrix(Durbin, dmf), silent=TRUE)
1032-
if (inherits(fx, "try-error"))
1033-
stop("Durbin variable mis-match")
1034-
WX <- create_WX(fx, listw, zero.policy=zero.policy,
1035-
prefix=prefix)
1036-
inds <- match(substring(colnames(WX), 5,
1037-
nchar(colnames(WX))), colnames(x))
1038-
if (anyNA(inds)) stop("WX variables not in X: ",
1039-
paste(substring(colnames(WX), 5,
1040-
nchar(colnames(WX)))[is.na(inds)], collapse=" "))
1041-
icept <- grep("(Intercept)", colnames(x))
1042-
iicept <- length(icept) > 0L
1043-
if (iicept) {
1044-
xn <- colnames(x)[-1]
1045-
} else {
1046-
xn <- colnames(x)
1047-
}
1048-
wxn <- substring(colnames(WX), nchar(prefix)+2,
1049-
nchar(colnames(WX)))
1050-
zero_fill <- NULL
1051-
if (length((which(!(xn %in% wxn)))) > 0L)
1052-
zero_fill <- length(xn) + (which(!(xn %in% wxn)))
1053-
}
1054-
dvars <- c(NCOL(x), NCOL(WX))
1055-
if (is.formula(Durbin)) {
1056-
attr(dvars, "f") <- Durbin
1057-
attr(dvars, "inds") <- inds
1058-
attr(dvars, "zero_fill") <- zero_fill
1059-
attr(dvars, "formula_durbin_factors") <- formula_durbin_factors
1060-
}
1061-
x <- cbind(x, WX)
1062-
m <- NCOL(x)
1063-
rm(WX)
942+
res <- create_Durbin(Durbin=Durbin,
943+
have_factor_preds=have_factor_preds, x=x, listw=listw,
944+
zero.policy=zero.policy, data=data, na.act=na.act,
945+
formula=formula)
946+
x <- res$x
947+
dvars <- res$dvars
948+
inds <-attr(dvars, "inds")
949+
xn <- attr(dvars, "xn")
950+
wxn <- attr(dvars, "wxn")
951+
zero_fill <- attr(dvars, "zero_fill")
952+
formula_durbin_factors <- attr(dvars, "formula_durbin_factors")
953+
attr(dvars, "xn") <- NULL
954+
attr(dvars, "wxn") <- NULL
1064955
}
1065956
if (NROW(x) != length(listw2$neighbours))
1066957
stop("Input data and neighbourhood list2 have different dimensions")

‎R/SLX_WX.R‎

Lines changed: 80 additions & 57 deletions
Original file line numberDiff line numberDiff line change
@@ -46,64 +46,24 @@ lmSLX <- function(formula, data = list(), listw, na.action, weights=NULL, Durbin
4646
if (is.null(weights)) weights <- rep(as.numeric(1), n)
4747
if (any(is.na(weights))) stop("NAs in weights")
4848
if (any(weights < 0)) stop("negative weights")
49-
dvars <- c(NCOL(x), 0L)
50-
prefix <- "lag"
51-
if (isTRUE(Durbin)) {
52-
if (have_factor_preds) warn_factor_preds(have_factor_preds)
53-
WX <- create_WX(x, listw, zero.policy=zero.policy,
54-
prefix=prefix)
55-
} else if (is.formula(Durbin)) {
56-
data1 <- data
57-
if (!is.null(na.act) && (inherits(na.act, "omit") ||
58-
inherits(na.act, "exclude"))) {
59-
data1 <- data1[-c(na.act),]
60-
}
61-
dmf <- lm(Durbin, data1, na.action=na.fail,
62-
method="model.frame")
63-
formula_durbin_factors <- have_factor_preds_mf(dmf)
64-
if (formula_durbin_factors)
65-
warn_factor_preds(formula_durbin_factors)
66-
# dmf <- lm(Durbin, data, na.action=na.action,
67-
# method="model.frame")
68-
fx <- try(model.matrix(Durbin, dmf), silent=TRUE)
69-
if (inherits(fx, "try-error"))
70-
stop("Durbin variable mis-match")
71-
WX <- create_WX(fx, listw, zero.policy=zero.policy,
72-
prefix=prefix)
73-
inds <- match(substring(colnames(WX), 5,
74-
nchar(colnames(WX))), colnames(x))
75-
if (anyNA(inds)) {
76-
wna <- which(is.na(inds)) #TR: continue if Durbin has intercept, but formula has not
77-
if (length(wna) == 1 && grepl("Intercept", colnames(WX)[wna])
78-
&& attr(terms(formula), "intercept") == 0
79-
&& attr(terms(Durbin), "intercept") == 1) {
80-
inds <- inds[-wna]
81-
} else{
82-
stop("WX variables not in X: ",
83-
paste(substring(colnames(WX), 5,
84-
nchar(colnames(WX)))[is.na(inds)], collapse=" "))
85-
}
86-
}
87-
icept <- grep("(Intercept)", colnames(x))
88-
iicept <- length(icept) > 0L
89-
if (iicept) {
90-
xn <- colnames(x)[-1]
91-
} else {
92-
xn <- colnames(x)
93-
}
94-
wxn <- substring(colnames(WX), nchar(prefix)+2,
95-
nchar(colnames(WX)))
96-
zero_fill <- length(xn) + (which(!(xn %in% wxn)))
97-
} else stop("Durbin argument neither TRUE nor formula")
98-
dvars <- c(NCOL(x), NCOL(WX))
99-
if (is.formula(Durbin)) {
100-
attr(dvars, "f") <- Durbin
101-
attr(dvars, "inds") <- inds
102-
attr(dvars, "zero_fill") <- zero_fill
103-
attr(dvars, "formula_durbin_factors") <- formula_durbin_factors
49+
# dvars <- c(NCOL(x), 0L)
50+
if (!(isTRUE(Durbin) || is.formula(Durbin))) {
51+
stop("Durbin argument neither TRUE nor formula")
52+
} else {
53+
res <- create_Durbin(Durbin=Durbin,
54+
have_factor_preds=have_factor_preds, x=x, listw=listw,
55+
zero.policy=zero.policy, data=data, na.act=na.act,
56+
formula=formula)
57+
x <- res$x
58+
dvars <- res$dvars
59+
inds <-attr(dvars, "inds")
60+
xn <- attr(dvars, "xn")
61+
wxn <- attr(dvars, "wxn")
62+
zero_fill <- attr(dvars, "zero_fill")
63+
formula_durbin_factors <- attr(dvars, "formula_durbin_factors")
64+
attr(dvars, "xn") <- NULL
65+
attr(dvars, "wxn") <- NULL
10466
}
105-
x <- cbind(x, WX)
106-
rm(WX)
10767
# WX <- create_WX(x, listw, zero.policy=zero.policy, prefix="lag")
10868
# x <- cbind(x, WX)
10969
# 180128 Mark L. Burkey summary.lm error for SlX object
@@ -464,4 +424,67 @@ create_WX <- function(x, listw, zero.policy=NULL, prefix="") {
464424
WX
465425
}
466426

427+
create_Durbin <- function(Durbin, have_factor_preds, x, listw, zero.policy,
428+
data, na.act, formula) {
429+
prefix <- "lag"
430+
if (isTRUE(Durbin)) {
431+
if (have_factor_preds) warn_factor_preds(have_factor_preds)
432+
WX <- create_WX(x, listw, zero.policy=zero.policy,
433+
prefix=prefix)
434+
} else if (is.formula(Durbin)) {
435+
data1 <- data
436+
if (!is.null(na.act) && (inherits(na.act, "omit") ||
437+
inherits(na.act, "exclude"))) {
438+
data1 <- data1[-c(na.act),]
439+
}
440+
dmf <- lm(Durbin, data1, na.action=na.fail,
441+
method="model.frame")
442+
formula_durbin_factors <- have_factor_preds_mf(dmf)
443+
if (formula_durbin_factors)
444+
warn_factor_preds(formula_durbin_factors)
445+
# dmf <- lm(Durbin, data, na.action=na.action,
446+
# method="model.frame")
447+
fx <- try(model.matrix(Durbin, dmf), silent=TRUE)
448+
if (inherits(fx, "try-error"))
449+
stop("Durbin variable mis-match")
450+
WX <- create_WX(fx, listw, zero.policy=zero.policy,
451+
prefix=prefix)
452+
inds <- match(substring(colnames(WX), 5,
453+
nchar(colnames(WX))), colnames(x))
454+
if (anyNA(inds)) {
455+
wna <- which(is.na(inds)) #TR: continue if Durbin has intercept, but formula has not
456+
if (length(wna) == 1 && grepl("Intercept", colnames(WX)[wna])
457+
&& attr(terms(formula), "intercept") == 0
458+
&& attr(terms(Durbin), "intercept") == 1) {
459+
inds <- inds[-wna]
460+
} else{
461+
stop("WX variables not in X: ",
462+
paste(substring(colnames(WX), 5,
463+
nchar(colnames(WX)))[is.na(inds)], collapse=" "))
464+
}
465+
}
466+
icept <- grep("(Intercept)", colnames(x))
467+
iicept <- length(icept) > 0L
468+
if (iicept) {
469+
xn <- colnames(x)[-1]
470+
} else {
471+
xn <- colnames(x)
472+
}
473+
wxn <- substring(colnames(WX), nchar(prefix)+2,
474+
nchar(colnames(WX)))
475+
zero_fill <- length(xn) + (which(!(xn %in% wxn)))
476+
}
477+
dvars <- c(NCOL(x), NCOL(WX))
478+
if (is.formula(Durbin)) {
479+
attr(dvars, "f") <- Durbin
480+
attr(dvars, "inds") <- inds
481+
attr(dvars, "xn") <- xn
482+
attr(dvars, "wxn") <- wxn
483+
attr(dvars, "zero_fill") <- zero_fill
484+
attr(dvars, "formula_durbin_factors") <- formula_durbin_factors
485+
}
486+
x <- cbind(x, WX)
487+
rm(WX)
488+
list(x=x, dvars=dvars)
489+
}
467490

0 commit comments

Comments
 (0)