Nothing
hyp_prop <- mtcars_df %>%
specify(response = am, success = "1") %>%
hypothesize(null = "point", p = .5)
hyp_diff_in_props <- mtcars_df %>%
specify(am ~ vs, success = "1") %>%
hypothesize(null = "independence")
hyp_chisq_gof <- mtcars_df %>%
specify(response = cyl) %>%
hypothesize(null = "point", p = c("4" = 1/3, "6" = 1/3, "8" = 1/3))
hyp_chisq_ind <- mtcars_df %>%
specify(cyl ~ vs) %>%
hypothesize(null = "independence")
hyp_mean <- mtcars_df %>%
specify(response = mpg) %>%
hypothesize(null = "point", mu = 3)
hyp_median <- mtcars_df %>%
specify(response = mpg) %>%
hypothesize(null = "point", med = 3)
hyp_sd <- mtcars_df %>%
specify(response = mpg) %>%
hypothesize(null = "point", sigma = 7)
hyp_diff_in_means <- mtcars_df %>%
specify(mpg ~ vs) %>%
hypothesize(null = "independence")
hyp_anova <- mtcars_df %>%
specify(mpg ~ cyl) %>%
hypothesize(null = "independence")
test_that("cohesion with type argument", {
expect_snapshot(res_ <- generate(hyp_prop, type = "bootstrap"))
expect_silent(generate(hyp_diff_in_props, type = "bootstrap"))
expect_snapshot(res_ <- generate(hyp_chisq_gof, type = "bootstrap"))
expect_silent(generate(hyp_chisq_ind, type = "bootstrap"))
expect_silent(generate(hyp_mean, type = "bootstrap"))
expect_silent(generate(hyp_median, type = "bootstrap"))
expect_silent(generate(hyp_sd, type = "bootstrap"))
expect_silent(generate(hyp_diff_in_means, type = "bootstrap"))
expect_silent(generate(hyp_anova, type = "bootstrap"))
expect_silent(generate(hyp_prop, type = "draw"))
expect_snapshot(res_ <- generate(hyp_diff_in_props, type = "draw"))
expect_silent(generate(hyp_chisq_gof, type = "draw"))
expect_snapshot(res_ <- generate(hyp_chisq_ind, type = "draw"))
expect_snapshot(error = TRUE,
res_ <- generate(hyp_mean, type = "draw")
)
expect_snapshot(res_ <- generate(hyp_diff_in_means, type = "draw"))
expect_snapshot(res_ <- generate(hyp_anova, type = "draw"))
expect_snapshot(error = TRUE,
res_ <- generate(hyp_prop, type = "permute")
)
expect_silent(generate(hyp_diff_in_props, type = "permute"))
expect_snapshot(error = TRUE,
res_ <- generate(hyp_chisq_gof, type = "permute")
)
expect_silent(generate(hyp_chisq_ind, type = "permute"))
expect_snapshot(error = TRUE,
res_ <- generate(hyp_mean, type = "permute")
)
expect_silent(generate(hyp_diff_in_means, type = "permute"))
expect_silent(generate(hyp_anova, type = "permute"))
})
test_that("sensible output", {
expect_equal(
nrow(mtcars_df) * 500,
nrow(generate(hyp_prop, reps = 500, type = "draw"))
)
expect_silent(generate(hyp_mean, reps = 1, type = "bootstrap"))
expect_snapshot(error = TRUE, generate(hyp_mean, reps = 1, type = "other"))
expect_equal(class(generate(hyp_mean, type = "bootstrap"))[1], "infer")
})
test_that("auto `type` works (generate)", {
one_mean <- mtcars_df %>%
specify(response = mpg) %>% # formula alt: mpg ~ NULL
hypothesize(null = "point", mu = 25) %>%
generate(reps = 100)
one_nonshift_mean <- mtcars_df %>%
specify(response = mpg) %>%
generate(reps = 100)
one_median <- mtcars_df %>%
specify(response = mpg) %>% # formula alt: mpg ~ NULL
hypothesize(null = "point", med = 26) %>%
generate(reps = 100)
one_prop <- mtcars_df %>%
specify(response = am, success = "1") %>% # formula alt: am ~ NULL
hypothesize(null = "point", p = .25) %>%
generate(reps = 100)
two_props <- mtcars_df %>%
specify(am ~ vs, success = "1") %>% # alt: response = am, explanatory = vs
hypothesize(null = "independence") %>%
generate(reps = 100)
gof_chisq <- mtcars_df %>%
specify(cyl ~ NULL) %>% # alt: response = cyl
hypothesize(null = "point", p = c("4" = .5, "6" = .25, "8" = .25)) %>%
generate(reps = 100)
indep_chisq <- mtcars_df %>%
specify(cyl ~ am) %>% # alt: response = cyl, explanatory = am
hypothesize(null = "independence") %>%
generate(reps = 100)
two_means <- mtcars_df %>%
specify(mpg ~ am) %>% # alt: response = mpg, explanatory = am
hypothesize(null = "independence") %>%
generate(reps = 100)
anova_f <- mtcars_df %>%
specify(mpg ~ cyl) %>% # alt: response = mpg, explanatory = cyl
hypothesize(null = "independence") %>%
generate(reps = 100)
slopes <- mtcars_df %>%
specify(mpg ~ hp) %>% # alt: response = mpg, explanatory = cyl
hypothesize(null = "independence") %>%
generate(reps = 100)
one_nonshift_prop <- mtcars_df %>%
specify(response = am, success = "1") %>%
generate(reps = 100)
two_means_boot <- mtcars_df %>%
specify(mpg ~ am) %>%
generate(reps = 100)
two_props_boot <- mtcars_df %>%
specify(am ~ vs, success = "1") %>%
generate(reps = 100)
slope_boot <- mtcars_df %>%
specify(mpg ~ hp) %>%
generate(reps = 100)
expect_equal(attr(one_mean, "type"), "bootstrap")
expect_equal(attr(one_nonshift_mean, "type"), "bootstrap")
expect_equal(attr(one_median, "type"), "bootstrap")
expect_equal(attr(one_prop, "type"), "draw")
expect_equal(attr(two_props, "type"), "permute")
expect_equal(attr(gof_chisq, "type"), "draw")
expect_equal(attr(indep_chisq, "type"), "permute")
expect_equal(attr(two_means, "type"), "permute")
expect_equal(attr(anova_f, "type"), "permute")
expect_equal(attr(slopes, "type"), "permute")
expect_equal(attr(one_nonshift_prop, "type"), "bootstrap")
expect_equal(attr(two_means_boot, "type"), "bootstrap")
expect_equal(attr(two_props_boot, "type"), "bootstrap")
expect_equal(attr(slope_boot, "type"), "bootstrap")
expect_snapshot(error = TRUE,
mtcars_df %>%
specify(response = mpg) %>% # formula alt: mpg ~ NULL
hypothesize(null = "point", mu = 25) %>%
generate(reps = 100, type = "permute")
)
expect_snapshot(
res_ <- mtcars_df %>%
specify(response = mpg) %>%
generate(reps = 100, type = "draw")
)
expect_snapshot(error = TRUE,
res_ <- mtcars_df %>%
specify(response = mpg) %>% # formula alt: mpg ~ NULL
hypothesize(null = "point", med = 26) %>%
generate(reps = 100, type = "permute")
)
expect_snapshot(
res_ <- mtcars_df %>%
specify(response = am, success = "1") %>% # formula alt: am ~ NULL
hypothesize(null = "point", p = .25) %>%
generate(reps = 100, type = "bootstrap")
)
expect_silent(mtcars_df %>%
specify(am ~ vs, success = "1") %>% # alt: response = am, explanatory = vs
hypothesize(null = "independence") %>%
generate(reps = 100, type = "bootstrap")
)
expect_snapshot(
res_ <- mtcars_df %>%
specify(cyl ~ NULL) %>% # alt: response = cyl
hypothesize(null = "point", p = c("4" = .5, "6" = .25, "8" = .25)) %>%
generate(reps = 100, type = "bootstrap")
)
expect_snapshot(
res_ <- mtcars_df %>%
specify(cyl ~ am) %>% # alt: response = cyl, explanatory = am
hypothesize(null = "independence") %>%
generate(reps = 100, type = "draw")
)
expect_silent(mtcars_df %>%
specify(mpg ~ am) %>% # alt: response = mpg, explanatory = am
hypothesize(null = "independence") %>%
generate(reps = 100, type = "bootstrap"))
expect_silent(
mtcars_df %>%
specify(mpg ~ am) %>% # alt: response = mpg, explanatory = am
generate(reps = 100, type = "bootstrap")
)
expect_snapshot(
res_ <- mtcars_df %>%
specify(mpg ~ cyl) %>% # alt: response = mpg, explanatory = cyl
hypothesize(null = "independence") %>%
generate(reps = 100, type = "draw")
)
expect_silent(mtcars_df %>%
specify(mpg ~ hp) %>% # alt: response = mpg, explanatory = cyl
hypothesize(null = "independence") %>%
generate(reps = 100, type = "bootstrap")
)
expect_snapshot(
res_ <- mtcars_df %>%
specify(response = am, success = "1") %>%
generate(reps = 100, type = "draw")
)
expect_snapshot(error = TRUE,
res_ <- mtcars_df %>%
specify(mpg ~ am) %>%
generate(reps = 100, type = "permute")
)
expect_snapshot(
res_ <- mtcars_df %>%
specify(am ~ vs, success = "1") %>%
generate(reps = 100, type = "draw")
)
expect_snapshot(
res_ <- mtcars_df %>%
specify(mpg ~ hp) %>%
generate(reps = 100, type = "draw")
)
})
test_that("mismatches lead to error", {
expect_snapshot(error = TRUE,
res_ <- mtcars_df %>% generate(reps = 10, type = "permute")
)
expect_snapshot(error = TRUE,
res_ <- mtcars_df %>%
specify(am ~ NULL, success = "1") %>%
hypothesize(null = "independence", p = c("1" = 0.5)) %>%
generate(reps = 100, type = "draw")
)
expect_snapshot(
res_ <- mtcars_df %>%
specify(cyl ~ NULL) %>% # alt: response = cyl
hypothesize(
null = "point", p = c("4" = .5, "6" = .25, "8" = .25)
) %>%
generate(reps = 100, type = "bootstrap"))
expect_snapshot(error = TRUE,
res_ <- mtcars_df %>% specify(mpg ~ hp) %>% generate(reps = 100, type = "other")
)
})
test_that("generate() handles `NULL` value of `type`", {
expect_snapshot(
res_ <- generate(hyp_prop, type = NULL)
)
})
test_that("generate() handles `x` response", {
expect_named(
data.frame(x = factor(rbinom(100, size = 1, prob = .5))) %>%
specify(response = x, success = "1") %>%
hypothesize(null = "point", p = .5) %>%
generate(reps = 100, type = "draw"),
c("x", "replicate")
)
expect_named(
data.frame(category = c(rep(c("A", "B"), each = 5)), x = 1:10) %>%
specify(explanatory = category, response = x) %>%
hypothesize(null = "independence") %>%
generate(reps = 5, type = "permute"),
c("x", "category", "replicate")
)
})
test_that("generate() can permute with multiple explanatory variables", {
# if the y variable is the one being permuted and the x's
# are being left alone, then each age + college combination
# should exist in every replicate
expect_true(
gss %>%
# add random noise to make the variable truly continuous
dplyr::mutate(age = age + rnorm(nrow(gss))) %>%
specify(hours ~ age + college) %>%
hypothesize(null = "independence") %>%
generate(reps = 3, type = "permute") %>%
dplyr::ungroup() %>%
dplyr::count(age, college) %>%
dplyr::pull(n) %>%
`==`(3) %>%
all()
)
x <- gss %>%
specify(hours ~ age + college) %>%
hypothesize(null = "independence") %>%
generate(reps = 3, type = "permute")
expect_true(inherits(x, "infer"))
expect_true(inherits(explanatory_variable(x), "tbl_df"))
expect_true(inherits(explanatory_name(x), "character"))
expect_true(inherits(explanatory_expr(x), "call"))
expect_equal(explanatory_name(x), c("age", "college"))
expect_equal(response_name(x), "hours")
expect_equal(nrow(x), 1500)
expect_equal(ncol(x), 4)
})
test_that("generate is sensitive to the variables argument", {
# default argument works appropriately
expect_equal({
set.seed(1)
gss[1:10,] %>%
specify(hours ~ age + college) %>%
hypothesize(null = "independence") %>%
generate(reps = 2, type = "permute")
}, {
set.seed(1)
gss[1:10,] %>%
specify(hours ~ age + college) %>%
hypothesize(null = "independence") %>%
generate(reps = 2, type = "permute", variables = hours)
})
# permuting changes output
expect_silent(
perm_age <- gss[1:10,] %>%
specify(hours ~ age + college) %>%
hypothesize(null = "independence") %>%
generate(reps = 2, type = "permute", variables = age)
)
expect_false(all(perm_age$age[1:10] == perm_age$age[11:20]))
expect_true(all(perm_age$hours[1:10] == perm_age$hours[11:20]))
expect_true(all(perm_age$college[1:10] == perm_age$college[11:20]))
expect_silent(
perm_college <- gss[1:10,] %>%
specify(hours ~ age + college) %>%
hypothesize(null = "independence") %>%
generate(reps = 2, type = "permute", variables = college)
)
expect_true(all(perm_college$age[1:10] == perm_college$age[11:20]))
expect_true(all(perm_college$hours[1:10] == perm_college$hours[11:20]))
expect_false(all(perm_college$college[1:10] == perm_college$college[11:20]))
expect_silent(
perm_college_age <- gss[1:10,] %>%
specify(hours ~ age + college) %>%
hypothesize(null = "independence") %>%
generate(reps = 2, type = "permute", variables = c(college, age))
)
expect_false(all(perm_college_age$age[1:10] == perm_college_age$age[11:20]))
expect_true(all(perm_college_age$hours[1:10] == perm_college_age$hours[11:20]))
expect_false(all(perm_college_age$college[1:10] == perm_college_age$college[11:20]))
# interaction effects are ignored
expect_equal({
set.seed(1)
expect_message(
res_1 <- gss[1:10,] %>%
specify(hours ~ age + college) %>%
hypothesize(null = "independence") %>%
generate(reps = 2, type = "permute", variables = c(hours, age*college))
)
res_1
}, {
set.seed(1)
gss[1:10,] %>%
specify(hours ~ age + college) %>%
hypothesize(null = "independence") %>%
generate(reps = 2, type = "permute", variables = hours)
})
})
test_that("variables argument prompts when it ought to", {
expect_snapshot(error = TRUE,
res_ <- gss[1:10,] %>%
specify(hours ~ age + college) %>%
hypothesize(null = "independence") %>%
generate(reps = 2, type = "permute", variables = c(howdy))
)
expect_snapshot(error = TRUE,
res <- gss[1:10,] %>%
specify(hours ~ age + college) %>%
hypothesize(null = "independence") %>%
generate(reps = 2, type = "permute", variables = c(howdy, doo))
)
expect_snapshot(
res_ <- gss[1:10,] %>%
specify(hours ~ NULL) %>%
hypothesize(null = "point", mu = 40) %>%
generate(reps = 2, type = "bootstrap", variables = c(hours))
)
expect_snapshot(error = TRUE,
res_ <- gss[1:10,] %>%
specify(hours ~ age + college) %>%
hypothesize(null = "independence") %>%
generate(reps = 2, type = "permute", variables = "hours")
)
expect_snapshot(
res_ <- gss[1:10,] %>%
specify(hours ~ age + college + age*college) %>%
hypothesize(null = "independence") %>%
generate(reps = 2, type = "permute", variables = age*college)
)
expect_snapshot(
res_ <- gss[1:10,] %>%
specify(hours ~ age + college + age*college) %>%
hypothesize(null = "independence") %>%
generate(reps = 2, type = "permute", variables = c(hours, age*college))
)
expect_silent(
gss[1:10,] %>%
specify(hours ~ age + college + age*college) %>%
hypothesize(null = "independence") %>%
generate(reps = 2, type = "permute", variables = c(hours))
)
expect_silent(
gss[1:10,] %>%
specify(hours ~ age + college + age*college) %>%
hypothesize(null = "independence") %>%
generate(reps = 2, type = "permute")
)
expect_silent(
gss[1:10,] %>%
specify(hours ~ age + college) %>%
hypothesize(null = "independence") %>%
generate(reps = 2, type = "permute")
)
# warn on type != permute but don't raise message re: interaction
# effects unless otherwise used appropriately
expect_snapshot(
res_ <- gss[1:10,] %>%
specify(hours ~ age*college) %>%
generate(
reps = 2,
type = "bootstrap",
variables = c(hours, age*college)
)
)
})
test_that("type = 'draw'/'simulate' superseding handled gracefully", {
# message on type = 'simulate'
expect_snapshot(
res_ <- mtcars_df %>%
specify(response = am, success = "1") %>%
hypothesize(null = "point", p = .5) %>%
generate(type = "simulate")
)
# don't message on type = 'draw'
expect_silent(
mtcars_df %>%
specify(response = am, success = "1") %>%
hypothesize(null = "point", p = .5) %>%
generate(type = "draw")
)
# mention new generation types when supplied a bad one
expect_snapshot(error = TRUE,
res_ <- mtcars_df %>%
specify(response = am, success = "1") %>%
hypothesize(null = "point", p = .5) %>%
generate(type = "boop")
)
# warns with either alias when given unexpected generate type
expect_snapshot(error = TRUE,
mtcars_df %>%
specify(response = mpg) %>%
hypothesize(null = "point", mu = 20) %>%
generate(type = "draw")
)
expect_snapshot(error = TRUE,
mtcars_df %>%
specify(response = mpg) %>%
hypothesize(null = "point", mu = 20) %>%
generate(type = "draw")
)
expect_equal(
{
set.seed(1)
expect_message(
res_1 <- mtcars_df %>%
specify(response = am, success = "1") %>%
hypothesize(null = "point", p = .5) %>%
generate(type = "simulate")
)
res_1
}, {
set.seed(1)
res_2 <- mtcars_df %>%
specify(response = am, success = "1") %>%
hypothesize(null = "point", p = .5) %>%
generate(type = "draw")
res_2
},
ignore_attr = TRUE
)
})
test_that("has_p_param handles edge cases", {
x <- NA
set_p_names <- function(x, to) {
attr(x, "params") <- rep(NA, length(to))
names(attr(x, "params")) <- to
x
}
expect_true (has_p_param(set_p_names(x, c("p.boop"))))
expect_true (has_p_param(set_p_names(x, c("p.boop", "p.bop"))))
expect_false(has_p_param(set_p_names(x, c("p.boop", "pbop"))))
expect_false(has_p_param(set_p_names(x, c("p.boop", "bo.p"))))
expect_false(has_p_param(set_p_names(x, c("p.boop", "pbop"))))
expect_false(has_p_param(set_p_names(x, c(".p.boop"))))
expect_false(has_p_param(set_p_names(x, c("beep.boop"))))
})
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.