groupdata2: Creating Groups from Data

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



})