diff --git a/R/check_collinearity.R b/R/check_collinearity.R index 86a28334a..c3a449084 100644 --- a/R/check_collinearity.R +++ b/R/check_collinearity.R @@ -481,6 +481,49 @@ check_collinearity.zerocount <- function( return(NULL) } + # Filter to true slope parameters (handles multiple intercepts in ordinal models) + if (inherits(x, c("clm", "clmm"))) { + # names(x$beta) returns only non-singular (surviving) slopes + slope_names <- names(x$beta) + keep_idx <- which(colnames(v) %in% slope_names) + + # Rebuild term_assign by matching model matrix columns to surviving slopes + tryCatch( + { + mm <- insight::get_modelmatrix(x) + assign_attr <- attr(mm, "assign") + if (!is.null(assign_attr)) { + # Use name-matching to isolate indices for estimated slopes + match_idx <- which(colnames(mm) %in% slope_names) + if (length(match_idx) > 0) { + term_assign <- assign_attr[match_idx] + } + } + }, + error = function(e) NULL + ) + } 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 (term_assign is already synced for ordinal models) + if (length(keep_idx) < ncol(v)) { + if ( + !inherits(x, c("clm", "clmm")) && + !is.null(term_assign) && + length(term_assign) == ncol(v) + ) { + term_assign <- term_assign[keep_idx] + } + v <- v[keep_idx, keep_idx, drop = FALSE] + } + # we have rank-deficiency here. remove NA columns from assignment if (isTRUE(attributes(v)$rank_deficient) && !is.null(attributes(v)$na_columns_index)) { term_assign <- term_assign[-attributes(v)$na_columns_index] @@ -491,14 +534,6 @@ check_collinearity.zerocount <- function( } } - # 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.") - } - f <- insight::find_formula(x, verbose = FALSE) # hurdle or zeroinfl model can have no zero-inflation formula, in which case