From 23a522ed827e68749b2317a3d68c0286350776ed Mon Sep 17 00:00:00 2001 From: "Mattan S. Ben-Shachar" Date: Thu, 13 Jun 2024 10:18:33 +0300 Subject: [PATCH] more fixes for #645 --- R/cohens_d.R | 3 ++- R/common_language.R | 4 ---- R/convert_between_common_language.R | 18 ++++++++++++++---- R/rank_diff.R | 10 ++++++---- man/effectsize_CIs.Rd | 12 +++++++++--- tests/testthat/test-rankES.R | 2 +- 6 files changed, 32 insertions(+), 17 deletions(-) diff --git a/R/cohens_d.R b/R/cohens_d.R index e7dd6d2b..25f1cc0e 100644 --- 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 index 49dd1aa1..393c5648 100644 --- 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 index 6b551e42..6dc1fc9f 100644 --- 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 index 7d7c1e98..33c12e5e 100644 --- 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 index db30b81c..34f336e8 100644 --- a/man/effectsize_CIs.Rd +++ b/man/effectsize_CIs.Rd @@ -121,7 +121,9 @@ eta_squared(fit) # default, ci = 0.95, alternative = "greater" #> n_comps | 0.19 | [0.14, 1.00] #> #> - One-sided CIs: upper bound fixed at [1.00]. -eta_squared(fit, alternative = "less") # Test is eta is smaller than some value +}\if{html}{\out{}} + +\if{html}{\out{
}}\preformatted{eta_squared(fit, alternative = "less") # Test is eta is smaller than some value #> For one-way between subjects designs, partial eta squared is equivalent #> to eta squared. Returning eta squared. #> # Effect Size for ANOVA @@ -131,7 +133,9 @@ eta_squared(fit, alternative = "less") # Test is eta is smaller than some value #> n_comps | 0.19 | [0.00, 0.24] #> #> - One-sided CIs: lower bound fixed at [0.00]. -eta_squared(fit, alternative = "two.sided") # 2-sided bounds for alpha = .05 +}\if{html}{\out{
}} + +\if{html}{\out{
}}\preformatted{eta_squared(fit, alternative = "two.sided") # 2-sided bounds for alpha = .05 #> For one-way between subjects designs, partial eta squared is equivalent #> to eta squared. Returning eta squared. #> # Effect Size for ANOVA @@ -139,7 +143,9 @@ eta_squared(fit, alternative = "two.sided") # 2-sided bounds for alpha = .05 #> Parameter | Eta2 | 95\% CI #> ------------------------------- #> n_comps | 0.19 | [0.14, 0.25] -eta_squared(fit, ci = 0.9, alternative = "two.sided") # both 1-sided bounds for alpha = .05 +}\if{html}{\out{
}} + +\if{html}{\out{
}}\preformatted{eta_squared(fit, ci = 0.9, alternative = "two.sided") # both 1-sided bounds for alpha = .05 #> For one-way between subjects designs, partial eta squared is equivalent #> to eta squared. Returning eta squared. #> # Effect Size for ANOVA diff --git a/tests/testthat/test-rankES.R b/tests/testthat/test-rankES.R index 0381bc36..9e49ad75 100644 --- 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)