Merge branch 'main' into macdonalds_omega

CRAN-SUBMISSION

@@ -1,3 +1,3 @@
-Version: 0.10.8
-Date: 2023-10-29 16:13:36 UTC
-SHA: c94741704caad7b8cde589e941af5d2f2826e6c2
+Version: 0.10.9
+Date: 2024-02-17 07:56:08 UTC
+SHA: 051016febd197937ad083266b630c871fa9e1623

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: performance
 Title: Assessment of Regression Models Performance
-Version: 0.10.8.10
+Version: 0.10.9
 Authors@R: 
     c(person(given = "Daniel",
              family = "Lüdecke",
@@ -69,7 +69,7 @@ BugReports: https://github.com/easystats/performance/issues
 Depends:
     R (>= 3.6)
 Imports:
-    bayestestR (>= 0.13.1),
+    bayestestR (>= 0.13.2),
     insight (>= 0.19.8),
     datawizard (>= 0.9.1),
     methods,
@@ -124,18 +124,19 @@ Suggests:
     nonnest2,
     ordinal,
     parallel,
-    parameters (>= 0.20.3),
+    parameters (>= 0.21.4),
     patchwork,
     pscl,
     psych,
+    quantreg,
     qqplotr (>= 0.0.6),
     randomForest,
     rempsyc,
     rmarkdown,
     rstanarm,
     rstantools,
     sandwich,
-    see (>= 0.8.1),
+    see (>= 0.8.2),
     survey,
     survival,
     testthat (>= 3.2.1),
@@ -144,7 +145,7 @@ Suggests:
     withr (>= 3.0.0)
 Encoding: UTF-8
 Language: en-US
-RoxygenNote: 7.2.3.9000
+RoxygenNote: 7.3.1
 Roxygen: list(markdown = TRUE)
 Config/testthat/edition: 3
 Config/testthat/parallel: true
@@ -153,4 +154,3 @@ Config/Needs/website:
     r-lib/pkgdown,
     easystats/easystatstemplate
 Config/rcmdcheck/ignore-inconsequential-notes: true
-Remotes: easystats/insight

NAMESPACE

@@ -89,6 +89,9 @@ S3method(check_outliers,metagen)
 S3method(check_outliers,numeric)
 S3method(check_outliers,rma)
 S3method(check_outliers,rma.uni)
+S3method(check_outliers,rq)
+S3method(check_outliers,rqs)
+S3method(check_outliers,rqss)
 S3method(check_overdispersion,default)
 S3method(check_overdispersion,fixest)
 S3method(check_overdispersion,fixest_multi)
@@ -430,6 +433,8 @@ S3method(r2_coxsnell,survreg)
 S3method(r2_coxsnell,svycoxph)
 S3method(r2_coxsnell,truncreg)
 S3method(r2_efron,default)
+S3method(r2_kullback,default)
+S3method(r2_kullback,glm)
 S3method(r2_loo_posterior,BFBayesFactor)
 S3method(r2_loo_posterior,brmsfit)
 S3method(r2_loo_posterior,stanmvreg)

NEWS.md

@@ -24,6 +24,21 @@
 * Clarification in the documentation of the `estimator` argument for
   `performance_aic()`.
 
+* Improved plots for overdispersion-checks for negative-binomial models from
+  package *glmmTMB* (affects `check_overdispersion()` and `check_mnodel()`).
+
+* Improved detection rates for singularity in `check_singularity()` for models
+  from package *glmmTMB*.
+
+* For model of class `glmmTMB`, deviance residuals are now used in the
+  `check_model()` plot.
+
+* Improved (better to understand) error messages for `check_model()`,
+  `check_collinearity()` and `check_outliers()` for models with non-numeric
+  response variables.
+
+* `r2_kullback()` now gives an informative error for non-supported models.
+
 ## Bug fixes
 
 * Fixed issue in `binned_residuals()` for models with binary outcome, where
@@ -32,6 +47,14 @@
 * `performance_score()` should no longer fail for models where scoring rules
   can't be calculated. Instead, an informative message is returned.
 
+* `check_outliers()` now properly accept the `percentage_central` argument when
+  using the `"mcd"` method.
+
+* Fixed edge cases in `check_collinearity()` and `check_outliers()` for models
+  with response variables of classes `Date`, `POSIXct`, `POSIXlt` or `difftime`.
+
+* Fixed issue with `check_model()` for models of package *quantreg*.
+
 # performance 0.10.8
 
 ## Changes

R/check_collinearity.R

@@ -405,6 +405,20 @@ check_collinearity.zerocount <- function(x,
 
 .check_collinearity <- function(x, component, ci = 0.95, verbose = TRUE) {
   v <- insight::get_varcov(x, component = component, verbose = FALSE)
+
+  # sanity check
+  if (is.null(v)) {
+    if (isTRUE(verbose)) {
+      insight::format_alert(
+        paste(
+          sprintf("Could not extract the variance-covariance matrix for the %s component of the model.", component),
+          "Please try to run `vcov(model)`, which may help identifying the problem."
+        )
+      )
+    }
+    return(NULL)
+  }
+
   term_assign <- .term_assignments(x, component, verbose = verbose)
 
   # any assignment found?
@@ -432,10 +446,8 @@ check_collinearity.zerocount <- function(x,
   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.")
-    }
+  } else if (isTRUE(verbose)) {
+    insight::format_alert("Model has no intercept. VIFs may not be sensible.")
   }
 
   f <- insight::find_formula(x)
@@ -475,6 +487,11 @@ check_collinearity.zerocount <- function(x,
   result <- vector("numeric")
   na_terms <- vector("numeric")
 
+  # sanity check - models with offset(?) may contain too many term assignments
+  if (length(term_assign) > ncol(v)) {
+    term_assign <- term_assign[seq_len(ncol(v))]
+  }
+
   for (term in 1:n.terms) {
     subs <- which(term_assign == term)
     if (length(subs)) {

R/check_heterogeneity_bias.R

@@ -31,9 +31,9 @@ check_heterogeneity_bias <- function(x, select = NULL, group = NULL) {
   if (insight::is_model(x)) {
     group <- insight::find_random(x, split_nested = TRUE, flatten = TRUE)
     if (is.null(group)) {
-      insight::format_error("Model is no mixed model. Please provide a mixed model, or a data frame and arguments `select` and `group`.")
+      insight::format_error("Model is no mixed model. Please provide a mixed model, or a data frame and arguments `select` and `group`.") # nolint
     }
-    data <- insight::get_data(x, source = "mf", verbose = FALSE)
+    my_data <- insight::get_data(x, source = "mf", verbose = FALSE)
     select <- insight::find_predictors(x, effects = "fixed", component = "conditional", flatten = TRUE)
   } else {
     if (inherits(select, "formula")) {
@@ -42,15 +42,15 @@ check_heterogeneity_bias <- function(x, select = NULL, group = NULL) {
     if (inherits(group, "formula")) {
       group <- all.vars(group)
     }
-    data <- x
+    my_data <- x
   }
 
-  unique_groups <- .n_unique(data[[group]])
+  unique_groups <- .n_unique(my_data[[group]])
   combinations <- expand.grid(select, group)
 
   result <- Map(function(predictor, id) {
     # demean predictor
-    d <- datawizard::demean(data, select = predictor, group = id, verbose = FALSE)
+    d <- datawizard::demean(my_data, select = predictor, group = id, verbose = FALSE)
 
     # get new names
     within_name <- paste0(predictor, "_within")

R/check_model.R

@@ -183,23 +183,27 @@ check_model.default <- function(x,
 
   minfo <- insight::model_info(x, verbose = FALSE)
 
-  ca <- tryCatch(
-    {
-      if (minfo$is_bayesian) {
-        suppressWarnings(.check_assumptions_stan(x, ...))
-      } else if (minfo$is_linear) {
-        suppressWarnings(.check_assumptions_linear(x, minfo, verbose, ...))
-      } else {
-        suppressWarnings(.check_assumptions_glm(x, minfo, verbose, ...))
-      }
+  assumptions_data <- tryCatch(
+    if (minfo$is_bayesian) {
+      suppressWarnings(.check_assumptions_stan(x, ...))
+    } else if (minfo$is_linear) {
+      suppressWarnings(.check_assumptions_linear(x, minfo, verbose, ...))
+    } else {
+      suppressWarnings(.check_assumptions_glm(x, minfo, verbose, ...))
     },
     error = function(e) {
-      NULL
+      e
     }
   )
 
-  if (is.null(ca)) {
-    insight::format_error(paste0("`check_model()` not implemented for models of class `", class(x)[1], "` yet."))
+  if (inherits(assumptions_data, c("error", "simpleError"))) {
+    pattern <- "(\n|\\s{2,})"
+    replacement <- " "
+    cleaned_string <- gsub(pattern, replacement, assumptions_data$message)
+    insight::format_error(
+      paste("`check_model()` returned following error:", cleaned_string),
+      paste0("\nIf the error message does not help identifying your problem, another reason why `check_model()` failed might be that models of class `", class(x)[1], "` are not yet supported.") # nolint
+    )
   }
 
   # try to find sensible default for "type" argument
@@ -214,21 +218,22 @@ check_model.default <- function(x,
     show_dots <- is.null(n) || n <= 1e5
   }
 
-  attr(ca, "panel") <- panel
-  attr(ca, "dot_size") <- dot_size
-  attr(ca, "line_size") <- line_size
-  attr(ca, "check") <- check
-  attr(ca, "alpha") <- alpha
-  attr(ca, "dot_alpha") <- dot_alpha
-  attr(ca, "show_dots") <- isTRUE(show_dots)
-  attr(ca, "detrend") <- detrend
-  attr(ca, "colors") <- colors
-  attr(ca, "theme") <- theme
-  attr(ca, "model_info") <- minfo
-  attr(ca, "overdisp_type") <- list(...)$plot_type
-  attr(ca, "bandwidth") <- bandwidth
-  attr(ca, "type") <- type
-  ca
+  attr(assumptions_data, "panel") <- panel
+  attr(assumptions_data, "dot_size") <- dot_size
+  attr(assumptions_data, "line_size") <- line_size
+  attr(assumptions_data, "check") <- check
+  attr(assumptions_data, "alpha") <- alpha
+  attr(assumptions_data, "dot_alpha") <- dot_alpha
+  attr(assumptions_data, "show_dots") <- isTRUE(show_dots)
+  attr(assumptions_data, "detrend") <- detrend
+  attr(assumptions_data, "colors") <- colors
+  attr(assumptions_data, "theme") <- theme
+  attr(assumptions_data, "model_info") <- minfo
+  attr(assumptions_data, "overdisp_type") <- list(...)$plot_type
+  attr(assumptions_data, "bandwidth") <- bandwidth
+  attr(assumptions_data, "type") <- type
+  attr(assumptions_data, "model_class") <- class(x)[1]
+  assumptions_data
 }
 
 
@@ -263,7 +268,7 @@ check_model.stanreg <- function(x,
                                 dot_alpha = 0.8,
                                 colors = c("#3aaf85", "#1b6ca8", "#cd201f"),
                                 theme = "see::theme_lucid",
-                                detrend = FALSE,
+                                detrend = TRUE,
                                 show_dots = NULL,
                                 bandwidth = "nrd",
                                 type = "density",
@@ -302,7 +307,7 @@ check_model.model_fit <- function(x,
                                   dot_alpha = 0.8,
                                   colors = c("#3aaf85", "#1b6ca8", "#cd201f"),
                                   theme = "see::theme_lucid",
-                                  detrend = FALSE,
+                                  detrend = TRUE,
                                   show_dots = NULL,
                                   bandwidth = "nrd",
                                   type = "density",
@@ -335,7 +340,7 @@ check_model.model_fit <- function(x,
   dat <- list()
 
   dat$VIF <- .diag_vif(model, verbose = verbose)
-  dat$QQ <- .diag_qq(model, verbose = verbose)
+  dat$QQ <- .diag_qq(model, model_info = model_info, verbose = verbose)
   dat$REQQ <- .diag_reqq(model, level = 0.95, model_info = model_info, verbose = verbose)
   dat$NORM <- .diag_norm(model, verbose = verbose)
   dat$NCV <- .diag_ncv(model, verbose = verbose)
@@ -362,7 +367,7 @@ check_model.model_fit <- function(x,
   dat <- list()
 
   dat$VIF <- .diag_vif(model, verbose = verbose)
-  dat$QQ <- .diag_qq(model, verbose = verbose)
+  dat$QQ <- .diag_qq(model, model_info = model_info, verbose = verbose)
   dat$HOMOGENEITY <- .diag_homogeneity(model, verbose = verbose)
   dat$REQQ <- .diag_reqq(model, level = 0.95, model_info = model_info, verbose = verbose)
   dat$OUTLIERS <- check_outliers(model, method = "cook")