@@ -3,8 +3,8 @@ Type: Package

 Title: A framework for cross-validated classification problems, with

        applications to differential variability and differential

        distribution testing

-Version: 3.1.25

-Date: 2022-10-18

+Version: 3.1.26

+Date: 2022-10-19

 Author: Dario Strbenac, Ellis Patrick, John Ormerod, Graham Mann, Jean Yang

 Maintainer: Dario Strbenac <dario.strbenac@sydney.edu.au>

 VignetteBuilder: knitr

@@ -124,16 +124,8 @@ setMethod("crossValidate", "DataFrame",

                                           measurements = measurements)

               selectionMethod <- cleanSelectionMethod(selectionMethod = selectionMethod,

                                                       measurements = measurements)

-              if(any(nFeatures == 1) && classifier == "elasticNetGLM")

-              {

-                  options(warn = 1)

-                  warning("Elastic Net GLM requires two or more features as input but there is only one.

-Using an ordinary GLM instead.")

-                  classifier <- "GLM"

-              }

-              

               classifier <- cleanClassifier(classifier = classifier,

-                                            measurements = measurements)

+                                            measurements = measurements, nFeatures = nFeatures)

               ##!!!!! Do something with data combinations

@@ -201,7 +193,7 @@ Using an ordinary GLM instead.")

                   # The below loops over different combinations of assays and merges them together.

                   # This allows someone to answer which combinations of the assays might be most useful.

-                  if(!is.list(assayCombinations) && assayCombinations == "all") assayCombinations <- do.call("c", sapply(seq_along(assayIDs), function(nChoose) combn(assayIDs, nChoose, simplify = FALSE)))

+                  if(!is.list(assayCombinations) && assayCombinations[1] == "all") assayCombinations <- do.call("c", sapply(seq_along(assayIDs), function(nChoose) combn(assayIDs, nChoose, simplify = FALSE)))

                   result <- sapply(assayCombinations, function(assayIndex){

                       CV(measurements = measurements[, mcols(measurements)[["assay"]] %in% assayIndex],

@@ -229,7 +221,7 @@ Using an ordinary GLM instead.")

                   # This allows someone to answer which combinations of the assays might be most useful.

-                  if(!is.list(assayCombinations) && assayCombinations == "all")

+                  if(!is.list(assayCombinations) && assayCombinations[1] == "all")

                   {

                       assayCombinations <- do.call("c", sapply(seq_along(assayIDs), function(nChoose) combn(assayIDs, nChoose, simplify = FALSE)))

                       assayCombinations <- assayCombinations[sapply(assayCombinations, function(combination) "clinical" %in% combination, simplify = TRUE)]

@@ -263,7 +255,7 @@ Using an ordinary GLM instead.")

                   # This allows someone to answer which combinations of the assays might be most useful.

-                  if(!is.list(assayCombinations) && assayCombinations == "all"){

+                  if(!is.list(assayCombinations) && assayCombinations[1] == "all"){

                       assayCombinations <- do.call("c", sapply(seq_along(assayIDs),function(nChoose) combn(assayIDs, nChoose, simplify = FALSE)))

                       assayCombinations <- assayCombinations[sapply(assayCombinations, function(combination) "clinical" %in% combination, simplify = TRUE)]

                       if(length(assayCombinations) == 0) stop("No assayCombinations with \"clinical\" data")

@@ -471,9 +463,9 @@ cleanNFeatures <- function(nFeatures, measurements){

       obsFeatures <- unlist(as.list(table(mcols(measurements)[, "assay"])))

     else obsFeatures <- ncol(measurements)

     if(is.null(nFeatures) || length(nFeatures) == 1 && nFeatures == "all") nFeatures <- as.list(obsFeatures)

-    if(is.null(names(nFeatures)) & length(nFeatures) == 1) nFeatures <- as.list(pmin(obsFeatures, nFeatures))

-    if(is.null(names(nFeatures)) & length(nFeatures) > 1) nFeatures <- sapply(obsFeatures, function(x)pmin(x, nFeatures), simplify = FALSE)

-    #if(is.null(names(nFeatures)) & length(nFeatures) > 1) stop("nFeatures needs to be a named numeric vector or list with the same names as the assays.")

+    if(is.null(names(nFeatures)) && length(nFeatures) == 1) nFeatures <- as.list(pmin(obsFeatures, nFeatures))

+    if(is.null(names(nFeatures)) && length(nFeatures) > 1) nFeatures <- sapply(obsFeatures, function(x)pmin(x, nFeatures), simplify = FALSE)

+    #if(is.null(names(nFeatures)) && length(nFeatures) > 1) stop("nFeatures needs to be a named numeric vector or list with the same names as the assays.")

     if(!is.null(names(obsFeatures)) && !all(names(obsFeatures) %in% names(nFeatures))) stop("nFeatures needs to be a named numeric vector or list with the same names as the assays.")

     if(!is.null(names(obsFeatures)) && all(names(obsFeatures) %in% names(nFeatures)) & is(nFeatures, "numeric")) nFeatures <- as.list(pmin(obsFeatures, nFeatures[names(obsFeatures)]))

     if(!is.null(names(obsFeatures)) && all(names(obsFeatures) %in% names(nFeatures)) & is(nFeatures, "list")) nFeatures <- mapply(pmin, nFeatures[names(obsFeatures)], obsFeatures, SIMPLIFY = FALSE)

@@ -498,7 +490,7 @@ cleanSelectionMethod <- function(selectionMethod, measurements){

 ######################################

 ######################################

-cleanClassifier <- function(classifier, measurements){

+cleanClassifier <- function(classifier, measurements, nFeatures){

     #### Clean up

     if(!is.null(mcols(measurements)$assay))

       obsFeatures <- unlist(as.list(table(mcols(measurements)[, "assay"])))

@@ -509,10 +501,20 @@ cleanClassifier <- function(classifier, measurements){

     #if(is.null(names(classifier)) & length(classifier) > 1) stop("classifier needs to be a named character vector or list with the same names as the assays.")

     if(!is.null(names(obsFeatures)) && !all(names(obsFeatures) %in% names(classifier))) stop("classifier needs to be a named character vector or list with the same names as the assays.")

     if(!is.null(names(obsFeatures)) && all(names(obsFeatures) %in% names(classifier)) & is(classifier, "character")) classifier <- as.list(classifier[names(obsFeatures)])

+    

+    nFeatures <- nFeatures[names(classifier)]

+    checkENs <- which(classifier == "elasticNetGLM")

+    if(length(checkENs) > 0)

+    {

+      replacements <- sapply(checkENs, function(checkEN) ifelse(any(nFeatures[[checkEN]] == 1), "GLM", "elasticNetGLM"))

+      classifier[checkENs] <- replacements

+      if(any(replacements) == "GLM")    

+        warning("Elastic Net GLM requires two or more features as input but there is only one.

+Using an ordinary GLM instead.")

+    }

     classifier

 }

-

 ######################################

 ######################################

 #' A function to generate a CrossValParams object

@@ -808,14 +810,6 @@ CV <- function(measurements = NULL,

                characteristicsLabel = NULL)

 {

-    # Check that other variables are in the right format and fix

-    nFeatures <- cleanNFeatures(nFeatures = nFeatures,

-                                measurements = measurements)

-    selectionMethod <- cleanSelectionMethod(selectionMethod = selectionMethod,

-                                            measurements = measurements)

-    classifier <- cleanClassifier(classifier = classifier,

-                                  measurements = measurements)

-

     # Which data-types or data-views are present?

     if(is.null(characteristicsLabel)) characteristicsLabel <- "none"

@@ -841,7 +835,7 @@ CV <- function(measurements = NULL,

     characteristics <- S4Vectors::DataFrame(characteristic = c(if(!is.null(assayText)) "Assay Name" else NULL, "Classifier Name", "Selection Name", "multiViewMethod", "characteristicsLabel"), value = c(if(!is.null(assayText)) paste(assayText, collapse = ", ") else NULL, paste(classifier, collapse = ", "),  paste(selectionMethod, collapse = ", "), multiViewMethod, characteristicsLabel))

     if(!is.null(measurements))

-    { # Cross-validation.        

+    { # Cross-validation.

       classifyResults <- runTests(measurements, outcome, crossValParams = crossValParams, modellingParams = modellingParams, characteristics = characteristics)

       fullResult <- runTest(measurements, outcome, measurements, outcome, crossValParams = crossValParams, modellingParams = modellingParams, characteristics = characteristics, .iteration = 1)

     } else { # Independent training and testing.

@@ -14,6 +14,7 @@ classifyInterface <- function(countsTrain, classesTrain, countsTest, ...,

   classPredictions <- predicted[["ytehat"]]

   classScores <- predicted[["discriminant"]]

   colnames(classScores) <- levels(classesTrain)

+  rownames(classScores) <- names(classPredictions) <- rownames(countsTest)

   switch(returnType, class = classPredictions, # Factor vector.

          score = classScores, # Numeric matrix.

          both = data.frame(class = classPredictions, classScores, check.names = FALSE))

@@ -39,6 +39,6 @@ coxnetPredictInterface <- function(model, measurementsTest, survivalTest = NULL,

   model$offset <- TRUE

   survScores <- predict(model, testMatrix, s = lambda, type = "response", newoffset = offset)

-  

+  rownames(survScores) <- rownames(measurementsTest)

   survScores[, 1]

 }

\ No newline at end of file

@@ -31,15 +31,6 @@ extractPrevalidation = function(assayPreval){ #}, startingCol) {

     vec

 }

-# Use to pull out the names of features in a ClassifyR model - XYZ: Could Ditch if we really wanted to

-featurePuller = function(classifyObject) {

-    if ("selectResult" %in% slotNames(classifyObject)) {

-        features = classifyObject@selectResult@chosenFeatures

-    } else{

-        features = classifyObject@originalFeatures

-    }

-}

-

 setClass("prevalModel", slots = list(fullModel = "list"))

 prevalTrainInterface <- function(measurements, classes, params, ...)

@@ -23,6 +23,7 @@ randomForestPredictInterface <- function(forest, measurementsTest, ..., returnTy

   classPredictions <- predict(forest, measurementsTest)$predictions

   classScores <- predict(forest, measurementsTest, predict.all = TRUE)[[1]]

   classScores <- t(apply(classScores, 1, function(sampleRow) table(factor(classes[sampleRow], levels = classes)) / forest$forest$num.trees))

+  rownames(classScores) <- names(classPredictions) <- rownames(measurementsTest)

   switch(returnType, class = classPredictions,

          score = classScores,

          both = data.frame(class = classPredictions, classScores, check.names = FALSE))

@@ -38,7 +38,7 @@ SVMpredictInterface <- function(model, measurementsTest, returnType = c("both",

   # e1071 uses attributes to pass back probabilities. Make them a standalone variable.

   classScores <- attr(classPredictions, "probabilities")[, model[["levels"]], drop = FALSE]

   attr(classPredictions, "probabilities") <- NULL

-  

+  rownames(classScores) <- names(classPredictions) <- rownames(measurementsTest)

   switch(returnType, class = classPredictions, score = classScores,

          both = data.frame(class = classPredictions, classScores, check.names = FALSE))

 }

\ No newline at end of file

@@ -46,13 +46,17 @@ extremeGradientBoostingPredictInterface <- function(booster, measurementsTest, .

   if(verbose == 3)

     message("Predicting using boosted random forest.")  

   measurementsTest <- as(measurementsTest, "data.frame")

+  measurementsTest <- measurementsTest[, attr(booster, "featureNames")]

   # Convert to one-hot encoding as xgboost doesn't understand factors. Need to get rid of intercept afterwards.

   measurementsTest <- MatrixModels::model.Matrix(~ 0 + ., data = measurementsTest, sparse = TRUE)

+  

   scores <- predict(booster, measurementsTest, reshape = TRUE)

+  colnames(scores) <- attr(booster, "classes")

   if(!is.null(attr(booster, "classes"))) # It is a classification task.

   {

     classPredictions <- attr(booster, "classes")[apply(scores, 1, function(sampleRow) which.max(sampleRow)[1])]

     classPredictions <- factor(classPredictions, levels = attr(booster, "classes"))

+    rownames(scores) <- names(classPredictions) <- rownames(measurementsTest)

     result <- switch(returnType, class = classPredictions,

                      score = scores,

                      both = data.frame(class = classPredictions, scores, check.names = FALSE))

@@ -188,7 +188,7 @@ Function(s) | Description | DM | DV | DD

 <span style="font-family: 'Courier New', monospace;">fisherDiscriminant</span> | Implementation of Fisher's LDA for departures from normality | ✔ | ✔* |

 <span style="font-family: 'Courier New', monospace;">mixModelsTrain</span>, <span style="font-family: 'Courier New', monospace;">mixModelsPredict</span> | Feature-wise mixtures of normals and voting | ✔ | ✔ | ✔ 

 <span style="font-family: 'Courier New', monospace;">naiveBayesKernel</span> | Feature-wise kernel density estimation and voting | ✔ | ✔ | ✔ 

-<span style="font-family: 'Courier New', monospace;">randomForestTrainInterface</span>, <span style="font-family: 'Courier New', monospace;">randomForestPredictInterface</span> | Wrapper for randomForest's functions <span style="font-family: 'Courier New', monospace;">randomForest</span> and <span style="font-family: 'Courier New', monospace;">predict</span> | ✔ | ✔ | ✔ 

+<span style="font-family: 'Courier New', monospace;">randomForestTrainInterface</span>, <span style="font-family: 'Courier New', monospace;">randomForestPredictInterface</span> | Wrapper for ranger's functions <span style="font-family: 'Courier New', monospace;">ranger</span> and <span style="font-family: 'Courier New', monospace;">predict</span> | ✔ | ✔ | ✔ 

 <span style="font-family: 'Courier New', monospace;">extremeGradientBoostingTrainInterface</span>, <span style="font-family: 'Courier New', monospace;">extremeGradientBoostingPredictInterface</span> | Wrapper for xgboost's functions <span style="font-family: 'Courier New', monospace;">xgboost</span> and <span style="font-family: 'Courier New', monospace;">predict</span> | ✔ | ✔ | ✔ 

 <span style="font-family: 'Courier New', monospace;">kNNinterface</span> | Wrapper for class's function <span style="font-family: 'Courier New', monospace;">knn</span> | ✔ | ✔ | ✔ 

 <span style="font-family: 'Courier New', monospace;">SVMtrainInterface</span>, <span style="font-family: 'Courier New', monospace;">SVMpredictInterface</span> | Wrapper for e1071's functions <span style="font-family: 'Courier New', monospace;">svm</span> and <span style="font-family: 'Courier New', monospace;">predict.svm</span> | ✔ | ✔ †| ✔ †