聚类

聚类分析

数据文件建立

> getwd() #设置工作目录
> stardata <- read.csv("star30.csv",header=T)
> str(stardata)
> summary(stardata)##得到数据摘要信息
'data.frame':   30 obs. of  14 variables:
 $ 姓名    : Factor w/ 30 levels "angelababy","陈赫",..: 19 14 4 1 25 29 6 9 24 12 ...
 $ 简介    : Factor w/ 30 levels "","湖南卫视《快乐大本营》主持人吴昕",..: 20 26 21 23 17 27 5 3 29 6 ...
 $ 微博会员: int  6 5 6 6 6 5 6 6 6 NA ...
 $ 关注    : int  303 324 206 685 651 96 181 681 671 936 ...
 $ 粉丝    : int  411302 3498384 57146753 81038728 71841791 15489879 20694867 84338335 90928261 14192217 ...
 $ 微博数  : int  2314 1285 905 2485 3467 1374 648 7900 9286 2990 ...
 $ 微博等级: int  35 31 33 40 39 30 33 40 41 35 ...
 $ 居住地  : Factor w/ 12 levels "","北京","北京 朝阳区",..: 3 3 2 11 2 2 7 3 5 2 ...
 $ 生日    : Factor w/ 13 levels "","1979年2月8日",..: 12 7 2 1 1 1 13 1 1 1 ...
 $ 毕业院校: Factor w/ 4 levels "","\n    \t\t\t\t\t\t    \t\t\t\t\t\t    \t\t\t\t\t\t    \t\t\t\t\t\t\t大连外国语大学",..: 4 1 1 1 1 1 3 1 1 1 ...
 $ 个人签名: Factor w/ 22 levels "","    \t\t\t\t\t\t    \t\t\t\t\t\t    \t\t\t\t\t\t\tTFBOYS组合成员易烊千玺，事宜请联系经纪人邮箱：manager@tfent.cn",..: 11 6 1 17 20 1 19 1 14 21 ...
 $ 爱慕值  : int  112 2616 370448 404016 779398 31016 158284 7134 94304 8880 ...
 $ 收到花数: int  56 1308 185232 202012 389707 15508 81314 3567 47152 4440 ...
 $ 排行榜  : int  574 347 83 59 3 54 21 117 68 137 ...

数据预处理与分析

> cludata <- stardata[,c(4,5,6,7,12,13,14)]##提取变量
> cludata  <- cludata[complete.cases(cludata),]##剔除缺失值
> str(cludata)
'data.frame':   29 obs. of  7 variables:
 $ 关注    : int  303 324 206 685 651 96 181 681 671 936 ...
 $ 粉丝    : int  411302 3498384 57146753 81038728 71841791 15489879 20694867 84338335 90928261 14192217 ...
 $ 微博数  : int  2314 1285 905 2485 3467 1374 648 7900 9286 2990 ...
 $ 微博等级: int  35 31 33 40 39 30 33 40 41 35 ...
 $ 爱慕值  : int  112 2616 370448 404016 779398 31016 158284 7134 94304 8880 ...
 $ 收到花数: int  56 1308 185232 202012 389707 15508 81314 3567 47152 4440 ...
 $ 排行榜  : int  574 347 83 59 3 54 21 117 68 137 ...
> plot(cludata$关注,type="l",col="red")##绘制折线图type=l为实线

数据挖掘

K-Means

> set.seed(12345)##设置随机数种子
> clur <- kmeans(x=cludata,centers=4,nstart=4)##设置类中心为4，指定参数为4
 K-means clustering with 4 clusters of sizes 8, 8, 4, 9

Cluster means:
    关注     粉丝   微博数 微博等级    爱慕值   收到花数   排行榜
1 309.50 24081294 2005.625 36.00000 906671.62 447435.000  90.1250
2 481.75 50017212 3420.375 38.37500 321865.75 160936.375  87.6250
3 672.00 82036779 5784.500 40.00000 321213.00 160609.500  61.7500
4 359.00  8268722 1629.333 33.55556  19347.56   9673.667 161.8889

Clustering vector:
 1  2  3  4  5  6  7  8  9 10 11 12 13 14 15 16 17 18 19 20 21 22 24 25 26 
 4  4  2  3  3  4  1  3  3  4  1  2  4  2  4  2  1  2  2  2  1  4  1  1  1 
27 28 29 30 
 2  1  4  4 

Within cluster sum of squares by cluster:
[1] 1.852224e+14 2.799902e+14 1.897482e+14 2.675635e+14
 (between_SS / total_SS =  95.1 %)

聚类结果

> clur$size##各类包含的样本量
[1] 8 8 4 9
> clur$centers##浏览4类的中心
关注     粉丝   微博数 微博等级    爱慕值   收到花数   排行榜
1 309.50 24081294 2005.625 36.00000 906671.62 447435.000  90.1250
2 481.75 50017212 3420.375 38.37500 321865.75 160936.375  87.6250
3 672.00 82036779 5784.500 40.00000 321213.00 160609.500  61.7500
4 359.00  8268722 1629.333 33.55556  19347.56   9673.667 161.8889

聚类可视化结果

> par(mfrow=c(2,1)) ##设置图形布局2*1的格式
> cludata1 <- stardata[,c(1,4,5,6,7,12,13,14)] ##提取变量
> cludata1 <- cludata[complete.cases(cludata1),] ##剔除缺失值
> cludata$clur <- clur$cluster##将聚类解保存到cludata1数据框中的clur域中
> plot(cludata1$clur,pch=cludata1$clur,col="lightblue",ylab="类别",xlab="明星",main="聚类结果图",axes=F)##绘制各类明星聚类解的序列图，不带坐标轴(pch（绘图符号设置参数）axes=FALSE 暂时禁止坐标轴的生成)
> axis(1,at=1:29,labels=cludata$姓名,cex.axis=0.8)##设定指定的坐标轴，#文字为明星的姓名（cex.axis表示修改坐标轴刻度字体大小）
> par(las=2)##指定坐标轴文字转90度  las标签是否平等于（=0）或垂直于=2）坐标轴
> axis(2,at=1:4,labels=c("第一类","第二类","第三类","第四类"),cex.axis=0.6)##指定列坐标刻度文字为聚类解编号
> box()##图形外加外框
> legend("right",c("第一类","第二类","第三类","第四类"),pch=1:4,cex=0.6)##图像添加右边的类别标签
> plot(clur$center[1,],type="l",ylim=c(0,100000000),xlab="聚类变量",ylab="组均值",axes=F)#绘制第一个类的类中心变量取值折线图
> axis(1,at=1:7,labels=c("关注","粉丝","微博数","微博等级","爱慕值","收到花数","排行榜"),cex.axis=0.6)#添加横坐标cex.axis坐标轴刻度文字的缩放倍数
> lines(1:7,clur$center[2,],lty=2,col="red",cex=0.6)##绘制第二#个类的类中心变量取值折线图
> lines(1:7,clur$center[3,],lty=3,col="blue",cex=0.6)##绘制第三#个类的类中心变量取值折线图
> lines(1:7,clur$center[4,],lty=4,col="green",cex=0.6)##绘制第四#个类的类中心变量取值折线图
> box()#添加图形框
> legend("topright",c("第一类","第二类","第三类","第四类"),lty=1:4,col=c("black","red","blue","green"))

第一类：明星包括有迪丽热巴、易烊千玺、黄磊、陈晓、吴昕、刘涛、魏晨等。这类明星关注数低，粉丝微博数以及微博等级较低但是其爱慕值与收到花数最高。
第二类：明星包括邓超、罗志祥等。其关注、微博、粉丝、收到花数等都颇高。
第三类：明星包括杨幂、谢娜等。这类明星关注、粉丝、微博数、微博等级、排行榜都是最高，爱慕值以及收到花数都颇高。
第四类：明星包括刘雨鑫、姜潮、王大陆、于小彤等。这类明星粉丝、微博数、微博等级、爱慕值、收到花数、排行榜等都是最低。
从各类成员及聚类变量均值变化折线图来看，这四类在折线图上看只有粉丝量均值变化有差异，其余都较为相似。

> clur$betweens/clur$totss*100
[1] 95.13237

说明：因类间解释的离差平方和占总平方的95.13237%，所以总体聚类效果很好。

系统聚类

> dis <- dist(cludata,method="euclidean")##计算关于欧式距离
> clur1 <- hclust(d=dis,method="ward.D")#层次聚类
#查询聚类可视化过程
> plot(clur1,labels=cludata[,1])##绘制聚类树形图
> box()

 从层次聚类的树形图来看,陈赫和刘涛距离最近，首先聚在一起；罗志祥、高圆圆、李晨、赵丽颖也聚在一起，等等。

确定合适聚类个数

> plot(clur1$height,28:1,type="b",cex=0.7,xlab="距离测度",ylab="聚类数目")

碎石图来看，随着聚类数目不断减少，最小类间距离不断增大。当聚类数目达到3类之后，最小类间距离的变化幅度很大，说明类间的差异较大，不应再继续合并，所以根据碎石图粗略判断聚成三类较为合适。

> cludata1$memb <- cutree(clur1,k=3)#将层次聚类的树形图分为三组
> table(cludata1$memb)##浏览各成员的个数
 1  2  3 
18  7  4 

查询聚类可视化结果

> plot(cludata1$memb,pch=cludata1$memb,ylab="类别",xlab="明星",axes=F)
> par(las=2)
> axis(1,at=1:29,labels=cludata$姓名,cex.axis=0.8)
> axis(2,at=1:3,labels=c("第一类","第二类","第三类"),cex.axis=0.6)
> box()

从层次聚类的聚类解来看，与K-Means聚类有所不同，这是两种方法原理上的差异导致。