首页 > 代码库 > 在R中练习k-meas聚类
在R中练习k-meas聚类
算法优势：适用于绝大多数的数据类型，简洁和快速
算法劣势：需要知道准确的 k 值，并且不能处理异形簇，比如球形簇，不同尺寸及密度的簇，环形簇等。
一、分析目标
以数据集字段进行客户分群
二、流程
数据获取，毕业年份、性别、年龄、交友数量、关注的热点词（原本是一个list是否关注了这些运动或者热点词，已经以哑变量展开）
数据探索
确认数据结构：整体都是数值型的，
1、性别是分类变量，这样的话该变量不能被K聚类识别，需要对性别进行哑变量编码
2、数据里边存在缺失
> str(teens) ‘data.frame‘: 30000 obs. of 40 variables: $ gradyear : int 2006 2006 2006 2006 2006 2006 2006 2006 2006 2006 ... $ gender : Factor w/ 2 levels "F","M": 2 1 2 1 NA 1 1 2 1 1 ... $ age : num 19 18.8 18.3 18.9 19 ... $ friends : int 7 0 69 0 10 142 72 17 52 39 ... $ basketball : int 0 0 0 0 0 0 0 0 0 0 ... $ football : int 0 1 1 0 0 0 0 0 0 0 ... $ soccer : int 0 0 0 0 0 0 0 0 0 0 ... $ softball : int 0 0 0 0 0 0 0 1 0 0 ... $ volleyball : int 0 0 0 0 0 0 0 0 0 0 ... $ swimming : int 0 0 0 0 0 0 0 0 0 0 ... $ cheerleading: int 0 0 0 0 0 0 0 0 0 0 ... $ baseball : int 0 0 0 0 0 0 0 0 0 0 ... $ tennis : int 0 0 0 0 0 0 0 0 0 0 ... $ sports : int 0 0 0 0 0 0 0 0 0 0 ... $ cute : int 0 1 0 1 0 0 0 0 0 1 ... $ sex : int 0 0 0 0 1 1 0 2 0 0 ... $ sexy : int 0 0 0 0 0 0 0 1 0 0 ... $ hot : int 0 0 0 0 0 0 0 0 0 1 ... $ kissed : int 0 0 0 0 5 0 0 0 0 0 ... $ dance : int 1 0 0 0 1 0 0 0 0 0 ... $ band : int 0 0 2 0 1 0 1 0 0 0 ... $ marching : int 0 0 0 0 0 1 1 0 0 0 ... $ music : int 0 2 1 0 3 2 0 1 0 1 ... $ rock : int 0 2 0 1 0 0 0 1 0 1 ... $ god : int 0 1 0 0 1 0 0 0 0 6 ... $ church : int 0 0 0 0 0 0 0 0 0 0 ... $ jesus : int 0 0 0 0 0 0 0 0 0 2 ... $ bible : int 0 0 0 0 0 0 0 0 0 0 ... $ hair : int 0 6 0 0 1 0 0 0 0 1 ... $ dress : int 0 4 0 0 0 1 0 0 0 0 ... $ blonde : int 0 0 0 0 0 0 0 0 0 0 ... $ mall : int 0 1 0 0 0 0 2 0 0 0 ... $ shopping : int 0 0 0 0 2 1 0 0 0 1 ... $ clothes : int 0 0 0 0 0 0 0 0 0 0 ... $ hollister : int 0 0 0 0 0 0 2 0 0 0 ... $ abercrombie : int 0 0 0 0 0 0 0 0 0 0 ... $ die : int 0 0 0 0 0 0 0 0 0 0 ... $ death : int 0 0 1 0 0 0 0 0 0 0 ... $ drunk : int 0 0 0 0 1 1 0 0 0 0 ... $ drugs : int 0 0 0 0 1 0 0 0 0 0 ...
查看缺失情况
> summary(teens) gradyear gender age friends basketball Min. :2006 F :22054 Min. : 3.086 Min. : 0.00 Min. : 0.0000 1st Qu.:2007 M : 5222 1st Qu.: 16.312 1st Qu.: 3.00 1st Qu.: 0.0000 Median :2008 NA‘s: 2724 Median : 17.287 Median : 20.00 Median : 0.0000 Mean :2008 Mean : 17.994 Mean : 30.18 Mean : 0.2673 3rd Qu.:2008 3rd Qu.: 18.259 3rd Qu.: 44.00 3rd Qu.: 0.0000 Max. :2009 Max. :106.927 Max. :830.00 Max. :24.0000 NA‘s :5086 football soccer softball volleyball Min. : 0.0000 Min. : 0.0000 Min. : 0.0000 Min. : 0.0000 1st Qu.: 0.0000 1st Qu.: 0.0000 1st Qu.: 0.0000 1st Qu.: 0.0000 Median : 0.0000 Median : 0.0000 Median : 0.0000 Median : 0.0000 Mean : 0.2523 Mean : 0.2228 Mean : 0.1612 Mean : 0.1431 3rd Qu.: 0.0000 3rd Qu.: 0.0000 3rd Qu.: 0.0000 3rd Qu.: 0.0000 Max. :15.0000 Max. :27.0000 Max. :17.0000 Max. :14.0000 swimming cheerleading baseball tennis Min. : 0.0000 Min. :0.0000 Min. : 0.0000 Min. : 0.00000 1st Qu.: 0.0000 1st Qu.:0.0000 1st Qu.: 0.0000 1st Qu.: 0.00000 Median : 0.0000 Median :0.0000 Median : 0.0000 Median : 0.00000 Mean : 0.1344 Mean :0.1066 Mean : 0.1049 Mean : 0.08733 3rd Qu.: 0.0000 3rd Qu.:0.0000 3rd Qu.: 0.0000 3rd Qu.: 0.00000 Max. :31.0000 Max. :9.0000 Max. :16.0000 Max. :15.00000 sports cute sex sexy Min. : 0.00 Min. : 0.0000 Min. : 0.0000 Min. : 0.0000 1st Qu.: 0.00 1st Qu.: 0.0000 1st Qu.: 0.0000 1st Qu.: 0.0000 Median : 0.00 Median : 0.0000 Median : 0.0000 Median : 0.0000 Mean : 0.14 Mean : 0.3229 Mean : 0.2094 Mean : 0.1412 3rd Qu.: 0.00 3rd Qu.: 0.0000 3rd Qu.: 0.0000 3rd Qu.: 0.0000 Max. :12.00 Max. :18.0000 Max. :114.0000 Max. :18.0000 hot kissed dance band Min. : 0.0000 Min. : 0.0000 Min. : 0.0000 Min. : 0.0000 1st Qu.: 0.0000 1st Qu.: 0.0000 1st Qu.: 0.0000 1st Qu.: 0.0000 Median : 0.0000 Median : 0.0000 Median : 0.0000 Median : 0.0000 Mean : 0.1266 Mean : 0.1032 Mean : 0.4252 Mean : 0.2996 3rd Qu.: 0.0000 3rd Qu.: 0.0000 3rd Qu.: 0.0000 3rd Qu.: 0.0000 Max. :10.0000 Max. :26.0000 Max. :30.0000 Max. :66.0000 marching music rock god Min. : 0.0000 Min. : 0.0000 Min. : 0.0000 Min. : 0.0000 1st Qu.: 0.0000 1st Qu.: 0.0000 1st Qu.: 0.0000 1st Qu.: 0.0000 Median : 0.0000 Median : 0.0000 Median : 0.0000 Median : 0.0000 Mean : 0.0406 Mean : 0.7378 Mean : 0.2433 Mean : 0.4653 3rd Qu.: 0.0000 3rd Qu.: 1.0000 3rd Qu.: 0.0000 3rd Qu.: 1.0000 Max. :11.0000 Max. :64.0000 Max. :21.0000 Max. :79.0000 church jesus bible hair Min. : 0.0000 Min. : 0.0000 Min. : 0.00000 Min. : 0.0000 1st Qu.: 0.0000 1st Qu.: 0.0000 1st Qu.: 0.00000 1st Qu.: 0.0000 Median : 0.0000 Median : 0.0000 Median : 0.00000 Median : 0.0000 Mean : 0.2482 Mean : 0.1121 Mean : 0.02133 Mean : 0.4226 3rd Qu.: 0.0000 3rd Qu.: 0.0000 3rd Qu.: 0.00000 3rd Qu.: 0.0000 Max. :44.0000 Max. :30.0000 Max. :11.00000 Max. :37.0000 dress blonde mall shopping Min. :0.000 Min. : 0.0000 Min. : 0.0000 Min. : 0.000 1st Qu.:0.000 1st Qu.: 0.0000 1st Qu.: 0.0000 1st Qu.: 0.000 Median :0.000 Median : 0.0000 Median : 0.0000 Median : 0.000 Mean :0.111 Mean : 0.0989 Mean : 0.2574 Mean : 0.353 3rd Qu.:0.000 3rd Qu.: 0.0000 3rd Qu.: 0.0000 3rd Qu.: 1.000 Max. :9.000 Max. :327.0000 Max. :12.0000 Max. :11.000 clothes hollister abercrombie die Min. :0.0000 Min. :0.00000 Min. :0.00000 Min. : 0.0000 1st Qu.:0.0000 1st Qu.:0.00000 1st Qu.:0.00000 1st Qu.: 0.0000 Median :0.0000 Median :0.00000 Median :0.00000 Median : 0.0000 Mean :0.1485 Mean :0.06987 Mean :0.05117 Mean : 0.1841 3rd Qu.:0.0000 3rd Qu.:0.00000 3rd Qu.:0.00000 3rd Qu.: 0.0000 Max. :8.0000 Max. :9.00000 Max. :8.00000 Max. :22.0000 death drunk drugs Min. : 0.0000 Min. :0.00000 Min. : 0.00000 1st Qu.: 0.0000 1st Qu.:0.00000 1st Qu.: 0.00000 Median : 0.0000 Median :0.00000 Median : 0.00000 Mean : 0.1142 Mean :0.08797 Mean : 0.06043 3rd Qu.: 0.0000 3rd Qu.:0.00000 3rd Qu.: 0.00000 Max. :14.0000 Max. :8.00000 Max. :16.00000
缺失处理
> table(teens$gender,useNA = ‘ifany‘)#返回缺失个数 F M <NA> 22054 5222 2724
> teens$female<-ifelse(teens$gender==‘F‘&!is.na(teens$gender),1,0)#将性别进行哑变量处理，首先将非空的女性赋值为1，NA或者男赋值为0
> teens$no_gender<-ifelse(is.na(teens$gender),1,0)#性别缺失为1，否则为0，这样的话相当于把男女哑变量处理，同时缺失也纳入考量
> teens$gender<-NULL
年龄处理：高中生不可能106岁，也不可能有3岁，同时存在较多缺失
> summary(teens$age) Min. 1st Qu. Median Mean 3rd Qu. Max. NA‘s 3.086 16.310 17.290 17.990 18.260 106.900 5086
> teens$age <- ifelse(teens$age >= 16 & teens$age < 20,teens$age,NA)#将16-20岁视为高中生的正常年龄，其他数据视为异常值为空 > aggregate(data=http://www.mamicode.com/teens,age~gradyear,mean,na.rm=TRUE)#求不同毕业年份的年龄均值，越最近毕业的人越年轻 gradyear age 1 2006 18.68560 2 2007 17.71878 3 2008 16.78118 4 2009 16.33252
# 按年份生成与原数据集合等长的向量
> ave_age <- ave(teens$age, teens$gradyear, FUN = function(x) { return(mean(x, na.rm = TRUE)) })
> teens$age <- ifelse(is.na(teens$age), ave_age, teens$age)#将NA的年龄赋值为均值，非空的保持原值 > summary(teens$age) Min. 1st Qu. Median Mean 3rd Qu. Max. 16.00 16.33 17.25 17.38 18.22 20.00
数据划分
> interests <- teens[, 4:39]
> interests_z <- data.frame(lapply(interests, scale))#标准化数据，减少量纲差异
k均值建模
set.seed(11)#设定随机种子 teen_clusters <- kmeans(interests_z, 5)
评估模型
> head(teen_clusters$cluster)#聚类标签 [1] 2 1 2 2 5 2 > teen_clusters$size#5个类别的数量 [1] 5233 22182 731 803 1051 > teen_clusters$centers#聚类中心 basketball football soccer softball volleyball swimming cheerleading baseball 1 0.4531058 0.43339400 -0.05953070 0.375996747 0.40342075 0.30482805 0.46479149 0.24682651 2 -0.1290187 -0.12977694 -0.14899365 -0.097191693 -0.10066663 -0.09079804 -0.11397570 -0.06918139 3 0.2457823 0.23577386 5.02937767 0.033589676 0.09057228 0.13165120 -0.02646162 0.03223472 4 -0.1109113 0.03602234 -0.14104152 -0.007481003 -0.07966170 0.04595234 -0.12500102 -0.11042346 5 0.3807668 0.38961431 0.05069711 0.161530303 0.11384059 0.27191272 0.20520869 0.29309699 tennis sports cute sex sexy hot kissed dance 1 0.13565618 0.2229282 0.65570947 0.005138338 0.230127643 0.50391601 -0.02252810 0.55362283 2 -0.04152949 -0.1020853 -0.17622878 -0.094412671 -0.077760392 -0.13325067 -0.13207336 -0.15193168 3 0.11156263 0.3998271 0.01361179 -0.056096990 -0.008332101 0.06411155 -0.06295344 -0.02447142 4 0.01655266 -0.1041384 -0.04851623 -0.046718513 -0.019765548 -0.06929059 -0.06814111 0.02098573 5 0.11082240 0.8460723 0.48219547 2.041764818 0.516256470 0.31165437 2.99550632 0.45107250 band marching music rock god church jesus 1 -0.04813421 -0.12344684 0.26060636 0.18108418 0.3304953087 0.51972951 0.24097725 2 -0.12756333 -0.13513757 -0.13216778 -0.10905451 -0.1001591088 -0.13566360 -0.06601809 3 -0.04525084 -0.09376867 0.04330389 0.09518405 -0.0001367759 0.10922246 0.01664811 4 3.37541403 4.63879117 0.39528646 0.16181449 0.0735799460 0.03691392 0.07066919 5 0.38450719 -0.01216509 1.15977396 1.21019696 0.4122385221 0.17132449 0.12793743 bible hair dress blonde mall shopping clothes 1 0.22258000 0.325589087 0.444453842 0.04528480 0.64138010 0.85834274 0.51465115 2 -0.05930602 -0.198168525 -0.132551874 -0.02830573 -0.17908734 -0.22075867 -0.18246937 3 0.03613298 -0.004854472 0.005732568 0.03146825 0.03512586 0.21142729 -0.04501739 4 0.04788738 -0.041196192 0.049581302 -0.01631323 -0.09605527 -0.06611646 0.01252734 5 0.08173007 2.596190010 0.542753982 0.36251061 0.63523179 0.28896231 1.31038466 hollister abercrombie die death drunk drugs 1 0.57661846 0.557958327 0.043023482 0.12784283 0.01420576 -0.05433707 2 -0.15090261 -0.146583539 -0.089778750 -0.07512888 -0.08530937 -0.11084192 3 0.06677613 0.002922202 -0.003454604 -0.01723961 -0.04902532 -0.04029186 4 -0.15478823 -0.147391253 -0.013624100 0.02928218 -0.08311224 -0.08479959 5 0.38568876 0.426202832 1.693430840 0.93872106 1.82737429 2.70274859
将聚类标签赋值回原记录，在本博文SPSS实例中SPSS聚类之后的结果也会生成新列，便于针对目标类别进行进一步特征提取
> names(teens) [1] "gradyear" "age" "friends" "basketball" "football" "soccer" [7] "softball" "volleyball" "swimming" "cheerleading" "baseball" "tennis" [13] "sports" "cute" "sex" "sexy" "hot" "kissed" [19] "dance" "band" "marching" "music" "rock" "god" [25] "church" "jesus" "bible" "hair" "dress" "blonde" [31] "mall" "shopping" "clothes" "hollister" "abercrombie" "die" [37] "death" "drunk" "drugs" "no_gender" "female" > teens$cluster <- teen_clusters$cluster > teens[1:5, c("cluster", "female", "no_gender", "age", "friends")] cluster female no_gender age friends 1 2 0 0 18.982 7 2 1 1 0 18.801 0 3 2 0 0 18.335 69 4 2 1 0 18.875 0 5 5 0 1 18.995 10
特征查看
cluster female no_gender age friends 1 2 0 0 18.982 7 2 1 1 0 18.801 0 3 2 0 0 18.335 69 4 2 1 0 18.875 0 5 5 0 1 18.995 10 > aggregate(data = http://www.mamicode.com/teens, age ~ cluster, mean)#年龄区分度较小 cluster age 1 1 17.19971 2 2 17.43109 3 3 17.16270 4 4 17.47728 5 5 17.26249 > aggregate(data = http://www.mamicode.com/teens, female ~ cluster, mean) cluster female 1 1 0.8696732 2 2 0.6995312 3 3 0.7633379 4 4 0.7272727 5 5 0.8030447 > aggregate(data = http://www.mamicode.com/teens, friends ~ cluster, mean)# cluster friends 1 1 39.05828 2 2 27.78077 3 3 35.73735 4 4 32.95392 5 5 30.61180
优化模型，调整K
> set.seed(11) > teen_clusters <- kmeans(interests_z, 10) > teens$cluster <- teen_clusters$cluster
> table(teens$cluster) 1 2 3 4 5 6 7 8 9 10 424 540 1993 2478 680 519 856 1917 996 19597 > data.frame(aggregate(data = http://www.mamicode.com/teens, football ~ cluster, mean), aggregate(data = teens, friends ~ cluster, mean), aggregate(data = teens, basketball ~ cluster, mean)) cluster football cluster.1 friends cluster.2 basketball 1 1 0.2900943 1 35.01179 1 0.3584906 2 2 0.2611111 2 35.24815 2 0.3425926 3 3 0.2483693 3 33.29704 3 0.2498746 4 4 0.4293785 4 39.57143 4 0.3950767 5 5 0.3941176 5 35.54265 5 0.4235294 6 6 1.2215800 6 32.96532 6 0.9441233 7 7 0.5537383 7 30.65070 7 0.5911215 8 8 0.2008346 8 32.38341 8 0.2034429 9 9 0.4608434 9 40.26506 9 1.0923695 10 10 0.1799255 10 27.42195 10 0.1757412 > names(teens) [1] "gradyear" "age" "friends" "basketball" "football" "soccer" [7] "softball" "volleyball" "swimming" "cheerleading" "baseball" "tennis" [13] "sports" "cute" "sex" "sexy" "hot" "kissed" [19] "dance" "band" "marching" "music" "rock" "god" [25] "church" "jesus" "bible" "hair" "dress" "blonde" [31] "mall" "shopping" "clothes" "hollister" "abercrombie" "die" [37] "death" "drunk" "drugs" "female" "no_gender" "cluster" > data.frame(aggregate(data = http://www.mamicode.com/teens, soccer ~ cluster, mean), aggregate(data = teens, softball ~ cluster, mean), aggregate(data = teens, volleyball ~ cluster, mean)) cluster soccer cluster.1 softball cluster.2 volleyball 1 1 0.16273585 1 0.15094340 1 0.11556604 2 2 0.16851852 2 0.14629630 2 0.12407407 3 3 0.15805319 3 0.09081786 3 0.12995484 4 4 0.16384181 4 0.12227603 4 0.13841808 5 5 4.94264706 5 0.11764706 5 0.13823529 6 6 0.31791908 6 0.21965318 6 0.10789981 7 7 0.26752336 7 0.23481308 7 0.19742991 8 8 0.09911320 8 0.08242045 8 0.07563902 9 9 0.19076305 9 2.55522088 9 1.99899598 10 10 0.08506404 10 0.05669235 10 0.05720263
可以看到每个类中不同变量的均值情况，可以手动将相似的进行合并，例如1、2中交友数量这个角度1、2、5都很接近，而soccer角度1、2、4又很接近，可以将所有的变量的均值进行查看判断进行人工合并分类。
仅对聚类算法的使用做一个练习，有不妥之处望指教，学习体验是：学无止境......永远有不确定的地方，永远有不懂的东西......刺激又恐慌
在R中练习k-meas聚类
声明：以上内容来自用户投稿及互联网公开渠道收集整理发布，本网站不拥有所有权，未作人工编辑处理，也不承担相关法律责任，若内容有误或涉及侵权可进行投诉： 投诉/举报 工作人员会在5个工作日内联系你，一经查实，本站将立刻删除涉嫌侵权内容。