PR addressing Issue #172

R/perf.R

@@ -795,6 +795,10 @@ perf.mixo_plsda <- function(object,
         nrepeat = 1
     }
 
+    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")
+    }
+
     if (!is.logical(progressBar))
         stop("'progressBar' must be either TRUE or FALSE")
 
@@ -806,6 +810,8 @@ perf.mixo_plsda <- function(object,
     #fold is checked in 'MCVfold'
 
 
+
+
     #-- check significance threshold
     signif.threshold <- .check_alpha(signif.threshold)
 
@@ -997,15 +1003,24 @@ perf.mixo_plsda <- function(object,
     # calculating the number of optimal component based on t.tests and the error.rate.all, if more than 3 error.rates(repeat>3)
     ncomp_opt = matrix(NA, nrow = length(measure), ncol = length(dist),
                        dimnames = list(measure, dist))
-    if(nrepeat > 2 & ncomp >1)
+
+    for (measure_i in measure)
     {
-        for (measure_i in measure)
-        {
-            for (ijk in dist)
+        for (ijk in dist) {
+            if(nrepeat > 2 & ncomp >1)
+            {
                 ncomp_opt[measure, ijk] = t.test.process(t(mat.error.rate[[measure_i]][[ijk]]), alpha = signif.threshold)
+            }
+            else
+            {
+                ncomp_opt[measure, ijk] = which(t(rowMeans(mat.error.rate[[measure_i]][[ijk]])) == min(t(rowMeans(mat.error.rate[[measure_i]][[ijk]]))))
+            }
         }
     }
 
+
+
+
     result = list(error.rate = mat.mean.error,
                   error.rate.sd = mat.sd.error,
                   error.rate.all = mat.error.rate,

tests/testthat/test-perf.R

@@ -0,0 +1,20 @@
+context("perf")
+
+test_that("perf works when nrepeat < 3 and validation != 'loo'", code = {
+
+  data(srbct) # extract the small round bull cell tumour data
+  X <- srbct$gene # use the gene expression data as the X matrix
+  Y <- srbct$class # use the class data as the Y matrix
+
+  initial.plsda <- plsda(X, Y, ncomp = 5)
+
+  set.seed(12)
+  plsda.perf <- suppressWarnings(perf(initial.plsda, progressBar = FALSE, auc = FALSE, 
+                     folds = 3, nrepeat = 1))
+
+  trueVals <- matrix(5, ncol = 3, nrow = 2)
+  colnames(trueVals) <- c("max.dist", "centroids.dist", "mahalanobis.dist")
+  rownames(trueVals) <- c("overall", "BER")
+
+  expect_equal(plsda.perf$choice.ncomp, trueVals)
+})