Skip to content

Commit 8041866

Browse files
authored
Merge pull request #281 from tidymodels/t-test-levels
specifying order in difference-based tests (#275)
2 parents ad3d5ce + 5b0a2a7 commit 8041866

File tree

6 files changed

+28
-17
lines changed

6 files changed

+28
-17
lines changed

R/calculate.R

+1-1
Original file line numberDiff line numberDiff line change
@@ -100,7 +100,7 @@ calculate <- function(x,
100100
(attr(x, "theory_type") %in% c("Two sample props z", "Two sample t"))
101101
)
102102
) {
103-
check_order(x, explanatory_variable(x), order)
103+
order <- check_order(x, explanatory_variable(x), order)
104104
}
105105

106106
if (!(

R/utils.R

+17-9
Original file line numberDiff line numberDiff line change
@@ -121,19 +121,25 @@ null_transformer <- function(text, envir) {
121121
}
122122

123123
check_order <- function(x, explanatory_variable, order) {
124-
unique_explanatory_variable <- unique(explanatory_variable)
125-
if (length(unique_explanatory_variable) != 2) {
124+
unique_ex <- sort(unique(explanatory_variable))
125+
if (length(unique_ex) != 2) {
126126
stop_glue(
127127
"Statistic is based on a difference; the explanatory variable should ",
128128
"have two levels."
129129
)
130130
}
131131
if (is.null(order)) {
132-
stop_glue(
133-
"Statistic is based on a difference; specify the `order` in which to ",
134-
"subtract the levels of the explanatory variable. ",
135-
'`order = c("first", "second")` means `("first" - "second")`. ',
136-
"Check `?calculate` for details."
132+
# Default to subtracting the first (alphabetically) level from the second,
133+
# unless the explanatory variable is a factor (in which case order is
134+
# preserved); raise a warning if this was done implicitly.
135+
order <- as.character(unique_ex)
136+
warning_glue(
137+
"The statistic is based on a difference; by default, the ",
138+
"explanatory variable has been subtracted in the order ",
139+
"\"{unique_ex[1]}\" - \"{unique_ex[2]}\". To specify the ",
140+
"order yourself, provide `order = c(\"{unique_ex[1]}\", ",
141+
"\"{unique_ex[2]}\")` (to subtract in the order ",
142+
"\"{unique_ex[1]}\" - \"{unique_ex[2]}\") to the calculate() function."
137143
)
138144
} else {
139145
if (xor(is.na(order[1]), is.na(order[2]))) {
@@ -144,13 +150,15 @@ check_order <- function(x, explanatory_variable, order) {
144150
if (length(order) > 2) {
145151
stop_glue("`order` is expecting only two entries.")
146152
}
147-
if (order[1] %in% unique_explanatory_variable == FALSE) {
153+
if (order[1] %in% unique_ex == FALSE) {
148154
stop_glue("{order[1]} is not a level of the explanatory variable.")
149155
}
150-
if (order[2] %in% unique_explanatory_variable == FALSE) {
156+
if (order[2] %in% unique_ex == FALSE) {
151157
stop_glue("{order[2]} is not a level of the explanatory variable.")
152158
}
153159
}
160+
# return the order as given (unless the argument was invalid or NULL)
161+
order
154162
}
155163

156164
check_args_and_attr <- function(x, explanatory_variable, response_variable,

R/wrappers.R

+2-2
Original file line numberDiff line numberDiff line change
@@ -80,7 +80,7 @@ t_test <- function(x, formula,
8080
# order[2]),
8181
# ordered = TRUE)
8282
# }
83-
check_order(x, explanatory_variable(x), order)
83+
order <- check_order(x, explanatory_variable(x), order)
8484
prelim <- stats::t.test(formula = as.formula(paste0(attr(x, "response"),
8585
" ~ ",
8686
attr(x, "explanatory"))),
@@ -189,7 +189,7 @@ t_stat <- function(x, formula,
189189
# order[2]),
190190
# ordered = TRUE)
191191
# }
192-
check_order(x, explanatory_variable(x), order)
192+
order <- check_order(x, explanatory_variable(x), order)
193193
prelim <- stats::t.test(formula = as.formula(paste0(attr(x, "response"),
194194
" ~ ",
195195
attr(x, "explanatory"))),

tests/testthat.R

+2
Original file line numberDiff line numberDiff line change
@@ -2,3 +2,5 @@ library(testthat)
22
library(infer)
33

44
test_check("infer")
5+
6+

tests/testthat/test-calculate.R

+5-4
Original file line numberDiff line numberDiff line change
@@ -125,7 +125,7 @@ test_that("response variable is a factor (two var problems)", {
125125
expect_silent(
126126
calculate(gen_iris4a, stat = "z", order = c("large", "small"))
127127
)
128-
expect_error(calculate(gen_iris4a, stat = "z"))
128+
expect_warning(calculate(gen_iris4a, stat = "z"))
129129
})
130130

131131
gen_iris5 <- iris %>%
@@ -144,11 +144,11 @@ test_that("two sample mean-type problems are working", {
144144
specify(Sepal.Width ~ Sepal.Length.Group) %>%
145145
hypothesize(null = "independence") %>%
146146
generate(reps = 10, type = "permute")
147-
expect_error(calculate(gen_iris5a, stat = "diff in means"))
147+
expect_warning(calculate(gen_iris5a, stat = "diff in means"))
148148
expect_silent(
149149
calculate(gen_iris5a, stat = "diff in means", order = c(">5", "<=5"))
150150
)
151-
expect_error(calculate(gen_iris5a, stat = "t"))
151+
expect_warning(calculate(gen_iris5a, stat = "t"))
152152
expect_silent(calculate(gen_iris5a, stat = "t", order = c(">5", "<=5")))
153153
})
154154

@@ -270,7 +270,8 @@ test_that("`order` is working", {
270270
calculate(gen_iris11, stat = "diff in means", order = c(">5", "<=4", ">4"))
271271
)
272272
# order not given
273-
expect_error(calculate(gen_iris11, stat = "diff in means"))
273+
expect_warning(calculate(gen_iris11, stat = "diff in means"),
274+
"by default, the explanatory variable has been subtracted")
274275
})
275276

276277
gen_iris12 <- iris %>%

tests/testthat/test-wrappers.R

+1-1
Original file line numberDiff line numberDiff line change
@@ -11,7 +11,7 @@ iris3 <- iris %>%
1111

1212
test_that("t_test works", {
1313
# Two Sample
14-
expect_error(iris2 %>% t_test(Sepal.Width ~ Species))
14+
expect_warning(iris2 %>% t_test(Sepal.Width ~ Species))
1515

1616
expect_error(
1717
iris2 %>% t_test(response = "Sepal.Width", explanatory = "Species")

0 commit comments

Comments
 (0)