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 < cases
roc
#>
#> 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.8301887
cutoff_text <- paste0(round(cutoff$threshold,3),"(",round(cutoff$specificity,3),",",round(cutoff$sensitivity,3),")")
cutoff_text
#> [1] "7.835(0.34,0.83)"
# 计算AUC
auc <- 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,
)
#> Scale for x is already present.
#> Adding another scale for x, which will replace the existing scale.
