.model_class_id <- function(model) {
  if (inherits(model, "glmerMod")) return("glmerMod")
  if (inherits(model, "lmerMod")) return("lmerMod")
  if (inherits(model, "glmmTMB")) return("glmmTMB")
  if (inherits(model, "coxph")) return("coxph")
  if (inherits(model, "survreg")) return("survreg")
  if (inherits(model, "glm")) return("glm")
  if (inherits(model, "aov")) return("aov")
  if (inherits(model, "lm")) return("lm")
  class(model)[[1L]]
}

.fixed_coef <- function(model) {
  id <- .model_class_id(model)
  if (id %in% c("lmerMod", "glmerMod")) return(lme4::fixef(model))
  if (id == "glmmTMB") return(glmmTMB::fixef(model)$cond)
  stats::coef(model)
}

.fixed_vcov <- function(model) {
  id <- .model_class_id(model)
  if (id == "glmmTMB") return(as.matrix(stats::vcov(model)$cond))
  as.matrix(stats::vcov(model))
}

.model_frame_safe <- function(model) {
  out <- tryCatch(stats::model.frame(model), error = function(e) NULL)
  if (!is.null(out)) return(out)
  if (inherits(model, "glmmTMB")) {
    out <- tryCatch(model$frame, error = function(e) NULL)
  }
  out
}

.model_matrix_fixed <- function(model) {
  id <- .model_class_id(model)
  if (id == "glmmTMB") return(stats::model.matrix(model, component = "cond"))
  stats::model.matrix(model)
}

.model_nobs <- function(model) {
  as.integer(stats::nobs(model))
}

.model_loglik <- function(model) {
  tryCatch(as.numeric(stats::logLik(model)), error = function(e) NA_real_)
}

.model_fixed_prediction <- function(model) {
  id <- .model_class_id(model)
  if (id == "lmerMod") return(as.numeric(stats::predict(model, re.form = NA)))
  if (id == "glmerMod") return(as.numeric(stats::predict(model, re.form = NA, type = "link")))
  if (id == "glmmTMB") return(as.numeric(stats::predict(model, re.form = NA, type = "link")))
  if (id == "coxph") return(as.numeric(stats::predict(model, type = "lp")))
  if (id == "survreg") return(as.numeric(stats::predict(model, type = "lp")))
  if (id == "glm") return(as.numeric(stats::predict(model, type = "link")))
  as.numeric(stats::predict(model))
}

.model_response_prediction <- function(model) {
  id <- .model_class_id(model)
  if (id == "glmerMod") return(as.numeric(stats::predict(model, type = "response", re.form = NULL)))
  if (id == "glmmTMB") return(as.numeric(stats::predict(model, type = "response", re.form = NULL)))
  if (id == "glm") return(as.numeric(stats::predict(model, type = "response")))
  as.numeric(stats::fitted(model))
}

.model_residuals <- function(model) {
  tryCatch(as.numeric(stats::residuals(model)), error = function(e) numeric())
}

.model_sigma <- function(model) {
  id <- .model_class_id(model)
  if (id == "lmerMod") return(stats::sigma(model))
  if (id == "glmmTMB") return(stats::sigma(model))
  if (id %in% c("lm", "aov")) return(sqrt(sum(stats::residuals(model)^2) / stats::df.residual(model)))
  NA_real_
}

.model_p_values <- function(model) {
  id <- .model_class_id(model)
  sm <- summary(model)
  tab <- sm$coefficients
  if (id == "glmmTMB") tab <- sm$coefficients$cond
  if (is.null(tab) || is.null(dim(tab))) {
    return(setNames(rep(NA_real_, length(.fixed_coef(model))), names(.fixed_coef(model))))
  }
  pcol <- grep("Pr\\(", colnames(tab), value = TRUE)
  if (!length(pcol)) {
    z <- tab[, min(3L, ncol(tab))]
    return(setNames(2 * stats::pnorm(abs(z), lower.tail = FALSE), rownames(tab)))
  }
  setNames(tab[, pcol[[1L]]], rownames(tab))
}

.random_group_vars <- function(formula) {
  if (!.has_random_terms(formula)) return(character())
  .require_namespace("reformulas", "mixed-model formula parsing")
  bars <- reformulas::findbars(formula)
  unique(unlist(lapply(bars, function(x) all.vars(x[[3L]]))))
}

.response_variables <- function(formula) {
  all.vars(formula[[2L]])
}

.analysis_variables <- function(formula) {
  unique(all.vars(formula))
}

.model_family_info <- function(model) {
  id <- .model_class_id(model)
  if (id == "glm") return(list(family = model$family$family, link = model$family$link, object = model$family))
  if (id == "glmerMod") {
    fam <- stats::family(model)
    return(list(family = fam$family, link = fam$link, object = fam))
  }
  if (id == "glmmTMB") {
    fam <- stats::family(model)
    return(list(family = fam$family, link = fam$link, object = fam))
  }
  if (id == "coxph") return(list(family = "cox", link = "log-hazard", object = NULL))
  if (id == "survreg") return(list(family = paste0("survreg_", model$dist), link = "location-scale", object = NULL))
  list(family = "gaussian", link = "identity", object = NULL)
}

.random_sd_vector <- function(model) {
  id <- .model_class_id(model)
  if (id %in% c("lmerMod", "glmerMod")) {
    vc <- as.data.frame(lme4::VarCorr(model))
    keep <- is.na(vc$var2) & vc$grp != "Residual"
    out <- vc$sdcor[keep]
    names(out) <- paste(vc$grp[keep], vc$var1[keep], sep = ":")
    return(out)
  }
  numeric()
}

.is_gaussian_identity <- function(info) {
  info$family == "gaussian" && info$link == "identity"
}
