In sungcheolkim78/FiDEL: Fermi-Dirac based Ensemble Learning

knitr::opts_chunk$set(echo = TRUE)
library(FiDEL)
#library(pROC)
library(tictoc)

check CI function

rholist <- c(0.1, 0.3, 0.5, 0.7, 0.9)
auclist <- create.auclist(0.6, 0.98, 10)
N0 <- 50000

res <- data.table()

for(r in rholist) {
  for (a in auclist) {
    # create test sets using AUC and prevalence
    y <- create.labels(N=N0, rho=r)
    gs <- create.scores.gaussian(y, auc=a)
    ds <- build_curve(gs, y)
    info <- attr(ds, 'info')

    # calculate confidence interval using pROC package
    ds_roc <- roc(y, gs)
    ds_ci <- ci(ds_roc)

    # data frame
    tmp <- data.table(N=length(y), rho=attr(y,'rho'), auc=a, auc_bac=info$auc_bac,
             auprc=info$auprc, th_bac=info$th_bac, rstar=info$rstar, 
             pxxy=info$Pxxy, pxyy=info$Pxyy, sig_auc=sqrt(info$var_auc), 
             sig_auc_delong=(ds_ci[2]-ds_ci[1])*.5)
    res <- rbind(res, tmp)
    rm(ds)
    rm(ds_roc)
  }
}

res

g1 <- ggplot(data=res) +
  geom_point(aes(y=rstar, x=th_bac)) + 
  geom_abline(slope=1, linetype='dashed') + theme_classic() +
  ylab(TeX('r_{FD}/N')) + xlab(TeX('r_{bac}/N')) + 
  xlim(c(0.1,0.9)) + ylim(c(0.1,0.9))
g1

gb2 <- ggplot(data=res) + 
  geom_point(aes(x=sig_auc_delong, y=sig_auc)) + 
  geom_abline(slope=1, linetype='dashed') + theme_classic() + 
  xlab(TeX('$\\sigma_{AUC}$ (Delong)')) + ylab(TeX('$\\sigma_{AUC}$ (FD)')) + 
  theme(legend.position='none')
gb2

library(ggpubr)
g <- ggarrange(g1, gb2, labels=c('A', 'B'), ncol=2, nrow=1)
ggsave("results/Figure3-dilog.pdf", width=7, height=3.5)
print(g)

sungcheolkim78/FiDEL documentation built on Nov. 13, 2024, 7:58 a.m.