library(groupdata2)
context("group()")
# Needs testing of vector and factor as input
test_that("dimensions of data frame with group()", {
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)
)
# The added grouping factor means we should get and extra column
expect_equal(ncol(group(df, 5)), 4)
# We expect the same amount of rows
expect_equal(nrow(group(df, 5)), 12)
# Outputted rows with force_equal = TRUE
expect_equal(nrow(group(df, 5, force_equal = TRUE)), 10)
expect_equal(nrow(group(df, 7, force_equal = TRUE)), 7)
expect_equal(nrow(group(df, 4, force_equal = TRUE)), 12)
})
test_that("mean age of groups made with group()", {
xpectr::set_test_seed(1)
# Create df 3x12
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)
)
int_mean_age <- function(df, n, method) {
df_means <- group(df, n, method = method)
df_means <- dplyr::summarise(df_means, mean_age = mean(age))
return(as.integer(df_means$mean_age))
}
# group(df, 5, method = 'n_fill')
expect_equal(int_mean_age(df, 5, "n_dist"), c(35, 44, 36, 44, 83))
expect_equal(int_mean_age(df, 5, "n_fill"), c(34, 46, 44, 44, 92))
expect_equal(int_mean_age(df, 5, "n_last"), c(35, 44, 43, 44, 68))
expect_equal(int_mean_age(df, 7, "n_dist"), c(5, 49, 43, 54, 44, 44, 92))
expect_equal(int_mean_age(df, 7, "n_fill"), c(35, 44, 43, 44, 44, 87, 98))
expect_equal(int_mean_age(df, 7, "n_last"), c(5, 65, 34, 54, 32, 54, 60))
# For n_rand test how many groups has been made
expect_equal(length(int_mean_age(df, 5, "n_rand")), 5)
expect_equal(length(int_mean_age(df, 7, "n_rand")), 7)
})
test_that("error messages work in group()", {
xpectr::set_test_seed(1)
# Create df 3x12
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)
)
expect_error(
xpectr::strip_msg(group(df, 13)),
xpectr::strip("Assertion on 'nrow(data) >= n' failed: Must be TRUE."),
fixed = TRUE)
expect_error(
xpectr::strip_msg(group(df, 0)),
xpectr::strip(paste0("1 assertions failed:\n * 'n' was 0. If this is on purpose, ",
"set 'allow_zero' to 'TRUE'.")),
fixed = TRUE)
})
test_that("allow_zero works in group()", {
xpectr::set_test_seed(1)
# Create df 3x12
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)
)
group_zero <- function(force_equal = FALSE) {
return(group(df, 0,
allow_zero = TRUE,
force_equal = force_equal
))
}
na_col <- function() {
grouped_df <- group(df, 0, allow_zero = TRUE)
return(grouped_df$.groups)
}
# Check that the .groups column contains NAs
expect_equal(na_col(), c(NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA))
# We should still get the added grouping factor
expect_equal(ncol(group_zero()), 4)
# We should still have the same amount of rows
expect_equal(nrow(group_zero()), 12)
# The same with force_equal as there are no group sizes to force equal
expect_equal(ncol(group_zero(force_equal = TRUE)), 4)
expect_equal(nrow(group_zero(force_equal = TRUE)), 12)
})
test_that("col_name can be set correctly in group()", {
xpectr::set_test_seed(1)
# Create df 3x12
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)
)
set_col_name <- function(df) {
grouped_data <- group(df, 5, col_name = ".cats")
return(colnames(grouped_data[4]))
}
expect_equal(set_col_name(df), ".cats")
})
test_that("l_starts can take n = auto", {
xpectr::set_test_seed(1)
df <- data.frame(
"x" = c(1:12),
"x2" = c(1, 1, 1, 2, NA, 2, 2, 3, NA, NA, 6, 6),
"species" = rep(c("cat", "cat", "human", "human"), 3),
"age" = c(5, 65, 34, 54, 32, 54, 23, 65, 23, 65, 87, 98),
stringsAsFactors = FALSE
)
expect_equal(
group(df,
n = "auto", method = "l_starts",
starts_col = "species"
)$.groups,
factor(c(1, 1, 2, 2, 3, 3, 4, 4, 5, 5, 6, 6))
)
expect_equal(
group(df,
n = "auto", method = "l_starts",
starts_col = "x2"
)$.groups,
factor(c(1, 1, 1, 2, 3, 4, 4, 5, 6, 6, 7, 7))
)
expect_error(
xpectr::strip_msg(group(df,
n = "auto", method = "l_sizes",
starts_col = "species")),
xpectr::strip(paste0("2 assertions failed:\n * 'n' can only be character when met",
"hod is 'l_starts'.\n * when method is not 'l_starts', 'start",
"s_col' must be 'NULL'.")),
fixed = TRUE)
})
test_that("l_starts can take starts_col = index / .index", {
xpectr::set_test_seed(1)
df <- data.frame(
"x" = c(1:12),
stringsAsFactors = FALSE
)
# index
expect_equal(
group(df, c(1, 4, 7),
method = "l_starts",
starts_col = "index"
)$.groups,
factor(c(1, 1, 1, 2, 2, 2, 3, 3, 3, 3, 3, 3))
)
# .index
expect_equal(
group(df, c(1, 4, 7),
method = "l_starts",
starts_col = ".index"
)$.groups,
factor(c(1, 1, 1, 2, 2, 2, 3, 3, 3, 3, 3, 3))
)
df2 <- data.frame(
"x" = c(1:12),
"index" = c(2:13),
".index" = c(3:14),
stringsAsFactors = FALSE
)
expect_warning(expect_equal(
group(df2, c(2, 7, 11),
method = "l_starts",
starts_col = ".index"
)$.groups,
factor(c(1, 2, 2, 2, 2, 2, 3, 3, 3, 3, 4, 4))
),
"data contains column named \'.index\' but this is ignored.",
fixed = TRUE
)
expect_warning(expect_equal(
group(df2, c(2, 7, 11),
method = "l_starts",
starts_col = "index"
)$.groups,
factor(c(1, 1, 1, 1, 1, 2, 2, 2, 2, 3, 3, 3))
),
"'data' contains column named 'index'. This is used as starts_col instead",
fixed = TRUE
)
})
test_that("simple fuzz test of group()", {
xpectr::set_test_seed(1)
# NOTE: Most things already tested in group_factor,
# so we just make a simple set of arg values
df <- data.frame(
"x" = c(1:12),
"x2" = c(1, 1, 1, 2, NA, 2, 2, 3, NA, NA, 6, 6),
"species" = rep(c("cat", "cat", "human", "human"), 3),
"age" = c(5, 65, 34, 54, 32, 54, 23, 65, 23, 65, 87, 98),
stringsAsFactors = FALSE
)
xpectr::set_test_seed(3)
# xpectr::gxs_function(group,
# args_values = list(
# "data" = list(df, df$x),
# "n" = list(3),
# "method" = list("n_dist", "n_rand"),
# "return_factor" = list(FALSE, TRUE),
# "col_name" = list(".groups", "myGroups")
# ), indentation = 2)
## Testing 'group' ####
## Initially generated by xpectr
# Testing different combinations of argument values
# Testing group(data = df, n = 3, method = "n_dist", ret...
xpectr::set_test_seed(42)
# Assigning output
output_11680 <- group(data = df, n = 3, method = "n_dist", return_factor = FALSE, col_name = ".groups")
# Testing class
expect_equal(
class(output_11680),
c("grouped_df", "tbl_df", "tbl", "data.frame"),
fixed = TRUE)
# Testing column values
expect_equal(
output_11680[["x"]],
c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12),
tolerance = 1e-4)
expect_equal(
output_11680[["x2"]],
c(1, 1, 1, 2, NA, 2, 2, 3, NA, NA, 6, 6),
tolerance = 1e-4)
expect_equal(
output_11680[["species"]],
c("cat", "cat", "human", "human", "cat", "cat", "human", "human",
"cat", "cat", "human", "human"),
fixed = TRUE)
expect_equal(
output_11680[["age"]],
c(5, 65, 34, 54, 32, 54, 23, 65, 23, 65, 87, 98),
tolerance = 1e-4)
expect_equal(
output_11680[[".groups"]],
structure(c(1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 3L, 3L, 3L, 3L), .Label = c("1",
"2", "3"), class = "factor"))
# Testing column names
expect_equal(
names(output_11680),
c("x", "x2", "species", "age", ".groups"),
fixed = TRUE)
# Testing column classes
expect_equal(
xpectr::element_classes(output_11680),
c("integer", "numeric", "character", "numeric", "factor"),
fixed = TRUE)
# Testing column types
expect_equal(
xpectr::element_types(output_11680),
c("integer", "double", "character", "double", "integer"),
fixed = TRUE)
# Testing dimensions
expect_equal(
dim(output_11680),
c(12L, 5L))
# Testing group keys
expect_equal(
colnames(dplyr::group_keys(output_11680)),
".groups",
fixed = TRUE)
# Testing group(data = df, n = 3, method = "n_dist", ret...
# Changed from baseline: col_name
xpectr::set_test_seed(42)
# Assigning output
output_18075 <- group(data = df, n = 3, method = "n_dist", return_factor = FALSE, col_name = "myGroups")
# Testing class
expect_equal(
class(output_18075),
c("grouped_df", "tbl_df", "tbl", "data.frame"),
fixed = TRUE)
# Testing column values
expect_equal(
output_18075[["x"]],
c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12),
tolerance = 1e-4)
expect_equal(
output_18075[["x2"]],
c(1, 1, 1, 2, NA, 2, 2, 3, NA, NA, 6, 6),
tolerance = 1e-4)
expect_equal(
output_18075[["species"]],
c("cat", "cat", "human", "human", "cat", "cat", "human", "human",
"cat", "cat", "human", "human"),
fixed = TRUE)
expect_equal(
output_18075[["age"]],
c(5, 65, 34, 54, 32, 54, 23, 65, 23, 65, 87, 98),
tolerance = 1e-4)
expect_equal(
output_18075[["myGroups"]],
structure(c(1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 3L, 3L, 3L, 3L), .Label = c("1",
"2", "3"), class = "factor"))
# Testing column names
expect_equal(
names(output_18075),
c("x", "x2", "species", "age", "myGroups"),
fixed = TRUE)
# Testing column classes
expect_equal(
xpectr::element_classes(output_18075),
c("integer", "numeric", "character", "numeric", "factor"),
fixed = TRUE)
# Testing column types
expect_equal(
xpectr::element_types(output_18075),
c("integer", "double", "character", "double", "integer"),
fixed = TRUE)
# Testing dimensions
expect_equal(
dim(output_18075),
c(12L, 5L))
# Testing group keys
expect_equal(
colnames(dplyr::group_keys(output_18075)),
"myGroups",
fixed = TRUE)
# Testing group(data = df, n = 3, method = "n_dist", ret...
# Changed from baseline: col_name
xpectr::set_test_seed(42)
# Testing side effects
expect_error(
xpectr::strip_msg(group(data = df, n = 3, method = "n_dist", return_factor = FALSE, col_name = NULL)),
xpectr::strip(paste0("1 assertions failed:\n * Variable 'col_name': Must be of ty",
"pe 'string', not 'NULL'.")),
fixed = TRUE)
# Testing group(data = df$x, n = 3, method = "n_dist", r...
# Changed from baseline: data
xpectr::set_test_seed(42)
# Assigning output
output_13277 <- group(data = df$x, n = 3, method = "n_dist", return_factor = FALSE, col_name = ".groups")
# Testing class
expect_equal(
class(output_13277),
c("grouped_df", "tbl_df", "tbl", "data.frame"),
fixed = TRUE)
# Testing column values
expect_equal(
output_13277[["data"]],
c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12),
tolerance = 1e-4)
expect_equal(
output_13277[[".groups"]],
structure(c(1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 3L, 3L, 3L, 3L), .Label = c("1",
"2", "3"), class = "factor"))
# Testing column names
expect_equal(
names(output_13277),
c("data", ".groups"),
fixed = TRUE)
# Testing column classes
expect_equal(
xpectr::element_classes(output_13277),
c("integer", "factor"),
fixed = TRUE)
# Testing column types
expect_equal(
xpectr::element_types(output_13277),
c("integer", "integer"),
fixed = TRUE)
# Testing dimensions
expect_equal(
dim(output_13277),
c(12L, 2L))
# Testing group keys
expect_equal(
colnames(dplyr::group_keys(output_13277)),
".groups",
fixed = TRUE)
# Testing group(data = NULL, n = 3, method = "n_dist", r...
# Changed from baseline: data
xpectr::set_test_seed(42)
# Testing side effects
expect_error(
xpectr::strip_msg(group(data = NULL, n = 3, method = "n_dist", return_factor = FALSE, col_name = ".groups")),
xpectr::strip("1 assertions failed:\n * 'data' cannot be 'NULL'"),
fixed = TRUE)
# Testing group(data = df, n = 3, method = "n_rand", ret...
# Changed from baseline: method
xpectr::set_test_seed(42)
# Assigning output
output_16043 <- group(data = df, n = 3, method = "n_rand", return_factor = FALSE, col_name = ".groups")
# Testing class
expect_equal(
class(output_16043),
c("grouped_df", "tbl_df", "tbl", "data.frame"),
fixed = TRUE)
# Testing column values
expect_equal(
output_16043[["x"]],
c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12),
tolerance = 1e-4)
expect_equal(
output_16043[["x2"]],
c(1, 1, 1, 2, NA, 2, 2, 3, NA, NA, 6, 6),
tolerance = 1e-4)
expect_equal(
output_16043[["species"]],
c("cat", "cat", "human", "human", "cat", "cat", "human", "human",
"cat", "cat", "human", "human"),
fixed = TRUE)
expect_equal(
output_16043[["age"]],
c(5, 65, 34, 54, 32, 54, 23, 65, 23, 65, 87, 98),
tolerance = 1e-4)
expect_equal(
output_16043[[".groups"]],
structure(c(1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 3L, 3L, 3L, 3L), .Label = c("1",
"2", "3"), class = "factor"))
# Testing column names
expect_equal(
names(output_16043),
c("x", "x2", "species", "age", ".groups"),
fixed = TRUE)
# Testing column classes
expect_equal(
xpectr::element_classes(output_16043),
c("integer", "numeric", "character", "numeric", "factor"),
fixed = TRUE)
# Testing column types
expect_equal(
xpectr::element_types(output_16043),
c("integer", "double", "character", "double", "integer"),
fixed = TRUE)
# Testing dimensions
expect_equal(
dim(output_16043),
c(12L, 5L))
# Testing group keys
expect_equal(
colnames(dplyr::group_keys(output_16043)),
".groups",
fixed = TRUE)
# Testing group(data = df, n = 3, method = NULL, return_...
# Changed from baseline: method
xpectr::set_test_seed(42)
# Testing side effects
expect_error(
xpectr::strip_msg(group(data = df, n = 3, method = NULL, return_factor = FALSE, col_name = ".groups")),
xpectr::strip(paste0("1 assertions failed:\n * Variable 'method': Must be of type",
" 'string', not 'NULL'.")),
fixed = TRUE)
# Testing group(data = df, n = NULL, method = "n_dist", ...
# Changed from baseline: n
xpectr::set_test_seed(42)
# Testing side effects
expect_error(
xpectr::strip_msg(group(data = df, n = NULL, method = "n_dist", return_factor = FALSE, col_name = ".groups")),
xpectr::strip("1 assertions failed:\n * 'n' cannot be 'NULL'"),
fixed = TRUE)
# Testing group(data = df, n = 3, method = "n_dist", ret...
# Changed from baseline: return_factor
xpectr::set_test_seed(42)
# Assigning output
output_15776 <- group(data = df, n = 3, method = "n_dist", return_factor = TRUE, col_name = ".groups")
# Testing is factor
expect_true(
is.factor(output_15776))
# Testing values
expect_equal(
as.character(output_15776),
c("1", "1", "1", "1", "2", "2", "2", "2", "3", "3", "3", "3"),
fixed = TRUE)
# Testing names
expect_equal(
names(output_15776),
NULL,
fixed = TRUE)
# Testing length
expect_equal(
length(output_15776),
12L)
# Testing number of levels
expect_equal(
nlevels(output_15776),
3L)
# Testing levels
expect_equal(
levels(output_15776),
c("1", "2", "3"),
fixed = TRUE)
# Testing group(data = df, n = 3, method = "n_dist", ret...
# Changed from baseline: return_factor
xpectr::set_test_seed(42)
# Testing side effects
expect_error(
xpectr::strip_msg(group(data = df, n = 3, method = "n_dist", return_factor = NULL, col_name = ".groups")),
xpectr::strip(paste0("1 assertions failed:\n * Variable 'return_factor': Must be ",
"of type 'logical flag', not 'NULL'.")),
fixed = TRUE)
## Finished testing 'group' ####
#
})
test_that("group() works with group_by()", {
xpectr::set_test_seed(42)
df <- data.frame(
"n" = c(1, 2, 3, 4, 2, 1, 5, 2, 1, 9),
"s" = c(4, 4, 4, 4, 7, 7, 7, 7, 1, 1),
"c" = as.character(c(4, 4, 6, 6, 7, 7, 7, 8, 8, 1)),
"f" = as.factor(as.character(c(4, 4, 6, 6, 7, 7, 7, 8, 8, 1))),
stringsAsFactors = FALSE
)
## Testing 'xpectr::suppress_mw( df %>% dplyr::group_by(...' ####
## Initially generated by xpectr
xpectr::set_test_seed(42)
# Assigning output
output_19148 <- xpectr::suppress_mw(
df %>%
dplyr::group_by(s) %>%
group(n = 2)
)
# Testing class
expect_equal(
class(output_19148),
c("grouped_df", "tbl_df", "tbl", "data.frame"),
fixed = TRUE)
# Testing column values
expect_equal(
output_19148[["n"]],
c(1, 9, 1, 2, 3, 4, 2, 1, 5, 2),
tolerance = 1e-4)
expect_equal(
output_19148[["s"]],
c(1, 1, 4, 4, 4, 4, 7, 7, 7, 7),
tolerance = 1e-4)
expect_equal(
output_19148[["c"]],
c("8", "1", "4", "4", "6", "6", "7", "7", "7", "8"),
fixed = TRUE)
expect_equal(
output_19148[["f"]],
structure(c(5L, 1L, 2L, 2L, 3L, 3L, 4L, 4L, 4L, 5L), .Label = c("1",
"4", "6", "7", "8"), class = "factor"))
expect_equal(
output_19148[[".groups"]],
structure(c(1L, 2L, 1L, 1L, 2L, 2L, 1L, 1L, 2L, 2L), .Label = c("1",
"2"), class = "factor"))
# Testing column names
expect_equal(
names(output_19148),
c("n", "s", "c", "f", ".groups"),
fixed = TRUE)
# Testing column classes
expect_equal(
xpectr::element_classes(output_19148),
c("numeric", "numeric", "character", "factor", "factor"),
fixed = TRUE)
# Testing column types
expect_equal(
xpectr::element_types(output_19148),
c("double", "double", "character", "integer", "integer"),
fixed = TRUE)
# Testing dimensions
expect_equal(
dim(output_19148),
c(10L, 5L))
# Testing group keys
expect_equal(
colnames(dplyr::group_keys(output_19148)),
c("s", ".groups"),
fixed = TRUE)
## Finished testing 'xpectr::suppress_mw( df %>% dplyr::group_by(...' ####
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.