library(tidymodels)#> Warning: package 'tidymodels' was built under R version 4.5.2#> ── Attaching packages ────────────────────────────────────── tidymodels 1.4.1 ──#> ✔ broom 1.0.10 ✔ recipes 1.3.1 #> ✔ dials 1.4.2 ✔ rsample 1.3.1 #> ✔ dplyr 1.1.4 ✔ tailor 0.1.0 #> ✔ ggplot2 4.0.1 ✔ tidyr 1.3.1 #> ✔ infer 1.0.9 ✔ tune 2.0.1 #> ✔ modeldata 1.5.1 ✔ workflows 1.3.0 #> ✔ parsnip 1.3.3 ✔ workflowsets 1.1.1 #> ✔ purrr 1.2.0 ✔ yardstick 1.3.2#> Warning: package 'broom' was built under R version 4.5.2#> Warning: package 'dials' was built under R version 4.5.2#> Warning: package 'modeldata' was built under R version 4.5.2#> Warning: package 'parsnip' was built under R version 4.5.2#> Warning: package 'purrr' was built under R version 4.5.2#> Warning: package 'rsample' was built under R version 4.5.2#> Warning: package 'tailor' was built under R version 4.5.2#> Warning: package 'tune' was built under R version 4.5.2#> Warning: package 'workflows' was built under R version 4.5.2#> ── Conflicts ───────────────────────────────────────── tidymodels_conflicts() ──#> ✖ purrr::discard() masks scales::discard()#> ✖ dplyr::filter() masks stats::filter()#> ✖ dplyr::lag() masks stats::lag()#> ✖ recipes::step() masks stats::step()library(tidyverse)#> Warning: package 'stringr' was built under R version 4.5.2#> Warning: package 'forcats' was built under R version 4.5.2#> ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──#> ✔ forcats 1.0.1 ✔ stringr 1.6.0#> ✔ lubridate 1.9.4 ✔ tibble 3.3.0#> ✔ readr 2.1.6#> ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──#> ✖ readr::col_factor() masks scales::col_factor()#> ✖ purrr::discard() masks scales::discard()#> ✖ dplyr::filter() masks stats::filter()#> ✖ stringr::fixed() masks recipes::fixed()#> ✖ dplyr::lag() masks stats::lag()#> ✖ readr::spec() masks yardstick::spec()#> ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errorsdata(two_class_example,package ="yardstick")tibble(two_class_example)#> # A tibble: 500 × 4#> truth Class1 Class2 predicted#> <fct> <dbl> <dbl> <fct> #> 1 Class2 0.00359 0.996 Class2 #> 2 Class1 0.679 0.321 Class1 #> 3 Class2 0.111 0.889 Class2 #> 4 Class1 0.735 0.265 Class1 #> 5 Class2 0.0162 0.984 Class2 #> 6 Class1 0.999 0.000725 Class1 #> 7 Class1 0.999 0.000799 Class1 #> 8 Class1 0.812 0.188 Class1 #> 9 Class2 0.457 0.543 Class2 #> 10 Class2 0.0976 0.902 Class2 #> # ℹ 490 more rows
library(pROC)#> Warning: package 'pROC' was built under R version 4.5.2#> Type 'citation("pROC")' for a citation.#> #> Attaching package: 'pROC'#> The following objects are masked from 'package:stats':#> #> cov, smooth, var
Code
set.seed(10)df<-tibble( group =sample(c("1","0"),size =100,replace =T), value =rnorm(100,10,3))roc<-roc(df$group,df$value, smooth =F,ci=T,auc=T)#> Setting levels: control = 0, case = 1#> Setting direction: controls < casesroc#> #> Call:#> roc.default(response = df$group, predictor = df$value, smooth = F, auc = T, ci = T)#> #> Data: df$value in 47 controls (df$group 0) < 53 cases (df$group 1).#> Area under the curve: 0.5319#> 95% CI: 0.4159-0.6479 (DeLong)# 计算最佳截断值cutoff<-coords(roc,"best")cutoff#> threshold specificity sensitivity#> 1 7.834545 0.3404255 0.8301887cutoff_text<-paste0(round(cutoff$threshold,3),"(",round(cutoff$specificity,3),",",round(cutoff$sensitivity,3),")")cutoff_text#> [1] "7.835(0.34,0.83)"# 计算AUCauc<-auc(roc)[1]auc_low<-ci(roc,of="auc")[1]auc_up<-ci(roc,of="auc")[3]# 计算置信区间ci<-ci.se(roc,specificities=seq(0,1,0.01))df_ci<-ci[1:101,1:3]df_ci<-as.data.frame(df_ci)df_ci<-tibble( x=rownames(df_ci)|>as.numeric(),df_ci,)# 绘图ggroc(roc, color="red",size=1,legacy.axes =T)+theme_classic()+scale_x_continuous(expand =expansion(mult =c(0,0)))+scale_y_continuous(expand =expansion(mult =c(0,0)))+# 对角线geom_abline(slope =1,linetype=3)+# 置信区间geom_ribbon( mapping =aes(x=1-x,ymin=`2.5%`,ymax=`97.5%`), data =df_ci, fill="lightblue",alpha=0.3,)+# 截断值geom_point(aes(x=1-specificity,y=sensitivity), data =cutoff, size=2)+# 截断值文字注释geom_text(aes(x=1-specificity,y=sensitivity,label=cutoff_text), data =cutoff, vjust=-1,)#> Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.#> ℹ Please use `linewidth` instead.#> ℹ The deprecated feature was likely used in the pROC package.#> Please report the issue at <https://github.com/xrobin/pROC/issues>.#> Scale for x is already present.#> Adding another scale for x, which will replace the existing scale.
