more fixes for #645

easystats · Jun 13, 2024 · 23a522e · 23a522e
1 parent e251f18
commit 23a522e
Show file tree

Hide file tree

Showing 6 changed files with 32 additions and 17 deletions.
diff --git a/R/cohens_d.R b/R/cohens_d.R
@@ -214,13 +214,14 @@ glass_delta <- function(x, y = NULL, data = NULL,
     )
   }
 
-  is_paired_or_onesample <- paired
   if (is.null(y)) {
     if (type == "delta") {
       insight::format_error("For Glass' Delta, please provide data from two samples.")
     }
     y <- 0
     is_paired_or_onesample <- TRUE
+  } else {
+    is_paired_or_onesample <- paired
   }
 
   # Compute index

diff --git a/R/common_language.R b/R/common_language.R
@@ -129,10 +129,6 @@ p_superiority <- function(x, y = NULL, data = NULL,
   paired <- data[["paired"]]
 
   if (parametric) {
-    if (paired) {
-      x <- x - y
-      y <- NULL
-    }
     d <- cohens_d(
       x = x,
       y = y,

diff --git a/R/convert_between_common_language.R b/R/convert_between_common_language.R
@@ -257,14 +257,24 @@ d_to_overlap.effectsize_difference <- function(d) {
 
 #' @keywords internal
 .is_cles_applicable <- function(d, allow_paired = FALSE) {
-  !any(colnames(d) %in% c("Cohens_d", "Hedges_g")) ||
-    (isTRUE(attr(d, "paired")) && !allow_paired) ||
-    (!isTRUE(attr(d, "paired")) && !isTRUE(attr(d, "pooled_sd")))
+  paired <- attr(d, "paired")
+  pooled_sd <- attr(d, "pooled_sd")
+
+  # Effect size is d or g
+  any(colnames(d) %in% c("Cohens_d", "Hedges_g")) &&
+    (
+      # Is paired when allowed
+      (isTRUE(paired) && allow_paired) ||
+        # Is one sample when allowed
+        (!isTRUE(paired) && is.null(pooled_sd) && allow_paired) ||
+        # Is independent with pooled sd
+        (!isTRUE(paired) && isTRUE(pooled_sd))
+    )
 }
 
 #' @keywords internal
 .cohens_d_to_cles <- function(d, converter, allow_paired = FALSE) {
-  if (.is_cles_applicable(d, allow_paired)) {
+  if (!.is_cles_applicable(d, allow_paired)) {
     insight::format_error("Common language effect size only applicable to 2-sample Cohen's d with pooled SD.")
   }
 

diff --git a/R/rank_diff.R b/R/rank_diff.R
@@ -140,11 +140,13 @@ rank_biserial <- function(x, y = NULL, data = NULL,
 
   if (is.null(y)) {
     y <- 0
-    paired <- TRUE
+    is_paired_or_onesample <- TRUE
+  } else {
+    is_paired_or_onesample <- paired
   }
 
   ## Compute
-  r_rbs <- .r_rbs(x, y, mu = mu, paired = paired, verbose = verbose)
+  r_rbs <- .r_rbs(x, y, mu = mu, paired = is_paired_or_onesample, verbose = verbose)
   out <- data.frame(r_rank_biserial = r_rbs)
 
   ## CI
@@ -155,7 +157,7 @@ rank_biserial <- function(x, y = NULL, data = NULL,
     alpha <- 1 - ci.level
 
     rf <- atanh(r_rbs)
-    if (paired) {
+    if (is_paired_or_onesample) {
       nd <- sum((x - mu) != 0)
       maxw <- (nd^2 + nd) / 2
 
@@ -216,7 +218,7 @@ cliffs_delta <- function(x, y = NULL, data = NULL,
   )
   x <- data$x
   y <- data$y
-  if (is.null(y) || isTRUE(match.call()$paired) || isTRUE(data[["paired"]])) {
+  if (is.null(y) || isTRUE(cl$paired) || isTRUE(data[["paired"]])) {
     insight::format_error("This effect size is only applicable for two independent samples.")
   }
 

diff --git a/man/effectsize_CIs.Rd b/man/effectsize_CIs.Rd
diff --git a/tests/testthat/test-rankES.R b/tests/testthat/test-rankES.R
@@ -5,7 +5,7 @@ test_that("rank_biserial", {
   rRB1 <- rank_biserial(x, y, paired = TRUE)
   rRB2 <- rank_biserial(x - y)
 
-  expect_equal(rRB1, rRB2)
+  expect_equal(rRB1, rRB2, ignore_attr = TRUE)
   expect_equal(rRB1[[1]], 0.777, tolerance = 0.01)
   expect_equal(rRB1$CI_low, 0.2953631, tolerance = 0.01)
   expect_equal(rRB1$CI_high, 0.9441559, tolerance = 0.01)