#' Function frament of 'TpAUC.function' which calculates bounds in FPR inside a range fpr.lower.bounds <- function(xsample, ysample, lower.fp, upper.fp){ if (lower.fp>=upper.fp) { stop("Error in the prefixed FPR range") } fpr.roc <- points.curve(xsample, ysample)[,1] sen.roc <- points.curve(xsample, ysample)[,2] if (is.unsorted(sen.roc)) { sen.roc <- rev(sen.roc) fpr.roc <- rev(fpr.roc) } i.l <- min(which(fpr.roc>=lower.fp)) j.l <- max(i.l-1,1) i.u <- max(which(fpr.roc<=upper.fp)) j.u <- min(1+i.u, length(fpr.roc)) fpr.pr <- fpr.roc[i.l:i.u] sen.pr <- sen.roc[i.l:i.u] if (fpr.roc[i.l]>lower.fp) { fpr.pr <- append(fpr.pr, lower.fp, 0) lscale <- (fpr.pr[1]-fpr.roc[j.l])/(fpr.roc[i.l]-fpr.roc[j.l]) sen.pr <- append(sen.pr,sen.roc[j.l]+(sen.roc[i.l]-sen.roc[j.l])*lscale, 0) } if (fpr.roc[i.u]=upper.fp) { stop("Error in the prefixed FPR range") } fpr.roc <- points.curve(xsample, ysample)[,1] sen.roc <- points.curve(xsample, ysample)[,2] if (is.unsorted(sen.roc)) { sen.roc <- rev(sen.roc) fpr.roc <- rev(fpr.roc) } i.l <- min(which(fpr.roc>=lower.fp)) j.l <- max(i.l-1,1) i.u <- max(which(fpr.roc<=upper.fp)) j.u <- min(1+i.u, length(fpr.roc)) fpr.pr <- fpr.roc[i.l:i.u] sen.pr <- sen.roc[i.l:i.u] if (fpr.roc[i.l]>lower.fp) { fpr.pr <- append(fpr.pr, lower.fp, 0) lscale <- (fpr.pr[1]-fpr.roc[j.l])/(fpr.roc[i.l]-fpr.roc[j.l]) sen.pr <- append(sen.pr,sen.roc[j.l]+(sen.roc[i.l]-sen.roc[j.l])*lscale, 0) } if (fpr.roc[i.u]=plr.pr[length(plr.pr)])) { TpAUC.min <- TpAUC.min.dplr } else { if (all(sen.pr>=fpr.pr)) { TpAUC.min <- TpAUC.min.proper } else { TpAUC.min <- TpAUC.min.roc } } if (min(sen.pr)==max(sen.pr)) { warning("Constant ROC curve over the prefixed FPR range") TpAUC.max <- sum(diff(fpr.pr)) } else { TpAUC.max <- sum(diff(fpr.pr))*max(sen.pr) } list( tp_auc_max = TpAUC.max, tp_auc_min = TpAUC.min ) }