From 4540dc7d35c26ee8d464f53ece714081cb720562 Mon Sep 17 00:00:00 2001
From: Max-Bladen <mbladen19@gmail.com>
Date: Mon, 21 Mar 2022 12:54:19 +1100
Subject: [PATCH] Fix for Issue #122

Implemented a check within the `perf.mixo_splsda()` function which prevents the method running if any of the classes have a single sample associated with them.

Also added to checks (in new file: `test-perf.mixo_splsda.R`) which ensure basic functionality as well as whether the function prevents a class with one sample being used.
---
 R/perf.R                               |  7 +++++
 tests/testthat/test-perf.mixo_splsda.R | 37 ++++++++++++++++++++++++++
 2 files changed, 44 insertions(+)
 create mode 100644 tests/testthat/test-perf.mixo_splsda.R

diff --git a/R/perf.R b/R/perf.R
index 7469987c..6aa9350f 100644
--- a/R/perf.R
+++ b/R/perf.R
@@ -805,6 +805,13 @@ perf.mixo_plsda <- function(object,
         stop("Choose one of the two following logratio transformation: 'none' or 'CLR'")
     #fold is checked in 'MCVfold'
     
+    # check if there is a class with only one sample
+    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 = ""))
+    }
+    
     
     #-- check significance threshold
     signif.threshold <- .check_alpha(signif.threshold)
diff --git a/tests/testthat/test-perf.mixo_splsda.R b/tests/testthat/test-perf.mixo_splsda.R
new file mode 100644
index 00000000..d8880708
--- /dev/null
+++ b/tests/testthat/test-perf.mixo_splsda.R
@@ -0,0 +1,37 @@
+context("perf.mixo_splsda")
+
+test_that("perf.mixo_splsda functions", code = {
+    data(liver.toxicity)
+    X <- liver.toxicity$gene
+    Y <- liver.toxicity$treatment$Dose.Group
+    # create a class with one sample only
+    #Y[c(1,2)] <- 'FOO'
+    
+    res <- plsda(X, Y, ncomp = 2)
+    set.seed(12)
+    out <- perf(res, validation = "Mfold", folds = 3, nrepeat = 3)
+    expect_is(out, "perf")
+    
+    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_true(all(out$choice.ncomp == ground.ncomp))
+})
+
+test_that("perf.mixo_splsda 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)] <- 'asdf'
+    
+    res <- plsda(X, Y, ncomp = 2)
+    set.seed(12)
+    expect_error(perf(res, validation = "Mfold", folds = 3, nrepeat = 3),
+                 paste("Cannot evaluate performance when a class level ('", 
+                       names(table(res$Y))[which(table(res$Y) == 1)], 
+                       "') has only a single assocaited sample.", 
+                       sep = ""),
+                 fixed = T)
+})