K-means优化算法-基于R语言实现(下)
该篇实现K-means++算法代码,所有原理都在(上)篇均已详细阐述。
一、数据源
继续利用爬取下来的大众点评数据,选取的变量为商家星级、口味评分、环境评分和服务评分。商家星级用于作聚类后的效果查看,用其余三项评分进行建模,部分数据如下图。
表1 建模数据(部分)
二、利用手肘法选取最佳K值
首先输入数据集利用手肘法选取 k 值,运行R语言程序,如图可看出,当K值从1变化到5时,平均畸变程度变化最大,K超过5以后,平均畸变程度变化明显降低。说明将商家聚为 5 类时的模型最合理。
图1 K-means 聚类最佳 K 值
三、利用K-means++算法选出K个质心点后传入传统算法
根据K-means++算法的计算流程,输入数据集和k=5,先从样本中随机挑选1个样本对象作为初始聚类的第一个质心,然后分别计算每个样本到这第一个聚类中心的欧式距离,并取最远的样本点作为第二个质心,然后继续计算每个样本与已选择的聚类中心中最近聚类中心的距离,选择最近距离数集里的最大值的样本点作为新的一个聚类中心,重复上述步骤,直至选出k=5个质心。
图2 K个质心点
将上一步选好的 k=5个质心和样本数据集作为输入,运行标准的 K-means 算法。根据算法流程,程序分别计算每个样本到这 5 个聚类中心的欧式距离, 并将所有样本分配到距离最近的簇中。重新计算每个簇中样本对象的均值,当这 5 个 簇中的样本均值不再发生变化时,停止计算并输出聚类结果。
表2 聚类结果(部分)
四、聚类效果评估
K-means聚类属于无监督学习方法,无法使用一些直接的方法去评估聚类效 果。通常而言,可以从用聚类结果簇内部的密集程度及簇之间的离散程度去评估聚类 效果。轮廓系数的取值区间为[-1,1]。越趋近于 1 代表内聚度和分离度都相对较优。总之,可以通过计算数据集中所有样本的轮廓系数均值来度量聚类的效果。R语言的fpc包里提供了计算轮廓系数的接口,运行后得到轮廓系数为0.43,说明聚类效果良好。
五、数据分析(部分)
首先观察聚类后的商家星级分布。如下图,可发现第一类含有408个商家,商家星级评分主要分布在 4.5~5,4.5 分最多且样本中所有 5 分商家都被分到第一类;第二类含有595个商家,星级评分则总体分布在4~4.5 分,4.5分商家占多数;第三类含有 852 个商家,星级评分分布在 4~4.5,4 分商家占多数;第四类含有 1046个商家,星级评分分布在 3.5~4,4 分商家占多数;第五类含有421个商家,星级评分分布在 3.5~4,3.5分商家占多数。
具体分析结果本人用于毕业论文,不给予公开,分享仅为了交流学习方法,需要具体的了解欢迎与我交流。
表3 聚类后商家星级评分分布
图 3 各个类别的口味评分密度分布对比
五、R语言代码
#1)利用 K-means++算法选取 K 个质中心
#利用k-means++算法初始化质心
initPoints <- function(dataset,k){
n = ncol(dataset)
# 建立质心矩阵
centerPointSet1 <- matrix(data = NA,nrow = k,ncol = n)
frist_num <- sample(1:100,1) # 随机选取第一个质心随机序号
frist_cent <- dataset[frist_num,]
# 第一个随机质心赋值
for(i in 1:3){
centerPointSet1[1,i] <- as.numeric(frist_cent[i])
}
# 剩下的质心选择
for(z in 2:k){
minset <- numeric(nrow(dataset))
linshi <- matrix(1000, nrow = 10, ncol = 1) # 储存每个样本点到各个质心点的距离
# 取每个样本到各质心的最小距离
for(i in 1:nrow(dataset)){
for(j in 1:z-1)
linshi[j] <- as.numeric(Eudist(centerPointSet1[j,],dataset[i,]))
minset[i] <- min(linshi)
}
# 找出最大值与其位置
max_value = 0
max_num = 0
for(i in 1:nrow(dataset)){
if(max_value < minset[i]){
max_value <- minset[i]
max_num <- i
}
}
# 第z个质点赋值
cent <- dataset[max_num,]
for(i in 1:3){
centerPointSet1[z,i] <- as.numeric(cent[i])
}
}
return(centerPointSet1)
}
centerPointSet = initPoints(dataset[,2:4],5)
#2)传统K-means算法
k_means <- function(dataset,centerPointSet){
dataset$classfly <- 0 # 最后一列放类别
# 迭代次数判断
iteration <- 0
t1 <- Sys.time()
while(TRUE){
centerPointSet_pd <- centerPointSet # 质心点判断
# 序号法,第一轮分类
for(i in 1:nrow(dataset)){
linshi <- numeric(nrow(centerPointSet))
for(j in 1:nrow(centerPointSet)){
# 装每个样本点到k个质心点的距离
linshi[j] <- as.numeric(Eudist(dataset[i,2:4],centerPointSet[j,]))
}
# 找出每个样本点的分类
min_value <- linshi[1]
min_num <- 1
for(q in 2:length(linshi)){
if(min_value > linshi[q]){
min_value <- linshi[q]
min_num <- q
}
}
dataset[i,5] <- min_num #分类
}
# 计算平均值选取新质心点
for(p in 1:nrow(centerPointSet)){
new_dataFrame <- dataset[which(dataset$classfly == p),][,2:4]
new_cent <- apply(new_dataFrame,2,mean)
centerPointSet[p,] <- new_cent
}
iteration <- iteration+1
# 迭代判断
num <- sum(centerPointSet == centerPointSet_pd)
if(num == nrow(centerPointSet)*3)
break
}
t2 <- Sys.time()
print(t2 - t1)
print(paste('算法迭代次数为:',iteration))
return(dataset)
}
result <- k_means(dataset,centerPointSet)
#3)计算轮廓系数
# 轮廓系数
library(fpc)
library(readxl)
setwd("C:/Users/Administrator/Desktop")
dzdp <- read_excel("dzdp_classfly.xlsx")
dataset <- dzdp[,1:5]
stats <- cluster.stats(dist(dataset[,2:4]), dataset$classfly)
re <- stats$avg.silwidth
re
随机用300个样本作为试验,可以发现用在大数据处理上还是比较慢的。后考虑加入了并行运算,不过我的计算机是四核处理器,速度提升不到三倍。目前还在不断优化代码,本人能力有限,文章有误的地方望指出。
如果有朋友有更好的优化的方法的欢迎与我分享