Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Add effect size (Cohen's d) to estimate_contrasts #227

Draft
wants to merge 9 commits into
base: main
Choose a base branch
from
2 changes: 1 addition & 1 deletion DESCRIPTION
Original file line number Diff line number Diff line change
Expand Up @@ -68,7 +68,7 @@ VignetteBuilder:
knitr
Encoding: UTF-8
Language: en-US
RoxygenNote: 7.2.3.9000
RoxygenNote: 7.2.3
Config/testthat/edition: 3
Config/testthat/parallel: true
Roxygen: list(markdown = TRUE)
Expand Down
25 changes: 25 additions & 0 deletions R/estimate_contrasts.R
Original file line number Diff line number Diff line change
Expand Up @@ -135,6 +135,31 @@ estimate_contrasts <- function(model,
contrasts$contrast <- NULL
contrasts <- cbind(level_cols, contrasts)

# Add effect size (Cohen's d)
if (is.null(contrast) && is.null(fixed) && is.null(at)) {
dat <- insight::get_data(model)
resp <- insight::find_response(model)

if (is.numeric(dat[[resp]])) {
dat <- datawizard::data_select(dat, c(resp, info$contrast))

list.dat <- lapply(seq_len(nrow(contrasts)), function(i) {
log.vec <- which(dat[[info$contrast]] == unlist(info$misc$orig.grid)[[i]])
dat.temp <- datawizard::data_filter(dat, log.vec)
})
list.dat <- stats::setNames(list.dat, unique(unlist(level_cols)))

eff <- lapply(seq_len(nrow(contrasts)), function(i) {
effectsize::cohens_d(x = list.dat[[contrasts$Level1[i]]][[resp]],
rempsyc marked this conversation as resolved.
Show resolved Hide resolved
y = list.dat[[contrasts$Level2[i]]][[resp]],
verbose = FALSE)
})

eff <- do.call(rbind, eff)
names(eff)[-1] <- paste0("Cohens_d_", names(eff)[-1])
contrasts <- cbind(contrasts, eff)
}
}

# Table formatting
attr(contrasts, "table_title") <- c("Marginal Contrasts Analysis", "blue")
Expand Down
22 changes: 11 additions & 11 deletions tests/testthat/test-estimate_contrasts.R
Original file line number Diff line number Diff line change
Expand Up @@ -8,7 +8,7 @@ test_that("estimate_contrasts - Frequentist", {
model <- lm(Sepal.Width ~ Species, data = dat)

estim <- suppressMessages(estimate_contrasts(model))
expect_equal(dim(estim), c(3, 9))
expect_equal(dim(estim), c(3, 13))

estim <- suppressMessages(estimate_contrasts(model, at = "Species=c('versicolor', 'virginica')"))
expect_equal(dim(estim), c(1, 9))
Expand All @@ -21,16 +21,16 @@ test_that("estimate_contrasts - Frequentist", {
model <- lm(Sepal.Width ~ Species * fac, data = dat)

estim <- suppressMessages(estimate_contrasts(model))
expect_equal(dim(estim), c(3, 9))
expect_equal(dim(estim), c(3, 13))
estim <- suppressMessages(estimate_contrasts(model, levels = "Species"))
expect_equal(dim(estim), c(3, 9))
expect_equal(dim(estim), c(3, 13))
estim <- suppressMessages(estimate_contrasts(model, fixed = "fac"))
expect_equal(dim(estim), c(3, 10))

# One factor and one continuous
model <- lm(Sepal.Width ~ Species * Petal.Width, data = iris)
estim <- suppressMessages(estimate_contrasts(model))
expect_equal(dim(estim), c(3, 9))
expect_equal(dim(estim), c(3, 13))
estim <- suppressMessages(estimate_contrasts(model, fixed = "Petal.Width"))
expect_equal(dim(estim), c(3, 10))
estim <- suppressMessages(estimate_contrasts(model, at = "Petal.Width", length = 4))
Expand Down Expand Up @@ -84,7 +84,7 @@ test_that("estimate_contrasts - Frequentist", {

model <- lme4::lmer(Sepal.Width ~ Species + (1 | Petal.Length_factor), data = data)
estim <- suppressMessages(estimate_contrasts(model))
expect_equal(dim(estim), c(3, 9))
expect_equal(dim(estim), c(3, 13))


# GLM - binomial
Expand All @@ -107,7 +107,7 @@ test_that("estimate_contrasts - Frequentist", {
model <- glm(counts ~ treatment, data = dat, family = poisson())

estim <- suppressMessages(estimate_contrasts(model, transform = "response"))
expect_equal(dim(estim), c(3, 9))
expect_equal(dim(estim), c(3, 13))
})


Expand Down Expand Up @@ -145,7 +145,7 @@ test_that("estimate_contrasts - Bayesian", {
)
)
estim <- suppressMessages(estimate_contrasts(model))
expect_equal(dim(estim), c(3, 7))
expect_equal(dim(estim), c(3, 11))
estim <- suppressMessages(estimate_contrasts(model, fixed = "Petal.Width"))
expect_equal(dim(estim), c(3, 8))
estim <- suppressMessages(estimate_contrasts(model, at = "Petal.Width", length = 4))
Expand All @@ -161,14 +161,14 @@ test_that("estimate_contrasts - Bayesian", {
))

estim <- suppressMessages(estimate_contrasts(model))
expect_equal(dim(estim), c(3, 7))
expect_equal(dim(estim), c(3, 11))
estim <- suppressMessages(estimate_contrasts(model, transform = "response"))
expect_equal(dim(estim), c(3, 7))
expect_equal(dim(estim), c(3, 11))

estim <- suppressWarnings(suppressMessages(estimate_contrasts(model, test = "bf")))
expect_equal(dim(estim), c(3, 6))
expect_equal(dim(estim), c(3, 10))
estim <- suppressWarnings(suppressMessages(estimate_contrasts(model, transform = "response", test = "bf")))
expect_equal(dim(estim), c(3, 6))
expect_equal(dim(estim), c(3, 10))
})


Expand Down