# 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", { skip_if(getRversion() < "4.0.0") 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 )) ) })