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...' #### })