Changes for new variable types (#358)

* changes for new variable types when reading options from a jasp file * start on fixing unit tests * fix some more tests
jasp-stats · Jul 11, 2024 · 1d2842e · 1d2842e
1 parent 4fd6ed6
commit 1d2842e
Show file tree

Hide file tree

Showing 25 changed files with 127 additions and 53 deletions.
diff --git a/R/commonMachineLearningClustering.R b/R/commonMachineLearningClustering.R
@@ -34,7 +34,7 @@
   predictors <- unlist(options[["predictors"]])
   predictors <- predictors[predictors != ""]
   if (is.null(dataset)) {
-    dataset <- .readAndAddCompleteRowIndices(dataset, predictors)
+    dataset <- .readAndAddCompleteRowIndices(options, "predictors")
   }
   if (options[["scaleVariables"]] && length(unlist(options[["predictors"]])) > 0) {
     dataset <- .scaleNumericData(dataset)
@@ -374,8 +374,8 @@
     ggplot2::scale_fill_manual(name = gettext("Cluster"), values = .mlColorScheme(ncolors)) +
     jaspGraphs::geom_rangeframe() +
     jaspGraphs::themeJaspRaw(legend.position = if (options[["tsneClusterPlotLegend"]]) "right" else "none") +
-    ggplot2::theme(axis.ticks = ggplot2::element_blank(), 
-                   axis.text.x = ggplot2::element_blank(), 
+    ggplot2::theme(axis.ticks = ggplot2::element_blank(),
+                   axis.text.x = ggplot2::element_blank(),
                    axis.text.y = ggplot2::element_blank())
   if (options[["tsneClusterPlotLabels"]]) {
     p <- p + ggrepel::geom_text_repel(ggplot2::aes(label = rownames(dataset), x = x, y = y), hjust = -1, vjust = 1, data = plotData, seed = 1)

diff --git a/R/commonMachineLearningRegression.R b/R/commonMachineLearningRegression.R
@@ -55,23 +55,23 @@
 }
 
 .readDataClassificationRegressionAnalyses <- function(dataset, options) {
-  target <- NULL
-  if (options[["target"]] != "") {
-    target <- options[["target"]]
-  }
-  predictors <- NULL
-  if (length(options[["predictors"]]) > 0) {
-    predictors <- unlist(options[["predictors"]])
-  }
+
   testSetIndicator <- NULL
-  if (options[["testSetIndicatorVariable"]] != "" && options[["holdoutData"]] == "testSetIndicator") {
-    testSetIndicator <- options[["testSetIndicatorVariable"]]
-  }
-  return(.readAndAddCompleteRowIndices(dataset, columns = c(target, predictors), columnsAsNumeric = testSetIndicator))
+  if (options[["testSetIndicatorVariable"]] != "" && options[["holdoutData"]] == "testSetIndicator")
+    testSetIndicator <- "testSetIndicatorVariable"
+
+  return(.readAndAddCompleteRowIndices(options, c("target", "predictors"), testSetIndicator))
 }
 
-.readAndAddCompleteRowIndices <- function(dataset, columns = NULL, columnsAsNumeric = NULL) {
-  dataset <- .readDataSetToEnd(columns = columns, columns.as.numeric = columnsAsNumeric)
+.readAndAddCompleteRowIndices <- function(options, optionNames = NULL, optionNamesAsNumeric = NULL) {
+
+  if (!is.null(optionNamesAsNumeric))
+    for (name in optionNamesAsNumeric) {
+      name2 <- paste(name, ".types")
+      if (is.null(options[[name]]))
+        options[[name2]] <- rep("scale", length(options[[name]]))
+    }
+  dataset <- jaspBase::readDataSetByVariableTypes(options, c(optionNames, optionNamesAsNumeric))
   complete.index <- which(complete.cases(dataset))
   dataset <- na.omit(dataset)
   rownames(dataset) <- as.character(complete.index)

diff --git a/R/mlRegressionRegularized.R b/R/mlRegressionRegularized.R
@@ -69,13 +69,13 @@ mlRegressionRegularized <- function(jaspResults, dataset, options, ...) {
   if (options[["weights"]] != "") {
     weights <- options[["weights"]]
   }
-  if (options[["testSetIndicatorVariable"]] != "" && options[["holdoutData"]] == "testSetIndicator") {
-    testSetIndicator <- options[["testSetIndicatorVariable"]]
-  }
+  if (options[["testSetIndicatorVariable"]] != "" && options[["holdoutData"]] == "testSetIndicator")
+    testSetIndicator <- "testSetIndicatorVariable"
+
   predictors <- unlist(options["predictors"])
   predictors <- predictors[predictors != ""]
   if (is.null(dataset)) {
-    dataset <- .readAndAddCompleteRowIndices(dataset, columns = predictors, columnsAsNumeric = c(target, weights, testSetIndicator))
+    dataset <- .readAndAddCompleteRowIndices(options, c("target", "predictors", "weights"), testSetIndicator)
   }
   if (length(unlist(options[["predictors"]])) > 0 && options[["scaleVariables"]]) {
     dataset[, options[["predictors"]]] <- .scaleNumericData(dataset[, options[["predictors"]], drop = FALSE])

diff --git a/tests/testthat/test-mlclassificationboosting.R b/tests/testthat/test-mlclassificationboosting.R
@@ -7,9 +7,11 @@ options$modelOptimization <- "manual"
 options$modelValid <- "validationManual"
 options$predictionsColumn <- ""
 options$predictors <- c("Sepal.Length", "Sepal.Width", "Petal.Length", "Petal.Width")
+options$predictors.types <- rep("scale", 4)
 options$savePath <- ""
 options$setSeed <- TRUE
 options$target <- "Species"
+options$target.types <- "nominal"
 options$testIndicatorColumn <- ""
 options$testSetIndicatorVariable <- ""
 options$dataSplitPlot <- FALSE
@@ -38,12 +40,14 @@ options$noOfFolds <- 5
 options$deviancePlot <- TRUE
 options$outOfBagImprovementPlot <- TRUE
 options$relativeInfluencePlot <- TRUE
-options$predictors <- list("Alcohol", "Malic", "Ash", "Alcalinity", "Magnesium", "Phenols", 
-                           "Flavanoids", "Nonflavanoids", "Proanthocyanins", "Color", 
+options$predictors <- list("Alcohol", "Malic", "Ash", "Alcalinity", "Magnesium", "Phenols",
+                           "Flavanoids", "Nonflavanoids", "Proanthocyanins", "Color",
                            "Hue", "Dilution", "Proline")
+options$predictors.types <- rep("scale", length(options$predictors))
 options$rocCurve <- TRUE
 options$setSeed <- TRUE
 options$target <- "Type"
+options$target.types <- "nominal"
 options$testDataManual <- 0.2
 options$testIndicatorColumn <- ""
 options$testSetIndicatorVariable <- ""

diff --git a/tests/testthat/test-mlclassificationdecisiontree.R b/tests/testthat/test-mlclassificationdecisiontree.R
@@ -7,9 +7,11 @@ options$modelOptimization <- "manual"
 options$modelValid <- "validationManual"
 options$predictionsColumn <- ""
 options$predictors <- c("Sepal.Length", "Sepal.Width", "Petal.Length", "Petal.Width")
+options$predictors.types <- rep("scale", 4)
 options$savePath <- ""
 options$setSeed <- TRUE
 options$target <- "Species"
+options$target.types <- "nominal"
 options$testIndicatorColumn <- ""
 options$testSetIndicatorVariable <- ""
 options$dataSplitPlot <- FALSE
@@ -33,11 +35,13 @@ options$noOfFolds <- 5
 options$decisionTreePlot <- TRUE
 options$predictionsColumn <- ""
 options$predictors <- c("Sepal.Length", "Sepal.Width", "Petal.Length", "Petal.Width")
+options$predictors.types <- rep("scale", 4)
 options$saveModel <- FALSE
 options$savePath <- ""
 options$setSeed <- TRUE
 options$featureImportanceTable <- TRUE
 options$target <- "Species"
+options$target.types <- "nominal"
 options$testDataManual <- 0.2
 options$testIndicatorColumn <- ""
 options$testSetIndicatorVariable <- ""

diff --git a/tests/testthat/test-mlclassificationknn.R b/tests/testthat/test-mlclassificationknn.R
@@ -7,9 +7,11 @@ options$modelOptimization <- "manual"
 options$modelValid <- "validationManual"
 options$predictionsColumn <- ""
 options$predictors <- c("Sepal.Length", "Sepal.Width", "Petal.Length", "Petal.Width")
+options$predictors.types <- rep("scale", 4)
 options$savePath <- ""
 options$setSeed <- TRUE
 options$target <- "Species"
+options$target.types <- "nominal"
 options$testIndicatorColumn <- ""
 options$testSetIndicatorVariable <- ""
 options$dataSplitPlot <- FALSE
@@ -36,12 +38,14 @@ options$modelValid <- "validationManual"
 options$noOfFolds <- 5
 options$errorVsKPlot <- TRUE
 options$weightsPlot <- TRUE
-options$predictors <- list("Alcohol", "Malic", "Ash", "Alcalinity", "Magnesium", "Phenols", 
-                           "Flavanoids", "Nonflavanoids", "Proanthocyanins", "Color", 
+options$predictors <- list("Alcohol", "Malic", "Ash", "Alcalinity", "Magnesium", "Phenols",
+                           "Flavanoids", "Nonflavanoids", "Proanthocyanins", "Color",
                            "Hue", "Dilution", "Proline")
+options$predictors.types <- rep("scale", length(options$predictors))
 options$rocCurve <- TRUE
 options$setSeed <- TRUE
 options$target <- "Type"
+options$target.types <- "nominal"
 options$testDataManual <- 0.2
 options$testIndicatorColumn <- ""
 options$testSetIndicatorVariable <- ""

diff --git a/tests/testthat/test-mlclassificationlda.R b/tests/testthat/test-mlclassificationlda.R
@@ -19,13 +19,15 @@ options$modelOptimization <- "manual"
 options$modelValid <- "validationManual"
 options$multicolTable <- TRUE
 options$noOfFolds <- 5
-options$predictors <- list("Alcohol", "Malic", "Ash", "Alcalinity", "Magnesium", "Phenols", 
-                           "Flavanoids", "Nonflavanoids", "Proanthocyanins", "Color", 
+options$predictors <- list("Alcohol", "Malic", "Ash", "Alcalinity", "Magnesium", "Phenols",
+                           "Flavanoids", "Nonflavanoids", "Proanthocyanins", "Color",
                            "Hue", "Dilution", "Proline")
+options$predictors.types <- rep("scale", length(options$predictors))
 options$priorTable <- TRUE
 options$rocCurve <- TRUE
 options$setSeed <- TRUE
 options$target <- "Type"
+options$target.types <- "nominal"
 options$testDataManual <- 0.2
 options$testIndicatorColumn <- ""
 options$testSetIndicatorVariable <- ""

diff --git a/tests/testthat/test-mlclassificationnaivebayes.R b/tests/testthat/test-mlclassificationnaivebayes.R
@@ -11,11 +11,13 @@ options$modelValid <- "validationManual"
 options$noOfFolds <- 5
 options$predictionsColumn <- ""
 options$predictors <- c("Sepal.Length", "Sepal.Width", "Petal.Length", "Petal.Width")
+options$predictors.types <- rep("scale", 4)
 options$saveModel <- FALSE
 options$savePath <- ""
 options$setSeed <- TRUE
 options$supportVectorsTable <- TRUE
 options$target <- "Species"
+options$target.types <- "nominal"
 options$testDataManual <- 0.2
 options$testIndicatorColumn <- ""
 options$testSetIndicatorVariable <- ""

diff --git a/tests/testthat/test-mlclassificationneuralnetwork.R b/tests/testthat/test-mlclassificationneuralnetwork.R
@@ -14,10 +14,12 @@ options$modelOptimization <- "manual"
 options$modelValid <- "validationManual"
 options$predictionsColumn <- ""
 options$predictors <- c("Sepal.Length", "Sepal.Width", "Petal.Length", "Petal.Width")
+options$predictors.types <- rep("scale", 4)
 options$saveModel <- FALSE
 options$savePath <- ""
 options$setSeed <- TRUE
 options$target <- "Species"
+options$target.types <- "nominal"
 options$testDataManual <- 0.2
 options$testIndicatorColumn <- ""
 options$testSetIndicatorVariable <- ""

diff --git a/tests/testthat/test-mlclassificationrandomforest.R b/tests/testthat/test-mlclassificationrandomforest.R
@@ -7,9 +7,11 @@ options$modelOptimization <- "manual"
 options$modelValid <- "validationManual"
 options$predictionsColumn <- ""
 options$predictors <- c("Sepal.Length", "Sepal.Width", "Petal.Length", "Petal.Width")
+options$predictors.types <- rep("scale", 4)
 options$savePath <- ""
 options$setSeed <- TRUE
 options$target <- "Species"
+options$target.types <- "nominal"
 options$testIndicatorColumn <- ""
 options$testSetIndicatorVariable <- ""
 options$dataSplitPlot <- FALSE
@@ -37,13 +39,15 @@ options$noOfFolds <- 5
 options$accuracyDecreasePlot <- TRUE
 options$purityIncreasePlot <- TRUE
 options$treesVsModelErrorPlot <- TRUE
-options$predictors <- list("Alcohol", "Malic", "Ash", "Alcalinity", "Magnesium", "Phenols", 
-                           "Flavanoids", "Nonflavanoids", "Proanthocyanins", "Color", 
+options$predictors <- list("Alcohol", "Malic", "Ash", "Alcalinity", "Magnesium", "Phenols",
+                           "Flavanoids", "Nonflavanoids", "Proanthocyanins", "Color",
                            "Hue", "Dilution", "Proline")
+options$predictors.types <- rep("scale", length(options$predictors))
 options$rocCurve <- TRUE
 options$setSeed <- TRUE
 options$featureImportanceTable <- TRUE
 options$target <- "Type"
+options$target.types <- "scale"
 options$testDataManual <- 0.2
 options$testIndicatorColumn <- ""
 options$testSetIndicatorVariable <- ""

diff --git a/tests/testthat/test-mlclassificationsvm.R b/tests/testthat/test-mlclassificationsvm.R
@@ -7,9 +7,11 @@ options$modelOptimization <- "manual"
 options$modelValid <- "validationManual"
 options$predictionsColumn <- ""
 options$predictors <- c("Sepal.Length", "Sepal.Width", "Petal.Length", "Petal.Width")
+options$predictors.types <- rep("scale", 4)
 options$savePath <- ""
 options$setSeed <- TRUE
 options$target <- "Species"
+options$target.types <- "nominal"
 options$testIndicatorColumn <- ""
 options$testSetIndicatorVariable <- ""
 options$dataSplitPlot <- FALSE
@@ -32,11 +34,13 @@ options$modelValid <- "validationManual"
 options$noOfFolds <- 5
 options$predictionsColumn <- ""
 options$predictors <- c("Sepal.Length", "Sepal.Width", "Petal.Length", "Petal.Width")
+options$predictors.types <- rep("scale", 4)
 options$saveModel <- FALSE
 options$savePath <- ""
 options$setSeed <- TRUE
 options$supportVectorsTable <- TRUE
 options$target <- "Species"
+options$target.types <- "nominal"
 options$testDataManual <- 0.2
 options$testIndicatorColumn <- ""
 options$testSetIndicatorVariable <- ""

diff --git a/tests/testthat/test-mlclusteringdensitybased.R b/tests/testthat/test-mlclusteringdensitybased.R
@@ -9,9 +9,10 @@ options$distance <- "normalDensities"
 options[["kDistancePlot"]] <- TRUE
 options$modelOptimization <- "manual"
 options$tsneClusterPlot <- TRUE
-options$predictors <- list("Alcohol", "Malic", "Ash", "Alcalinity", "Magnesium", "Phenols", 
-                           "Flavanoids", "Nonflavanoids", "Proanthocyanins", "Color", 
+options$predictors <- list("Alcohol", "Malic", "Ash", "Alcalinity", "Magnesium", "Phenols",
+                           "Flavanoids", "Nonflavanoids", "Proanthocyanins", "Color",
                            "Hue", "Dilution", "Proline")
+options$predictors.types <- rep("scale", length(options$predictors))
 options$setSeed <- TRUE
 options$tableClusterInformationBetweenSumOfSquares <- TRUE
 options$tableClusterInformationSilhouetteScore <- TRUE

diff --git a/tests/testthat/test-mlclusteringfuzzycmeans.R b/tests/testthat/test-mlclusteringfuzzycmeans.R
@@ -3,6 +3,7 @@ context("Machine Learning Fuzzy C-Means Clustering")
 # Test fixed model #############################################################
 options <- initMlOptions("mlClusteringFuzzyCMeans")
 options$predictors <- list("Sepal.Length", "Sepal.Width", "Petal.Length", "Petal.Width")
+options$predictors.types <- rep("scale", length(options$predictors))
 options$modelOptimization <- "manual"
 options$predictionsColumn <- ""
 options$setSeed <- TRUE
@@ -21,9 +22,10 @@ options$predictionsColumn <- ""
 options$validationMeasures <- TRUE
 options$modelOptimization <- "optimized"
 options$tsneClusterPlot <- TRUE
-options$predictors <- list("Alcohol", "Malic", "Ash", "Alcalinity", "Magnesium", "Phenols", 
-                           "Flavanoids", "Nonflavanoids", "Proanthocyanins", "Color", 
+options$predictors <- list("Alcohol", "Malic", "Ash", "Alcalinity", "Magnesium", "Phenols",
+                           "Flavanoids", "Nonflavanoids", "Proanthocyanins", "Color",
                            "Hue", "Dilution", "Proline")
+options$predictors.types <- rep("scale", length(options$predictors))
 options$setSeed <- TRUE
 options$tableClusterInformationBetweenSumOfSquares <- TRUE
 options$tableClusterInformationCentroids <- TRUE

diff --git a/tests/testthat/test-mlclusteringhierarchical.R b/tests/testthat/test-mlclusteringhierarchical.R
@@ -3,6 +3,7 @@ context("Machine Learning Hierarchical Clustering")
 # Test fixed model #############################################################
 options <- initMlOptions("mlClusteringHierarchical")
 options$predictors <- list("Sepal.Length", "Sepal.Width", "Petal.Length", "Petal.Width")
+options$predictors.types <- rep("scale", length(options$predictors))
 options$modelOptimization <- "manual"
 options$predictionsColumn <- ""
 options$setSeed <- TRUE
@@ -22,9 +23,10 @@ options$validationMeasures <- TRUE
 options$dendrogram <- TRUE
 options$modelOptimization <- "optimized"
 options$tsneClusterPlot <- TRUE
-options$predictors <- list("Alcohol", "Malic", "Ash", "Alcalinity", "Magnesium", "Phenols", 
-                           "Flavanoids", "Nonflavanoids", "Proanthocyanins", "Color", 
+options$predictors <- list("Alcohol", "Malic", "Ash", "Alcalinity", "Magnesium", "Phenols",
+                           "Flavanoids", "Nonflavanoids", "Proanthocyanins", "Color",
                            "Hue", "Dilution", "Proline")
+options$predictors.types <- rep("scale", length(options$predictors))
 options$setSeed <- TRUE
 options$tableClusterInformationBetweenSumOfSquares <- TRUE
 options$tableClusterInformationSilhouetteScore <- TRUE
@@ -98,6 +100,7 @@ options$validationMeasures <- TRUE
 options$linkage <- "wardD"
 options$modelOptimization <- "optimized"
 options$predictors <- c("Alcohol", "Malic", "Ash", "Alcalinity", "Magnesium", "Phenols", "Flavanoids", "Nonflavanoids", "Proanthocyanins", "Color", "Hue", "Dilution", "Proline")
+options$predictors.types <- rep("scale", length(options$predictors))
 options$setSeed <- TRUE
 options$tableClusterMeans <- TRUE
 set.seed(1)
@@ -163,6 +166,7 @@ options$validationMeasures <- TRUE
 options$linkage <- "wardD"
 options$modelOptimization <- "optimized"
 options$predictors <- c("Alcohol", "Malic", "Ash", "Alcalinity", "Magnesium", "Phenols", "Flavanoids", "Nonflavanoids", "Proanthocyanins", "Color", "Hue", "Dilution", "Proline")
+options$predictors.types <- rep("scale", length(options$predictors))
 options$setSeed <- TRUE
 options$tableClusterMeans <- TRUE
 set.seed(1)
@@ -228,6 +232,7 @@ options$validationMeasures <- TRUE
 options$linkage <- "median"
 options$modelOptimization <- "optimized"
 options$predictors <- c("Alcohol", "Malic", "Ash", "Alcalinity", "Magnesium", "Phenols", "Flavanoids", "Nonflavanoids", "Proanthocyanins", "Color", "Hue", "Dilution", "Proline")
+options$predictors.types <- rep("scale", length(options$predictors))
 options$setSeed <- TRUE
 options$tableClusterMeans <- TRUE
 set.seed(1)
@@ -277,6 +282,7 @@ options$validationMeasures <- TRUE
 options$linkage <- "mcquitty"
 options$modelOptimization <- "optimized"
 options$predictors <- c("Alcohol", "Malic", "Ash", "Alcalinity", "Magnesium", "Phenols", "Flavanoids", "Nonflavanoids", "Proanthocyanins", "Color", "Hue", "Dilution", "Proline")
+options$predictors.types <- rep("scale", length(options$predictors))
 options$setSeed <- TRUE
 options$tableClusterMeans <- TRUE
 set.seed(1)

diff --git a/tests/testthat/test-mlclusteringkmeans.R b/tests/testthat/test-mlclusteringkmeans.R
@@ -3,6 +3,7 @@ context("Machine Learning K-Means Clustering")
 # Test fixed model #############################################################
 options <- initMlOptions("mlClusteringKMeans")
 options$predictors <- list("Sepal.Length", "Sepal.Width", "Petal.Length", "Petal.Width")
+options$predictors.types <- rep("scale", length(options$predictors))
 options$modelOptimization <- "manual"
 options$predictionsColumn <- ""
 options$setSeed <- TRUE
@@ -17,9 +18,10 @@ jaspTools::expect_equal_tables(table,
 
 # Test optimized model #########################################################
 options <- initMlOptions("mlClusteringKMeans")
-options$predictors <- list("Alcohol", "Malic", "Ash", "Alcalinity", "Magnesium", "Phenols", 
-    "Flavanoids", "Nonflavanoids", "Proanthocyanins", "Color", 
+options$predictors <- list("Alcohol", "Malic", "Ash", "Alcalinity", "Magnesium", "Phenols",
+    "Flavanoids", "Nonflavanoids", "Proanthocyanins", "Color",
     "Hue", "Dilution", "Proline")
+options$predictors.types <- rep("scale", length(options$predictors))
 options$tableClusterInformationSilhouetteScore <- TRUE
 options$tableClusterInformationCentroids <- TRUE
 options$tableClusterInformationBetweenSumOfSquares <- TRUE
@@ -102,9 +104,10 @@ test_that("t-SNE Cluster Plot matches", {
 context("Machine Learning K-Medians Clustering")
 
 options <- initMlOptions("mlClusteringKMeans")
-options$predictors <- list("Alcohol", "Malic", "Ash", "Alcalinity", "Magnesium", "Phenols", 
-    "Flavanoids", "Nonflavanoids", "Proanthocyanins", "Color", 
+options$predictors <- list("Alcohol", "Malic", "Ash", "Alcalinity", "Magnesium", "Phenols",
+    "Flavanoids", "Nonflavanoids", "Proanthocyanins", "Color",
     "Hue", "Dilution", "Proline")
+options$predictors.types <- rep("scale", length(options$predictors))
 options$tableClusterInformationSilhouetteScore <- TRUE
 options$tableClusterInformationCentroids <- TRUE
 options$tableClusterInformationBetweenSumOfSquares <- TRUE
@@ -183,9 +186,10 @@ test_that("Elbow Method Plot matches", {
 context("Machine Learning K-Medoids Clustering")
 
 options <- initMlOptions("mlClusteringKMeans")
-options$predictors <- list("Alcohol", "Malic", "Ash", "Alcalinity", "Magnesium", "Phenols", 
-    "Flavanoids", "Nonflavanoids", "Proanthocyanins", "Color", 
+options$predictors <- list("Alcohol", "Malic", "Ash", "Alcalinity", "Magnesium", "Phenols",
+    "Flavanoids", "Nonflavanoids", "Proanthocyanins", "Color",
     "Hue", "Dilution", "Proline")
+options$predictors.types <- rep("scale", length(options$predictors))
 options$tableClusterInformationSilhouetteScore <- TRUE
 options$tableClusterInformationCentroids <- TRUE
 options$tableClusterInformationBetweenSumOfSquares <- TRUE