Método no supervisado para detectar anomalías en datos no etiquetados, donde no se conoce la clasificación de anomalía. La selección de los punto de división de cada rama se gace en forma aleatoria. Aquellas observaciones con características distintas al resto, quedarán aisladas a las pocas divisiones, por lo que el número de nodos necesarios para llegar a estas observación desde el inicio del árbol (profundidad) es menor que para el resto.
Crear un nodo raíz que contiene las N observaciones de entrenamiento.
Seleccionar aleatoriamente un atributo i y un valor aleatorio a dentro del rango observado de i
Crear dos nuevos nodos separando las observaciones acorde al criterio xi ≤ a ó xi> a
Repetir los pasos 2 y 3 hasta que todas las observaciones quedan aisladas de forma individual en nodos terminales.
Al ser un método no supervisado, no hay forma de conocer el valor óptimo a partir del cual se debe de considerar que se trata de una anomalía. La puntuación asignada a cada observación es una medida relativa respecto al resto de observaciones. En la práctica, suelen considerarse como potenciales outliers aquellas observaciones cuya distancia predicha está por debajo de un determinado cuantil.
library(R.matlab) # Lectura de archivos .mat
## R.matlab v3.7.0 (2022-08-25 21:52:34 UTC) successfully loaded. See ?R.matlab for help.
##
## Attaching package: 'R.matlab'
## The following objects are masked from 'package:base':
##
## getOption, isOpen
library(h2o) # Modelo isolation forest
##
## ----------------------------------------------------------------------
##
## Your next step is to start H2O:
## > h2o.init()
##
## For H2O package documentation, ask for help:
## > ??h2o
##
## After starting H2O, you can use the Web UI at http://localhost:54321
## For more information visit https://docs.h2o.ai
##
## ----------------------------------------------------------------------
##
## Attaching package: 'h2o'
## The following objects are masked from 'package:stats':
##
## cor, sd, var
## The following objects are masked from 'package:base':
##
## &&, %*%, %in%, ||, apply, as.factor, as.numeric, colnames,
## colnames<-, ifelse, is.character, is.factor, is.numeric, log,
## log10, log1p, log2, round, signif, trunc
library(solitude) # Modelo isolation forest
library(tidyverse)
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.0 ✔ readr 2.1.4
## ✔ forcats 1.0.0 ✔ stringr 1.5.0
## ✔ ggplot2 3.4.2 ✔ tibble 3.1.8
## ✔ lubridate 1.9.2 ✔ tidyr 1.3.0
## ✔ purrr 1.0.1
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ lubridate::day() masks h2o::day()
## ✖ dplyr::filter() masks stats::filter()
## ✖ lubridate::hour() masks h2o::hour()
## ✖ dplyr::lag() masks stats::lag()
## ✖ lubridate::month() masks h2o::month()
## ✖ lubridate::week() masks h2o::week()
## ✖ lubridate::year() masks h2o::year()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library(MLmetrics)
##
## Attaching package: 'MLmetrics'
##
## The following object is masked from 'package:base':
##
## Recall
Datos de mamografías alojados en Outlier Detection DataSets (ODDS) ODDS Library [http://odds.cs.stonybrook.edu]. Stony Brook, NY: Stony Brook University, Department of Computer Science.
Dataset:
Cantidad de observaciones: 11.183
Dimensiones: 6
Outliers: 260 (2,32%)
Las dimensiones estan descritas como x.1 … x.6
datos <- as.data.frame(readMat("data/mammography.mat"))
glimpse(datos)
## Rows: 11,183
## Columns: 7
## $ X.1 <dbl> 0.23001961, 0.15549112, -0.78441482, 0.54608818, -0.10298725, -0.1…
## $ X.2 <dbl> 5.0725783, -0.1693904, -0.4436537, 0.1314146, -0.3949941, -0.38172…
## $ X.3 <dbl> -0.27606055, 0.67065219, 5.67470530, -0.45638679, -0.14081588, 0.2…
## $ X.4 <dbl> 0.8324441, -0.8595525, -0.8595525, -0.8595525, 0.9797027, 0.772950…
## $ X.5 <dbl> -0.3778657, -0.3778657, -0.3778657, -0.3778657, -0.3778657, 1.4689…
## $ X.6 <dbl> 0.4803223, -0.9457232, -0.9457232, -0.9457232, 1.0135658, 0.852069…
## $ y <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, …
Se entrena un modelo isolation forest para detectar anomalias.
# inicializa el cluster de H2O
h2o.init(ip = "localhost",
# Todos los cores disponibles.
nthreads = -1,
# Máxima memoria disponible para el cluster.
max_mem_size = "4g")
## Connection successful!
##
## R is connected to the H2O cluster:
## H2O cluster uptime: 26 minutes 37 seconds
## H2O cluster timezone: America/Santiago
## H2O data parsing timezone: UTC
## H2O cluster version: 3.40.0.1
## H2O cluster version age: 3 months and 1 day
## H2O cluster name: H2O_started_from_R_patricio_dox294
## H2O cluster total nodes: 1
## H2O cluster total memory: 3.32 GB
## H2O cluster total cores: 4
## H2O cluster allowed cores: 4
## H2O cluster healthy: TRUE
## H2O Connection ip: localhost
## H2O Connection port: 54321
## H2O Connection proxy: NA
## H2O Internal Security: FALSE
## R Version: R version 4.2.3 (2023-03-15)
h2o.removeAll()
h2o.no_progress()
# carga de datos en el cluster creado
datos_h2O <- as.h2o(x = datos)
Creación del modelo
# Modelo
isoforest <- h2o.isolationForest(
model_id = "isoforest",
training_frame = datos_h2O,
x = colnames(datos_h2O)[-7],
max_depth = 350, # Profundidad máxima de los árboles
ntrees = 500, # Número de los árboles
sample_rate = 0.9 # Ratio de observaciones empleadas en cada árbol
)
isoforest
## Model Details:
## ==============
##
## H2OAnomalyDetectionModel: isolationforest
## Model ID: isoforest
## Model Summary:
## number_of_trees number_of_internal_trees model_size_in_bytes min_depth
## 1 500 500 24478700 29
## max_depth mean_depth min_leaves max_leaves mean_leaves
## 1 59 40.11200 2308 5055 3881.00400
##
##
## H2OAnomalyDetectionMetrics: isolationforest
## ** Reported on training data. **
## ** Metrics reported on Out-Of-Bag training samples **
##
## Anomaly Score: 17.16332
## Normalized Anomaly Score: 0.4360477
Con el modelo entrenado, se predicen las distancias de aislamiento
promedio de cada observación. Los resultados devueltos por
h2o contiene la distancia promedio mean_length
y su valor normalizado predict.
predicciones_h2o <- h2o.predict(
object = isoforest,
newdata = datos_h2O
)
predicciones <- as.data.frame(predicciones_h2o)
head(predicciones)
## predict mean_length
## 1 0.60316092 13.674
## 2 0.33630268 19.246
## 3 0.67863985 12.098
## 4 0.37768199 18.382
## 5 0.06091954 24.996
## 6 0.25000000 21.048
ggplot(data = predicciones, aes(x = mean_length)) +
geom_histogram(color = "gray40") +
geom_vline(
xintercept = quantile(predicciones$mean_length, seq(0, 1, 0.1)),
color = "red",
linetype = "dashed") +
labs(
title = "Distribución de las distancias medias del Isolation Forest",
subtitle = "Cuantiles marcados en rojo" ) +
theme_bw()
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
Una vez que la distancia de separación ha sido calculado, se puede emplear como criterio para identificar anomalías. Asumiendo que las observaciones con valores atípicos alguna de sus variables se separan del resto con mayor facilidad, aquellas observaciones con menor distancia promedio deberían ser las más atípicas.
datos <- datos %>%
bind_cols(predicciones)
ggplot(data = datos,
aes(x = y, y = mean_length)) +
geom_jitter(aes(color = y), width = 0.03, alpha = 0.3) +
geom_violin(alpha = 0) +
geom_boxplot(width = 0.2, outlier.shape = NA, alpha = 0) +
stat_summary(fun = "mean", colour = "orangered2", size = 3, geom = "point") +
labs(title = "Distancia promedio en el modelo Isolation Forest",
x = "clasificación (0 = normal, 1 = anomalía)",
y = "Distancia promedio") +
theme_bw() +
theme(legend.position = "none")
## Warning: Continuous x aesthetic
## ℹ did you forget `aes(group = ...)`?
La distancia promedio en el grupo de las anomalías (1) es claramente inferior. Sin embargo, al existir solapamiento, si se clasifican las n observaciones con menor distancia como anomalías, se incurriría en errores de falsos positivos.
Acorde a la documentación, el set de datos Cardiotocogrpahy contiene 260 anomalías. Véase la matriz de confusión resultante si se clasifican como anomalías las 260 observaciones con menor distancia predicha.
resultados <- datos %>%
select(y, mean_length) %>%
arrange(mean_length) %>%
mutate(clasificacion = if_else(row_number() <= 260, "1", "0"))
# matriz de confusion
mat_confusion <- MLmetrics::ConfusionMatrix(
y_pred = resultados$clasificacion,
y_true = resultados$y
)
mat_confusion
## y_pred
## y_true 0 1
## 0 10712 211
## 1 211 49
De las 260 anomalias detectadas, solo 66 lo son realmente. El porcentaje de falsos positivos es alto 75% (102/260).
Dataset:
Cantidad de observaciones: 1.831
Dimensiones: 21
Outliers: 176 (9,6%)
Las dimensiones estan descritas como x.1 … x.21
Creacion de modelo
datos <- as.data.frame(readMat("data/cardio.mat"))
# Modelo isolation forest
isoforest <- isolationForest$new(
sample_size = as.integer(nrow(datos)/2),
num_trees = 500,
replace = TRUE,
seed = 123
)
isoforest$fit(dataset = datos %>% select(-y))
## INFO [18:47:21.655] dataset has duplicated rows
## INFO [18:47:21.741] Building Isolation Forest ...
## INFO [18:47:28.162] done
## INFO [18:47:28.163] Computing depth of terminal nodes ...
## INFO [18:47:31.090] done
## INFO [18:47:31.828] Completed growing isolation forest
predicciones <- isoforest$predict(
data = datos %>% select(-y)
)
head(predicciones)
## id average_depth anomaly_score
## 1: 1 9.806 0.5878190
## 2: 2 9.782 0.5885839
## 3: 3 9.578 0.5951260
## 4: 4 9.784 0.5885201
## 5: 5 9.892 0.5850862
## 6: 6 9.786 0.5884563
ggplot(data = predicciones, aes(x = average_depth)) +
geom_histogram(color = "gray40") +
geom_vline(
xintercept = quantile(predicciones$average_depth, seq(0, 1, 0.1)),
color = "red",
linetype = "dashed") +
labs(
title = "Distribución de las distancias medias del Isolation Forest",
subtitle = "Cuantiles marcados en rojo" ) +
theme_bw()
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
cuantiles <- quantile(x = predicciones$average_depth, probs = seq(0, 1, 0.05))
cuantiles
## 0% 5% 10% 15% 20% 25% 30% 35% 40% 45% 50%
## 7.614 8.941 9.278 9.466 9.554 9.631 9.680 9.736 9.784 9.820 9.846
## 55% 60% 65% 70% 75% 80% 85% 90% 95% 100%
## 9.868 9.888 9.902 9.918 9.934 9.944 9.954 9.966 9.980 10.000
datos <- datos %>%
bind_cols(predicciones)
ggplot(data = datos,
aes(x = y, y = average_depth)) +
geom_jitter(aes(color = y), width = 0.03, alpha = 0.3) +
geom_violin(alpha = 0) +
geom_boxplot(width = 0.2, outlier.shape = NA, alpha = 0) +
stat_summary(fun = "mean", colour = "orangered2", size = 3, geom = "point") +
labs(title = "Distancia promedio en el modelo Isolation Forest",
x = "clasificación (0 = normal, 1 = anomalía)",
y = "Distancia promedio") +
theme_bw() +
theme(legend.position = "none")
## Warning: Continuous x aesthetic
## ℹ did you forget `aes(group = ...)`?
Resultados
resultados <- datos %>%
select(y, average_depth) %>%
arrange(average_depth) %>%
mutate(clasificacion = if_else(row_number() <= 176, "1", "0"))
mat_confusion <- MLmetrics::ConfusionMatrix(
y_pred = resultados$clasificacion,
y_true = resultados$y
)
mat_confusion
## y_pred
## y_true 0 1
## 0 1549 106
## 1 106 70