Added functionality to balance sample size of each level of the target/label variable [version 1.0.0]

R/commonMachineLearningClassification.R

@@ -33,14 +33,47 @@
     "noOfTrees", "maxTrees", "baggingFraction", "noOfPredictors", "numberOfPredictors",   # Random forest
     "complexityParameter", "degree", "gamma", "cost", "tolerance", "epsilon", "maxCost",  # Support vector machine
     "smoothingParameter",                                                                 # Naive Bayes
-    "intercept", "link"                                                                   # Logistic
+    "intercept", "link",                                                                  # Logistic
+	  "balanceLabels", "balanceSamplingMethod"                                                                     # Common
   )
   if (includeSaveOptions) {
     opt <- c(opt, "saveModel", "savePath")
   }
   return(opt)
 }
 
+# Function balancing the size of classes of a discrete dependent variable in a dataset
+.mlBalanceDataset <- function(dataset, options) {
+  # To balance the classes, this function uses either under- or oversampling to adjust
+  # the size of each class to either the minimum or maximum class size found in the data.
+  # The sampling method is random sampling.
+
+  # Ensures that if the option is not selected, balancing will not occur.
+  if (!isTRUE(options[["balanceLabels"]]))
+    return(dataset)
+
+  classes <- dataset[, options[["target"]]]
+  splitData <- split(dataset, classes)
+
+  if (options[["balanceSamplingMethod"]] == "minSample") {
+    n <- min(sapply(splitData, nrow))
+    replace <- FALSE
+  }
+
+  else {
+    n <- max(sapply(splitData, nrow))
+    replace <- TRUE
+  }
+
+  balancedSplits <- lapply(
+    X   = splitData,
+    FUN = function(df) {df[sample(nrow(df), size = n, replace = replace), ]}
+    )
+  balancedDataset <- do.call(rbind, balancedSplits)
+
+  return(balancedDataset)
+}
+
 .mlClassificationReadData <- function(dataset, options) {
   dataset <- .readDataClassificationRegressionAnalyses(dataset, options, include_weights = FALSE)
   if (options[["target"]] != "") {

R/commonMachineLearningRegression.R

@@ -166,7 +166,7 @@
   if (length(factorsWithNewLevels) > 0) {
     setType <- switch(type, "test" = gettext("test set"), "validation" = gettext("validation set"), "prediction" = gettext("new dataset"))
     additionalMessage <- switch(type,
-      "test" = gettext(" or use a different test set (e.g., automatically by setting a different seed or manually by specifying the test set indicator)"), 
+      "test" = gettext(" or use a different test set (e.g., automatically by setting a different seed or manually by specifying the test set indicator)"),
       "validation" = gettext(" or use a different validation set by setting a different seed"),
       "prediction" = "")
     factorMessage <- paste(sapply(factorsWithNewLevels, function(i) {
@@ -597,7 +597,7 @@
   }
   plot <- createJaspPlot(plot = NULL, title = gettext("Data Split"), width = 800, height = 30)
   plot$position <- position
-  plot$dependOn(options = c("dataSplitPlot", "target", "predictors", "trainingDataManual", "modelValid", "testSetIndicatorVariable", "testSetIndicator", "validationDataManual", "holdoutData", "testDataManual", "modelOptimization"))
+  plot$dependOn(options = c("balanceSamplingMethod", "balanceLabels", "dataSplitPlot", "target", "predictors", "trainingDataManual", "modelValid", "testSetIndicatorVariable", "testSetIndicator", "validationDataManual", "holdoutData", "testDataManual", "modelOptimization"))
   jaspResults[["plotDataSplit"]] <- plot
   if (!ready) {
     return()

R/mlClassificationLda.R

@@ -110,7 +110,7 @@ mlClassificationLda <- function(jaspResults, dataset, options, ...) {
     # Sample a percentage of the total data set
     trainingIndex <- sample.int(nrow(dataset), size = ceiling((1 - options[["testDataManual"]]) * nrow(dataset)))
   }
-  trainingSet <- dataset[trainingIndex, ]
+  trainingSet <- .mlBalanceDataset(dataset[trainingIndex, ], options)
   testSet <- dataset[-trainingIndex, ]
   # Check for factor levels in the test set that are not in the training set
   .checkForNewFactorLevelsInPredictionSet(trainingSet, testSet, "test")

R/mlClassificationLogisticMultinomial.R

@@ -74,7 +74,9 @@ mlClassificationLogisticMultinomial <- function(jaspResults, dataset, options, .
     # Sample a percentage of the total data set
     trainingIndex <- sample.int(nrow(dataset), size = ceiling((1 - options[["testDataManual"]]) * nrow(dataset)))
   }
-  trainingSet <- dataset[trainingIndex, ]
+  # Create training set with optional balanced classes
+  trainingSet <- .mlBalanceDataset(dataset[trainingIndex, ], options)
+
   # Create the generated test set indicator
   testIndicatorColumn <- rep(1, nrow(dataset))
   testIndicatorColumn[trainingIndex] <- 0

R/mlClassificationNaiveBayes.R

@@ -75,7 +75,7 @@ mlClassificationNaiveBayes <- function(jaspResults, dataset, options, ...) {
     # Sample a percentage of the total data set
     trainingIndex <- sample.int(nrow(dataset), size = ceiling((1 - options[["testDataManual"]]) * nrow(dataset)))
   }
-  trainingSet <- dataset[trainingIndex, ]
+  trainingSet <- .mlBalanceDataset(dataset[trainingIndex, ], options)
   # Create the generated test set indicator
   testIndicatorColumn <- rep(1, nrow(dataset))
   testIndicatorColumn[trainingIndex] <- 0

inst/qml/common/ui/DataSplit.qml

@@ -25,6 +25,7 @@ Section
 	property alias leaveOneOutVisible:			leaveOneOut.visible
 	property alias kFoldsVisible:				kFolds.visible
 	property alias trainingValidationSplit:		trainingValidationSplit.visible
+	property alias balanceTargetClasses: 		balanceTargetClasses.visible
 
 	title: 										qsTr("Data Split Preferences")
 
@@ -157,4 +158,32 @@ Section
 			info:								qsTr("Partition the remaining data in *n* parts.")
 		}
 	}
+
+    CheckBox 
+	{ 
+		id: balanceTargetClasses
+		name: "balanceLabels"
+		label: qsTr("Balance sample size of target classes")
+		info: qsTr("When clicked, the dataset is balanced to have the same sample size for all classes of the target variable. This is done either through over- or undersampling")
+
+		RadioButtonGroup
+		{
+			name: "balanceSamplingMethod"
+
+			RadioButton
+			{ 
+				value: "minSample" 
+				label: qsTr("Undersample") 
+				checked: true 
+				info: qsTr("Balances the target classes by undersampling to match the size of the smallest class.")
+			}
+
+			RadioButton
+			{ 
+				value: "maxSample" 
+				label: qsTr("Oversample") 
+				info: qsTr("Balances the target classes by oversampling to match the size of the largest class. This is done by sampling with replacement for smaller classes.")
+			}
+		}
+	}
 }

inst/qml/mlClassificationBoosting.qml

@@ -56,7 +56,12 @@ Form
 	}
 
 	UI.ExportResults { enabled: vars.predictorCount > 1 && vars.targetCount > 0 }
-	UI.DataSplit { leaveOneOutVisible: false; trainingValidationSplit: !optim.isManual }
+	UI.DataSplit 
+	{ 
+		leaveOneOutVisible: false 
+		trainingValidationSplit: !optim.isManual
+		balanceTargetClasses: false 
+	}
 
 	Section
 	{

inst/qml/mlClassificationDecisionTree.qml

@@ -56,7 +56,13 @@ Form
 	}
 
 	UI.ExportResults { enabled: vars.predictorCount > 0 && vars.targetCount > 0 }
-	UI.DataSplit { leaveOneOutVisible: false; kFoldsVisible: false; trainingValidationSplit: !optim.isManual }
+	UI.DataSplit 
+	{ 
+		leaveOneOutVisible: false 
+		kFoldsVisible: false 
+		trainingValidationSplit: !optim.isManual
+		balanceTargetClasses: false 
+	}
 
 	Section
 	{

inst/qml/mlClassificationKnn.qml

@@ -55,7 +55,7 @@ Form
 	}
 
 	UI.ExportResults { enabled: vars.predictorCount > 0 && vars.targetCount > 0 }
-	UI.DataSplit { trainingValidationSplit:	!optim.isManual }
+	UI.DataSplit { trainingValidationSplit:	!optim.isManual; balanceTargetClasses: false }
 
 	Section
 	{

inst/qml/mlClassificationNeuralNetwork.qml

@@ -57,7 +57,7 @@ Form
 	}
 
 	UI.ExportResults { enabled: vars.predictorCount > 0 && vars.targetCount > 0 }
-	UI.DataSplit { leaveOneOutVisible: false; kFoldsVisible: false }
+	UI.DataSplit { leaveOneOutVisible: false; kFoldsVisible: false; balanceTargetClasses: false }
 
 	Section
 	{

inst/qml/mlClassificationRandomForest.qml

@@ -56,7 +56,13 @@ Form
 	}
 
 	UI.ExportResults { enabled: vars.predictorCount > 1 && vars.targetCount > 0 }
-	UI.DataSplit { leaveOneOutVisible: false; kFoldsVisible: false; trainingValidationSplit: !optim.isManual }
+	UI.DataSplit 
+	{ 
+		leaveOneOutVisible: false 
+		kFoldsVisible: false 
+		trainingValidationSplit: !optim.isManual
+		balanceTargetClasses: false 
+	}
 
 	Section
 	{

inst/qml/mlClassificationSvm.qml

@@ -55,7 +55,12 @@ Form
 	}
 
 	UI.ExportResults { enabled: vars.predictorCount > 0 && vars.targetCount > 0 }
-	UI.DataSplit { leaveOneOutVisible: false; kFoldsVisible: false; trainingValidationSplit: !optim.isManual }
+	UI.DataSplit 
+	{ 
+		leaveOneOutVisible: false 
+		kFoldsVisible: false 
+		trainingValidationSplit: !optim.isManual
+		balanceTargetClasses: false }
 
 	Section
 	{

inst/qml/mlRegressionBoosting.qml

@@ -44,15 +44,20 @@ Form
 	{
 		title: qsTr("Plots")
 
-		FIG.DataSplit { }
+		FIG.DataSplit {}
 		FIG.PredictivePerformance { }
 		BOOSTING.Oob { }
 		BOOSTING.Deviance { }
 		BOOSTING.RelativeInfluence { }
 	}
 
 	UI.ExportResults { enabled:	vars.predictorCount > 1 && vars.targetCount > 0 }
-	UI.DataSplit { leaveOneOutVisible: false; trainingValidationSplit: !optim.isManual }
+	UI.DataSplit 
+	{ 
+		leaveOneOutVisible: 		false
+		trainingValidationSplit: 	!optim.isManual
+		balanceTargetClasses: 		false 
+	}
 
 	Section
 	{

inst/qml/mlRegressionDecisionTree.qml

@@ -52,7 +52,13 @@ Form
 	}
 
 	UI.ExportResults { enabled:	vars.predictorCount > 0 && vars.targetCount > 0 }
-	UI.DataSplit { leaveOneOutVisible: false; kFoldsVisible: false; trainingValidationSplit: !optim.isManual }
+	UI.DataSplit 
+	{ 
+		leaveOneOutVisible: 		false
+		kFoldsVisible: 				false
+		trainingValidationSplit: 	!optim.isManual
+		balanceTargetClasses: 		false  
+	}
 
 	Section
 	{

inst/qml/mlRegressionKnn.qml

@@ -52,7 +52,7 @@ Form
 
 	UI.ExportResults { enabled: vars.predictorCount > 0 && vars.targetCount > 0 }
 
-	UI.DataSplit { trainingValidationSplit: !optim.isManual }
+	UI.DataSplit { trainingValidationSplit: !optim.isManual ; balanceTargetClasses: false }
 
 	Section
 	{

inst/qml/mlRegressionLinear.qml

@@ -50,7 +50,7 @@ Form
 	}
 
 	UI.ExportResults { enabled:	vars.predictorCount > 0 && vars.targetCount > 0 }
-	UI.DataSplit { trainingValidationSplit: false }
+	UI.DataSplit { trainingValidationSplit: false; balanceTargetClasses: false  }
 
 	Section
 	{

inst/qml/mlRegressionNeuralNetwork.qml

@@ -53,7 +53,7 @@ Form
 	}
 
 	UI.ExportResults { enabled: vars.predictorCount > 0 && vars.targetCount > 0 }
-	UI.DataSplit { leaveOneOutVisible: false; kFoldsVisible: false }
+	UI.DataSplit { leaveOneOutVisible: false; kFoldsVisible: false; balanceTargetClasses: false  }
 
 	Section
 	{

inst/qml/mlRegressionRandomForest.qml

@@ -52,7 +52,13 @@ Form
 	}
 
 	UI.ExportResults { enabled: vars.predictorCount > 1 && vars.targetCount > 0 }
-	UI.DataSplit { leaveOneOutVisible: false; kFoldsVisible: false; trainingValidationSplit: !optim.isManual }
+	UI.DataSplit 
+	{ 
+		leaveOneOutVisible: 		false
+		kFoldsVisible: 				false
+		trainingValidationSplit: 	!optim.isManual
+		balanceTargetClasses: 		false
+	}
 
 	Section
 	{

inst/qml/mlRegressionRegularized.qml

@@ -85,6 +85,7 @@ Form
 		leaveOneOutVisible:						false
 		kFoldsVisible:							false
 		trainingValidationSplit:				!fixedModel.checked
+		balanceTargetClasses: 					false 
 	}
 
 	Section

inst/qml/mlRegressionSvm.qml

@@ -51,7 +51,13 @@ Form
 	}
 
 	UI.ExportResults { enabled: vars.predictorCount > 0 && vars.targetCount > 0 }
-	UI.DataSplit { leaveOneOutVisible: false; kFoldsVisible: false; trainingValidationSplit: !optim.isManual }
+	UI.DataSplit 
+	{ 
+		leaveOneOutVisible: 		false
+		kFoldsVisible: 				false
+		trainingValidationSplit: 	!optim.isManual
+		balanceTargetClasses: 		false  
+	}
 
 	Section
 	{