С SOM я немного поэкспериментировал. Сначала я использовал MiniSOM в Python, но меня это не впечатлило, и я перешел на пакет kohonen в R, который предлагает больше функций, чем предыдущий. По сути, я применил SOM для трех случаев использования: (1) кластеризация в 2D с сгенерированными данными, (2) кластеризация с более многомерными данными: встроенный набор данных вина и (3) обнаружение выбросов. Я решил все три варианта использования, но хотел бы поднять вопрос в связи с примененным мною обнаружением выбросов. Для этой цели я использовал вектор som $ distance, который содержит расстояние для каждой строки входного набора данных. Значения с превосходными расстояниями могут быть выбросами. Однако я не знаю, как рассчитывается это расстояние. Описание пакета (https://cran.r-project.org/web/packages/kohonen/kohonen.pdf) указывает для этой метрики: расстояние до ближайшей единицы.
- Подскажите, пожалуйста, как рассчитывается это расстояние?
- Не могли бы вы прокомментировать используемое мной обнаружение выбросов? Как бы вы это сделали? (В сгенерированном наборе данных он действительно находит выбросы. В реальном наборе данных по вину есть четыре относительно превосходных значения среди 177 сортов вин. См. Диаграммы ниже. Идея, которая пришла мне в голову, использовать гистограммы для отображения этого, я действительно нравиться.)
Графики:
Сгенерированные данные, 100 точек в 2D в 5 отдельных кластерах и 2 выброса (Категория 6 показывает выбросы):
Расстояния показаны для всех 102 точек данных, две последние - выбросы, которые были правильно идентифицированы. Я повторил тест с 500 и 1000 точками данных и добавил только 2 выброса. В этих случаях также были обнаружены выбросы.
Расстояния для реального набора данных вина с потенциальными выбросами:
Идентификатор строки потенциальных выбросов:
# print the row id of the outliers
# the threshold 10 can be taken from the bar chart,
# below which the vast majority of the values fall
df_wine[df_wine$value > 10, ]
it produces the following output:
index value
59 59 12.22916
110 110 13.41211
121 121 15.86576
158 158 11.50079
Мой аннотированный фрагмент кода:
data(wines)
scaled_wines <- scale(wines)
# creating and training SOM
som.wines <- som(scaled_wines, grid = somgrid(5, 5, "hexagonal"))
summary(som.wines)
#looking for outliers, dist = distance to the closest unit
som.wines$distances
len <- length(som.wines$distances)
index_in_vector <- c(1:len)
df_wine<-data.frame(cbind(index_in_vector, som.wines$distances))
colnames(df_wine) <-c("index", "value")
po <-ggplot(df_wine, aes(index, value)) + geom_bar(stat = "identity")
po <- po + ggtitle("Outliers?") + theme(plot.title = element_text(hjust = 0.5)) + ylab("Distances in som.wines$distances") + xlab("Number of Rows in the Data Set")
plot(po)
# print the row id of the outliers
# the threshold 10 can be taken from the bar chart,
# below which the vast majority of the values fall
df_wine[df_wine$value > 10, ]
Дополнительные образцы кода
Что касается обсуждения в комментариях, я также публикую запрошенные фрагменты кода. Насколько я помню, строки кода, отвечающие за кластеризацию, я построил на основе примеров, которые я нашел в описании пакета Kohonen (https://cran.r-project.org/web/packages/kohonen/kohonen.pdf). Однако я не совсем уверен, это было больше года назад. Код предоставляется как есть, без каких-либо гарантий :-). Имейте в виду, что конкретный подход к кластеризации может работать с разными данными с разной точностью. Я также рекомендовал бы сравнить его с t-SNE в наборе данных по винам (data(wines) доступно в R). Кроме того, внедрите тепловые карты, чтобы продемонстрировать, как расположены данные по отдельным переменным. (В случае приведенного выше примера с двумя переменными это не важно, но было бы неплохо для набора данных вина).
Генерация данных с пятью кластерами и двумя выбросами и построение графиков
library(stats)
library(ggplot2)
library(kohonen)
generate_data <- function(num_of_points, num_of_clusters, outliers=TRUE){
num_of_points_per_cluster <- num_of_points/num_of_clusters
cat(sprintf("#### num_of_points_per_cluster = %s, num_of_clusters = %s \n", num_of_points_per_cluster, num_of_clusters))
arr<-array()
standard_dev_y <- 6000
standard_dev_x <- 2
# for reproducibility setting the random generator
set.seed(10)
for (i in 1:num_of_clusters){
centroid_y <- runif(1, min=10000, max=200000)
centroid_x <- runif(1, min=20, max=70)
cat(sprintf("centroid_x = %s \n, centroid_y = %s", centroid_x, centroid_y ))
vector_y <- rnorm(num_of_points_per_cluster, mean=centroid_y, sd=standard_dev_y)
vector_x <- rnorm(num_of_points_per_cluster, mean=centroid_x, sd=standard_dev_x)
cluster <- array(c(vector_y, vector_x), dim=c(num_of_points_per_cluster, 2))
cluster <- cbind(cluster, i)
arr <- rbind(arr, cluster)
}
if(outliers){
#adding two outliers
arr <- rbind(arr, c(10000, 30, 6))
arr <- rbind(arr, c(150000, 70, 6))
}
colnames(arr) <-c("y", "x", "Cluster")
# WA to remove the first NA row
arr <- na.omit(arr)
return(arr)
}
scatter_plot_data <- function(data_in, couloring_base_indx, main_label){
df <- data.frame(data_in)
colnames(df) <-c("y", "x", "Cluster")
pl <- ggplot(data=df, aes(x = x,y=y)) + geom_point(aes(color=factor(df[, couloring_base_indx])))
pl <- pl + ggtitle(main_label) + theme(plot.title = element_text(hjust = 0.5))
print(pl)
}
##################
# generating data
data <- generate_data(100, 5, TRUE)
print(data)
scatter_plot_data(data, couloring_base_indx<-3, "Original Clusters without Outliers \n 102 Points")
Подготовка, кластеризация и построение графиков
Я использовал подход иерархической кластеризации с картой Кохонена (SOM).
normalising_data <- function(data){
# normalizing data points not the cluster identifiers
mtrx <- data.matrix(data)
umtrx <- scale(mtrx[,1:2])
umtrx <- cbind(umtrx, factor(mtrx[,3]))
colnames(umtrx) <-c("y", "x", "Cluster")
return(umtrx)
}
train_som <- function(umtrx){
# unsupervised learning
set.seed(7)
g <- somgrid(xdim=5, ydim=5, topo="hexagonal")
#map<-som(umtrx[, 1:2], grid=g, alpha=c(0.005, 0.01), radius=1, rlen=1000)
map<-som(umtrx[, 1:2], grid=g)
summary(map)
return(map)
}
plot_som_data <- function(map){
par(mfrow=c(3,2))
# to plot some charactristics of the SOM map
plot(map, type='changes')
plot(map, type='codes', main="Mapping Data")
plot(map, type='count')
plot(map, type='mapping') # how many data points are held by each neuron
plot(map, type='dist.neighbours') # the darker the colours are, the closer the point are; the lighter the colours are, the more distant the points are
#to switch the plot config to the normal
par(mfrow=c(1,1))
}
plot_disstances_to_the_closest_point <- function(map){
# to see which neuron is assigned to which value
map$unit.classif
#looking for outliers, dist = distance to the closest unit
map$distances
max(map$distances)
len <- length(map$distances)
index_in_vector <- c(1:len)
df<-data.frame(cbind(index_in_vector, map$distances))
colnames(df) <-c("index", "value")
po <-ggplot(df, aes(index, value)) + geom_bar(stat = "identity")
po <- po + ggtitle("Outliers?") + theme(plot.title = element_text(hjust = 0.5)) + ylab("Distances in som$distances") + xlab("Number of Rows in the Data Set")
plot(po)
return(df)
}
###################
# unsupervised learning
umtrx <- normalising_data(data)
map<-train_som(umtrx)
plot_som_data(map)
#####################
# creating the dendogram and then the clusters for the neurons
dendogram <- hclust(object.distances(map, "codes"), method = 'ward.D')
plot(dendogram)
clusters <- cutree(dendogram, 7)
clusters
length(clusters)
#visualising the clusters on the map
par(mfrow = c(1,1))
plot(map, type='dist.neighbours', main="Mapping Data")
add.cluster.boundaries(map, clusters)
Сюжеты с кластерами
Вы также можете создавать хорошие тепловые карты для выбранных переменных, но я не реализовал их для кластеризации с двумя переменными, это не имеет смысла. Если вы реализуете его для набора данных вина, добавьте код и диаграммы в этот пост.
#see the predicted clusters with the data set
# 1. add the vector of the neuron ids to the data
mapped_neurons <- map$unit.classif
umtrx <- cbind(umtrx, mapped_neurons)
# 2. taking the predicted clusters and adding them the the original matrix
# very good description of the apply functions:
# https://www.guru99.com/r-apply-sapply-tapply.html
get_cluster_for_the_row <- function(x, cltrs){
return(cltrs[x])
}
predicted_clusters <- sapply (umtrx[,4], get_cluster_for_the_row, cltrs<-clusters)
mtrx <- cbind(mtrx, predicted_clusters)
scatter_plot_data(mtrx, couloring_base_indx<-4, "Predicted Clusters with Outliers \n 100 points")
См. Прогнозируемые кластеры ниже в случае, если были выбросы, а в случае, если их не было.
