Make roc plot work

Author: koenderks

R/commonMachineLearningClassification.R

@@ -721,6 +721,9 @@
     } else if (type == "naivebayes") {
       fit <- e1071::naiveBayes(formula = formula, data = typeData, laplace = options[["smoothingParameter"]])
       score <- max.col(predict(fit, test, type = "raw"))
+    } else if (type == "logistic") {
+      fit <- glm(formula, data = typeData, family = "binomial")
+      score <- round(predict(fit, test, type = "response"), 0)
     }
     pred <- ROCR::prediction(score, actual.class)
     nbperf <- ROCR::performance(pred, "tpr", "fpr")
@@ -1144,18 +1147,3 @@
   score <- round(predict(fit, test, type = "response"), 0)
   return(score)
 }
-
-.calcAUCScore.multinomialClassification <- function(AUCformula, test, typeData, options, jaspResults, ...) {
-  fit <- VGAM::vglm(AUCformula, data = typeData, family = "multinomial")
-  logodds <- as.data.frame(predict(fit, test))
-  ncategories <- ncol(logodds) + 1
-  probabilities <- matrix(0, nrow = nrow(logodds), ncol = ncategories)
-  for (i in seq_len(ncategories - 1)) {
-    probabilities[, i] <- exp(logodds[, i])
-  }
-  probabilities[, ncategories] <- 1
-  row_sums <- rowSums(probabilities)
-  probabilities <- probabilities / row_sums
-  score <- apply(probabilities, 1, which.max)
-  return(score)
-}

R/mlClassificationLogisticMultinomial.R

@@ -53,8 +53,8 @@ mlClassificationLogisticMultinomial <- function(jaspResults, dataset, options, .
 
   .mlClassificationLogisticTableCoef(options, jaspResults, ready, position = 8)
 
-#   # Create the ROC curve
-#   .mlClassificationPlotRoc(dataset, options, jaspResults, ready, position = 10, type = "logistic") # position + 1 for regression equation
+  # Create the ROC curve
+  .mlClassificationPlotRoc(dataset, options, jaspResults, ready, position = 10, type = "logistic") # position + 1 for regression equation
 
   # Create the Andrews curves
   .mlClassificationPlotAndrews(dataset, options, jaspResults, ready, position = 11)
@@ -106,7 +106,7 @@ mlClassificationLogisticMultinomial <- function(jaspResults, dataset, options, .
   result[["model"]] <- trainingFit
   result[["confTable"]] <- table("Pred" = testPredictions, "Real" = testSet[, options[["target"]]])
   result[["testAcc"]] <- sum(diag(prop.table(result[["confTable"]])))
-  result[["auc"]] <- .classificationCalcAUC(testSet, trainingSet, options, if (family == "binomial") "logisticClassification" else "multinomialClassification")
+  result[["auc"]] <- .classificationCalcAUC(testSet, trainingSet, options, "logisticClassification")
   result[["ntrain"]] <- nrow(trainingSet)
   result[["ntest"]] <- nrow(testSet)
   result[["testReal"]] <- testSet[, options[["target"]]]

tests/testthat/_snaps/mlclassificationlogisticmultinomial/data-split.svg

@@ -36,7 +36,7 @@ test_that("Class Proportions table results match", {
 			 "virginica", 0.4, 0.316666666666667))
 })
 
-test_that("Model Summary: Logistic / Multinomial Regression table results match", {
+test_that("Model Summary: Multinomial Regression Classification table results match", {
 	table <- results[["results"]][["classificationTable"]][["data"]]
 	jaspTools::expect_equal_tables(table,
 		list("multinomial", 30, 120, 1))
@@ -58,9 +58,10 @@ test_that("Data Split plot matches", {
 test_that("Model Performance Metrics table results match", {
 	table <- results[["results"]][["validationMeasures"]][["data"]]
 	jaspTools::expect_equal_tables(table,
-		list(1, "", 1, 0, 0, 0, 0, "setosa", 1, 1, 1, 1, 0.333333333333333,
-			 10, 1, "<unicode>", 1, 1, 0, 0, 0, 0, "versicolor", 1, 1, 1,
-			 1, 0.266666666666667, 8, 1, "<unicode>", 1, 1, 0, 0, 0, 0, "virginica",
-			 1, 1, 1, 1, 0.4, 12, 1, "<unicode>", 1, 1, 0, 0, 0, 0, "Average / Total",
-			 1, 1, 1, 1, 1, 30, 1, "<unicode>"))
+		list(1, 1, 1, 0, 0, 0, 0, "setosa", 1, 1, 1, 1, 0.333333333333333,
+			 10, 1, "<unicode>", 1, 0.613636363636364, 1, 0, 0, 0, 0, "versicolor",
+			 1, 1, 1, 1, 0.266666666666667, 8, 1, "<unicode>", 1, 1, 1, 0,
+			 0, 0, 0, "virginica", 1, 1, 1, 1, 0.4, 12, 1, "<unicode>", 1,
+			 0.871212121212121, 1, 0, 0, 0, 0, "Average / Total", 1, 1, 1,
+			 1, 1, 30, 1, "<unicode>"))
 })