模型评估 | R语言实现ROC

• 2019 年 12 月 25 日
• 筆記

上一篇是关于ROC的含义及Python的实现，现在通过R来实现ROC，实现逻辑完全一样。

其中Pred_Var是预测结果，可以为预测概率或评分；labels_Var是目标变量，取值0或1；N表示在计算AUC值时切分的数量；descending表示数据是否降序排列，当Pred_Var为评分时升序，当Pred_Var为概率时降序；输出结果为存放AUC值和ROC曲线对象的列表。

library(dplyr)  library(ggplot2)  PlotROC_N <-function(Pred_Var, labels_Var, descending, N){    # Pred_Var is prob: descending=1    # Pred_Var is score: descending=0      df<- data.frame(Pred=Pred_Var, labels=labels_Var)      if (descending==1){      df1<-arrange(df, desc(Pred))    }else if (descending==0){      df1<-arrange(df, Pred)    }      len<- ceiling(dim(df1)[1]/N)    N_0<- table(df1$labels)[1]    N_1<- table(df1$labels)[2]      I<- c(0)    TPR<- c(0)    FPR<- c(0)    area<- c(0)      L<- nrow(df1)    if (N>L) N<- L    df1$rowno<- 1:L    qus<- quantile(1:L, probs = seq(0,1, 1/N))      out<- mapply(      function(i){        sub<- df1[df1$rowno<ifelse(i==N, qus[i+1]+0.001, qus[i+1]), ]        I<<- c(I, i)          TPR_temp<-sum(sub$labels==1)/N_1        FPR_temp<-sum(sub$labels==0)/N_0        area_temp<-0.5*(TPR_temp+TPR[length(TPR)])*(FPR_temp-FPR[length(FPR)])          TPR<<- c(TPR, TPR_temp)        FPR<<- c(FPR, FPR_temp)        area<<- c(area, area_temp)        }, 1:N)      df_roc<- data.frame(I=I, TPR=TPR, FPR=FPR, area=area)      #calculate the AUC: area under the curve    AUC<-round(sum(df_roc$area), 4)      # Plot ROC-curve    PlotROC<- ggplot(      data = df_roc, aes(x= FPR, y = TPR)) +      geom_line(colour='steelblue4', size=1.2) +      geom_abline(intercept=0, slope =1, linetype=2, size=1, colour="gray40") +        scale_x_continuous(breaks=seq(0,1,.2))+      scale_y_continuous(breaks=seq(0,1,.2))+        annotate("text", x = 0.5, y = 1.05, label=paste("AUC=",AUC), size=4, alpha=0.8) +      labs(x="False positive rate", y ="True positive rate", title ="ROC-Curve") +        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")      )      result<-list(AUC=AUC, PlotROC=PlotROC)    return(result)  }

运行代码，设置N=10，N越大AUC值越精确：

result <- PlotROC_N(predict, y, 1, 10)

AUC值：

> result$AUC  [1] 0.806

ROC曲线：

result$PlotROC