add effectsize(type = ,...)

#214

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: effectsize
 Type: Package
 Title: Indices of Effect Size and Standardized Parameters
-Version: 0.4.0.001
+Version: 0.4.1
 Authors@R: c(
     person("Mattan S.", 
         "Ben-Shachar", 
@@ -40,7 +40,7 @@ Depends:
 Imports:
     bayestestR (>= 0.7.5),
     insight (>= 0.11.0),
-    parameters (>= 0.8.6),
+    parameters (>= 0.10.0),
     stats,
     utils
 Suggests:

NEWS.md

@@ -1,11 +1,12 @@
-# effectsize 0.4.0.001
+# effectsize 0.4.1
 
 ## Breaking Changes
 
 - `eta_squared_posterior()` no longer uses `car::Anova()` by default.
 
 ## New features
 
+- `effectsize()` gains `type = ` argument for specifying which effect size to return.
 - `eta_squared_posterior()` can return a generalized Eta squared.
 - `oddsratio()` and `riskratio()` functions for 2-by-2 contingency tables.
 - `standardize()` gains support for `mediation::mediate()` models.

R/effectsize.R

@@ -4,20 +4,21 @@
 #' input model. See details.
 #'
 #' @param model An object of class `htest`, or a statistical model. See details.
+#' @param type The effect size of interest. See details.
 #' @param ... Arguments passed to or from other methods. See details.
 #'
 #' @details
 #'
 #' - For an object of class `htest`:
 #'   - A **t-test** returns *Cohen's d* via [t_to_d()].
-#'   - A **correlation test** returns *r*. See [t_to_r()].
-#'   - A **Chi-squared test** returns *Cramer's V* via [cramers_v()].
-#'   - A **One-way ANOVA test** returns *Eta squared* via [F_to_eta2()], but can be changes via an `es` argument.
+#'   - A **correlation test** returns *r*.
+#'   - A **Chi-squared test**, depending on `type`: `"cramers_v"` (default), `"phi"` or `"cohens_w"`, `"oddsratio"`, or `"riskratio"`.
+#'   - A **One-way ANOVA test**, depending on `type`: `"eta"` (default), `"omega"` or `"epsilon"` -squared, `"f"`, or `"f2"`.
 #' - For an object of class `BFBayesFactor`, using [bayestestR::describe_posterior()],
 #'   - A **t-test** returns *Cohen's d*.
-#'   - A **correlation test** returns *r*..
-#'   - A **contingency table test** returns *Cramer's V*.
-#' - Objects of class `anova`, `aov`, or `aovlist` are passed to [eta_squared()].
+#'   - A **correlation test** returns *r*.
+#'   - A **contingency table test**, depending on `type`: `"cramers_v"` (default), `"phi"` or `"cohens_w"`, `"oddsratio"`, or `"riskratio"`.
+#' - Objects of class `anova`, `aov`, or `aovlist`, depending on `type`: `"eta"` (default), `"omega"` or `"epsilon"` -squared, `"f"`, or `"f2"`.
 #' - Other objects are passed to [standardize_parameters()].
 #'
 #' **For statistical models it is recommended to directly use the listed
@@ -32,12 +33,14 @@
 #' contingency_table <- as.table(rbind(c(762, 327, 468), c(484, 239, 477), c(484, 239, 477)))
 #' Xsq <- chisq.test(contingency_table)
 #' effectsize(Xsq)
+#' effectsize(Xsq, type = "phi")
 #'
 #' Ts <- t.test(1:10, y = c(7:20))
 #' effectsize(Ts)
 #'
-#' Aov <- oneway.test(extra ~ group, data = sleep)
+#' Aov <- oneway.test(extra ~ group, data = sleep, var.equal = TRUE)
 #' effectsize(Aov)
+#' effectsize(Aov, type = "omega")
 #'
 #'
 #' ## Bayesian Hypothesis Testing
@@ -52,6 +55,7 @@
 #'   data(raceDolls)
 #'   bf3 <- contingencyTableBF(raceDolls, sampleType = "poisson", fixedMargin = "cols")
 #'   effectsize(bf3, test = NULL)
+#'   effectsize(bf3, type = "oddsratio", test = NULL)
 #' }
 #'
 #'
@@ -62,14 +66,16 @@
 #'
 #' anova_table <- anova(fit)
 #' effectsize(anova_table)
+#' effectsize(anova_table, type = "epsilon")
 #'
 #' @export
 effectsize <- function(model, ...) {
   UseMethod("effectsize")
 }
 
 #' @export
-effectsize.htest <- function(model, ...) {
+#' @rdname effectsize
+effectsize.htest <- function(model, type = NULL, ...) {
   if (grepl("t-test", model$method)) {
     # message("Using t_to_d().")
     out <- t_to_d(
@@ -88,34 +94,58 @@ effectsize.htest <- function(model, ...) {
     return(out)
   } else if (grepl("Pearson's Chi-squared", model$method) ||
              grepl("Chi-squared test for given probabilities", model$method)) {
-    # message("Using chisq_to_cramers_v().")
-    Obs <- model$observed
-    Exp <- model$expected
-
-    if (!is.null(dim(Exp))) {
-      nr <- nrow(Obs)
-      nc <- ncol(Obs)
-    } else {
-      nr <- length(Obs)
-      nc <- 1
-    }
+    if (is.null(type)) type <- "cramers_v"
 
-    out <- chisq_to_cramers_v(
-      chisq = .chisq(Obs, Exp),
-      n = sum(Obs),
-      nrow = nr,
-      ncol = nc,
-      ...
-    )
+    f <- switch (tolower(type),
+                 v = ,
+                 cramers_v = cramers_v,
+
+                 w = ,
+                 cohens_w = ,
+                 phi = phi,
+
+                 or = ,
+                 oddsratio = oddsratio,
+
+                 rr = ,
+                 riskratio = riskratio)
+
+    out <- f(x = model$observed, ...)
     return(out)
   } else if (grepl("One-way", model$method)) {
-    # message("Using F_to_eta2/epsilon2/omega2().")
-    out <- .F_to_pve(
-      model$statistic,
-      model$parameter[1],
-      model$parameter[2],
+    if (grepl("not assuming", model$method, fixed = TRUE)) {
+      warning("Approximating effect size.", call. = FALSE)
+    }
+
+    if (is.null(type)) type <- "eta"
+
+    f <- switch (tolower(type),
+                 eta = ,
+                 eta2 = ,
+                 eta_squared = F_to_eta2,
+
+                 epsilon = ,
+                 epsilon2 = ,
+                 epsilon_squared = F_to_epsilon2,
+
+                 omega = ,
+                 omega2 = ,
+                 omega_squared = F_to_omega2,
+
+                 f = ,
+                 cohens_f = F_to_f,
+
+                 f2 = ,
+                 f_squared = ,
+                 cohens_f2 = F_to_f2)
+
+    out <- f(
+      f = model$statistic,
+      df = model$parameter[1],
+      df_error = model$parameter[2],
       ...
     )
+    colnames(out)[1] <- sub("_partial", "", colnames(out)[1])
     return(out)
   } else if (grepl("McNemar", model$method)) {
     stop("Cannot extract Cohen's g from an 'htest' object.",
@@ -132,17 +162,36 @@ effectsize.htest <- function(model, ...) {
 }
 
 #' @export
+#' @rdname effectsize
 #' @importFrom insight get_data get_parameters
 #' @importFrom bayestestR describe_posterior
-effectsize.BFBayesFactor <- function(model, ...){
+effectsize.BFBayesFactor <- function(model, type = NULL, ...){
   if (!requireNamespace("BayesFactor")) {
     stop("This function requires 'BayesFactor' to work. Please install it.")
   }
 
-  if (length(model) > 1)
+  if (length(model) > 1) {
     warning("Multiple models detected. Using first only.", call. = FALSE)
+    model <- model[1]
+  }
 
   if (inherits(model@numerator[[1]], "BFcontingencyTable")) {
+    if (is.null(type)) type <- "cramers_v"
+
+    f <- switch (tolower(type),
+                 v = ,
+                 cramers_v = cramers_v,
+
+                 w = ,
+                 cohens_w = ,
+                 phi = phi,
+
+                 or = ,
+                 oddsratio = oddsratio,
+
+                 rr = ,
+                 riskratio = riskratio)
+
     data <- insight::get_data(model)
     N <- sum(data)
     cells <- prod(dim(data))
@@ -153,20 +202,21 @@ effectsize.BFBayesFactor <- function(model, ...){
       posts <- posts * N
     }
 
-    V <- apply(posts, 1, function(a) {
-      cramers_v(matrix(a, nrow = nrow(data)), ci = NULL)[[1]]
+    ES <- apply(posts, 1, function(a) {
+      f(matrix(a, nrow = nrow(data)), ci = NULL)[[1]]
     })
 
-    res <- data.frame(Cramers_v = V)
+    res <- data.frame(ES)
+    colnames(res) <- colnames(f(matrix(posts[1,], nrow = nrow(data)), ci = NULL))
   } else if (inherits(model@numerator[[1]], c("BFoneSample", "BFindepSample"))) {
     D <- as.matrix(BayesFactor::posterior(model, iterations = 4000, progress = FALSE))[,"delta"]
     res <- data.frame(Cohens_d = D)
   } else if (inherits(model@numerator[[1]], "BFcorrelation")) {
     rho <- insight::get_parameters(model)[["rho"]]
     res <- data.frame(r = rho)
-  # } else if (inherits(model@numerator[[1]], "BFproportion")) {
-  #   p <- as.matrix(BayesFactor::posterior(model, iterations = 4000))[,"p"]
-  #   res <- data.frame(p = p)
+  } else if (inherits(model@numerator[[1]], "BFproportion")) {
+    p <- as.matrix(BayesFactor::posterior(model, iterations = 4000))[,"p"]
+    res <- data.frame(p = p)
   } else {
     stop("No effect size for this type of BayesFactor object.")
   }
@@ -176,12 +226,34 @@ effectsize.BFBayesFactor <- function(model, ...){
 
 
 #' @export
-effectsize.anova <- function(model, ...) {
-  # message("Using eta_squared().")
-  eta_squared(model, ...)
+effectsize.anova <- function(model, type = NULL, ...) {
+  if (is.null(type)) type <- "eta"
+
+  f <- switch (tolower(type),
+               eta = ,
+               eta2 = ,
+               eta_squared = eta_squared,
+
+               epsilon = ,
+               epsilon2 = ,
+               epsilon_squared = epsilon_squared,
+
+               omega = ,
+               omega2 = ,
+               omega_squared = omega_squared,
+
+               f = ,
+               cohens_f = cohens_f,
+
+               f2 = ,
+               f_squared = ,
+               cohens_f2 = cohens_f2)
+
+  f(model, ...)
 }
 
 #' @export
+#' @rdname effectsize
 effectsize.aov <- effectsize.anova
 
 #' @export