tests/testthat/test-makeme-hide-crowd-functionality.R

In saros: Semi-Automatic Reporting of Ordinary Surveys

test_that("makeme respects hide_for_crowd_if_all_na argument", {
  data("ex_survey", package = "saros")

  # Test with individual variables to avoid mixing variable types
  test_data <- ex_survey
  test_data$all_na_var <- factor(NA, levels = c("No", "Yes"))
  attr(test_data$all_na_var, "label") <- "All NA Variable"

  # Test all_na_var individually with hide_for_crowd_if_all_na = TRUE (default)
  result_hide_true <- makeme(
    data = test_data,
    dep = all_na_var,
    type = "cat_table_html",
    label_separator = " - ",
    hide_for_crowd_if_all_na = TRUE
  )

  # all_na_var should be hidden (empty result)
  expect_true(is.data.frame(result_hide_true))
  expect_equal(nrow(result_hide_true), 0) # Variable should be hidden

  # Test all_na_var individually with hide_for_crowd_if_all_na = TRUE (default)
  result_hide_true <- makeme(
    data = test_data,
    dep = c(all_na_var),
    type = "cat_table_html",
    label_separator = " - ",
    hide_for_crowd_if_all_na = TRUE
  )

  # all_na_var should be hidden (empty result)
  expect_true(is.data.frame(result_hide_true))
  expect_equal(nrow(result_hide_true), 0) # Variable should be hidden

  # Instead of testing all-NA inclusion (which might have other constraints),
  # test a variable with mostly NA but some valid values
  test_data$mostly_na_var <- factor(
    c(rep("No", 2), rep(NA_character_, 298)),
    levels = c("No", "Yes")
  )
  attr(test_data$mostly_na_var, "label") <- "Mostly NA Variable"

  # Test with hide_for_crowd_if_all_na = TRUE (should be included as it's not ALL NA)
  result_mostly_na_true <- makeme(
    data = test_data,
    dep = mostly_na_var,
    type = "cat_table_html",
    hide_for_crowd_if_all_na = TRUE,
    hide_for_crowd_if_valid_n_below = 1,
    hide_for_crowd_if_category_k_below = 1
  )

  # mostly_na_var should be included as it has some valid values
  expect_true(is.data.frame(result_mostly_na_true))
  expect_equal(nrow(result_mostly_na_true), 1) # Variable should be present

  # Test normal variable a_1 (should always be included)
  result_normal <- makeme(
    data = test_data,
    dep = a_1,
    type = "cat_table_html",
    hide_for_crowd_if_all_na = TRUE
  )

  # a_1 should be included as it has valid data
  expect_true(is.data.frame(result_normal))
  expect_equal(nrow(result_normal), 1) # Variable should be present
})

test_that("makeme respects hide_for_crowd_if_valid_n_below argument", {
  data("ex_survey", package = "saros")

  # Create test data with a variable that has very few valid values
  test_data <- ex_survey[1:20, ] # Subset to 20 rows
  test_data$few_valid_var <- factor(
    c(rep("No", 3), rep(NA_character_, 17)),
    levels = c("No", "Yes")
  )
  attr(test_data$few_valid_var, "label") <- "Few Valid Variables"

  # Test few_valid_var individually with hide_for_crowd_if_valid_n_below = 5 (should hide variable with 3 valid values)
  result_hide <- makeme(
    data = test_data,
    dep = few_valid_var,
    type = "cat_table_html",
    hide_for_crowd_if_valid_n_below = 5
  )

  # few_valid_var should be hidden
  expect_true(is.data.frame(result_hide))
  expect_equal(nrow(result_hide), 0) # Variable should be hidden

  # Test few_valid_var individually with hide_for_crowd_if_valid_n_below = 2 (should include variable with 3 valid values)
  # Need to also set category threshold to be permissive since we only have 1 category used
  result_keep <- makeme(
    data = test_data,
    dep = few_valid_var,
    type = "cat_table_html",
    hide_for_crowd_if_valid_n_below = 2,
    hide_for_crowd_if_category_k_below = 1 # Allow variables with 1 category
  )

  # few_valid_var should be included
  expect_true(is.data.frame(result_keep))
  expect_equal(nrow(result_keep), 1) # Variable should be present

  # Test normal variable a_1 (should always be included)
  result_normal <- makeme(
    data = test_data,
    dep = a_1,
    type = "cat_table_html",
    hide_for_crowd_if_valid_n_below = 5
  )

  # a_1 should be included as it has sufficient valid data
  expect_true(is.data.frame(result_normal))
  expect_equal(nrow(result_normal), 1) # Variable should be present
})

test_that("makeme respects hide_for_crowd_if_category_k_below argument", {
  data("ex_survey", package = "saros")

  # Test by creating a single-category version of a_1
  test_data <- ex_survey[1:50, ]
  # Convert a_1 to only have "No" values (single category)
  test_data$a_1 <- factor(rep("No", 50), levels = c("No", "Yes"))
  attr(test_data$a_1, "label") <- "Only No Responses"

  # Test with hide_for_crowd_if_category_k_below = 2 (default - should hide single category variable)
  result_hide <- makeme(
    data = test_data,
    dep = a_1,
    type = "cat_table_html",
    hide_for_crowd_if_category_k_below = 2
  )

  # a_1 should be hidden due to having only 1 category
  expect_true(is.data.frame(result_hide))
  expect_equal(nrow(result_hide), 0) # No variables remain

  # Test with hide_for_crowd_if_category_k_below = 1 (should include single category variable)
  result_keep <- makeme(
    data = test_data,
    dep = a_1,
    type = "cat_table_html",
    hide_for_crowd_if_category_k_below = 1
  )

  # a_1 should be included
  expect_true(is.data.frame(result_keep))
  expect_equal(nrow(result_keep), 1) # Variable present
})

test_that("makeme respects hide_for_crowd_if_category_n_below argument", {
  data("ex_survey", package = "saros")

  # Create test data with a variable that has a category with very few observations
  test_data <- ex_survey[1:50, ]
  # Create a custom variable with one rare category
  test_data$rare_cat_var <- factor(
    c(
      rep("No", 47), # 47 observations
      rep("Yes", 2), # 2 observations
      rep(NA_character_, 1) # 1 NA
    ),
    levels = c("No", "Yes")
  )
  attr(test_data$rare_cat_var, "label") <- "Rare Category Variable"

  # Test with hide_for_crowd_if_category_n_below = 5 (should hide variable with category having 2 obs)
  result_hide <- makeme(
    data = test_data,
    dep = rare_cat_var,
    type = "cat_table_html",
    hide_for_crowd_if_category_n_below = 5
  )

  # rare_cat_var should be hidden due to "Yes" category having only 2 observations
  expect_true(is.data.frame(result_hide))
  expect_equal(nrow(result_hide), 0) # No variables remain

  # Test with hide_for_crowd_if_category_n_below = 1 (should include variable)
  result_keep <- makeme(
    data = test_data,
    dep = rare_cat_var,
    type = "cat_table_html",
    hide_for_crowd_if_category_n_below = 1
  )

  # rare_cat_var should be included
  expect_true(is.data.frame(result_keep))
  expect_equal(nrow(result_keep), 1) # Variable present
})

test_that("makeme respects hide_for_crowd_if_cell_n_below argument with indep variable", {
  data("ex_survey", package = "saros")

  # Use existing variables that should create small cells when crossed with gender
  test_data <- ex_survey[1:30, ] # 15 males, 15 females roughly

  # Test with hide_for_crowd_if_cell_n_below = 20 and independent variable
  # This should hide variables that create cells smaller than 20
  result_hide <- makeme(
    data = test_data,
    dep = a_1,
    indep = x1_sex,
    type = "cat_table_html",
    hide_for_crowd_if_cell_n_below = 20
  )

  # With only 30 rows and gender split, cells will be small - might hide variable
  expect_true(is.data.frame(result_hide))

  # Test with hide_for_crowd_if_cell_n_below = 2 (more permissive)
  result_keep <- makeme(
    data = test_data,
    dep = a_1,
    indep = x1_sex,
    type = "cat_table_html",
    hide_for_crowd_if_cell_n_below = 2
  )

  # Should be included with lower threshold
  expect_true(is.data.frame(result_keep))
  # With 30 rows, we should have at least some data
  expect_true(nrow(result_keep) >= 0)
})

test_that("makeme hide arguments work with integer variables", {
  data("ex_survey", package = "saros")

  # Test with integer/numeric variables
  test_data <- ex_survey[1:50, ]
  test_data$all_na_int <- NA_integer_
  attr(test_data$all_na_int, "label") <- "All NA Integer"
  test_data$few_valid_int <- c(rep(1L, 3), rep(NA_integer_, 47))
  attr(test_data$few_valid_int, "label") <- "Few Valid Integer"

  # Test all_na_int individually
  result_all_na <- makeme(
    data = test_data,
    dep = all_na_int,
    type = "int_table_html",
    hide_for_crowd_if_all_na = TRUE
  )

  # all_na_int should be hidden (all NA)
  expect_true(is.data.frame(result_all_na))
  expect_equal(nrow(result_all_na), 0) # No variables remain

  # Test few_valid_int individually
  result_few_valid <- makeme(
    data = test_data,
    dep = few_valid_int,
    type = "int_table_html",
    hide_for_crowd_if_valid_n_below = 5
  )

  # few_valid_int should be hidden (< 5 valid values)
  expect_true(is.data.frame(result_few_valid))
  expect_equal(nrow(result_few_valid), 0) # No variables remain

  # Test normal variable c_1 (should always be included)
  result_normal <- makeme(
    data = test_data,
    dep = c_1,
    type = "int_table_html",
    hide_for_crowd_if_all_na = TRUE,
    hide_for_crowd_if_valid_n_below = 5
  )

  # c_1 should be included
  expect_true(is.data.frame(result_normal))
  expect_equal(nrow(result_normal), 1) # c_1 remains
})

test_that("makeme hide arguments work correctly with mesos functionality", {
  data("ex_survey", package = "saros")

  # Test with mesos/crowd functionality using existing variables
  result_all <- makeme(
    data = ex_survey,
    dep = a_1,
    crowd = "all",
    mesos_var = "f_uni",
    mesos_group = "Uni of A",
    type = "cat_table_html",
    hide_for_crowd_if_all_na = TRUE,
    hide_for_crowd_if_valid_n_below = 5
  )

  expect_true(is.data.frame(result_all))
  # a_1 should be included as it has valid data
  expect_equal(nrow(result_all), 1)
})

test_that("makeme hide arguments preserve expected output structure when hiding variables", {
  data("ex_survey", package = "saros")

  # Test that when variables are hidden, the output structure remains consistent
  test_data <- ex_survey[1:30, ]

  # Test with variables that should be included
  result_keep <- makeme(
    data = test_data,
    dep = c(a_1, a_2),
    type = "cat_table_html",
    hide_for_crowd_if_all_na = TRUE
  )

  # Should include both a_1 and a_2
  expect_true(is.data.frame(result_keep))
  expect_equal(nrow(result_keep), 2) # Both variables
  expect_equal(ncol(result_keep), 5) # Standard cat_table_html columns
  expect_true(all(
    c("No (%)", "Yes (%)", "NA (%)", "Total (N)") %in% colnames(result_keep)
  ))

  # Test with variables that should be hidden due to insufficient data
  test_data_sparse <- test_data[1:5, ] # Very small sample

  result_hide <- makeme(
    data = test_data_sparse,
    dep = c(a_1, a_2),
    type = "cat_table_html",
    hide_for_crowd_if_valid_n_below = 10 # Require at least 10 valid observations
  )

  # Variables should be hidden due to insufficient valid observations
  expect_true(is.data.frame(result_hide))
  expect_equal(nrow(result_hide), 0) # No variables should remain
})

test_that("makeme hide arguments work with combinations of hiding conditions", {
  data("ex_survey", package = "saros")

  # Test with multiple hiding conditions using individual variables
  test_data <- ex_survey[1:40, ]

  # Test variable that should pass all conditions (normal a_1)
  result_pass <- makeme(
    data = test_data,
    dep = a_1,
    type = "cat_table_html",
    hide_for_crowd_if_all_na = TRUE,
    hide_for_crowd_if_category_k_below = 2,
    hide_for_crowd_if_valid_n_below = 5
  )

  # a_1 should pass all conditions and be included
  expect_true(is.data.frame(result_pass))
  expect_equal(nrow(result_pass), 1)

  # Create and test a variable that should fail conditions
  test_data$single_cat <- factor(rep("No", 40), levels = c("No", "Yes"))
  attr(test_data$single_cat, "label") <- "Only No Responses"

  result_fail <- makeme(
    data = test_data,
    dep = single_cat,
    type = "cat_table_html",
    hide_for_crowd_if_category_k_below = 2 # Should hide single-category variable
  )

  # single_cat should fail the category count condition
  expect_true(is.data.frame(result_fail))
  expect_equal(nrow(result_fail), 0) # Should be hidden
})

test_that("makeme hide arguments default values work as expected", {
  data("ex_survey", package = "saros")

  # Test default behavior with standard data
  result_defaults <- makeme(
    data = ex_survey,
    dep = c(a_1, a_2, a_3),
    type = "cat_table_html"
    # Using all default values for hide_for_crowd_if_* parameters
  )

  expect_true(is.data.frame(result_defaults))
  expect_equal(nrow(result_defaults), 3) # All three variables should be included with defaults

  # Verify default values are working by checking they're not too restrictive
  expect_true(all(result_defaults$`Total (N)` == 300))
  expect_true(all(grepl("Agreement", result_defaults$.variable_label)))
})