Chinaunix首页 | 论坛 | 博客
  • 博客访问: 2391
  • 博文数量: 1
  • 博客积分: 0
  • 博客等级: 民兵
  • 技术积分: 25
  • 用 户 组: 普通用户
  • 注册时间: 2019-08-08 17:33
文章分类

全部博文(1)

文章存档

2019年(1)

我的朋友
最近访客

分类: 大数据

2019-08-09 10:32:39

漫画PCA分析



一、数据处理


要分析的数据来源于一张excel表。经观察分析,这张表有以下特点:

1、最后一行是个多余行;

2、“人气”列是数字加“万”字构成;

3、“话题数”、“累计打赏”、“今日打赏数”等列有非数字值或空值;

4、“漫画名称”列有重复,有些是名称和作者都相同,有些是不同作者的相同名称的作品;


因此,需要对原始数据进行处理,我选择的包是readxl

R code:

install.packages("readxl")

首先,导入excel数据(我的excel表放路径为D:\R\漫画.xlsx):

R code:

library(readxl)

origin <- read_excel("D:\\R\\漫画.xlsx", trim_ws=T, n_max=1713, col_types = c("text","text","text","text","numeric","numeric","text","numeric","numeric","numeric","text","guess","numeric","numeric","numeric","numeric","numeric","numeric","numeric","numeric"))

其次,处理“人气”列:

R code:

origin$人气 <- as.numeric(gsub("", "0000", origin$人气))

然后,选取有效数据,并去除漫画名称+作者都相同的行:

R code:

fr <- data.frame(origin[1], origin[3], origin[5:10], origin[13:14], origin[19:20], origin[4])

fr <- fr[!duplicated(fr[1:2]),]

之后,给作者不同但漫画名称相同的数据赋予不同的漫画名称:

R code:

fr[duplicated(fr[1]),1] <- paste(fr[duplicated(fr[1]),1],"2")

最后,设置行名称并去掉NA值:

R code:

row.names(fr)=fr[,1]

fr[is.na(fr)] <- 0


二、PCA计算及特征值分析

首先,在PCA分析之前需要将数据标准化,即xi?mean(x)/sd(x)R语言的PCA函数一般都自带数据标准化功能,所以不需要自己手工处理。

这里我调用的是PCA函数:

R code:

fr.active <- fr[3:12]

library("FactoMineR")

res.pca <- PCA(fr.active, scale.unit = TRUE, graph = F)



下面,检查特征值以确定要考虑的主成分数量。

R code:

library("factoextra")

eig.val <- get_eigenvalue(res.pca)

eig.val是这样一张表:

      eigenvalue variance.percent cumulative.variance.percent

Dim.1  5.28225236       52.8225236                    52.82252

Dim.2  1.36873525       13.6873525                    66.50988

Dim.3  1.04034679       10.4034679                    76.91334

Dim.4  0.76420624        7.6420624                    84.55541

Dim.5  0.57861584        5.7861584                    90.34156

Dim.6  0.32639774        3.2639774                    93.60554

Dim.7  0.27760653        2.7760653                    96.38161

Dim.8  0.19712376        1.9712376                    98.35285

Dim.9  0.09733676        0.9733676                    99.32621

Dim.10 0.06737872        0.6737872                   100.00000


每个特征值解释的变化比例在上表第二列中给出。解释的累积百分比,即第三列是通过将所解释的变化的连续比例相加以获得运行总计来获得的。可见,前三项的特征值大于1,而且累计解释比例已达到76.9%,是个可接受的大比例了。在本分析中,我们认为前三个主成分是足够的。

确定主成分数量的另一种方法是查看Scree Plot,它是从最大到最小排序的特征值图。

R code:

fviz_eig(res.pca, addlabels = TRUE)

 

从图中可见明显的拐点。


三、变量分析

提取变量:

R code:

var <- get_pca_var(res.pca)

通过var$coord可以得出变量的坐标:

                           Dim.1       Dim.2      Dim.3       Dim.4       Dim.5

评分                  0.14504324 -0.65942446 -0.3425518  0.64909673  0.05983225

评分人数              0.90490818  0.24085647 -0.2270857  0.06384066  0.03587817

人气                  0.87250774 -0.02218187  0.0434355  0.04202673 -0.25411353

收藏数                0.85272910 -0.27026410  0.2323292 -0.04391026 -0.17712932

好票                  0.74881709  0.41131323 -0.3975698  0.04973863  0.12347331

黑票                  0.73507799  0.40811946 -0.2567772  0.03413473  0.18441070

话题数                0.86898726 -0.21466541  0.2539299 -0.06126312 -0.14311966

累计打赏              0.86238216 -0.06427954  0.1441258 -0.04509377 -0.15636620

单次得到打赏最高数额  0.59173004 -0.34567500  0.3375211 -0.14698821  0.61779233

作者作品数           -0.06234063  0.54488871  0.6264218  0.55143307  0.04411640


通过var$contrib可得出变量的贡献:

                           Dim.1       Dim.2      Dim.3      Dim.4      Dim.5

评分                  0.39826841 31.76952028 11.2790982 55.1325727  0.6187004

评分人数             15.50207675  4.23835344  4.9568018  0.5333155  0.2224694

人气                 14.41184006  0.03594816  0.1813475  0.2311217 11.1600271

收藏数               13.76584950  5.33650909  5.1883524  0.2523024  5.4223878

好票                 10.61530188 12.36021156 15.1931801  0.3237257  2.6348500

黑票                 10.22934173 12.16900734  6.3377446  0.1524693  5.8773547

话题数               14.29577400  3.36670195  6.1979694  0.4911201  3.5400409

累计打赏             14.07927802  0.30187429  1.9966666  0.2660863  4.2256689

单次得到打赏最高数额  6.62869584  8.73004509 10.9502415  2.8271861 65.9621365

作者作品数            0.07357381 21.69182880 37.7185979 39.7901002  0.3363643


可以画一个关系圈图形:

R code:

fviz_pca_var(res.pca)

 

在关系圈上加上贡献度的颜色:

R code:

fviz_pca_var(res.pca, col.var = "contrib", gradient.cols = c("green", "blue", "red"))

 

可见,评分人数、收藏数、话题数更趋近圆圈且颜色趋于红色,具备良好的表示。评分和作者作品数是相对的,呈现负相关关系。

下面,进一步观察变量对主成分的贡献:

第一主成分:

R code:

fviz_contrib(res.pca, choice = "var", axes = 1, top = 10)

 

第二主成分:

R code:

fviz_contrib(res.pca, choice = "var", axes = 2, top = 10)

 

第三主成分:

R code:

fviz_contrib(res.pca, choice = "var", axes = 3, top = 10)

 

由此可见,第一主成分与评分人数、人气、话题数、累计打赏、收藏数有很大的正相关关系,因此该部分主要衡量的是漫画的火热程度。第二主成分与评分有很大的相关关系,因此该部分主要衡量的是漫画的评价。第三主成分与作者作品数有很大的相关关系,因此该部分主要衡量的是作者的产出程度。


四、个体分析

提取个体信息:

R code:

ind <- get_pca_ind(res.pca)

类似于变量分析,也可以查看坐标:

R code:

head(ind$coord, 20)

                                 Dim.1       Dim.2       Dim.3       Dim.4       Dim.5

火影忍者                     15.703775 -0.15260505   0.9157721  1.80424066 -5.45376319

尸兄(我叫白小飞)           49.505306 20.26742784 -18.5185968  3.72477443  5.28046421

海贼王/航海王                13.800529  1.03628295  -0.9545084  2.14283526 -4.00187878

妖怪名单                     27.994483 -3.34223413   4.6512021 -0.86789120 -6.82876018

中国惊奇先生                 26.209129  2.47086254  -1.4026582  0.05612973 -0.91231199

狐妖小红娘                   23.997306 -2.43800991   3.8512758 -0.61664679 -4.06631681

王牌御史                     21.454015 -3.97112032   4.6135486 -1.03327587 -4.06077511

死神/境·界                    6.355510 -0.64211629   0.3791436  1.69280734 -3.19429618

斗破苍穹                     22.763770  1.80172024   1.1098332 -0.40859805  0.58935065

一人之下                     13.265945 -4.34797747   4.7288114 -1.01613293 -1.90666809

银之守墓人                   11.122643 -4.21761061   4.0564674 -0.86729807 -1.00280565

从前有座灵剑山               11.423870 -2.72407594   2.8150461 -0.63548099 -0.17421731

妖精种植手册                 11.386147 -4.54579442   4.4551326 -1.04549114 -1.12695647

通职者                        7.979733 -1.97815843   1.6741200 -0.09576681 -3.48720435

偷星九月天                    5.203160  0.05577831   0.4154013  0.45784300 -1.55823012

罗刹大人请留步                6.703990 -2.56950107   1.9134348 -0.14788972 -2.30044848

灵契                         17.363979 -5.07121423   6.6000628 -2.03119632 -3.95767328

妖神记                       11.290169 -3.71206130   3.7141885 -0.70693574 -2.95717362

通灵妃                        4.169304 -1.85097903   1.3497245 -0.13685945 -2.74473521

我的双修道侣(我的天劫女友) 11.590207 -3.39868423   3.9348743 -1.36517399 -0.06083572



查看贡献:

R code:

head(ind$contrib, 20)

                                  Dim.1        Dim.2        Dim.3        Dim.4        Dim.5

火影忍者                      2.7365915 9.973310e-04  0.047251727 0.2496889511 3.0131670587

尸兄(我叫白小飞)           27.1960182 1.759133e+01 19.322307716 1.0641683687 2.8247164854

海贼王/航海王                 2.1134564 4.598945e-02  0.051333677 0.3521988712 1.6224021628

妖怪名单                      8.6965446 4.783825e-01  1.218914529 0.0577751344 4.7240488469

中国惊奇先生                  7.6226680 2.614560e-01  0.110852766 0.0002416552 0.0843174412

狐妖小红娘                    6.3903818 2.545496e-01  0.835703222 0.0291664342 1.6750704618

王牌御史                      5.1076248 6.753480e-01  1.199259137 0.0818922810 1.6705079022

死神/境·界                    0.4482318 1.765749e-02  0.008099351 0.2197988715 1.0336678828

斗破苍穹                      5.7502958 1.390197e-01  0.069399808 0.0128056897 0.0351866718

一人之下                      1.9528919 8.096104e-01  1.259931169 0.0791974950 0.3682823047

银之守墓人                    1.3728334 7.617886e-01  0.927126110 0.0576961922 0.1018741982

从前有座灵剑山                1.4481994 3.177898e-01  0.446492197 0.0309752995 0.0030747746

妖精种植手册                  1.4386509 8.849548e-01  1.118314901 0.0838399683 0.1286604128

通职者                        0.7066080 1.675806e-01  0.157912322 0.0007034616 1.2319283605

偷星九月天                    0.3004251 1.332393e-04  0.009722512 0.0160784267 0.2459766298

罗刹大人请留步                0.4987335 2.827477e-01  0.206286203 0.0016775920 0.5361121891

灵契                          3.3458028 1.101350e+00  2.454363994 0.3164566274 1.5867574065

妖神记                        1.4144991 5.901084e-01  0.777267877 0.0383327758 0.8858991872

通灵妃                        0.1928985 1.467251e-01  0.102643885 0.0014366797 0.7631880543

我的双修道侣(我的天劫女友)  1.4906792 4.946786e-01  0.872377715 0.1429507390 0.0003749281


下面画出个体的贡献度图:

R code:

fviz_pca_ind(res.pca, col.ind = "cos2", gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"))

 

个体数量太多,这个图不是很明显,下面我们把名称去掉再看一下:

R code:

fviz_pca_ind(res.pca, col.ind = "cos2", gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"), label="none")

 

这样就明显多了。

下面我们更进一步的来看个体对主成分的贡献:

我们来选取对第一主成分的贡献个体,因为数量太多,所以我们选择前十个来展示:

R code:

fviz_contrib(res.pca, choice = "ind", axes = 1, top=10)


 

我们再来看对前三维主成分的贡献排名前十名的个体有哪些:

R code:

fviz_contrib(res.pca, choice = "ind", axes = 1:3, top=10)

 

他们是:尸兄(我叫白小飞)、妖怪名单、中国惊奇先生、狐妖小红娘、斗破苍穹、王牌御史、灵契、火影忍者、一人之下、斗罗大陆。相应的,可以把他们放在本站显著位置进行宣传。也可根据这种分析方法,相应的得出比如前50的个体,进行不同等级的宣传。


五、组群分析

在源数据表中,“合约关系”列可以当作分组依据,我们来据此看看分组情况。

R code:

fviz_pca_ind(res.pca, label="none", habillage=as.factor(fr$合约关系), addEllipses=TRUE)

 

从图中可见,签约作者、合作伙伴、普通作者并没有形成特别明显的群落。但是普通作者和合作伙伴的数量多且特性更趋于集中,而签约作者数量少且趋于分散。这样,对于本站来说,就需要进一步分析签约作者的分散性,通过解约签约或者上架下架的方式来使本站的收益最大化。





附件——本文用到的代码:

excel表《漫画.xlsx》地址:https://github.com/beforeicer/blog/blob/master/%E4%BD%BF%E7%94%A8R%E5%AF%B9%E6%BC%AB%E7%94%BB%E8%BF%9B%E8%A1%8CPCA%E5%88%86%E6%9E%90/%E6%BC%AB%E7%94%BB.xlsx

# install required packages first:

# Here, I commented the install instructions:

# install.packages("readxl")

# install.packages("factoextra")



# --preprocess data from excel begin--

library(readxl)

origin <- read_excel("D:\\R\\漫画.xlsx", trim_ws=T, n_max=1713, col_types = c("text","text","text","text","numeric","numeric","text","numeric","numeric","numeric","text","guess","numeric","numeric","numeric","numeric","numeric","numeric","numeric","numeric"))

origin$人气 <- as.numeric(gsub("", "0000", origin$人气))

fr <- data.frame(origin[1], origin[3], origin[5:10], origin[13:14], origin[19:20], origin[4])

fr <- fr[!duplicated(fr[1:2]),]

fr[duplicated(fr[1]),1] <- paste(fr[duplicated(fr[1]),1],"2")

row.names(fr)=fr[,1]

fr[is.na(fr)] <- 0

# --preprocess data from excel end--


# --PCA begin--

# --eig--

fr.active <- fr[3:12]

library("FactoMineR")

res.pca <- PCA(fr.active, scale.unit = TRUE, graph = F)

library("factoextra")

eig.val <- get_eigenvalue(res.pca)

fviz_eig(res.pca, addlabels = TRUE)


# --variable--

var <- get_pca_var(res.pca)

fviz_pca_var(res.pca)

fviz_pca_var(res.pca, col.var = "contrib", gradient.cols = c("green", "blue", "red"))

fviz_contrib(res.pca, choice = "var", axes = 1, top = 10)

fviz_contrib(res.pca, choice = "var", axes = 2, top = 10)

fviz_contrib(res.pca, choice = "var", axes = 3, top = 10)


# --individual--

ind <- get_pca_ind(res.pca)

fviz_pca_ind(res.pca, col.ind = "cos2", gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"))

fviz_pca_ind(res.pca, col.ind = "cos2", gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"), label="none")

fviz_contrib(res.pca, choice = "ind", axes = 1, top=10)

fviz_contrib(res.pca, choice = "ind", axes = 1:3, top=10)


# --groups--

fviz_pca_ind(res.pca, label="none", habillage=as.factor(fr$合约关系), addEllipses=TRUE)

阅读(2011) | 评论(0) | 转发(0) |
0

上一篇:没有了

下一篇:没有了

给主人留下些什么吧!~~