diff --git a/tests/testthat/test-testThenRank.R b/tests/testthat/test-testThenRank.R index 9c78216..d03b6e5 100644 --- a/tests/testthat/test-testThenRank.R +++ b/tests/testthat/test-testThenRank.R @@ -1,91 +1,108 @@ test_that("test-then-rank raises warning for one case", { data <- rbind( data.frame(algo="A1", value=0.6, case="C1"), data.frame(algo="A2", value=0.8, case="C1")) challenge <- as.challenge(data, taskName="T1", algorithm="algo", case="case", value="value", smallBetter = TRUE) expect_warning(ranking <- challenge%>%testThenRank(), "Only one case in task.", fixed = TRUE) expectedRanking <- rbind( "A1" = data.frame(prop_significance = 0, rank = 1), "A2" = data.frame(prop_significance = 0, rank = 1)) expect_equal(ranking$matlist$T1, expectedRanking) }) test_that("test-then-rank works with two algorithms, small values are better", { data <- rbind( data.frame(algo="A1", value=0.2, case="C1"), data.frame(algo="A1", value=0.2, case="C2"), data.frame(algo="A1", value=0.2, case="C3"), data.frame(algo="A1", value=0.2, case="C4"), data.frame(algo="A2", value=1.0, case="C1"), data.frame(algo="A2", value=1.0, case="C2"), data.frame(algo="A2", value=1.0, case="C3"), data.frame(algo="A2", value=1.0, case="C4")) challenge <- as.challenge(data, taskName="T1", algorithm="algo", case="case", value="value", smallBetter = TRUE) ranking <- challenge%>%testThenRank() expectedRanking <- rbind( "A1" = data.frame(prop_significance = 1, rank = 1), "A2" = data.frame(prop_significance = 0, rank = 2)) expect_equal(ranking$matlist$T1, expectedRanking) }) test_that("test-then-rank works with two algorithms, large values are better", { data <- rbind( data.frame(algo="A1", value=0.2, case="C1"), data.frame(algo="A1", value=0.2, case="C2"), data.frame(algo="A1", value=0.2, case="C3"), data.frame(algo="A1", value=0.2, case="C4"), data.frame(algo="A2", value=1.0, case="C1"), data.frame(algo="A2", value=1.0, case="C2"), data.frame(algo="A2", value=1.0, case="C3"), data.frame(algo="A2", value=1.0, case="C4")) challenge <- as.challenge(data, taskName="T1", algorithm="algo", case="case", value="value", smallBetter = FALSE) ranking <- challenge%>%testThenRank() expectedRanking <- rbind( "A1" = data.frame(prop_significance = 0, rank = 2), "A2" = data.frame(prop_significance = 1, rank = 1)) expect_equal(ranking$matlist$T1, expectedRanking) }) test_that("test-then-rank works for ties method 'max'", { data <- rbind( data.frame(algo="A1", value=0.6, case="C1"), data.frame(algo="A1", value=0.6, case="C2"), data.frame(algo="A2", value=0.8, case="C1"), data.frame(algo="A2", value=0.8, case="C2")) challenge <- as.challenge(data, taskName="T1", algorithm="algo", case="case", value="value", smallBetter = TRUE) ranking <- challenge%>%testThenRank(ties.method = "max") expectedRanking <- rbind( "A1" = data.frame(prop_significance = 0, rank = 2), "A2" = data.frame(prop_significance = 0, rank = 2)) expect_equal(ranking$matlist$T1, expectedRanking) }) test_that("test-then-rank raises error for invalid ties method", { data <- rbind( data.frame(algo="A1", value=0.6, case="C1"), data.frame(algo="A1", value=0.6, case="C2"), data.frame(algo="A2", value=0.8, case="C1"), data.frame(algo="A2", value=0.8, case="C2")) challenge <- as.challenge(data, taskName="T1", algorithm="algo", case="case", value="value", smallBetter = TRUE) expect_error(challenge%>%testThenRank(FUN = mean, ties.method = "maxx"), "'arg' should be one of \"average\", \"first\", \"last\", \"random\", \"max\", \"min\"", fixed = TRUE) }) + +test_that("test-then-rank raises error for invalid ties method even when no ties present", { + data <- rbind( + data.frame(algo="A1", value=0.2, case="C1"), + data.frame(algo="A1", value=0.2, case="C2"), + data.frame(algo="A1", value=0.2, case="C3"), + data.frame(algo="A1", value=0.2, case="C4"), + data.frame(algo="A2", value=1.0, case="C1"), + data.frame(algo="A2", value=1.0, case="C2"), + data.frame(algo="A2", value=1.0, case="C3"), + data.frame(algo="A2", value=1.0, case="C4")) + + challenge <- as.challenge(data, taskName="T1", algorithm="algo", case="case", value="value", smallBetter = TRUE) + + expect_error(challenge%>%testThenRank(FUN = mean, ties.method = "maxx"), + "'arg' should be one of \"average\", \"first\", \"last\", \"random\", \"max\", \"min\"", fixed = TRUE) +})