#376

R/check_model.R

@@ -218,7 +218,7 @@ check_model.model_fit <- function(x,
 
 
 
-# helper ------------------------
+# compile plots for checks of linear models  ------------------------
 
 .check_assumptions_linear <- function(model, model_info) {
   dat <- list()
@@ -245,6 +245,8 @@ check_model.model_fit <- function(x,
 
 
 
+# compile plots for checks of generalized linear models  ------------------------
+
 .check_assumptions_glm <- function(model, model_info) {
   dat <- list()
 
@@ -263,6 +265,9 @@ check_model.model_fit <- function(x,
   if (isTRUE(model_info$is_binomial)) {
     dat$BINNED_RESID <- binned_residuals(model)
   }
+  if (isTRUE(model_info$is_count)) {
+    dat$OVERDISPERION <- .diag_overdispersion(model)
+  }
 
   dat <- datawizard::compact_list(dat)
   class(dat) <- c("check_model", "see_check_model")
@@ -271,6 +276,8 @@ check_model.model_fit <- function(x,
 
 
 
+# compile plots for checks of Bayesian models  ------------------------
+
 .check_assumptions_stan <- function(model) {
   if (inherits(model, "brmsfit")) {
 

R/check_model_diagnostics.R

@@ -1,3 +1,5 @@
+# prepare data for VIF plot ----------------------------------
+
 .diag_vif <- function(model) {
   dat <- datawizard::compact_list(check_collinearity(model))
   if (is.null(dat)) {
@@ -17,6 +19,9 @@
 }
 
 
+
+# prepare data for QQ plot ----------------------------------
+
 .diag_qq <- function(model) {
   if (inherits(model, c("lme", "lmerMod", "merMod", "glmmTMB", "gam"))) {
     res_ <- sort(stats::residuals(model), na.last = NA)
@@ -54,6 +59,8 @@
 
 
 
+# prepare data for random effects QQ plot ----------------------------------
+
 .diag_reqq <- function(model, level = .95, model_info) {
   # check if we have mixed model
   if (!model_info$is_mixed) {
@@ -117,6 +124,7 @@
 
 
 
+# prepare data for normality of residuals plot ----------------------------------
 
 .diag_norm <- function(model) {
   r <- try(stats::residuals(model), silent = TRUE)
@@ -133,6 +141,8 @@
 
 
 
+# prepare data for influential obs plot ----------------------------------
+
 .diag_influential_obs <- function(model, threshold = NULL) {
   s <- summary(model)
 
@@ -184,6 +194,7 @@
 
 
 
+# prepare data for non-constant variance plot ----------------------------------
 
 .diag_ncv <- function(model) {
   ncv <- tryCatch(
@@ -207,6 +218,9 @@
 }
 
 
+
+# prepare data for homogeneity of variance plot ----------------------------------
+
 .diag_homogeneity <- function(model) {
   faminfo <- insight::model_info(model)
   r <- tryCatch(
@@ -246,6 +260,48 @@
 
 
 
+# prepare data for homogeneity of variance plot ----------------------------------
+
+.diag_overdispersion <- function(model) {
+  faminfo <- insight::model_info(model)
+
+  # data for poisson models
+  if (faminfo$is_poisson && !faminfo$is_zero_inflated) {
+    d <- as.data.frame(insight::get_predicted(model, predict = "expectation", ci = NA))
+    d$Residuals <- insight::get_response(model) - as.vector(d$Predicted)
+    d$Res2 <- d$Residuals^2
+    d$V <- d$Predicted
+  }
+
+  # data for negative binomial models
+  if (faminfo$is_negbin && !faminfo$is_zero_inflated) {
+    d <- as.data.frame(insight::get_predicted(model, predict = "expectation", ci = NA))
+    d$Residuals <- insight::get_response(model) - as.vector(d$Predicted)
+    d$Res2 <- d$Residuals^2
+    d$V <- d$Predicted * (1 + d$Predicted / insight::get_sigma(model))
+  }
+
+  # data for zero-inflated poisson models
+  if (faminfo$is_poisson && faminfo$is_zero_inflated) {
+    d <- as.data.frame(insight::get_predicted(model, predict = "expectation", ci = NA))
+    d$Residuals <- insight::get_response(model) - as.vector(d$Predicted)
+    d$Res2 <- d$Residuals^2
+    if (inherits(model, "glmmTMB")) {
+      ptype <- "zprob"
+    } else {
+      ptype <- "zero"
+    }
+    d$Prob <- stats::predict(model, type = ptype)
+    d$V <- d$Predicted * (1 - d$Prob) * (1 + d$Predicted * d$Prob)
+  }
+
+  d
+}
+
+
+
+# helpers ----------------------------------
+
 .sigma_glmmTMB_nonmixed <- function(model, faminfo) {
   if (!is.na(match(faminfo$family, c("binomial", "poisson", "truncated_poisson")))) {
     return(1)