Fix collinearity inflation for ordinal models

R/check_collinearity.R

@@ -447,7 +447,7 @@
 }
 
 
 .check_collinearity <- function(x, component, ci = 0.95, verbose = TRUE) {
   v <- .safe(insight::get_varcov(x, component = component, verbose = FALSE))
 
   # sanity check
@@ -491,12 +491,29 @@
     }
   }
 
-  # check for missing intercept
-  if (insight::has_intercept(x)) {
-    v <- v[-1, -1]
-    term_assign <- term_assign[-1]
-  } else if (isTRUE(verbose)) {
-    insight::format_alert("Model has no intercept. VIFs may not be sensible.")
+  # Filter to true slope parameters (handles multiple intercepts in ordinal models)
+  if (inherits(x, c("clm", "clmm"))) {
+    slope_names <- insight::find_parameters(x)$conditional
+    if (is.null(slope_names)) {
+      slope_names <- names(x$beta)
+    }
+    keep_idx <- which(colnames(v) %in% slope_names)
+  } else if (insight::has_intercept(x)) {
+    # Standard behavior: drop the first column/row (the singular intercept)
+    keep_idx <- seq_len(ncol(v))[-1]
+  } else {
+    keep_idx <- seq_len(ncol(v))
+    if (isTRUE(verbose)) {
+      insight::format_alert("Model without intercept. VIFs may not be sensible.")
+    }
+  }
+
+  # Safely subset the matrix and the assignment vector
+  if (length(keep_idx) < ncol(v)) {
+    if (!is.null(term_assign) && length(term_assign) == ncol(v)) {
+      term_assign <- term_assign[keep_idx]
+    }
+    v <- v[keep_idx, keep_idx, drop = FALSE]
   }
 
   f <- insight::find_formula(x, verbose = FALSE)
@@ -535,7 +552,7 @@
     return(NULL)
   }
 
   R <- stats::cov2cor(v)
   detR <- det(R)
 
   result <- vector("numeric")