tests/testthat/helper.R

In fastVoteR: Efficient Voting Methods for Committee Selection

# Create some example inputs for testing

# large data example
set.seed(42)

n_candidates = 800
n_voters = 200

cand = paste0("V", seq_len(n_candidates))
vot = lapply(1:n_voters, function(x) sample(cand, size = sample(2:30, 1)))
w = runif(n_voters)
we = rep(1, n_voters) # equal weights

# small data example
cand2 = paste0("V", seq_len(5))
# "V3" candidate in all sets, "V1" in half, "V2", "V4" once, "V5" nowhere!
vot2 = list(
  c("V3", "V1", "V2"),
  c("V3", "V1"),
  c("V3", "V4"),
  c("V3")
)
w2 = c(0.27, 0.23, 0.4, 0.5)
we2 = rep(1, length(vot2))

# edge case: all voters voted the same candidates, "V4" and "V5" are nowhere!
# equal/same votes
vot_equal = list(
  c("V3", "V1", "V2"),
  c("V3", "V1", "V2"),
  c("V3", "V1", "V2"),
  c("V3", "V1", "V2")
)

test_large_example = function(method_fun, committee_size = NULL) {
  # unequal weights
  res = method_fun(vot, cand, w, committee_size)
  size = ifelse(is.null(committee_size), length(cand), committee_size)

  expect_data_table(res, nrows = size, min.cols = 2, max.cols = 4)
  expect_contains(colnames(res), c("candidate", "borda_score"))

  # committee candidates are included in the candidates
  if (is.null(committee_size)) {
    expect_set_equal(res$candidate, cand)
  } else {
    expect_in(res$candidate, cand)
  }

  # scores must be positive
  if (!is.null(res$score)) {
    expect_true(all(res$score >= 0))
  }

  # normalized scores behave like probabilities
  if (!is.null(res$norm_score)) {
    expect_true(all(res$norm_score >= 0 & res$norm_score <= 1))
  }

  # house monotonicy check: ordering remains the same with less committee members
  res_less = method_fun(vot, cand, w, committee_size = 3)
  expect_equal(res_less$candidate, res$candidate[1:3])

  # equal weights
  res_equal = method_fun(vot, cand, we, committee_size)

  expect_data_table(res_equal, nrows = size, min.cols = 2, max.cols = 4)
  expect_contains(colnames(res_equal), c("candidate", "borda_score"))

  # committee candidates are included in the candidates
  if (is.null(committee_size)) {
    expect_set_equal(res_equal$candidate, cand)
  } else {
    expect_in(res_equal$candidate, cand)
  }

  # scores must be positive
  if (!is.null(res_equal$score)) {
    expect_true(all(res_equal$score >= 0))
  }

  # normalized scores behave like probabilities
  if (!is.null(res_equal$norm_score)) {
    expect_true(all(res_equal$norm_score >= 0 & res_equal$norm_score <= 1))
  }

  # house monotonicy check: ordering remains the same with less committee members
  res_equal_less = method_fun(vot, cand, we, committee_size = 3)
  expect_equal(res_equal_less$candidate, res_equal$candidate[1:3])

  # using different weights, candidate rankings should be different
  expect_false(identical(res$candidate, res_equal$candidate))
}

test_borda_score = function(method_fun) {
  # uses small data example
  # no borda score in the output result
  res = method_fun(vot2, cand2, w2, borda_score = FALSE)
  expect_error(expect_in("borda_score", colnames(res)))

  # borda score in the output result
  res = method_fun(vot2, cand2, w2, borda_score = TRUE)
  expect_in("borda_score", colnames(res))
  # borda scores make sense
  expect_equal(res$borda_score[1], 1) # top candidate
  expect_equal(res$borda_score[length(cand2)], 0) # lowest-ranked candidate

  # borda score takes into account the total number of candidates, so last score is not 0
  # when committee_size < #candidates
  res = method_fun(vot2, cand2, w2, committee_size = 2, borda_score = TRUE)
  expect_gt(res$borda_score[2] , 0)
}

test_equal_votes = function(method_fun) {
  res = method_fun(vot_equal, cand2, w2)
  expect_contains(res$candidate[1:3], c("V1", "V2", "V3"))
  expect_contains(res$candidate[4:5], c("V4", "V5")) # V4, V5 were never voted

  # if scores are present, V1, V2 and V3 should have the same positive scores,
  # V4 and V5 zero
  if (!is.null(res$score)) {
    expect_true(length(unique(res$score[1:3])) == 1) # all scores the same
    expect_true(all(res$score[1:3] > 0))
    expect_equal(res$score[4:5], c(0, 0))
  }
}