tests/testthat/test-select_group_tbl.R

In summarytabl: Generate Summary Tables for Categorical, Ordinal, and Continuous Data

# Test select_group_tbl

test_that("Failure: 'data' argument", {
  expect_snapshot(error = TRUE, {
    select_group_tbl(
      data = NULL,
      var_stem = "dep",
      group = "_\\d"
    )
  })
  
  expect_snapshot(error = TRUE, {
    select_group_tbl(
      data = data.frame(),
      var_stem = "dep",
      group = "sex",
      group_type = "variable"
    )
  })
})

test_that("Failure: Invalid 'var_stem' argument", {
  ex_mean_dat <- tibble::tibble(var_1 = 1:3, `var 2` = 5:7)
  
  expect_snapshot(error = TRUE, {
    select_group_tbl(
      data = depressive,
      var_stem = NA,
      group = "sex",
      group_type = "variable"
    )
  })
  
  expect_snapshot(error = TRUE, {
    select_group_tbl(
      data = depressive,
      var_stem = c("dep", "gender"),
      group = "sex",
      group_type = "variable"
    )
  })
  
  expect_snapshot(error = TRUE, {
    select_group_tbl(
      data = stem_social_psych,
      var_stem = "BELONG_belong",
      ignore_stem_case = FALSE,
      group = "urm",
      group_type = "variable"
    )
  })
})

test_that("Failure: Invalid 'var_input' argument", {
  expect_snapshot(error = TRUE, {
    select_group_tbl(
      data = stem_social_psych,
      var_stem = "belong_belong",
      var_input = NULL,
      group = "urm"
    )
  })
  
  expect_snapshot(error = TRUE, {
    select_group_tbl(
      data = stem_social_psych,
      var_stem = "belong_belong",
      var_input = "var_name",
      group = "urm"
    )
  })
})

test_that("Failure: Invalid 'group' argument", {
  sample_select_data <- 
    data.frame(var_1 = 1:3, var_2 = 5:7, 
               group = letters[1:3], 
               group = letters[1:3],
               check.names = FALSE)
  
  expect_snapshot(error = TRUE, {
    select_group_tbl(
      data = sample_select_data,
      var_stem = "var",
      group = NULL
    )
  })
  
  expect_snapshot(error = TRUE, {
    select_group_tbl(
      data = stem_social_psych,
      var_stem = "belong_belong",
      group = "URMS",
    )
  })
  
  expect_snapshot(error = TRUE, {
    select_group_tbl(
      data = sample_select_data,
      var_stem = "var",
      group = "group"
    )
  })
})

test_that("Failure: Invalid 'group_type' argument", {
  expect_snapshot(error = TRUE, {
    select_group_tbl(
      data = stem_social_psych,
      var_stem = "belong_belong",
      group = "\\d$",
      group_type = NULL
    )
  })
  
  expect_snapshot(error = TRUE, {
    select_group_tbl(
      data = stem_social_psych,
      var_stem = "belong_belong",
      group = "\\d$",
      group_type = "patterning"
    )
  })
})


test_that("Failure: Invalid 'only' argument", {
  expect_snapshot(error = TRUE, {
    select_group_tbl(
      data = stem_social_psych,
      var_stem = "belong_belong",
      group = "urm",
      only = character(0)
    )
  })
  
  expect_snapshot(error = TRUE, {
    select_group_tbl(
      data = stem_social_psych,
      var_stem = "belong_belong",
      group = "urm",
      only = NA
    )
  })
})

test_that("Failure: Invalid 'na_removal' argument", {
  expect_snapshot(error = TRUE, {
    select_group_tbl(
      data = stem_social_psych,
      var_stem = "belong_belong",
      group = "urm",
      na_removal = NULL
    )
  })
  
  expect_snapshot(error = TRUE, {
    select_group_tbl(
      data = stem_social_psych,
      var_stem = "belong_belong",
      group = "urm",
      na_removal = "side-ways"
    )
  })
})


test_that("Failure: Invalid 'pivot' argument", {
  expect_snapshot(error = TRUE, {
    select_group_tbl(
      data = stem_social_psych,
      var_stem = "belong_belong",
      group = "urm",
      pivot = NULL
    )
  })
  
  expect_snapshot(error = TRUE, {
    select_group_tbl(
      data = stem_social_psych,
      var_stem = "belong_belong",
      group = "urm",
      pivot = "side_ways"
    )
  })
})

test_that("Expected output longer format", {
  observed <-
    select_group_tbl(
      data = depressive,
      var_stem = "dep",
      group = "sex",
      group_type = "variable",
      margins = "rows"
    ) |>
    head() |>
    dplyr::mutate(percent = round(percent, digits = 3))

  expected <-
    tibble::tibble(
      variable = rep("dep_1", times = 6),
      sex = rep(1:2, times = 3),
      values = rep(1:3, each = 2),
      count = c(55, 54, 325, 364, 440, 369),
      percent = c(0.505, 0.495, 0.472, 0.528,
                  0.544, 0.456)
    )

  expect_equal(observed, expected)
})


test_that("Expected output wider format", {
  observed <-
    select_group_tbl(
      data = depressive,
      var_stem = "dep",
      group = "sex",
      group_type = "variable",
      pivot = "wider",
      only = "count"
    )
  observed <- observed[1:3,]
  
  expected <-
    tibble::tibble(
      variable = rep("dep_1", times = 3),
      values = 1:3L,
      count_sex_1 = c(55, 325, 440),
      count_sex_2 = c(54, 364, 369)
    ) |>
    dplyr::mutate(dplyr::across(
      .cols = dplyr::all_of(c("values", "count_sex_1", "count_sex_2")),
      .fns = as.integer)
      )
  
  expect_equal(observed, expected)
})


test_that("Expected output wider format with variable labels", {
  observed <-
    select_group_tbl(
      data = depressive,
      var_stem = "dep",
      group = "sex",
      group_type = "variable",
      pivot = "wider",
      only = "count",
      var_labels = c(
        dep_1="how often child feels sad and blue",
        dep_2="how often child feels nervous, tense, or on edge",
        dep_3="how often child feels happy",
        dep_4="how often child feels bored",
        dep_5="how often child feels lonely",
        dep_6="how often child feels tired or worn out",
        dep_7="how often child feels excited about something",
        dep_8="how often child feels too busy to get everything"
      )
    )[1:3,]
  
  expected <-
    tibble::tibble(
      variable = rep("dep_1", times = 3),
      variable_label = "how often child feels sad and blue",
      values = 1:3L,
      count_sex_1 = c(55, 325, 440),
      count_sex_2 = c(54, 364, 369)
    ) |>
    dplyr::mutate(dplyr::across(
      .cols = dplyr::all_of(c("values", "count_sex_1", "count_sex_2")),
      .fns = as.integer)
      )
  
  expect_equal(observed, expected)
})


test_that("Expected output wider for with 'ignore' values", {
  observed <-
    select_group_tbl(
      data = depressive,
      var_stem = "dep",
      group = "sex",
      group_type = "variable",
      pivot = "wider",
      only = "count",
      ignore = c(sex = 2, dep = 1),
      var_labels = c(
        dep_1="how often child feels sad and blue",
        dep_2="how often child feels nervous, tense, or on edge",
        dep_3="how often child feels happy",
        dep_4="how often child feels bored",
        dep_5="how often child feels lonely",
        dep_6="how often child feels tired or worn out",
        dep_7="how often child feels excited about something",
        dep_8="how often child feels too busy to get everything"
      )
    ) |> head()
  
  expected <-
    tibble::tibble(
      variable = rep(paste0("dep_", 1:3), each = 2),
      variable_label = rep(c("how often child feels sad and blue",
                             "how often child feels nervous, tense, or on edge",
                             "how often child feels happy"), each  = 2),
      values = rep(2:3L, times = 3),
      count_sex_1 = c(41, 26, 42, 25, 59, 8),
    ) |>
    dplyr::mutate(dplyr::across(
      .cols = dplyr::all_of(c("values", "count_sex_1")),
      .fns = as.integer
      ))
  
  expect_equal(observed, expected)
})



test_that("Expected output with remove_group_non_alnum", {
  observed1 <-
    select_group_tbl(
      data = stem_social_psych,
      var_stem = "belong_belong",
      group = "_w\\d",
      group_type = "pattern",
      remove_group_non_alnum = FALSE
    ) |>
    head() |>
    dplyr::mutate(percent = round(percent, digits = 3))
    
  expected1 <-
    tibble::tibble(
      variable = c(rep("belong_belongStem_w1", times = 5), 
                   "belong_belongStem_w2"),
      group = c(rep("_w1", times = 5), "_w2"),
      values = c(1:5L, 1L),
      count = c(5, 20, 59, 107, 79, 11),
      percent = c(0.019, 0.074, 0.219, 0.396, 0.293, 0.041)
    )
  
  observed2 <-
    select_group_tbl(
      data = stem_social_psych,
      var_stem = "belong_belong",
      group = "_w\\d",
      group_type = "pattern",
      remove_group_non_alnum = TRUE
    ) |>
    head() |>
    dplyr::mutate(percent = round(percent, digits = 3))
  
  expected2 <-
    tibble::tibble(
      variable = c(rep("belong_belongStem_w1", times = 5), 
                   "belong_belongStem_w2"),
      group = c(rep("w1", times = 5), "w2"),
      values = c(1:5L, 1L),
      count = c(5, 20, 59, 107, 79, 11),
      percent = c(0.019, 0.074, 0.219, 0.396, 0.293, 0.041)
    )
  
  expect_equal(observed1, expected1)
  expect_equal(observed2, expected2)
})


test_that("Expected output with ignore_stem_case", {
  observed <-
    select_group_tbl(
      data = depressive,
      var_stem = "DEP",
      ignore_stem_case = TRUE,
      group = "sex",
      group_type = "variable",
      pivot = "wider",
      only = "count"
    )[1:2,]
  
  expected <-
    tibble::tibble(
      variable = rep("dep_1", times = 2),
      values = 1:2,
      count_sex_1 = c(55, 325),
      count_sex_2 = c(54,364)
    ) |>
    dplyr::mutate(dplyr::across(
      .cols = dplyr::all_of(c("values", "count_sex_1","count_sex_2")),
      .fns = as.integer)
      )
  
  expect_equal(observed, expected)
})

test_that("Expected output with ignore_group_case", {
  observed <-
    select_group_tbl(
      data = depressive,
      var_stem = "DEP",
      ignore_stem_case = TRUE,
      group = "SEX",
      group_type = "variable",
      ignore_group_case = TRUE,
      pivot = "wider",
      only = "count"
    )[1:2,]
  
  expected <-
    tibble::tibble(
      variable = rep("dep_1", times = 2),
      values = 1:2,
      count_sex_1 = c(55, 325),
      count_sex_2 = c(54,364)
    ) |>
    dplyr::mutate(dplyr::across(
      .cols = dplyr::all_of(c("values","count_sex_1", "count_sex_2")),
      .fns = as.integer)
      )
  
  expect_equal(observed, expected)
})

test_that("Expected output with different 'only' types", {
  observed1 <-
    select_group_tbl(
      data = depressive,
      var_stem = "dep",
      group = "sex",
      only = "count"
    ) |>
    head()
  
  expected1 <-
    tibble::tibble(
      variable = "dep_1",
      sex = rep(1:2, each = 3),
      values = rep(1:3, times = 2),
      count = c(55, 325, 440, 54, 364, 369)
    ) |>
    dplyr::mutate(dplyr::across(
      .cols = dplyr::all_of(c("sex", "values")),
      .fns = as.integer)
      )
  
  observed2 <-
    select_group_tbl(
      data = depressive,
      var_stem = "dep",
      group = "sex",
      only = "percent",
      margins = "rows"
    ) |>
    head() |>
    dplyr::mutate(percent = round(percent, digits = 3))
  
  
  expected2 <-
    tibble::tibble(
      variable = "dep_1",
      sex = rep(1:2, times = 3),
      values = rep(1:3, each = 2),
      percent = c(0.505, 0.495, 0.472, 0.528, 0.544, 0.456)
    ) |>
    dplyr::mutate(dplyr::across(
      .cols = dplyr::all_of(c("sex", "values")),
      .fns = as.integer)
      )
  
  expect_equal(observed1, expected1)
  expect_equal(observed2, expected2)
})


test_that("Expected output with specified group name", {
  observed1 <-
    select_group_tbl(
      data = depressive,
      var_stem = "dep",
      group = "sex",
      only = "count",
      group_name = "gender_identity"
    ) |>
    head()
  
  expected1 <-
    tibble::tibble(
      variable = "dep_1",
      gender_identity = rep(1:2, each = 3),
      values = rep(1:3, times = 2),
      count = c(55, 325, 440, 54, 364, 369)
    ) |>
    dplyr::mutate(values = as.integer(values))
  
  observed2 <-
    select_group_tbl(
      data = depressive,
      var_stem = "dep",
      group = "_\\d",
      group_type = "pattern",
      group_name = "item_suffix",
      only = "percent"
    ) |>
    head() |>
    dplyr::mutate(percent = round(percent, digits = 3))
  
  expected2 <-
    tibble::tibble(
      variable = rep(c("dep_1","dep_2"), each = 3),
      item_suffix = rep(paste0(1:2), each = 3),
      values = rep(1:3, times = 2),
      percent = c(0.068, 0.429, 0.503, 0.090, 0.464, 0.446)
    ) |>
    dplyr::mutate(values = as.integer(values))
  
  
  expect_equal(observed1, expected1)
  expect_equal(observed2, expected2)
})


test_that("Expected output with multiple names, group is pattern (digits), and ignore values (pairwise deletion)", {
  observed <-
    select_group_tbl(
      data = depressive,
      var_stem = c("dep_1", "dep_5"),
      group = "\\d",
      group_type = "pattern",
      var_input = "name",
      na_removal = "pairwise",
      only = "count",
      ignore = c(dep_1 = 3, dep_5 = 2))
  
  expected <-
    tibble::tibble(
      variable = rep(c("dep_1", "dep_5"), each = 2),
      group = as.character(c(1,1,5,5)),
      values = as.integer(c(1,2,1,3)),
      count = as.integer(c(120, 709, 206, 871))
    )
  
  expect_equal(observed, expected)
})


test_that("Expected output with multiple variable stems, group is a variable, and ignore values (pairwise deletion)", {
  observed <-
    select_group_tbl(
      data = social_psy_data,
      var_stem = c("belong", "identity"),
      group = "gender",
      na_removal = "pairwise",
      only = "count",
      ignore = list(belong = c(1,2,3), identity = c(3, 4,5),
                    gender = c(4,5,6))) |>
    tail()
  
  expected <-
    tibble::tibble(
      variable = "identity_4",
      gender = rep(1:3, each = 2),
      values = as.integer(rep(1:2, times = 3)),
      count = as.integer(c(323, 1041, 1027,2014, 5, 11))
    )
  
  expect_equal(observed, expected)
})


test_that("Expected output with multiple variable names, group is variable, and ignore values (pairwise deletion)", {
  observed <-
    select_group_tbl(
      data = social_psy_data,
      var_stem = c("belong_1", "selfEfficacy_1"),
      group = "gender",
      na_removal = "pairwise",
      only = "count",
      ignore = list(belong_1 = c(1,2,3), selfEfficacy_1 = c(3, 4,5),
                    gender = c(4,5,6)))
  
  expected <-
    tibble::tibble(
      variable = rep(c("belong_1", "selfEfficacy_1"), each = 6),
      gender = rep(rep(1:3, each = 2), times = 2),
      values = c(rep(4:5, times = 3), rep(1:2, times = 3)),
      count = as.integer(c(1136, 560,2115,2442, 18, 9,
                           79, 238, 62, 251, 2, 6))
    )
  
  expect_equal(observed, expected)
})


test_that("Warning: override pivot wider", {
  expect_snapshot(error = FALSE, {
    select_group_tbl(
      data = social_psy_data,
      var_stem = c("belong", "identity"),
      group = "gender",
      na_removal = "pairwise",
      only = "count",
      pivot = "wider",
      ignore = list(belong = c(1,2,3), identity = c(3,4,5)))
  })
})