
R语言侦测欺诈交易【行业材料】.doc
9页R语言侦测欺诈交易背景考虑到在经济和社会领域中经常存在欺诈交易等非法活动,因此欺诈检验是数据挖掘技术的一个重要应用领域从数据分析的角度,欺诈行为通常和异常的观测值相关联,因为这些欺诈行为是偏离常规的在多个数据分析领域,这些偏离常规的行为经常成为离群值数据挖掘的结果有助于公司的事后检查活动,能够提供某种欺诈概率排序作为输出结果,可以使公司以最佳方式来利用其事后检查资源目的侦测欺诈交易的目的是找到“奇怪的”交易记录报告,它可能指出某些销售员涉嫌欺诈这里用的数据是一个较短时期内的销售数据,销售员可按照自己的策略和公司情况来自由设置销售价格我们的目的是根据公司过去发现的交易报告中的错误和欺诈企图,帮助公司完成核实这些销售报告真实性的工作1.加载数据:共401 146行数据,每一行包括来自销售员报告的信息ID:说明销售员ID的一个因子变量Prod:说明销售产品ID号的一个因子变量Quant:报告该产品销售的数量Val:报告销售记录的总价值Insp:有3个可能值的因子变量——ok表示公司检查了该交易并认为该交易有效;fraud表示发现该交易为欺诈;unkn表示该交易未经过公司审核2.数据集探索:> sum(is.na(sales$Quant) & is.na(sales$Val))[1] 888从数据的统计特征初步可以看出v431号雇员录入的数据最多,p1125号产品卖出最多,可以看到产品销售的数量和总价值的四分位数据,公司已检查承认有效的数据有14462,已发现欺诈的数据有1270,未经过审查的有385414,说明大量数据还未经过审核,需要接下来的数据分析来检查其中的欺诈数据。
数据中有大量缺失值,当重要产品销售数和销售总价值同时缺失时,就无法进行分析,这样的数据有888条,在40万组数据中可以忽略不计判断数据框中每个变量的属性:str(sales)'data.frame': 401146 obs. of 5 variables: $ ID : Factor w/ 6016 levels "v1","v2","v3",..: 1 2 3 4 3 5 6 7 8 9 ... $ Prod : Factor w/ 4548 levels "p1","p2","p3",..: 1 1 1 1 1 2 2 2 2 2 ... $ Quant: int 182 3072 20393 112 6164 104 350 200 233 118 ... $ Val : num 1665 8780 76990 1100 20260 ... $ Insp : Factor w/ 3 levels "ok","unkn","fraud": 2 2 2 2 2 2 2 2 2 2 ...可以看到ID,Prod,Insp是因子型变量, Quant整数型,Val数值型table(sales$Insp)/nrow(sales)*100 ok unkn fraud 3.6124200 96.0702847 0.3172953在只考虑已检查过的销售记录,看到欺诈比例较小。
绘制每个交易人员的交易数量和每个产品的交易数量图形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')看到所有销售人员的数据相当不同,对于每个产品,波动性较大sales$Uprice <- sales$Val/sales$Quantsummary(sales$Uprice) Min. 1st Qu. Median Mean 3rd Qu. Max. NA's 0.00 8.46 11.89 20.30 19.11 26460.00 13248检查产品单位价格的分布,看到有明显的变动性。
out <- tapply(Uprice,list(Prod=Prod),function(x) length(boxplot.stats(x)$out))out[order(out,decreasing=T)[1:10]]sum(out)[1]29446sum(out)/nrow(sales)*100[1]7.34047初步找到29446个被认为是离群值的交易,相当于交易的7.3%3.缺失值处理:找出变量Quant和变量Val同时有缺失值的交易占很大比例的销售人员> totS<-table(sales$ID)> totP<-table(sales$Prod)> nas<-sales[which(is.na(sales$Quant)&is.na(sales$Val)),c("ID","Prod")]> propS<-100*table(nas$ID)/totS> propS[order(propS,decreasing=T)[1:10]] v1237 v4254 v4038 v5248 v3666 v4433 v4170 13.793103 9.523810 8.333333 8.333333 6.666667 6.250000 5.555556 v4926 v4664 v4642 5.555556 5.494505 4.761905可以考虑直接剔除同时在两个变量有缺失值的交易sales<-sales[-which(is.na(sales$Quant) & is.na(sales$Val)),]分析剩余的在数量或者价格变量上有缺失值的交易。
计算每一种产品在数量上有缺失值的交易,显示前10个:> nnasQp<-tapply(sales$Quant,list(sales$Prod),function(x) sum(is.na(x)))> propNAsQp<-nnasQp/table(sales$Prod)> propNAsQp[order(propNAsQp,decreasing=T)[1:10]] p2442 p2443 p1653 p4101 p4243 p903 p3678 1.0000000 1.0000000 0.9090909 0.8571429 0.6842105 0.6666667 0.6666667 p4061 p3955 p4313 0.6666667 0.6428571 0.6363636P2442和p2443两个产品所有的交易数量是缺失的,因此我们无法计算其标准价格,所以这些产品的交易信息不可能进行任何分析一共54份报告,标记为ok的报告,意味着检查员掌握了比这个数据集更多的信息,或者我们得到的数据有输入错误,因为从这些交易中似乎不可能得到任何结论,基于此,将删除这些交易报告:> sales <- sales[!sales$Prod %in% c('p2442','p2443'),]更新删除两种产品后的Prod:> nlevels(sales$Prod)[1] 4548> sales$Prod <- factor(sales$Prod)> nlevels(sales$Prod)[1] 4546观察是否有销售人员的所有交易数量为缺失值:> nnasQs<-tapply(sales$Quant,list(sales$ID),function(x) sum(is.na(x)))> propNAsQs<-nnasQs/table(sales$ID)> propNAsQs[order(propNAsQs,decreasing=T)[1:10]] v2925 v5537 v5836 v6058 v6065 v4368 v2923 1.0000000 1.0000000 1.0000000 1.0000000 1.0000000 0.8888889 0.8750000 v2970 v4910 v4542 0.8571429 0.8333333 0.8095238从结果上看,有几个销售人员没有在报告中填写交易的数量信息。
我们只要有其他销售人员报告的相同产品的交易,就可以尝试使用此信息来填补那些缺失值,所以不删除这些交易对剩余的交易,用每个产品单位价格的中位数作为产品的标准价格:tPrice<-tapply(sales[sales$Insp!='fraud','Uprice'],list(sales[sales$Insp!='fraud','Prod']),median,na.rm=T)用标准单价计算缺失值Quant和Val,填补所有缺失值noQuant<-which(is.na(sales$Quant))sales[noQuant,'Quant']<-ceiling(sales[noQuant,'Val']/tPrice[sales[noQuant,'Prod']])noVal<-which(is.na(sales$Val))sales[noVal,'Val']<-sales[noVal,'Quant']*tPrice[sales[noVal,'Prod']]重新计算Uprice列的值来填充先前未知的单位价格sales$Uprice<-sales$Val/sales$Quant填补缺失值之后保存为sales,后面分析的数据就用这个数据。
有些产品只有极少的交易,因为太少的交易,在要求的统计学显著性下很难做出决定这种情况下,可以和一些产品的交易一起分析来避免这个问题尽管缺失产品之间关系的信息,但可以尝试通过观察产品单价分部之间的相似性来推断其中的一些关系,如果可以发现具有类似价格的产品,我们可以考虑合并它们相应的交易并对它们一起进行分析,从而找到异常值比较两个分布的方法是比较总结分布的一些统计特性连续变量分布的两个重要属性是集中趋势和离散趋势,这里使用中位数作为衡量中心的统计量,应用四分位距(IQR)作为离散指标的统计量 > notF<-which(Insp!="fraud")> ms<-tapply(Uprice[notF],list(Prod=Prod[notF]),function(x){+ bp<-boxplot.stats(x)$stats+ c(median=bp[3],iqr=bp[4]-bp[2])+ })> ms<-matrix(unlist(ms),length(ms),2,byrow=T,dimnames=list(names(ms),c('median','iqr')))> head(ms) median iqrp1 11.346154 8.575599p2 10.877863 5.609731p3 10.000000 。
