deal with alternative = NULL (#555)

* init * Apply automatic changes * fix tests * Apply automatic changes * [skip ci] Co-authored-by: mattansb <[email protected]>
easystats · Jan 24, 2023 · 13b46a6 · 13b46a6
1 parent 1b8ad84
commit 13b46a6
Show file tree

Hide file tree

Showing 14 changed files with 95 additions and 72 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,7 +1,7 @@
 Type: Package
 Package: effectsize
 Title: Indices of Effect Size
-Version: 0.8.2.6
+Version: 0.8.2.10
 Authors@R: 
     c(person(given = "Mattan S.",
              family = "Ben-Shachar",

diff --git a/NEWS.md b/NEWS.md
@@ -1,5 +1,9 @@
 # effectsize 0.8.2.xxx
 
+## Changes
+
+- `mahalanobis_d()` now defaults to one-sided CIs.
+
 ## New features
 
 - `means_ratio()` for computing ratios of two means for ratio-scales outcomes (thanks to @arcaldwell49!)
@@ -23,7 +27,7 @@
 
 ## Changes
 
-- cohens_w() has an exact upper bound when used as an effect size for goodness-of-fit.
+- `cohens_w()` has an exact upper bound when used as an effect size for goodness-of-fit.
 
 ## Bug fixes
 

diff --git a/R/convert_stat_chisq.R b/R/convert_stat_chisq.R
@@ -326,7 +326,7 @@ phi_to_chisq <- function(phi, n, ...) {
 .chisq_to_generic_phi <- function(chisq, den, nrow, ncol,
                                   ci = NULL, alternative = "greater",
                                   ...) {
-  alternative <- .match.alt(alternative)
+  alternative <- .match.alt(alternative, FALSE)
 
   if (ci_numeric <- .test_ci(ci)) {
     is_goodness <- ncol == 1 || nrow == 1

diff --git a/R/convert_stat_to_anova.R b/R/convert_stat_to_anova.R
@@ -183,7 +183,8 @@ F_to_omega2 <- function(f, df, df_error,
 #' @rdname F_to_eta2
 #' @export
 t_to_omega2 <- function(t, df_error,
-                        ci = 0.95, alternative = "greater", ...) {
+                        ci = 0.95, alternative = "greater",
+                        ...) {
   F_to_omega2(t^2, 1, df_error,
     ci = ci, alternative = alternative,
     ...
@@ -274,7 +275,7 @@ t_to_f2 <- function(t, df_error,
                       es = "eta2",
                       ci = 0.95, alternative = "greater",
                       verbose = TRUE, ...) {
-  alternative <- .match.alt(alternative)
+  alternative <- .match.alt(alternative, FALSE)
 
   res <- switch(tolower(es),
     eta2 = data.frame(Eta2_partial = (f * df) / (f * df + df_error)),

diff --git a/R/eta_squared-main.R b/R/eta_squared-main.R
@@ -203,7 +203,7 @@ eta_squared <- function(model,
                         partial = TRUE, generalized = FALSE,
                         ci = 0.95, alternative = "greater",
                         verbose = TRUE, ...) {
-  alternative <- .match.alt(alternative)
+  alternative <- .match.alt(alternative, FALSE)
   out <- .anova_es(
     model,
     type = "eta",
@@ -225,7 +225,7 @@ omega_squared <- function(model,
                           partial = TRUE,
                           ci = 0.95, alternative = "greater",
                           verbose = TRUE, ...) {
-  alternative <- .match.alt(alternative)
+  alternative <- .match.alt(alternative, FALSE)
   out <- .anova_es(model, type = "omega", partial = partial, ci = ci, alternative = alternative, verbose = verbose, ...)
   class(out) <- unique(c("effectsize_anova", "effectsize_table", "see_effectsize_table", class(out)))
   if ("CI" %in% colnames(out)) attr(out, "ci_method") <- list(method = "ncp", distribution = "F")
@@ -239,7 +239,7 @@ epsilon_squared <- function(model,
                             partial = TRUE,
                             ci = 0.95, alternative = "greater",
                             verbose = TRUE, ...) {
-  alternative <- .match.alt(alternative)
+  alternative <- .match.alt(alternative, FALSE)
   out <- .anova_es(model, type = "epsilon", partial = partial, ci = ci, alternative = alternative, verbose = verbose, ...)
   class(out) <- unique(c("effectsize_anova", "effectsize_table", "see_effectsize_table", class(out)))
   if ("CI" %in% colnames(out)) attr(out, "ci_method") <- list(method = "ncp", distribution = "F")
@@ -256,7 +256,7 @@ cohens_f <- function(model,
                      partial = TRUE, squared = FALSE, model2 = NULL,
                      ci = 0.95, alternative = "greater",
                      verbose = TRUE, ...) {
-  alternative <- .match.alt(alternative)
+  alternative <- .match.alt(alternative, FALSE)
   if (!is.null(model2)) {
     return(.cohens_f_delta(model, model2,
       squared = squared,

diff --git a/R/mahalanobis_D.R b/R/mahalanobis_D.R
@@ -55,7 +55,7 @@
 #' # Or
 #' mahalanobis_d(mpg + hp + cyl ~ am, data = mtcars)
 #'
-#' mahalanobis_d(mpg + hp + cyl ~ am, data = mtcars, alternative = "greater")
+#' mahalanobis_d(mpg + hp + cyl ~ am, data = mtcars, alternative = "two.sided")
 #'
 #' # Different mu:
 #' mahalanobis_d(mpg + hp + cyl ~ am,
@@ -83,11 +83,11 @@
 #' @export
 mahalanobis_d <- function(x, y = NULL, data = NULL,
                           pooled_cov = TRUE, mu = 0,
-                          ci = 0.95, alternative = "two.sided",
+                          ci = 0.95, alternative = "greater",
                           verbose = TRUE, ...) {
   # TODO add one sample case DV1 + DV2 ~ 1
   # TODO add paired samples case DV1 + DV2 ~ 1 | ID
-  alternative <- .match.alt(alternative)
+  alternative <- .match.alt(alternative, FALSE)
   data <- .get_data_multivariate(x, y, data, verbose = verbose, ...)
   x <- data[["x"]]
   y <- data[["y"]]

diff --git a/R/r2_semipartial.R b/R/r2_semipartial.R
@@ -97,7 +97,7 @@ r2_semipartial.lm <- function(model, type = c("terms", "parameters"),
                               ci = 0.95, alternative = "greater",
                               ...) {
   type <- match.arg(type)
-  alternative <- .match.alt(alternative)
+  alternative <- .match.alt(alternative, FALSE)
 
   y <- stats::model.frame(model)[[1]]
   mm <- insight::get_modelmatrix(model)

diff --git a/R/rank_ANOVA.R b/R/rank_ANOVA.R
@@ -89,7 +89,7 @@ rank_epsilon_squared <- function(x, groups, data = NULL,
                                  ci = 0.95, alternative = "greater",
                                  iterations = 200,
                                  verbose = TRUE, ...) {
-  alternative <- .match.alt(alternative)
+  alternative <- .match.alt(alternative, FALSE)
 
   if (.is_htest_of_type(x, "Kruskal-Wallis", "Kruskal-Wallis-test")) {
     return(effectsize(x, type = "epsilon", ci = ci, iterations = iterations, alternative = alternative))
@@ -130,7 +130,7 @@ rank_eta_squared <- function(x, groups, data = NULL,
                              ci = 0.95, alternative = "greater",
                              iterations = 200,
                              verbose = TRUE, ...) {
-  alternative <- .match.alt(alternative)
+  alternative <- .match.alt(alternative, FALSE)
 
   if (.is_htest_of_type(x, "Kruskal-Wallis", "Kruskal-Wallis-test")) {
     return(effectsize(x, type = "eta", ci = ci, iterations = iterations, alternative = alternative))
@@ -177,7 +177,7 @@ kendalls_w <- function(x, groups, blocks, data = NULL,
                        ci = 0.95, alternative = "greater",
                        iterations = 200,
                        verbose = TRUE, ...) {
-  alternative <- .match.alt(alternative)
+  alternative <- .match.alt(alternative, FALSE)
 
   if (.is_htest_of_type(x, "Friedman", "Friedman-test")) {
     return(effectsize(x, ci = ci, iterations = iterations, verbose = verbose, alternative = alternative))

diff --git a/R/utils.R b/R/utils.R
@@ -68,49 +68,3 @@
     return(FALSE)
   }
 }
-
-
-# CI Utils ----------------------------------------------------------------
-
-#' @keywords internal
-.test_ci <- function(ci) {
-  if (is.null(ci)) {
-    return(FALSE)
-  }
-  if (!is.numeric(ci) ||
-    length(ci) != 1L ||
-    ci < 0 ||
-    ci > 1) {
-    insight::format_error("ci must be a single numeric value between (0, 1)")
-  }
-  return(TRUE)
-}
-
-#' @keywords internal
-.adjust_ci <- function(ci, alternative) {
-  if (alternative == "two.sided") {
-    return(ci)
-  }
-
-  2 * ci - 1
-}
-
-#' @keywords internal
-.limit_ci <- function(out, alternative, lb, ub) {
-  if (alternative == "two.sided") {
-    return(out)
-  }
-
-  if (alternative == "less") {
-    out$CI_low <- lb
-  } else if (alternative == "greater") {
-    out$CI_high <- ub
-  }
-
-  out
-}
-
-#' @keywords internal
-.match.alt <- function(alternative) {
-  match.arg(alternative, c("two.sided", "less", "greater"))
-}
diff --git a/R/utils_ncp_ci.R → R/utils_ci.R b/R/utils_ncp_ci.R → R/utils_ci.R
@@ -1,3 +1,5 @@
+# NCP -------------------------
+
 #' @keywords internal
 #' @importFrom stats pf qf optim
 .get_ncp_F <- function(f, df, df_error, conf.level = 0.9) {
@@ -93,3 +95,57 @@
 
   chi_ncp
 }
+
+# Validators --------------------------------------
+
+
+#' @keywords internal
+.test_ci <- function(ci) {
+  if (is.null(ci)) {
+    return(FALSE)
+  }
+  if (!is.numeric(ci) ||
+    length(ci) != 1L ||
+    ci < 0 ||
+    ci > 1) {
+    insight::format_error("ci must be a single numeric value between (0, 1)")
+  }
+  return(TRUE)
+}
+
+#' @keywords internal
+.adjust_ci <- function(ci, alternative) {
+  if (alternative == "two.sided") {
+    return(ci)
+  }
+
+  2 * ci - 1
+}
+
+#' @keywords internal
+.limit_ci <- function(out, alternative, lb, ub) {
+  if (alternative == "two.sided") {
+    return(out)
+  }
+
+  if (alternative == "less") {
+    out$CI_low <- lb
+  } else if (alternative == "greater") {
+    out$CI_high <- ub
+  }
+
+  out
+}
+
+#' @keywords internal
+.match.alt <- function(alternative, two.sided = TRUE) {
+  if (is.null(alternative)) {
+    if (two.sided) {
+      return("two.sided")
+    } else {
+      return("greater")
+    }
+  }
+
+  match.arg(alternative, c("two.sided", "less", "greater"))
+}
diff --git a/R/xtab_corr.R b/R/xtab_corr.R
@@ -105,7 +105,7 @@ phi <- function(x, y = NULL,
                 adjust = TRUE,
                 ci = 0.95, alternative = "greater",
                 ...) {
-  alternative <- .match.alt(alternative)
+  alternative <- .match.alt(alternative, FALSE)
 
   if (.is_BF_of_type(x, "BFcontingencyTable", "Chi-squared")) {
     return(effectsize(x, type = "phi", adjust = adjust, ci = ci))
@@ -124,7 +124,7 @@ cramers_v <- function(x, y = NULL,
                       adjust = TRUE,
                       ci = 0.95, alternative = "greater",
                       ...) {
-  alternative <- .match.alt(alternative)
+  alternative <- .match.alt(alternative, FALSE)
 
   if (.is_BF_of_type(x, "BFcontingencyTable", "Chi-squared")) {
     return(effectsize(x, type = "cramers_v", adjust = adjust, ci = ci))
@@ -143,7 +143,7 @@ cramers_v <- function(x, y = NULL,
 tschuprows_t <- function(x, y = NULL,
                          ci = 0.95, alternative = "greater",
                          ...) {
-  alternative <- .match.alt(alternative)
+  alternative <- .match.alt(alternative, FALSE)
 
   if (.is_BF_of_type(x, "BFcontingencyTable", "Chi-squared")) {
     return(effectsize(x, type = "tschuprows_t", ci = ci))
@@ -161,7 +161,7 @@ tschuprows_t <- function(x, y = NULL,
 cohens_w <- function(x, y = NULL, p = rep(1, length(x)),
                      ci = 0.95, alternative = "greater",
                      ...) {
-  alternative <- .match.alt(alternative)
+  alternative <- .match.alt(alternative, FALSE)
 
   if (.is_BF_of_type(x, "BFcontingencyTable", "Chi-squared")) {
     return(effectsize(x, type = "cohens_w", ci = ci))
@@ -183,7 +183,7 @@ cohens_w <- function(x, y = NULL, p = rep(1, length(x)),
 fei <- function(x, p = rep(1, length(x)),
                 ci = 0.95, alternative = "greater",
                 ...) {
-  alternative <- .match.alt(alternative)
+  alternative <- .match.alt(alternative, FALSE)
 
   if (inherits(x, "BFBayesFactor")) {
     insight::format_error("Fei is only applicable to goodness of fit tests.")
@@ -201,7 +201,7 @@ fei <- function(x, p = rep(1, length(x)),
 pearsons_c <- function(x, y = NULL, p = rep(1, length(x)),
                        ci = 0.95, alternative = "greater",
                        ...) {
-  alternative <- .match.alt(alternative)
+  alternative <- .match.alt(alternative, FALSE)
 
   if (.is_BF_of_type(x, "BFcontingencyTable", "Chi-squared")) {
     return(effectsize(x, type = "pearsons_c", ci = ci))

diff --git a/man/mahalanobis_d.Rd b/man/mahalanobis_d.Rd
diff --git a/tests/testthat/test-eta_squared.R b/tests/testthat/test-eta_squared.R
@@ -1,5 +1,13 @@
 # library(testthat)
 
+test_that("alternative = NULL", {
+  m <- aov(mpg ~ factor(cyl) + hp, mtcars)
+  expect_equal(
+    eta_squared(m),
+    eta_squared(m, alternative = NULL)
+  )
+})
+
 # anova() -----------------------------------------------------------------
 test_that("anova()", {
   # Make minimal ANOVA table

diff --git a/tests/testthat/test-mahalanobis_D.R b/tests/testthat/test-mahalanobis_D.R
@@ -12,7 +12,7 @@ test_that("mahalanobis_d | two sample | vs cohens_d", {
   y <- within(x, {
     B <- B + 15
   })
-  D <- mahalanobis_d(x, y)
+  D <- mahalanobis_d(x, y, alternative = "two")
   d <- cohens_d(-x$B, -y$B)
   expect_equal(D[[1]], d[[1]], tolerance = 0.01)
   expect_equal(D[[3]], d[[3]], tolerance = 0.1)
@@ -45,7 +45,7 @@ test_that("mahalanobis_d | one sample | vs cohens_d", {
 
 
   # Simple:
-  D <- mahalanobis_d(x)
+  D <- mahalanobis_d(x, alternative = "two")
   d <- cohens_d(x$B)
   expect_equal(D[[1]], d[[1]], tolerance = 0.01)
   expect_equal(D[[3]], d[[3]], tolerance = 0.1)