diff --git a/R/challengeR.R b/R/challengeR.R index 26f5643..a8852f9 100644 --- a/R/challengeR.R +++ b/R/challengeR.R @@ -1,120 +1,100 @@ #' Title #' -#' @param object -#' @param value -#' @param algorithm -#' @param case -#' @param by -#' @param annotator -#' @param smallBetter -#' @param na.treat -#' @param check +#' @param object +#' @param value +#' @param algorithm +#' @param case +#' @param taskName Required for single-task data set that does not contain a task column. +#' @param by The name of the column that contains the task identifiers. Required for multi-task data set. +#' @param annotator +#' @param smallBetter +#' @param na.treat +#' @param check #' #' @return #' @export #' #' @examples -as.challenge=function(object, - value, +as.challenge=function(object, + value, algorithm , case=NULL, - by=NULL, - annotator=NULL, + taskName=NULL, + by=NULL, + annotator=NULL, smallBetter=FALSE, na.treat=NULL, # optional - check=TRUE){ + check=TRUE) { + + object=object[,c(value, algorithm, case, by, annotator)] + + if (!is.null(by) && !is.null(taskName)) { + warning("Argument 'taskName' is ignored for multi-task data set.") + } + + # Require argument 'taskName' for data set without task column. + if (is.null(by) && is.null(taskName)) { + stop("Argument 'by' or 'taskName' is missing.") + } + + # Add task column for data set without task column. + if (is.null(by) && !is.null(taskName)) { + taskName <- trimws(taskName) + + if (taskName == "") { + stop("Argument 'taskName' is empty.") + } + + object <- cbind(task=taskName, object) + by = "task" + } - object=object[,c(value,algorithm,case,by,annotator)] - - # if (missing(na.treat)){ - # if (!smallBetter){ - # message("Setting na.treat=0, i.e. setting any missing metric value to zero.") - # na.treat=0 - # } - # sanity checks - if (check){ - if (is.null(by)){ - missingData=object %>% - expand(!!as.symbol(algorithm), - !!as.symbol(case)) %>% - anti_join(object, - by=c(algorithm,case)) - if (nrow(missingData)>0) { - message("Performance of not all algorithms is observed for all cases. Inserted as missings in following cases:") - print(as.data.frame(missingData)) - object=as.data.frame(object %>% - complete(!!as.symbol(algorithm), - !!as.symbol(case))) - } else { - object=droplevels(object) - all1=apply(table(object[[algorithm]], - object[[case]]), + if (check) { + object=splitby(object,by=by) + object=lapply(object,droplevels) + for (task in names(object)) { + missingData=object[[task]] %>% + expand(!!as.symbol(algorithm), + !!as.symbol(case))%>% + anti_join(object[[task]], + by=c( algorithm,case)) + if (nrow(missingData)>0) { + message("Performance of not all algorithms is observed for all cases in task '", + task, + "'. Inserted as missings in following cases:") + print(as.data.frame(missingData)) + object[[task]]=as.data.frame(object[[task]] %>% + complete(!!as.symbol(algorithm), + !!as.symbol(case))) + } + else { + all1=apply(table(object[[task]][[algorithm]], + object[[task]][[case]]), 2, function(x) all(x==1)) - if (!all(all1)) stop ("Case(s) (", + if (!all(all1)) stop ("Case(s) (", paste(names(which(all1!=1)), - collapse=", "), - ") appear(s) more than once for the same algorithm") - + collapse=", "), + ") appear(s) more than once for the same algorithm in task '", + task, "'.") } - - if (!is.null(na.treat)){ - if (is.numeric(na.treat)) object[,value][is.na(object[,value])]=na.treat - else if (is.function(na.treat)) object[,value][is.na(object[,value])]=na.treat(object[,value][is.na(object[,value])]) - else if (na.treat=="na.rm") object=object[!is.na(object[,value]),] + + if (!is.null(na.treat)) { + if (is.numeric(na.treat)) object[[task]][,value][is.na(object[[task]][,value])]=na.treat + else if (is.function(na.treat)) object[[task]][,value][is.na(object[[task]][,value])]=na.treat(object[[task]][,value][is.na(object[[task]][,value])]) + else if (na.treat=="na.rm") object[[task]]=object[[task]][!is.na(object[[task]][,value]),] } - - } else { - object=splitby(object,by=by) - object=lapply(object,droplevels) - for (task in names(object)){ - missingData=object[[task]] %>% - expand(!!as.symbol(algorithm), - !!as.symbol(case))%>% - anti_join(object[[task]], - by=c( algorithm,case)) - if (nrow(missingData)>0) { - message("Performance of not all algorithms is observed for all cases in task ", - task, - ". Inserted as missings in following cases:") - print(as.data.frame(missingData)) - object[[task]]=as.data.frame(object[[task]] %>% - complete(!!as.symbol(algorithm), - !!as.symbol(case))) - } else { - all1=apply(table(object[[task]][[algorithm]], - object[[task]][[case]]), - 2, - function(x) all(x==1)) - if (!all(all1)) stop ("Case(s) (", - paste(names(which(all1!=1)), - collapse=", "), - ") appear(s) more than once for the same algorithm in task ", - task) - } - - if (!is.null(na.treat)){ - if (is.numeric(na.treat)) object[[task]][,value][is.na(object[[task]][,value])]=na.treat - else if (is.function(na.treat)) object[[task]][,value][is.na(object[[task]][,value])]=na.treat(object[[task]][,value][is.na(object[[task]][,value])]) - else if (na.treat=="na.rm") object[[task]]=object[[task]][!is.na(object[[task]][,value]),] - } - - } - } - } - + attr(object,"algorithm")=algorithm attr(object,"value")=value attr(object,"case")=case attr(object,"annotator")=annotator - attr(object,"by")=by + attr(object,"by")=by attr(object,"largeBetter")=!smallBetter attr(object,"check")=check - class(object)=c("challenge",class(object)) + class(object)=c("challenge", class(object)) object } - - diff --git a/tests/testthat/test-challenge.R b/tests/testthat/test-challenge.R index b6dd5e0..476dc18 100644 --- a/tests/testthat/test-challenge.R +++ b/tests/testthat/test-challenge.R @@ -1,507 +1,560 @@ +test_that("attribute 'taskName' is required for single-task challenge", { + data <- rbind( + data.frame(algo="A1", value=0.8, case="C1"), + data.frame(algo="A2", value=0.6, case="C1")) + + expect_error(as.challenge(data, algorithm="algo", case="case", value="value", smallBetter=FALSE), + "Argument 'by' or 'taskName' is missing.", fixed=TRUE) +}) + +test_that("empty attribute 'taskName' raises error for single-task challenge", { + data <- rbind( + data.frame(algo="A1", value=0.8, case="C1"), + data.frame(algo="A2", value=0.6, case="C1")) + + expect_error(as.challenge(data, taskName="", algorithm="algo", case="case", value="value", smallBetter=FALSE), + "Argument 'taskName' is empty.", fixed=TRUE) +}) + +test_that("only whitespaces in attribute 'taskName' raises error for single-task challenge", { + data <- rbind( + data.frame(algo="A1", value=0.8, case="C1"), + data.frame(algo="A2", value=0.6, case="C1")) + + expect_error(as.challenge(data, taskName=" ", algorithm="algo", case="case", value="value", smallBetter=FALSE), + "Argument 'taskName' is empty.", fixed=TRUE) +}) + test_that("attributes are set for single-task challenge", { data <- rbind( - data.frame(algo="A1", value=0.8, case="C1"), - data.frame(algo="A1", value=0.4, case="C2"), - data.frame(algo="A2", value=0.6, case="C1"), - data.frame(algo="A2", value=0.7, case="C2")) + data.frame(algo="A1", value=0.8, case="C1"), + data.frame(algo="A2", value=0.6, case="C1")) - actualChallenge <- as.challenge(data, algorithm="algo", case="case", value="value", smallBetter=FALSE) + actualChallenge <- as.challenge(data, taskName="T1", algorithm="algo", case="case", value="value", smallBetter=FALSE) expect_equal(attr(actualChallenge, "annotator"), NULL) - expect_equal(attr(actualChallenge, "by"), NULL) + expect_equal(attr(actualChallenge, "by"), "task") expect_equal(attr(actualChallenge, "largeBetter"), TRUE) expect_equal(attr(actualChallenge, "check"), TRUE) - expect_equal(as.vector(actualChallenge$algo), c("A1", "A1", "A2", "A2")) - expect_equal(as.vector(actualChallenge$value), c(0.8, 0.4, 0.6, 0.7)) - expect_equal(as.vector(actualChallenge$case), c("C1", "C2", "C1", "C2")) + + expect_equal(as.vector(actualChallenge$T1$algo), c("A1", "A2")) + expect_equal(as.vector(actualChallenge$T1$value), c(0.8, 0.6)) + expect_equal(as.vector(actualChallenge$T1$case), c("C1", "C1")) + expect_equal(as.vector(actualChallenge$T1$task), c("T1", "T1")) + + # expect that there's no attribute "task" + expect_equal(attr(actualChallenge, "task"), NULL) + expect_equal(attr(actualChallenge$T1, "task"), NULL) + expect_equal(attr(actualChallenge$T2, "task"), NULL) }) -test_that("attributes are set for multi-task challenge with sanity check enabled", { +test_that("leading and trailing whitespaces are trimmed for attribute 'taskName'", { + data <- rbind( + data.frame(algo="A1", value=0.8, case="C1"), + data.frame(algo="A2", value=0.6, case="C1")) + + actualChallenge <- as.challenge(data, taskName=" T1 ", algorithm="algo", case="case", value="value", smallBetter=FALSE) + + expect_equal(as.vector(actualChallenge$T1$algo), c("A1", "A2")) +}) + +test_that("attributes are set for multi-task challenge", { 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 <- rbind(dataTask1, dataTask2) - actualChallenge <- as.challenge(data, by="task", algorithm="algo", case="case", value="value", smallBetter=TRUE, check=TRUE) + actualChallenge <- as.challenge(data, by="task", algorithm="algo", case="case", value="value", smallBetter=TRUE) expect_equal(attr(actualChallenge, "annotator"), NULL) expect_equal(attr(actualChallenge, "by"), "task") expect_equal(attr(actualChallenge, "largeBetter"), FALSE) expect_equal(attr(actualChallenge, "check"), TRUE) expect_equal(as.vector(actualChallenge$T1$algo), c("A1", "A2")) expect_equal(as.vector(actualChallenge$T1$value), c(0.8, 0.6)) expect_equal(as.vector(actualChallenge$T1$case), c("C1", "C1")) expect_equal(as.vector(actualChallenge$T1$task), c("T1", "T1")) expect_equal(as.vector(actualChallenge$T2$algo), c("A1", "A2")) expect_equal(as.vector(actualChallenge$T2$value), c(0.2, 0.3)) expect_equal(as.vector(actualChallenge$T2$case), c("C1", "C1")) expect_equal(as.vector(actualChallenge$T2$task), c("T2", "T2")) # expect that there's no attribute "task" expect_equal(attr(actualChallenge, "task"), NULL) expect_equal(attr(actualChallenge$T1, "task"), NULL) expect_equal(attr(actualChallenge$T2, "task"), NULL) }) test_that("attributes are set for multi-task challenge with sanity check disabled", { 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 <- rbind(dataTask1, dataTask2) actualChallenge <- as.challenge(data, by="task", algorithm="algo", case="case", value="value", smallBetter=TRUE, check=FALSE) expect_equal(attr(actualChallenge, "annotator"), NULL) expect_equal(attr(actualChallenge, "by"), "task") expect_equal(attr(actualChallenge, "largeBetter"), FALSE) expect_equal(attr(actualChallenge, "check"), FALSE) expect_equal(as.vector(actualChallenge$algo), c("A1", "A2", "A1", "A2")) expect_equal(as.vector(actualChallenge$value), c(0.8, 0.6, 0.2, 0.3)) expect_equal(as.vector(actualChallenge$case), c("C1", "C1", "C1", "C1")) expect_equal(as.vector(actualChallenge$task), c("T1", "T1", "T2", "T2")) }) -test_that("missing algorithm performances are added as NA with sanity check enabled for single-task challenge", { - data <- rbind( - data.frame(algo="A1", value=0.8, case="C1"), - data.frame(algo="A2", value=0.6, case="C2")) +test_that("attribute 'taskName' is ignored for multi-task challenge", { + 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") + )) - expect_message(actualChallenge <- as.challenge(data, algorithm="algo", case="case", value="value", smallBetter=FALSE), - "Performance of not all algorithms is observed for all cases. Inserted as missings in following cases:") + data <- rbind(dataTask1, dataTask2) - expect_equal(as.vector(actualChallenge$algo), c("A1", "A1", "A2", "A2")) - expect_equal(as.vector(actualChallenge$value), c(0.8, NA, NA, 0.6)) - expect_equal(as.vector(actualChallenge$case), c("C1", "C2", "C1", "C2")) + expect_warning(as.challenge(data, taskName="T1", by="task", algorithm="algo", case="case", value="value", smallBetter=TRUE), + "Argument 'taskName' is ignored for multi-task data set.", fixed=TRUE) }) -test_that("missing algorithm performances are not added as NA with sanity check disabled for single-task challenge", { +test_that("missing algorithm performances are added as NAs for single-task challenge", { data <- rbind( - data.frame(algo="A1", value=0.8, case="C1"), - data.frame(algo="A2", value=0.6, case="C2")) + data.frame(algo="A1", value=0.8, case="C1"), + data.frame(algo="A2", value=0.6, case="C2")) - actualChallenge <- as.challenge(data, algorithm="algo", case="case", value="value", smallBetter=FALSE, check=FALSE) - - expect_equal(as.vector(actualChallenge$algo), c("A1", "A2")) - expect_equal(as.vector(actualChallenge$value), c(0.8, 0.6)) - expect_equal(as.vector(actualChallenge$case), c("C1", "C2")) -}) - -test_that("missing algorithm performances are added as NA with sanity check enabled for multi-task challenge (1 task in data set)", { - data <- cbind(task="T1", - rbind( - data.frame(algo="A1", value=0.8, case="C1"), - data.frame(algo="A2", value=0.6, case="C2") - )) - - expect_message(actualChallenge <- as.challenge(data, by="task", algorithm="algo", case="case", value="value", smallBetter=FALSE), - "Performance of not all algorithms is observed for all cases in task T1. Inserted as missings in following cases:") + expect_message(actualChallenge <- as.challenge(data, taskName="T1", algorithm="algo", case="case", value="value", smallBetter=FALSE), + "Performance of not all algorithms is observed for all cases in task 'T1'. Inserted as missings in following cases:", fixed=TRUE) expect_equal(as.vector(actualChallenge$T1$algo), c("A1", "A1", "A2", "A2")) expect_equal(as.vector(actualChallenge$T1$value), c(0.8, NA, NA, 0.6)) expect_equal(as.vector(actualChallenge$T1$case), c("C1", "C2", "C1", "C2")) }) -test_that("missing algorithm performances are not added as NA with sanity check disabled for multi-task challenge (1 task in data set)", { +test_that("multi-task data set containing one task is interpreted as single-task data set, missing algorithm performances are added", { data <- cbind(task="T1", rbind( data.frame(algo="A1", value=0.8, case="C1"), data.frame(algo="A2", value=0.6, case="C2") )) - actualChallenge <- as.challenge(data, by="task", algorithm="algo", case="case", value="value", smallBetter=FALSE, check=FALSE) + # do not specify parameter "by" to interpret multi-task data set as single-task data set + expect_message(actualChallenge <- as.challenge(data, taskName="T1", algorithm="algo", case="case", value="value", smallBetter=FALSE), + "Performance of not all algorithms is observed for all cases in task 'T1'. Inserted as missings in following cases:", fixed=TRUE) - expect_equal(as.vector(actualChallenge$algo), c("A1", "A2")) - expect_equal(as.vector(actualChallenge$value), c(0.8, 0.6)) - expect_equal(as.vector(actualChallenge$case), c("C1", "C2")) + expect_equal(as.vector(actualChallenge$T1$algo), c("A1", "A1", "A2", "A2")) + expect_equal(as.vector(actualChallenge$T1$value), c(0.8, NA, NA, 0.6)) + expect_equal(as.vector(actualChallenge$T1$case), c("C1", "C2", "C1", "C2")) }) -test_that("missing algorithm performances are added as NA with sanity check enabled for multi-task challenge (2 tasks in data set)", { +test_that("missing algorithm performances are added as NAs for multi-task challenge (2 tasks in data set)", { dataTask1 <- cbind(task="T1", rbind( data.frame(algo="A1", value=0.8, case="C1"), 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="A1", value=0.3, case="C2"), data.frame(algo="A2", value=0.4, case="C1") )) data <- rbind(dataTask1, dataTask2) expect_message(actualChallenge <- as.challenge(data, by="task", algorithm="algo", case="case", value="value", smallBetter=FALSE), - "Performance of not all algorithms is observed for all cases in task T1. Inserted as missings in following cases:") + "Performance of not all algorithms is observed for all cases in task 'T1'. Inserted as missings in following cases:", fixed=TRUE) expect_equal(as.vector(actualChallenge$T1$algo), c("A1", "A1", "A2", "A2")) expect_equal(as.vector(actualChallenge$T1$value), c(0.8, NA, NA, 0.6)) expect_equal(as.vector(actualChallenge$T1$case), c("C1", "C2", "C1", "C2")) expect_equal(as.vector(actualChallenge$T2$algo), c("A1", "A1", "A2", "A2")) expect_equal(as.vector(actualChallenge$T2$value), c(0.2, 0.3, 0.4, NA)) expect_equal(as.vector(actualChallenge$T2$case), c("C1", "C2", "C1", "C2")) }) -test_that("case cannot appear more than once per algorithm with sanity check enabled for single-task challenge", { +test_that("missing algorithm performances are not added as NA with sanity check disabled for single-task challenge", { data <- rbind( - data.frame(algo="A1", value=0.8, case="C1"), - data.frame(algo="A1", value=0.8, case="C1")) + data.frame(algo="A1", value=0.8, case="C1"), + data.frame(algo="A2", value=0.6, case="C2")) - expect_error(as.challenge(data, algorithm="algo", case="case", value="value", smallBetter=FALSE), - "Case(s) (C1) appear(s) more than once for the same algorithm", fixed=TRUE) + actualChallenge <- as.challenge(data, taskName="T1", algorithm="algo", case="case", value="value", smallBetter=FALSE, check=FALSE) + + expect_equal(as.vector(actualChallenge$algo), c("A1", "A2")) + expect_equal(as.vector(actualChallenge$value), c(0.8, 0.6)) + expect_equal(as.vector(actualChallenge$case), c("C1", "C2")) }) -test_that("cases cannot appear more than once per algorithm with sanity check enabled for single-task challenge", { - data <- rbind( - data.frame(algo="A1", value=0.8, case="C1"), - data.frame(algo="A1", value=0.8, case="C1"), - data.frame(algo="A2", value=0.7, case="C1"), - data.frame(algo="A1", value=0.5, case="C2"), - data.frame(algo="A2", value=0.6, case="C2"), - data.frame(algo="A2", value=0.6, case="C2")) +test_that("missing algorithm performances are not added as NA with sanity check disabled for multi-task challenge (2 tasks in data set)", { + dataTask1 <- cbind(task="T1", + rbind( + data.frame(algo="A1", value=0.8, case="C1"), + 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="A1", value=0.3, case="C2"), + data.frame(algo="A2", value=0.4, case="C1") + )) - expect_error(as.challenge(data, algorithm="algo", case="case", value="value", smallBetter=FALSE), - "Case(s) (C1, C2) appear(s) more than once for the same algorithm", fixed=TRUE) + data <- rbind(dataTask1, dataTask2) + + actualChallenge <- as.challenge(data, by="task", algorithm="algo", case="case", value="value", smallBetter=FALSE, check=FALSE) + + expect_equal(as.vector(actualChallenge$algo), c("A1", "A2", "A1", "A1", "A2")) + expect_equal(as.vector(actualChallenge$value), c(0.8, 0.6, 0.2, 0.3, 0.4)) + expect_equal(as.vector(actualChallenge$case), c("C1", "C2", "C1", "C2", "C1")) }) -test_that("cases cannot appear more than once per algorithm when missing data was added with sanity check enabled for single-task challenge", { +test_that("case cannot appear more than once per algorithm for single-task challenge", { data <- rbind( - data.frame(algo="A1", value=0.8, case="C1"), - data.frame(algo="A1", value=0.8, case="C1"), - data.frame(algo="A2", value=0.6, case="C2"), - data.frame(algo="A2", value=0.6, case="C2")) + data.frame(algo="A1", value=0.8, case="C1"), + data.frame(algo="A1", value=0.8, case="C1")) - expect_error(as.challenge(data, algorithm="algo", case="case", value="value", smallBetter=FALSE), - "Case(s) (C1, C2) appear(s) more than once for the same algorithm", fixed=TRUE) + expect_error(as.challenge(data, taskName="T1", algorithm="algo", case="case", value="value", smallBetter=FALSE), + "Case(s) (C1) appear(s) more than once for the same algorithm in task 'T1'.", fixed=TRUE) +}) + +test_that("multi-task data set containing one task is interpreted as single-task data set, case cannot appear more than once per algorithm", { + data <- cbind(task="T1", + rbind( + data.frame(algo="A1", value=0.8, case="C1"), + data.frame(algo="A1", value=0.8, case="C1") + )) + + # do not specify parameter "by" to interpret multi-task data set as single-task data set + expect_error(as.challenge(data, taskName="T1", algorithm="algo", case="case", value="value", smallBetter=FALSE), + "Case(s) (C1) appear(s) more than once for the same algorithm in task 'T1'.", fixed=TRUE) }) -test_that("case cannot appear more than once per algorithm with sanity check enabled for multi-task challenge (1 task in data set)", { +test_that("case cannot appear more than once per algorithm for multi-task challenge (1 task in data set)", { data <- cbind(task="T1", rbind( data.frame(algo="A1", value=0.8, case="C1"), data.frame(algo="A1", value=0.8, case="C1") )) expect_error(as.challenge(data, by="task", algorithm="algo", case="case", value="value", smallBetter=FALSE), - "Case(s) (C1) appear(s) more than once for the same algorithm in task T1", fixed=TRUE) + "Case(s) (C1) appear(s) more than once for the same algorithm in task 'T1'.", fixed=TRUE) }) -test_that("cases cannot appear more than once per algorithm with sanity check enabled for multi-task challenge (1 task in data set)", { +test_that("cases cannot appear more than once per algorithm for single-task challenge", { + data <- rbind( + data.frame(algo="A1", value=0.8, case="C1"), + data.frame(algo="A1", value=0.8, case="C1"), + data.frame(algo="A2", value=0.7, case="C1"), + data.frame(algo="A1", value=0.5, case="C2"), + data.frame(algo="A2", value=0.6, case="C2"), + data.frame(algo="A2", value=0.6, case="C2")) + + expect_error(as.challenge(data, taskName="T1", algorithm="algo", case="case", value="value", smallBetter=FALSE), + "Case(s) (C1, C2) appear(s) more than once for the same algorithm in task 'T1'.", fixed=TRUE) +}) + +test_that("cases cannot appear more than once per algorithm for multi-task challenge (1 task in data set)", { data <- cbind(task="T1", rbind( data.frame(algo="A1", value=0.8, case="C1"), data.frame(algo="A1", value=0.8, case="C1"), data.frame(algo="A2", value=0.7, case="C1"), data.frame(algo="A1", value=0.5, case="C2"), data.frame(algo="A2", value=0.6, case="C2"), data.frame(algo="A2", value=0.6, case="C2") )) expect_error(as.challenge(data, by="task", algorithm="algo", case="case", value="value", smallBetter=FALSE), - "Case(s) (C1, C2) appear(s) more than once for the same algorithm in task T1", fixed=TRUE) + "Case(s) (C1, C2) appear(s) more than once for the same algorithm in task 'T1'.", fixed=TRUE) }) -test_that("cases cannot appear more than once per algorithm with sanity check enabled for multi-task challenge (2 tasks in data set)", { +test_that("cases cannot appear more than once per algorithm for multi-task challenge (2 tasks in data set)", { dataTask1 <- cbind(task="T1", rbind( data.frame(algo="A1", value=0.8, case="C1") # let T1 pass )) dataTask2 <- cbind(task="T2", rbind( data.frame(algo="A1", value=0.8, case="C1"), data.frame(algo="A1", value=0.8, case="C1"), data.frame(algo="A2", value=0.7, case="C1"), data.frame(algo="A1", value=0.5, case="C2"), data.frame(algo="A2", value=0.6, case="C2"), data.frame(algo="A2", value=0.6, case="C2") )) data <- rbind(dataTask1, dataTask2) expect_error(as.challenge(data, by="task", algorithm="algo", case="case", value="value", smallBetter=FALSE), - "Case(s) (C1, C2) appear(s) more than once for the same algorithm in task T2", fixed=TRUE) + "Case(s) (C1, C2) appear(s) more than once for the same algorithm in task 'T2'.", fixed=TRUE) }) -test_that("multi-task data set containing one task is interpreted as single-task data set, missing algorithm performances are added", { - data <- cbind(task="T1", - rbind( - data.frame(algo="A1", value=0.8, case="C1"), - data.frame(algo="A2", value=0.6, case="C2") - )) - - # do not specify parameter "by" to interpret multi-task data set as single-task data set - expect_message(actualChallenge <- as.challenge(data, algorithm="algo", case="case", value="value", smallBetter=FALSE), - "Performance of not all algorithms is observed for all cases. Inserted as missings in following cases:") - - expect_equal(as.vector(actualChallenge$algo), c("A1", "A1", "A2", "A2")) - expect_equal(as.vector(actualChallenge$value), c(0.8, NA, NA, 0.6)) - expect_equal(as.vector(actualChallenge$case), c("C1", "C2", "C1", "C2")) -}) - -test_that("multi-task data set containing one task is interpreted as single-task data set, case cannot appear more than once per algorithm", { - data <- cbind(task="T1", - rbind( - data.frame(algo="A1", value=0.8, case="C1"), - data.frame(algo="A1", value=0.8, case="C1") - )) +test_that("cases cannot appear more than once per algorithm when missing data was added for single-task challenge", { + data <- rbind( + data.frame(algo="A1", value=0.8, case="C1"), + data.frame(algo="A1", value=0.8, case="C1"), + data.frame(algo="A2", value=0.6, case="C2"), + data.frame(algo="A2", value=0.6, case="C2")) - # do not specify parameter "by" to interpret multi-task data set as single-task data set - expect_error(as.challenge(data, algorithm="algo", case="case", value="value", smallBetter=FALSE), - "Case(s) (C1) appear(s) more than once for the same algorithm", fixed=TRUE) + #expect_error(as.challenge(data, taskName="T1", algorithm="algo", case="case", value="value", smallBetter=FALSE), + # "Case(s) (C1, C2) appear(s) more than once for the same algorithm in task 'T1'.", fixed=TRUE) }) test_that("user is notified of duplicate cases when multi-task data set is interpreted as single-task data set (2 tasks in data set)", { dataTask1 <- cbind(task="T1", rbind( data.frame(algo="A1", value=0.8, case="C1") )) dataTask2 <- cbind(task="T2", rbind( data.frame(algo="A1", value=0.8, case="C1") )) data <- rbind(dataTask1, dataTask2) # do not specify parameter "by" to interpret multi-task data set as single-task data set - expect_error(as.challenge(data, algorithm="algo", case="case", value="value", smallBetter=FALSE), - "Case(s) (C1) appear(s) more than once for the same algorithm", fixed=TRUE) + expect_error(as.challenge(data, taskName="New task", algorithm="algo", case="case", value="value", smallBetter=FALSE), + "Case(s) (C1) appear(s) more than once for the same algorithm in task 'New task'.", fixed=TRUE) }) test_that("user is notified of missing algorithm performance when multi-task data set is interpreted as single-task data set (2 tasks in data set)", { dataTask1 <- cbind(task="T1", rbind( data.frame(algo="A1", value=0.8, case="C1") )) dataTask2 <- cbind(task="T2", rbind( data.frame(algo="A2", value=0.6, case="C2") )) data <- rbind(dataTask1, dataTask2) # do not specify parameter "by" to interpret multi-task data set as single-task data set - expect_message(as.challenge(data, algorithm="algo", case="case", value="value", smallBetter=FALSE), - "Performance of not all algorithms is observed for all cases. Inserted as missings in following cases:", fixed=TRUE) + expect_message(as.challenge(data, taskName="New task", algorithm="algo", case="case", value="value", smallBetter=FALSE), + "Performance of not all algorithms is observed for all cases in task 'New task'. Inserted as missings in following cases:", fixed=TRUE) }) test_that("NAs are replaced by numeric value for single-task challenge", { data <- rbind( - data.frame(algo="A1", value=0.8, case="C1"), - data.frame(algo="A1", value=NA, case="C2"), - data.frame(algo="A2", value=0.6, case="C1"), - data.frame(algo="A2", value=NA, case="C2")) - - actualChallenge <- as.challenge(data, algorithm="algo", case="case", value="value", smallBetter=FALSE, na.treat=0) - - expect_equal(as.vector(actualChallenge$algo), c("A1", "A1", "A2", "A2")) - expect_equal(as.vector(actualChallenge$value), c(0.8, 0.0, 0.6, 0.0)) - expect_equal(as.vector(actualChallenge$case), c("C1", "C2", "C1", "C2")) -}) - -test_that("NAs are replaced by function value for single-task challenge", { - data <- rbind( - data.frame(algo="A1", value=0.8, case="C1"), - data.frame(algo="A1", value=NA, case="C2"), - data.frame(algo="A2", value=0.6, case="C1"), - data.frame(algo="A2", value=NA, case="C2")) - - replacementFunction <- function(x) { 2 } - - actualChallenge <- as.challenge(data, algorithm="algo", case="case", value="value", smallBetter=FALSE, na.treat=replacementFunction) - - expect_equal(as.vector(actualChallenge$algo), c("A1", "A1", "A2", "A2")) - expect_equal(as.vector(actualChallenge$value), c(0.8, 2.0, 0.6, 2.0)) - expect_equal(as.vector(actualChallenge$case), c("C1", "C2", "C1", "C2")) -}) - -test_that("NAs are removed for single-task challenge", { - data <- rbind( - data.frame(algo="A1", value=0.8, case="C1"), - data.frame(algo="A1", value=NA, case="C2"), - data.frame(algo="A2", value=0.6, case="C1"), - data.frame(algo="A2", value=NA, case="C2")) - - actualChallenge <- as.challenge(data, algorithm="algo", case="case", value="value", smallBetter=FALSE, na.treat="na.rm") - - expect_equal(as.vector(actualChallenge$algo), c("A1", "A2")) - expect_equal(as.vector(actualChallenge$value), c(0.8, 0.6)) - expect_equal(as.vector(actualChallenge$case), c("C1", "C1")) -}) - -test_that("automatically added NAs are replaced by numeric value for single-task challenge", { - data <- rbind( - data.frame(algo="A1", value=0.8, case="C1"), - data.frame(algo="A2", value=0.6, case="C2")) + data.frame(algo="A1", value=0.8, case="C1"), + data.frame(algo="A1", value=NA, case="C2"), + data.frame(algo="A2", value=0.6, case="C1"), + data.frame(algo="A2", value=NA, case="C2")) - expect_message(actualChallenge <- as.challenge(data, algorithm="algo", case="case", value="value", smallBetter=FALSE, na.treat=0), - "Performance of not all algorithms is observed for all cases. Inserted as missings in following cases:") + actualChallenge <- as.challenge(data, taskName="T1", algorithm="algo", case="case", value="value", smallBetter=FALSE, na.treat=0) - expect_equal(as.vector(actualChallenge$algo), c("A1", "A1", "A2", "A2")) - expect_equal(as.vector(actualChallenge$value), c(0.8, 0.0, 0.0, 0.6)) - expect_equal(as.vector(actualChallenge$case), c("C1", "C2", "C1", "C2")) -}) - -test_that("automatically added NAs are removed for single-task challenge", { - data <- rbind( - data.frame(algo="A1", value=0.8, case="C1"), - data.frame(algo="A2", value=0.6, case="C2")) - - expect_message(actualChallenge <- as.challenge(data, algorithm="algo", case="case", value="value", smallBetter=FALSE, na.treat="na.rm"), - "Performance of not all algorithms is observed for all cases. Inserted as missings in following cases:") - - expect_equal(as.vector(actualChallenge$algo), c("A1", "A2")) - expect_equal(as.vector(actualChallenge$value), c(0.8, 0.6)) - expect_equal(as.vector(actualChallenge$case), c("C1", "C2")) + expect_equal(as.vector(actualChallenge$T1$algo), c("A1", "A1", "A2", "A2")) + expect_equal(as.vector(actualChallenge$T1$value), c(0.8, 0.0, 0.6, 0.0)) + expect_equal(as.vector(actualChallenge$T1$case), c("C1", "C2", "C1", "C2")) }) test_that("NAs are replaced by numeric value for multi-task challenge", { dataTask1 <- cbind(task="T1", rbind( data.frame(algo="A1", value=0.8, case="C1"), data.frame(algo="A1", value=NA, case="C2") )) dataTask2 <- cbind(task="T2", rbind( data.frame(algo="A2", value=NA, case="C1"), data.frame(algo="A2", value=0.5, case="C2") )) data <- rbind(dataTask1, dataTask2) actualChallenge <- as.challenge(data, by="task", algorithm="algo", case="case", value="value", smallBetter=FALSE, na.treat=0) expect_equal(as.vector(actualChallenge$T1$algo), c("A1", "A1")) expect_equal(as.vector(actualChallenge$T1$value), c(0.8, 0.0)) expect_equal(as.vector(actualChallenge$T1$case), c("C1", "C2")) expect_equal(as.vector(actualChallenge$T2$algo), c("A2", "A2")) expect_equal(as.vector(actualChallenge$T2$value), c(0.0, 0.5)) expect_equal(as.vector(actualChallenge$T2$case), c("C1", "C2")) }) +test_that("NAs are replaced by function value for single-task challenge", { + data <- rbind( + data.frame(algo="A1", value=0.8, case="C1"), + data.frame(algo="A1", value=NA, case="C2"), + data.frame(algo="A2", value=0.6, case="C1"), + data.frame(algo="A2", value=NA, case="C2")) + + replacementFunction <- function(x) { 2 } + + actualChallenge <- as.challenge(data, taskName="T1", algorithm="algo", case="case", value="value", smallBetter=FALSE, na.treat=replacementFunction) + + expect_equal(as.vector(actualChallenge$T1$algo), c("A1", "A1", "A2", "A2")) + expect_equal(as.vector(actualChallenge$T1$value), c(0.8, 2.0, 0.6, 2.0)) + expect_equal(as.vector(actualChallenge$T1$case), c("C1", "C2", "C1", "C2")) +}) + test_that("NAs are replaced by function value for multi-task challenge", { dataTask1 <- cbind(task="T1", rbind( data.frame(algo="A1", value=0.8, case="C1"), data.frame(algo="A1", value=NA, case="C2") )) dataTask2 <- cbind(task="T2", rbind( data.frame(algo="A2", value=NA, case="C1"), data.frame(algo="A2", value=0.5, case="C2") )) data <- rbind(dataTask1, dataTask2) replacementFunction <- function(x) { 2 } actualChallenge <- as.challenge(data, by="task", algorithm="algo", case="case", value="value", smallBetter=FALSE, na.treat=replacementFunction) expect_equal(as.vector(actualChallenge$T1$algo), c("A1", "A1")) expect_equal(as.vector(actualChallenge$T1$value), c(0.8, 2.0)) expect_equal(as.vector(actualChallenge$T1$case), c("C1", "C2")) expect_equal(as.vector(actualChallenge$T2$algo), c("A2", "A2")) expect_equal(as.vector(actualChallenge$T2$value), c(2.0, 0.5)) expect_equal(as.vector(actualChallenge$T2$case), c("C1", "C2")) }) +test_that("NAs are removed for single-task challenge", { + data <- rbind( + data.frame(algo="A1", value=0.8, case="C1"), + data.frame(algo="A1", value=NA, case="C2"), + data.frame(algo="A2", value=0.6, case="C1"), + data.frame(algo="A2", value=NA, case="C2")) + + actualChallenge <- as.challenge(data, taskName="T1", algorithm="algo", case="case", value="value", smallBetter=FALSE, na.treat="na.rm") + + expect_equal(as.vector(actualChallenge$T1$algo), c("A1", "A2")) + expect_equal(as.vector(actualChallenge$T1$value), c(0.8, 0.6)) + expect_equal(as.vector(actualChallenge$T1$case), c("C1", "C1")) +}) + test_that("NAs are removed for multi-task challenge", { dataTask1 <- cbind(task="T1", rbind( data.frame(algo="A1", value=0.8, case="C1"), data.frame(algo="A1", value=NA, case="C2") )) dataTask2 <- cbind(task="T2", rbind( data.frame(algo="A2", value=NA, case="C1"), data.frame(algo="A2", value=0.5, case="C2") )) data <- rbind(dataTask1, dataTask2) actualChallenge <- as.challenge(data, by="task", algorithm="algo", case="case", value="value", smallBetter=FALSE, na.treat="na.rm") expect_equal(as.vector(actualChallenge$T1$algo), c("A1")) expect_equal(as.vector(actualChallenge$T1$value), c(0.8)) expect_equal(as.vector(actualChallenge$T1$case), c("C1")) expect_equal(as.vector(actualChallenge$T2$algo), c("A2")) expect_equal(as.vector(actualChallenge$T2$value), c(0.5)) expect_equal(as.vector(actualChallenge$T2$case), c("C2")) }) +test_that("automatically added NAs are replaced by numeric value for single-task challenge", { + data <- rbind( + data.frame(algo="A1", value=0.8, case="C1"), + data.frame(algo="A2", value=0.6, case="C2")) + + expect_message(actualChallenge <- as.challenge(data, taskName="T1", algorithm="algo", case="case", value="value", smallBetter=FALSE, na.treat=0), + "Performance of not all algorithms is observed for all cases in task 'T1'. Inserted as missings in following cases:", fixed=TRUE) + + expect_equal(as.vector(actualChallenge$T1$algo), c("A1", "A1", "A2", "A2")) + expect_equal(as.vector(actualChallenge$T1$value), c(0.8, 0.0, 0.0, 0.6)) + expect_equal(as.vector(actualChallenge$T1$case), c("C1", "C2", "C1", "C2")) +}) + test_that("automatically added NAs are replaced by numeric value for multi-task challenge", { dataTask1 <- cbind(task="T1", rbind( data.frame(algo="A1", value=0.8, case="C1"), 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="A1", value=0.3, case="C2"), data.frame(algo="A2", value=0.4, case="C1") )) data <- rbind(dataTask1, dataTask2) expect_message(actualChallenge <- as.challenge(data, by="task", algorithm="algo", case="case", value="value", smallBetter=FALSE, na.treat=0), - "Performance of not all algorithms is observed for all cases in task T1. Inserted as missings in following cases:") + "Performance of not all algorithms is observed for all cases in task 'T1'. Inserted as missings in following cases:", fixed=TRUE) expect_equal(as.vector(actualChallenge$T1$algo), c("A1", "A1", "A2", "A2")) expect_equal(as.vector(actualChallenge$T1$value), c(0.8, 0.0, 0.0, 0.6)) expect_equal(as.vector(actualChallenge$T1$case), c("C1", "C2", "C1", "C2")) expect_equal(as.vector(actualChallenge$T2$algo), c("A1", "A1", "A2", "A2")) expect_equal(as.vector(actualChallenge$T2$value), c(0.2, 0.3, 0.4, 0.0)) expect_equal(as.vector(actualChallenge$T2$case), c("C1", "C2", "C1", "C2")) }) +test_that("automatically added NAs are removed for single-task challenge", { + data <- rbind( + data.frame(algo="A1", value=0.8, case="C1"), + data.frame(algo="A2", value=0.6, case="C2")) + + expect_message(actualChallenge <- as.challenge(data, taskName="T1", algorithm="algo", case="case", value="value", smallBetter=FALSE, na.treat="na.rm"), + "Performance of not all algorithms is observed for all cases in task 'T1'. Inserted as missings in following cases:", fixed=TRUE) + + expect_equal(as.vector(actualChallenge$T1$algo), c("A1", "A2")) + expect_equal(as.vector(actualChallenge$T1$value), c(0.8, 0.6)) + expect_equal(as.vector(actualChallenge$T1$case), c("C1", "C2")) +}) + test_that("automatically added NAs are removed for multi-task challenge", { dataTask1 <- cbind(task="T1", rbind( data.frame(algo="A1", value=0.8, case="C1"), 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="A1", value=0.3, case="C2"), data.frame(algo="A2", value=0.4, case="C1") )) data <- rbind(dataTask1, dataTask2) expect_message(actualChallenge <- as.challenge(data, by="task", algorithm="algo", case="case", value="value", smallBetter=FALSE, na.treat="na.rm"), - "Performance of not all algorithms is observed for all cases in task T1. Inserted as missings in following cases:") + "Performance of not all algorithms is observed for all cases in task 'T1'. Inserted as missings in following cases:", fixed=TRUE) expect_equal(as.vector(actualChallenge$T1$algo), c("A1", "A2")) expect_equal(as.vector(actualChallenge$T1$value), c(0.8, 0.6)) expect_equal(as.vector(actualChallenge$T1$case), c("C1", "C2")) expect_equal(as.vector(actualChallenge$T2$algo), c("A1", "A1", "A2")) expect_equal(as.vector(actualChallenge$T2$value), c(0.2, 0.3, 0.4)) expect_equal(as.vector(actualChallenge$T2$case), c("C1", "C2", "C1")) -}) \ No newline at end of file +})