R語言數(shù)據(jù)分析與挖掘-模型性能評(píng)估及優(yōu)化

模型性能評(píng)估01102模型參數(shù)優(yōu)化01模型性能評(píng)估201PAGE3模型性能評(píng)估3預(yù)測(cè)通常有兩大應(yīng)用場(chǎng)景：第一類是預(yù)測(cè)某指標(biāo)的取值，也稱為數(shù)值預(yù)測(cè)，數(shù)值預(yù)測(cè)模型性能評(píng)估主要通過均方誤差、均方根誤差、平均絕對(duì)誤差等指標(biāo)來評(píng)價(jià)；第二類是預(yù)測(cè)某事物出現(xiàn)的概率，也稱為概率預(yù)測(cè)，對(duì)于二分類概率預(yù)測(cè)，常以混淆矩陣為基礎(chǔ)，通過準(zhǔn)確率率、覆蓋率等指標(biāo)，結(jié)合ROC曲線、KS曲線、提升圖等可視化方法來評(píng)估模型性能。PAGE4數(shù)值預(yù)測(cè)評(píng)估方法4

PAGE5數(shù)值預(yù)測(cè)評(píng)估方法5

PAGE6數(shù)值預(yù)測(cè)評(píng)估方法R語言實(shí)現(xiàn)6讓我們利用mlbench擴(kuò)展包中BostonHousing（波士頓房?jī)r(jià)）數(shù)據(jù)集為例，利用lm()函數(shù)建立以medv為因變量，其他特征為自變量的線性回歸模型，并通過自定義函數(shù)，實(shí)現(xiàn)計(jì)算以上常見數(shù)值預(yù)測(cè)模型評(píng)估指標(biāo)。實(shí)現(xiàn)代碼如下：>#加載包，不存在就進(jìn)行在線下載后加載>if(!require(mlbench))install.packages("mlbench")>data("BostonHousing")>#數(shù)據(jù)分區(qū)>library(caret)>index<-createDataPartition(BostonHousing$medv,+p=0.75,list=FALSE)>train<-BostonHousing[index,]>test<-BostonHousing[-index,]>#利用訓(xùn)練集構(gòu)建模型,并對(duì)測(cè)試集進(jìn)行預(yù)測(cè)>set.seed(1234)>fit<-lm(medv~.,data=train)>pred<-predict(fit,newdata=test)>>#自定義函數(shù)計(jì)算數(shù)值預(yù)測(cè)模型的評(píng)估指標(biāo)>numericIndex<-function(obs,pred){+#計(jì)算平均絕對(duì)誤差MAE+MAE<-mean(abs(obs-pred))+#計(jì)算均方誤差MSE+MSE<-mean((obs-pred)^2)+#計(jì)算均方根誤差RMSE+RMSE<-sqrt(mean((obs-pred)^2))+#計(jì)算歸一化均方誤差+NMSE<-sum((obs-pred)^2)/(sum((obs-mean(obs))^2))+#計(jì)算判定系數(shù)Rsquared+Rsqured<-cor(pred,obs)^2+#返回向量形式+return(c('MAE'=MAE,'MSE'=MSE,'RMSE'=RMSE,'NMSE'=NMSE,'Rsqured'=Rsqured))+}>#計(jì)算各指標(biāo)度量值>numericIndex(test$medv,pred)MAEMSERMSENMSERsqured3.456530826.65314315.16266820.37314740.6461423PAGE7概率預(yù)測(cè)評(píng)估方法-混淆矩陣7概率是指事物出現(xiàn)的可能性，是對(duì)分類問題中某類出現(xiàn)概率的描述，本質(zhì)上是分類問題（通過各類別出現(xiàn)的概率大小確定取某一類）。常用評(píng)估方法有：混淆矩陣、ROC曲線、KS曲線、累計(jì)提升圖等。處理分類問題的評(píng)估思路，最常見的就是通過混淆矩陣，結(jié)合分析圖表綜合評(píng)價(jià)。

預(yù)測(cè)類別實(shí)際類別

101TPFN0FPTNTruePositive（TP）：指模型預(yù)測(cè)為正(1)，并且實(shí)際上也的確是正(1)的觀察對(duì)象的數(shù)量。TrueNegative（TN）：指模型預(yù)測(cè)為負(fù)(0)，并且實(shí)際上也的確是負(fù)(0)的觀察對(duì)象的數(shù)量。FalsePositive（FP）：指模型預(yù)測(cè)為正(1)，但是實(shí)際上是負(fù)(0)的觀測(cè)對(duì)象的數(shù)量。FalseNegative（FN）：指模型預(yù)測(cè)為負(fù)(0)，但是實(shí)際上是正(1)的觀測(cè)對(duì)象的數(shù)量。PAGE8概率預(yù)測(cè)評(píng)估方法-混淆矩陣8

PAGE9概率預(yù)測(cè)評(píng)估方法-混淆矩陣9

PAGE10概率預(yù)測(cè)評(píng)估方法-混淆矩陣案例10接下來，利用DAAG擴(kuò)展包的數(shù)據(jù)集anesthetic為例進(jìn)行演示。數(shù)據(jù)集來自于一組醫(yī)學(xué)數(shù)據(jù)，其中變量conc表示麻醉劑的用量，move則表示手術(shù)病人是否有所移動(dòng)，而我們用nomove做為因變量，研究的重點(diǎn)在于conc的增加是否會(huì)使nomove的概率增加。以下代碼利用邏輯回歸構(gòu)建二分類預(yù)測(cè)模型，以0.5作為預(yù)測(cè)概率值的劃分閾值，大于0.5預(yù)測(cè)概率值的樣本類別為1，否則為0，最后利用table()函數(shù)得到混淆矩陣，并計(jì)算各評(píng)估指標(biāo)值。>#install.packages("DAAG")>library(DAAG)>data(anesthetic)>anes1=glm(factor(nomove)~conc,family=binomial(link='logit'),data=anesthetic)>#對(duì)模型做出預(yù)測(cè)結(jié)果>pre=predict(anes1,type='response')#得到的是樣本為1類別時(shí)的預(yù)測(cè)概率值>#以0.5作為分界點(diǎn)>result<-ifelse(pre>0.5,1,0)>#install.packages("DAAG")>library(DAAG)>data(anesthetic)>anes1=glm(factor(nomove)~conc,family=binomial(link='logit'),data=anesthetic)>#對(duì)模型做出預(yù)測(cè)結(jié)果>pre=predict(anes1,type='response')#得到的是樣本為1類別時(shí)的預(yù)測(cè)概率值>#以0.5作為分界點(diǎn)>result<-ifelse(pre>0.5,1,0)>#構(gòu)建混淆矩陣>confusion<-table(actual=anesthetic$nomove,predict=result)>confusionpredictactual0101041214>#計(jì)算各指標(biāo)（1為正樣本，0為負(fù)樣本）>(TP<-confusion[4])[1]14>(TN<-confusion[1])[1]10>(FP<-confusion[3])[1]4>(FN<-confusion[2])[1]2>(Accuracy<-(sum(TN)+sum(TP))/sum(confusion))#準(zhǔn)確率[1]0.8>(Precision<-TP/(TP+FP))#精度[1]0.7777778>(Recall<-TP/(TP+FN))#靈敏性/召回率[1]0.875>(F1<-2*TP/(2*TP+FP+FN))#F1-score[1]0.8235294>(FPR<-FP/(TN+FP))#假正率[1]0.2857143PAGE11概率預(yù)測(cè)評(píng)估方法-ROC曲線11ROC(ReceiverOperatingCharacteristic,接收者運(yùn)行特征)曲線來源于信號(hào)檢測(cè)理論，它顯示了給定模型的靈敏性（Sensitivity）真正率與假正率（FalsePostiveRate）之間的比較評(píng)定。給定一個(gè)二元分類問題，通過對(duì)測(cè)試數(shù)據(jù)集可以正確識(shí)別“1”實(shí)例的比例與模型將“0”實(shí)例錯(cuò)誤地識(shí)別為“1”的比例進(jìn)行分析，來進(jìn)行不同模型的準(zhǔn)確率的比較評(píng)定。真正率的增加是以假正率的增加為代價(jià)的，ROC曲線下面的面積就是比較模型準(zhǔn)確度的指標(biāo)和依據(jù)。面積（AUC）大的模型對(duì)應(yīng)的模型準(zhǔn)確度要高，也就是要擇優(yōu)應(yīng)用的模型。AUC越接近0.5，對(duì)應(yīng)的模型的準(zhǔn)確率就越低。AUC值越接近1，模型效果越好，通常情況下，當(dāng)AUC在0.8以上時(shí)，模型就基本可以接受了。紅色實(shí)線就是ROC曲線。圖中以假正率（FalsePositiveRate，F(xiàn)PR）為X軸，代表在所有正樣本中，被判斷為假正的機(jī)率，又寫1-Specificity；以真正率（TruePositiveRate,TPR）為Y軸，代表在所有正樣本中，被判斷為真正的機(jī)率，又稱為靈敏性。可見，ROC曲線的繪制還是非常容易的。只要利用預(yù)測(cè)為正的概率值對(duì)樣本進(jìn)行降序排序后，再計(jì)算出從第一個(gè)累積到最后一個(gè)樣本的真正率和假正率，就可以繪制ROC曲線了。PAGE12概率預(yù)測(cè)評(píng)估方法-ROC曲線案例12讓我們繼續(xù)利用上一小節(jié)的類別為1的預(yù)測(cè)概率值，結(jié)合樣本實(shí)際類別，以下代碼計(jì)算出從第一個(gè)累積到最后一個(gè)樣本的真正率和假正率。>#構(gòu)建結(jié)果數(shù)據(jù)集>result<-data.frame(pre_prob=pre,true_label=anesthetic$nomove)>result<-result[order(result$pre_prob,decreasing=T),]#按照預(yù)測(cè)概率值進(jìn)行降序排序>result$cumsum<-cumsum(rep(1,nrow(result)))#統(tǒng)計(jì)累計(jì)樣本數(shù)量>result$poscumsum<-cumsum(result$true_label)#統(tǒng)計(jì)累計(jì)正樣本數(shù)量>result$tpr<-round(result$poscumsum/sum(result$true_label==1),3)#計(jì)算真正率>result$fpr<-round((result$cumsum-result$poscumsum)/sum(result$true_label==0),3)#計(jì)算假正率>result$lift<-round((result$poscumsum/result$cumsum)/(sum(result$true_label==1)/nrow(result)),2)#計(jì)算提升度>head(result)pre_probtrue_labelcumsumposcumsumtprfprlift60.99941791110.06201.88130.99941791220.12501.8870.91969011330.18801.8890.91969011440.25001.88120.91969011550.31201.88150.91969011660.37501.88PAGE13概率預(yù)測(cè)評(píng)估方法-ROC曲線案例13接下來，利用result中的變量tpr和fpr，可以非常輕松地繪制出ROC曲線，運(yùn)行以下代碼得到結(jié)果如圖。>#畫出roc曲線>library(ggplot2)>if(!require(ROCR))install.packages("ROCR")>ggplot(result)++geom_line(aes(x=result$fpr,y=result$tpr),color="red1",size=1.2)++geom_segment(aes(x=0,y=0,xend=1,yend=1),color="grey",lty=2,size=1.2)++annotate("text",x=0.5,y=1.05,label=paste('AUC:',round(ROCR::performance(prediction(result$pre_prob,result$true_label),'auc')@y.values[[1]],3)),+size=6,alpha=0.8)++scale_x_continuous(breaks=seq(0,1,.2))++scale_y_continuous(breaks=seq(0,1,.2))++xlab("FalsePostiveRate")++ylab("TruePostiveRate")++ggtitle(label="ROC-Chart")++theme_bw()++theme(+plot.title=element_text(colour="gray24",size=12,face="bold"),+plot.background=element_rect(fill="gray90"),+axis.title=element_text(size=10),+axis.text=element_text(colour="gray35"))PAGE14概率預(yù)測(cè)評(píng)估方法-ROCR擴(kuò)展包14其實(shí)R語言的ROCR擴(kuò)展包已經(jīng)實(shí)現(xiàn)了繪制ROC曲線功能，并且可以輸出對(duì)應(yīng)的AUC值。ROCR擴(kuò)展包通過可視化方法根據(jù)得分評(píng)估分類器的性能，其中，ROC曲線、敏感度\特異度曲線、提升圖、精度\召回率是權(quán)衡可視化中用于具體成對(duì)性能指標(biāo)的經(jīng)典方法。ROCR擴(kuò)展包是用于創(chuàng)建閾值參數(shù)化的二維性能曲線的靈活工具，對(duì)應(yīng)的兩個(gè)性能指標(biāo)可以從超過25個(gè)性能指標(biāo)中選取，并且自由組合。其中主要函數(shù)為performance()，基本表達(dá)形式如下：performance(prediction.obj,measure,x.measure="cutoff",...)PAGE15概率預(yù)測(cè)評(píng)估方法-ROCR擴(kuò)展包案例15>#利用ROCR包繪制roc曲線>library(ROCR)>pred1<-prediction(pre,anesthetic$nomove)>#設(shè)置參數(shù)，橫軸為假正率fpr，縱軸為真正率tpr>perf<-performance(pred1,'tpr','fpr')>#繪制ROC曲線>plot(perf,main="利用ROCR包繪制ROC曲線")PAGE16概率預(yù)測(cè)評(píng)估方法-KS曲線16KS曲線基于Kolmogorov-Smirnov的兩樣本檢驗(yàn)的思想，按預(yù)測(cè)概率從大到小的順序劃分等分位數(shù)分別統(tǒng)計(jì)正負(fù)樣本的累積函數(shù)分布，并檢驗(yàn)其一致性。分布相差越大，模型效果越好；分布越接近，模型效果越差。兩條折線分別代表各分位點(diǎn)下的正例覆蓋率和1-負(fù)例覆蓋率，通過兩條曲線很難對(duì)模型的好壞做評(píng)估，一般會(huì)選用最大的KS值作為衡量指標(biāo)。KS的計(jì)算公式為：KS=Sensitivity-(1-Specificity)=Sensitivity+Specificity-1。對(duì)于KS值而言，也是希望越大越好，通常情況下，當(dāng)KS值大于0.2時(shí)，說明模型具有區(qū)分能力，預(yù)測(cè)效果可能達(dá)到使用要求。Sensitivity：靈敏性（真正率）Specificity：特效性（正負(fù)率）PAGE17概率預(yù)測(cè)評(píng)估方法-KS曲線案例17這里仍利用result結(jié)果集，使用ggplot2擴(kuò)展包繪制KS曲線，運(yùn)行以下代碼得到結(jié)果如圖。>#畫出KS曲線>ggplot(result)++geom_line(aes((1:nrow(result))/nrow(result),result$tpr),colour="red2",size=1.2)++geom_line(aes((1:nrow(result))/nrow(result),result$fpr),colour="blue3",size=1.2)++annotate("text",x=0.5,y=1.05,label=paste("KS=",round(which.max(result$tpr-result$fpr)/nrow(result),4),+"atPop=",round(max(result$tpr-result$fpr),4)),size=6,alpha=0.8)++scale_x_continuous(breaks=seq(0,1,.2))++scale_y_continuous(breaks=seq(0,1,.2))++xlab("TotalPopulationRate")++ylab("TP/FPRate")++ggtitle(label="KS-Chart")++theme_bw()++theme(+plot.title=element_text(colour="gray24",size=12,face="bold"),+plot.background=element_rect(fill="gray90"),+axis.title=element_text(size=10),+axis.text=element_text(colour="gray35"))PAGE18概率預(yù)測(cè)評(píng)估方法-累積提升圖18

>#畫累積提升圖>ggplot(result)++geom_line(aes(x=(1:nrow(result))/nrow(result),y=result$lift),color="red3",size=1.2)++scale_x_continuous(breaks=seq(0,1,.2))++xlab("TotalPopulationRate")++ylab("Liftvalue")++ggtitle(label="LIFT-Chart")++theme_bw()++theme(+plot.title=element