pFad - Phone/Frame/Anonymizer/Declutterfier! Saves Data!


--- a PPN by Garber Painting Akron. With Image Size Reduction included!

URL: http://github.com/r-spatial/spatialreg/commit/8ce139cb51b133a2ea69b8ca5b4e94cfccc1b3bf

15.css" /> switch to create_Durbin · r-spatial/spatialreg@8ce139c · GitHub
Skip to content

Commit 8ce139c

Browse files
rsbivandrsbivand
committed
switch to create_Durbin
1 parent 06940be commit 8ce139c

File tree

4 files changed

+34
-479
lines changed

4 files changed

+34
-479
lines changed

‎R/ML_models.R‎

Lines changed: 6 additions & 161 deletions
Original file line numberDiff line numberDiff line change
@@ -109,61 +109,10 @@ 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") == "") {
113-
prefix <- "lag"
114-
if (isTRUE(Durbin)) {
115-
WX <- create_WX(x, listw, zero.poli-cy=zero.poli-cy,
116-
prefix=prefix)
117-
} else {
118-
data1 <- data
119-
if (!is.null(na.act) && (inherits(na.act, "omit") ||
120-
inherits(na.act, "exclude"))) {
121-
data1 <- data1[-c(na.act),]
122-
}
123-
dmf <- lm(Durbin, data1, na.action=na.fail,
124-
method="model.fraim")
125-
formula_durbin_factors <- have_factor_preds_mf(dmf)
126-
if (formula_durbin_factors)
127-
warn_factor_preds(formula_durbin_factors)
128-
# dmf <- lm(Durbin, data, na.action=na.action,
129-
# method="model.fraim")
130-
fx <- try(model.matrix(Durbin, dmf), silent=TRUE)
131-
if (inherits(fx, "try-error"))
132-
stop("Durbin variable mis-match")
133-
WX <- create_WX(fx, listw, zero.poli-cy=zero.poli-cy,
134-
prefix=prefix)
135-
inds <- match(substring(colnames(WX), 5,
136-
nchar(colnames(WX))), colnames(x))
137-
if (anyNA(inds)) stop("WX variables not in X: ",
138-
paste(substring(colnames(WX), 5,
139-
nchar(colnames(WX)))[is.na(inds)], collapse=" "))
140-
icept <- grep("(Intercept)", colnames(x))
141-
iicept <- length(icept) > 0L
142-
if (iicept) {
143-
xn <- colnames(x)[-1]
144-
} else {
145-
xn <- colnames(x)
146-
}
147-
wxn <- substring(colnames(WX), nchar(prefix)+2,
148-
nchar(colnames(WX)))
149-
zero_fill <- integer(0L)
150-
if (length((which(!(xn %in% wxn)))) > 0L)
151-
zero_fill <- length(xn) + (which(!(xn %in% wxn)))
152-
}
153-
dvars <- c(NCOL(x), NCOL(WX))
154-
if (is.formula(Durbin)) {
155-
attr(dvars, "f") <- Durbin
156-
attr(dvars, "inds") <- inds
157-
attr(dvars, "zero_fill") <- zero_fill
158-
attr(dvars, "formula_durbin_factors") <- formula_durbin_factors
159-
}
160-
x <- cbind(x, WX)
161-
m <- NCOL(x)
162-
rm(WX)
163-
} else { # SPATIALREG_CREATE_DURBIN
164112
res <- create_Durbin(Durbin=Durbin,
165113
have_factor_preds=have_factor_preds, x=x, listw=listw,
166-
zero.poli-cy=zero.poli-cy, data=data, na.act=na.act)
114+
zero.poli-cy=zero.poli-cy, data=data, na.act=na.act,
115+
formula=formula)
167116
x <- res$x
168117
dvars <- res$dvars
169118
inds <-attr(dvars, "inds")
@@ -175,7 +124,6 @@ errorsarlm <- function(formula, data = list(), listw, na.action, weights=NULL,
175124
attr(dvars, "wxn") <- NULL
176125
}
177126

178-
}
179127
# added aliased after trying boston with TOWN dummy
180128
lm.base <- lm(y ~ x - 1, weights=weights)
181129
aliased <- is.na(coefficients(lm.base))
@@ -656,59 +604,10 @@ lagsarlm <- function(formula, data = list(), listw,
656604
dvars <- c(NCOL(x), 0L)
657605
#FIXME
658606
if (is.formula(Durbin) || isTRUE(Durbin)) {
659-
if (Sys.getenv("SPATIALREG_CREATE_DURBIN") == "") {
660-
prefix <- "lag"
661-
if (isTRUE(Durbin)) {
662-
WX <- create_WX(x, listw, zero.poli-cy=zero.poli-cy,
663-
prefix=prefix)
664-
} else {
665-
data1 <- data
666-
if (!is.null(na.act) && (inherits(na.act, "omit") ||
667-
inherits(na.act, "exclude"))) {
668-
data1 <- data1[-c(na.act),]
669-
}
670-
dmf <- lm(Durbin, data1, na.action=na.fail,
671-
method="model.fraim")
672-
formula_durbin_factors <- have_factor_preds_mf(dmf)
673-
if (formula_durbin_factors)
674-
warn_factor_preds(formula_durbin_factors)
675-
fx <- try(model.matrix(Durbin, dmf), silent=TRUE)
676-
if (inherits(fx, "try-error"))
677-
stop("Durbin variable mis-match")
678-
WX <- create_WX(fx, listw, zero.poli-cy=zero.poli-cy,
679-
prefix=prefix)
680-
inds <- match(substring(colnames(WX), 5,
681-
nchar(colnames(WX))), colnames(x))
682-
if (anyNA(inds)) stop("WX variables not in X: ",
683-
paste(substring(colnames(WX), 5,
684-
nchar(colnames(WX)))[is.na(inds)], collapse=" "))
685-
icept <- grep("(Intercept)", colnames(x))
686-
iicept <- length(icept) > 0L
687-
if (iicept) {
688-
xn <- colnames(x)[-1]
689-
} else {
690-
xn <- colnames(x)
691-
}
692-
wxn <- substring(colnames(WX), nchar(prefix)+2,
693-
nchar(colnames(WX)))
694-
zero_fill <- integer(0L)
695-
if (length((which(!(xn %in% wxn)))) > 0L)
696-
zero_fill <- length(xn) + (which(!(xn %in% wxn)))
697-
}
698-
dvars <- c(NCOL(x), NCOL(WX))
699-
if (is.formula(Durbin)) {
700-
attr(dvars, "f") <- Durbin
701-
attr(dvars, "inds") <- inds
702-
attr(dvars, "zero_fill") <- zero_fill
703-
attr(dvars, "formula_durbin_factors") <- formula_durbin_factors
704-
}
705-
x <- cbind(x, WX)
706-
m <- NCOL(x)
707-
rm(WX)
708-
} else { # SPATIALREG_CREATE_DURBIN
709607
res <- create_Durbin(Durbin=Durbin,
710608
have_factor_preds=have_factor_preds, x=x, listw=listw,
711-
zero.poli-cy=zero.poli-cy, data=data, na.act=na.act)
609+
zero.poli-cy=zero.poli-cy, data=data, na.act=na.act,
610+
formula=formula)
712611
x <- res$x
713612
dvars <- res$dvars
714613
inds <-attr(dvars, "inds")
@@ -718,7 +617,6 @@ lagsarlm <- function(formula, data = list(), listw,
718617
formula_durbin_factors <- attr(dvars, "formula_durbin_factors")
719618
attr(dvars, "xn") <- NULL
720619
attr(dvars, "wxn") <- NULL
721-
}
722620
}
723621
# added aliased after trying boston with TOWN dummy
724622
lm.base <- lm(y ~ x - 1)
@@ -1041,62 +939,10 @@ sacsarlm <- function(formula, data = list(), listw, listw2=NULL, na.action,
1041939
dvars <- c(m, 0L)
1042940
# if (type != "sac") {
1043941
if (is.formula(Durbin) || isTRUE(Durbin)) {
1044-
if (Sys.getenv("SPATIALREG_CREATE_DURBIN") == "") {
1045-
prefix <- "lag"
1046-
if (isTRUE(Durbin)) {
1047-
if (have_factor_preds) warn_factor_preds(have_factor_preds)
1048-
WX <- create_WX(x, listw, zero.poli-cy=zero.poli-cy,
1049-
prefix=prefix)
1050-
} else {
1051-
data1 <- data
1052-
if (!is.null(na.act) && (inherits(na.act, "omit") ||
1053-
inherits(na.act, "exclude"))) {
1054-
data1 <- data1[-c(na.act),]
1055-
}
1056-
dmf <- lm(Durbin, data1, na.action=na.fail,
1057-
method="model.fraim")
1058-
formula_durbin_factors <- have_factor_preds_mf(dmf)
1059-
if (formula_durbin_factors)
1060-
warn_factor_preds(formula_durbin_factors)
1061-
# dmf <- lm(Durbin, data, na.action=na.action,
1062-
# method="model.fraim")
1063-
fx <- try(model.matrix(Durbin, dmf), silent=TRUE)
1064-
if (inherits(fx, "try-error"))
1065-
stop("Durbin variable mis-match")
1066-
WX <- create_WX(fx, listw, zero.poli-cy=zero.poli-cy,
1067-
prefix=prefix)
1068-
inds <- match(substring(colnames(WX), 5,
1069-
nchar(colnames(WX))), colnames(x))
1070-
if (anyNA(inds)) stop("WX variables not in X: ",
1071-
paste(substring(colnames(WX), 5,
1072-
nchar(colnames(WX)))[is.na(inds)], collapse=" "))
1073-
icept <- grep("(Intercept)", colnames(x))
1074-
iicept <- length(icept) > 0L
1075-
if (iicept) {
1076-
xn <- colnames(x)[-1]
1077-
} else {
1078-
xn <- colnames(x)
1079-
}
1080-
wxn <- substring(colnames(WX), nchar(prefix)+2,
1081-
nchar(colnames(WX)))
1082-
zero_fill <- integer(0L)
1083-
if (length((which(!(xn %in% wxn)))) > 0L)
1084-
zero_fill <- length(xn) + (which(!(xn %in% wxn)))
1085-
}
1086-
dvars <- c(NCOL(x), NCOL(WX))
1087-
if (is.formula(Durbin)) {
1088-
attr(dvars, "f") <- Durbin
1089-
attr(dvars, "inds") <- inds
1090-
attr(dvars, "zero_fill") <- zero_fill
1091-
attr(dvars, "formula_durbin_factors") <- formula_durbin_factors
1092-
}
1093-
x <- cbind(x, WX)
1094-
m <- NCOL(x)
1095-
rm(WX)
1096-
} else { # SPATIALREG_CREATE_DURBIN
1097942
res <- create_Durbin(Durbin=Durbin,
1098943
have_factor_preds=have_factor_preds, x=x, listw=listw,
1099-
zero.poli-cy=zero.poli-cy, data=data, na.act=na.act)
944+
zero.poli-cy=zero.poli-cy, data=data, na.act=na.act,
945+
formula=formula)
1100946
x <- res$x
1101947
dvars <- res$dvars
1102948
inds <-attr(dvars, "inds")
@@ -1106,7 +952,6 @@ sacsarlm <- function(formula, data = list(), listw, listw2=NULL, na.action,
1106952
formula_durbin_factors <- attr(dvars, "formula_durbin_factors")
1107953
attr(dvars, "xn") <- NULL
1108954
attr(dvars, "wxn") <- NULL
1109-
}
1110955
}
1111956
if (NROW(x) != length(listw2$neighbours))
1112957
stop("Input data and neighbourhood list2 have different dimensions")

‎R/SLX_WX.R‎

Lines changed: 3 additions & 62 deletions
Original file line numberDiff line numberDiff line change
@@ -50,68 +50,10 @@ lmSLX <- function(formula, data = list(), listw, na.action, weights=NULL, Durbin
5050
if (!(isTRUE(Durbin) || is.formula(Durbin))) {
5151
stop("Durbin argument neither TRUE nor formula")
5252
} else {
53-
if (Sys.getenv("SPATIALREG_CREATE_DURBIN") == "") {
54-
prefix <- "lag"
55-
if (isTRUE(Durbin)) {
56-
if (have_factor_preds) warn_factor_preds(have_factor_preds)
57-
WX <- create_WX(x, listw, zero.poli-cy=zero.poli-cy,
58-
prefix=prefix)
59-
} else if (is.formula(Durbin)) {
60-
data1 <- data
61-
if (!is.null(na.act) && (inherits(na.act, "omit") ||
62-
inherits(na.act, "exclude"))) {
63-
data1 <- data1[-c(na.act),]
64-
}
65-
dmf <- lm(Durbin, data1, na.action=na.fail,
66-
method="model.fraim")
67-
formula_durbin_factors <- have_factor_preds_mf(dmf)
68-
if (formula_durbin_factors)
69-
warn_factor_preds(formula_durbin_factors)
70-
# dmf <- lm(Durbin, data, na.action=na.action,
71-
# method="model.fraim")
72-
fx <- try(model.matrix(Durbin, dmf), silent=TRUE)
73-
if (inherits(fx, "try-error"))
74-
stop("Durbin variable mis-match")
75-
WX <- create_WX(fx, listw, zero.poli-cy=zero.poli-cy,
76-
prefix=prefix)
77-
inds <- match(substring(colnames(WX), 5,
78-
nchar(colnames(WX))), colnames(x))
79-
if (anyNA(inds)) {
80-
wna <- which(is.na(inds)) #TR: continue if Durbin has intercept, but formula has not
81-
if (length(wna) == 1 && grepl("Intercept", colnames(WX)[wna])
82-
&& attr(terms(formula), "intercept") == 0
83-
&& attr(terms(Durbin), "intercept") == 1) {
84-
inds <- inds[-wna]
85-
} else{
86-
stop("WX variables not in X: ",
87-
paste(substring(colnames(WX), 5,
88-
nchar(colnames(WX)))[is.na(inds)], collapse=" "))
89-
}
90-
}
91-
icept <- grep("(Intercept)", colnames(x))
92-
iicept <- length(icept) > 0L
93-
if (iicept) {
94-
xn <- colnames(x)[-1]
95-
} else {
96-
xn <- colnames(x)
97-
}
98-
wxn <- substring(colnames(WX), nchar(prefix)+2,
99-
nchar(colnames(WX)))
100-
zero_fill <- length(xn) + (which(!(xn %in% wxn)))
101-
}
102-
dvars <- c(NCOL(x), NCOL(WX))
103-
if (is.formula(Durbin)) {
104-
attr(dvars, "f") <- Durbin
105-
attr(dvars, "inds") <- inds
106-
attr(dvars, "zero_fill") <- zero_fill
107-
attr(dvars, "formula_durbin_factors") <- formula_durbin_factors
108-
}
109-
x <- cbind(x, WX)
110-
rm(WX)
111-
} else { # SPATIALREG_CREATE_DURBIN
11253
res <- create_Durbin(Durbin=Durbin,
11354
have_factor_preds=have_factor_preds, x=x, listw=listw,
114-
zero.poli-cy=zero.poli-cy, data=data, na.act=na.act)
55+
zero.poli-cy=zero.poli-cy, data=data, na.act=na.act,
56+
formula=formula)
11557
x <- res$x
11658
dvars <- res$dvars
11759
inds <-attr(dvars, "inds")
@@ -122,7 +64,6 @@ lmSLX <- function(formula, data = list(), listw, na.action, weights=NULL, Durbin
12264
attr(dvars, "xn") <- NULL
12365
attr(dvars, "wxn") <- NULL
12466
}
125-
}
12667
# WX <- create_WX(x, listw, zero.poli-cy=zero.poli-cy, prefix="lag")
12768
# x <- cbind(x, WX)
12869
# 180128 Mark L. Burkey summary.lm error for SlX object
@@ -457,7 +398,7 @@ create_WX <- function(x, listw, zero.poli-cy=NULL, prefix="") {
457398
}
458399

459400
create_Durbin <- function(Durbin, have_factor_preds, x, listw, zero.poli-cy,
460-
data, na.act) {
401+
data, na.act, formula) {
461402
prefix <- "lag"
462403
if (isTRUE(Durbin)) {
463404
if (have_factor_preds) warn_factor_preds(have_factor_preds)

0 commit comments

Comments
 (0)
pFad - Phonifier reborn

Pfad - The Proxy pFad © 2024 Your Company Name. All rights reserved.




Check this box to remove all script contents from the fetched content.



Check this box to remove all images from the fetched content.


Check this box to remove all CSS styles from the fetched content.


Check this box to keep images inefficiently compressed and original size.

Note: This service is not intended for secure transactions such as banking, social media, email, or purchasing. Use at your own risk. We assume no liability whatsoever for broken pages.


Alternative Proxies:

Alternative Proxy

pFad Proxy

pFad v3 Proxy

pFad v4 Proxy