tests/testthat/test_group.R

In groupdata2: Creating Groups from Data

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


})