Prepare CRAN release (#573)

Co-authored-by: Indrajeet Patil <patilindrajeet.science@gmail.com>

CRAN-SUBMISSION

@@ -1,3 +1,3 @@
-Version: 0.10.2
-Date: 2023-01-11 16:37:43 UTC
-SHA: 6d11ca782c1b971ca0d3fa0ae7298f18193e8dd7
+Version: 0.10.3
+Date: 2023-04-06 14:07:07 UTC
+SHA: 3198a3d95e27c0bc6470733dacf0496be7f96f43

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: performance
 Title: Assessment of Regression Models Performance
-Version: 0.10.2.10
+Version: 0.10.3
 Authors@R: 
     c(person(given = "Daniel",
              family = "Lüdecke",
@@ -120,7 +120,7 @@ Suggests:
     nonnest2,
     ordinal,
     parallel,
-    parameters,
+    parameters (>= 0.20.3),
     patchwork,
     pscl,
     psych,
@@ -147,4 +147,3 @@ Config/Needs/website:
     r-lib/pkgdown,
     easystats/easystatstemplate
 Config/rcmdcheck/ignore-inconsequential-notes: true
-Remotes: easystats/parameters

NEWS.md

@@ -17,6 +17,9 @@
 
 ## Changes to functions
 
+* `test_*()` functions now automatically fit a null-model when only one model
+  objects was provided for testing multiple models.
+
 * Warnings in `model_performance()` for unsupported objects of class
   `BFBayesFactor` can now be suppressed with `verbose = FALSE`.
 

R/check_itemscale.R

@@ -65,13 +65,6 @@ check_itemscale <- function(x) {
   insight::check_if_installed("parameters")
 
   dataset <- attributes(x)$dataset
-
-  ## TODO: remove once parameters 0.18.3 or higher on CRAN
-  # backward compatibility to parameters 0.18.2
-  if (is.null(dataset)) {
-    dataset <- attributes(x)$data_set
-  }
-
   subscales <- parameters::closest_component(x)
 
   out <- lapply(sort(unique(subscales)), function(.subscale) {

R/check_model.R

@@ -99,8 +99,9 @@
 #' some deviation (mostly at the tails), this indicates that the model doesn't
 #' predict the outcome well for that range that shows larger deviations from
 #' the line. For generalized linear models, a half-normal Q-Q plot of the
-#' absolute value of the standardized deviance residuals is shown. See
-#' [`check_normality()`] for further details.
+#' absolute value of the standardized deviance residuals is shown, however, the
+#' interpretation of the plot remains the same. See [`check_normality()`] for
+#' further details.
 #'
 #' @section Overdispersion:
 #' For count models, an *overdispersion plot* is shown. Overdispersion occurs

R/check_model_diagnostics.R

@@ -41,7 +41,7 @@
   } else if (inherits(model, "geeglm")) {
     res_ <- stats::residuals(model, type = "pearson")
   } else if (inherits(model, "glm")) {
-    res_ <- abs(stats::rstandard(model, type = "deviance"))
+    res_ <- .safe(abs(stats::rstandard(model, type = "deviance")))
   } else {
     res_ <- .safe(stats::rstudent(model))
     if (is.null(res_)) {
@@ -62,12 +62,12 @@
   }
 
   if (inherits(model, "glm")) {
-    fitted_ <- stats::qnorm((stats::ppoints(length(res_)) + 1) / 2)[order(order(res_))]
+    fitted_ <- stats::qnorm((stats::ppoints(length(res_)) + 1) / 2)
   } else {
     fitted_ <- stats::fitted(model)
   }
 
-  # sanity check, sometime either residuals or fitted can contain NA, see #488
+  # sanity check, sometimes either residuals or fitted can contain NA, see #488
   if (anyNA(res_) || anyNA(fitted_)) {
     # drop NA and make sure both fitted and residuals match
     non_na <- !is.na(fitted_) & !is.na(res_)
@@ -251,6 +251,7 @@
         }
         stats::residuals(model) / sigma
       } else if (inherits(model, "glm")) {
+        ## TODO: check if we can / should use deviance residuals (as for QQ plots) here as well?
         stats::rstandard(model, type = "pearson")
       } else {
         stats::rstandard(model)

R/check_normality.R

@@ -15,7 +15,7 @@
 #' @note For mixed-effects models, studentized residuals, and *not*
 #' standardized residuals, are used for the test. There is also a
 #' [`plot()`-method](https://easystats.github.io/see/articles/performance.html)
-#'  implemented in the [**see**-package]((https://easystats.github.io/see/).
+#'  implemented in the [**see**-package](https://easystats.github.io/see/).
 #'
 #' @details `check_normality()` calls `stats::shapiro.test` and checks the
 #' standardized residuals (or studentized residuals for mixed models) for

R/check_outliers.R

@@ -81,7 +81,7 @@
 #' The reliability and approximate convergence of Bayesian models can be
 #' assessed using the estimates for the shape parameter k of the generalized
 #' Pareto distribution. If the estimated tail shape parameter k exceeds 0.5, the
-#' user should be warned, although in practice the authors of the [loo::loo]
+#' user should be warned, although in practice the authors of the **loo**
 #' package observed good performance for values of k up to 0.7 (the default
 #' threshold used by `performance`).
 #'
@@ -148,8 +148,8 @@
 #' - **Robust Mahalanobis Distance**:
 #' A robust version of Mahalanobis distance using an Orthogonalized
 #' Gnanadesikan-Kettenring pairwise estimator (Gnanadesikan and Kettenring,
-#' 1972). Requires the [bigutilsr::bigutilsr] package. See the
-#' [bigutilsr::dist_ogk()] function.
+#' 1972). Requires the **bigutilsr** package. See the [bigutilsr::dist_ogk()]
+#' function.
 #'
 #' - **Minimum Covariance Determinant (MCD)**:
 #' Another robust version of Mahalanobis. Leys et al. (2018) argue that
@@ -166,7 +166,7 @@
 #'  of 0.025 (corresponding to the 2.5\% most extreme observations) as a cut-off
 #'  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::ICSOutlier]
+#'  Note that `method = "ics"` requires both **ICS** and **ICSOutlier**
 #'  to be installed, and that it takes some time to compute the results.
 #'
 #'  - **OPTICS**:
@@ -179,7 +179,7 @@
 #'  detect several outliers (as these are usually defined as a percentage of
 #'  extreme values), this algorithm functions in a different manner and won't
 #'  always detect outliers. Note that `method = "optics"` requires the
-#'  [dbscan::dbscan] package to be installed, and that it takes some time to compute
+#'  **dbscan** package to be installed, and that it takes some time to compute
 #'  the results.
 #'
 #'  - **Local Outlier Factor**:
@@ -191,7 +191,7 @@
 #'  comparable to its neighbors. Scores significantly larger than 1 indicate
 #'  outliers. The default threshold of 0.025 will classify as outliers the
 #'  observations located at `qnorm(1-0.025) * SD)` of the log-transformed
-#'  LOF distance. Requires the [dbscan::dbscan] package.
+#'  LOF distance. Requires the **dbscan** package.
 #'
 #' @section Threshold specification:
 #'

R/check_predictions.R

@@ -83,7 +83,7 @@ check_predictions.default <- function(object,
   .is_model_valid(object)
 
   if (isTRUE(insight::model_info(object, verbose = FALSE)$is_bayesian) &&
-        isFALSE(inherits(object, "BFBayesFactor"))) {
+    isFALSE(inherits(object, "BFBayesFactor"))) {
     insight::check_if_installed(
       "bayesplot",
       "to create posterior prediction plots for Stan models"

R/cronbachs_alpha.R

@@ -63,12 +63,6 @@ cronbachs_alpha.parameters_pca <- function(x, verbose = TRUE, ...) {
   # fetch data used for the PCA
   pca_data <- attributes(x)$dataset
 
-  ## TODO: remove once parameters 0.18.3 or higher on CRAN
-  # backward compatibility to parameters 0.18.2
-  if (is.null(pca_data)) {
-    pca_data <- attributes(x)$data_set
-  }
-
   # if NULL, can we get from environment?
   if (is.null(pca_data)) {
     pca_data <- attr(x, "data")

R/item_discrimination.R

@@ -36,7 +36,7 @@
 item_discrimination <- function(x, standardize = FALSE) {
   # check param
   if (!is.matrix(x) && !is.data.frame(x)) {
-    insight::format_warning("`x` needs to be a data frame or matrix.")
+    insight::format_alert("`x` needs to be a data frame or matrix.")
     return(NULL)
   }
 
@@ -54,7 +54,7 @@ item_discrimination <- function(x, standardize = FALSE) {
   }
   # calculate corrected total-item correlation
   id <- vapply(seq_len(ncol(x)), function(i) {
-    stats::cor(x[, i], apply(x[, -i], 1, sum), use = "pairwise.complete.obs")
+    stats::cor(x[, i], rowSums(x[, -i]), use = "pairwise.complete.obs")
   }, numeric(1))
 
   out <- data.frame(

R/item_reliability.R

@@ -36,7 +36,7 @@
 item_reliability <- function(x, standardize = FALSE, digits = 3) {
   # check param
   if (!is.matrix(x) && !is.data.frame(x)) {
-    warning("`x` needs to be a data frame or matrix.", call. = FALSE)
+    insight::format_alert("`x` needs to be a data frame or matrix.")
     return(NULL)
   }
 
@@ -63,7 +63,7 @@ item_reliability <- function(x, standardize = FALSE, digits = 3) {
 
     # calculate corrected total-item correlation
     totalCorr <- vapply(seq_len(ncol(x)), function(i) {
-      stats::cor(x[, i], apply(x[, -i], 1, sum), use = "pairwise.complete.obs")
+      stats::cor(x[, i], rowSums(x[, -i]), use = "pairwise.complete.obs")
     }, numeric(1L))
 
     ret.df <- data.frame(

R/test_bf.R

@@ -16,9 +16,9 @@ test_bf.default <- function(..., reference = 1, text_length = NULL) {
   .test_performance_checks(objects, multiple = FALSE)
 
   if (length(objects) == 1 && isTRUE(insight::is_model(objects))) {
-    stop(insight::format_message(
-      "'test_bf()' is designed to compare multiple models together. For a single model, you might want to run bayestestR::bf_parameters() instead."
-    ), call. = FALSE)
+    insight::format_error(
+      "`test_bf()` is designed to compare multiple models together. For a single model, you might want to run `bayestestR::bf_parameters()` instead."
+    )
   }
 
   # If a suitable class is found, run the more specific method on it
@@ -34,7 +34,7 @@ test_bf.default <- function(..., reference = 1, text_length = NULL) {
 #' @export
 test_bf.ListModels <- function(objects, reference = 1, text_length = NULL, ...) {
   if (.test_bf_areAllBayesian(objects) == "mixed") {
-    stop("You cannot mix Bayesian and non-Bayesian models in 'test_bf()'.", call. = FALSE)
+    insight::format_error("You cannot mix Bayesian and non-Bayesian models in `test_bf()`.")
   }
 
   # Adapt reference but keep original input

R/test_likelihoodratio.R

@@ -5,7 +5,7 @@
 #'   `"ML"` for all other models (including mixed models), or `"REML"` for
 #'   linear mixed models when these have the same fixed effects. See 'Details'.
 #' @export
-test_likelihoodratio <- function(..., estimator = "ML") {
+test_likelihoodratio <- function(..., estimator = "ML", verbose = TRUE) {
   UseMethod("test_likelihoodratio")
 }
 
@@ -20,12 +20,12 @@ test_lrt <- test_likelihoodratio
 # default --------------------
 
 #' @export
-test_likelihoodratio.default <- function(..., estimator = "OLS") {
+test_likelihoodratio.default <- function(..., estimator = "OLS", verbose = TRUE) {
   # Attribute class to list
   objects <- insight::ellipsis_info(..., only_models = TRUE)
 
   # Sanity checks (will throw error if non-valid objects)
-  .test_performance_checks(objects)
+  objects <- .test_performance_checks(objects, verbose = verbose)
 
   # different default when mixed model or glm is included
   if (missing(estimator)) {
@@ -101,7 +101,7 @@ print.test_likelihoodratio <- function(x, digits = 2, ...) {
 # other classes ---------------------------
 
 #' @export
-test_likelihoodratio.ListNestedRegressions <- function(objects, estimator = "ML", ...) {
+test_likelihoodratio.ListNestedRegressions <- function(objects, estimator = "ML", verbose = TRUE, ...) {
   dfs <- sapply(objects, insight::get_df, type = "model")
   same_fixef <- attributes(objects)$same_fixef
 
@@ -140,10 +140,10 @@ test_likelihoodratio.ListNestedRegressions <- function(objects, estimator = "ML"
     # only when mixed models are involved, others probably don't have problems with REML fit
     any(sapply(objects, insight::is_mixed_model)) &&
     # only if not all models have same fixed effects (else, REML is ok)
-    !isTRUE(same_fixef)) {
-    warning(insight::format_message(
+    !isTRUE(same_fixef) && isTRUE(verbose)) {
+    insight::format_warning(
       "The Likelihood-Ratio-Test is probably inaccurate when comparing REML-fit models with different fixed effects."
-    ), call. = FALSE)
+    )
   }
 
   attr(out, "is_nested_increasing") <- attributes(objects)$is_nested_increasing

R/test_performance.R

@@ -21,6 +21,7 @@
 #'   `test_bf()` describes models by their formulas, which can lead to
 #'   overly long lines in the output. `text_length` fixes the length of
 #'   lines to a specified limit.
+#' @param verbose Toggle warning and messages.
 #'
 #' @return A data frame containing the relevant indices.
 #'
@@ -224,7 +225,7 @@
 #'    structural equation models. Psychological Methods, 21, 151-163.
 #'
 #' @export
-test_performance <- function(..., reference = 1) {
+test_performance <- function(..., reference = 1, verbose = TRUE) {
   UseMethod("test_performance")
 }
 
@@ -233,12 +234,12 @@ test_performance <- function(..., reference = 1) {
 # default --------------------------------
 
 #' @export
-test_performance.default <- function(..., reference = 1, include_formula = FALSE) {
+test_performance.default <- function(..., reference = 1, include_formula = FALSE, verbose = TRUE) {
   # Attribute class to list and get names from the global environment
   objects <- insight::ellipsis_info(..., only_models = TRUE)
 
   # Sanity checks (will throw error if non-valid objects)
-  .test_performance_checks(objects)
+  objects <- .test_performance_checks(objects, verbose = verbose)
 
   # ensure proper object names
   objects <- .check_objectnames(objects, sapply(match.call(expand.dots = FALSE)$`...`, as.character))
@@ -432,10 +433,22 @@ test_performance.ListNonNestedRegressions <- function(objects,
 
 
 
-.test_performance_checks <- function(objects, multiple = TRUE, same_response = TRUE) {
+.test_performance_checks <- function(objects, multiple = TRUE, same_response = TRUE, verbose = TRUE) {
   # TODO: we could actually generate a baseline model 'y ~ 1' whenever a single model is passed
   if (multiple && insight::is_model(objects)) {
-    insight::format_error("At least two models are required to test them.")
+    null_model <- .safe(insight::null_model(objects, verbose = FALSE))
+    if (!is.null(null_model) && insight::is_model(null_model)) {
+      objects <- insight::ellipsis_info(list(null_model, objects))
+      names(objects) <- c("Null model", "Full model")
+      if (verbose) {
+        insight::format_alert(
+          "Only one model was provided, however, at least two are required for comparison.",
+          "Fitting a null-model as reference now."
+        )
+      }
+    } else {
+      insight::format_error("At least two models are required to test them.")
+    }
   }
 
   if (same_response && !inherits(objects, "ListLavaan") && isFALSE(attributes(objects)$same_response)) {

R/test_vuong.R

@@ -1,17 +1,17 @@
 #' @rdname test_performance
 #' @export
-test_vuong <- function(...) {
+test_vuong <- function(..., verbose = TRUE) {
   UseMethod("test_vuong")
 }
 
 
 #' @export
-test_vuong.default <- function(..., reference = 1) {
+test_vuong.default <- function(..., reference = 1, verbose = TRUE) {
   # Attribute class to list and get names from the global environment
   objects <- insight::ellipsis_info(..., only_models = TRUE)
 
   # Sanity checks (will throw error if non-valid objects)
-  .test_performance_checks(objects)
+  objects <- .test_performance_checks(objects, verbose = verbose)
 
   # ensure proper object names
   objects <- .check_objectnames(objects, sapply(match.call(expand.dots = FALSE)$`...`, as.character))
@@ -165,7 +165,7 @@ test_vuong.ListNonNestedRegressions <- function(objects, reference = 1, ...) {
   # Null distribution and test stat depends on nested
   if (nested) {
     teststat <- 2 * lr
-    p_LRTA <- CompQuadForm::imhof(teststat, -lamstar)[[1]]
+    p_LRTA <- suppressWarnings(CompQuadForm::imhof(teststat, -lamstar)[[1]])
     p_LRTB <- NA
   } else {
     teststat <- (1 / sqrt(n)) * lr / sqrt(omega_hat_2)