diff --git a/R/perf.R b/R/perf.R index 35bb631a..848b5889 100644 --- a/R/perf.R +++ b/R/perf.R @@ -808,6 +808,12 @@ perf.mixo_plsda <- function(object, warning("Leave-One-Out validation does not need to be repeated: 'nrepeat' is set to '1'.") nrepeat = 1 } + + if (any(table(object$Y) <= 1)) { + stop(paste("Cannot evaluate performance when a class level ('", + names(table(object$Y))[which(table(object$Y) == 1)], + "') has only a single assocaited sample.", sep = "")) + } if (nrepeat < 3 && validation != "loo") { warning("Values in '$choice.ncomp' will reflect component count with the minimum error rate rather than the best based on a one-way t.test") diff --git a/tests/testthat/test-perf.mixo.splsda.R b/tests/testthat/test-perf.mixo.splsda.R new file mode 100644 index 00000000..488231a9 --- /dev/null +++ b/tests/testthat/test-perf.mixo.splsda.R @@ -0,0 +1,28 @@ +test_that("perf.mixo_splsda functions", code = { + data(liver.toxicity) + X <- liver.toxicity$gene + Y <- liver.toxicity$treatment$Dose.Group + + set.seed(12) + res <- plsda(X, Y, ncomp = 2) + out <- perf(res, validation = "Mfold", folds = 3, nrepeat = 3) + + ground.ncomp <- matrix(c(2,1,2,2,1,2), ncol = 3, byrow=T, + dimnames = list(c("overall", "BER"), + c("max.dist", "centroids.dist", "mahalanobis.dist"))) + + expect_equal(out$choice.ncomp, ground.ncomp) +}) + +test_that("does not allow for class with 1 associated sample", code = { + data(liver.toxicity) + X <- liver.toxicity$gene + Y <- liver.toxicity$treatment$Dose.Group + # create a class with one sample only + Y[c(1)] <- 'random.class' + + res <- plsda(X, Y, ncomp = 2) + + expect_error(perf(res, validation = "Mfold", folds = 3, nrepeat = 3), + "single assocaited") +}) \ No newline at end of file