Update

jasp-stats · Jan 25, 2024 · 3812c72 · 3812c72
1 parent 0218c5f
commit 3812c72
Show file tree

Hide file tree

Showing 2 changed files with 28 additions and 12 deletions.
diff --git a/R/commonMachineLearningAnomalyDetection.R b/R/commonMachineLearningAnomalyDetection.R
@@ -70,6 +70,9 @@
     table$addColumnInfo(name = "npred", title = gettext("Features per split"), type = "integer")
   } else if (type == "svm") {
     table$addColumnInfo(name = "svec", title = gettext("Support vectors"), type = "integer")
+  } else if (type == "outliertree") {
+	table$addColumnInfo(name = "ntrees", title = gettext("Trees"), type = "integer")
+	table$addColumnInfo(name = "nclusters", title = gettext("Clusters"), type = "integer")
   }
   table$addColumnInfo(name = "N", title = "N", type = "integer")
   table$addColumnInfo(name = "n", title = gettext("Anomalies"), type = "integer")
@@ -89,11 +92,10 @@
     table$addFootnote(gettext("The features in the model are <b>unstandardized</b>."))
   }
   row <- data.frame(N = anomalyResult[["N"]], n = anomalyResult[["noutlier"]])
-  if (type == "isoforest") {
-    row <- cbind(row, ntrees = options[["nTrees"]], npred = options[["numberOfPredictors"]])
-  } else if (type == "svm") {
-	row <- cbind(row, svec = nrow(anomalyResult[["model"]]$SV))
-  }
+  row <- switch(type,
+  "isoforest" = cbind(row, ntrees = options[["nTrees"]], npred = options[["numberOfPredictors"]]),
+  "svm" = cbind(row, svec = nrow(anomalyResult[["model"]]$SV)),
+  "outliertree" = cbind(row, ntrees = anomalyResult[["ntrees"]], nclusters = anomalyResult[["nclusters"]]))
   table$addRows(row)
 }
 
@@ -123,10 +125,12 @@
   table$dependOn(options = c("tableAnomalyScores", "tableAnomalyScoresFeatures", .mlAnomalyDependencies(options)))
   table$position <- position
   table$addColumnInfo(name = "row", title = gettext("Case"), type = "integer")
-  table$addColumnInfo(name = "pred", title = gettext("Predicted"), type = "string")
   if (type == "isoforest") {
     table$addColumnInfo(name = "score", title = gettext("Score"), type = "number")
-  }
+  } else if (type == "outliertree") {
+	table$addColumnInfo(name = "depth", title = gettext("Tree depth"), type = "integer")
+	table$addColumnInfo(name = "value", title = gettext("Suspicous feature"), type = "string")
+	}
   if (options[["tableAnomalyScoresFeatures"]]) {
     types <- ifelse(unlist(lapply(dataset[, options[["predictors"]]], is.factor)), yes = "string", no = "number")
     for (i in seq_len(ncol(dataset[, options[["predictors"]], drop = FALSE]))) {
@@ -139,11 +143,16 @@
   }
   anomalyResult <- jaspResults[["anomalyResult"]]$object
   indexes <- anomalyResult[["ioutlier"]]
+  indexes <- switch(type, "outliertree" = indexes[order(anomalyResult[["depth"]][indexes])],
+                          "isoforest" = indexes[order(-anomalyResult[["values"]][indexes])],
+						  "svm" = indexes[order(anomalyResult[["values"]][indexes])])
   table[["row"]] <- indexes
-  table[["pred"]] <- as.character(anomalyResult[["classes"]][indexes])
   if (type == "isoforest") {
     table[["score"]] <- anomalyResult[["values"]][indexes]
-  }
+  } else if (type == "outliertree") {
+	table[["depth"]] <- anomalyResult[["depth"]][indexes]
+	table[["value"]] <- anomalyResult[["susp"]][indexes]
+	}
   if (options[["tableAnomalyScoresFeatures"]]) {
     for (i in seq_len(ncol(dataset))) {
       table[[options[["predictors"]][i]]] <- switch(types[i],

diff --git a/R/mlAnomalyOutlierTree.R b/R/mlAnomalyOutlierTree.R
@@ -40,9 +40,16 @@ mlAnomalyOutlierTree <- function(jaspResults, dataset, options, ...) {
   result <- list()
   result[["model"]] <- outliertree::outlier.tree(dataset[, options[["predictors"]]], save_outliers = TRUE, nthreads = 1,
                                    max_depth = options[["maxDepth"]], min_gain = options[["complexityParameter"]])
-  result[["values"]] <- as.numeric(unlist(as.numeric(lapply(result[["model"]][["outliers_data"]], `[[`, "outlier_score"))))
-  result[["values"]] <- ifelse(is.na(result[["values"]]), yes = 0, no = 1)
-  result[["outlier"]] <- as.logical(result[["values"]])
+  out <- outliertree:::list.to.outliers((result[["model"]]$outliers_data))
+  result[["values"]] <- as.numeric(ifelse(is.na(out[["outlier_score"]]), yes = 0, no = out[["outlier_score"]]))
+  result[["depth"]] <- as.numeric(ifelse(is.na(out[["outlier_score"]]), yes = 0, no = out[["tree_depth"]]))
+  result[["ntrees"]] <- result[["model"]]$obj_from_cpp$ntrees
+  result[["nclusters"]] <- result[["model"]]$obj_from_cpp$nclust
+  result[["susp"]] <- character(length(result[["depth"]]))
+  for (i in seq_along(result[["depth"]])) {
+	result[["susp"]][i] <- if (is.null(out$suspicous_value[[i]]$column)) "" else out$suspicous_value[[i]]$column
+  }
+  result[["outlier"]] <- as.logical(result[["values"]] != 0)
   result[["classes"]] <- as.factor(ifelse(result[["outlier"]], yes = gettext("Anomaly"), no = gettext("Standard")))
   result[["noutlier"]] <- sum(result[["outlier"]])
   result[["ioutlier"]] <- which(result[["outlier"]])