-
Notifications
You must be signed in to change notification settings - Fork 0
/
simple_effects.R
96 lines (83 loc) · 2.84 KB
/
simple_effects.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
#' Compute Simple Effects Omnibus Tests
#'
#' This is a wrapper for `emmeans::joint_tests()` that provides an easy way to
#' specify which simple effects we wish to test, and within what variable(s).
#'
#' @param model The model.
#' @param effect The name of the required simple effect. e.g., `"A"` for a
#' simple effect of *A*, or `"A:B"` for a simple *A-by-B* interaction.
#' @param inside A vector of the name(s) of the variable(s) within whose levels
#' the `effect` will be tested. Can also be the name of an interaction (e.g.,
#' `"B:C"`). If not specified, will use all the terms not in `effect`.
#' @param ... Passed to `emmeans::joint_tests()`, e.g., `cov.reduce`, `at`, etc.
#'
#'
#' @examplesIf require("ggplot2") && require("insight") && require("stringr")
#' library(afex)
#'
#' data(obk.long, package = "afex")
#' A <- aov_car(value ~ treatment * gender + Error(id / (phase * hour)),
#' data = obk.long
#' )
#'
#' simple_effects(A, effect = "treatment")
#'
#' simple_effects(A, effect = "treatment:phase")
#'
#' simple_effects(A, effect = "phase", inside = "treatment")
#'
#' simple_effects(A, effect = "phase", inside = c("treatment", "gender"))
#' # simple_effects(A, effect = "phase", inside = "treatment:gender") # same
#'
#' simple_effects(A,
#' effect = "phase", inside = c("treatment", "gender"),
#' at = list(gender = "F")
#' )
#'
#' simple_effects(A, effect = "phase:treatment", inside = "gender")
#'
#' @export
simple_effects <- function(model, effect, inside, ...) {
UseMethod("simple_effects")
}
#' @export
simple_effects.lm <- function(model, effect, inside, ...) {
.check_namespace("insight", "emmeans", "stringr")
stopifnot("Effect must me a char of length 1." = is.character(effect) && length(effect) == 1L)
if (missing(effect)) {
stop("'effect' must be specified.")
}
effects <- unique(unlist(stringr::str_split(effect, pattern = ":")))
IVs <- insight::find_predictors(model)[[1]]
if (missing(inside)) {
inside <- setdiff(IVs, effects)
} else {
inside <- unique(unlist(stringr::str_split(inside, pattern = ":")))
}
jt <- emmeans::joint_tests(model, by = inside, ...)
other_ivs <- setdiff(IVs, c(effects, inside))
i <- outer(jt[["model term"]], effects, stringr::str_detect)
i <- apply(i, 1, all)
if (length(other_ivs)) {
iX <- outer(jt[["model term"]], other_ivs, stringr::str_detect)
iX <- apply(iX, 1, any)
i <- i & !iX
}
jt <- jt[i, ]
jt[["model term"]] <- NULL
class(jt) <- c("summary_emm", class(jt))
cl <- quote(stats::update(jt))
cl$by <- if (length(inside) > 1L) utils::tail(inside, -1)
cl$mesg <- paste0(
"Omnibus test for ",
paste0(rep("simple", length(inside)), collapse = "-"),
" effect of ",
effect,
".\n"
)
jt <- eval(cl)
if (length(inside) == 1L) jt <- stats::update(jt, by = NULL)
jt
}
#' @export
simple_effects.afex_aov <- simple_effects.lm