context("data munging helpers")
sample_data <- tibble::tibble(
letter = rep(letters, 5),
color = rep(c("red", "green", "yellow", "orange", "blue"), 26),
value = rnorm(26 * 5)
)
test_that("sample_n_of() samples from n groups", {
four_letters <- sample_n_of(sample_data, 4, letter)
two_colors <- sample_n_of(sample_data, 2, color)
three_letter_colors <- sample_n_of(sample_data, 3, letter, color)
# four letters in five colors
four_letters %>%
expect_nrow(4 * 5) %>%
dplyr::distinct(letter) %>%
expect_nrow(4)
# two colors in 26 letters
two_colors %>%
expect_nrow(2 * 26) %>%
dplyr::distinct(color) %>%
expect_nrow(2)
# color-letter pairs are unique
three_letter_colors %>%
expect_nrow(3) %>%
dplyr::distinct(letter, color) %>%
expect_nrow(3)
})
test_that("sample_n_of() warns about sample size", {
expect_warning(
sample_n_of(sample_data, 40, letter),
regexp = "Sample size.+ is larger than"
)
})
test_that("sample_n_of() samples n rows if no groups given", {
sample_n_of(sample_data, 10) %>%
nrow() %>%
expect_equal(10)
sample_n_of(sample_data, 0) %>%
nrow() %>%
expect_equal(0)
})
test_that("compare_pairs() calculates differences in pairs", {
means <- mtcars %>%
dplyr::group_by(cyl) %>%
dplyr::summarise(mpg = mean(mpg))
result <- compare_pairs(means, cyl, mpg)
by_hand <- tapply(mtcars$mpg, mtcars$cyl, mean, simplify = FALSE)
pairs <- result$pair %>%
as.character() %>%
strsplit("-") %>%
setNames(result$pair)
for (pair in names(pairs)) {
x1 <- pairs[[pair]][1]
x2 <- pairs[[pair]][2]
by_hand_diff <- by_hand[[x1]] - by_hand[[x2]]
diff <- result[result$pair == pair, "value"] %>%
unlist(use.names = FALSE) %>%
expect_equal(by_hand_diff)
}
# Check pair names
make_pairs_hard_way <- function(xs) {
indices <- seq_along(xs)
heads <- rev(seq_along(xs)[-1])
results <- character(0)
for (head in heads) {
tails <- indices[indices < head]
results <- c(results, paste0(xs[head], "-", xs[tails]))
}
results
}
pair_names <- make_pairs_hard_way(names(by_hand))
expect_true(all(pair_names %in% as.character(result$pair)))
})
test_that("seq_along_rows() returns a sequence along dataframe rows", {
# check lengths
mtcars %>%
seq_along_rows() %>%
expect_length(nrow(mtcars))
mtcars[0, ] %>%
seq_along_rows() %>%
expect_length(0)
# check values
mtcars[20:11, ] %>%
seq_along_rows() %>%
expect_equal(1:10)
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.