Skip to content

Commit

Permalink
add include_intercept
Browse files Browse the repository at this point in the history
  • Loading branch information
mattansb committed Mar 7, 2021
1 parent 1c7544a commit 1446237
Show file tree
Hide file tree
Showing 4 changed files with 120 additions and 19 deletions.
1 change: 1 addition & 0 deletions NEWS.md
Original file line number Diff line number Diff line change
Expand Up @@ -6,6 +6,7 @@

- `unstandardize()` which will reverse the effects of `standardize()`.
- `interpret_kendalls_w()` to interpret Kendall's coefficient of concordance.
- `eta_squared()` family of functions can now also return effect sizes for the intercept by setting `include_intercept = TRUE` ( #156 ).

## Bug fixes

Expand Down
65 changes: 47 additions & 18 deletions R/eta_squared.R
Original file line number Diff line number Diff line change
Expand Up @@ -21,7 +21,9 @@
#' automatically from the fitted model, if they were provided then.
#' @inheritParams chisq_to_phi
#' @inheritParams standardize
#' @param ... For Bayesian models, passed to `ss_function`. Otherwise ignored.
#' @param ... Arguments passed to or from other methods.
#' - Can be `include_intercept = TRUE` to include the effect size for the intercept.
#' - For Bayesian models, arguments passed to `ss_function`.
#'
#' @return
#' A data frame with the effect size(s) between 0-1 (`Eta2`, `Epsilon2`,
Expand Down Expand Up @@ -394,15 +396,16 @@ cohens_f_squared <- function(model, partial = TRUE, ci = 0.9, squared = TRUE,
partial = partial,
generalized = generalized,
ci = ci,
verbose = verbose
verbose = verbose,
...
)
return(res)
}

type <- match.arg(type)

params <- as.data.frame(parameters::model_parameters(model))
.es_aov(params, type, partial, generalized, ci, verbose = verbose)
.es_aov(params, type, partial, generalized, ci, verbose = verbose, ...)
}

#' @keywords internal
Expand All @@ -412,8 +415,9 @@ cohens_f_squared <- function(model, partial = TRUE, ci = 0.9, squared = TRUE,
generalized = FALSE,
ci = 0.9,
verbose = TRUE,
include_intercept = FALSE,
...) {
params <- params[params$Parameter != "(Intercept)", ]

if (!"Residuals" %in% params$Parameter) {
stop(
"No residuals data found - ",
Expand All @@ -422,7 +426,13 @@ cohens_f_squared <- function(model, partial = TRUE, ci = 0.9, squared = TRUE,
)
}

values <- .values_aov(params)
if (include_intercept) {
values <- .values_aov(params[params$Parameter != "(Intercept)", ])
} else {
params <- params[params$Parameter != "(Intercept)", ]
values <- .values_aov(params)
}

df_error <- params$df[params$Parameter == "Residuals"]
params <- params[params$Parameter != "Residuals", , drop = FALSE]

Expand Down Expand Up @@ -539,11 +549,11 @@ cohens_f_squared <- function(model, partial = TRUE, ci = 0.9, squared = TRUE,
generalized = FALSE,
ci = 0.9,
verbose = TRUE,
include_intercept = FALSE,
...) {
type <- match.arg(type)

params <- as.data.frame(parameters::model_parameters(model))
params <- params[params$Parameter != "(Intercept)", ]
if (!"Residuals" %in% params$Parameter) {
stop(
"No residuals data found - ",
Expand All @@ -552,7 +562,13 @@ cohens_f_squared <- function(model, partial = TRUE, ci = 0.9, squared = TRUE,
)
}

values <- .values_aov(params)
if (include_intercept) {
values <- .values_aov(params[params$Parameter != "(Intercept)", ])
} else {
params <- params[params$Parameter != "(Intercept)", ]
values <- .values_aov(params)
}

params <- params[params$Parameter != "Residuals" & !is.na(params$`F`), , drop = FALSE]
Sum_Squares_total <- sum(sapply(values, "[[", "Sum_Squares_total"))
Sum_Squares_residuals <- sapply(values[params$Group], "[[", "Sum_Squares_residuals")
Expand Down Expand Up @@ -676,7 +692,8 @@ cohens_f_squared <- function(model, partial = TRUE, ci = 0.9, squared = TRUE,
partial = partial,
generalized = generalized,
ci = ci,
verbose = verbose
verbose = verbose,
...
)
out <- do.call("rbind", params)
rownames(out) <- NULL
Expand All @@ -697,6 +714,7 @@ cohens_f_squared <- function(model, partial = TRUE, ci = 0.9, squared = TRUE,
generalized = FALSE,
ci = 0.9,
verbose = TRUE,
include_intercept = FALSE,
...) {
type <- match.arg(type)
es_fun <- switch(type,
Expand All @@ -716,11 +734,13 @@ cohens_f_squared <- function(model, partial = TRUE, ci = 0.9, squared = TRUE,
type = type,
generalized = generalized,
ci = ci,
verbose = verbose
verbose = verbose,
include_intercept = include_intercept,
...
)
return(res)
}
model <- model[rownames(model) != "(Intercept)", , drop = FALSE]
if (!include_intercept) model <- model[rownames(model) != "(Intercept)", , drop = FALSE]
model <- model[rownames(model) != "Residuals", , drop = FALSE]

F_val <- F_val[F_val %in% colnames(model)]
Expand Down Expand Up @@ -875,6 +895,7 @@ cohens_f_squared <- function(model, partial = TRUE, ci = 0.9, squared = TRUE,
generalized = FALSE,
ci = 0.9,
verbose = TRUE,
include_intercept = FALSE,
...) {
# ## For the univariate test
# model <- summary(mlm1.aov)$univariate.tests
Expand All @@ -889,7 +910,8 @@ cohens_f_squared <- function(model, partial = TRUE, ci = 0.9, squared = TRUE,
model <- parameters::model_parameters(model, ...)
if ("df_num" %in% colnames(model))
model$df <- model$df_num
model <- model[model$Parameter != "(Intercept)", , drop = FALSE]
if (!include_intercept)
model <- model[model$Parameter != "(Intercept)", , drop = FALSE]
.anova_es.parameters_model(model, type = type,
partial = partial,
generalized = generalized,
Expand Down Expand Up @@ -981,12 +1003,13 @@ cohens_f_squared <- function(model, partial = TRUE, ci = 0.9, squared = TRUE,
generalized = FALSE,
ci = 0.9,
verbose = TRUE,
include_intercept = FALSE,
...) {
type <- match.arg(type)
if (type == "eta" && isTRUE(generalized))
generalized <- attr(model$anova_table, "observed")

# For between, covers all
# For completely between, covers all
if (!inherits(model$Anova, "Anova.mlm")) {
out <-
.anova_es(
Expand All @@ -995,7 +1018,9 @@ cohens_f_squared <- function(model, partial = TRUE, ci = 0.9, squared = TRUE,
partial = partial,
generalized = generalized,
ci = ci,
verbose = verbose
verbose = verbose,
include_intercept = include_intercept,
...
)
return(out)
}
Expand All @@ -1017,7 +1042,8 @@ cohens_f_squared <- function(model, partial = TRUE, ci = 0.9, squared = TRUE,

aov_tab <- anova(model, es = "ges",
observed = generalized,
correction = "none")
correction = "none",
intercept = include_intercept)

ES <- aov_tab$ges
df1 <- aov_tab$`num Df`
Expand Down Expand Up @@ -1057,7 +1083,8 @@ cohens_f_squared <- function(model, partial = TRUE, ci = 0.9, squared = TRUE,
epsilon = F_to_epsilon2
)

aov_tab <- anova(model, es = "none", correction = "none")
aov_tab <- anova(model, es = "none", correction = "none",
intercept = include_intercept)

out <- cbind(
Parameter = rownames(aov_tab),
Expand All @@ -1074,7 +1101,7 @@ cohens_f_squared <- function(model, partial = TRUE, ci = 0.9, squared = TRUE,
return(out)
}

# If not fully between, covers all
# Even if not fully between, covers all
if (!is.null(model$aov)) {
out <-
.anova_es(
Expand All @@ -1083,7 +1110,9 @@ cohens_f_squared <- function(model, partial = TRUE, ci = 0.9, squared = TRUE,
partial = partial,
generalized = FALSE,
ci = ci,
verbose = verbose
verbose = verbose,
include_intercept = include_intercept,
...
)
out <- out[, !colnames(out) == "Group"]
return(out)
Expand Down Expand Up @@ -1130,7 +1159,7 @@ cohens_f_squared <- function(model, partial = TRUE, ci = 0.9, squared = TRUE,

model <- model[rownames(model) != "ERROR", ]

.anova_es.anova(model, type = type, partial = partial, generalized = generalized, ci = ci)
.anova_es.anova(model, type = type, partial = partial, generalized = generalized, ci = ci, ...)
}

.anova_es.anova.rms <- .anova_es.rms
Expand Down
6 changes: 5 additions & 1 deletion man/eta_squared.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

67 changes: 67 additions & 0 deletions tests/testthat/test-eta_squared_etc.R
Original file line number Diff line number Diff line change
Expand Up @@ -332,4 +332,71 @@ if (require("testthat") && require("effectsize")) {
tolerance = 0.01
)
})


# Include intercept -------------------------------------------------------



test_that("include_intercept | car", {
skip_if_not_installed("car")

m <- lm(mpg ~ factor(cyl) * factor(am), data = mtcars)
AOV <- car::Anova(m, type = 3)

res0 <- eta_squared(AOV)
res1 <- eta_squared(AOV, include_intercept = TRUE)
expect_equal(nrow(res0), 3)
expect_equal(nrow(res1), nrow(res0) + 1)
expect_equal(res1[[1]][1], "(Intercept)")
expect_equal(res1[[2]][1], 0.8680899, tolerance = 0.01)

res0 <- epsilon_squared(AOV)
res1 <- epsilon_squared(AOV, include_intercept = TRUE)
expect_equal(nrow(res0), 3)
expect_equal(nrow(res1), nrow(res0) + 1)
expect_equal(res1[[1]][1], "(Intercept)")


res0 <- omega_squared(AOV)
res1 <- omega_squared(AOV, include_intercept = TRUE)
expect_equal(nrow(res0), 3)
expect_equal(nrow(res1), nrow(res0) + 1)
expect_equal(res1[[1]][1], "(Intercept)")

# generalized
res1 <- eta_squared(AOV, generalized = "cyl", include_intercept = TRUE)
expect_equal(res1[[1]][1], "(Intercept)")
expect_equal(res1[[2]][1], 0.784483, tolerance = 0.01)
})


test_that("include_intercept | afex", {
skip_if_not_installed("afex")
data(obk.long, package = "afex")

suppressWarnings(suppressMessages(
a <- aov_car(value ~ treatment * gender + Error(id),
include_aov = TRUE,
data = obk.long)
))

resE0 <- eta_squared(a)
resA0 <- anova(a, es = "pes")
expect_equal(nrow(resE0), 3)
expect_equal(nrow(resE0), nrow(resA0))


resE1 <- eta_squared(a, include_intercept = TRUE)
resA1 <- anova(a, es = "pes", intercept = TRUE)
expect_equal(nrow(resE1), nrow(resE0) + 1)
expect_equal(nrow(resE1), nrow(resA1))

skip_if_not_installed("car")
resE1 <- eta_squared(car::Anova(a$aov, type = 3), include_intercept = TRUE, generalized = "gender")
resA1 <- anova(a, es = "ges", intercept = TRUE, observed = "gender")
expect_equal(resE1[[2]][1], 0.9386555, tolerance = 0.01)
expect_equal(resE1[[2]][1], resA1[[5]][1], tolerance = 0.01)
})

}

0 comments on commit 1446237

Please sign in to comment.