首页 > 代码库 > 侦测欺诈交易-数据初步探索

侦测欺诈交易-数据初步探索

# 4.2.1 加载数据至R
library(DMwR)
## Loading required package: lattice
## Loading required package: grid
data(sales)
head(sales)
##   ID Prod Quant   Val Insp
## 1 v1   p1   182  1665 unkn
## 2 v2   p1  3072  8780 unkn
## 3 v3   p1 20393 76990 unkn
## 4 v4   p1   112  1100 unkn
## 5 v3   p1  6164 20260 unkn
## 6 v5   p2   104  1155 unkn
# 4.2.2. 探索数据集
summary(sales)
##        ID              Prod            Quant               Val         
##  v431   : 10159   p1125  :  3923   Min.   :1.00e+02   Min.   :   1005  
##  v54    :  6017   p3774  :  1824   1st Qu.:1.07e+02   1st Qu.:   1345  
##  v426   :  3902   p1437  :  1720   Median :1.68e+02   Median :   2675  
##  v1679  :  3016   p1917  :  1702   Mean   :8.44e+03   Mean   :  14617  
##  v1085  :  3001   p4089  :  1598   3rd Qu.:7.38e+02   3rd Qu.:   8680  
##  v1183  :  2642   p2742  :  1519   Max.   :4.74e+08   Max.   :4642955  
##  (Other):372409   (Other):388860   NA‘s   :13842      NA‘s   :1182     
##     Insp       
##  ok   : 14462  
##  unkn :385414  
##  fraud:  1270  
##                
##                
##                
## 
library(Hmisc)
## Loading required package: survival
## Loading required package: splines
## Loading required package: Formula
## 
## Attaching package: ‘Hmisc‘
## 
## 下列对象被屏蔽了from ‘package:base‘:
## 
##     format.pval, round.POSIXt, trunc.POSIXt, units
describe(sales)
## sales 
## 
##  5  Variables      401146  Observations
## ---------------------------------------------------------------------------
## ID 
##       n missing  unique 
##  401146       0    6016 
## 
## lowest : v1    v2    v3    v4    v5   
## highest: v6066 v6067 v6068 v6069 v6070 
## ---------------------------------------------------------------------------
## Prod 
##       n missing  unique 
##  401146       0    4548 
## 
## lowest : p1    p2    p3    p4    p5   
## highest: p4544 p4545 p4546 p4547 p4548 
## ---------------------------------------------------------------------------
## Quant 
##       n missing  unique    Info    Mean     .05     .10     .25     .50 
##  387304   13842   20956       1    8442     100     101     107     168 
##     .75     .90     .95 
##     738    4877   12916 
## 
## lowest :       100       101       102       103       104
## highest:  56590926 164244544 173844544 194044544 473883883 
## ---------------------------------------------------------------------------
## Val 
##       n missing  unique    Info    Mean     .05     .10     .25     .50 
##  399964    1182   21821       1   14617    1040    1085    1345    2675 
##     .75     .90     .95 
##    8680   27250   52995 
## 
## lowest :    1005    1010    1015    1020    1025
## highest: 4161740 4308620 4475360 4616735 4642955 
## ---------------------------------------------------------------------------
## Insp 
##       n missing  unique 
##  401146       0       3 
## 
## ok (14462, 4%), unkn (385414, 96%), fraud (1270, 0%) 
## ---------------------------------------------------------------------------
# 从结果可知,数据集中有大量的产品和销售人员信息,可以使用nlevels()来确认这一点:
nlevels(sales$ID)
## [1] 6016
nlevels(sales$Prod)
## [1] 4548
length(which(is.na(sales$Quant) & is.na(sales$Val)))
## [1] 888
# 等价于
sum(is.na(sales$Quant) & is.na(sales$Val))
## [1] 888
# 欺诈行为的比例总体而言也是较低的:
table(sales$Insp)/nrow(sales)*100
## 
##      ok    unkn   fraud 
##  3.6052 96.0782  0.3166
# 等价于
prop.table(table(sales$Insp))*100
## 
##      ok    unkn   fraud 
##  3.6052 96.0782  0.3166
# 下面代码绘制的图显示了每个销售人员报告的数量。可以确定的是,所有销售人员的数据相当不同。
# 针对每个产品,也是同样的情况.
par(mfrow=c(1,2))
totS<-table(sales$ID)
totP<-table(sales$Prod)
barplot(totS,main="Transactions per salespeople",names.arg="",
        xlab="Salespeople",ylab="Amount")
barplot(totP,main="Transactions per product",names.arg="",
        xlab="Products",ylab="Amount")
par(mfrow=c(1,1))
技术分享

# 把单位产品价格做为新的一列加入到数据框中,代码如下:
sales$Uprice<-sales$Val/sales$Quant
# 我们可以用如下代码来检查产品单位价格的分布:
summary(sales$Uprice)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max.    NA‘s 
##       0       8      12      20      19   26500   14136
describe(sales$Uprice)
## sales$Uprice 
##       n missing  unique    Info    Mean     .05     .10     .25     .50 
##  387010   14136  167071       1    20.3   1.557   3.269   8.460  11.887 
##     .75     .90     .95 
##  19.112  34.068  50.779 
## 
## lowest : 2.448e-06 4.203e-04 4.283e-04 4.741e-04 5.274e-04
## highest: 1.334e+04 1.388e+04 1.615e+04 2.117e+04 2.646e+04
# 我们再次看到明显的变动性。
# 检查最贵的和最便宜的产品可能是很有趣的。我们用单位价格的中位数来代表已售产品的标准价格。下面代码用于获取我们所需要的信息:
attach(sales)
upp<-aggregate(Uprice,list(Prod),median,na.rm=T)
topP<-sapply(c(T,F),function(o)
  upp[order(upp[,2],decreasing=o)[1:5],1])
colnames(topP)<-c("Expensive","Cheap")
topP
##      Expensive Cheap  
## [1,] "p3689"   "p560" 
## [2,] "p2453"   "p559" 
## [3,] "p2452"   "p4195"
## [4,] "p2456"   "p601" 
## [5,] "p2459"   "p563"
# 我们可以用这5个产品的单位价格的箱图来确认它们完全不同的价格分布:
topS<-sales[Prod %in% topP[1,],c("Prod","Uprice")]
topS$Prod<-factor(topS$Prod)
boxplot(Uprice~Prod,data=http://www.mamicode.com/topS,ylab="Uprice",log="y") # 对y轴取对数
技术分享



# 可以进行类似的分析,以找出那些给公司带来更多(少)资金的销售人员:
vs<-aggregate(Val,list(ID),sum,na.rm=T)
scoresSs<-sapply(c(T,F),function(o)
  vs[order(vs$x,decreasing=o)[1:5],1])
colnames(scoresSs)<-c("Most","Least")
scoresSs
##      Most    Least  
## [1,] "v431"  "v3355"
## [2,] "v54"   "v6069"
## [3,] "v19"   "v5876"
## [4,] "v4520" "v6058"
## [5,] "v955"  "v4515"
# 前100位销售人员的资金收入几乎占公司资金收入的40%,而在6016名销售人员中,底部2000人的总收入不足公司总收入的2%。
sum(vs[order(vs$x,decreasing=T)[1:100],2])/sum(Val,na.rm=T)*100
## [1] 38.33
sum(vs[order(vs$x,decreasing=F)[1:2000],2])/sum(Val,na.rm=T)*100
## [1] 1.989
# 如果我们对每个产品所销售的数量进行类似的分析,结果更加不平衡:
qs<-aggregate(Quant,list(Prod),sum,na.rm=T)
scoresPs<-sapply(c(T,F),function(o)
  qs[order(qs$x,decreasing=o)[1:5],1])
colnames(scoresPs)<-c("Most","Least")
scoresPs
##      Most    Least  
## [1,] "p2516" "p2442"
## [2,] "p3599" "p2443"
## [3,] "p314"  "p1653"
## [4,] "p569"  "p4101"
## [5,] "p319"  "p3678"
sum(as.double(qs[order(qs$x,decreasing=T)[1:100],2]))/sum(as.double(Quant),na.rm=T)*100
## [1] 74.63
sum(as.double(qs[order(qs$x,decreasing=F)[1:4000],2]))/sum(as.double(Quant),na.rm=T)*100
## [1] 8.945
# 在4548个产品中,其中4000个产品代表了少于10%的销量,而销量最高的100个产品占了近75%的销量。


# 确定每个产品的异常值个数:
out<-tapply(Uprice,list(Prod=Prod),
            function(x) length(boxplot.stats(x)$out))
# 函数boxplot.stats()可以获取某些用于绘制箱图的统计量。
out[order(out,decreasing=T)[1:10]]
## Prod
## p1125 p1437 p2273 p1917 p1918 p4089  p538 p3774 p2742 p3338 
##   376   181   165   156   156   137   129   125   120   117
# 应用这个简单方法,找到29446个别认为是离群值的交易,这相当于总交易数量的7%。
sum(out)
## [1] 29446
sum(out)/nrow(sales)*100
## [1] 7.34

侦测欺诈交易-数据初步探索