anyuan2002.com - vwin网

查找: 您的方位主页 > 网络频道 > 阅览资讯:R言语逻辑回归、ROC曲线和十折穿插验证

R言语逻辑回归、ROC曲线和十折穿插验证

2019-03-30 19:45:30 来历:www.anyuan2002.com 【

自己收拾编写的逻辑回归模板,作为学习笔记记载共享。数据集用的是14个自变量Xi,一个因变量Y的australian数据集。

 

1. 测验集和练习集3、7分组

australian <- read.csv("australian.csv",as.is = T,sep=",",header=TRUE)
#读取行数
N = length(australian$Y)                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                       
#ind=1的是0.7概率呈现的行,ind=2是0.3概率呈现的行
ind=sample(2,N,replace=TRUE,prob=c(0.7,0.3))
#生成练习集(这儿练习集和测验集随机设置为原数据集的70%,30%)
aus_train <- australian[ind==1,]
#生成测验集
aus_test <- australian[ind==2,]

2.生成模型,成果导出
#生成logis模型,用glm函数
#用练习集数据生成logis模型,用glm函数
#family:每一种呼应散布(指数散布族)答应各种相关函数将均值和线性猜测器相关起来。常用的family:binomal(link='logit')--呼应变量遵守二项散布,衔接函数为logit,即logistic回归
pre <- glm(Y ~.,family=binomial(link = "logit"),data = aus_train)
summary(pre)

#测验集的实在值
real <- aus_test$Y
#predict函数能够获得模型的猜测值。这儿猜测所需的模型目标为pre,猜测目标newdata为测验集,猜测所需类型type挑选response,对呼应变量的区间进行调整
predict. <- predict.glm(pre,type='response',newdata=aus_test)
#依照猜测值为1的概率,>0.5的回来1,其他回来0
predict =ifelse(predict.>0.5,1,0)
#数据中参加猜测值一列
aus_test$predict = predict
#导出成果为csv格局
#write.csv(aus_test,"aus_test.csv")

3.模型查验
##模型查验
res <- data.frame(real,predict)
#练习数据的行数,也便是样本数量
n = nrow(aus_train)   
#核算Cox-Snell拟合优度
R2 <- 1-exp((pre$deviance-pre$null.deviance)/n)  
cat("Cox-Snell R2=",R2,"\n")
#核算Nagelkerke拟合优度,咱们在最终输出这个拟合优度值
R2<-R2/(1-exp((-pre$null.deviance)/n)) 
cat("Nagelkerke R2=",R2,"\n")
##模型的其他目标
#residuals(pre)   #残差
#coefficients(pre) #系数,线性模型的截距项和每个自变量的斜率,由此得出线性方程表达式。或许写为coef(pre)
#anova(pre)     #方差

4.准确率和精度
true_value=aus_test[,15]
predict_value=aus_test[,16]
#核算模型准确度
error = predict_value-true_value
accuracy = (nrow(aus_test)-sum(abs(error)))/nrow(aus_test) #准确度--判别正确的数量占总数的份额
#核算Precision,Recall和F-measure
#一般来说,Precision便是检索出来的条目(比方:文档、网页等)有多少是准确的,Recall便是一切准确的条目有多少被检索出来了
#和混杂矩阵结合,Precision核算的是一切被检索到的item(TP+FP)中,"应该被检索到的item(TP)”占的份额;Recall核算的是一切检索到的item(TP)占一切"应该被检索到的item(TP+FN)"的份额。
precision=sum(true_value & predict_value)/sum(predict_value) #实在值猜测值全为1 / 猜测值全为1 --- 提取出的正确信息条数/提取出的信息条数
recall=sum(predict_value & true_value)/sum(true_value) #实在值猜测值全为1 / 实在值全为1 --- 提取出的正确信息条数 /样本中的信息条数
#P和R目标有时候会呈现的对立的状况,这样就需要归纳考虑他们,最常见的办法便是F-Measure(又称为F-Score)
F_measure=2*precision*recall/(precision+recall)  #F-Measure是Precision和Recall加权谐和均匀,是一个归纳点评目标
#输出以上各成果
print(accuracy)
print(precision)
print(recall)
print(F_measure)
#混杂矩阵,显现成果依次为TP、FN、FP、TN
table(true_value,predict_value)     

5.ROC曲线的几个办法
#ROC曲线
# 办法1
#install.packages("ROCR") 
library(ROCR)   
pred <- prediction(predict.,true_value)  #猜测值(0.5二分类之前的猜测值)和实在值  
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曲线,标出坐标,并标出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.替换测验集和练习集的选取方法,选用十折穿插验证
australian <- read.csv("australian.csv",as.is = T,sep=",",header=TRUE)
#将australian数据分红随机十等分
#install.packages("caret")
#固定folds函数的分组
set.seed(7)
require(caret)
folds <- createFolds(y=australian$Y,k=10)

#构建for循环,得10次穿插验证的测验集准确度、练习集准确度

max=0
num=0

for(i in 1:10){
 
 fold_test <- australian[folds[[i]],]  #取folds[[i]]作为测验集
 fold_train <- australian[-folds[[i]],]  # 剩余的数据作为练习集
 
 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("***练习集准确度***")
 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)

##成果能够看到,准确度accuracy最大的一次为max,取folds[[num]]作为测验集,其他作为练习集。

7.得到十折穿插验证的准确度,成果导出
#十折里测验集最大准确度的成果
testi <- australian[folds[[num]],]
traini <- australian[-folds[[num]],]  # 剩余的folds作为练习集
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) 

#十折里练习集的准确度
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组、练习集准确
accuracyi;num;accuracyi2
#write.csv(traini,"ausfold_train.csv")


 

 

 

 
 

本文地址:http://www.anyuan2002.com/a/question/100091.html
Tags: 言语 逻辑 回归
修改:vwin网
关于咱们 | 联络咱们 | 友情链接 | 网站地图 | Sitemap | App | 回来顶部