您好,登錄后才能下訂單哦!
SMOTE - Supersampling Rare Events in R:用R對稀有事件進(jìn)行超級采樣
在這個(gè)例子中將用到以下三個(gè)包
{DMwR} - Functions and data for the book “Data Mining with R” and SMOTE algorithm:SMOTE算法
{caret} - modeling wrapper, functions, commands:模型封裝、函數(shù)、命令
{pROC} - Area Under the Curve (AUC) functions:曲線下面積(ACU)函數(shù)
SMOTE算法是為了解決不平衡的分類問題。也就是說,它可以產(chǎn)生一個(gè)新的“SMOTEd”數(shù)據(jù),解決類不平衡問題集?;蛘?,它也可以運(yùn)行在這個(gè)新的數(shù)據(jù)集的分類算法,并返回所得到的模型。
我們利用 Thyroid Disease 數(shù)據(jù)來進(jìn)行研究。
讓我們清洗一些數(shù)據(jù)
# 加載數(shù)據(jù),刪除冒號和句號,并追加列名
hyper <-read.csv('http://archive.ics.uci.edu/ml/machine-learning-databases/thyroid-disease/hypothyroid.data', header=F)
names <- read.csv('http://archive.ics.uci.edu/ml/machine-learning-databases/thyroid-disease/hypothyroid.names', header=F, sep='\t')`1`
names <- gsub(pattern =":|[.]", replacement="", x = names)
colnames(hyper)<-names
# 我們將第一列的列名從 hypothyroid, negative改成target,并將negative變成0,其他值變成1.
colnames(hyper)[1]<-"target"
colnames(hyper)
## [1] "target" "age"
## [3] "sex" "on_thyroxine"
## [5] "query_on_thyroxine" "on_antithyroid_medication"
## [7] "thyroid_surgery" "query_hypothyroid"
## [9] "query_hyperthyroid" "pregnant"
## [11] "sick" "tumor"
## [13] "lithium" "goitre"
## [15] "TSH_measured" "TSH"
## [17] "T3_measured" "T3"
## [19] "TT4_measured" "TT4"
## [21] "T4U_measured" "T4U"
## [23] "FTI_measured" "FTI"
## [25] "TBG_measured" "TBG"
hyper$target<-ifelse(hyper$target=="negative",0,1)
# 檢查下陽性和陰性的結(jié)果
table(hyper$target)
##
## 0 1
## 3012 151
prop.table(table(hyper$target))
##
## 0 1
## 0.95226 0.04774
# 可見,1僅有5%。這顯然是一個(gè)扭曲的數(shù)據(jù)集,也是罕見事件。
head(hyper,2)
## target age sex on_thyroxine query_on_thyroxine on_antithyroid_medication
## 1 1 72 M f f f
## 2 1 15 F t f f
## thyroid_surgery query_hypothyroid query_hyperthyroid pregnant sick tumor
## 1 f f f f f f
## 2 f f f f f f
## lithium goitre TSH_measured TSH T3_measured T3 TT4_measured TT4
## 1 f f y 30 y 0.60 y 15
## 2 f f y 145 y 1.70 y 19
## T4U_measured T4U FTI_measured FTI TBG_measured TBG
## 1 y 1.48 y 10 n ?
## 2 y 1.13 y 17 n ?
# 這數(shù)據(jù)都是因子型變量(字符型的值),這些都需要轉(zhuǎn)換成二值化的數(shù)字,以方便建模:
ind<-sapply(hyper,is.factor)
hyper[ind]<-lapply(hyper[ind],as.character)
hyper[hyper=="?"]=NA
hyper[hyper=="f"]=0
hyper[hyper=="t"]=1
hyper[hyper=="n"]=0
hyper[hyper=="y"]=1
hyper[hyper=="M"]=0
hyper[hyper=="F"]=1
hyper[ind]<-lapply(hyper[ind],as.numeric)
replaceNAWithMean<-function(x) {replace(x,is.na(x),mean(x[!is.na(x)]))}
hyper<-replaceNAWithMean(hyper)
模型研究
我們利用caret包中的createDataPartition(數(shù)據(jù)分割功能)函數(shù)將數(shù)據(jù)隨機(jī)分成相同的兩份。
library(caret)
## Loading required package: lattice
## Loading required package: ggplot2
set.seed(1234)
splitIndex<-createDataPartition(hyper$target,time=1,p=0.5,list=FALSE)
trainSplit<-hyper[splitIndex,]
testSplit<-hyper[-splitIndex,]
prop.table(table(trainSplit$target))
##
## 0 1
## 0.95006 0.04994
prop.table(table(testSplit$target))
##
## 0 1
## 0.95446 0.04554
兩者的分類結(jié)果是平衡的,因此仍然有5%左右的代表,我們?nèi)匀惶幱诹己玫乃健?br />
我們利用caret包中的treebag模型算法,對訓(xùn)練集數(shù)據(jù)建立模型,并對測試集數(shù)據(jù)進(jìn)行預(yù)測。
ctrl<-trainControl(method="cv",number=5)
tbmodel<-train(target~.,data=trainSplit,method="treebag",
trControl=ctrl)
## Loading required package: ipred
## Loading required package: plyr
predictors<-names(trainSplit)[names(trainSplit)!='target']
pred<-predict(tbmodel$finalModel,testSplit[,predictors])
為了評估模型,我們用pROC包的roc函數(shù)算auc得分和畫圖
library(pROC)
## Type 'citation("pROC")' for a citation.
##
## Attaching package: 'pROC'
##
## 下列對象被屏蔽了from 'package:stats':
##
## cov, smooth, var
auc<-roc(testSplit$target,pred)
print(auc)
##
## Call:
## roc.default(response = testSplit$target, predictor = pred)
##
## Data: pred in 1509 controls (testSplit$target 0) < 72 cases (testSplit$target 1).
## Area under the curve: 0.985
plot(auc,ylim=c(0,1),print.thres=TRUE,main=paste('AUC',round(auc$auc`1`,2)))
##
## Call:
## roc.default(response = testSplit$target, predictor = pred)
##
## Data: pred in 1509 controls (testSplit$target 0) < 72 cases (testSplit$target 1).
## Area under the curve: 0.985
abline(h=1,col="blue",lwd=2)
abline(h=0,col="red",lwd=2)
auc得分是0.98,已經(jīng)是非常不錯(cuò)的結(jié)果了(因?yàn)樗姆秶窃?.5到1之間)。
很難想象SMOTE對此能再有提高了,但接下來我們利用SMOTE對數(shù)據(jù)處理后再建模,看看auc結(jié)果
在R中,SMOTE算法是DMwR軟件包的一部分,主要參數(shù)有如下三個(gè):perc.over:過采樣時(shí),生成少數(shù)類的樣本個(gè)數(shù);k:過采樣中使用K近鄰算法生成少數(shù)類樣本時(shí)的K值,默認(rèn)是5;perc.under:欠采樣時(shí),對應(yīng)每個(gè)生成的少數(shù)類樣本,選擇原始數(shù)據(jù)多數(shù)類樣本的個(gè)數(shù)。例如,perc.over=500表示對原始數(shù)據(jù)集中的每個(gè)少數(shù)樣本,都將生成5個(gè)新的少數(shù)樣本;perc.under=80表示從原始數(shù)據(jù)集中選擇的多數(shù)類的樣本是新生的數(shù)據(jù)集中少數(shù)樣本的80%。
library(DMwR)
## Loading required package: grid
##
## Attaching package: 'DMwR'
##
## 下列對象被屏蔽了from 'package:plyr':
##
## join
trainSplit$target<-as.factor(trainSplit$target)
trainSplit<-SMOTE(target~.,trainSplit,perc.over=100,perc.under=200)
trainSplit$target<-as.numeric(trainSplit$target)
# 我們再次用prop.table()函數(shù)檢查結(jié)果的平衡性,確定我們已經(jīng)讓陰性、陽性數(shù)據(jù)達(dá)到相同。
prop.table(table(trainSplit$target))
##
## 1 2
## 0.5 0.5
# 再次建立treebag模型
tbmodel<-train(target~.,data=trainSplit,method="treebag",
trControl=ctrl)
predictors<-names(trainSplit)[names(trainSplit)!='target']
pred<-predict(tbmodel$finalModel,testSplit[,predictors])
auc<-roc(testSplit$target,pred)
print(auc)
##
## Call:
## roc.default(response = testSplit$target, predictor = pred)
##
## Data: pred in 1509 controls (testSplit$target 0) < 72 cases (testSplit$target 1).
## Area under the curve: 0.99
哇,達(dá)到0.99,比之前的0.985有提高
plot(auc,ylim=c(0,1),print.thres=TRUE,main=paste('AUC',round(auc$auc`1`,2)))
##
## Call:
## roc.default(response = testSplit$target, predictor = pred)
##
## Data: pred in 1509 controls (testSplit$target 0) < 72 cases (testSplit$target 1).
## Area under the curve: 0.99
abline(h=1,col="blue",lwd=2)
abline(h=0,col="red",lwd=2)
免責(zé)聲明:本站發(fā)布的內(nèi)容(圖片、視頻和文字)以原創(chuàng)、轉(zhuǎn)載和分享為主,文章觀點(diǎn)不代表本網(wǎng)站立場,如果涉及侵權(quán)請聯(lián)系站長郵箱:is@yisu.com進(jìn)行舉報(bào),并提供相關(guān)證據(jù),一經(jīng)查實(shí),將立刻刪除涉嫌侵權(quán)內(nèi)容。