Update model

Author: strengejacke

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: performance
 Title: Assessment of Regression Models Performance
-Version: 0.11.0.7
+Version: 0.11.0.8
 Authors@R: 
     c(person(given = "Daniel",
              family = "Lüdecke",

NEWS.md

@@ -15,6 +15,9 @@
   the usual style as for other models and no longer returns plots from
   `bayesplot::pp_check()`.
 
+* Updated the trained model that is used to prediction distributions in
+  `check_distribution()`.
+
 ## Bug fixes
 
 * `check_model()` now falls back on normal Q-Q plots when a model is not supported

R/check_distribution.R

@@ -192,23 +192,40 @@ check_distribution.numeric <- function(model) {
   # validation check, remove missings
   x <- x[!is.na(x)]
 
-  # this might fail, so we wrap in ".safe()"
-  map_est <- .safe(mean(x) - as.numeric(bayestestR::map_estimate(x, bw = "nrd0")))
+  mode <- NULL
+  # find mode for integer, or MAP for distributions
+  if (all(.is_integer(x))) {
+    mode <- datawizard::distribution_mode(x)
+  } else {
+    # this might fail, so we wrap in ".safe()"
+    mode <- tryCatch(
+      as.numeric(bayestestR::map_estimate(x, bw = "nrd0")),
+      error = function(e) NULL
+    )
+    if (is.null(mode)) {
+      mode <- tryCatch(
+        as.numeric(bayestestR::map_estimate(x, bw = "kernel")),
+        error = function(e) NULL
+      )
+    }
+  }
 
-  if (is.null(map_est)) {
-    map_est <- mean(x) - datawizard::distribution_mode(x)
+  if (is.null(mode)) {
+    mean_mode_diff <- mean(x) - datawizard::distribution_mode(x)
     msg <- "Could not accurately estimate the mode."
     if (!is.null(type)) {
       msg <- paste(msg, "Predicted distribution of the", type, "may be less accurate.")
     }
     insight::format_alert(msg)
+  } else {
+    mean_mode_diff <- .safe(mean(x) - mode)
   }
 
   data.frame(
     SD = stats::sd(x),
     MAD = stats::mad(x, constant = 1),
     Mean_Median_Distance = mean(x) - stats::median(x),
-    Mean_Mode_Distance = map_est,
+    Mean_Mode_Distance = mean_mode_diff,
     SD_MAD_Distance = stats::sd(x) - stats::mad(x, constant = 1),
     Var_Mean_Distance = stats::var(x) - mean(x),
     Range_SD = diff(range(x)) / stats::sd(x),

R/sysdata.rda

@@ -134,18 +134,22 @@ for (di in seq_along(distrs)) {
     # x_scaled <- parameters::normalize(x, verbose = FALSE)
 
     if (length(x) >= 10) {
-      mode <- tryCatch(
-        bayestestR::map_estimate(x, bw = "nrd0"),
-        error = function(e) NULL
-      )
-      if (is.null(mode)) {
+      if (all(.is.integer(x))) {
+        mode <- datawizard::distribution_mode(x)
+      } else {
         mode <- tryCatch(
-          bayestestR::map_estimate(x, bw = "kernel"),
+          as.numeric(bayestestR::map_estimate(x, bw = "nrd0")),
           error = function(e) NULL
         )
-      }
-      if (is.null(mode)) {
-        mode <- datawizard::distribution_mode(x)
+        if (is.null(mode)) {
+          mode <- tryCatch(
+            as.numeric(bayestestR::map_estimate(x, bw = "kernel")),
+            error = function(e) NULL
+          )
+        }
+        if (is.null(mode)) {
+          mode <- datawizard::distribution_mode(x)
+        }
       }
       # Extract features
       data <- data.frame(

WIP/generate_distribution.R

@@ -7,15 +7,14 @@
       
       Predicted Distribution of Residuals
       
-       Distribution Probability
-             cauchy         94%
-              gamma          3%
-          lognormal          3%
+                     Distribution Probability
+                           cauchy         91%
+                            gamma          6%
+       neg. binomial (zero-infl.)          3%
       
       Predicted Distribution of Response
       
        Distribution Probability
-          lognormal         53%
-              gamma         44%
-        exponential          3%
+          lognormal         66%
+              gamma         34%
 

tests/testthat/_snaps/check_distribution.md

@@ -18,16 +18,16 @@ test_that("check_distribution", {
   expect_equal(
     out$p_Residuals,
     c(
-      0, 0, 0, 0, 0.9375, 0, 0, 0, 0.03125, 0, 0, 0.03125, 0, 0,
+      0, 0, 0, 0, 0.90625, 0, 0, 0, 0.0625, 0, 0, 0.03125, 0, 0,
       0, 0, 0, 0, 0, 0, 0
     ),
     tolerance = 1e-4
   )
   expect_equal(
     out$p_Response,
     c(
-      0, 0, 0, 0, 0, 0, 0.03125, 0, 0.4375, 0, 0, 0.53125, 0, 0,
-      0, 0, 0, 0, 0, 0, 0
+      0, 0, 0, 0, 0, 0, 0, 0, 0.34375, 0, 0, 0.65625, 0, 0, 0, 0,
+      0, 0, 0, 0, 0
     ),
     tolerance = 1e-4
   )