主成分分析：你为什么还是单身？

数据森麟

发布于 2019-09-28 21:27:17

5510

发布于 2019-09-28 21:27:17

文章被收录于专栏：数据森麟数据森麟

作者：herain R语言中文社区专栏作者

知乎ID：https://www.zhihu.com/people/herain-14

来源：R语言中文社区公众号

前言

问天问地不如问知乎：【主成分分析偏向统计技术，小白可以跳过】

天地不仁，以万物为刍狗，天地没有闲工夫关心的单身那件小事；所以答案在知乎，同是天涯沦落人，感谢知乎好心人。一起看看知友的回答吧。

本文纲目：

1.数据来源简述

2.数据的简单描述

2.1 亮眼高赞的回答
2.2 数据的总体描述
2.3 R制作关键词词频图

3.主成分分析实战

3.1 ，巧妙的数据转换
3.2，什么是主成分分析？
3.3，主成分分析步骤
3.4，R具体操作

4.寄托未来

1.数据来源简述

感谢知乎平台，感谢知友贡献，感谢Python：获取知乎【单身理由】，【单身的好处】，【为什么越来越多的人选择单身】三个搜索关键词的搜索数据。

数据获取流程图

 1#数据表结构
 2mysql> desc why_single;
 3+-----------+--------------+------+-----+---------+----------------+
 4| Field     | Type         | Null | Key | Default | Extra          |
 5+-----------+--------------+------+-----+---------+----------------+
 6| w_id      | int(20)      | NO   | PRI | NULL    | auto_increment |
 7| title     | varchar(100) | YES  |     | NULL    |                |
 8| content   | text         | YES  |     | NULL    |                |
 9| vote_num  | int(4)       | YES  |     | NULL    |                |
10| words     | varchar(500) | YES  |     | NULL    |                |
11| words_num | int(4)       | YES  |     | NULL    |                |
12+-----------+--------------+------+-----+---------+----------------+
13
14#单条数据： title题目，content文章内容，vote_num赞同数，words关键词,words_num关键词个数
15
16mysql> select * from why_single limit 1 \G;
17*************************** 1. row ***************************
18     w_id: 602
19    title: 纯属个人观点客观上来说，现在单身的挺多都是条件很好的。拿我一个朋友的姐姐举个栗子长相中等偏上，性格温
20  content: 纯属个人观点客观上来说，现在单身的挺多都是条件很好的。拿我一个朋友的姐姐举个栗子长相中等偏上，性格温柔，家庭条件一般可是人家自己努力呀，本科，研究生出来工作，月薪，后公司出钱出国培训，回来后升职加薪，工资。现在出头了，周围有人介绍过相亲，可是对方一听这条件都走了，有的觉得太女强人了，有的觉得自己薪水没她高难堪，有的觉得她看不上自己主动放弃。事实上，她是一旦你跨出第一步，即使之后的步都由她来走也无所谓这种女生，然而从未有人跨出这一步来。再者有部分是高不成低不就的，反正还年轻，也不急，诗酒趁年华嘛。也有将感情视为重大的抉择，希望慎重考虑这些也不在少数，比如我记几。希望谈一场不分手的恋爱，所以就会想得很多，哎我能承担两个人在一起后的责任吗？若有了孩子我能教育得好吗？再反过来审视自己，嗯还差得很远，算了再等等。总得来说。毕竟人生只有一次，要为自己而活。你若盛开，清风自来。
21 vote_num: 0
22    words: 条件,不急,月薪,一般,家庭,人家,温柔,公司,纯属,教育,重大,朋友,客观,孩子,姐姐,感情,个人观点,研究生,工作,性格,诗酒,年轻,努力,培训,对方,很好
23words_num: 26
24

2.数据的简单描述

2.1

亮眼的回答

亮眼的高赞回答

2.2

数据的总体描述

1#文章总数，赞同总数，关键词总数
2select count(1) as article_num, sum(vote_num) as vote_num , sum(words_num) from why_single;
3+-------------+----------+----------------+
4| article_num | vote_num | sum(words_num) |
5+-------------+----------+----------------+
6|         535 |   295044 |          11154 |
7+-------------+----------+----------------+
81 row in set (0.01 sec)

2.3

R制作关键词词频图

 1mysql> select words from why_single order by vote_num desc limit 2 \G;
 2*************************** 1. row ***************************
 3words: 女博士,博士,工作,干部,答友,妈呀,人生,干嘛,儿子,优秀,厅长,男人,情趣,经历,感情,正统,有点,背景,羊毛,清醒,氮气,分数,教育,头脑,家务,复杂,家庭,我会,围观,充满
 4*************************** 2. row ***************************
 5words: 问题,态度,女生,情绪,情感,生活,对方,阶段,用法,友善,爱意,块钱,故事,心情,方式,预测,道理,我会,丰富,干货,人生,束缚,女朋友,礼貌,人格,准则,男生,紧急,悬念,热烈
 6*************************** 3. row ***************************
 7words: 生活,北京,女人,经历,套路,婚姻,逻辑,同事,社会,质量,孩子,无法,男生,快乐,车房,合适,巨大,妻子,消费者,廊坊,全职,旅游,故事,问题,事业,不错,干嘛,评论,洗脑,个人
 8#R绘制词云图
 9> data1<-read.table('forzhihu/kws.csv',header=T, encoding='GB2312')
10> v <-data.frame(ftable(data1))
11> wordcloud(v$x,v$Freq,colors = rainbow(length(v$Freq)));

关键词高频词云

3.主成分分析实战

3.1

巧妙的数据转换

从上文环境中，可知我们有535篇文章，每个文章都有赞同数（用于加权），每个文章的关键词反映出对单身原因的看法，1篇文章对应多个关键词，是不是说明1篇文章反馈出多种单身的原因呢？基于词云我们可以将单身的原因进行聚类分析。量化每一篇文在聚类原因中的权重值，这也我们是不是将数据转化为 535 行，n类（聚类个数）的单身原因权重表呢？

关键词归为7大类：

社会环境：社会，世界，中国，乡镇，农村，交通，教育.... 
家庭因素：家，家庭，父母，子女，爸爸，妈妈，兄弟，姐妹....
生活态度：旅行，电影，美食，自己，生活，读书....
时间观念：青春，年轻，大龄，时间，自由，日子，理想....
爱情婚姻观：爱情，婚姻，幸福，颜值，三观，心动，喜欢....
工作压力：加班，双休，单位，公司，考勤，工作，绩效....
经济基础：事业，房子，车子，花钱，话费，房价，工资，月薪....

[对应词频*赞同率多词求和 = 因素重要程度值]生产数据表：选取赞同数>=100 的114篇文章，生产114行7列的二位数据表

 1mysql> select count(1) from why_single where vote_num>=100 \G;
 2*************************** 1. row ***************************
 3count(1): 114
 41 row in set (0.00 sec)
 5> read.table(pipe("pbpaste"),sep='\t',header=T)->data
 6> data
 7      x1  x2   x3  x4  x5   x6   x7
 81    793 517  211 728 900 1434  381
 92    526 225  428 728 728 1219  581
103    499 473  272 926 926  573 1354
114    172 414  940 175 175   62  234
125    709 387 1003 295 295 1229  755
136    928 409  160 877 877 1025 1496
147    970 671  677 407 407  490 1146
158    574 265  893 584 584 1187   79
16.......

3.2

什么是主成分分析？

主成分的概念由Karl Pearson在1901年提出

考察多个变量间相关性一种多元统计方法

研究如何通过少数几个主成分(principal component)来解释多个变量间的内部结构。即从原始变量中导出少数几个主分量，使它们尽可能多地保留原始变量的信息，且彼此间互不相关

主成分分析的目的：数据的压缩；数据的解释

常被用来寻找判断事物或现象的综合指标，并对综合指标所包含的信息进行适当的解释

3.3

主成分分析步骤

对原来的p个指标进行标准化，以消除变量在水平和量纲上的影响

根据标准化后的数据矩阵求出相关系数矩阵

求出协方差矩阵的特征根和特征向量

确定主成分，并对各主成分所包含的信息给予适当的解释

3.4

R具体操作

1：载入数据到R控制台

 1> read.table(pipe("pbpaste"),sep='\t',header=T)->data
 2> data
 3      x1  x2   x3  x4  x5   x6   x7
 41    793 517  211 728 900 1434  381
 52    526 225  428 728 728 1219  581
 63    499 473  272 926 926  573 1354
 74    172 414  940 175 175   62  234
 85    709 387 1003 295 295 1229  755
 96    928 409  160 877 877 1025 1496
107    970 671  677 407 407  490 1146
11.......

2：求出样本相关系数矩阵

 1> R<-round(cor(data),3)
 2> R
 3       x1     x2     x3     x4     x5    x6     x7
 4x1  1.000 -0.023 -0.047  0.050  0.055 0.007  0.056
 5x2 -0.023  1.000 -0.014 -0.113 -0.113 0.039 -0.005
 6x3 -0.047 -0.014  1.000 -0.007 -0.013 0.055 -0.029
 7x4  0.050 -0.113 -0.007  1.000  0.999 0.021 -0.055
 8x5  0.055 -0.113 -0.013  0.999  1.000 0.029 -0.058
 9x6  0.007  0.039  0.055  0.021  0.029 1.000  0.042
10x7  0.056 -0.005 -0.029 -0.055 -0.058 0.042  1.000
11
12> PCA=princomp(data,cor=T)
13> PCA
14Call:
15princomp(x = data, cor = T)
16
17Standard deviations:
18    Comp.1     Comp.2     Comp.3     Comp.4     Comp.5     Comp.6     Comp.7 
191.42659724 1.04377423 1.03044704 0.99731643 0.96457786 0.94186945 0.03695955 
20
21 7  variables and  114 observations.
22
23> summary(PCA,loadings=T)
24Importance of components:
25                         Comp.1    Comp.2    Comp.3    Comp.4    Comp.5    Comp.6       Comp.7
26Standard deviation     1.426597 1.0437742 1.0304470 0.9973164 0.9645779 0.9418695 0.0369595547
27Proportion of Variance 0.290740 0.1556378 0.1516887 0.1420914 0.1329158 0.1267312 0.0001951441
28Cumulative Proportion  0.290740 0.4463778 0.5980665 0.7401579 0.8730737 0.9998049 1.0000000000
29
30Loadings:
31   Comp.1 Comp.2 Comp.3 Comp.4 Comp.5 Comp.6 Comp.7
32x1         0.625  0.115         0.764              
33x2 -0.152         0.239 -0.830  0.113  0.457       
34x3        -0.537  0.380  0.484  0.308  0.488       
35x4  0.695                                     0.707
36x5  0.695                                    -0.707
37x6                0.793               -0.595       
38x7         0.553  0.393  0.222 -0.550  0.428

从输出的结果可以看出，主成分的标准差，即相关矩阵的七个特征值的开方：

前五项：0.290+0.155+0.151+0.142+0.126=0.864大于80%，构成主成分（需要校验）；

说明7大因素中：社会环境，家庭因素，生活态度，时间观念，爱情婚姻观构成了单身原因的主要成分；而，工作压力，经济基础这两张成分却居于次要位置。

人是社会的动物，社会环境左右着我们的主观意识，在潜移默化中影响我们人生的重大决策。

如下：通过主成分碎石图，可以直观的看着7个因素的影响成分大小：

 1#预估成分影响
 2> round(predict(PCA),3)
 3       Comp.1 Comp.2 Comp.3 Comp.4 Comp.5 Comp.6 Comp.7
 4  [1,]  1.401  0.705  0.607 -0.946  0.590 -1.650 -0.382
 5  [2,]  1.049  0.188  0.264  0.403 -0.209 -1.391  0.015
 6  [3,]  1.672  1.372 -0.207 -0.162 -1.332  0.554  0.004
 7  [4,] -1.746 -1.633 -1.689  0.901  0.136  0.655 -0.015
 8  [5,] -1.062 -0.196  1.254  1.143  0.812 -0.298  0.003
 9  [6,]  1.588  2.572  0.735 -0.038 -0.559 -0.195  0.015
10  [7,] -0.731  1.407  0.188  0.155  0.776  1.199 -0.001
11  [8,]  0.428 -1.119  0.339  0.833  1.056 -1.123  0.010
12  [9,]  1.058 -0.624 -1.645  0.909 -0.389 -0.897  0.003
13
14#画碎石图
15> screeplot(PCA, type='lines')

主成分碎石图

 1> PCA$scores #可计算主成分得分
 2            Comp.1      Comp.2       Comp.3      Comp.4       Comp.5      Comp.6        Comp.7
 3  [1,]  1.40056690  0.70517326  0.606696840 -0.94638853  0.589941685 -1.65041421 -3.821126e-01
 4  [2,]  1.04900803  0.18822092  0.264318975  0.40340326 -0.208947445 -1.39094323  1.453613e-02
 5  [3,]  1.67243670  1.37248483 -0.206803150 -0.16197874 -1.331755444  0.55412967  4.289578e-03
 6  [4,] -1.74644756 -1.63308359 -1.688867556  0.90089657  0.136496255  0.65475617 -1.505974e-02
 7  [5,] -1.06222511 -0.19584553  1.253599410  1.14341654  0.811554283 -0.29819077  3.002552e-03
 8  [6,]  1.58829651  2.57186495  0.735027870 -0.03833332 -0.558572926 -0.19522828  1.509744e-02
 9  [7,] -0.73148282  1.40740690  0.188022616  0.15503755  0.775989636  1.19936396 -1.329158e-03
10  [8,]  0.42828896 -1.11856447  0.338679544  0.83288277  1.056283875 -1.12349627  9.765501e-03
11  [9,]  1.05783957 -0.62446493 -1.645173343  0.90942155 -0.388630187 -0.89748195  3.366658e-03
12 [10,] -0.59822192 -0.21181364  2.307340901  1.48071324 -0.487337546  0.24474231 -1.442962e-03
13 [11,] -0.82908479  1.25097668  0.535623214 -1.56504778  0.317734183 -0.34005001  1.382917e-02
14
15> load<-loadings(PCA)
16> plot(load[,1:2],xlim=c(-0.6,0.6),ylim=c(-0.6,0.6))
17> text(load[,1],load[,2],adj=c(0.5,-0.5))
18> abline(h=0);abline(v=0);