Make AUC work

Author: koenderks

R/commonMachineLearningClassification.R

@@ -1138,3 +1138,24 @@
   score <- max.col(predict(fit, test, type = "raw"))
   return(score)
 }
+
+.calcAUCScore.logisticClassification <- function(AUCformula, test, typeData, options, jaspResults, ...) {
+  fit <- glm(AUCformula, data = typeData, family = "binomial")
+  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

@@ -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, "logisticClassification")
+  result[["auc"]] <- .classificationCalcAUC(testSet, trainingSet, options, if (family == "binomial") "logisticClassification" else "multinomialClassification")
   result[["ntrain"]] <- nrow(trainingSet)
   result[["ntest"]] <- nrow(testSet)
   result[["testReal"]] <- testSet[, options[["target"]]]
@@ -207,7 +207,7 @@ mlClassificationLogisticMultinomial <- function(jaspResults, dataset, options, .
     table[["lower"]] <- coefs[, "lower"]
     table[["upper"]] <- coefs[, "upper"]
   }
-  if (options[["formula"]]) {
+  if (options[["formula"]]) { # TODO FOR MULTINOMIAL
     one_cat <- levels(factor(classificationResult[["train"]][[options[["target"]]]]))[2]
     if (options[["intercept"]]) {
       regform <- paste0("logit(p<sub>", options[["target"]], " = ", one_cat, "</sub>) = ", round(as.numeric(coefs[, 1])[1], 3))