分享

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

 勤悦轩 2018-03-13

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


1. 测试集和训练集3、7分组

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

2.生成模型,结果导出

  1. #生成logis模型,用glm函数  
  2. #用训练集数据生成logis模型,用glm函数  
  3. #family:每一种响应分布(指数分布族)允许各种关联函数将均值和线性预测器关联起来。常用的family:binomal(link='logit')--响应变量服从二项分布,连接函数为logit,即logistic回归  
  4. pre <- glm(Y ~.,family=binomial(link = "logit"),data = aus_train)  
  5. summary(pre)  
  6.   
  7. #测试集的真实值  
  8. real <- aus_test$Y  
  9. #predict函数可以获得模型的预测值。这里预测所需的模型对象为pre,预测对象newdata为测试集,预测所需类型type选择response,对响应变量的区间进行调整  
  10. predict. <- predict.glm(pre,type='response',newdata=aus_test)  
  11. #按照预测值为1的概率,>0.5的返回1,其余返回0  
  12. predict =ifelse(predict.>0.5,1,0)  
  13. #数据中加入预测值一列  
  14. aus_test$predict = predict  
  15. #导出结果为csv格式  
  16. #write.csv(aus_test,"aus_test.csv")  

3.模型检验

  1. ##模型检验  
  2. res <- data.frame(real,predict)  
  3. #训练数据的行数,也就是样本数量  
  4. n = nrow(aus_train)        
  5. #计算Cox-Snell拟合优度  
  6. R2 <- 1-exp((pre$deviance-pre$null.deviance)/n)      
  7. cat("Cox-Snell R2=",R2,"\n")  
  8. #计算Nagelkerke拟合优度,我们在最后输出这个拟合优度值  
  9. R2<-R2/(1-exp((-pre$null.deviance)/n))    
  10. cat("Nagelkerke R2=",R2,"\n")  
  11. ##模型的其他指标  
  12. #residuals(pre)     #残差  
  13. #coefficients(pre)  #系数,线性模型的截距项和每个自变量的斜率,由此得出线性方程表达式。或者写为coef(pre)  
  14. #anova(pre)         #方差  

4.准确率和精度

  1. true_value=aus_test[,15]  
  2. predict_value=aus_test[,16]  
  3. #计算模型精确度  
  4. error = predict_value-true_value  
  5. accuracy = (nrow(aus_test)-sum(abs(error)))/nrow(aus_test) #精确度--判断正确的数量占总数的比例  
  6. #计算Precision,Recall和F-measure  
  7. #一般来说,Precision就是检索出来的条目(比如:文档、网页等)有多少是准确的,Recall就是所有准确的条目有多少被检索出来了  
  8. #和混淆矩阵结合,Precision计算的是所有被检索到的item(TP+FP)中,"应该被检索到的item(TP)”占的比例;Recall计算的是所有检索到的item(TP)占所有"应该被检索到的item(TP+FN)"的比例。  
  9. precision=sum(true_value & predict_value)/sum(predict_value)  #真实值预测值全为1 / 预测值全为1 --- 提取出的正确信息条数/提取出的信息条数  
  10. recall=sum(predict_value & true_value)/sum(true_value)  #真实值预测值全为1 / 真实值全为1 --- 提取出的正确信息条数 /样本中的信息条数  
  11. #P和R指标有时候会出现的矛盾的情况,这样就需要综合考虑他们,最常见的方法就是F-Measure(又称为F-Score)  
  12. F_measure=2*precision*recall/(precision+recall)    #F-Measure是Precision和Recall加权调和平均,是一个综合评价指标  
  13. #输出以上各结果  
  14. print(accuracy)  
  15. print(precision)  
  16. print(recall)  
  17. print(F_measure)  
  18. #混淆矩阵,显示结果依次为TP、FN、FP、TN  
  19. table(true_value,predict_value)           

5.ROC曲线的几个方法

  1. #ROC曲线  
  2. # 方法1  
  3. #install.packages("ROCR")    
  4. library(ROCR)       
  5. pred <- prediction(predict.,true_value)   #预测值(0.5二分类之前的预测值)和真实值     
  6. performance(pred,'auc')@y.values        #AUC值  
  7. perf <- performance(pred,'tpr','fpr')  
  8. plot(perf)  
  9. #方法2  
  10. #install.packages("pROC")  
  11. library(pROC)  
  12. modelroc <- roc(true_value,predict.)  
  13. plot(modelroc, print.auc=TRUE, auc.polygon=TRUE,legacy.axes=TRUE, grid=c(0.1, 0.2),  
  14.      grid.col=c("green", "red"), max.auc.polygon=TRUE,  
  15.      auc.polygon.col="skyblue", print.thres=TRUE)        #画出ROC曲线,标出坐标,并标出AUC的值  
  16. #方法3,按ROC定义  
  17. TPR=rep(0,1000)  
  18. FPR=rep(0,1000)  
  19. p=predict.  
  20. for(i in 1:1000)  
  21.   {   
  22.   p0=i/1000;  
  23.   ypred<-1*(p>p0)    
  24.   TPR[i]=sum(ypred*true_value)/sum(true_value)    
  25.   FPR[i]=sum(ypred*(1-true_value))/sum(1-true_value)  
  26.   }  
  27. plot(FPR,TPR,type="l",col=2)  
  28. points(c(0,1),c(0,1),type="l",lty=2)  

6.更换测试集和训练集的选取方式,采用十折交叉验证

  1. australian <- read.csv("australian.csv",as.is = T,sep=",",header=TRUE)  
  2. #将australian数据分成随机十等分  
  3. #install.packages("caret")  
  4. #固定folds函数的分组  
  5. set.seed(7)  
  6. require(caret)  
  7. folds <- createFolds(y=australian$Y,k=10)  
  8.   
  9. #构建for循环,得10次交叉验证的测试集精确度、训练集精确度  
  10.   
  11. max=0  
  12. num=0  
  13.   
  14. for(i in 1:10){  
  15.     
  16.   fold_test <- australian[folds[[i]],]   #取folds[[i]]作为测试集  
  17.   fold_train <- australian[-folds[[i]],]   # 剩下的数据作为训练集  
  18.     
  19.   print("***组号***")  
  20.     
  21.   fold_pre <- glm(Y ~.,family=binomial(link='logit'),data=fold_train)  
  22.   fold_predict <- predict(fold_pre,type='response',newdata=fold_test)  
  23.   fold_predict =ifelse(fold_predict>0.5,1,0)  
  24.   fold_test$predict = fold_predict  
  25.   fold_error = fold_test[,16]-fold_test[,15]  
  26.   fold_accuracy = (nrow(fold_test)-sum(abs(fold_error)))/nrow(fold_test)   
  27.   print(i)  
  28.   print("***测试集精确度***")  
  29.   print(fold_accuracy)  
  30.   print("***训练集精确度***")  
  31.   fold_predict2 <- predict(fold_pre,type='response',newdata=fold_train)  
  32.   fold_predict2 =ifelse(fold_predict2>0.5,1,0)  
  33.   fold_train$predict = fold_predict2  
  34.   fold_error2 = fold_train[,16]-fold_train[,15]  
  35.   fold_accuracy2 = (nrow(fold_train)-sum(abs(fold_error2)))/nrow(fold_train)   
  36.   print(fold_accuracy2)  
  37.     
  38.     
  39.   if(fold_accuracy>max)  
  40.     {  
  41.     max=fold_accuracy    
  42.     num=i  
  43.     }  
  44.     
  45. }  
  46.   
  47. print(max)  
  48. print(num)  
  49.   
  50. ##结果可以看到,精确度accuracy最大的一次为max,取folds[[num]]作为测试集,其余作为训练集。  

7.得到十折交叉验证的精确度,结果导出

  1. #十折里测试集最大精确度的结果  
  2. testi <- australian[folds[[num]],]  
  3. traini <- australian[-folds[[num]],]   # 剩下的folds作为训练集  
  4. prei <- glm(Y ~.,family=binomial(link='logit'),data=traini)  
  5. predicti <- predict.glm(prei,type='response',newdata=testi)  
  6. predicti =ifelse(predicti>0.5,1,0)  
  7. testi$predict = predicti  
  8. #write.csv(testi,"ausfold_test.csv")  
  9. errori = testi[,16]-testi[,15]  
  10. accuracyi = (nrow(testi)-sum(abs(errori)))/nrow(testi)   
  11.   
  12. #十折里训练集的精确度  
  13. predicti2 <- predict.glm(prei,type='response',newdata=traini)  
  14. predicti2 =ifelse(predicti2>0.5,1,0)  
  15. traini$predict = predicti2  
  16. errori2 = traini[,16]-traini[,15]  
  17. accuracyi2 = (nrow(traini)-sum(abs(errori2)))/nrow(traini)   
  18.   
  19. #测试集精确度、取第i组、训练集精确  
  20. accuracyi;num;accuracyi2  
  21. #write.csv(traini,"ausfold_train.csv")  





    本站是提供个人知识管理的网络存储空间,所有内容均由用户发布,不代表本站观点。请注意甄别内容中的联系方式、诱导购买等信息,谨防诈骗。如发现有害或侵权内容,请点击一键举报。
    转藏 分享 献花(0

    0条评论

    发表

    请遵守用户 评论公约

    类似文章 更多