Update

Author: koenderks

R/commonMachineLearningClassification.R

@@ -152,6 +152,7 @@
     table$addColumnInfo(name = "smoothing", title = gettext("Smoothing"), type = "number")
   } else if (type == "logistic") {
     table$addColumnInfo(name = "family", title = gettext("Family"), type = "string")
+    table$addColumnInfo(name = "link", title = gettext("Link"), type = "string")
   }
   # Add common columns
   table$addColumnInfo(name = "nTrain", title = gettext("n(Train)"), type = "integer")
@@ -324,8 +325,10 @@
       table$title <- gettext("Model Summary: Multinomial Regression Classification")
     }
     family <- classificationResult[["family"]]
+    link <- classificationResult[["link"]]
     row <- data.frame(
       family = paste0(toupper(substr(family, 1, 1)), substr(family, 2, nchar(family))),
+      link = paste0(toupper(substr(link, 1, 1)), substr(link, 2, nchar(link))),
       nTrain = nTrain,
       nTest = classificationResult[["ntest"]],
       testAcc = classificationResult[["testAcc"]]
@@ -585,11 +588,11 @@
     levels(predictions) <- unique(dataset[, options[["target"]]])
   } else if (type == "logistic") {
     if (classificationResult[["family"]] == "binomial") {
-      fit <- glm(formula, data = dataset, family = "binomial")
+      fit <- glm(formula, data = dataset, family = stats::binomial(link = "logit"))
       predictions <- as.factor(round(predict(fit, grid, type = "response"), 0))
       levels(predictions) <- unique(dataset[, options[["target"]]])
     } else {
-      fit <- VGAM::vglm(formula, data = dataset, family = "multinomial")
+      fit <- VGAM::vglm(formula, data = dataset, family = VGAM::multinomial())
       logodds <- predict(fit, newdata = grid)
       ncategories <- ncol(logodds) + 1
       probabilities <- matrix(0, nrow = nrow(logodds), ncol = ncategories)
@@ -743,7 +746,7 @@
       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")
+      fit <- glm(formula, data = typeData, family = stats::binomial(link = "logit"))
       score <- round(predict(fit, test, type = "response"), 0)
     }
     pred <- ROCR::prediction(score, actual.class)
@@ -1164,7 +1167,7 @@
 }
 
 .calcAUCScore.logisticClassification <- function(AUCformula, test, typeData, options, jaspResults, ...) {
-  fit <- glm(AUCformula, data = typeData, family = "binomial")
+  fit <- glm(AUCformula, data = typeData, family = stats::binomial(link = "logit"))
   score <- round(predict(fit, test, type = "response"), 0)
   return(score)
 }

R/mlClassificationLogisticMultinomial.R

@@ -88,12 +88,14 @@ mlClassificationLogisticMultinomial <- function(jaspResults, dataset, options, .
   }
   if (nlevels(trainingSet[[options[["target"]]]]) == 2) {
     family = "binomial"
-    trainingFit <- glm(formula, data = trainingSet, family = stats::binomial(link = "logit"))
+    linkFunction <- "logit"
+    trainingFit <- glm(formula, data = trainingSet, family = stats::binomial(link = linkFunction))
     # Use the specified model to make predictions for dataset
     testPredictions <- .mlClassificationLogisticPredictions(trainingSet, options, predict(trainingFit, newdata = testSet, type = "response"))
     dataPredictions <- .mlClassificationLogisticPredictions(trainingSet, options, predict(trainingFit, newdata = dataset, type = "response"))
   } else {
     family <- "multinomial"
+    linkFunction <- "logit"
     trainingFit <- VGAM::vglm(formula, data = trainingSet, family = VGAM::multinomial())
     # Use the specified model to make predictions for dataset
     testPredictions <- .mlClassificationMultinomialPredictions(trainingSet, options, predict(trainingFit, newdata = testSet))
@@ -103,6 +105,7 @@ mlClassificationLogisticMultinomial <- function(jaspResults, dataset, options, .
   result <- list()
   result[["formula"]] <- formula
   result[["family"]] <- family
+  result[["link"]] <- linkFunction
   if (family == "binomial") {
     result[["model"]] <- trainingFit
   } else {

R/mlPrediction.R

@@ -365,6 +365,9 @@ is.jaspMachineLearning <- function(x) {
     table$addColumnInfo(name = "mtry", title = gettext("Features per split"), type = "integer")
   } else if (inherits(model, "cv.glmnet")) {
     table$addColumnInfo(name = "lambda", title = "\u03BB", type = "number")
+  } else if (inherits(model, "glm") || inherits(model, "vglm")) {
+    table$addColumnInfo(name = "family", title = gettext("Family"), type = "string")
+    table$addColumnInfo(name = "link", title = gettext("Link"), type = "string")
   }
   table$addColumnInfo(name = "ntrain", title = gettext("n(Train)"), type = "integer")
   table$addColumnInfo(name = "nnew", title = gettext("n(New)"), type = "integer")
@@ -383,6 +386,12 @@ is.jaspMachineLearning <- function(x) {
     row[["mtry"]] <- model[["mtry"]]
   } else if (inherits(model, "cv.glmnet")) {
     row[["lambda"]] <- model[["lambda.min"]]
+  } else if (inherits(model, "glm")) {
+    row[["family"]] <- gettext("Binomial")
+    row[["link"]] <- gettext("Logit")
+  } else if (inherits(model, "vglm")) {
+    row[["family"]] <- gettext("Multinomial")
+    row[["link"]] <- gettext("Logit")
   }
   if (length(presentVars) > 0) {
     row[["nnew"]] <- nrow(dataset)

tests/testthat/test-mlclassificationlogisticmultinomial.R

@@ -39,7 +39,7 @@ test_that("Class Proportions 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))
+		list("Multinomial", "Logit", 30, 120, 1))
 })
 
 test_that("Confusion Matrix table results match", {