本篇內(nèi)容主要講解“R語言邏輯回歸、ROC曲線與十折如何實(shí)現(xiàn)交叉驗(yàn)證”，感興趣的朋友不妨來看看。本文介紹的方法操作簡單快捷，實(shí)用性強(qiáng)。下面就讓小編來帶大家學(xué)習(xí)“R語言邏輯回歸、ROC曲線與十折如何實(shí)現(xiàn)交叉驗(yàn)證”吧!
1. 測試集和訓(xùn)練集3、7分組
重慶分公司
重慶分公司
australian <- read.csv("australian.csv",as.is = T,sep=",",header=TRUE)
#讀取行數(shù)
N = length(australian$Y)
#ind=1的是0.7概率出現(xiàn)的行，ind=2是0.3概率出現(xiàn)的行
ind=sample(2,N,replace=TRUE,prob=c(0.7,0.3))
#生成訓(xùn)練集(這里訓(xùn)練集和測試集隨機(jī)設(shè)置為原數(shù)據(jù)集的70%，30%)
aus_train <- australian[ind==1,]
#生成測試集
aus_test <- australian[ind==2,]2.生成模型，結(jié)果導(dǎo)出
#生成logis模型，用glm函數(shù) #用訓(xùn)練集數(shù)據(jù)生成logis模型，用glm函數(shù) #family：每一種響應(yīng)分布（指數(shù)分布族）允許各種關(guān)聯(lián)函數(shù)將均值和線性預(yù)測器關(guān)聯(lián)起來。常用的family：binomal(link='logit')--響應(yīng)變量服從二項(xiàng)分布，連接函數(shù)為logit，即logistic回歸 pre <- glm(Y ~.,family=binomial(link = "logit"),data = aus_train) summary(pre) #測試集的真實(shí)值 real <- aus_test$Y #predict函數(shù)可以獲得模型的預(yù)測值。這里預(yù)測所需的模型對象為pre，預(yù)測對象newdata為測試集,預(yù)測所需類型type選擇response,對響應(yīng)變量的區(qū)間進(jìn)行調(diào)整 predict. <- predict.glm(pre,type='response',newdata=aus_test) #按照預(yù)測值為1的概率，>0.5的返回1，其余返回0 predict =ifelse(predict.>0.5,1,0) #數(shù)據(jù)中加入預(yù)測值一列 aus_test$predict = predict #導(dǎo)出結(jié)果為csv格式 #write.csv(aus_test,"aus_test.csv")
3.模型檢驗(yàn)
##模型檢驗(yàn)
res <- data.frame(real,predict)
#訓(xùn)練數(shù)據(jù)的行數(shù)，也就是樣本數(shù)量
n = nrow(aus_train)
#計(jì)算Cox-Snell擬合優(yōu)度
R2 <- 1-exp((pre$deviance-pre$null.deviance)/n)
cat("Cox-Snell R2=",R2,"\n")
#計(jì)算Nagelkerke擬合優(yōu)度，我們在最后輸出這個(gè)擬合優(yōu)度值
R2<-R2/(1-exp((-pre$null.deviance)/n))
cat("Nagelkerke R2=",R2,"\n")
##模型的其他指標(biāo)
#residuals(pre) #殘差
#coefficients(pre) #系數(shù)，線性模型的截距項(xiàng)和每個(gè)自變量的斜率，由此得出線性方程表達(dá)式?；蛘邔憺閏oef(pre)
#anova(pre) #方差4.準(zhǔn)確率和精度
true_value=aus_test[,15] predict_value=aus_test[,16] #計(jì)算模型精確度 error = predict_value-true_value accuracy = (nrow(aus_test)-sum(abs(error)))/nrow(aus_test) #精確度--判斷正確的數(shù)量占總數(shù)的比例 #計(jì)算Precision，Recall和F-measure #一般來說，Precision就是檢索出來的條目（比如：文檔、網(wǎng)頁等）有多少是準(zhǔn)確的，Recall就是所有準(zhǔn)確的條目有多少被檢索出來了 #和混淆矩陣結(jié)合，Precision計(jì)算的是所有被檢索到的item（TP+FP）中,"應(yīng)該被檢索到的item（TP）”占的比例；Recall計(jì)算的是所有檢索到的item（TP）占所有"應(yīng)該被檢索到的item（TP+FN）"的比例。 precision=sum(true_value & predict_value)/sum(predict_value) #真實(shí)值預(yù)測值全為1 / 預(yù)測值全為1 --- 提取出的正確信息條數(shù)/提取出的信息條數(shù) recall=sum(predict_value & true_value)/sum(true_value) #真實(shí)值預(yù)測值全為1 / 真實(shí)值全為1 --- 提取出的正確信息條數(shù) /樣本中的信息條數(shù) #P和R指標(biāo)有時(shí)候會(huì)出現(xiàn)的矛盾的情況，這樣就需要綜合考慮他們，最常見的方法就是F-Measure（又稱為F-Score） F_measure=2*precision*recall/(precision+recall) #F-Measure是Precision和Recall加權(quán)調(diào)和平均，是一個(gè)綜合評價(jià)指標(biāo) #輸出以上各結(jié)果 print(accuracy) print(precision) print(recall) print(F_measure) #混淆矩陣，顯示結(jié)果依次為TP、FN、FP、TN table(true_value,predict_value)
5.ROC曲線的幾個(gè)方法
#ROC曲線
# 方法1
#install.packages("ROCR")
library(ROCR)
pred <- prediction(predict.,true_value) #預(yù)測值(0.5二分類之前的預(yù)測值)和真實(shí)值
performance(pred,'auc')@y.values #AUC值
perf <- performance(pred,'tpr','fpr')
plot(perf)
#方法2
#install.packages("pROC")
library(pROC)
modelroc <- roc(true_value,predict.)
plot(modelroc, print.auc=TRUE, auc.polygon=TRUE,legacy.axes=TRUE, grid=c(0.1, 0.2),
grid.col=c("green", "red"), max.auc.polygon=TRUE,
auc.polygon.col="skyblue", print.thres=TRUE) #畫出ROC曲線，標(biāo)出坐標(biāo)，并標(biāo)出AUC的值
#方法3，按ROC定義
TPR=rep(0,1000)
FPR=rep(0,1000)
p=predict.
for(i in 1:1000)
{
p0=i/1000;
ypred<-1*(p>p0)
TPR[i]=sum(ypred*true_value)/sum(true_value)
FPR[i]=sum(ypred*(1-true_value))/sum(1-true_value)
}
plot(FPR,TPR,type="l",col=2)
points(c(0,1),c(0,1),type="l",lty=2)6.更換測試集和訓(xùn)練集的選取方式，采用十折交叉驗(yàn)證
australian <- read.csv("australian.csv",as.is = T,sep=",",header=TRUE)
#將australian數(shù)據(jù)分成隨機(jī)十等分
#install.packages("caret")
#固定folds函數(shù)的分組
set.seed(7)
require(caret)
folds <- createFolds(y=australian$Y,k=10)
#構(gòu)建for循環(huán)，得10次交叉驗(yàn)證的測試集精確度、訓(xùn)練集精確度
max=0
num=0
for(i in 1:10){
fold_test <- australian[folds[[i]],] #取folds[[i]]作為測試集
fold_train <- australian[-folds[[i]],] # 剩下的數(shù)據(jù)作為訓(xùn)練集
print("***組號***")
fold_pre <- glm(Y ~.,family=binomial(link='logit'),data=fold_train)
fold_predict <- predict(fold_pre,type='response',newdata=fold_test)
fold_predict =ifelse(fold_predict>0.5,1,0)
fold_test$predict = fold_predict
fold_error = fold_test[,16]-fold_test[,15]
fold_accuracy = (nrow(fold_test)-sum(abs(fold_error)))/nrow(fold_test)
print(i)
print("***測試集精確度***")
print(fold_accuracy)
print("***訓(xùn)練集精確度***")
fold_predict2 <- predict(fold_pre,type='response',newdata=fold_train)
fold_predict2 =ifelse(fold_predict2>0.5,1,0)
fold_train$predict = fold_predict2
fold_error2 = fold_train[,16]-fold_train[,15]
fold_accuracy2 = (nrow(fold_train)-sum(abs(fold_error2)))/nrow(fold_train)
print(fold_accuracy2)
if(fold_accuracy>max)
{
max=fold_accuracy
num=i
}
}
print(max)
print(num)
##結(jié)果可以看到，精確度accuracy較大的一次為max,取folds[[num]]作為測試集，其余作為訓(xùn)練集。7.得到十折交叉驗(yàn)證的精確度，結(jié)果導(dǎo)出
#十折里測試集較大精確度的結(jié)果 testi <- australian[folds[[num]],] traini <- australian[-folds[[num]],] # 剩下的folds作為訓(xùn)練集 prei <- glm(Y ~.,family=binomial(link='logit'),data=traini) predicti <- predict.glm(prei,type='response',newdata=testi) predicti =ifelse(predicti>0.5,1,0) testi$predict = predicti #write.csv(testi,"ausfold_test.csv") errori = testi[,16]-testi[,15] accuracyi = (nrow(testi)-sum(abs(errori)))/nrow(testi) #十折里訓(xùn)練集的精確度 predicti2 <- predict.glm(prei,type='response',newdata=traini) predicti2 =ifelse(predicti2>0.5,1,0) traini$predict = predicti2 errori2 = traini[,16]-traini[,15] accuracyi2 = (nrow(traini)-sum(abs(errori2)))/nrow(traini) #測試集精確度、取第i組、訓(xùn)練集精確 accuracyi;num;accuracyi2 #write.csv(traini,"ausfold_train.csv")
總結(jié)
到此，相信大家對“R語言邏輯回歸、ROC曲線與十折如何實(shí)現(xiàn)交叉驗(yàn)證”有了更深的了解，不妨來實(shí)際操作一番吧！這里是創(chuàng)新互聯(lián)建站，更多相關(guān)內(nèi)容可以進(jìn)入相關(guān)頻道進(jìn)行查詢，關(guān)注我們，繼續(xù)學(xué)習(xí)！
