R、 SOM、Kohonen包、异常检测

我用SOM做了一点实验。首先，我在Python中使用了MiniSOM，但我对此印象不深，于是改为在R中使用kohonen包，它提供了比前一个更多的特性。基本上，我将SOM应用于三个用例：（1）使用生成的数据在2D中进行聚类，（2）使用更高维度的数据进行聚类：内置的葡萄酒数据集，以及（3）异常值检测。我解决了所有三个用例，但我想提出一个与我应用的异常值检测相关的问题。为此，我使用了向量som$distance，它包含输入数据集每行的距离。距离超过的值可能是异常值。然而，我不知道这个距离是如何计算的。包说明（）对此度量说明：“到最近单位的距离”

你能告诉我这个距离是怎么计算的吗

你能评论一下我使用的异常值检测吗？你会怎么做？（在生成的数据集中，它确实找到了异常值 真正的葡萄酒数据集在177种葡萄酒中有四种相对优异的价值。参见 下面的图表。我想到用条形图来描述这一点，我非常喜欢。）

图表：

• 生成的数据，5个不同的簇中的100个2D点和2个 异常值（第6类显示异常值）：

• 显示所有102个数据点的距离，最后两个为 正确识别的异常值。我重复了测试 有500个和1000个数据点，仅添加了2个异常值。这个 在这些案例中也发现了异常值。

• 具有潜在异常值的真实葡萄酒数据集的距离：

潜在异常值的行id：

# 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

我的注释代码段： 准备、聚类和绘图 我将层次聚类方法与Kohonen映射（SOM）结合使用

标准化_数据
虽然我不太确定，但我经常发现，两个物体在特定维度空间中的距离测量主要使用欧几里德距离。例如，在具有位置A（x=3，y=4）和B（x=6，y=8）的二维空间中，两点A和B相距5个距离单位。它是计算平方根（（3-6）^2+（4-8）^2）的结果。这也适用于维度较大的数据，方法是将特定维度中两点值之差的二的尾随幂相加。如果A（x=3，y=4，z=5）和B（x=6，y=8，z=7），则距离是平方根（（3-6）^2+（4-8）^2+（5-7）^2），依此类推。在kohonen中，我认为在模型完成训练阶段后，算法会计算每个基准到所有节点的距离，然后将其分配到最近的节点（距离最小的节点）。最终，模型返回的变量“距离”内的值是每个基准到其最近节点的距离。从脚本中需要注意的一点是，该算法不会直接测量与数据所具有的原始特性值之间的距离，因为在将数据提供给模型之前，这些特性值已经过缩放。距离测量应用于数据的缩放版本。标度是消除一个变量在另一个变量上的支配地位的标准程序
我相信您的方法是可以接受的，因为“距离”变量中的值是每个基准到其最近节点的距离。因此，如果一个基准点与其最近的节点之间的距离值很高，那么这也意味着：基准点与其他节点之间的距离明显要高得多
好问题，塔马斯！你是如何绘制“5个簇2个离群点图”的？嗨，Noob，据我记忆所及，我随机选择了给定范围内二维空间的x和y坐标作为簇的质心。然后围绕每个质心（x，y），我从正态分布生成随机的x'和y'值，平均值为x和y。我喜欢选择的标准偏差：-）。当我有5个簇中的点时，我任意添加了2个不属于生成的任何簇的点。如果您需要，我将尝试寻找我编写的代码…非常感谢！如果你能找到代码，请告诉我。我也在处理一个类似的问题：我会查找代码，我想我在某处找到了：-）。我会在1到2天内给你回复。
        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, ]

            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")

            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")