Skip to content

Commit e2191c2

Browse files
rsbivandrsbivand
committed
continue outfactoring of create_Durbin
1 parent 4f85d37 commit e2191c2

File tree

2 files changed

+91
-3
lines changed

2 files changed

+91
-3
lines changed

‎R/ML_models.R

Lines changed: 49 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -109,6 +109,7 @@ 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+
if (Sys.getenv("SPATIALREG_CREATE_DURBIN") == "") {
112113
prefix <- "lag"
113114
if (isTRUE(Durbin)) {
114115
WX <- create_WX(x, listw, zero.policy=zero.policy,
@@ -145,7 +146,7 @@ errorsarlm <- function(formula, data = list(), listw, na.action, weights=NULL,
145146
}
146147
wxn <- substring(colnames(WX), nchar(prefix)+2,
147148
nchar(colnames(WX)))
148-
zero_fill <- NULL
149+
zero_fill <- integer(0L)
149150
if (length((which(!(xn %in% wxn)))) > 0L)
150151
zero_fill <- length(xn) + (which(!(xn %in% wxn)))
151152
}
@@ -159,6 +160,21 @@ errorsarlm <- function(formula, data = list(), listw, na.action, weights=NULL,
159160
x <- cbind(x, WX)
160161
m <- NCOL(x)
161162
rm(WX)
163+
} else { # SPATIALREG_CREATE_DURBIN
164+
res <- create_Durbin(Durbin=Durbin,
165+
have_factor_preds=have_factor_preds, x=x, listw=listw,
166+
zero.policy=zero.policy, data=data, na.act=na.act)
167+
x <- res$x
168+
dvars <- res$dvars
169+
inds <-attr(dvars, "inds")
170+
xn <- attr(dvars, "xn")
171+
wxn <- attr(dvars, "wxn")
172+
zero_fill <- attr(dvars, "zero_fill")
173+
formula_durbin_factors <- attr(dvars, "formula_durbin_factors")
174+
attr(dvars, "xn") <- NULL
175+
attr(dvars, "wxn") <- NULL
176+
}
177+
162178
}
163179
# added aliased after trying boston with TOWN dummy
164180
lm.base <- lm(y ~ x - 1, weights=weights)
@@ -640,6 +656,7 @@ lagsarlm <- function(formula, data = list(), listw,
640656
dvars <- c(NCOL(x), 0L)
641657
#FIXME
642658
if (is.formula(Durbin) || isTRUE(Durbin)) {
659+
if (Sys.getenv("SPATIALREG_CREATE_DURBIN") == "") {
643660
prefix <- "lag"
644661
if (isTRUE(Durbin)) {
645662
WX <- create_WX(x, listw, zero.policy=zero.policy,
@@ -674,7 +691,7 @@ lagsarlm <- function(formula, data = list(), listw,
674691
}
675692
wxn <- substring(colnames(WX), nchar(prefix)+2,
676693
nchar(colnames(WX)))
677-
zero_fill <- NULL
694+
zero_fill <- integer(0L)
678695
if (length((which(!(xn %in% wxn)))) > 0L)
679696
zero_fill <- length(xn) + (which(!(xn %in% wxn)))
680697
}
@@ -688,6 +705,20 @@ lagsarlm <- function(formula, data = list(), listw,
688705
x <- cbind(x, WX)
689706
m <- NCOL(x)
690707
rm(WX)
708+
} else { # SPATIALREG_CREATE_DURBIN
709+
res <- create_Durbin(Durbin=Durbin,
710+
have_factor_preds=have_factor_preds, x=x, listw=listw,
711+
zero.policy=zero.policy, data=data, na.act=na.act)
712+
x <- res$x
713+
dvars <- res$dvars
714+
inds <-attr(dvars, "inds")
715+
xn <- attr(dvars, "xn")
716+
wxn <- attr(dvars, "wxn")
717+
zero_fill <- attr(dvars, "zero_fill")
718+
formula_durbin_factors <- attr(dvars, "formula_durbin_factors")
719+
attr(dvars, "xn") <- NULL
720+
attr(dvars, "wxn") <- NULL
721+
}
691722
}
692723
# added aliased after trying boston with TOWN dummy
693724
lm.base <- lm(y ~ x - 1)
@@ -1010,6 +1041,7 @@ sacsarlm <- function(formula, data = list(), listw, listw2=NULL, na.action,
10101041
dvars <- c(m, 0L)
10111042
# if (type != "sac") {
10121043
if (is.formula(Durbin) || isTRUE(Durbin)) {
1044+
if (Sys.getenv("SPATIALREG_CREATE_DURBIN") == "") {
10131045
prefix <- "lag"
10141046
if (isTRUE(Durbin)) {
10151047
if (have_factor_preds) warn_factor_preds(have_factor_preds)
@@ -1047,7 +1079,7 @@ sacsarlm <- function(formula, data = list(), listw, listw2=NULL, na.action,
10471079
}
10481080
wxn <- substring(colnames(WX), nchar(prefix)+2,
10491081
nchar(colnames(WX)))
1050-
zero_fill <- NULL
1082+
zero_fill <- integer(0L)
10511083
if (length((which(!(xn %in% wxn)))) > 0L)
10521084
zero_fill <- length(xn) + (which(!(xn %in% wxn)))
10531085
}
@@ -1061,6 +1093,20 @@ sacsarlm <- function(formula, data = list(), listw, listw2=NULL, na.action,
10611093
x <- cbind(x, WX)
10621094
m <- NCOL(x)
10631095
rm(WX)
1096+
} else { # SPATIALREG_CREATE_DURBIN
1097+
res <- create_Durbin(Durbin=Durbin,
1098+
have_factor_preds=have_factor_preds, x=x, listw=listw,
1099+
zero.policy=zero.policy, data=data, na.act=na.act)
1100+
x <- res$x
1101+
dvars <- res$dvars
1102+
inds <-attr(dvars, "inds")
1103+
xn <- attr(dvars, "xn")
1104+
wxn <- attr(dvars, "wxn")
1105+
zero_fill <- attr(dvars, "zero_fill")
1106+
formula_durbin_factors <- attr(dvars, "formula_durbin_factors")
1107+
attr(dvars, "xn") <- NULL
1108+
attr(dvars, "wxn") <- NULL
1109+
}
10641110
}
10651111
if (NROW(x) != length(listw2$neighbours))
10661112
stop("Input data and neighbourhood list2 have different dimensions")

‎inst/tinytest/test_Durbin_factor.R

Lines changed: 42 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -23,14 +23,56 @@ expect_warning(COL.err0 <- errorsarlm(f, data=COL.OLD, lw, Durbin=TRUE))
2323
expect_warning(COL.err1 <- errorsarlm(f, data=COL.OLD, lw, Durbin=~ INC + HOVAL + fDISCBD*fEW))
2424
expect_warning(COL.err2 <- errorsarlm(f, data=COL.OLD, lw, Durbin=~ INC + HOVAL + fDISCBD))
2525
expect_silent(COL.err3 <- errorsarlm(f, data=COL.OLD, lw, Durbin=~ INC + HOVAL))
26+
Sys.setenv("SPATIALREG_CREATE_DURBIN"="0")
27+
expect_warning(COL.err0a <- errorsarlm(f, data=COL.OLD, lw, Durbin=TRUE))
28+
expect_warning(COL.err1a <- errorsarlm(f, data=COL.OLD, lw, Durbin=~ INC + HOVAL + fDISCBD*fEW))
29+
expect_warning(COL.err2a <- errorsarlm(f, data=COL.OLD, lw, Durbin=~ INC + HOVAL + fDISCBD))
30+
expect_silent(COL.err3a <- errorsarlm(f, data=COL.OLD, lw, Durbin=~ INC + HOVAL))
31+
Sys.setenv("SPATIALREG_CREATE_DURBIN"="")
32+
COL.err0$timings <- COL.err0a$timings <- NULL
33+
expect_true(isTRUE(all.equal(COL.err0, COL.err0a)))
34+
COL.err1$timings <- COL.err1a$timings <- NULL
35+
expect_true(isTRUE(all.equal(COL.err1, COL.err1a)))
36+
COL.err2$timings <- COL.err2a$timings <- NULL
37+
expect_true(isTRUE(all.equal(COL.err2, COL.err2a)))
38+
COL.err3$timings <- COL.err3a$timings <- NULL
39+
expect_true(isTRUE(all.equal(COL.err3, COL.err3a)))
2640
expect_warning(COL.lag0 <- lagsarlm(f, data=COL.OLD, lw, Durbin=TRUE))
2741
expect_warning(COL.lag1 <- lagsarlm(f, data=COL.OLD, lw, Durbin=~ INC + HOVAL + fDISCBD*fEW))
2842
expect_warning(COL.lag2 <- lagsarlm(f, data=COL.OLD, lw, Durbin=~ INC + HOVAL + fDISCBD))
2943
expect_silent(COL.lag3 <- lagsarlm(f, data=COL.OLD, lw, Durbin=~ INC + HOVAL))
44+
Sys.setenv("SPATIALREG_CREATE_DURBIN"="0")
45+
expect_warning(COL.lag0a <- lagsarlm(f, data=COL.OLD, lw, Durbin=TRUE))
46+
expect_warning(COL.lag1a <- lagsarlm(f, data=COL.OLD, lw, Durbin=~ INC + HOVAL + fDISCBD*fEW))
47+
expect_warning(COL.lag2a <- lagsarlm(f, data=COL.OLD, lw, Durbin=~ INC + HOVAL + fDISCBD))
48+
expect_silent(COL.lag3a <- lagsarlm(f, data=COL.OLD, lw, Durbin=~ INC + HOVAL))
49+
Sys.setenv("SPATIALREG_CREATE_DURBIN"="")
50+
COL.lag0$timings <- COL.lag0a$timings <- NULL
51+
expect_true(isTRUE(all.equal(COL.lag0, COL.lag0a)))
52+
COL.lag1$timings <- COL.lag1a$timings <- NULL
53+
expect_true(isTRUE(all.equal(COL.lag1, COL.lag1a)))
54+
COL.lag2$timings <- COL.lag2a$timings <- NULL
55+
expect_true(isTRUE(all.equal(COL.lag2, COL.lag2a)))
56+
COL.lag3$timings <- COL.lag3a$timings <- NULL
57+
expect_true(isTRUE(all.equal(COL.lag3, COL.lag3a)))
3058
expect_warning(COL.sac0 <- sacsarlm(f, data=COL.OLD, lw, Durbin=TRUE))
3159
expect_warning(COL.sac1 <- sacsarlm(f, data=COL.OLD, lw, Durbin=~ INC + HOVAL + fDISCBD*fEW))
3260
expect_warning(COL.sac2 <- sacsarlm(f, data=COL.OLD, lw, Durbin=~ INC + HOVAL + fDISCBD))
3361
expect_silent(COL.sac3 <- sacsarlm(f, data=COL.OLD, lw, Durbin=~ INC + HOVAL))
62+
Sys.setenv("SPATIALREG_CREATE_DURBIN"="0")
63+
expect_warning(COL.sac0a <- sacsarlm(f, data=COL.OLD, lw, Durbin=TRUE))
64+
expect_warning(COL.sac1a <- sacsarlm(f, data=COL.OLD, lw, Durbin=~ INC + HOVAL + fDISCBD*fEW))
65+
expect_warning(COL.sac2a <- sacsarlm(f, data=COL.OLD, lw, Durbin=~ INC + HOVAL + fDISCBD))
66+
expect_silent(COL.sac3a <- sacsarlm(f, data=COL.OLD, lw, Durbin=~ INC + HOVAL))
67+
Sys.setenv("SPATIALREG_CREATE_DURBIN"="")
68+
COL.sac0$timings <- COL.sac0a$timings <- NULL
69+
expect_true(isTRUE(all.equal(COL.sac0, COL.sac0a)))
70+
COL.sac1$timings <- COL.sac1a$timings <- NULL
71+
expect_true(isTRUE(all.equal(COL.sac1, COL.sac1a)))
72+
COL.sac2$timings <- COL.sac2a$timings <- NULL
73+
expect_true(isTRUE(all.equal(COL.sac2, COL.sac2a)))
74+
COL.sac3$timings <- COL.sac3a$timings <- NULL
75+
expect_true(isTRUE(all.equal(COL.sac3, COL.sac3a)))
3476
expect_warning(COL.lag0 <- spBreg_lag(f, data=COL.OLD, lw, Durbin=TRUE))
3577
expect_warning(COL.lag1 <- spBreg_lag(f, data=COL.OLD, lw, Durbin=~ INC + HOVAL + fDISCBD*fEW))
3678
expect_warning(COL.lag2 <- spBreg_lag(f, data=COL.OLD, lw, Durbin=~ INC + HOVAL + fDISCBD))

0 commit comments

Comments
 (0)