diff --git a/R/Bootstrap.R b/R/Bootstrap.R
index 64a1969..df66d74 100644
--- a/R/Bootstrap.R
+++ b/R/Bootstrap.R
@@ -1,210 +1,219 @@
# 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 .
bootstrap <- function(object,...) UseMethod("bootstrap")
bootstrap.default <- function(object, ...) stop("not implemented for this class")
#' Performs bootstrapping
#'
#' Performs bootstrapping on a ranked assessment data set and applies the ranking method to each bootstrap sample. One bootstrap sample of
#' a task with \code{n} cases consists of \code{n} cases randomly drawn with replacement from this task.
#' A total of \code{nboot} of these bootstrap samples are drawn.
#'
#' @param object The ranked assessment data set.
#' @param nboot The number of bootstrap samples.
#' @param parallel A boolean specifying whether parallel processing should be enabled.
#' @param progress A string specifying the type of progress indication.
#' @param ... Further arguments passed to or from other functions.
#'
#' @return An S3 object of class "bootstrap.list" to represent a bootstrapped, ranked assessment data set.
#'
#' @examples
#'
#' \dontrun{
#' # perform bootstrapping with 1000 bootstrap samples using one CPU
#' set.seed(1)
#' ranking_bootstrapped <- bootstrap(ranking, nboot = 1000)
#' }
#'
#' \dontrun{
#' # perform bootstrapping using multiple CPUs (here: 8 CPUs)
#' library(doParallel)
#' registerDoParallel(cores=8)
#' set.seed(1)
#' ranking_bootstrapped <- bootstrap(ranking, nboot = 1000, parallel = TRUE, progress = "none")
#' stopImplicitCluster()
#' }
#'
#' @export
bootstrap.ranked.list=function(object,
nboot,
parallel=FALSE,
progress="text",
...){
algorithm=attr(object$data,"algorithm")
by=attr(object$data,"case")
# exclude if only 1 test case or only 1 algorithm
tidy.data.id=sapply(object$data,
function(data.subset) {
ifelse((length(unique(data.subset[[by]]))==1 | length(unique(data.subset[[algorithm]]))<=1 ),
yes=FALSE,
no=TRUE)
})
+
+ if (sum(tidy.data.id)==0) {
+ if (length(object$matlist)>1) stop("All tasks only contained 1 test case. Bootstrapping with 1 test case not sensible.")
+ else stop("Only 1 test case included. Bootstrapping with 1 test case not sensible.")
+ }
+ if (sum(tidy.data.id)%aggregateThenRank(FUN=median, ties.method="min")
+
+set.seed(1)
+
+
+expect_error(rankingBootstrapped <- ranking%>%bootstrap(nboot=10),
+ "Only 1 test case included. Bootstrapping with 1 test case not sensible.", fixed = TRUE)
+})
+
+
+test_that("Multi task bootstrapping, all tasks with 1 test case stopped with message", {
+ 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")
+
+ set.seed(1)
+ expect_error(rankingBootstrapped <- ranking%>%bootstrap(nboot=10),
+ "All tasks only contained 1 test case. Bootstrapping with 1 test case not sensible.", fixed = TRUE)
+})
+
+
+test_that("Multi task bootstrapping, only one task with >1 test case continued with message", {
+ 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")
+
+ set.seed(1)
+ expect_message(rankingBootstrapped <- ranking%>%bootstrap(nboot=3),
+ "Task(s) T1, T3 with only 1 test case excluded from bootstrapping.", fixed = TRUE)
+})
+
+