R語言 數據清洗（缺失值處理、異常值處理）

關注微信公共號：小程在線

關注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")