关注微信公共号：小程在线

关注CSDN博客：程志伟的博客

详细内容为 《R语言游戏数据分析与挖掘》第五章学习笔记之数据清洗

5.2.1 缺失值处理 

5.2.2 异常值处理：

setwd('H:\\程志伟\\R语言游戏数据分析与挖掘\\Game_DataMining_With_R-master\\data\\第5章\\')

5.2.1 缺失值处理
> # 导入玩家的玩牌游戏数据
> player <- read.csv("H:\\程志伟\\R语言游戏数据分析与挖掘\\Game_DataMining_With_R-master\\data\\第5章\\玩家玩牌数据.csv",na.strings = "NA")
> # 查看变量名
> colnames(player)
 [1] "用户id"     "性别"       "等级"       "站内好友"   "经验值"     "积分"      
 [7] "登陆总次数" "玩牌局数"   "赢牌局数"   "身上货币量"
> # 查看前六行
> head(player)
   用户id 性别 等级 站内好友 经验值 积分 登陆总次数 玩牌局数 赢牌局数 身上货币量
1 7795915    0    2        3     36    0          2        3        1       1000
2 7795912    0    3        2     83    0          2        8        1        800
3 7795909    1    0        0      0    5          3       NA       NA        800
4 7795906    0    0        0      0    0          1       NA       NA          0
5 7795900    0    0        3      0    0          2       NA       NA        800
6 7795898    0    2        1     10    0          2       NA       NA        760
 

# 利用is.na函数判断“玩牌局数”变量各值是否为缺失值
> is.na(player$玩牌局数)
   [1] FALSE FALSE  TRUE  TRUE  TRUE  TRUE  TRUE FALSE FALSE FALSE  TRUE FALSE FALSE
  [14] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE  TRUE FALSE FALSE FALSE FALSE
  ......
 [989] FALSE FALSE FALSE FALSE  TRUE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
 [ reached getOption("max.print") -- omitted 5240 entries ]
 

# 统计缺失值与非缺失值的个数
> table(is.na(player$玩牌局数))

FALSE  TRUE 
 3094  3146 
> # sum()和mean()函数来统计缺失值的个数和占比
> # 计算缺失值个数
> sum(is.na(player$玩牌局数))
[1] 3146
> # 计算缺失值占比
> mean(is.na(player$玩牌局数))
[1] 0.5041667

> # 利用complete.cases函数查看完整实例
> sum(complete.cases(player))
[1] 2000
> library('mice')

载入程辑包：‘mice’

The following objects are masked from ‘package:base’:

    cbind, rbind

Warning message:
程辑包‘mice’是用R版本3.6.3 来建造的 
> md.pattern(player)
     用户id 性别 等级 站内好友 经验值 积分 登陆总次数 身上货币量 玩牌局数 赢牌局数     
2000      1    1    1        1      1    1          1          1        1        1    0
1094      1    1    1        1      1    1          1          1        1        0    1
3146      1    1    1        1      1    1          1          1        0        0    2
          0    0    0        0      0    0          0          0     3146     4240 7386

 

# 用aggr函数对player数据的缺失值模式进行可视化
> library('VIM')
> aggr(player[,-1],prop=FALSE,numbers=TRUE)

 

# 删除缺失样本
> player_full <- na.omit(player)
 

# 计算有缺失值的样本个数
> sum(!complete.cases(player_full))
[1] 0

# 替换缺失值
> iris1 <- iris[,c(1,5)]
> # 将40、80、120号样本的Sepal.Length变量值设置为缺失值
> iris1[c(40,80,120),1] <- NA

# 利用均值替换缺失值
> iris1[c(40,80,120),1] <- round(mean(iris1$Sepal.Length,na.rm = T),1)

# 查看以前的值和现在的值
> iris[c(40,80,120),1];iris1[c(40,80,120),1]
[1] 5.1 5.7 6.0
[1] 5.8 5.8 5.8
> # 绘制箱线图
> plot(iris$Sepal.Length~iris$Species,col=heat.colors(3))

# 对缺失值进行赋值
# 利用决策树对性别变量的缺失值进行赋值
> # 导入玩家调研数据
> questionnaire <- read.csv("问卷调研数据.csv",T)
> # 查看问卷调研数据的行数和变量个数
> dim(questionnaire)
[1] 292743      9
> # 对缺失值进行可视化展示
> library(VIM)
> aggr(questionnaire[,-1],prop=FALSE,numbers=TRUE)
> # 把变量转换成因子型
> str(questionnaire)
'data.frame':    292743 obs. of  9 variables:
 $ 总序号      : int  1 2 3 4 5 6 7 8 9 10 ...
 $ 性别        : int  1 2 2 1 1 1 1 1 2 1 ...
 $ 年龄        : int  5 2 1 2 3 4 3 1 2 4 ...
 $ 职业        : int  4 1 1 1 5 5 1 1 1 2 ...
 $ 学历        : int  3 3 2 5 3 4 5 1 5 4 ...
 $ 收入        : int  4 1 1 1 2 4 1 2 1 2 ...
 $ 玩家游戏情况: int  2 2 4 4 2 4 4 4 4 4 ...
 $ 游戏进入    : int  3 1 1 2 3 2 2 2 1 3 ...
 $ 游戏偏好    : int  3 3 5 4 5 3 1 2 3 4 ...
> for(i in 2:ncol(questionnaire)){
+   questionnaire[,i] <- as.factor(questionnaire[,i])
+ }
> str(questionnaire)
'data.frame':    292743 obs. of  9 variables:
 $ 总序号      : int  1 2 3 4 5 6 7 8 9 10 ...
 $ 性别        : Factor w/ 2 levels "1","2": 1 2 2 1 1 1 1 1 2 1 ...
 $ 年龄        : Factor w/ 5 levels "1","2","3","4",..: 5 2 1 2 3 4 3 1 2 4 ...
 $ 职业        : Factor w/ 7 levels "1","2","3","4",..: 4 1 1 1 5 5 1 1 1 2 ...
 $ 学历        : Factor w/ 5 levels "1","2","3","4",..: 3 3 2 5 3 4 5 1 5 4 ...
 $ 收入        : Factor w/ 5 levels "1","2","3","4",..: 4 1 1 1 2 4 1 2 1 2 ...
 $ 玩家游戏情况: Factor w/ 4 levels "1","2","3","4": 2 2 4 4 2 4 4 4 4 4 ...
 $ 游戏进入    : Factor w/ 5 levels "1","2","3","4",..: 3 1 1 2 3 2 2 2 1 3 ...
 $ 游戏偏好    : Factor w/ 6 levels "1","2","3","4",..: 3 3 5 4 5 3 1 2 3 4 ...

# 对数据进行分区
> train <- na.omit(questionnaire[,c("性别","职业" ,"学历","玩家游戏情况","游戏进入","游戏偏好")])
> test <- questionnaire[is.na(questionnaire$性别),c("职业" ,"学历","玩家游戏情况","游戏进入","游戏偏好")]

# 建立logit回归模型
> fit <- glm(性别~.,train,family = "binomial")

# 由于拟合结果是给每个观测值一个概率值，下面以0.5作为分类界限：
> result <- predict(fit,test,type = "response")<0.5

# 把预测结果转换成原先的值(1或2)
> z=rep(1,nrow(test));z[!result]=2

# 在test集中增加预测的性别变量值
> test_new <- cbind('性别'=z,test)

# 查看前六行数据
> head(test_new)
   性别 职业 学历 玩家游戏情况 游戏进入 游戏偏好
32    2    1    1            2        1        3
33    1    5    3            2        3        6
37    2    2    4            1        1        3
54    2    1    4            1        1        3
66    2    1    2            1        1        1
77    1    4    4            4        3        2

 

> # 导入数据
> questionnaire <- read.csv("问卷调研数据.csv",T)

# 把变量转换成因子型
> str(questionnaire)
'data.frame':    292743 obs. of  9 variables:
 $ 总序号      : int  1 2 3 4 5 6 7 8 9 10 ...
 $ 性别        : int  1 2 2 1 1 1 1 1 2 1 ...
 $ 年龄        : int  5 2 1 2 3 4 3 1 2 4 ...
 $ 职业        : int  4 1 1 1 5 5 1 1 1 2 ...
 $ 学历        : int  3 3 2 5 3 4 5 1 5 4 ...
 $ 收入        : int  4 1 1 1 2 4 1 2 1 2 ...
 $ 玩家游戏情况: int  2 2 4 4 2 4 4 4 4 4 ...
 $ 游戏进入    : int  3 1 1 2 3 2 2 2 1 3 ...
 $ 游戏偏好    : int  3 3 5 4 5 3 1 2 3 4 ...
> for(i in 2:ncol(questionnaire)){
+   questionnaire[,i] <- as.factor(questionnaire[,i])
+ }
> # 取前10000行样本进行演示
> test <- questionnaire[1:10000,]
> library(mice)
> md.pattern(test)
     总序号 职业 学历 玩家游戏情况 游戏进入 游戏偏好 年龄 收入 性别     
8584      1    1    1            1        1        1    1    1    1    0
605       1    1    1            1        1        1    1    1    0    1
432       1    1    1            1        1        1    1    0    1    1
36        1    1    1            1        1        1    1    0    0    2
309       1    1    1            1        1        1    0    1    1    1
17        1    1    1            1        1        1    0    1    0    2
16        1    1    1            1        1        1    0    0    1    2
1         1    1    1            1        1        1    0    0    0    3
          0    0    0            0        0        0  343  485  659 1487
> install.packages("missForest")
 

# 利用missForest进行缺失值赋值
> #install.packages("missForest")
> library("missForest")
> z <- missForest(test)
  missForest iteration 1 in progress...done!
  missForest iteration 2 in progress...done!
  missForest iteration 3 in progress...done!
  missForest iteration 4 in progress...done!
> test.full <- z$ximp
> md.pattern(test.full)
 /\     /\
{  `---'  }
{  O   O  }
==>  V <==  No need for mice. This data set is completely observed.
 \  \|/  /
  `-----'

      总序号 性别 年龄 职业 学历 收入 玩家游戏情况 游戏进入 游戏偏好  
10000      1    1    1    1    1    1            1        1        1 0
           0    0    0    0    0    0            0        0        0 0

 

 

5.2.2异常值判断

# 绘制质量控制图
> set.seed(1234)
> data <- rnorm(20)
> plot(data,type = "l",lwd=1.5,xlab = NA,ylab = NA,
+      ylim = c(-4,4),xlim = c(0,23),main="质量控制图")
> lines(rep(mean(data),20),lwd=1.8);text(21,mean(data),"均值线")
> lines(rep(mean(data)-3*sd(data),20),lty=2,col="red",lwd=1.8)
> text(21,mean(data)-3*sd(data),labels = "控制下限",col="red")
> lines(rep(mean(data)+3*sd(data),20),lty=2,col="red",lwd=1.8)
> text(21,mean(data)+3*sd(data),labels = "控制上限",col="red")

> dailydata <- read.csv("每日付费及留存数据.csv",T)
> # 查看前六行
> head(dailydata)
    日期 新增用户 七日留存率
1 6月1日    95648     0.0753
2 6月2日    72093     0.0881
3 6月3日    84027     0.0892
4 6月4日   130968     0.0749
5 6月5日   129277     0.0579
6 6月6日    79603     0.0497
> # 查看前六行
> head(dailydata)
    日期 新增用户 七日留存率
1 6月1日    95648     0.0753
2 6月2日    72093     0.0881
3 6月3日    84027     0.0892
4 6月4日   130968     0.0749
5 6月5日   129277     0.0579
6 6月6日    79603     0.0497

# 绘制付费率的单值-均值质量控制图
> library(qcc)
Error in library(qcc) : 不存在叫‘qcc’这个名字的程辑包

# 绘制付费率的单值-均值质量控制图

> library(qcc)
  __ _  ___ ___ 
 / _  |/ __/ __|  Quality Control Charts and 
| (_| | (_| (__   Statistical Process Control
 \__  |\___\___|
    |_|           version 2.7
Type 'citation("qcc")' for citing this R package in publications.
Warning message:
程辑包‘qcc’是用R版本3.6.3 来建造的 
> attach(dailydata)
> qcc(七日留存率,type="xbar.one",labels= 日期,
+          title="新增用户第7日留存率的单值-均值质量监控图",
+          xlab="date",ylab="第七日留存率")
List of 11
 $ call      : language qcc(data = 七日留存率, type = "xbar.one", labels = 日期, title = "新增用户第7日留存率的单值-均值质量监控图",     | __truncated__
 $ type      : chr "xbar.one"
 $ data.name : chr "七日留存率"
 $ data      : num [1:30, 1] 0.0753 0.0881 0.0892 0.0749 0.0579 0.0497 0.0696 0.0628 0.055 0.0691 ...
  ..- attr(*, "dimnames")=List of 2
 $ statistics: Named num [1:30] 0.0753 0.0881 0.0892 0.0749 0.0579 0.0497 0.0696 0.0628 0.055 0.0691 ...
  ..- attr(*, "names")= chr [1:30] "6月1日" "6月2日" "6月3日" "6月4日" ...
 $ sizes     : int [1:30] 1 1 1 1 1 1 1 1 1 1 ...
 $ center    : num 0.076
 $ std.dev   : num 0.00454
 $ nsigmas   : num 3
 $ limits    : num [1, 1:2] 0.0624 0.0896
  ..- attr(*, "dimnames")=List of 2
 $ violations:List of 2
 - attr(*, "class")= chr "qcc"

> # 通过boxplot.stat()函数识别异常值
> boxplot.stats(七日留存率)
$stats
[1] 0.0628 0.0730 0.0789 0.0815 0.0894

$n
[1] 30

$conf
[1] 0.07644803 0.08135197

$out
[1] 0.0579 0.0497 0.0550

> # 查找异常值的下标
> idx <- which(七日留存率 %in% boxplot.stats(七日留存率)$out)
> # 查看异常值的下标集
> idx
[1] 5 6 9
> # 绘制箱线图
> boxplot(七日留存率,col='violet')
> # 通过text函数把异常值的日期和数值在图上显示
> text(1.1,boxplot.stats(七日留存率)$out,
+      labels=paste(dailydata[idx,'日期'],dailydata[idx,'七日留存率']),
+      col="darkgreen")

 # 通过聚类进行异常检测
> # 导入棋牌游戏玩家的样本数据
> w <- read.csv("玩家玩牌数据样本.csv",T)
> # 查看数据对象w的前六行
> head(w)
   用户id   免费筹码 身上货币量   最高拥有  最大赢取  贡献台费 登录总次数
1 7793439 2100219025     403237  151268700  11264000  10321990          4
2 7793414       8000      20000    2774724    939132   1043120          4
3 7793253  303023394     532722  131950000  10280000  11020155          5
4 7793114      50606      10605    7211504   2040000   1792750          5
5 7793052       4000      54000 1529464150 248700000 194001720          5
6 7793039    8043211     236456     392813    160528     36960          5
  站内好友数 经验值 玩牌局数 赢牌局数 输牌局数 正常牌局 非正常牌局 最高牌类型
1          1   4023     1792      270     1522     2030         10          8
2          0   1010      289       79      210      285          4          8
3          3   2898     2334      379     1955     1548          5          9
4          1   2374      926      135      791      920          6          8
5          1   4097     4710     1558     3151     4651         59         10
6          1   1467      651      113      538      408         59          9
> # w各变量的量纲不是处于同一水平，接下来进行归一化处理
> u <- round(apply(w[,-1],2,function(x) (x-min(x))/(max(x)-min(x))),4)
> # 将u变成data.frame形式
> u <- data.frame(u)
> # 将用户ID赋予对象u的行号
> row.names(u) <- w$用户id
> # 查看u的前六行
> head(u)
        免费筹码 身上货币量 最高拥有 最大赢取 贡献台费 登录总次数 站内好友数
7793439   0.0825     0.0539   0.0989   0.0453   0.0532     0.2222     0.0833
7793414   0.0000     0.0027   0.0018   0.0038   0.0054     0.2222     0.0000
7793253   0.0119     0.0712   0.0863   0.0413   0.0568     0.3333     0.2500
7793114   0.0000     0.0014   0.0047   0.0082   0.0092     0.3333     0.0833
7793052   0.0000     0.0072   1.0000   1.0000   1.0000     0.3333     0.0833
7793039   0.0003     0.0316   0.0003   0.0006   0.0002     0.3333     0.0833
        经验值 玩牌局数 赢牌局数 输牌局数 正常牌局 非正常牌局 最高牌类型
7793439 0.2780   0.2376   0.1266   0.2301   0.4365     0.0352      0.625
7793414 0.0417   0.0263   0.0314   0.0299   0.0613     0.0141      0.625
7793253 0.1898   0.3138   0.1809   0.2962   0.3328     0.0176      0.750
7793114 0.1487   0.1158   0.0593   0.1186   0.1978     0.0211      0.625
7793052 0.2838   0.6478   0.7683   0.4786   1.0000     0.2077      0.875
7793039 0.0775   0.0772   0.0483   0.0800   0.0877     0.2077      0.750
> # 利用K-Means聚类对数据u进行分群，k选择为3
> kmeans.result <- kmeans(u,3)
> # 查看聚类结果
> kmeans.result
K-means clustering with 3 clusters of sizes 14, 71, 50

Cluster means:
     免费筹码 身上货币量   最高拥有    最大赢取    贡献台费 登录总次数
1 0.108764286 0.15163571 0.11637143 0.109628571 0.136200000  0.6508071
2 0.004321127 0.01327324 0.00613662 0.009998592 0.001423944  0.2222000
3 0.016440000 0.08925200 0.02921200 0.032534000 0.010432000  0.5355600
  站内好友数     经验值  玩牌局数   赢牌局数   输牌局数   正常牌局  非正常牌局
1  0.1607000 0.48262857 0.5033571 0.34067143 0.44974286 0.64602857 0.077471429
2  0.1150127 0.05312817 0.0274338 0.02373662 0.03092113 0.05804366 0.008323944
3  0.1733240 0.13628000 0.0834060 0.07338200 0.07800000 0.16078600 0.045978000
  最高牌类型
1  0.7946429
2  0.6320423
3  0.7050000

Clustering vector:
7793439 7793414 7793253 7793114 7793052 7793039 7792916 7792868 7792852 7792789 
      3       2       3       2       1       2       2       2       3       2 
7792668 7792464 7792107 7792081 7791623 7791602 7791500 7791470 7791350 7790995 
      3       3       2       3       3       2       2       2       3       3 
7790983 7790940 7790910 7790848 7790777 7790487 7790156 7790155 7790132 7790078 
      2       2       2       1       1       2       3       3       3       2 
7790011 7789828 7789630 7789238 7789115 7788935 7788851 7788850 7788730 7788701 
      3       3       2       3       2       1       3       2       3       3 
7788345 7788205 7788150 7788135 7788117 7787809 7787637 7787607 7787455 7787426 
      2       2       2       3       3       3       2       2       3       3 
7787043 7786946 7786849 7786848 7786693 7786668 7786559 7786516 7786317 7785823 
      1       2       3       1       2       2       3       3       3       2 
7785694 7785618 7785324 7785241 7785132 7785129 7785022 7785012 7784979 7784401 
      1       3       3       3       3       2       3       2       2       1 
7784277 7784272 7784240 7784015 7783648 7783392 7783382 7783181 7783122 7782622 
      1       2       3       3       2       1       3       3       1       1 
7782454 7782386 7781798 7781797 7781599 7781580 7781537 7780962 7780876 7780355 
      3       3       1       3       3       3       2       3       3       3 
7780096 7780095 7779790 7779712 7779508 7779280 7779165 7779132 7779016 7778900 
      1       3       3       2       3       2       3       2       2       3 
7794328 7787666 7780334 7784012 7784759 7791150 7779470 7791828 7786085 7794708 
      2       2       2       2       2       2       2       2       2       2 
7783630 7786065 7785023 7784754 7793765 7794916 7782731 7795859 7784033 7794499 
      2       2       2       2       2       2       2       2       2       2 
7790049 7795560 7785530 7785874 7783034 7785840 7790881 7794303 7794234 7791025 
      2       2       2       2       2       2       2       2       2       2 
7788078 7790831 7793545 7794275 7783970 
      2       2       3       2       2 

Within cluster sum of squares by cluster:
[1] 10.032499  4.871164 10.743719
 (between_SS / total_SS =  40.7 %)

Available components:

[1] "cluster"      "centers"      "totss"        "withinss"     "tot.withinss"
[6] "betweenss"    "size"         "iter"         "ifault"      
> # 找出距离最大的5个玩家
> centers <- kmeans.result$centers[kmeans.result$cluster,]
> distances <- sqrt(rowSums((u-centers)^2))
> outliers <- order(distances,decreasing = T)[1:5]
> # 打印出距离最大的5个玩家的行号
> print(outliers)
[1]  5 11 76 71 67
> # 打印出异常玩家的用户ID
> rownames(u[outliers,])
[1] "7793052" "7792668" "7783392" "7784277" "7785022"
> # 绘制135位玩家的散点图
> plot(u$玩牌局数,u$正常牌局,pch=kmeans.result$cluster,
+      axes=F,xlab="玩牌局数",ylab="正常牌局")
> axis(1,labels = F);axis(2,labels = F)
> # 绘制类中心点
> points(kmeans.result$centers[,c('玩牌局数','正常牌局')],pch=16,cex=1.5)
> # 绘制离群点
> points(u[outliers,c('玩牌局数','正常牌局')],pch="*",col=4,cex=1.5)
> # 把离群点的用户ID号打印出来
> text(u[outliers,c('玩牌局数','正常牌局')],
+      labels=rownames(u[outliers,]),
+      cex=1,col="black")