fix more paired issues

easystats · Sep 13, 2023 · 0c4c23f · 0c4c23f
1 parent 5711eec
commit 0c4c23f
Show file tree

Hide file tree

Showing 8 changed files with 57 additions and 29 deletions.
diff --git a/R/cohens_d.R b/R/cohens_d.R
@@ -206,6 +206,7 @@ glass_delta <- function(x, y = NULL, data = NULL,
   out <- .get_data_2_samples(x, y, data, paired = paired, verbose = verbose, ...)
   x <- out[["x"]]
   y <- out[["y"]]
+  paired <- out[["paired"]]
 
   if (is.null(y)) {
     if (type == "delta") {

diff --git a/R/common_language.R b/R/common_language.R
@@ -123,6 +123,7 @@ p_superiority <- function(x, y = NULL, data = NULL,
   )
   x <- data[["x"]]
   y <- data[["y"]]
+  paired <- data[["paired"]]
 
   if (parametric) {
     d <- cohens_d(
@@ -162,14 +163,15 @@ cohens_u1 <- function(x, y = NULL, data = NULL,
     return(effectsize(x, type = "u1", ci = ci, verbose = verbose, ...))
   }
 
-
   data <- .get_data_2_samples(x, y, data,
     allow_ordered = !parametric,
     verbose = verbose, ...
   )
   x <- data[["x"]]
   y <- data[["y"]]
-  if (is.null(y)) insight::format_error("cohens_u3 only applicable to two sample case.")
+  if (is.null(y) || isTRUE(match.call()$paired)) {
+    insight::format_error("This effect size is only applicable for two independent samples.")
+  }
 
   if (!parametric) {
     insight::format_error("Cohen's U1 only available for parametric estimation.")
@@ -202,14 +204,15 @@ cohens_u2 <- function(x, y = NULL, data = NULL,
     return(effectsize(x, type = "u2", ci = ci, verbose = verbose, ...))
   }
 
-
   data <- .get_data_2_samples(x, y, data,
     allow_ordered = !parametric,
     verbose = verbose, ...
   )
   x <- data[["x"]]
   y <- data[["y"]]
-  if (is.null(y)) insight::format_error("cohens_u3 only applicable to two sample case.")
+  if (is.null(y) || isTRUE(match.call()$paired)) {
+    insight::format_error("This effect size is only applicable for two independent samples.")
+  }
 
   if (parametric) {
     d <- cohens_d(
@@ -253,7 +256,9 @@ cohens_u3 <- function(x, y = NULL, data = NULL,
   )
   x <- data[["x"]]
   y <- data[["y"]]
-  if (is.null(y)) insight::format_error("cohens_u3 only applicable to two sample case.")
+  if (is.null(y) || isTRUE(match.call()$paired)) {
+    insight::format_error("This effect size is only applicable for two independent samples.")
+  }
 
   if (parametric) {
     d <- cohens_d(
@@ -289,14 +294,15 @@ p_overlap <- function(x, y = NULL, data = NULL,
     return(effectsize(x, type = "overlap", ci = ci, verbose = verbose, ...))
   }
 
-
   data <- .get_data_2_samples(x, y, data,
     allow_ordered = !parametric,
     verbose = verbose, ...
   )
   x <- data[["x"]]
   y <- data[["y"]]
-  if (is.null(y)) insight::format_error("Overlap only applicable to two sample case.")
+  if (is.null(y) || isTRUE(match.call()$paired)) {
+    insight::format_error("This effect size is only applicable for two independent samples.")
+  }
 
   if (parametric) {
     d <- cohens_d(

diff --git a/R/means_ratio.R b/R/means_ratio.R
@@ -76,6 +76,7 @@ means_ratio <- function(x, y = NULL, data = NULL,
   )
   x <- out[["x"]]
   y <- out[["y"]]
+  paired <- out[["paired"]]
 
   if (is.null(y)) {
     insight::format_error("Only one sample provided. y or data must be provided.")

diff --git a/R/pooled.R b/R/pooled.R
@@ -28,6 +28,9 @@ sd_pooled <- function(x, y = NULL, data = NULL, verbose = TRUE, ...) {
   data <- .get_data_2_samples(x, y, data, verbose = verbose, ...)
   x <- data[["x"]]
   y <- data[["y"]]
+  if (is.null(y) || isTRUE(match.call()$paired)) {
+    insight::format_error("This effect size is only applicable for two independent samples.")
+  }
 
   V <- cov_pooled(
     data.frame(x = x),
@@ -46,6 +49,9 @@ mad_pooled <- function(x, y = NULL, data = NULL,
   data <- .get_data_2_samples(x, y, data, verbose = verbose, ...)
   x <- data[["x"]]
   y <- data[["y"]]
+  if (is.null(y) || isTRUE(match.call()$paired)) {
+    insight::format_error("This effect size is only applicable for two independent samples.")
+  }
 
   n1 <- length(x)
   n2 <- length(y)

diff --git a/R/rank_diff.R b/R/rank_diff.R
@@ -62,28 +62,34 @@
 #' # Same as:
 #' # rank_biserial("mpg", "am", data = mtcars)
 #' # rank_biserial(mtcars$mpg[mtcars$am=="0"], mtcars$mpg[mtcars$am=="1"])
+#' # cliffs_delta(mpg ~ am, data = mtcars)
 #'
 #' # More options:
 #' rank_biserial(mpg ~ am, data = mtcars, mu = -5)
 #' print(rb, append_CLES = TRUE)
 #'
 #'
 #' # One Sample ----------
-#' rank_biserial(wt ~ 1, data = mtcars, mu = 3)
+#' # from help("wilcox.test")
+#' x <- c(1.83,  0.50,  1.62,  2.48, 1.68, 1.88, 1.55, 3.06, 1.30)
+#' y <- c(0.878, 0.647, 0.598, 2.05, 1.06, 1.29, 1.06, 3.14, 1.29)
+#' depression <- data.frame(first = x, second = y, change = y - x)
+#'
+#' rank_biserial(change ~ 1, data = depression)
+#'
 #' # same as:
-#' # rank_biserial("wt", data = mtcars, mu = 3)
-#' # rank_biserial(mtcars$wt, mu = 3)
+#' # rank_biserial("change", data = depression)
+#' # rank_biserial(mtcars$wt)
+#'
+#' # More options:
+#' rank_biserial(change ~ 1, data = depression, mu = -0.5)
 #'
 #'
 #' # Paired Samples ----------
-#' dat <- data.frame(
-#'   Cond1 = c(1.83, 0.5, 1.62, 2.48, 1.68, 1.88, 1.55, 3.06, 1.3),
-#'   Cond2 = c(0.878, 0.647, 0.598, 2.05, 1.06, 1.29, 1.06, 3.14, 1.29)
-#' )
-#' (rb <- rank_biserial(Pair(Cond1, Cond2) ~ 1, data = dat, paired = TRUE))
+#' (rb <- rank_biserial(Pair(first, second) ~ 1, data = depression))
 #'
 #' # same as:
-#' # rank_biserial(dat$Cond1, dat$Cond2, paired = TRUE)
+#' # rank_biserial(depression$first, depression$second, paired = TRUE)
 #'
 #' interpret_rank_biserial(0.78)
 #' interpret(rb, rules = "funder2019")
@@ -127,8 +133,9 @@ rank_biserial <- function(x, y = NULL, data = NULL,
     allow_ordered = TRUE,
     verbose = verbose, ...
   )
-  x <- out$x
-  y <- out$y
+  x <- out[["x"]]
+  y <- out[["y"]]
+  paired <- out[["paired"]]
 
   if (is.null(y)) {
     y <- 0

diff --git a/R/utils_validate_input_data.R b/R/utils_validate_input_data.R
@@ -56,6 +56,7 @@
   } else if (inherits(x, "Pair")) {
     x <- x[, 1] - x[, 2]
     y <- NULL
+    paired <- TRUE
   }
 
 
@@ -97,7 +98,7 @@
   }
 
 
-  list(x = x, y = y)
+  list(x = x, y = y, paired = paired)
 }
 
 

diff --git a/man/rank_biserial.Rd b/man/rank_biserial.Rd
diff --git a/tests/testthat/test-eta_squared.R b/tests/testthat/test-eta_squared.R
@@ -659,7 +659,7 @@ test_that("ets_squared | gam", {
   dat <- mgcv::gamSim(1, n = 400, dist = "normal", scale = 2, verbose = FALSE)
   b <- mgcv::gam(y ~ x0 + s(x1) + s(x2) + t2(x1, x2) + s(x3), data = dat)
 
-  expect_error(eta_squared(b), regexp = NA)
+  expect_error(out <- eta_squared(b), regexp = NA)
   expect_warning(eta_squared(b), regexp = NA)
   expect_output(print(out), "Type III")
 })