Skip to content

Commit 9131f0c

Browse files
rsbivandrsbivand
committed
tidy
2 parents e279d86 + 9b71ac6 commit 9131f0c

File tree

10 files changed

+104
-86
lines changed

10 files changed

+104
-86
lines changed

‎DESCRIPTION‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,6 @@
11
Package: spatialreg
2-
Version: 1.3-7
3-
Date: 2025-06-10
2+
Version: 1.4-1
3+
Date: 2025-08-29
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")),

‎NEWS.md‎

Lines changed: 5 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,8 @@
1-
# Version 1.3-7 (development)
1+
# Version 1.4-1 (development)
2+
3+
* annotate `impacts` output with `"dy/dx"` or `"(F)"` to distinguish continuous and categorical independent variables
4+
5+
* suggest `codingMatrices` to expand examples with factors (categorical variables)
26

37
* introduce warnings for factors (categorical variables) in Durbin models (`errorsarlm`, `lagsarlm`, `sacsarlm`, `spBreg_lag`, `spBreg_err`, `spBreg_sac` and `lm.SLX`)
48

‎R/ML_models.R‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -67,7 +67,7 @@ errorsarlm <- function(formula, data = list(), listw, na.action, weights=NULL,
6767
# }
6868
if (is.logical(Durbin) && isTRUE(Durbin)) {
6969
etype <- "emixed"
70-
if (have_factor_preds) warn_factor_preds(have_factor_preds)
70+
# if (have_factor_preds) warn_factor_preds(have_factor_preds)
7171
}
7272
if (is.formula(Durbin)) etype <- "emixed"
7373
if (is.logical(Durbin) && !isTRUE(Durbin)) etype <- "error"
@@ -571,7 +571,7 @@ lagsarlm <- function(formula, data = list(), listw,
571571
}
572572
if (is.logical(Durbin) && isTRUE(Durbin)) {
573573
type <- "mixed"
574-
if (have_factor_preds) warn_factor_preds(have_factor_preds)
574+
# if (have_factor_preds) warn_factor_preds(have_factor_preds)
575575
}
576576
if (is.formula(Durbin)) type <- "mixed"
577577
if (is.logical(Durbin) && !isTRUE(Durbin)) type <- "lag"

‎R/SLX_WX.R‎

Lines changed: 29 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -273,10 +273,9 @@ impacts.SlX <- function(obj, ...) {
273273
n <- nrow(obj$model)
274274
k <- obj$qr$rank
275275
impactsWX(attr(obj, "mixedImps"), n, k, type="SlX", method="glht",
276-
have_factor_preds=attr(obj, "have_factor_preds"))
276+
have_factor_preds=attr(obj, "have_factor_preds"))
277277
}
278278

279-
280279
impactsWX <- function(obj, n, k, type="SlX", method="glht", have_factor_preds=FALSE) {
281280
imps <- lapply(obj, function(x) x[, 1])
282281
bnames <- rownames(obj[[1]])
@@ -297,25 +296,37 @@ impactsWX <- function(obj, n, k, type="SlX", method="glht", have_factor_preds=FA
297296
}
298297

299298
update_bnames <- function(bnames, have_factor_preds=FALSE) {
300-
interactions <- length(grep(":", bnames)) > 0L
301299
b_suffix <- rep("dy/dx", length(bnames))
302-
if (have_factor_preds && !interactions) {
300+
stopifnot(!is.null(have_factor_preds))
301+
if (have_factor_preds) {
303302
factnames <- attr(have_factor_preds, "factnames")
304-
xlevels <- attr(have_factor_preds, "xlevels")
305-
contrasts <- attr(have_factor_preds, "contrasts")
306303
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-
}
304+
npred <- grep(paste0("^", factnames[pred], ".*"), bnames)
305+
b_suffix[npred] <- "(F)"
306+
#=======
307+
# xlevels <- attr(have_factor_preds, "xlevels")
308+
# contrasts <- attr(have_factor_preds, "pred_contrasts")
309+
# for (pred in seq(along=factnames)) {
310+
# npred <- grep(factnames[pred], bnames)
311+
# xlpred <- xlevels[[pred]]
312+
# cpred <- contrasts[[pred]]
313+
# if (length(npred) >= length(xlpred)) {
314+
# b_suffix[npred] <- ""
315+
# } else {
316+
# if (cpred == "contr.treatment") {
317+
# b_suffix[npred] <- xlpred[-1]
318+
# } else if (cpred == "code_control") {
319+
# b_suffix[npred] <- paste(xlpred[-1], "vs.", xlpred[1])
320+
# } else if (cpred == "code_diff") {
321+
# b_suffix[npred] <- paste(xlpred[-1], "vs.",
322+
# xlpred[-length(xlpred)])
323+
# } else if (cpred == "contr.poly") {
324+
# b_suffix[npred] <- "poly"
325+
# } else {
326+
# b_suffix[npred] <- ""
327+
# }
328+
# }
329+
#>>>>>>> ddd1e233b0387bd18bd409837b00671295e6001d
319330
}
320331
}
321332
bnames <- paste(bnames, b_suffix)

‎R/impacts.R‎

Lines changed: 1 addition & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -572,18 +572,7 @@ lagImpactMat <- function(x, reportQ=NULL) {
572572
mat <- cbind(direct, indirect, total)
573573
colnames(mat) <- c("Direct", "Indirect", "Total")
574574
bnames <- attr(x, "bnames")
575-
have_factor_preds <- attr(x, "have_factor_preds")
576-
if (!is.null(have_factor_preds)) {
577-
if (have_factor_preds) {
578-
xlevels <- attr(have_factor_preds, "xlevels")
579-
factnames <- attr(have_factor_preds, "factnames")
580-
rownames(mat) <- bnames
581-
} else {
582-
rownames(mat) <- bnames
583-
}
584-
} else {
585-
rownames(mat) <- bnames
586-
}
575+
rownames(mat) <- bnames
587576

588577
if (!is.null(reportQ) && reportQ) {
589578
if (is.null(x$res)) {

‎R/kpgm_new.R‎

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -33,6 +33,7 @@ GMerrorsar <- function(#W, y, X,
3333
if (!inherits(formula, "formula")) formula <- as.formula(formula)
3434
mt <- terms(formula, data = data)
3535
mf <- lm(formula, data, na.action=na.action, method="model.frame")
36+
have_factor_preds <- have_factor_preds_mf(mf)
3637
na.act <- attr(mf, "na.action")
3738
if (!is.null(na.act)) {
3839
subset <- !(1:length(listw$neighbours) %in% na.act)
@@ -234,6 +235,7 @@ GMerrorsar <- function(#W, y, X,
234235
}
235236
if (!is.null(na.act))
236237
ret$na.action <- na.act
238+
attr(ret, "have_factor_preds") <- have_factor_preds
237239
ret
238240
}
239241

@@ -411,6 +413,8 @@ impacts.Gmsar <- function(obj, ..., n=NULL, tr=NULL, R=NULL, listw=NULL,
411413
Sigma <- obj$secstep_var
412414
irho <- 1
413415
drop2beta <- 1
416+
bnames <- update_bnames(bnames,
417+
have_factor_preds=attr(obj, "have_factor_preds"))
414418
res <- intImpacts(rho=rho, beta=beta, P=P, n=n, mu=mu, Sigma=Sigma,
415419
irho=irho, drop2beta=drop2beta, bnames=bnames, interval=NULL,
416420
type="lag", tr=tr, R=R, listw=listw, evalues=evalues, tol=tol,
@@ -543,6 +547,7 @@ gstsls<-function (formula, data = list(), listw, listw2=NULL,
543547
if (!inherits(formula, "formula")) formula <- as.formula(formula)
544548
mt <- terms(formula, data = data)
545549
mf <- lm(formula, data, na.action = na.fail, method = "model.frame")
550+
have_factor_preds <- have_factor_preds_mf(mf)
546551
na.act <- attr(mf, "na.action")
547552
cl <- match.call()
548553
if (!is.null(na.act)) {
@@ -670,6 +675,7 @@ gstsls<-function (formula, data = list(), listw, listw2=NULL,
670675
}
671676

672677
if (!is.null(na.act)) ret$na.action <- na.act
678+
attr(ret, "have_factor_preds") <- have_factor_preds
673679
ret
674680
}
675681

‎R/s2sls.R‎

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -16,6 +16,7 @@ stsls <- function(formula, data = list(), listw, zero.policy=NULL,
1616
if (!inherits(formula, "formula")) formula <- as.formula(formula)
1717
mt <- terms(formula, data = data)
1818
mf <- lm(formula, data, na.action=na.action, method="model.frame")
19+
have_factor_preds <- have_factor_preds_mf(mf)
1920
na.act <- attr(mf, "na.action")
2021
if (!is.null(na.act)) {
2122
subset <- !(1:length(listw$neighbours) %in% na.act)
@@ -92,6 +93,7 @@ stsls <- function(formula, data = list(), listw, zero.policy=NULL,
9293
result$legacy <- legacy
9394
result$listw_style <- listw$style
9495
result$call <- match.call()
96+
attr(result, "have_factor_preds") <- have_factor_preds
9597
class(result) <- "Stsls"
9698
result
9799
}
@@ -211,6 +213,8 @@ impacts.Stsls <- function(obj, ..., tr=NULL, R=NULL, listw=NULL, evalues=NULL,
211213
Sigma <- obj$var
212214
irho <- 1
213215
drop2beta <- 1
216+
bnames <- update_bnames(bnames,
217+
have_factor_preds=attr(obj, "have_factor_preds"))
214218
res <- intImpacts(rho=rho, beta=beta, P=P, n=n, mu=mu, Sigma=Sigma,
215219
irho=irho, drop2beta=drop2beta, bnames=bnames, interval=NULL,
216220
type="lag", tr=tr, R=R, listw=listw, evalues=evalues, tol=tol,

‎R/sarlm_tests.R‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -414,6 +414,8 @@ impacts.Sarlm <- function(obj, ..., tr=NULL, R=NULL, listw=NULL, evalues=NULL,
414414
}
415415
}
416416
}
417+
bnames <- update_bnames(bnames,
418+
have_factor_preds=attr(obj, "have_factor_preds"))
417419
res <- intImpacts(rho=rho, beta=beta, P=P, n=n, mu=mu, Sigma=Sigma,
418420
irho=irho, drop2beta=drop2beta, bnames=bnames, interval=interval,
419421
type=obj$type, tr=tr, R=R, listw=listw, evalues=evalues, tol=tol,

‎R/spBreg.R‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -437,6 +437,8 @@ impacts.MCMC_sar_G <- function(obj, ..., tr=NULL, listw=NULL, evalues=NULL,
437437

438438
R <- nrow(samples)
439439

440+
bnames <- update_bnames(bnames,
441+
have_factor_preds=attr(obj, "have_factor_preds"))
440442
res <- intImpacts(rho=rho, beta=beta, P=P, n=n, mu=NULL, Sigma=NULL,
441443
irho=irho, drop2beta=drop2beta, bnames=bnames, interval=interval,
442444
type=type, tr=tr, R=R, listw=listw, evalues=evalues, tol=NULL,

0 commit comments

Comments
 (0)