Nothing
library(groupdata2)
context("splt()")
test_that("dimensions of output with splt()", {
xpectr::set_test_seed(1)
df <- data.frame(
"x" = c(1:12),
"species" = factor(rep(c("cat", "pig", "human"), 4)),
"age" = c(5, 65, 34, 54, 32, 54, 23, 65, 23, 65, 87, 98)
)
get_element_sizes <- function(df, n) {
sizes <- plyr::llply(splt(df, n), function(d) {
return(nrow(d))
})
return(unname(unlist(sizes)))
}
# There should be no columns in the returned object
expect_equal(ncol(splt(df, 3)), NULL)
# There should be n elements in the list
expect_equal(length(splt(df, 3)), 3)
# Check that there are the right amount of rows in list elements
expect_equal(get_element_sizes(df, 3), c(4, 4, 4))
# There should be n elements in the list
expect_equal(length(splt(df, 0, allow_zero = T)), 1)
expect_equal(nrow(splt(df, 0, allow_zero = T)[[1]]), 12)
})
test_that("splt() works with force_equal on vector", {
xpectr::set_test_seed(1)
splt_equal <- function(data, n, method) {
splits <- splt(data, n, method,
force_equal = T
)
counts <- plyr::llply(splits, function(s) {
return(length(s))
})
counts <- unlist(counts)
names(counts) <- NULL
return(counts)
}
expect_equal(splt_equal(c(1:10), 3, "greedy"), c(3, 3, 3))
expect_equal(splt_equal(c(1:10), .3, "greedy"), c(3, 3, 3))
expect_equal(splt_equal(c(1:10), 3, "n_dist"), c(3, 3, 3))
expect_equal(splt_equal(c(1:10), .3, "n_dist"), c(3, 3, 3))
expect_equal(splt_equal(c(1:10), 3, "n_fill"), c(3, 3, 3))
expect_equal(splt_equal(c(1:10), .3, "n_fill"), c(3, 3, 3))
expect_equal(splt_equal(c(1:10), 3, "n_last"), c(3, 3, 3))
expect_equal(splt_equal(c(1:10), .3, "n_last"), c(3, 3, 3))
expect_equal(splt_equal(c(1:10), 3, "n_rand"), c(3, 3, 3))
expect_equal(splt_equal(c(1:10), .3, "n_rand"), c(3, 3, 3))
expect_equal(splt_equal(c(1:10), 3, "l_sizes"), c(3))
expect_equal(splt_equal(c(1:10), c(0.2, 0.3), "l_sizes"), c(2, 3))
# l_starts shouldn't cut any values.
expect_equal(splt_equal(c(1:10), c(3, 5), "l_starts"), c(2, 2, 6))
expect_equal(splt_equal(c(1:57), 5, "staircase"), c(5, 10, 15, 20))
expect_equal(splt_equal(c(1:57), 0.2, "staircase"), c(11, 22))
expect_equal(splt_equal(c(1:57), 5, "primes"), c(5, 7, 11, 13, 17))
})
test_that("splt() works with force_equal on vector", {
xpectr::set_test_seed(1)
splt_equal <- function(data, n, method, starts_col = NULL) {
splits <- splt(data, n, method,
force_equal = T,
starts_col = starts_col
)
counts <- plyr::llply(splits, function(s) {
return(nrow(s))
})
counts <- unlist(counts)
names(counts) <- NULL
return(counts)
}
df <- data.frame(
"participant" = factor(rep(c("1", "2", "3", "4", "5", "6"), 3)),
"age" = rep(c(25, 65, 34), 3),
"diagnosis" = factor(rep(c("a", "b", "a", "a", "b", "b"), 3)),
"score" = c(34, 23, 54, 23, 56, 76, 43, 56, 76, 42, 54, 1, 5, 76, 34, 76, 23, 65)
)
expect_equal(splt_equal(df, 3, "greedy"), c(3, 3, 3, 3, 3, 3))
expect_equal(splt_equal(df, .2, "greedy"), c(3, 3, 3, 3, 3, 3))
expect_equal(splt_equal(df, 3, "n_dist"), c(6, 6, 6))
expect_equal(splt_equal(df, .2, "n_dist"), c(6, 6, 6))
expect_equal(splt_equal(df, 3, "n_fill"), c(6, 6, 6))
expect_equal(splt_equal(df, .2, "n_fill"), c(6, 6, 6))
expect_equal(splt_equal(df, 3, "n_last"), c(6, 6, 6))
expect_equal(splt_equal(df, .2, "n_last"), c(6, 6, 6))
expect_equal(splt_equal(df, 3, "n_rand"), c(6, 6, 6))
expect_equal(splt_equal(df, .2, "n_rand"), c(6, 6, 6))
expect_equal(splt_equal(df, 3, "l_sizes"), c(3))
expect_equal(splt_equal(df, c(0.2, 0.3), "l_sizes"), c(3, 5))
expect_equal(splt_equal(df, 5, "staircase"), c(5, 10))
expect_equal(splt_equal(df, 0.2, "staircase"), c(3, 6, 9))
expect_equal(splt_equal(df, 5, "primes"), c(5, 7))
# l_starts shouldn't cut any values.
## Testing 'splt_equal(df, c(3, 5), "l_starts", starts_c...' ####
## Initially generated by xpectr
xpectr::set_test_seed(42)
# Testing side effects
# Assigning side effects
side_effects_12655 <- xpectr::capture_side_effects(splt_equal(df, c(3, 5), "l_starts", starts_col = 1), reset_seed = TRUE)
expect_equal(
xpectr::strip(side_effects_12655[['warnings']]),
xpectr::strip("'data[[starts_col]]' is factor. Converting to character."),
fixed = TRUE)
expect_equal(
xpectr::strip(side_effects_12655[['messages']]),
xpectr::strip(character(0)),
fixed = TRUE)
# Assigning output
output_12655 <- xpectr::suppress_mw(splt_equal(df, c(3, 5), "l_starts", starts_col = 1))
# Testing class
expect_equal(
class(output_12655),
"integer",
fixed = TRUE)
# Testing type
expect_type(
output_12655,
type = "integer")
# Testing values
expect_equal(
output_12655,
c(2, 2, 14),
tolerance = 1e-4)
# Testing names
expect_equal(
names(output_12655),
NULL,
fixed = TRUE)
# Testing length
expect_equal(
length(output_12655),
3L)
# Testing sum of element lengths
expect_equal(
sum(xpectr::element_lengths(output_12655)),
3L)
## Finished testing 'splt_equal(df, c(3, 5), "l_starts", starts_c...' ####
})
test_that("splt() works with group_by()", {
xpectr::set_test_seed(42)
df <- data.frame(
"x" = c(1:12),
"species" = factor(rep(c("cat", "pig", "human"), 4)),
"age" = c(5, 65, 34, 54, 32, 54, 23, 65, 23, 65, 87, 98)
)
## Testing 'xpectr::suppress_mw(df %>% dplyr::group_by(s...' ####
## Initially generated by xpectr
xpectr::set_test_seed(42)
# Assigning output
output_19148 <- xpectr::suppress_mw(df %>%
dplyr::group_by(species) %>%
splt(n = 2))
# Testing class
expect_equal(
class(output_19148),
"list",
fixed = TRUE)
# Testing type
expect_type(
output_19148,
type = "list")
# Testing values
expect_equal(
output_19148[["1"]],
list(`1` = structure(list(x = c(1L, 4L), species = structure(c(1L,
1L), .Label = c("cat", "human", "pig"), class = "factor"), age = c(5,
54)), row.names = c(NA, -2L), class = c("tbl_df", "tbl", "data.frame")),
`2` = structure(list(x = c(7L, 10L), species = structure(c(1L,
1L), .Label = c("cat", "human", "pig"), class = "factor"),
age = c(23, 65)), row.names = c(NA, -2L), class = c("tbl_df",
"tbl", "data.frame"))))
expect_equal(
output_19148[["2"]],
list(`1` = structure(list(x = c(3L, 6L), species = structure(c(2L,
2L), .Label = c("cat", "human", "pig"), class = "factor"), age = c(34,
54)), row.names = c(NA, -2L), class = c("tbl_df", "tbl", "data.frame")),
`2` = structure(list(x = c(9L, 12L), species = structure(c(2L,
2L), .Label = c("cat", "human", "pig"), class = "factor"),
age = c(23, 98)), row.names = c(NA, -2L), class = c("tbl_df",
"tbl", "data.frame"))))
expect_equal(
output_19148[["3"]],
list(`1` = structure(list(x = c(2L, 5L), species = structure(c(3L,
3L), .Label = c("cat", "human", "pig"), class = "factor"), age = c(65,
32)), row.names = c(NA, -2L), class = c("tbl_df", "tbl", "data.frame")),
`2` = structure(list(x = c(8L, 11L), species = structure(c(3L,
3L), .Label = c("cat", "human", "pig"), class = "factor"),
age = c(65, 87)), row.names = c(NA, -2L), class = c("tbl_df",
"tbl", "data.frame"))))
# Testing names
expect_equal(
names(output_19148),
c("1", "2", "3"),
fixed = TRUE)
# Testing length
expect_equal(
length(output_19148),
3L)
# Testing sum of element lengths
expect_equal(
sum(xpectr::element_lengths(output_19148)),
6L)
# Testing element classes
expect_equal(
xpectr::element_classes(output_19148),
c("list", "list", "list"),
fixed = TRUE)
# Testing element types
expect_equal(
xpectr::element_types(output_19148),
c("list", "list", "list"),
fixed = TRUE)
## Finished testing 'xpectr::suppress_mw(df %>% dplyr::group_by(s...' ####
})
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.