tests/testthat/test-PowerRelation.R

test_that("basic", {
  pr <- PowerRelation(list(list(c(2,1)),list(1),list(2)))
  expect_equal(pr$elements, c(1, 2))
  expect_equal(pr$eqs, list(list(c(1,2)), list(c(1)), list(c(2))))

  expect_equal(pr$coalitionLookup(c(1,2)), 1)
  expect_equal(pr$coalitionLookup(1), 2)
  expect_equal(pr$coalitionLookup(2), 3)

  expect_equal(pr$elementLookup(1), list(c(1,1), c(2,1)))
  expect_equal(pr$elementLookup(2), list(c(1,1), c(3,1)))
})

test_that("element types", {
  pr <- PowerRelation(list(list(c("a",2)), list("a", 2)))
  expect_equal(pr$elements, c('2','a'))
  expect_equal(pr$eqs, list(list(c('2','a')), list(c('a'), c(2))))
})

test_that("empty eqs exception", {
  expect_error(PowerRelation(list()))
  expect_error(PowerRelation(list(list())))
  expect_error(PowerRelation(list(list(1), list(), list(2))))
})

test_that("from string", {
  pr <- as.PowerRelation("12 > 1 ~ 2")
  expect_equal(pr, PowerRelation(list(list(c(1,2)), list(1, 2))))

  pr <- as.PowerRelation("ab > a ~ b")
  expect_equal(pr, PowerRelation(list(list(c("a","b")), list("a", "b"))))


  pr <- as.PowerRelation("12 > (1 ~ 2).:;-*/\\")
  expect_equal(pr, PowerRelation(list(list(c(1,2)), list(1, 2))))

  pr <- as.PowerRelation("a ~ {} > b")
  expect_equal(pr, PowerRelation(list(list("a", c()), list("b"))))

  pr <- as.PowerRelation("{} > a > b")
  expect_equal(pr, PowerRelation(list(list(c()), list("a"), list("b"))))
})

test_that("from list", {
  pr <- as.PowerRelation(list(c(1,2), 1, 2))
  expect_equal(pr, PowerRelation(list(list(c(1,2)), list(1), list(2))))

  pr <- as.PowerRelation(list(c(1,2), 1, 2), comparators = '>')
  expect_equal(pr, PowerRelation(list(list(c(1,2)), list(1), list(2))))

  pr <- as.PowerRelation(list(c(1,2), 1, 2), comparators = '~')
  expect_equal(pr, PowerRelation(list(list(c(1,2), 1, 2))))

  pr <- as.PowerRelation(list(c(1,2), 1, 2), comparators = c('>', '~'))
  expect_equal(pr, PowerRelation(list(list(c(1,2)), list(1, 2))))
})


test_that("output", {
  result <- evaluate_promise(as.PowerRelation("1 > 2 ~ 12"), print = TRUE)
  expect_equal(result$output, "1 > (2 ~ 12)")


  result <- evaluate_promise(PowerRelation(list(list(c('de','at')),list('b',c('de','b')))), print = TRUE)
  expect_equal(result$output, "{at, de} > ({b} ~ {b, de})")
})


test_that("cycle warning", {
  result <- evaluate_promise(as.PowerRelation("1 > 1"))
  expect_length(result$warnings, 1)
  expect_equal(result$warnings[1], "Found 1 duplicate coalition, listed below. This violates transitivity and can cause issues with certain ranking solutions. You may want to take a look at socialranking::transitiveClosure().
    - {1}")

  result <- evaluate_promise(as.PowerRelation("1 > 1 ~ 2 > 2"))
  expect_length(result$warnings, 1)
  expect_equal(result$warnings[1], "Found 2 duplicate coalitions, listed below. This violates transitivity and can cause issues with certain ranking solutions. You may want to take a look at socialranking::transitiveClosure().
    - {1}
    - {2}")

  result <- evaluate_promise(as.PowerRelation("12 > 12 ~ 123 > 12"))
  expect_length(result$warnings, 1)
  expect_equal(result$warnings[1], "Found 1 duplicate coalition, listed below. This violates transitivity and can cause issues with certain ranking solutions. You may want to take a look at socialranking::transitiveClosure().
    - {1, 2}")

  result <- evaluate_promise(PowerRelation(list(list(c("ab", "cd", "ef")), list(c("ab", "cd", "ef")))))
  expect_length(result$warnings, 1)
  expect_equal(result$warnings[1], "Found 1 duplicate coalition, listed below. This violates transitivity and can cause issues with certain ranking solutions. You may want to take a look at socialranking::transitiveClosure().
    - {ab, cd, ef}")
})

test_that("duplicate elements", {
  result <- evaluate_promise(as.PowerRelation("11 > 12"))
  expect_length(result$warnings, 1)
  expect_equal(result$warnings[1], "Found 1 coalition that contain elements more than once.\n    - 1 in the coalition {1, 1}")

  result <- evaluate_promise(as.PowerRelation("11 > 121 > 313133"))
  expect_length(result$warnings, 1)
  expect_equal(result$warnings[1], "Found 3 coalitions that contain elements more than once.\n    - 1 in the coalition {1, 1}\n    - 1 in the coalition {1, 1, 2}\n    - 1, 3 in the coalition {1, 1, 3, 3, 3, 3}")

  result <- evaluate_promise(as.PowerRelation("121 > 123 > 121"))
  expect_length(result$warnings, 2)
})

test_that("equality", {
  expect_true(
    as.PowerRelation("1 ~ 12 ~ 3") ==
    as.PowerRelation("12 ~ 3 ~ 1")
  )
  expect_true(
    as.PowerRelation("12 > 1 ~ 2") ==
    as.PowerRelation("12 > 2 ~ 1")
  )

  expect_false(
    as.PowerRelation("12 > 1 ~ 2") ==
    as.PowerRelation("1 > 12 ~ 2")
  )
})

test_that("coalitionsAreIndifferent", {
  pr <- as.PowerRelation("123 ~ 2 > 12 ~ 1 ~ 3 > {}")
  expect_true(coalitionsAreIndifferent(pr, c(1,2,3), 2))
  expect_true(coalitionsAreIndifferent(pr, 2, c(1,2,3)))
  expect_false(coalitionsAreIndifferent(pr, 2, c()))
  expect_false(coalitionsAreIndifferent(pr, 3, c(1,2,3)))
})

test_that("equivalenceClassIndex", {
  pr <- as.PowerRelation("123 ~ 2 > 12 ~ 1 ~ 3 > {}")
  expect_equal(equivalenceClassIndex(pr, c(1,2)), 2)
  expect_equal(equivalenceClassIndex(pr, c(2,1)), 2)
  expect_null(equivalenceClassIndex(pr, c(1,3)))
  expect_equal(equivalenceClassIndex(pr, c()), 3)
  expect_equal(equivalenceClassIndex, coalitionLookup)
})

test_that("elementLookup", {
  pr <- as.PowerRelation("123 ~ 2 > 12 ~ 1 ~ 3 > {}")
  expect_equal(elementLookup(pr, 1), list(c(1,1), c(2,1), c(2,2)))
  expect_equal(elementLookup(pr, 2), list(c(1,1), c(1,2), c(2,1)))
  expect_equal(elementLookup(pr, 3), list(c(1,1), c(2,3)))
  expect_null(elementLookup(pr, 4))

})

test_that("deprecated", {
  pr <- as.PowerRelation("123 ~ 2 > 12 ~ 1 ~ 3 > {}")
  expect_error(newPowerRelation(c(1,2), '>', 2))
  expect_error(newPowerRelationFromString("123 ~ 2 > 12 ~ 1 ~ 3 > {}"))
})

test_that("Inequality from differently sized lists", {
  expect_false({
    as.PowerRelation("12 > (13 ~ 1) >( 23 ~ 123 ~ 2 ~ 3)") ==
    as.PowerRelation("12 > (13 ~ 1 ~ 23 ~ 123 ~ 2 ~ 3)")
  })
  expect_false({
    as.PowerRelation("12 > (13 ~ 1) > (23 ~ 123 ~ 2 ~ 3)") ==
    as.PowerRelation("(12 ~ 13) > 1 > (23 ~ 123 ~ 2 ~ 3)")
  })
})
jassler/socialranking documentation built on March 29, 2025, 5:23 a.m.