Support different link functions

Author: koenderks

R/commonMachineLearningClassification.R

@@ -33,7 +33,7 @@
     "noOfTrees", "maxTrees", "baggingFraction", "noOfPredictors", "numberOfPredictors",   # Random forest
     "complexityParameter", "degree", "gamma", "cost", "tolerance", "epsilon", "maxCost",  # Support vector machine
     "smoothingParameter",                                                                 # Naive Bayes
-    "intercept"                                                                           # Logistic
+    "intercept", "link"                                                                   # Logistic
   )
   if (includeSaveOptions) {
     opt <- c(opt, "saveModel", "savePath")
@@ -588,7 +588,7 @@
     levels(predictions) <- unique(dataset[, options[["target"]]])
   } else if (type == "logistic") {
     if (classificationResult[["family"]] == "binomial") {
-      fit <- glm(formula, data = dataset, family = stats::binomial(link = "logit"))
+      fit <- stats::glm(formula, data = dataset, family = stats::binomial(link = options[["link"]]))
       predictions <- as.factor(round(predict(fit, grid, type = "response"), 0))
       levels(predictions) <- unique(dataset[, options[["target"]]])
     } else {
@@ -746,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 = stats::binomial(link = "logit"))
+      fit <- stats::glm(formula, data = typeData, family = stats::binomial(link = options[["link"]]))
       score <- round(predict(fit, test, type = "response"), 0)
     }
     pred <- ROCR::prediction(score, actual.class)
@@ -1167,7 +1167,7 @@
 }
 
 .calcAUCScore.logisticClassification <- function(AUCformula, test, typeData, options, jaspResults, ...) {
-  fit <- glm(AUCformula, data = typeData, family = stats::binomial(link = "logit"))
+  fit <- stats::glm(AUCformula, data = typeData, family = stats::binomial(link = options[["link"]]))
   score <- round(predict(fit, test, type = "response"), 0)
   return(score)
 }

R/mlClassificationLogisticMultinomial.R

@@ -88,18 +88,18 @@ mlClassificationLogisticMultinomial <- function(jaspResults, dataset, options, .
   }
   if (nlevels(trainingSet[[options[["target"]]]]) == 2) {
     family = "binomial"
-    linkFunction <- "logit"
-    trainingFit <- glm(formula, data = trainingSet, family = stats::binomial(link = linkFunction))
+    linkFunction <- options[["link"]]
+    trainingFit <- stats::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"))
+    testPredictions <- .mlClassificationLogisticPredictions(trainingSet, options, stats::predict(trainingFit, newdata = testSet, type = "response"))
+    dataPredictions <- .mlClassificationLogisticPredictions(trainingSet, options, stats::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))
-    dataPredictions <- .mlClassificationMultinomialPredictions(trainingSet, options, predict(trainingFit, newdata = dataset))
+    testPredictions <- .mlClassificationMultinomialPredictions(trainingSet, options, VGAM::predict(trainingFit, newdata = testSet))
+    dataPredictions <- .mlClassificationMultinomialPredictions(trainingSet, options, VGAM::predict(trainingFit, newdata = dataset))
   }
   # Create results object
   result <- list()
@@ -108,6 +108,7 @@ mlClassificationLogisticMultinomial <- function(jaspResults, dataset, options, .
   result[["link"]] <- linkFunction
   if (family == "binomial") {
     result[["model"]] <- trainingFit
+    result[["model"]]$link <- result[["link"]]
   } else {
     model <- lapply(slotNames(trainingFit), function(x) slot(trainingFit, x))
     names(model) <- slotNames(trainingFit)
@@ -211,14 +212,14 @@ mlClassificationLogisticMultinomial <- function(jaspResults, dataset, options, .
     table[["lower"]] <- coefs[, "lower"]
     table[["upper"]] <- coefs[, "upper"]
   }
-  if (options[["formula"]]) { # TODO FOR MULTINOMIAL
+  if (options[["formula"]]) {
     if (classificationResult[["family"]] == "binomial") {
       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))
+        regform <- paste0(options[["link"]], "(p<sub>", options[["target"]], " = ", one_cat, "</sub>) = ", round(as.numeric(coefs[, 1])[1], 3))
         start <- 2
       } else {
-        regform <- paste0("logit(p<sub>", options[["target"]], " = ", one_cat, "</sub>) = ")
+        regform <- paste0(options[["link"]], "(p<sub>", options[["target"]], " = ", one_cat, "</sub>) = ")
         start <- 1
       }
       for (i in start:nrow(coefs)) {

R/mlPrediction.R

@@ -388,7 +388,7 @@ is.jaspMachineLearning <- function(x) {
     row[["lambda"]] <- model[["lambda.min"]]
   } else if (inherits(model, "glm")) {
     row[["family"]] <- gettext("Binomial")
-    row[["link"]] <- gettext("Logit")
+    row[["link"]] <- paste0(toupper(substr(model[["link"]], 1, 1)), substr(model[["link"]], 2, nchar(model[["link"]])))
   } else if (inherits(model, "vglm")) {
     row[["family"]] <- gettext("Multinomial")
     row[["link"]] <- gettext("Logit")

inst/qml/mlClassificationLogisticMultinomial.qml

@@ -65,6 +65,20 @@ Form
 		{
 			title: qsTr("Algorithmic Settings")
 
+			DropDown
+			{
+				name:							"link"
+				indexDefaultValue:				0
+				label:							qsTr("Link function (for binary classification)")
+				values:
+					[
+					{ label: qsTr("Logit"),		value: "logit"},
+					{ label: qsTr("Probit"),	value: "probit"},
+					{ label: qsTr("Cauchit"),	value: "cauchit"},
+					{ label: qsTr("C log-log"),	value: "cloglog"},
+					{ label: qsTr("Log"),		value: "log"}
+				]
+			}
 			REGU.Intercept { }
 			UI.ScaleVariables { }
 			UI.SetSeed { }