diff --git a/tests/testthat/test-blobPlotStabilityByAlgorithm.R b/tests/testthat/test-blobPlotStabilityByAlgorithm.R
index 66d0ff6..392fe06 100644
--- a/tests/testthat/test-blobPlotStabilityByAlgorithm.R
+++ b/tests/testthat/test-blobPlotStabilityByAlgorithm.R
@@ -1,140 +1,207 @@
# Copyright (c) German Cancer Research Center (DKFZ)
# All rights reserved.
#
# This file is part of challengeR.
#
# challengeR is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 2 of the License, or
# (at your option) any later version.
#
# challengeR is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with challengeR. If not, see .
test_that("blob plot for visualizing ranking stability by algorithm raises error for single-task data set", {
data <- rbind(
data.frame(algo="A1", value=0.8, case="C1"),
data.frame(algo="A2", value=0.6, case="C1"),
data.frame(algo="A3", value=0.4, case="C1"),
data.frame(algo="A1", value=0.2, case="C2"),
data.frame(algo="A2", value=0.1, case="C2"),
data.frame(algo="A3", value=0.0, case="C2"))
challenge <- as.challenge(data, taskName="T1", algorithm="algo", case="case", value="value", smallBetter=FALSE)
ranking <- challenge%>%aggregateThenRank(FUN=median, ties.method="min")
set.seed(1)
rankingBootstrapped <- ranking%>%bootstrap(nboot=10)
expect_error(stabilityByAlgorithm(rankingBootstrapped),
"The stability of rankings by algorithm cannot be computed for less than two tasks.", fixed=TRUE)
})
test_that("blob plot for visualizing ranking stability by algorithm returns one plot for multi-task data set", {
dataTask1 <- cbind(task="T1",
rbind(
data.frame(algo="A1", value=0.8, case="C1"),
data.frame(algo="A2", value=0.6, case="C1"),
data.frame(algo="A3", value=0.4, case="C1"),
data.frame(algo="A1", value=0.2, case="C2"),
data.frame(algo="A2", value=0.1, case="C2"),
data.frame(algo="A3", value=0.0, case="C2")
))
dataTask2 <- cbind(task="T2",
rbind(
data.frame(algo="A1", value=0.2, case="C1"),
data.frame(algo="A2", value=0.3, case="C1"),
data.frame(algo="A3", value=0.4, case="C1"),
data.frame(algo="A1", value=0.7, case="C2"),
data.frame(algo="A2", value=0.8, case="C2"),
data.frame(algo="A3", value=0.9, case="C2")
))
data <- rbind(dataTask1, dataTask2)
challenge <- as.challenge(data, by="task", algorithm="algo", case="case", value="value", smallBetter=FALSE)
ranking <- challenge%>%aggregateThenRank(FUN=median, ties.method="min")
set.seed(1)
rankingBootstrapped <- ranking%>%bootstrap(nboot=10)
actualPlot <- stabilityByAlgorithm(rankingBootstrapped)
expect_is(actualPlot, "ggplot")
})
test_that("blob plot for visualizing ranking stability by algorithm returns a plot for each algorithm", {
dataTask1 <- cbind(task="T1",
rbind(
data.frame(algo="A1", value=0.8, case="C1"),
data.frame(algo="A2", value=0.6, case="C1"),
data.frame(algo="A3", value=0.4, case="C1"),
data.frame(algo="A1", value=0.2, case="C2"),
data.frame(algo="A2", value=0.1, case="C2"),
data.frame(algo="A3", value=0.0, case="C2")
))
dataTask2 <- cbind(task="T2",
rbind(
data.frame(algo="A1", value=0.2, case="C1"),
data.frame(algo="A2", value=0.3, case="C1"),
data.frame(algo="A3", value=0.4, case="C1"),
data.frame(algo="A1", value=0.7, case="C2"),
data.frame(algo="A2", value=0.8, case="C2"),
data.frame(algo="A3", value=0.9, case="C2")
))
data <- rbind(dataTask1, dataTask2)
challenge <- as.challenge(data, by="task", algorithm="algo", case="case", value="value", smallBetter=FALSE)
ranking <- challenge%>%aggregateThenRank(FUN=median, ties.method="min")
set.seed(1)
rankingBootstrapped <- ranking%>%bootstrap(nboot=10)
meanRanks <- ranking%>%consensus(method = "euclidean")
actualPlot <- stabilityByAlgorithm(rankingBootstrapped, ordering = names(meanRanks), single = TRUE)
expect_equal(length(actualPlot), 3)
expect_is(actualPlot[[1]], "ggplot")
expect_is(actualPlot[[2]], "ggplot")
expect_is(actualPlot[[3]], "ggplot")
})
-
-
test_that("Multi task bootstrapping, only one task with >1 test case stability plot works", {
dataTask1 <- cbind(task="T1",
rbind(
data.frame(algo="A1", value=0.8, case="C1"),
data.frame(algo="A2", value=0.6, case="C1")
))
dataTask2 <- cbind(task="T2",
rbind(
data.frame(algo="A1", value=0.2, case="C1"),
data.frame(algo="A2", value=0.3, case="C1"),
data.frame(algo="A1", value=0.2, case="C2"),
data.frame(algo="A2", value=0.3, case="C2")
))
dataTask3 <- cbind(task="T3",
rbind(
data.frame(algo="A1", value=0.1, case="C1"),
data.frame(algo="A2", value=0.8, case="C1")
))
-
+
data <- rbind(dataTask1, dataTask2, dataTask3)
-
+
challenge <- as.challenge(data, by="task", algorithm="algo", case="case", value="value", smallBetter=FALSE)
-
+
ranking <- challenge%>%aggregateThenRank(FUN=median, ties.method="min")
rankingBootstrapped <- ranking%>%bootstrap(nboot=3)
meanRanks <- ranking%>%consensus(method = "euclidean")
actualPlot <- stabilityByAlgorithm(rankingBootstrapped, ordering = names(meanRanks), single = FALSE)
expect_is(actualPlot, "ggplot")
})
+
+test_that("blob plot for visualizing ranking stability by algorithm returns one plot if #algorithms equals #tasks", {
+ dataTask1 <- cbind(task="T1",
+ rbind(
+ data.frame(algo="A1", value=0.8, case="C1"),
+ data.frame(algo="A2", value=0.6, case="C1"),
+ data.frame(algo="A1", value=0.2, case="C2"),
+ data.frame(algo="A2", value=0.1, case="C2")
+ ))
+ dataTask2 <- cbind(task="T2",
+ rbind(
+ data.frame(algo="A1", value=0.2, case="C1"),
+ data.frame(algo="A2", value=0.3, case="C1"),
+ data.frame(algo="A1", value=0.7, case="C2"),
+ data.frame(algo="A2", value=0.8, case="C2")
+ ))
+
+ data <- rbind(dataTask1, dataTask2)
+
+ challenge <- as.challenge(data, by="task", algorithm="algo", case="case", value="value", smallBetter=FALSE)
+
+ ranking <- challenge%>%aggregateThenRank(FUN=median, ties.method="min")
+
+ set.seed(1)
+ rankingBootstrapped <- ranking%>%bootstrap(nboot=10)
+
+ meanRanks <- ranking%>%consensus(method = "euclidean")
+
+ actualPlot <- stabilityByAlgorithm(rankingBootstrapped, ordering = names(meanRanks), single = FALSE)
+ expect_is(actualPlot, "ggplot")
+})
+
+test_that("blob plot for visualizing ranking stability by algorithm returns one plot if #algorithms < #tasks", {
+ dataTask1 <- cbind(task="T1",
+ rbind(
+ data.frame(algo="A1", value=0.8, case="C1"),
+ data.frame(algo="A2", value=0.6, case="C1"),
+ data.frame(algo="A1", value=0.8, case="C2"),
+ data.frame(algo="A2", value=0.6, case="C2")
+ ))
+ dataTask2 <- cbind(task="T2",
+ rbind(
+ data.frame(algo="A1", value=0.2, case="C1"),
+ data.frame(algo="A2", value=0.3, case="C1"),
+ data.frame(algo="A1", value=0.2, case="C2"),
+ data.frame(algo="A2", value=0.3, case="C2")
+ ))
+ dataTask3 <- cbind(task="T3",
+ rbind(
+ data.frame(algo="A1", value=0.1, case="C1"),
+ data.frame(algo="A2", value=0.8, case="C1"),
+ data.frame(algo="A1", value=0.1, case="C2"),
+ data.frame(algo="A2", value=0.8, case="C2")
+ ))
+
+ data <- rbind(dataTask1, dataTask2, dataTask3)
+
+ challenge <- as.challenge(data, by="task", algorithm="algo", case="case", value="value", smallBetter=FALSE)
+
+ ranking <- challenge%>%aggregateThenRank(FUN=median, ties.method="min")
+
+ set.seed(1)
+ rankingBootstrapped <- ranking%>%bootstrap(nboot=10)
+
+ meanRanks <- ranking%>%consensus(method = "euclidean")
+
+ actualPlot <- stabilityByAlgorithm(rankingBootstrapped, ordering = names(meanRanks), single = FALSE)
+ expect_is(actualPlot, "ggplot")
+})
diff --git a/tests/testthat/test-report.R b/tests/testthat/test-report.R
index 54c0fbd..f911f0b 100644
--- a/tests/testthat/test-report.R
+++ b/tests/testthat/test-report.R
@@ -1,485 +1,536 @@
# Copyright (c) German Cancer Research Center (DKFZ)
# All rights reserved.
#
# This file is part of challengeR.
#
# challengeR is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 2 of the License, or
# (at your option) any later version.
#
# challengeR is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with challengeR. If not, see .
test_that("PDF report for single-task data set without bootstrapping is created", {
data <- rbind(
data.frame(algo="A1", value=0.8, case="C1"),
data.frame(algo="A2", value=0.6, case="C1"))
challenge <- as.challenge(data, taskName="T1", algorithm="algo", case="case", value="value", smallBetter=FALSE)
ranking <- challenge%>%aggregateThenRank(FUN=median, ties.method="min")
ranking %>%
report(title="Test Challenge",
file="testthat_single_task_no_bootstrapping",
format="PDF",
clean=TRUE,
open=FALSE)
expect_true(file.exists("testthat_single_task_no_bootstrapping.pdf"))
# Clean up
if (file.exists("testthat_single_task_no_bootstrapping.pdf")) {
file.remove("testthat_single_task_no_bootstrapping.pdf")
}
})
test_that("HTML report for single-task data set without bootstrapping is created", {
data <- rbind(
data.frame(algo="A1", value=0.8, case="C1"),
data.frame(algo="A2", value=0.6, case="C1"))
challenge <- as.challenge(data, taskName="T1", algorithm="algo", case="case", value="value", smallBetter=FALSE)
ranking <- challenge%>%aggregateThenRank(FUN=median, ties.method="min")
ranking %>%
report(title="Test Challenge",
file="testthat_single_task_no_bootstrapping",
format="HTML",
clean=TRUE,
open=FALSE)
expect_true(file.exists("testthat_single_task_no_bootstrapping.html"))
# Clean up
if (file.exists("testthat_single_task_no_bootstrapping.html")) {
file.remove("testthat_single_task_no_bootstrapping.html")
}
})
test_that("Word report for single-task data set without bootstrapping is created", {
data <- rbind(
data.frame(algo="A1", value=0.8, case="C1"),
data.frame(algo="A2", value=0.6, case="C1"))
challenge <- as.challenge(data, taskName="T1", algorithm="algo", case="case", value="value", smallBetter=FALSE)
ranking <- challenge%>%aggregateThenRank(FUN=median, ties.method="min")
ranking %>%
report(title="Test Challenge",
file="testthat_single_task_no_bootstrapping",
format="Word",
clean=TRUE,
open=FALSE)
expect_true(file.exists("testthat_single_task_no_bootstrapping.docx"))
# Clean up
if (file.exists("testthat_single_task_no_bootstrapping.docx")) {
file.remove("testthat_single_task_no_bootstrapping.docx")
}
})
test_that("PDF report for single-task data set with bootstrapping is created", {
data <- rbind(
data.frame(algo="A1", value=0.8, case="C1"),
data.frame(algo="A2", value=0.6, case="C1"),
data.frame(algo="A3", value=0.4, case="C1"),
data.frame(algo="A1", value=0.2, case="C2"),
data.frame(algo="A2", value=0.1, case="C2"),
data.frame(algo="A3", value=0.0, case="C2"))
challenge <- as.challenge(data, taskName="T1", algorithm="algo", case="case", value="value", smallBetter=FALSE)
ranking <- challenge%>%aggregateThenRank(FUN=median, ties.method="min")
set.seed(1)
rankingBootstrapped <- ranking%>%bootstrap(nboot=10)
rankingBootstrapped %>%
report(title="Test Challenge",
file="testthat_single_task_bootstrapping",
format="PDF",
clean=TRUE,
open=FALSE)
expect_true(file.exists("testthat_single_task_bootstrapping.pdf"))
# Clean up
if (file.exists("testthat_single_task_bootstrapping.pdf")) {
file.remove("testthat_single_task_bootstrapping.pdf")
}
})
test_that("HTML report for single-task data set with bootstrapping is created", {
data <- rbind(
data.frame(algo="A1", value=0.8, case="C1"),
data.frame(algo="A2", value=0.6, case="C1"),
data.frame(algo="A3", value=0.4, case="C1"),
data.frame(algo="A1", value=0.2, case="C2"),
data.frame(algo="A2", value=0.1, case="C2"),
data.frame(algo="A3", value=0.0, case="C2"))
challenge <- as.challenge(data, taskName="T1", algorithm="algo", case="case", value="value", smallBetter=FALSE)
ranking <- challenge%>%aggregateThenRank(FUN=median, ties.method="min")
set.seed(1)
rankingBootstrapped <- ranking%>%bootstrap(nboot=10)
rankingBootstrapped %>%
report(title="Test Challenge",
file="testthat_single_task_bootstrapping",
format="HTML",
clean=TRUE,
open=FALSE)
expect_true(file.exists("testthat_single_task_bootstrapping.html"))
# Clean up
if (file.exists("testthat_single_task_bootstrapping.html")) {
file.remove("testthat_single_task_bootstrapping.html")
}
})
test_that("Word report for single-task data set with bootstrapping is created", {
data <- rbind(
data.frame(algo="A1", value=0.8, case="C1"),
data.frame(algo="A2", value=0.6, case="C1"),
data.frame(algo="A3", value=0.4, case="C1"),
data.frame(algo="A1", value=0.2, case="C2"),
data.frame(algo="A2", value=0.1, case="C2"),
data.frame(algo="A3", value=0.0, case="C2"))
challenge <- as.challenge(data, taskName="T1", algorithm="algo", case="case", value="value", smallBetter=FALSE)
ranking <- challenge%>%aggregateThenRank(FUN=median, ties.method="min")
set.seed(1)
rankingBootstrapped <- ranking%>%bootstrap(nboot=10)
rankingBootstrapped %>%
report(title="Test Challenge",
file="testthat_single_task_bootstrapping",
format="Word",
clean=TRUE,
open=FALSE)
expect_true(file.exists("testthat_single_task_bootstrapping.docx"))
# Clean up
if (file.exists("testthat_single_task_bootstrapping.docx")) {
file.remove("testthat_single_task_bootstrapping.docx")
}
})
test_that("PDF report for multi-task data set without bootstrapping is created", {
dataTask1 <- cbind(task="T1",
rbind(
data.frame(algo="A1", value=0.8, case="C1"),
data.frame(algo="A2", value=0.6, case="C1")
))
dataTask2 <- cbind(task="T2",
rbind(
data.frame(algo="A1", value=0.2, case="C1"),
data.frame(algo="A2", value=0.3, case="C1")
))
dataTask3 <- cbind(task="T3",
rbind(
data.frame(algo="A1", value=0.1, case="C1"),
data.frame(algo="A2", value=0.8, case="C1")
))
data <- rbind(dataTask1, dataTask2, dataTask3)
challenge <- as.challenge(data, by="task", algorithm="algo", case="case", value="value", smallBetter=FALSE)
ranking <- challenge%>%aggregateThenRank(FUN=median, ties.method="min")
meanRanks <- ranking%>%consensus(method = "euclidean")
ranking %>%
report(consensus=meanRanks,
title="Test Challenge",
file="testthat_multi_task_no_bootstrapping",
format="PDF",
clean=TRUE,
open=FALSE)
expect_true(file.exists("testthat_multi_task_no_bootstrapping.pdf"))
# Clean up
if (file.exists("testthat_multi_task_no_bootstrapping.pdf")) {
file.remove("testthat_multi_task_no_bootstrapping.pdf")
}
})
test_that("HTML report for multi-task data set without bootstrapping is created", {
dataTask1 <- cbind(task="T1",
rbind(
data.frame(algo="A1", value=0.8, case="C1"),
data.frame(algo="A2", value=0.6, case="C1")
))
dataTask2 <- cbind(task="T2",
rbind(
data.frame(algo="A1", value=0.2, case="C1"),
data.frame(algo="A2", value=0.3, case="C1")
))
dataTask3 <- cbind(task="T3",
rbind(
data.frame(algo="A1", value=0.1, case="C1"),
data.frame(algo="A2", value=0.8, case="C1")
))
data <- rbind(dataTask1, dataTask2, dataTask3)
challenge <- as.challenge(data, by="task", algorithm="algo", case="case", value="value", smallBetter=FALSE)
ranking <- challenge%>%aggregateThenRank(FUN=median, ties.method="min")
meanRanks <- ranking%>%consensus(method = "euclidean")
ranking %>%
report(consensus=meanRanks,
title="Test Challenge",
file="testthat_multi_task_no_bootstrapping",
format="HTML",
clean=TRUE,
open=FALSE)
expect_true(file.exists("testthat_multi_task_no_bootstrapping.html"))
# Clean up
if (file.exists("testthat_multi_task_no_bootstrapping.html")) {
file.remove("testthat_multi_task_no_bootstrapping.html")
}
})
test_that("Word report for multi-task data set without bootstrapping is created", {
dataTask1 <- cbind(task="T1",
rbind(
data.frame(algo="A1", value=0.8, case="C1"),
data.frame(algo="A2", value=0.6, case="C1")
))
dataTask2 <- cbind(task="T2",
rbind(
data.frame(algo="A1", value=0.2, case="C1"),
data.frame(algo="A2", value=0.3, case="C1")
))
dataTask3 <- cbind(task="T3",
rbind(
data.frame(algo="A1", value=0.1, case="C1"),
data.frame(algo="A2", value=0.8, case="C1")
))
data <- rbind(dataTask1, dataTask2, dataTask3)
challenge <- as.challenge(data, by="task", algorithm="algo", case="case", value="value", smallBetter=FALSE)
ranking <- challenge%>%aggregateThenRank(FUN=median, ties.method="min")
meanRanks <- ranking%>%consensus(method = "euclidean")
ranking %>%
report(consensus=meanRanks,
title="Test Challenge",
file="testthat_multi_task_no_bootstrapping",
format="Word",
clean=TRUE,
open=FALSE)
expect_true(file.exists("testthat_multi_task_no_bootstrapping.docx"))
# Clean up
if (file.exists("testthat_multi_task_no_bootstrapping.docx")) {
file.remove("testthat_multi_task_no_bootstrapping.docx")
}
})
test_that("PDF report for multi-task data set with bootstrapping is created", {
dataTask1 <- cbind(task="T1",
rbind(
data.frame(algo="A1", value=0.8, case="C1"),
data.frame(algo="A2", value=0.6, case="C1"),
data.frame(algo="A3", value=0.4, case="C1"),
data.frame(algo="A1", value=0.2, case="C2"),
data.frame(algo="A2", value=0.1, case="C2"),
data.frame(algo="A3", value=0.0, case="C2")
))
dataTask2 <- cbind(task="T2",
rbind(
data.frame(algo="A1", value=0.2, case="C1"),
data.frame(algo="A2", value=0.3, case="C1"),
data.frame(algo="A3", value=0.4, case="C1"),
data.frame(algo="A1", value=0.7, case="C2"),
data.frame(algo="A2", value=0.8, case="C2"),
data.frame(algo="A3", value=0.9, case="C2")
))
dataTask3 <- cbind(task="T3",
rbind(
data.frame(algo="A1", value=0.1, case="C1"),
data.frame(algo="A2", value=0.2, case="C1"),
data.frame(algo="A3", value=0.3, case="C1"),
data.frame(algo="A1", value=0.6, case="C2"),
data.frame(algo="A2", value=0.7, case="C2"),
data.frame(algo="A3", value=0.8, case="C2")
))
data <- rbind(dataTask1, dataTask2, dataTask3)
challenge <- as.challenge(data, by="task", algorithm="algo", case="case", value="value", smallBetter=FALSE)
ranking <- challenge%>%aggregateThenRank(FUN=median, ties.method="min")
meanRanks <- ranking%>%consensus(method = "euclidean")
set.seed(1)
rankingBootstrapped <- ranking%>%bootstrap(nboot=10)
rankingBootstrapped %>%
report(consensus=meanRanks,
title="Test Challenge",
file="testthat_multi_task_bootstrapping",
format="PDF",
clean=TRUE,
open=FALSE)
expect_true(file.exists("testthat_multi_task_bootstrapping.pdf"))
# Clean up
if (file.exists("testthat_multi_task_bootstrapping.pdf")) {
file.remove("testthat_multi_task_bootstrapping.pdf")
}
})
test_that("HTML report for multi-task data set with bootstrapping is created", {
dataTask1 <- cbind(task="T1",
rbind(
data.frame(algo="A1", value=0.8, case="C1"),
data.frame(algo="A2", value=0.6, case="C1"),
data.frame(algo="A3", value=0.4, case="C1"),
data.frame(algo="A1", value=0.2, case="C2"),
data.frame(algo="A2", value=0.1, case="C2"),
data.frame(algo="A3", value=0.0, case="C2")
))
dataTask2 <- cbind(task="T2",
rbind(
data.frame(algo="A1", value=0.2, case="C1"),
data.frame(algo="A2", value=0.3, case="C1"),
data.frame(algo="A3", value=0.4, case="C1"),
data.frame(algo="A1", value=0.7, case="C2"),
data.frame(algo="A2", value=0.8, case="C2"),
data.frame(algo="A3", value=0.9, case="C2")
))
dataTask3 <- cbind(task="T3",
rbind(
data.frame(algo="A1", value=0.1, case="C1"),
data.frame(algo="A2", value=0.2, case="C1"),
data.frame(algo="A3", value=0.3, case="C1"),
data.frame(algo="A1", value=0.6, case="C2"),
data.frame(algo="A2", value=0.7, case="C2"),
data.frame(algo="A3", value=0.8, case="C2")
))
data <- rbind(dataTask1, dataTask2, dataTask3)
challenge <- as.challenge(data, by="task", algorithm="algo", case="case", value="value", smallBetter=FALSE)
ranking <- challenge%>%aggregateThenRank(FUN=median, ties.method="min")
meanRanks <- ranking%>%consensus(method = "euclidean")
set.seed(1)
rankingBootstrapped <- ranking%>%bootstrap(nboot=10)
rankingBootstrapped %>%
report(consensus=meanRanks,
title="Test Challenge",
file="testthat_multi_task_bootstrapping",
format="HTML",
clean=TRUE,
open=FALSE)
expect_true(file.exists("testthat_multi_task_bootstrapping.html"))
# Clean up
if (file.exists("testthat_multi_task_bootstrapping.html")) {
file.remove("testthat_multi_task_bootstrapping.html")
}
})
test_that("Word report for multi-task data set with bootstrapping is created", {
dataTask1 <- cbind(task="T1",
rbind(
data.frame(algo="A1", value=0.8, case="C1"),
data.frame(algo="A2", value=0.6, case="C1"),
data.frame(algo="A3", value=0.4, case="C1"),
data.frame(algo="A1", value=0.2, case="C2"),
data.frame(algo="A2", value=0.1, case="C2"),
data.frame(algo="A3", value=0.0, case="C2")
))
dataTask2 <- cbind(task="T2",
rbind(
data.frame(algo="A1", value=0.2, case="C1"),
data.frame(algo="A2", value=0.3, case="C1"),
data.frame(algo="A3", value=0.4, case="C1"),
data.frame(algo="A1", value=0.7, case="C2"),
data.frame(algo="A2", value=0.8, case="C2"),
data.frame(algo="A3", value=0.9, case="C2")
))
dataTask3 <- cbind(task="T3",
rbind(
data.frame(algo="A1", value=0.1, case="C1"),
data.frame(algo="A2", value=0.2, case="C1"),
data.frame(algo="A3", value=0.3, case="C1"),
data.frame(algo="A1", value=0.6, case="C2"),
data.frame(algo="A2", value=0.7, case="C2"),
data.frame(algo="A3", value=0.8, case="C2")
))
data <- rbind(dataTask1, dataTask2, dataTask3)
challenge <- as.challenge(data, by="task", algorithm="algo", case="case", value="value", smallBetter=FALSE)
ranking <- challenge%>%aggregateThenRank(FUN=median, ties.method="min")
meanRanks <- ranking%>%consensus(method = "euclidean")
set.seed(1)
rankingBootstrapped <- ranking%>%bootstrap(nboot=10)
rankingBootstrapped %>%
report(consensus=meanRanks,
title="Test Challenge",
file="testthat_multi_task_bootstrapping",
format="Word",
clean=TRUE,
open=FALSE)
expect_true(file.exists("testthat_multi_task_bootstrapping.docx"))
# Clean up
if (file.exists("testthat_multi_task_bootstrapping.docx")) {
file.remove("testthat_multi_task_bootstrapping.docx")
}
})
+
+test_that("PDF report for multi-task data set with bootstrapping is created (#algorithms < #tasks)", {
+ dataTask1 <- cbind(task="T1",
+ rbind(
+ data.frame(algo="A1", value=0.80, case="C1"),
+ data.frame(algo="A2", value=0.60, case="C1"),
+ data.frame(algo="A1", value=0.85, case="C2"),
+ data.frame(algo="A2", value=0.65, case="C2")
+ ))
+ dataTask2 <- cbind(task="T2",
+ rbind(
+ data.frame(algo="A1", value=0.20, case="C1"),
+ data.frame(algo="A2", value=0.30, case="C1"),
+ data.frame(algo="A1", value=0.25, case="C2"),
+ data.frame(algo="A2", value=0.35, case="C2")
+ ))
+ dataTask3 <- cbind(task="T3",
+ rbind(
+ data.frame(algo="A1", value=0.10, case="C1"),
+ data.frame(algo="A2", value=0.80, case="C1"),
+ data.frame(algo="A1", value=0.15, case="C2"),
+ data.frame(algo="A2", value=0.85, case="C2")
+ ))
+
+ data <- rbind(dataTask1, dataTask2, dataTask3)
+
+ challenge <- as.challenge(data, by="task", algorithm="algo", case="case", value="value", smallBetter=FALSE)
+
+ ranking <- challenge%>%aggregateThenRank(FUN=median, ties.method="min")
+
+ meanRanks <- ranking%>%consensus(method = "euclidean")
+
+ set.seed(1)
+ rankingBootstrapped <- ranking%>%bootstrap(nboot=10)
+
+ rankingBootstrapped %>%
+ report(consensus=meanRanks,
+ title="Test Challenge",
+ file="testthat_multi_task_bootstrapping_more_tasks_than_algorithms",
+ format="PDF",
+ clean=TRUE,
+ open=FALSE)
+
+ expect_true(file.exists("testthat_multi_task_bootstrapping_more_tasks_than_algorithms.pdf"))
+
+ # Clean up
+ if (file.exists("testthat_multi_task_bootstrapping_more_tasks_than_algorithms.pdf")) {
+ file.remove("testthat_multi_task_bootstrapping_more_tasks_than_algorithms.pdf")
+ }
+
+})
diff --git a/tests/testthat/test-stackedBarPlotStabilityByAlgorithm.R b/tests/testthat/test-stackedBarPlotStabilityByAlgorithm.R
index c07078f..b633905 100644
--- a/tests/testthat/test-stackedBarPlotStabilityByAlgorithm.R
+++ b/tests/testthat/test-stackedBarPlotStabilityByAlgorithm.R
@@ -1,70 +1,139 @@
# Copyright (c) German Cancer Research Center (DKFZ)
# All rights reserved.
#
# This file is part of challengeR.
#
# challengeR is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 2 of the License, or
# (at your option) any later version.
#
# challengeR is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with challengeR. If not, see .
test_that("stacked bar plot for visualizing ranking stability by algorithm raises error for single-task data set", {
data <- rbind(
data.frame(algo="A1", value=0.8, case="C1"),
data.frame(algo="A2", value=0.6, case="C1"),
data.frame(algo="A3", value=0.4, case="C1"),
data.frame(algo="A1", value=0.2, case="C2"),
data.frame(algo="A2", value=0.1, case="C2"),
data.frame(algo="A3", value=0.0, case="C2"))
challenge <- as.challenge(data, taskName="T1", algorithm="algo", case="case", value="value", smallBetter=FALSE)
ranking <- challenge%>%aggregateThenRank(FUN=median, ties.method="min")
set.seed(1)
rankingBootstrapped <- ranking%>%bootstrap(nboot=10)
- expect_error(stabilityByAlgorithm(rankingBootstrapped, stacked =TRUE),
+ expect_error(stabilityByAlgorithm(rankingBootstrapped, stacked = TRUE),
"The stability of rankings by algorithm cannot be computed for less than two tasks.", fixed=TRUE)
})
test_that("stacked bar plot for visualizing ranking stability by algorithm returns one plot for multi-task data set", {
dataTask1 <- cbind(task="T1",
rbind(
data.frame(algo="A1", value=0.8, case="C1"),
data.frame(algo="A2", value=0.6, case="C1"),
data.frame(algo="A3", value=0.4, case="C1"),
data.frame(algo="A1", value=0.2, case="C2"),
data.frame(algo="A2", value=0.1, case="C2"),
data.frame(algo="A3", value=0.0, case="C2")
))
dataTask2 <- cbind(task="T2",
rbind(
data.frame(algo="A1", value=0.2, case="C1"),
data.frame(algo="A2", value=0.3, case="C1"),
data.frame(algo="A3", value=0.4, case="C1"),
data.frame(algo="A1", value=0.7, case="C2"),
data.frame(algo="A2", value=0.8, case="C2"),
data.frame(algo="A3", value=0.9, case="C2")
))
data <- rbind(dataTask1, dataTask2)
challenge <- as.challenge(data, by="task", algorithm="algo", case="case", value="value", smallBetter=FALSE)
ranking <- challenge%>%aggregateThenRank(FUN=median, ties.method="min")
set.seed(1)
rankingBootstrapped <- ranking%>%bootstrap(nboot=10)
- actualPlot <- stabilityByAlgorithm(rankingBootstrapped, stacked =TRUE)
+ actualPlot <- stabilityByAlgorithm(rankingBootstrapped, stacked = TRUE)
+ expect_is(actualPlot, "ggplot")
+})
+
+test_that("stacked bar plot for visualizing ranking stability by algorithm returns one plot if #algorithms equals #tasks", {
+ dataTask1 <- cbind(task="T1",
+ rbind(
+ data.frame(algo="A1", value=0.8, case="C1"),
+ data.frame(algo="A2", value=0.6, case="C1"),
+ data.frame(algo="A1", value=0.2, case="C2"),
+ data.frame(algo="A2", value=0.1, case="C2")
+ ))
+ dataTask2 <- cbind(task="T2",
+ rbind(
+ data.frame(algo="A1", value=0.2, case="C1"),
+ data.frame(algo="A2", value=0.3, case="C1"),
+ data.frame(algo="A1", value=0.7, case="C2"),
+ data.frame(algo="A2", value=0.8, case="C2")
+ ))
+
+ data <- rbind(dataTask1, dataTask2)
+
+ challenge <- as.challenge(data, by="task", algorithm="algo", case="case", value="value", smallBetter=FALSE)
+
+ ranking <- challenge%>%aggregateThenRank(FUN=median, ties.method="min")
+
+ set.seed(1)
+ rankingBootstrapped <- ranking%>%bootstrap(nboot=10)
+
+ meanRanks <- ranking%>%consensus(method = "euclidean")
+
+ actualPlot <- stabilityByAlgorithm(rankingBootstrapped, stacked = TRUE)
+ expect_is(actualPlot, "ggplot")
+})
+
+test_that("stacked bar plot for visualizing ranking stability by algorithm returns one plot if #algorithms < #tasks", {
+ dataTask1 <- cbind(task="T1",
+ rbind(
+ data.frame(algo="A1", value=0.8, case="C1"),
+ data.frame(algo="A2", value=0.6, case="C1"),
+ data.frame(algo="A1", value=0.8, case="C2"),
+ data.frame(algo="A2", value=0.6, case="C2")
+ ))
+ dataTask2 <- cbind(task="T2",
+ rbind(
+ data.frame(algo="A1", value=0.2, case="C1"),
+ data.frame(algo="A2", value=0.3, case="C1"),
+ data.frame(algo="A1", value=0.2, case="C2"),
+ data.frame(algo="A2", value=0.3, case="C2")
+ ))
+ dataTask3 <- cbind(task="T3",
+ rbind(
+ data.frame(algo="A1", value=0.1, case="C1"),
+ data.frame(algo="A2", value=0.8, case="C1"),
+ data.frame(algo="A1", value=0.1, case="C2"),
+ data.frame(algo="A2", value=0.8, case="C2")
+ ))
+
+ data <- rbind(dataTask1, dataTask2, dataTask3)
+
+ challenge <- as.challenge(data, by="task", algorithm="algo", case="case", value="value", smallBetter=FALSE)
+
+ ranking <- challenge%>%aggregateThenRank(FUN=median, ties.method="min")
+
+ set.seed(1)
+ rankingBootstrapped <- ranking%>%bootstrap(nboot=10)
+
+ meanRanks <- ranking%>%consensus(method = "euclidean")
+
+ actualPlot <- stabilityByAlgorithm(rankingBootstrapped, stacked = TRUE)
expect_is(actualPlot, "ggplot")
})
diff --git a/tests/testthat/test-stackedFrequencyPlotStabilityByAlgorithm.R b/tests/testthat/test-stackedFrequencyPlotStabilityByAlgorithm.R
index 859cfb4..2c3a9ac 100644
--- a/tests/testthat/test-stackedFrequencyPlotStabilityByAlgorithm.R
+++ b/tests/testthat/test-stackedFrequencyPlotStabilityByAlgorithm.R
@@ -1,108 +1,177 @@
# Copyright (c) German Cancer Research Center (DKFZ)
# All rights reserved.
#
# This file is part of challengeR.
#
# challengeR is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 2 of the License, or
# (at your option) any later version.
#
# challengeR is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with challengeR. If not, see .
test_that("stacked frequency plot for visualizing ranking stability by algorithm raises error for single-task data set", {
data <- rbind(
data.frame(algo="A1", value=0.8, case="C1"),
data.frame(algo="A2", value=0.6, case="C1"),
data.frame(algo="A3", value=0.4, case="C1"),
data.frame(algo="A1", value=0.2, case="C2"),
data.frame(algo="A2", value=0.1, case="C2"),
data.frame(algo="A3", value=0.0, case="C2"))
challenge <- as.challenge(data, taskName="T1", algorithm="algo", case="case", value="value", smallBetter=FALSE)
ranking <- challenge%>%aggregateThenRank(FUN=median, ties.method="min")
set.seed(1)
rankingBootstrapped <- ranking%>%bootstrap(nboot=10)
expect_error(stabilityByAlgorithm(rankingBootstrapped, stacked = TRUE),
"The stability of rankings by algorithm cannot be computed for less than two tasks.", fixed=TRUE)
})
test_that("stacked frequency plot for visualizing ranking stability by algorithm returns one plot for multi-task data set", {
dataTask1 <- cbind(task="T1",
rbind(
data.frame(algo="A1", value=0.8, case="C1"),
data.frame(algo="A2", value=0.6, case="C1"),
data.frame(algo="A3", value=0.4, case="C1"),
data.frame(algo="A1", value=0.2, case="C2"),
data.frame(algo="A2", value=0.1, case="C2"),
data.frame(algo="A3", value=0.0, case="C2")
))
dataTask2 <- cbind(task="T2",
rbind(
data.frame(algo="A1", value=0.2, case="C1"),
data.frame(algo="A2", value=0.3, case="C1"),
data.frame(algo="A3", value=0.4, case="C1"),
data.frame(algo="A1", value=0.7, case="C2"),
data.frame(algo="A2", value=0.8, case="C2"),
data.frame(algo="A3", value=0.9, case="C2")
))
data <- rbind(dataTask1, dataTask2)
challenge <- as.challenge(data, by="task", algorithm="algo", case="case", value="value", smallBetter=FALSE)
ranking <- challenge%>%aggregateThenRank(FUN=median, ties.method="min")
set.seed(1)
rankingBootstrapped <- ranking%>%bootstrap(nboot=10)
actualPlot <- stabilityByAlgorithm(rankingBootstrapped, stacked = TRUE)
expect_is(actualPlot, "ggplot")
})
test_that("stacked frequency plot for visualizing ranking stability by algorithm returns a plot for each algorithm", {
dataTask1 <- cbind(task="T1",
rbind(
data.frame(algo="A1", value=0.8, case="C1"),
data.frame(algo="A2", value=0.6, case="C1"),
data.frame(algo="A3", value=0.4, case="C1"),
data.frame(algo="A1", value=0.2, case="C2"),
data.frame(algo="A2", value=0.1, case="C2"),
data.frame(algo="A3", value=0.0, case="C2")
))
dataTask2 <- cbind(task="T2",
rbind(
data.frame(algo="A1", value=0.2, case="C1"),
data.frame(algo="A2", value=0.3, case="C1"),
data.frame(algo="A3", value=0.4, case="C1"),
data.frame(algo="A1", value=0.7, case="C2"),
data.frame(algo="A2", value=0.8, case="C2"),
data.frame(algo="A3", value=0.9, case="C2")
))
data <- rbind(dataTask1, dataTask2)
challenge <- as.challenge(data, by="task", algorithm="algo", case="case", value="value", smallBetter=FALSE)
ranking <- challenge%>%aggregateThenRank(FUN=median, ties.method="min")
set.seed(1)
rankingBootstrapped <- ranking%>%bootstrap(nboot=10)
meanRanks <- ranking%>%consensus(method = "euclidean")
actualPlot <- stabilityByAlgorithm(rankingBootstrapped, ordering = names(meanRanks), stacked = TRUE, single = TRUE)
expect_equal(length(actualPlot), 3)
expect_is(actualPlot[[1]], "ggplot")
expect_is(actualPlot[[2]], "ggplot")
expect_is(actualPlot[[3]], "ggplot")
})
+
+test_that("stacked frequency plot for visualizing ranking stability by algorithm returns one plot if #algorithms equals #tasks", {
+ dataTask1 <- cbind(task="T1",
+ rbind(
+ data.frame(algo="A1", value=0.8, case="C1"),
+ data.frame(algo="A2", value=0.6, case="C1"),
+ data.frame(algo="A1", value=0.2, case="C2"),
+ data.frame(algo="A2", value=0.1, case="C2")
+ ))
+ dataTask2 <- cbind(task="T2",
+ rbind(
+ data.frame(algo="A1", value=0.2, case="C1"),
+ data.frame(algo="A2", value=0.3, case="C1"),
+ data.frame(algo="A1", value=0.7, case="C2"),
+ data.frame(algo="A2", value=0.8, case="C2")
+ ))
+
+ data <- rbind(dataTask1, dataTask2)
+
+ challenge <- as.challenge(data, by="task", algorithm="algo", case="case", value="value", smallBetter=FALSE)
+
+ ranking <- challenge%>%aggregateThenRank(FUN=median, ties.method="min")
+
+ set.seed(1)
+ rankingBootstrapped <- ranking%>%bootstrap(nboot=10)
+
+ meanRanks <- ranking%>%consensus(method = "euclidean")
+
+ actualPlot <- stabilityByAlgorithm(rankingBootstrapped, ordering = names(meanRanks), stacked = TRUE, single = FALSE)
+ expect_is(actualPlot, "ggplot")
+})
+
+test_that("stacked frequency plot for visualizing ranking stability by algorithm returns one plot if #algorithms < #tasks", {
+ dataTask1 <- cbind(task="T1",
+ rbind(
+ data.frame(algo="A1", value=0.8, case="C1"),
+ data.frame(algo="A2", value=0.6, case="C1"),
+ data.frame(algo="A1", value=0.8, case="C2"),
+ data.frame(algo="A2", value=0.6, case="C2")
+ ))
+ dataTask2 <- cbind(task="T2",
+ rbind(
+ data.frame(algo="A1", value=0.2, case="C1"),
+ data.frame(algo="A2", value=0.3, case="C1"),
+ data.frame(algo="A1", value=0.2, case="C2"),
+ data.frame(algo="A2", value=0.3, case="C2")
+ ))
+ dataTask3 <- cbind(task="T3",
+ rbind(
+ data.frame(algo="A1", value=0.1, case="C1"),
+ data.frame(algo="A2", value=0.8, case="C1"),
+ data.frame(algo="A1", value=0.1, case="C2"),
+ data.frame(algo="A2", value=0.8, case="C2")
+ ))
+
+ data <- rbind(dataTask1, dataTask2, dataTask3)
+
+ challenge <- as.challenge(data, by="task", algorithm="algo", case="case", value="value", smallBetter=FALSE)
+
+ ranking <- challenge%>%aggregateThenRank(FUN=median, ties.method="min")
+
+ set.seed(1)
+ rankingBootstrapped <- ranking%>%bootstrap(nboot=10)
+
+ meanRanks <- ranking%>%consensus(method = "euclidean")
+
+ actualPlot <- stabilityByAlgorithm(rankingBootstrapped, ordering = names(meanRanks), stacked = TRUE, single = FALSE)
+ expect_is(actualPlot, "ggplot")
+})