Merge branch 'main' into check_smooth

.github/workflows/html-5-check.yaml

@@ -6,8 +6,8 @@ on:
   pull_request:
     branches: [main, master]
 
-name: HTML5 check
+name: html-5-check
 
 jobs:
-  HTML5-check:
+  html-5-check:
     uses: easystats/workflows/.github/workflows/html-5-check.yaml@main

.github/workflows/update-to-latest-easystats.yaml

@@ -0,0 +1,10 @@
+on:
+  schedule:
+    # Check for dependency updates once a month
+    - cron: "0 0 1 * *"
+
+name: update-to-latest-easystats
+
+jobs:
+  update-to-latest-easystats:
+    uses: easystats/workflows/.github/workflows/update-to-latest-easystats.yaml@main

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: performance
 Title: Assessment of Regression Models Performance
-Version: 0.10.5.2
+Version: 0.10.5.6
 Authors@R: 
     c(person(given = "Daniel",
              family = "Lüdecke",
@@ -69,9 +69,9 @@ BugReports: https://github.com/easystats/performance/issues
 Depends:
     R (>= 3.6)
 Imports:
-    bayestestR (>= 0.13.0),
-    insight (>= 0.19.4),
-    datawizard (>= 0.7.0),
+    bayestestR (>= 0.13.1),
+    insight (>= 0.19.5),
+    datawizard (>= 0.9.0),
     methods,
     stats,
     utils
@@ -117,6 +117,7 @@ Suggests:
     mgcv,
     mlogit,
     multimode,
+    nestedLogit,
     nlme,
     nonnest2,
     ordinal,
@@ -149,4 +150,4 @@ Config/Needs/website:
     r-lib/pkgdown,
     easystats/easystatstemplate
 Config/rcmdcheck/ignore-inconsequential-notes: true
-Remotes: easystats/see, easystats/parameters
+Remotes: easystats/see, easystats/parameters, easystats/insight

NAMESPACE

@@ -180,6 +180,7 @@ S3method(model_performance,model_fit)
 S3method(model_performance,multinom)
 S3method(model_performance,negbinirr)
 S3method(model_performance,negbinmfx)
+S3method(model_performance,nestedLogit)
 S3method(model_performance,plm)
 S3method(model_performance,poissonirr)
 S3method(model_performance,poissonmfx)
@@ -371,6 +372,7 @@ S3method(r2,model_fit)
 S3method(r2,multinom)
 S3method(r2,negbinirr)
 S3method(r2,negbinmfx)
+S3method(r2,nestedLogit)
 S3method(r2,ols)
 S3method(r2,phylolm)
 S3method(r2,plm)
@@ -413,6 +415,7 @@ S3method(r2_coxsnell,mclogit)
 S3method(r2_coxsnell,multinom)
 S3method(r2_coxsnell,negbinirr)
 S3method(r2_coxsnell,negbinmfx)
+S3method(r2_coxsnell,nestedLogit)
 S3method(r2_coxsnell,poissonirr)
 S3method(r2_coxsnell,poissonmfx)
 S3method(r2_coxsnell,polr)
@@ -468,6 +471,7 @@ S3method(r2_nagelkerke,mclogit)
 S3method(r2_nagelkerke,multinom)
 S3method(r2_nagelkerke,negbinirr)
 S3method(r2_nagelkerke,negbinmfx)
+S3method(r2_nagelkerke,nestedLogit)
 S3method(r2_nagelkerke,poissonirr)
 S3method(r2_nagelkerke,poissonmfx)
 S3method(r2_nagelkerke,polr)
@@ -479,6 +483,8 @@ S3method(r2_posterior,BFBayesFactor)
 S3method(r2_posterior,brmsfit)
 S3method(r2_posterior,stanmvreg)
 S3method(r2_posterior,stanreg)
+S3method(r2_tjur,default)
+S3method(r2_tjur,nestedLogit)
 S3method(residuals,BFBayesFactor)
 S3method(residuals,check_normality_numeric)
 S3method(residuals,iv_robust)

NEWS.md

@@ -1,5 +1,21 @@
 # performance (development version)
 
+## General
+
+* Support for `nestedLogit` models.
+
+## Changes to functions
+
+* `check_outliers()` for method `"ics"` now detects number of available cores
+  for parallel computing via the `"mc.cores"` option. This is more robust than
+  the previous method, which used `parallel::detectCores()`. Now you should
+  set the number of cores via `options(mc.cores = 4)`.
+
+## Bug fixes
+
+* Fixed issues is `check_model()` for models that used data sets with
+  variables of class `"haven_labelled"`.
+
 # performance 0.10.5
 
 ## Changes to functions

R/check_itemscale.R

@@ -40,8 +40,6 @@
 #' - Briggs SR, Cheek JM (1986) The role of factor analysis in the development
 #'   and evaluation of personality scales. Journal of Personality, 54(1),
 #'   106-148. doi: 10.1111/j.1467-6494.1986.tb00391.x
-#' - Trochim WMK (2008) Types of Reliability.
-#'   ([web](https://conjointly.com/kb/types-of-reliability/))
 #'
 #' @examplesIf require("parameters") && require("psych")
 #' # data generation from '?prcomp', slightly modified
@@ -82,9 +80,9 @@ check_itemscale <- function(x) {
       Mean = vapply(items, mean, numeric(1), na.rm = TRUE),
       SD = vapply(items, stats::sd, numeric(1), na.rm = TRUE),
       Skewness = vapply(items, function(i) as.numeric(datawizard::skewness(i)), numeric(1)),
-      "Difficulty" = item_difficulty(items)$Difficulty,
-      "Discrimination" = .item_discr,
-      "alpha if deleted" = .item_alpha,
+      Difficulty = item_difficulty(items)$Difficulty,
+      Discrimination = .item_discr,
+      `alpha if deleted` = .item_alpha,
       stringsAsFactors = FALSE,
       check.names = FALSE
     )

R/check_model_diagnostics.R

@@ -153,7 +153,7 @@
 # prepare data for normality of residuals plot ----------------------------------
 
 .diag_norm <- function(model, verbose = TRUE) {
-  r <- try(stats::residuals(model), silent = TRUE)
+  r <- try(as.numeric(stats::residuals(model)), silent = TRUE)
 
   if (inherits(r, "try-error")) {
     insight::format_alert(sprintf("Non-normality of residuals could not be computed. Cannot extract residuals from objects of class '%s'.", class(model)[1]))
@@ -174,16 +174,16 @@
 
   if (inherits(model, "lm", which = TRUE) == 1) {
     cook_levels <- round(stats::qf(0.5, s$fstatistic[2], s$fstatistic[3]), 2)
-  } else if (!is.null(threshold)) {
-    cook_levels <- threshold
-  } else {
+  } else if (is.null(threshold)) {
     cook_levels <- c(0.5, 1)
+  } else {
+    cook_levels <- threshold
   }
 
   n_params <- tryCatch(model$rank, error = function(e) insight::n_parameters(model))
 
   infl <- stats::influence(model, do.coef = FALSE)
-  resid <- insight::get_residuals(model)
+  resid <- as.numeric(insight::get_residuals(model))
 
   std_resid <- tryCatch(stats::rstandard(model, infl), error = function(e) resid)
 
@@ -212,8 +212,8 @@
   ncv <- tryCatch(
     {
       data.frame(
-        x = stats::fitted(model),
-        y = stats::residuals(model)
+        x = as.numeric(stats::fitted(model)),
+        y = as.numeric(stats::residuals(model))
       )
     },
     error = function(e) {

R/check_outliers.R

@@ -167,7 +167,9 @@
 #'  value for outliers classification. Refer to the help-file of
 #'  [ICSOutlier::ics.outlier()] to get more details about this procedure.
 #'  Note that `method = "ics"` requires both **ICS** and **ICSOutlier**
-#'  to be installed, and that it takes some time to compute the results.
+#'  to be installed, and that it takes some time to compute the results. You
+#'  can speed up computation time using parallel computing. Set the number of
+#'  cores to use with `options(mc.cores = 4)` (for example).
 #'
 #'  - **OPTICS**:
 #'  The Ordering Points To Identify the Clustering Structure (OPTICS) algorithm
@@ -299,6 +301,7 @@
 #' group_iris <- datawizard::data_group(iris, "Species")
 #' check_outliers(group_iris)
 #'
+#' @examplesIf require("see") && require("bigutilsr") && require("loo") && require("MASS") && require("ICSOutlier") && require("ICS") && require("dbscan")
 #' \donttest{
 #' # You can also run all the methods
 #' check_outliers(data, method = "all")
@@ -315,10 +318,7 @@
 #' model <- lm(disp ~ mpg + hp, data = mt2)
 #'
 #' outliers_list <- check_outliers(model)
-#'
-#' if (require("see")) {
-#'   plot(outliers_list)
-#' }
+#' plot(outliers_list)
 #'
 #' insight::get_data(model)[outliers_list, ] # Show outliers data
 #' }
@@ -506,7 +506,7 @@ check_outliers.default <- function(x,
 
   num.df <- outlier_count$all[!names(outlier_count$all) %in% c("Row", ID)]
   if (isTRUE(nrow(num.df) > 0)) {
-    num.df <- datawizard::change_code(
+    num.df <- datawizard::recode_values(
       num.df,
       recode = list(`2` = "(Multivariate)")
     )
@@ -1764,7 +1764,20 @@ check_outliers.metabin <- check_outliers.metagen
   n_cores <- if (!requireNamespace("parallel", quietly = TRUE)) {
     NULL
   } else {
-    max(1L, parallel::detectCores() - 2L, na.rm = TRUE)
+    getOption("mc.cores", 1L)
+  }
+
+  # tell user about n-cores option
+  if (is.null(n_cores)) {
+    insight::format_alert(
+      "Package `parallel` is not installed. `check_outliers()` will run on a single core.",
+      "Install package `parallel` and set, for example, `options(mc.cores = 4)` to run on multiple cores."
+    )
+  } else if (n_cores == 1) {
+    insight::format_alert(
+      "Package `parallel` is installed, but `check_outliers()` will run on a single core.",
+      "To use multiple cores, set `options(mc.cores = 4)` (for example)."
+    )
   }
 
   # Run algorithm

R/logLik.R

@@ -55,7 +55,7 @@ logLik.plm <- function(object, ...) {
 
   attr(val, "nall") <- N0
   attr(val, "nobs") <- N
-  attr(val, "df") <- insight::get_df(object, type = "model")
+  attr(val, "df") <- insight::n_parameters(object) + 1L
   class(val) <- "logLik"
 
   val

R/model_performance.lm.R

@@ -125,10 +125,10 @@ model_performance.lm <- function(model, metrics = "all", verbose = TRUE, ...) {
   if (("LOGLOSS" %in% toupper(metrics)) && isTRUE(info$is_binomial)) {
     out$Log_loss <- .safe({
       .logloss <- performance_logloss(model, verbose = verbose)
-      if (!is.na(.logloss)) {
-        .logloss
-      } else {
+      if (is.na(.logloss)) {
         NULL
+      } else {
+        .logloss
       }
     })
   }
@@ -253,6 +253,22 @@ model_performance.zeroinfl <- model_performance.lm
 #' @export
 model_performance.zerotrunc <- model_performance.lm
 
+#' @export
+model_performance.nestedLogit <- function(model, metrics = "all", verbose = TRUE, ...) {
+  mp <- lapply(model$models, model_performance.lm, metrics = metrics, verbose = verbose, ...)
+  out <- cbind(
+    data.frame(Response = names(mp), stringsAsFactors = FALSE),
+    do.call(rbind, mp)
+  )
+  # need to handle R2 separately
+  if (any(c("ALL", "R2") %in% toupper(metrics))) {
+    out$R2 <- unlist(r2_tjur(model))
+  }
+
+  row.names(out) <- NULL
+  class(out) <- unique(c("performance_model", class(out)))
+  out
+}