Durbin factors code factor

Author: rsbivand

R/ML_models.R

@@ -46,14 +46,7 @@ errorsarlm <- function(formula, data = list(), listw, na.action, weights=NULL,
             warning("intercept-only model, Durbin invalid and set FALSE")
             Durbin <- FALSE
         }
-	dcfact <- which(attr(attr(mf, "terms"), "dataClasses") == "factor")
-        have_factor_preds <- FALSE
-        if (length(dcfact) > 0) {
-            have_factor_preds <- TRUE
-            factnames <- names(dcfact)
-            xlevels <- lapply(factnames, function(xnms) levels(mf[[xnms]]))
-            names(xlevels) <- factnames
-        }
+        have_factor_preds <- have_factor_preds_mf(mf)
 #
 	na.act <- attr(mf, "na.action")
 	if (!is.null(na.act)) {
@@ -76,7 +69,8 @@ errorsarlm <- function(formula, data = list(), listw, na.action, weights=NULL,
             etype <- "emixed"
             if (have_factor_preds)
                 warning("use of spatially lagged factors (categorical variables)\n", 
-                paste(factnames, collapse=", "), "\nis not well-understood")
+                paste(attr(have_factor_preds, "factnames"), collapse=", "),
+                "\nis not well-understood")
         }
         if (is.formula(Durbin)) etype <- "emixed"
         if (is.logical(Durbin) && !isTRUE(Durbin)) etype <- "error"
@@ -130,11 +124,12 @@ errorsarlm <- function(formula, data = list(), listw, na.action, weights=NULL,
                     }
 	            dmf <- lm(Durbin, data1, na.action=na.fail, 
 		        method="model.frame")
-	    	    Ddcfact <- which(attr(attr(dmf, "terms"), "dataClasses") == "factor")
-            	    if (length(Ddcfact) > 0) {
-                        warning("use of spatially lagged factors (categorical variables)\n", 
-                        paste(names(Ddcfact), collapse=", "), "\nis not well-understood")
-                    }
+	           formula_durbin_factors <- have_factor_preds_mf(dmf)
+                   if (formula_durbin_factors) {
+                       warning("use of spatially lagged factors (categorical variables)\n", 
+                       paste(attr(formula_durbin_factors, "factnames"), collapse=", "),
+                       "\nis not well-understood")
+                   }
 #	            dmf <- lm(Durbin, data, na.action=na.action, 
 #		        method="model.frame")
                     fx <- try(model.matrix(Durbin, dmf), silent=TRUE)

R/SLX_WX.R

@@ -18,14 +18,7 @@ lmSLX <- function(formula, data = list(), listw, na.action, weights=NULL, Durbin
         if (attr(mt, "intercept") == 1 && !any(attr(mt, "factors") == 1)) {
             stop("intercept-only model, Durbin invalid")
         }
-	dcfact <- which(attr(attr(mf, "terms"), "dataClasses") == "factor")
-        have_factor_preds <- FALSE
-        if (length(dcfact) > 0) {
-            have_factor_preds <- TRUE
-            factnames <- names(dcfact)
-            xlevels <- lapply(factnames, function(xnms) levels(mf[[xnms]]))
-            names(xlevels) <- factnames
-        }
+	have_factor_preds <- have_factor_preds_mf(mf)
 	na.act <- attr(mf, "na.action")
 	if (!inherits(listw, "listw")) stop("No neighbourhood list")
 	if (listw$style == "M") warning("missing spatial weights style")
@@ -58,7 +51,8 @@ lmSLX <- function(formula, data = list(), listw, na.action, weights=NULL, Durbin
         if (isTRUE(Durbin)) {
             if (have_factor_preds)
                 warning("use of spatially lagged factors (categorical variables)\n",
-                paste(factnames, collapse=", "), "\nis not well-understood")
+                paste(attr(have_factor_preds, "factnames"), collapse=", "),
+                "\nis not well-understood")
             WX <- create_WX(x, listw, zero.policy=zero.policy,
                prefix=prefix)
         } else if (is.formula(Durbin)) {
@@ -69,10 +63,11 @@ lmSLX <- function(formula, data = list(), listw, na.action, weights=NULL, Durbin
             }
             dmf <- lm(Durbin, data1, na.action=na.fail, 
 	        method="model.frame")
-	    Ddcfact <- which(attr(attr(dmf, "terms"), "dataClasses") == "factor")
-            if (length(Ddcfact) > 0) {
+	    formula_durbin_factors <- have_factor_preds_mf(dmf)
+            if (formula_durbin_factors) {
                 warning("use of spatially lagged factors (categorical variables)\n", 
-                paste(names(Ddcfact), collapse=", "), "\nis not well-understood")
+                paste(attr(formula_durbin_factors, "factnames"), collapse=", "),
+                "\nis not well-understood")
             }
 #	    dmf <- lm(Durbin, data, na.action=na.action, 
 #	         method="model.frame")

R/cat_durbin.R

@@ -0,0 +1,18 @@
+# Copyright 2025 by Roger Bivand 
+#
+
+have_factor_preds_mf <- function(mf) {
+    if (!inherits(mf, "data.frame") || is.null(attr(mf, "terms")))
+        stop("mf not a model.frame")
+    dcfact <- which(attr(attr(mf, "terms"), "dataClasses") == "factor")
+    have_factor_preds <- FALSE
+    if (length(dcfact) > 0) {
+        have_factor_preds <- TRUE
+        factnames <- names(dcfact)
+        xlevels <- lapply(factnames, function(xnms) levels(mf[[xnms]]))
+        names(xlevels) <- factnames
+        attr(have_factor_preds, "xlevels") <- xlevels 
+        attr(have_factor_preds, "factnames") <- factnames
+    }
+    have_factor_preds
+}