Trying to use more than 1 random effects (nested) variables as well as predict function later

[erdelab-vikasm]

Hello Rune,

I am using the clmm function which allows for more than one random effects (nested) variables to be included. However, then I also want to use the predict function to predict probabilities - is this functionality not available with clmm? Is there a way around?

Thanks,

[bryorsnef]

I'll second this, a predict function for clmm models would be very useful.

[HannahD412]

Bumping this thread - predict() and predict.clm() do not work when using clmm and this has not been addressed.

[runehaubo]

Noted. A predict method for clmm object is on the to-do list but it has been there for quite some years and I still haven't found the time to implement...

[filthysocks]

well the last response is a year old but are there any plans to add it?

[MichaelSchatz]

+1 for this

[mattansb]

Came here looking for answers on this. I've since implemented my own (probably wrong?) predict.clmm() that seems to work (at least for my needs). Feel free to use at your own risk.

For re.form = NA, results have been confirmed against {emmeans}.

predict.clmm <- function(object, newdata, re.form = NULL, type = c("lin", "prob")) {
  type <- match.arg(type)

  Terms <- delete.response(terms(object))
  m <- model.frame(Terms, newdata, xlev = object$xlevels)
  X <- model.matrix(Terms, m, contrasts.arg = object$contrasts)

  n <- nrow(X)

  b <- c("(Intercept)" = 0, coef(object))
  fixed_names <- intersect(names(b), colnames(X))
  brep <- matrix(rep(b[fixed_names], times = n), nrow = n, byrow = TRUE, 
                 dimnames = list(rownames(X), fixed_names))

  if (is.null(re.form)) {
    rgv <- insight::find_random(object, flatten = TRUE)

    u <- ranef(object)
    for (v in rgv) {
      rg_u <- u[[v]][as.character(newdata[,v,drop = TRUE]),]
      r_slopes <- intersect(colnames(rg_u), colnames(brep))
      for (i in r_slopes) {
        brep[,i] <- brep[,i] + rg_u[,i]  
      }
    }
  }

  lin_pred <- rowSums(brep * X)

  if (type == "lin") {
    return(lin_pred)
  }

  thres <- setdiff(names(b), colnames(X))
  preds <- outer(b[thres], lin_pred, FUN = "-")

  fm1 <- insight::link_inverse(object)
  cumprobs <- rbind(0, fm1(preds), 1)
  probs <- t(apply(cumprobs, 2, diff))
  colnames(probs) <- levels(insight::get_response(object))

  probs
}