在 R 中编写自己的 kmeans 算法

Writing own kmeans algorithm in R

我正在尝试用 R 编写我自己的第一个 kmeans 算法。我是这个领域的新手,所以请不要因为我没有看到显而易见的东西而评判我。

在当前状态下,该算法采用两个向量 xy,计算每个数据点到聚类中心的距离,并将其中心到聚类中心的距离最小的聚类分配给数据点。当分配没有变化,因此聚类中心也没有变化时,算法停止。

# Sample data    
set.seed(100)
xval <- rnorm(12, mean = rep(1:3, each = 4), sd = 0.2)
yval <- rnorm(12, mean = rep(c(1,2,1), each = 4), sd = 0.2)

# Kmeans function
kclus <- function(x, y, nclus) {

    # start with random cluster centers
    xcen <- runif(n = nclus, min = min(x), max = max(x))   
    ycen <- runif(n = nclus, min = min(y), max = max(y))

    # data points and cluster assignment in "data"
    # cluster coordinates in "clus"
    data <- data.frame(xval = x, yval = y, clus = NA)
    clus <- data.frame(name = 1:nclus, xcen = xcen, ycen = ycen)

    finish <- FALSE

    while(finish == FALSE) {

        # assign cluster with minimum distance to each data point
        for(i in 1:length(x)) {
            dist <- sqrt((x[i]-clus$xcen)^2 + (y[i]-clus$ycen)^2)
            data$clus[i] <- which.min(dist)
        }

        xcen_old <- clus$xcen
        ycen_old <- clus$ycen

        # calculate new cluster centers
        for(i in 1:nclus) {
            clus[i,2] <- mean(subset(data$xval, data$clus == i))
            clus[i,3] <- mean(subset(data$yval, data$clus == i))
        }

        # stop the loop if there is no change in cluster coordinates
        if(identical(xcen_old, clus$xcen) & identical(ycen_old, clus$ycen)) finish <- TRUE
    }
    data
}

# apply kmeans function to sample data
cluster <- kclus(xval, yval, 4)

# plot the result
ggplot(cluster, aes(xval, yval, color = as.factor(clus))) + geom_point()

目前为止效果还不错。但我不知道如何将算法强制到特定数量的集群。它已经在我的 kclus() 函数中作为参数 nclus 实现,但我不知道如何使用它。

对于给定的样本数据,算法只给了我三个集群。我要逼着他把四簇还给我

这里有人可以给我一些建议吗?

非常感谢, 马库斯

这正是 k-means 的工作方式。你有两个主要选择。每当集群数量低于请求的集群数量时,要么接受越来越少的集群 要么 ,开始一个新集群。要开始一个新的,可能会找到离其聚类中心最远的点并将其更改为一个新的聚类。但是,这样做存在问题。假设您有 20 个点,用户要求 25 个簇。你就是无法满足某些人。

这不是真的,您实施的算法总是给您 3 个集群,可能您没有 运行 它足够多的次数。这是对您的代码的轻微修改,我们将能够看到集群输出的数量取决于集群质心的初始化(随机选择并可以用 random.seed 控制):

# Sample data    
set.seed(100)
xval <- rnorm(12, mean = rep(1:3, each = 4), sd = 0.2)
yval <- rnorm(12, mean = rep(c(1,2,1), each = 4), sd = 0.2)

# Kmeans function with random.seed for initialization
kclus <- function(x, y, nclus, random.seed=123) {

  set.seed(random.seed)
  # start with random cluster centers
  xcen <- runif(n = nclus, min = min(x), max = max(x))   
  ycen <- runif(n = nclus, min = min(y), max = max(y))

  # data points and cluster assignment in "data"
  # cluster coordinates in "clus"
  data <- data.frame(xval = x, yval = y, clus = NA)
  clus <- data.frame(name = 1:nclus, xcen = xcen, ycen = ycen)

  finish <- FALSE

  while(finish == FALSE) {

    # assign cluster with minimum distance to each data point
    for(i in 1:length(x)) {
      dist <- sqrt((x[i]-clus$xcen)^2 + (y[i]-clus$ycen)^2)
      data$clus[i] <- which.min(dist)
    }

    xcen_old <- clus$xcen
    ycen_old <- clus$ycen

    # calculate new cluster centers
    for(i in 1:nclus) {
      clus[i,2] <- mean(subset(data$xval, data$clus == i))
      clus[i,3] <- mean(subset(data$yval, data$clus == i))
    }

    # stop the loop if there is no change in cluster coordinates
    if(identical(xcen_old, clus$xcen) & identical(ycen_old, clus$ycen)) finish <- TRUE
  }
  data
}

# with default random seed 123, you should be able to reproduce the result
# as you can see, in this case, no data points were assigned to the 4th cluster
cluster <- kclus(xval, yval, 4)
cluster.centers <- aggregate(.~clus, cluster, mean)
ggplot(cluster, aes(xval, yval, color = as.factor(clus))) + 
  geom_point(size=5) + 
  geom_point(data=cluster.centers, aes(xval, yval, col=as.factor(clus)), pch=8, size=5)

# run with a different random seed = 12
# as you can see, in this case, the algorithm outputs 4 clusters, with the 2nd cluster having a single datapoint assigned to
    cluster <- kclus(xval, yval, 4, 12)
    cluster.centers <- aggregate(.~clus, cluster, mean)
    ggplot(cluster, aes(xval, yval, color = as.factor(clus))) + 
      geom_point(size=5) + 
      geom_point(data=cluster.centers, aes(xval, yval, col=as.factor(clus)), pch=8, size=5)

# run with a different random seed = 12345
# as you can see, in this case, the algorithm outputs 2 clusters, with the all the datapoints assigned to the 1st and the 2nd cluster
    cluster <- kclus(xval, yval, 4, 12345)
    cluster.centers <- aggregate(.~clus, cluster, mean)
    ggplot(cluster, aes(xval, yval, color = as.factor(clus))) + 
      geom_point(size=5) + 
      geom_point(data=cluster.centers, aes(xval, yval, col=as.factor(clus)), pch=8, size=5)

从上面的例子我们可以看出,一个聚类在收敛时是否最终没有分配点取决于初始中心位置和数据分布。一般来说,如果 kmeans 以一个空簇质心结束,这意味着如果你试图强行将一个点分配给空簇,它可能会导致质量较差的簇,这是你不想做的。

此时您可以尝试几种方法。

  1. 首先你可以运行你的算法多次,每次使用不同的随机初始化中心,然后选择具有最高聚类质量(通过 SSE 等测量)的结果。
  2. 您可以尝试的第二件事是更智能的初始化 K均值++。
  3. A not-so-good-choice 可能是将您的算法修改为 确保在重新分配集群时它保证每个 k (=4) 个簇至少分配了一个点(如果没有,则 不要重新分配)。
  4. 最后你可以尝试一些其他的算法,比如 层次聚类,通过以下方式为您提供更大的灵活性 树状图以选择任意数量的聚类。

问题出在你的初始化上。

用随机数初始化是最糟糕的选择,除非你的数据是均匀随机分布的(这样你就没有集群)。

现在,如果您在左上角生成一个中心,它可能有 0 个点,您的代码接下来可能会生成一个 NaN 均值。

相反,请尝试从您的数据 中选择 k 个点 作为中心。这不太可能变坏(尽管它可以)。