Skip to content

Commit cd46e51

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

File tree

2 files changed

+63
-4
lines changed

2 files changed

+63
-4
lines changed

‎R/spBreg.R

Lines changed: 51 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -84,6 +84,7 @@ spBreg_lag <- function(formula, data = list(), listw, na.action, Durbin, type,
8484
# WX <- create_WX(x, listw, zero.policy=zero.policy, prefix="lag")
8585
#FIXME
8686
if (is.formula(Durbin) || isTRUE(Durbin)) {
87+
if (Sys.getenv("SPATIALREG_CREATE_DURBIN") == "") {
8788
prefix <- "lag"
8889
if (isTRUE(Durbin)) {
8990
if (have_factor_preds) warn_factor_preds(have_factor_preds)
@@ -121,7 +122,7 @@ spBreg_lag <- function(formula, data = list(), listw, na.action, Durbin, type,
121122
}
122123
wxn <- substring(colnames(WX), nchar(prefix)+2,
123124
nchar(colnames(WX)))
124-
zero_fill <- NULL
125+
zero_fill <- integer(0L)
125126
if (length((which(!(xn %in% wxn)))) > 0L)
126127
zero_fill <- length(xn) + (which(!(xn %in% wxn)))
127128
}
@@ -135,6 +136,20 @@ spBreg_lag <- function(formula, data = list(), listw, na.action, Durbin, type,
135136
x <- cbind(x, WX)
136137
m <- NCOL(x)
137138
rm(WX)
139+
} else { # SPATIALREG_CREATE_DURBIN
140+
res <- create_Durbin(Durbin=Durbin,
141+
have_factor_preds=have_factor_preds, x=x, listw=listw,
142+
zero.policy=zero.policy, data=data, na.act=na.act)
143+
x <- res$x
144+
dvars <- res$dvars
145+
inds <-attr(dvars, "inds")
146+
xn <- attr(dvars, "xn")
147+
wxn <- attr(dvars, "wxn")
148+
zero_fill <- attr(dvars, "zero_fill")
149+
formula_durbin_factors <- attr(dvars, "formula_durbin_factors")
150+
attr(dvars, "xn") <- NULL
151+
attr(dvars, "wxn") <- NULL
152+
}
138153
}
139154
# x <- cbind(x, WX)
140155
# rm(WX)
@@ -408,7 +423,7 @@ impacts.MCMC_sar_G <- function(obj, ..., tr=NULL, listw=NULL, evalues=NULL,
408423
beta <- means[1:(length(means)-2)]
409424
icept <- grep("(Intercept)", names(beta))
410425
iicept <- length(icept) > 0L
411-
zero_fill <- NULL
426+
zero_fill <- integer(0L)
412427
dvars <- NULL
413428
samples <- as.matrix(obj)
414429
interval <- attr(obj, "control")$interval
@@ -569,6 +584,7 @@ spBreg_err <- function(formula, data = list(), listw, na.action, Durbin, etype,
569584
dvars <- c(NCOL(x), 0L)
570585

571586
if (is.formula(Durbin) || isTRUE(Durbin)) {
587+
if (Sys.getenv("SPATIALREG_CREATE_DURBIN") == "") {
572588
prefix <- "lag"
573589
if (isTRUE(Durbin)) {
574590
if (have_factor_preds) warn_factor_preds(have_factor_preds)
@@ -606,7 +622,7 @@ spBreg_err <- function(formula, data = list(), listw, na.action, Durbin, etype,
606622
}
607623
wxn <- substring(colnames(WX), nchar(prefix)+2,
608624
nchar(colnames(WX)))
609-
zero_fill <- NULL
625+
zero_fill <- integer(0L)
610626
if (length((which(!(xn %in% wxn)))) > 0L)
611627
zero_fill <- length(xn) + (which(!(xn %in% wxn)))
612628
}
@@ -621,6 +637,22 @@ spBreg_err <- function(formula, data = list(), listw, na.action, Durbin, etype,
621637
xcolnames <- colnames(x)
622638
m <- NCOL(x)
623639
rm(WX)
640+
} else { # SPATIALREG_CREATE_DURBIN
641+
res <- create_Durbin(Durbin=Durbin,
642+
have_factor_preds=have_factor_preds, x=x, listw=listw,
643+
zero.policy=zero.policy, data=data, na.act=na.act)
644+
x <- res$x
645+
xcolnames <- colnames(x)
646+
m <- NCOL(x)
647+
dvars <- res$dvars
648+
inds <-attr(dvars, "inds")
649+
xn <- attr(dvars, "xn")
650+
wxn <- attr(dvars, "wxn")
651+
zero_fill <- attr(dvars, "zero_fill")
652+
formula_durbin_factors <- attr(dvars, "formula_durbin_factors")
653+
attr(dvars, "xn") <- NULL
654+
attr(dvars, "wxn") <- NULL
655+
}
624656
}
625657
# x <- cbind(x, WX)
626658
# rm(WX)
@@ -1070,6 +1102,7 @@ spBreg_sac <- function(formula, data = list(), listw, listw2=NULL, na.action,
10701102
# WX <- create_WX(x, listw, zero.policy=zero.policy, prefix="lag")
10711103
#FIXME
10721104
if (is.formula(Durbin) || isTRUE(Durbin)) {
1105+
if (Sys.getenv("SPATIALREG_CREATE_DURBIN") == "") {
10731106
prefix <- "lag"
10741107
if (isTRUE(Durbin)) {
10751108
if (have_factor_preds) warn_factor_preds(have_factor_preds)
@@ -1107,7 +1140,7 @@ spBreg_sac <- function(formula, data = list(), listw, listw2=NULL, na.action,
11071140
}
11081141
wxn <- substring(colnames(WX), nchar(prefix)+2,
11091142
nchar(colnames(WX)))
1110-
zero_fill <- NULL
1143+
zero_fill <- integer(0L)
11111144
if (length((which(!(xn %in% wxn)))) > 0L)
11121145
zero_fill <- length(xn) + (which(!(xn %in% wxn)))
11131146
}
@@ -1121,6 +1154,20 @@ spBreg_sac <- function(formula, data = list(), listw, listw2=NULL, na.action,
11211154
x <- cbind(x, WX)
11221155
m <- NCOL(x)
11231156
rm(WX)
1157+
} else { # SPATIALREG_CREATE_DURBIN
1158+
res <- create_Durbin(Durbin=Durbin,
1159+
have_factor_preds=have_factor_preds, x=x, listw=listw,
1160+
zero.policy=zero.policy, data=data, na.act=na.act)
1161+
x <- res$x
1162+
dvars <- res$dvars
1163+
inds <-attr(dvars, "inds")
1164+
xn <- attr(dvars, "xn")
1165+
wxn <- attr(dvars, "wxn")
1166+
zero_fill <- attr(dvars, "zero_fill")
1167+
formula_durbin_factors <- attr(dvars, "formula_durbin_factors")
1168+
attr(dvars, "xn") <- NULL
1169+
attr(dvars, "wxn") <- NULL
1170+
}
11241171
}
11251172
if (NROW(x) != length(listw2$neighbours))
11261173
stop("Input data and neighbourhood list2 have different dimensions")

‎inst/tinytest/test_Durbin_factor.R

Lines changed: 12 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -77,8 +77,20 @@ expect_warning(COL.lag0 <- spBreg_lag(f, data=COL.OLD, lw, Durbin=TRUE))
7777
expect_warning(COL.lag1 <- spBreg_lag(f, data=COL.OLD, lw, Durbin=~ INC + HOVAL + fDISCBD*fEW))
7878
expect_warning(COL.lag2 <- spBreg_lag(f, data=COL.OLD, lw, Durbin=~ INC + HOVAL + fDISCBD))
7979
expect_silent(COL.lag3 <- spBreg_lag(f, data=COL.OLD, lw, Durbin=~ INC + HOVAL))
80+
Sys.setenv("SPATIALREG_CREATE_DURBIN"="0")
81+
expect_warning(COL.lag0a <- spBreg_lag(f, data=COL.OLD, lw, Durbin=TRUE))
82+
expect_warning(COL.lag1a <- spBreg_lag(f, data=COL.OLD, lw, Durbin=~ INC + HOVAL + fDISCBD*fEW))
83+
expect_warning(COL.lag2a <- spBreg_lag(f, data=COL.OLD, lw, Durbin=~ INC + HOVAL + fDISCBD))
84+
expect_silent(COL.lag3a <- spBreg_lag(f, data=COL.OLD, lw, Durbin=~ INC + HOVAL))
85+
Sys.setenv("SPATIALREG_CREATE_DURBIN"="")
8086
expect_warning(COL.err0 <- spBreg_err(f, data=COL.OLD, lw, Durbin=TRUE))
8187
expect_warning(COL.err1 <- spBreg_err(f, data=COL.OLD, lw, Durbin=~ INC + HOVAL + fDISCBD*fEW))
8288
expect_warning(COL.err2 <- spBreg_err(f, data=COL.OLD, lw, Durbin=~ INC + HOVAL + fDISCBD))
8389
expect_silent(COL.err3 <- spBreg_err(f, data=COL.OLD, lw, Durbin=~ INC + HOVAL))
90+
Sys.setenv("SPATIALREG_CREATE_DURBIN"="0")
91+
expect_warning(COL.err0a <- spBreg_err(f, data=COL.OLD, lw, Durbin=TRUE))
92+
expect_warning(COL.err1a <- spBreg_err(f, data=COL.OLD, lw, Durbin=~ INC + HOVAL + fDISCBD*fEW))
93+
expect_warning(COL.err2a <- spBreg_err(f, data=COL.OLD, lw, Durbin=~ INC + HOVAL + fDISCBD))
94+
expect_silent(COL.err3a <- spBreg_err(f, data=COL.OLD, lw, Durbin=~ INC + HOVAL))
95+
Sys.setenv("SPATIALREG_CREATE_DURBIN"="")
8496

0 commit comments

Comments
 (0)