Nothing
context("nse")
x <- Out(a2l(replicate(50, matrix(1:4, 2, 2))),
fac=dplyr::tibble(a=rep(letters[1:5], 10),
b=rep(LETTERS[1:5], each=10)))
test_that("fac_dispatcher works fine", {
bot <- mutate(bot, s=rnorm(40), fake=factor(rep(letters[1:4], 10)))
# factor, on the fly
expect_true(fac_dispatcher(bot, factor(rep(letters[1:4], 10))) %>% is.factor)
# column id
expect_true(fac_dispatcher(bot, 1) %>% is.factor)
# column name
expect_true(fac_dispatcher(bot, "type") %>% is.factor)
# same, numeric case
expect_true(fac_dispatcher(bot, "s") %>% is.numeric)
# formula interface
expect_true(fac_dispatcher(bot, ~type) %>% is.factor)
# formula interface + interaction on the fly
expect_true(fac_dispatcher(bot, ~type+fake) %>% is.factor)
})
# prepare_fac -----
# test_that("prepare_fac works fine", {
# olea$fac$fake <- rnorm(length(olea))
# # Valid ways below ------
# # nothing
# expect_null(prepare_fac(olea))
# # column id
# expect_identical(prepare_fac(olea, 2), olea$fac[, 2])
# # column name
# expect_identical(prepare_fac(olea, "domes"), olea$fac[, "domes"])
# # column name NSE, unquoted
# expect_identical(prepare_fac(olea, domes), olea$fac$domes)
# # formula style
# expect_identical(prepare_fac(olea, ~domes), olea$fac$domes)
# # formula + interactions
# expect_identical(prepare_fac(olea, ~domes+var), with(olea$fac, interaction(domes, var)))
# # factor on the fly
# f <- factor(rep(letters[1:7], each=30))
# expect_identical(prepare_fac(olea, f), f)
# # numeric on the fly
# n <- rnorm(length(olea))
# expect_identical(prepare_fac(olea, n), n)
# # non-valid ways
# data(olea)
# # non-existing column
# expect_error(prepare_fac(olea, 84))
# # non existing column name
# expect_error(prepare_fac(olea, "rock_and_roll"))
# # also, formula style
# expect_error(prepare_fac(olea, ~rock_and_roll))
# # passing a factor of the wrong length
# expect_error(prepare_fac(olea, factor(rep(letters[1:7], each=10))))
# # passing a numeric of the wrong length
# expect_error(prepare_fac(olea, rnorm(70)))
# })
# dplyr verbs -------
test_that("select works fine",{
nc <- function(x) ncol(x$fac)
expect_equal(select(olea, 1) %>% nc, 1)
expect_equal(select(olea, 1:2) %>% nc, 2)
expect_equal(select(olea, var) %>% nc, 1)
expect_equal(select(olea, var, domes) %>% nc, 2)
expect_equal(select(olea, -(1:2)) %>% nc, nc(olea)-2)
})
test_that("filter works fine",{
expect_equal(length(filter(x, a=="a")) , 10)
expect_equal(length(filter(x, a %in% c("a", "b"))) , 20)
expect_equal(length(filter(x, !(a %in% c("a", "b")))) , 30)
# only two rows in the fac, both with {a; B}
x_lite <-filter(x, a=="a", b=="B")
expect_equal(length(x_lite), 2)
# test for the dropping of factor levels
expect_true(all(sapply(x_lite$fac, function(.x) length(unique(.x)))==1))
})
# rename
# mutate
# trnsmute
# arrange
# slice
test_that("slice works fine",{
expect_true(x %>% slice(0) %>% verify %>% is_Out())
expect_true(x %>% slice(1) %>% verify %>% is_Out())
expect_true(x %>% slice(-1) %>% verify %>% is_Out())
expect_true(x %>% slice(1:5) %>% verify %>% is_Out())
expect_true(x %>% slice(-(1:5)) %>% verify %>% is_Out())
expect_true(x %>% slice(sample(c(TRUE, FALSE), length(.), rep=T)) %>% is_Out())
})
# sample_n
test_that("sample_n works fine", {
expect_equal(sample_n(x, 0) %>% length(), 0)
expect_equal(sample_n(x, 5) %>% length(), 5)
})
# sample_frac
test_that("sample_frac works fine", {
expect_equal(sample_frac(x, 0) %>% length(), 0)
expect_equal(sample_frac(x, 0.5) %>% length(), length(x)/2)
expect_equal(sample_frac(x, 1) %>% length(), length(x))
})
# chop
test_that("chop works fine",{
expect_true(chop(x, ~a) %>% is.list())
expect_equal(chop(x, ~a) %>% length, 5)
expect_true(chop(x, "a") %>% sapply(is_Out) %>% all)
})
# combine
test_that("combine works fine", {
expect_true(chop(x, ~a) %>% combine %>% is_Out())
expect_equal(chop(x, ~a) %>% combine %>% length(), length(x))
})
# dissolve
test_that("dissolve works fine", {
bw <- bot %>% chop(~type) %>% lapply(efourier, 10) %>% combine
expect_true(bw %>% is_OutCoe())
expect_equal(ncol(bw$coe), 80)
expect_true(bw %>% dissolve(1) %>% is_OutCoe())
expect_equal(bw %>% dissolve(1) %$% ncol(coe), 40)
})
# subsetize
test_that("subsetize works fine", {
expect_equal(subsetize(bot, type=="whisky") %>% length, 20)
expect_equal(subsetize(bot, type!="whisky") %>% length, 20)
expect_equal(subsetize(bot, 1:5) %>% length, 5)
expect_equal(subsetize(bot, -(1:5)) %>% length, 35)
})
# rw
# test_that("rw_rule works fine", {
# expect_equal(rw_fac(x, "b", "C", "foo")$a %>% unique(), c("A", "B", "D", "E", "foo"))
# })
# at_least
xx <- Out(a2l(replicate(50, matrix(1:4, 2, 2))),
fac=dplyr::tibble(a=rep(letters[1:5], 10),
b=factor(c(rep(LETTERS[1], 5),
rep(LETTERS[2], 10),
rep(LETTERS[3], 15),
rep(LETTERS[4], 20)))))
test_that("at_least works fine", {
expect_equal(at_least(xx, "b", 5)$b %>% unique() %>% length(), 4)
expect_equal(at_least(xx, "b", 6)$b %>% unique() %>% length(), 3)
expect_equal(at_least(xx, "b", 20)$b %>% unique() %>% length(), 1)
expect_equal(at_least(xx, "b", 50)$b %>% unique() %>% length(), 0)
expect_message(at_least(xx, "b", 50)$b %>% unique() %>% length())
})
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.