diff --git a/DESCRIPTION b/DESCRIPTION index 03f9746..149c00f 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -69,6 +69,7 @@ Collate: 'interfaceRandomForest.R' 'interfaceRandomForestSurvival.R' 'interfaceSVM.R' + 'interfaceTemplate.R' 'interfaceXGB.R' 'performancePlot.R' 'plotFeatureClasses.R' @@ -90,12 +91,12 @@ Collate: 'rankingPairsDifferences.R' 'rankingPlot.R' 'reexports.R' + 'registry.R' 'runTest.R' 'runTests.R' 'samplesMetricMap.R' 'selectMulti.R' 'selectionPlot.R' - 'simpleParams.R' 'subtractFromLocation.R' 'utilities.R' URL: https://sydneybiox.github.io/ClassifyR/ diff --git a/R/available.R b/R/available.R index 1ce02e9..f3852c1 100755 --- a/R/available.R +++ b/R/available.R @@ -6,6 +6,8 @@ #' @aliases available #' @param what Default: \code{"classifier"}. Either \code{"classifier"}, \code{"selectionMethod"} #' or \code{"multiViewMethod"}. +#' @return A data frame of keywords and their descriptions. For classifiers and feature selection methods, the column +#' \code{Outcomes} says whether each one accepts classes, survival outcomes or both. #' @author Dario Strbenac #' @examples diff --git a/R/constants.R b/R/constants.R index 1302183..2f3824c 100644 --- a/R/constants.R +++ b/R/constants.R @@ -25,80 +25,7 @@ NULL .ClassifyRenvir[["performanceTypes"]] <- .ClassifyRenvir[["performanceInfoTable"]][, "type"] -# Nice-looking names for feature selection and classification functions, to automatically use -# in a variety of performance plots. -.ClassifyRenvir[["functionsTable"]] <- matrix( - c("subtractFromLocation", "Subtraction From Training Set Location", - "bartlettRanking", "Bartlett Test", - "classifyInterface", "Poisson LDA", - "differentMeansRanking", "Difference in Means", - "DLDAtrainInterface", "Diagonal LDA", - "DMDranking", "Differences of Medians and Deviations", - "edgeRranking", "edgeR LRT", - "GLMtrainInterface", "Logistic Regression", - "penalisedGLMtrainInterface", "Penalised GLMs (Ridge, Elastic net, LASSO)", - "fisherDiscriminant", "Fisher's LDA", - "kNNinterface", "k Nearest Neighbours", - "KolmogorovSmirnovRanking", "Kolmogorov-Smirnov Test", - "kTSPclassifier", "k Top-Scoring Pairs", - "KullbackLeiblerRanking", "Kullback-Leibler Divergence", - "leveneRanking", "Levene Test", - "likelihoodRatioRanking", "Likelihood Ratio Test (Normal)", - "limmaRanking", "Moderated t-test", - "mixModelsTrain", "Mixtures of Normals", - "naiveBayesKernel", "Naive Bayes Kernel", - "NSCtrainInterface", "Nearest Shrunken Centroids", - "pairsDifferencesRanking", "Pairs Differences", - "previousSelection", "Previous Selection", - "previousTrained", "Previous Trained", - "randomSelection", "Random Selection", - "randomForestTrainInterface", "Random Forest", - "SVMtrainInterface", "Support Vector Machine", - "coxphTrainInterface", "Cox Proportional Hazards", - "coxphRanking", "Cox Proportional Hazards", - "coxnetTrainInterface", "Penalised Cox Proportional Hazards", - #"NEMOEtrainInterface", "Nutrition-Ecotype Mixture of Experts", - "rfsrcTrainInterface", "Random Survival Forest", - "extremeGradientBoostingTrainInterface", "Extreme Gradient Boosting"), - ncol = 2, byrow = TRUE, dimnames = list(NULL, c("character", "name")) -) |> as.data.frame() - -.ClassifyRenvir[["selectKeywords"]] <- matrix( - c("none", "Skip selection procedure and use all input features.", - "t-test", "T-test.", - "limma", "Moderated t-test.", - "edgeR", "edgeR likelihood ratio test.", - "Bartlett", "Bartlett's test for different variance.", - "Levene", "Levene's test for different variance.", - "DMD", "Differences in means/medians and/or deviations.", - "likelihoodRatio", "Likelihood ratio test (normal distribution).", - "KS", "Kolmogorov-Smirnov test for differences in distributions.", - "KL", "Kullback-Leibler divergence between distributions.", - "CoxPH", "Cox proportional hazards Wald test per-feature.", - "randomSelection", "Randomly selects a specified number of features." - ), - ncol = 2, byrow = TRUE, dimnames = list(NULL, c("selectionMethod Keyword", "Description")) -) |> as.data.frame() - -.ClassifyRenvir[["classifyKeywords"]] <- matrix( - c("randomForest", "Random forest.", - "DLDA", "Diagonal Linear Discriminant Analysis.", - "kNN", "k Nearest Neighbours.", - "GLM", "Logistic regression.", - "ridgeGLM", "Ridge GLM multinomial regression (alpha = 0).", - "elasticNetGLM", "Elastic net GLM multinomial regression (alpha = 0.5).", - "LASSOGLM", "LASSO GLM multinomial regression (alpha = 1).", - "SVM", "Support Vector Machine.", - "NSC", "Nearest Shrunken Centroids.", - "naiveBayes", "Naive Bayes kernel feature voting classifier.", - "mixturesNormals", "Mixture of normals feature voting classifier.", - "CoxPH", "Cox proportional hazards.", - "CoxNet", "Penalised Cox proportional hazards.", - "randomSurvivalForest", "Random survival forest.", - "XGB", "Extreme gradient booster." - ), - ncol = 2, byrow = TRUE, dimnames = list(NULL, c("classifier Keyword", "Description")) -) |> as.data.frame() +# The classifiers and feature selection methods, their keywords and display names are in the registry (registry.R). .ClassifyRenvir[["multiViewKeywords"]] <- matrix( c("none", "Keep assays separate.", diff --git a/R/crossValidate.R b/R/crossValidate.R index 0a80a1e..ff3627f 100644 --- a/R/crossValidate.R +++ b/R/crossValidate.R @@ -159,6 +159,8 @@ setMethod("crossValidate", "DataFrame", if(isCategorical) selectionMethod <- "t-test" else selectionMethod <- "CoxPH" if(length(classifier) == 1 && classifier == "auto") if(isCategorical) classifier <- "randomForest" else classifier <- "CoxPH" + .checkOutcomeType(classifier, outcome, "classifiers") + .checkOutcomeType(selectionMethod, outcome, "selections") # Which data-types or data-views are present? @@ -413,14 +415,16 @@ cleanClassifier <- function(classifier, measurements, nFeatures){ 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 %in% c("ridgeGLM", "elasticNetGLM", "LASSOGLM")) - if(length(checkENs) > 0) + # A classifier needing more features than an assay has is replaced by its fallback classifier. + for(index in seq_along(classifier)) { - replacements <- sapply(checkENs, function(checkEN) ifelse(any(nFeatures[[checkEN]] == 1), "GLM", classifier[[checkEN]])) - classifier[checkENs] <- replacements - if(any(replacements == "GLM")) - warning("Penalised GLM requires two or more features as input but there is only one. -Using an ordinary GLM instead.") + entry <- if(length(classifier[[index]]) == 1) .ClassifyRenvir[["classifiers"]][[classifier[[index]]]] + if(!is.null(entry[["fewFeaturesClassifier"]]) && any(nFeatures[[index]] < entry[["minFeatures"]])) + { + warning(classifier[[index]], " requires ", entry[["minFeatures"]], " or more features as input but there are fewer.\n", + "Using ", entry[["fewFeaturesClassifier"]], " instead.") + classifier[[index]] <- entry[["fewFeaturesClassifier"]] + } } classifier } diff --git a/R/interfaceTemplate.R b/R/interfaceTemplate.R new file mode 100644 index 0000000..813cbcc --- /dev/null +++ b/R/interfaceTemplate.R @@ -0,0 +1,33 @@ +################################################################################ +# +# The contract of a classifier or feature selection interface. Copy this outline for a new method, then register it +# in registry.R. +# +# Training: newTrainInterface(measurementsTrain, outcomeTrain, , ..., verbose = 3) +# - measurementsTrain is a DataFrame of the training samples, with features in columns. Categorical features are +# factors; methods needing a numeric matrix encode them with .encodeTrain and, at prediction, .encodeTest. +# - outcomeTrain (named classesTrain by the classifiers of classes only) is a factor of classes or a Surv object, as +# the registry entry's outcomes allow. It is passed by position. +# - are the method's settings. Those in the entry's tunePresets are tuned when tuneParams is "auto". +# - It returns the trained model. +# +# Prediction: newPredictInterface(model, measurementsTest, ..., returnType = c("both", "class", "score"), verbose = 3) +# - Classes: "class" gives a factor with the training levels, "score" a samples x classes numeric matrix of class +# scores or probabilities with the class names as column names, and "both" a data frame of a column "class" +# followed by the score columns. +# - Survival: a numeric vector of risk scores, where higher means a higher risk of the event. +# - A classifier that trains and predicts in one function takes measurementsTest as its third argument and has no +# prediction interface (predict = NULL in its registry entry). +# +# Features used by a model (optional), for classifiers that rank or select features themselves: newFeatures(model) +# returns a list of two vectors of column indices of measurementsTrain, the features ranked from best to worst and +# the features the model uses. Other arguments, if any, are named after variables of runTest (for example, +# measurementsTrain), which supplies them. It is the entry's getFeatures. +# +# Feature ranking: newRanking(measurementsTrain, outcomeTrain, ..., verbose = 3) returns the indices of the columns +# of measurementsTrain, from the best feature to the worst. +# +# Each function carries its name as an attribute, which results and plots use to show its display name: +# attr(newTrainInterface, "name") <- "newTrainInterface" +# +################################################################################ diff --git a/R/registry.R b/R/registry.R new file mode 100644 index 0000000..ff85769 --- /dev/null +++ b/R/registry.R @@ -0,0 +1,176 @@ +################################################################################ +# +# The registry of classifiers and feature selection methods. +# +# Adding a classifier or a feature selection method needs its interface file (see interfaceTemplate.R), its entry +# in Collate and one entry below. Everything else is read from the registry: the keywords of crossValidate, +# TrainParams, PredictParams and SelectParams, the tables of available(), the names shown in results and plots, +# tuning presets, the outcomes a method accepts and the fallback for too few features. +# +# The registry is built when the package is loaded, so the order of files in Collate does not matter. +# +################################################################################ + +# Registers a classifier. +# - keyword: the classifier keyword of crossValidate, TrainParams and PredictParams. +# - train, predict: the training and prediction functions. predict is NULL if train also predicts. +# - getFeatures: the function that extracts the features a trained model used, if the classifier selects features. +# - displayName: the name shown in results and plots. Classifiers sharing a training function share it. +# - description: one sentence for available(). +# - outcomes: "classes", "survival" or both. +# - tunePresets: the ranges of parameters tuned when tuneParams is "auto". NULL if the classifier has none. +# - defaults: other parameters of the training function. +# - minFeatures, fewFeaturesClassifier: the classifier used instead when an assay has fewer features than minFeatures. +# - listed: whether available() lists it. +.registerClassifier <- function(keyword, train, predict = NULL, getFeatures = NULL, displayName, description, + outcomes = "classes", tunePresets = NULL, defaults = list(), minFeatures = 1, + fewFeaturesClassifier = NULL, listed = TRUE) +{ + .ClassifyRenvir[["classifiers"]][[keyword]] <- list(train = train, predict = predict, getFeatures = getFeatures, + displayName = displayName, description = description, outcomes = outcomes, tunePresets = tunePresets, + defaults = defaults, minFeatures = minFeatures, fewFeaturesClassifier = fewFeaturesClassifier, listed = listed) +} + +# Registers a feature selection method. rank is the ranking (or selection) function, NULL for no selection. +.registerSelection <- function(keyword, rank, displayName = NULL, description, outcomes = c("classes", "survival"), + listed = TRUE) +{ + .ClassifyRenvir[["selections"]][[keyword]] <- list(rank = rank, displayName = displayName, description = description, + outcomes = outcomes, listed = listed) +} + +.buildRegistry <- function() +{ + .ClassifyRenvir[["classifiers"]] <- list() + .ClassifyRenvir[["selections"]] <- list() + forestPresets <- list(mTryProportion = c(0.10, 0.25, 0.33, 0.5), num.trees = c(1, 10, 100)) + + ##### Classifiers, in the order available() lists them ##### + .registerClassifier("randomForest", randomForestTrainInterface, randomForestPredictInterface, forestFeatures, + "Random Forest", "Random forest.", c("classes", "survival"), forestPresets) + .registerClassifier("DLDA", DLDAtrainInterface, DLDApredictInterface, displayName = "Diagonal LDA", + description = "Diagonal Linear Discriminant Analysis.") + .registerClassifier("kNN", kNNinterface, displayName = "k Nearest Neighbours", description = "k Nearest Neighbours.", + tunePresets = list(k = 1:5)) + .registerClassifier("GLM", GLMtrainInterface, GLMpredictInterface, displayName = "Logistic Regression", + description = "Logistic regression.") + penalisedName <- "Penalised GLMs (Ridge, Elastic net, LASSO)" + .registerClassifier("ridgeGLM", penalisedGLMtrainInterface, penalisedGLMpredictInterface, penalisedFeatures, + penalisedName, "Ridge GLM multinomial regression (alpha = 0).", defaults = list(alpha = 0), + minFeatures = 2, fewFeaturesClassifier = "GLM") + .registerClassifier("elasticNetGLM", penalisedGLMtrainInterface, penalisedGLMpredictInterface, penalisedFeatures, + penalisedName, "Elastic net GLM multinomial regression (alpha = 0.5).", defaults = list(alpha = 0.5), + minFeatures = 2, fewFeaturesClassifier = "GLM") + .registerClassifier("LASSOGLM", penalisedGLMtrainInterface, penalisedGLMpredictInterface, penalisedFeatures, + penalisedName, "LASSO GLM multinomial regression (alpha = 1).", + minFeatures = 2, fewFeaturesClassifier = "GLM") + .registerClassifier("SVM", SVMtrainInterface, SVMpredictInterface, displayName = "Support Vector Machine", + description = "Support Vector Machine.", + tunePresets = list(kernel = c("linear", "polynomial", "radial", "sigmoid"), cost = 10^(-3:3))) + .registerClassifier("NSC", NSCtrainInterface, NSCpredictInterface, NSCfeatures, "Nearest Shrunken Centroids", + "Nearest Shrunken Centroids.") + .registerClassifier("naiveBayes", naiveBayesKernel, displayName = "Naive Bayes Kernel", + description = "Naive Bayes kernel feature voting classifier.", + tunePresets = list(difference = c("unweighted", "weighted"))) + .registerClassifier("mixturesNormals", mixModelsTrain, mixModelsPredict, displayName = "Mixtures of Normals", + description = "Mixture of normals feature voting classifier.", defaults = list(nbCluster = 1:2)) + .registerClassifier("CoxPH", coxphTrainInterface, coxphPredictInterface, displayName = "Cox Proportional Hazards", + description = "Cox proportional hazards.", outcomes = "survival") + .registerClassifier("CoxNet", coxnetTrainInterface, coxnetPredictInterface, penalisedFeatures, + "Penalised Cox Proportional Hazards", "Penalised Cox proportional hazards.", outcomes = "survival") + .registerClassifier("randomSurvivalForest", rfsrcTrainInterface, rfsrcPredictInterface, rfsrcFeatures, + "Random Survival Forest", "Random survival forest.", outcomes = "survival", + tunePresets = list(mTryProportion = c(0.10, 0.25, 0.33, 0.5), ntree = c(1, 10, 100))) + .registerClassifier("XGB", extremeGradientBoostingTrainInterface, extremeGradientBoostingPredictInterface, + XGBfeatures, "Extreme Gradient Boosting", "Extreme gradient booster.", c("classes", "survival"), + list(mTryProportion = c(0.10, 0.25, 0.33, 0.5), nrounds = c(5, 10))) + # Uses the models trained in the same iteration of a previous cross-validation. + .registerClassifier("previousTrained", previousTrained, displayName = "Previous Trained", + description = "The models of a previous cross-validation.", outcomes = c("classes", "survival"), + listed = FALSE) + + ##### Feature selection, in the order available() lists them ##### + .registerSelection("none", NULL, description = "Skip selection procedure and use all input features.") + .registerSelection("t-test", differentMeansRanking, "Difference in Means", "T-test.", "classes") + .registerSelection("limma", limmaRanking, "Moderated t-test", "Moderated t-test.", "classes") + .registerSelection("edgeR", edgeRranking, "edgeR LRT", "edgeR likelihood ratio test.", "classes") + .registerSelection("Bartlett", bartlettRanking, "Bartlett Test", "Bartlett's test for different variance.", "classes") + .registerSelection("Levene", leveneRanking, "Levene Test", "Levene's test for different variance.", "classes") + .registerSelection("DMD", DMDranking, "Differences of Medians and Deviations", + "Differences in means/medians and/or deviations.", "classes") + .registerSelection("likelihoodRatio", likelihoodRatioRanking, "Likelihood Ratio Test (Normal)", + "Likelihood ratio test (normal distribution).", "classes") + .registerSelection("KS", KolmogorovSmirnovRanking, "Kolmogorov-Smirnov Test", + "Kolmogorov-Smirnov test for differences in distributions.", "classes") + .registerSelection("KL", KullbackLeiblerRanking, "Kullback-Leibler Divergence", + "Kullback-Leibler divergence between distributions.", "classes") + .registerSelection("CoxPH", coxphRanking, "Cox Proportional Hazards", "Cox proportional hazards Wald test per-feature.", + "survival") + .registerSelection("randomSelection", randomSelection, "Random Selection", + "Randomly selects a specified number of features.") + .registerSelection("previousSelection", previousSelection, "Previous Selection", + "The features chosen in the same iteration of a previous cross-validation.", listed = FALSE) + .registerSelection("selectMulti", selectMulti, description = "Union of the selections of several assays.", + listed = FALSE) + + .ClassifyRenvir[["classifyKeywords"]] <- .keywordsTable(.ClassifyRenvir[["classifiers"]], "classifier Keyword") + .ClassifyRenvir[["selectKeywords"]] <- .keywordsTable(.ClassifyRenvir[["selections"]], "selectionMethod Keyword") + + # Names shown in results and plots, by the name of a function. Functions without a keyword are listed here too. + registered <- c(lapply(.ClassifyRenvir[["classifiers"]], function(entry) c(attr(entry[["train"]], "name"), entry[["displayName"]])), + lapply(.ClassifyRenvir[["selections"]], function(entry) c(attr(entry[["rank"]], "name"), entry[["displayName"]]))) + registered <- do.call(rbind, Filter(function(pair) length(pair) == 2, registered)) + others <- matrix(c("subtractFromLocation", "Subtraction From Training Set Location", + "classifyInterface", "Poisson LDA", + "fisherDiscriminant", "Fisher's LDA", + "kTSPclassifier", "k Top-Scoring Pairs", + "pairsDifferencesRanking", "Pairs Differences"), ncol = 2, byrow = TRUE) + functionsTable <- unique(rbind(registered, others)) + dimnames(functionsTable) <- list(NULL, c("character", "name")) + .ClassifyRenvir[["functionsTable"]] <- as.data.frame(functionsTable) +} + +# The table of listed keywords that available() shows. +.keywordsTable <- function(registry, keywordColumn) +{ + listed <- Filter(function(entry) entry[["listed"]], registry) + table <- data.frame(names(listed), sapply(listed, `[[`, "description"), + sapply(listed, function(entry) paste(entry[["outcomes"]], collapse = ", ")), row.names = NULL) + setNames(table, c(keywordColumn, "Description", "Outcomes")) +} + +.selectionKeywordToFunction <- function(keyword) +{ + .ClassifyRenvir[["selections"]][[keyword]][["rank"]] +} + +# A classifier keyword's TrainParams and PredictParams (NULL if training also predicts), or NULL for an unknown keyword. +# tuneParams is used only by classifiers with tuning presets. "auto" chooses the presets. +.classifierKeywordToParams <- function(keyword, tuneParams) +{ + entry <- .ClassifyRenvir[["classifiers"]][[keyword]] + if(is.null(entry)) return(NULL) + if(is.null(entry[["tunePresets"]])) tuneParams <- NULL + else if(is.character(tuneParams) && tuneParams == "auto") tuneParams <- entry[["tunePresets"]] + trainParams <- do.call(TrainParams, c(list(entry[["train"]], tuneParams = tuneParams, getFeatures = entry[["getFeatures"]]), + entry[["defaults"]])) + predictParams <- if(!is.null(entry[["predict"]])) PredictParams(entry[["predict"]]) + list(trainParams = trainParams, predictParams = predictParams) +} + +# Stops if a classifier or feature selection keyword does not accept the kind of outcome. +.checkOutcomeType <- function(keywords, outcome, registryName) +{ + outcomeType <- if(is(outcome, "Surv")) "survival" else "classes" + registry <- .ClassifyRenvir[[registryName]] + unsuitable <- Filter(function(keyword) !is.null(registry[[keyword]]) && !outcomeType %in% registry[[keyword]][["outcomes"]], + unique(unlist(keywords))) + if(length(unsuitable) > 0) + stop(paste(unsuitable, collapse = ", "), " can't be used with ", if(outcomeType == "survival") "a survival outcome" else "classes", + ". See the Outcomes column of available(", if(registryName == "selections") "\"selectionMethod\"", ").") +} + +.onLoad <- function(libname, pkgname) +{ + .buildRegistry() +} diff --git a/R/simpleParams.R b/R/simpleParams.R deleted file mode 100644 index a885c88..0000000 --- a/R/simpleParams.R +++ /dev/null @@ -1,126 +0,0 @@ -# Random Forest -RFparams <- function(tuneParams = NULL) { - if(is.character(tuneParams) && tuneParams == "auto") tuneParams <- list(mTryProportion = c(0.10, 0.25, 0.33, 0.5), num.trees = c(1, 10, 100)) - trainParams <- TrainParams(randomForestTrainInterface, tuneParams = tuneParams, - getFeatures = forestFeatures) - predictParams <- PredictParams(randomForestPredictInterface) - - return(list(trainParams = trainParams, predictParams = predictParams)) -} - -# Random Survival Forest -RSFparams <- function(tuneParams = NULL) { - if(is.character(tuneParams) && tuneParams == "auto") tuneParams <- list(mTryProportion = c(0.10, 0.25, 0.33, 0.5), ntree = c(1, 10, 100)) - trainParams <- TrainParams(rfsrcTrainInterface, tuneParams = tuneParams, - getFeatures = rfsrcFeatures) - predictParams <- PredictParams(rfsrcPredictInterface) - - return(list(trainParams = trainParams, predictParams = predictParams)) -} - -XGBparams <- function(tuneParams = NULL) { - if(is.character(tuneParams) && tuneParams == "auto") tuneParams <- list(mTryProportion = c(0.10, 0.25, 0.33, 0.5), nrounds = c(5, 10)) - trainParams <- TrainParams(extremeGradientBoostingTrainInterface, tuneParams = tuneParams, - getFeatures = XGBfeatures) - predictParams <- PredictParams(extremeGradientBoostingPredictInterface) - - return(list(trainParams = trainParams, predictParams = predictParams)) -} - -# k Nearest Neighbours -kNNparams <- function(tuneParams = NULL) { - if(is.character(tuneParams) && tuneParams == "auto") tuneParams <- list(k = 1:5) - trainParams <- TrainParams(kNNinterface, tuneParams = tuneParams) - predictParams <- NULL - return(list(trainParams = trainParams, predictParams = predictParams)) -} - -# Ordinary GLM -GLMparams <- function() { - trainParams <- TrainParams(GLMtrainInterface) - predictParams <- PredictParams(GLMpredictInterface) - - return(list(trainParams = trainParams, predictParams = predictParams)) -} - -# Ridge GLM -ridgeGLMparams <- function() { - trainParams <- TrainParams(penalisedGLMtrainInterface, alpha = 0, getFeatures = penalisedFeatures) - predictParams <- PredictParams(penalisedGLMpredictInterface) - - return(list(trainParams = trainParams, predictParams = predictParams)) -} - -# Elastic net GLM -elasticNetGLMparams <- function() { - trainParams <- TrainParams(penalisedGLMtrainInterface, alpha = 0.5, getFeatures = penalisedFeatures) - predictParams <- PredictParams(penalisedGLMpredictInterface) - - return(list(trainParams = trainParams, predictParams = predictParams)) -} - -# LASSO GLM -LASSOGLMparams <- function() { - trainParams <- TrainParams(penalisedGLMtrainInterface, getFeatures = penalisedFeatures) - predictParams <- PredictParams(penalisedGLMpredictInterface) - - return(list(trainParams = trainParams, predictParams = predictParams)) -} - -# Support Vector Machine -SVMparams = function(tuneParams = NULL) { - if(is.character(tuneParams) && tuneParams == "auto") - tuneParams <- list(kernel = c("linear", "polynomial", "radial", "sigmoid"), cost = 10^(-3:3)) - trainParams <- TrainParams(SVMtrainInterface, tuneParams = tuneParams) - predictParams <- PredictParams(SVMpredictInterface) - - return(list(trainParams = trainParams, predictParams = predictParams)) -} - -# Nearest Shrunken Centroid -NSCparams = function() { - trainParams <- TrainParams(NSCtrainInterface, getFeatures = NSCfeatures) - predictParams <- PredictParams(NSCpredictInterface) - - return(list(trainParams = trainParams, predictParams = predictParams)) -} - -# Diagonal Linear Discriminant Analysis -DLDAparams = function() { - trainParams <- TrainParams(DLDAtrainInterface) - predictParams <- PredictParams(DLDApredictInterface) - - return(list(trainParams = trainParams, predictParams = predictParams)) -} - -# naive Bayes Kernel -naiveBayesParams <- function(tuneParams = NULL) { - if(is.character(tuneParams) && tuneParams == "auto") tuneParams <- list(difference = c("unweighted", "weighted")) - trainParams <- TrainParams(naiveBayesKernel, tuneParams = tuneParams) - predictParams <- NULL - return(list(trainParams = trainParams, predictParams = predictParams)) -} - -# Mixtures of Normals -mixModelsParams <- function() { - trainParams <- TrainParams(mixModelsTrain, nbCluster = 1:2) - predictParams <- PredictParams(mixModelsPredict) - - return(list(trainParams = trainParams, predictParams = predictParams)) -} - -# Cox Proportional Hazards Model for Survival -coxphParams <- function() { - trainParams <- TrainParams(coxphTrainInterface) - predictParams <- PredictParams(predictor = coxphPredictInterface) - - return(list(trainParams = trainParams, predictParams = predictParams)) -} - -# Cox Proportional Hazards Model with Elastic Net for Survival -coxnetParams <- function() { - trainParams <- TrainParams(coxnetTrainInterface, getFeatures = penalisedFeatures) - predictParams <- PredictParams(coxnetPredictInterface) - - return(list(trainParams = trainParams, predictParams = predictParams)) -} \ No newline at end of file diff --git a/R/utilities.R b/R/utilities.R index bbf9b14..3919e73 100644 --- a/R/utilities.R +++ b/R/utilities.R @@ -633,50 +633,6 @@ splitsTestInfo <- function(samplesSplits = c("k-Fold", "Permute k-Fold", "Permut ) } -.selectionKeywordToFunction <- function(keyword) -{ - switch( - keyword, - "none" = NULL, - "t-test" = differentMeansRanking, - "limma" = limmaRanking, - "edgeR" = edgeRranking, - "Bartlett" = bartlettRanking, - "Levene" = leveneRanking, - "DMD" = DMDranking, - "likelihoodRatio" = likelihoodRatioRanking, - "KS" = KolmogorovSmirnovRanking, - "KL" = KullbackLeiblerRanking, - "CoxPH" = coxphRanking, - "previousSelection" = previousSelection, - "randomSelection" = randomSelection, - "selectMulti" = selectMulti - ) -} - -.classifierKeywordToParams <- function(keyword, tuneParams) -{ - switch( - keyword, - "randomForest" = RFparams(tuneParams = tuneParams), - "randomSurvivalForest" = RSFparams(tuneParams = tuneParams), - "XGB" = XGBparams(tuneParams = tuneParams), - "GLM" = GLMparams(), - "ridgeGLM" = ridgeGLMparams(), - "elasticNetGLM" = elasticNetGLMparams(), - "LASSOGLM" = LASSOGLMparams(), - "SVM" = SVMparams(tuneParams = tuneParams), - "NSC" = NSCparams(), - "DLDA" = DLDAparams(), - "naiveBayes" = naiveBayesParams(tuneParams = tuneParams), - "mixturesNormals" = mixModelsParams(), - "kNN" = kNNparams(tuneParams = tuneParams), - "CoxPH" = coxphParams(), - "CoxNet" = coxnetParams(), - "previousTrained" = list(TrainParams(previousTrained), NULL) - ) -} - .dlda <- function(x, y, prior = NULL){ # Remove this once sparsediscrim is reinstated to CRAN. obj <- list() obj$labels <- y diff --git a/man/available.Rd b/man/available.Rd index 2feacf9..891866c 100644 --- a/man/available.Rd +++ b/man/available.Rd @@ -10,6 +10,10 @@ available(what = c("classifier", "selectionMethod", "multiViewMethod")) \item{what}{Default: \code{"classifier"}. Either \code{"classifier"}, \code{"selectionMethod"} or \code{"multiViewMethod"}.} } +\value{ +A data frame of keywords and their descriptions. For classifiers and feature selection methods, the column +\code{Outcomes} says whether each one accepts classes, survival outcomes or both. +} \description{ Prints a list of keywords to use with \code{\link{crossValidate}} } diff --git a/tests/testthat/test-registry.R b/tests/testthat/test-registry.R new file mode 100644 index 0000000..53c3c45 --- /dev/null +++ b/tests/testthat/test-registry.R @@ -0,0 +1,82 @@ +# Every registered classifier and feature selection method, fitted and predicted through crossValidate. + +classifierPackages <- list(randomForest = "ranger", kNN = "class", ridgeGLM = "glmnet", elasticNetGLM = "glmnet", + LASSOGLM = "glmnet", SVM = "e1071", NSC = "pamr", mixturesNormals = "Rmixmod", + CoxNet = "glmnet", randomSurvivalForest = "randomForestSRC", XGB = "xgboost") +selectionPackages <- list(limma = "limma", edgeR = "edgeR", Levene = "car", DMD = "robustbase") + +hasPackages <- function(packages) all(vapply(packages, requireNamespace, logical(1), quietly = TRUE)) + +test_that("available() lists the registered keywords with their outcomes", { + classifiers <- available() + expect_identical(colnames(classifiers), c("classifier Keyword", "Description", "Outcomes")) + expect_false("previousTrained" %in% classifiers[, "classifier Keyword"]) + expect_identical(classifiers[classifiers[, 1] == "CoxPH", "Outcomes"], "survival") + selections <- available("selectionMethod") + expect_identical(colnames(selections), c("selectionMethod Keyword", "Description", "Outcomes")) + expect_true(all(c("none", "t-test", "CoxPH") %in% selections[, 1])) +}) + +test_that("every classifier keyword fits and predicts its kinds of outcome in the expected format", { + classesData <- makeTwoClass(nSamples = 40, nFeatures = 10, shift = 2) + survivalData <- makeSurvival(nSamples = 60, nFeatures = 10) + for(keyword in available()[, "classifier Keyword"]) + { + if(!hasPackages(classifierPackages[[keyword]])) next + outcomes <- .subset2(ClassifyR:::.ClassifyRenvir[["classifiers"]], keyword)[["outcomes"]] + for(outcomeType in outcomes) + { + if(outcomeType == "classes") data <- list(classesData$measurements, classesData$classes) + else data <- list(survivalData$measurements, survivalData$outcome) + selection <- if(outcomeType == "classes") "t-test" else "CoxPH" + set.seed(1) + result <- suppressWarnings(crossValidate(data[[1]], data[[2]], nFeatures = 5, selectionMethod = selection, + classifier = keyword, nFolds = 2, nRepeats = 1)) + expect_s4_class(result, "ClassifyResult") + predicted <- predictions(result) + if(outcomeType == "classes") + expect_true("class" %in% colnames(predicted) && is.factor(predicted[["class"]]), label = keyword) + else + expect_true("risk" %in% colnames(predicted) && is.numeric(predicted[["risk"]]), label = keyword) + expect_equal(nrow(predicted), nrow(data[[1]]), label = keyword) + } + } +}) + +test_that("every feature selection keyword ranks features for its kinds of outcome", { + classesData <- makeTwoClass(nSamples = 40, nFeatures = 10, shift = 2) + survivalData <- makeSurvival(nSamples = 60, nFeatures = 10) + for(keyword in setdiff(available("selectionMethod")[, 1], "none")) + { + if(!hasPackages(selectionPackages[[keyword]])) next + outcomes <- .subset2(ClassifyR:::.ClassifyRenvir[["selections"]], keyword)[["outcomes"]] + for(outcomeType in outcomes) + { + if(outcomeType == "classes") data <- list(abs(classesData$measurements), classesData$classes, "DLDA") + else data <- list(survivalData$measurements, survivalData$outcome, "CoxPH") + set.seed(1) + result <- suppressWarnings(crossValidate(data[[1]], data[[2]], nFeatures = 5, selectionMethod = keyword, + classifier = data[[3]], nFolds = 2, nRepeats = 1)) + expect_s4_class(result, "ClassifyResult") + expect_true(all(lengths(chosenFeatureNames(result)) == 5), label = keyword) + } + } +}) + +test_that("a method that does not accept the kind of outcome stops early with a clear error", { + data <- makeTwoClass() + expect_error(crossValidate(data$measurements, data$classes, classifier = "CoxPH", nFolds = 2, nRepeats = 1), + "CoxPH can't be used with classes") + survivalData <- makeSurvival() + expect_error(crossValidate(survivalData$measurements, survivalData$outcome, selectionMethod = "t-test", + classifier = "CoxPH", nFolds = 2, nRepeats = 1), "t-test can't be used with a survival outcome") +}) + +test_that("keyword parameter sets match the registry, including tuning presets", { + forest <- ClassifyR:::.classifierKeywordToParams("randomForest", "auto") + expect_identical(forest$trainParams@tuneParams, list(mTryProportion = c(0.10, 0.25, 0.33, 0.5), num.trees = c(1, 10, 100))) + expect_null(ClassifyR:::.classifierKeywordToParams("DLDA", "auto")$trainParams@tuneParams) + expect_identical(ClassifyR:::.classifierKeywordToParams("ridgeGLM", NULL)$trainParams@otherParams, list(alpha = 0)) + expect_null(ClassifyR:::.classifierKeywordToParams("kNN", NULL)$predictParams) + expect_null(ClassifyR:::.classifierKeywordToParams("notAClassifier", NULL)) +}) diff --git a/vignettes/DevelopersGuide.Rmd b/vignettes/DevelopersGuide.Rmd index 866df15..46c0e3d 100755 --- a/vignettes/DevelopersGuide.Rmd +++ b/vignettes/DevelopersGuide.Rmd @@ -48,9 +48,7 @@ Importantly, ClassifyR implements a number of methods for classification using d ## Registering the Function -**ClassifyR** keeps track of functions used for model building, to allow automated naming of axes labels or tick marks in a nice format. To do this, each function has a pretty name associated with it in the file *constants.R*. Firstly, find `.ClassifyRenvir[["functionsTable"]]` in that file, which is basically a two-column matrix stored in an environment and add your new function and its pretty name as an additional row of that matrix. - -Secondly, there is a convenience cross-validation function named `crossValidate`. It allows convenient specification of feature selection and modelling combinations with keywords. To add a new feature ranking method, add a new entry to `.selectionKeywordToFunction` in `utilities.R` by adding a new keyword and function pair. There is a similar statement in the same R file for modelling functions, in which a new classifier, for instance, would be added. +Every classifier and feature selection method has one entry in the registry, *R/registry.R*. The entry gives the keyword used by `crossValidate`, `TrainParams`, `PredictParams` and `SelectParams`, the functions it calls, the name shown in axis labels and results, the description listed by `available()`, the kinds of outcome it accepts and its tuning presets. The arguments and return values an interface must have are described in *R/interfaceTemplate.R*. The vignette *Creating a Wrapper for New Functionality and Registering It* gives an example. ## Documenting the Function diff --git a/vignettes/incorporateNew.Rmd b/vignettes/incorporateNew.Rmd index f3f9eed..cd7d2e3 100644 --- a/vignettes/incorporateNew.Rmd +++ b/vignettes/incorporateNew.Rmd @@ -26,28 +26,22 @@ newFancyClassifier <- function(measurementsTrain, classesTrain, alpha, ..., verb attr(newFancyClassifier, "name") <- "newFancyClassifier" ``` -2. Open the file constants.R. In the `.ClassifyRenvir[["functionsTable"]]` two-column matrix, add a row specifying the function name and a nice title to use for plot labelling. For example, +Each interface follows the contract in R/interfaceTemplate.R: the arguments it receives and the format of the predictions it returns. -```{r, eval = FALSE} -.ClassifyRenvir[["functionsTable"]] <- matrix( - ... ... -"newFancyClassifier", "Fancy Classifier"), - ... ... -``` +2. Add the new file to the `Collate` field of the DESCRIPTION file. -3. Add a keyword that users will use when the want to use the function in cross-validation to one of the keywords two-column matrices along with a short one-sentence description. In the example, the new function is a classifier, so it is added to the end of the `"classifyKeywords"` matrix. +3. Register the function with one entry in R/registry.R, inside `.buildRegistry`. The entry gives the keyword that users type, the training and prediction functions, the name shown in results and plots, a one-sentence description for `available()`, the kinds of outcome the method accepts and, if the classifier has tuning parameters, a small range of values to try when `tuneParams` is `"auto"`. For example, ```{r, eval = FALSE} -.ClassifyRenvir[["classifyKeywords"]] <- matrix( - ... ... -"fancy", "Very good classifier that predicts amazingly well."), - ... ... +.registerClassifier("fancy", newFancyClassifier, newFancyPredictor, displayName = "Fancy Classifier", + description = "Very good classifier that predicts amazingly well.", + outcomes = "classes", tunePresets = list(alpha = c(0.1, 0.5, 1))) ``` -4. Depending on what kind of functionality the new function provides, add an entry into either `.selectionKeywordToFunction` or `.classifierKeywordToParams` functions in utilities.R. The first function maps a feature selection keyword to a wrapper function and the second maps a classifier keyword into a pair of `TrainParams` and `PredictParams` objects, which specify the functions of training and prediction stages. +A feature selection method is registered with `.registerSelection`, giving its ranking function instead. -5. If the function is a classifier, open simpleParams.R and define the `TrainParams` and `PredictParams` parameter sets there. If the classifier has any tuning parameters, it would be good to specify a small range of values to try, since crossValidate for simplicity doesn't allow anything other than a keyword to be specified by the user. +4. Run the package's tests. A test fits and predicts every registered keyword on small data sets and checks the format of the predictions. -6. Open the vignette in vignettes/ClassifyR.Rmd and look for the section heading #### Provided Methods for Feature Selection and Classification. Add the new function to the appropriate table. +5. Open the vignette in vignettes/ClassifyR.Rmd and look for the section heading #### Provided Methods for Feature Selection and Classification. Add the new function to the appropriate table. Now that the new function is defined and described, users will be able to discover it using `available()` at the R command line and results will automatically store nice names for the functions used and they will automatically be able to be shown in plots. \ No newline at end of file