# t test ---------------
x <- t.test(1:3, c(1, 1:3))
test_that("get_data.t-test", {
expect_identical(colnames(get_data(x)), c("x", "y"))
expect_equal(
get_data(x)$x,
c(1, 2, 3, 1, 1, 2, 3),
ignore_attr = TRUE
)
expect_equal(
get_data(x)$y,
c(1, 1, 1, 2, 2, 2, 2),
ignore_attr = TRUE
)
})
test_that("model_info.t-test", {
expect_true(model_info(x)$is_ttest)
})
# One sample
test_that("get_data.t-test, one-sample", {
tt1 <- t.test(mtcars$mpg)
tt2 <- t.test(mtcars$mpg ~ 1)
expect_equal(
head(get_data(tt1)$mpg),
c(21, 21, 22.8, 21.4, 18.7, 18.1)
)
expect_identical(nrow(get_data(tt1)), 32L)
expect_equal(
head(get_data(tt2)$mpg),
c(21, 21, 22.8, 21.4, 18.7, 18.1)
)
expect_identical(nrow(get_data(tt2)), 32L)
expect_true(model_info(tt1)$is_ttest)
expect_true(model_info(tt2)$is_ttest)
})
# Two sample
test_that("get_data.t-test, two-sample", {
tt3 <- t.test(mtcars$mpg ~ mtcars$am)
tt4 <- t.test(mtcars$mpg[mtcars$am == 0], mtcars$mpg[mtcars$am == 1])
expect_identical(colnames(get_data(tt3)), c("x", "y"))
expect_identical(nrow(get_data(tt3)), 32L)
expect_equal(
head(get_data(tt3)$x),
c(21, 21, 22.8, 21.4, 18.7, 18.1)
)
expect_equal(
head(get_data(tt3)$y),
c(2, 2, 2, 1, 1, 1),
ignore_attr = TRUE
)
expect_identical(colnames(get_data(tt4)), c("x", "y"))
expect_identical(nrow(get_data(tt4)), 32L)
expect_equal(
head(get_data(tt3)$x),
c(21, 21, 22.8, 21.4, 18.7, 18.1)
)
expect_equal(
head(get_data(tt3)$y),
c(2, 2, 2, 1, 1, 1),
ignore_attr = TRUE
)
expect_true(model_info(tt3)$is_ttest)
expect_true(model_info(tt4)$is_ttest)
})
# # Paired
# test_that("get_data.t-test, two-sample", {
# data(sleep)
# sleep <<- sleep
# tt5 <- t.test(sleep$extra ~ sleep$group, paired = TRUE)
# tt6 <- t.test(sleep$extra[sleep$group == "1"], sleep$extra[sleep$group == "2"], paired = TRUE)
# tt7 <- t.test(Pair(sleep$extra[sleep$group == "1"], sleep$extra[sleep$group == "2"]) ~ 1)
# expect_identical(colnames(get_data(tt5)), c("x", "y"))
# expect_equal(
# head(get_data(tt5))$x,
# c(0.7, -1.6, -0.2, -1.2, -0.1, 3.4),
# ignore_attr = TRUE
# )
# expect_equal(
# head(get_data(tt5))$y,
# structure(c(1L, 1L, 1L, 1L, 1L, 1L), levels = c("1", "2"), class = "factor"),
# ignore_attr = TRUE
# )
# expect_identical(colnames(get_data(tt6)), c("x", "y"))
# expect_equal(
# head(get_data(tt6))$x,
# c(0.7, -1.6, -0.2, -1.2, -0.1, 3.4),
# ignore_attr = TRUE
# )
# expect_equal(
# head(get_data(tt6))$y,
# structure(c(1L, 1L, 1L, 1L, 1L, 1L), levels = c("1", "2"), class = "factor"),
# ignore_attr = TRUE
# )
# expect_true(model_info(tt5)$is_ttest)
# expect_true(model_info(tt6)$is_ttest)
# expect_true(model_info(tt7)$is_ttest)
# })
# mcnemar test ---------------
dat <<- matrix(c(794, 86, 150, 570),
nrow = 2,
dimnames = list(
"1st Survey" = c("Approve", "Disapprove"),
"2nd Survey" = c("Approve", "Disapprove")
)
)
m <- mcnemar.test(dat)
test_that("get_data.mcnemar", {
expect_equal(
get_data(m),
structure(c(794, 86, 150, 570),
.Dim = c(2L, 2L),
.Dimnames = list(
`1st Survey` = c("Approve", "Disapprove"),
`2nd Survey` = c("Approve", "Disapprove")
), class = "table"
),
ignore_attr = TRUE
)
})
test_that("model_info.mcnemar-test", {
expect_true(model_info(m)$is_chi2test)
expect_true(model_info(m)$is_xtab)
})
# fisher test ---------------
TeaTasting <<-
matrix(c(3, 1, 1, 3),
nrow = 2,
dimnames = list(
Guess = c("Milk", "Tea"),
Truth = c("Milk", "Tea")
)
)
m <- fisher.test(TeaTasting, alternative = "greater")
test_that("get_data.fisher", {
expect_equal(
get_data(m),
structure(c(3, 1, 1, 3),
.Dim = c(2L, 2L),
.Dimnames = list(
Guess = c("Milk", "Tea"),
Truth = c("Milk", "Tea")
), class = "table"
),
ignore_attr = TRUE
)
})
test_that("model_info.fisher-test", {
expect_true(model_info(m)$is_chi2test)
expect_true(model_info(m)$is_xtab)
})
# friedmann test ---------------
wb <<- aggregate(warpbreaks$breaks,
by = list(
w = warpbreaks$wool,
t = warpbreaks$tension
),
FUN = mean
)
m <- friedman.test(wb$x, wb$w, wb$t)
test_that("get_data.freedman", {
expect_equal(
get_data(m),
data.frame(
x = c(
44.5555555555556, 28.2222222222222, 24,
28.7777777777778, 24.5555555555556, 18.7777777777778
),
w = c(1L, 2L, 1L, 2L, 1L, 2L),
t = c(1L, 1L, 2L, 2L, 3L, 3L)
),
tolerance = 1e-3,
ignore_attr = TRUE
)
})
test_that("model_info.friedman-test", {
expect_true(model_info(m)$is_ranktest)
})
# shapiro test ---------------
set.seed(123)
m <- shapiro.test(rnorm(10, mean = 5, sd = 3))
test_that("get_data.freedman", {
expect_equal(
get_data(m),
data.frame(
x = c(
8.67224539231838, 6.07944148117209, 6.20231435178216,
5.33204814783536, 3.33247659573778, 10.3607394104092, 6.49355143468772,
-0.899851469888914, 7.10406770469106, 3.5816257768162
)
),
tolerance = 1e-3,
ignore_attr = TRUE
)
})
test_that("model_info.shapiro-test", {
expect_true(model_info(m)$is_variancetest)
expect_identical(model_info(m)$family, "shapiro")
})
# kruskal test ---------------
set.seed(123)
d <<- data.frame(
x = sample(1:8, 50, TRUE),
y = sample(1:3, 50, TRUE)
)
test_that("model_info.shapiro-test", {
k1 <- kruskal.test(x ~ y, data = d)
expect_null(get_data(k1))
k2 <- kruskal.test(list(d$x, d$y))
out <- get_data(k2)
expect_identical(
out,
list(x1 = c(
7L, 7L, 3L, 6L, 3L, 2L, 2L, 6L, 3L, 5L, 4L, 6L, 6L,
1L, 2L, 3L, 8L, 5L, 3L, 3L, 1L, 4L, 1L, 1L, 5L, 3L, 8L, 2L, 7L,
2L, 1L, 6L, 3L, 4L, 6L, 1L, 3L, 7L, 5L, 4L, 7L, 8L, 2L, 5L, 7L,
1L, 1L, 2L, 7L, 3L
), x2 = c(
1L, 3L, 1L, 3L, 2L, 1L, 2L, 1L, 1L,
3L, 1L, 2L, 1L, 1L, 3L, 1L, 2L, 1L, 3L, 1L, 3L, 2L, 3L, 2L, 2L,
3L, 2L, 2L, 3L, 3L, 1L, 2L, 2L, 1L, 2L, 1L, 1L, 2L, 3L, 3L, 1L,
2L, 1L, 2L, 1L, 3L, 3L, 2L, 3L, 1L
))
)
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.