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)")
})
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.