tests/testthat/helper-roc_points.R

In ROCnGO: Fast Analysis of ROC Curves

# Preliminary function to use in the TpAUC function
# points.curve function calculates the coordinates (FPR, TPR) of the ROC curve 
# Inputs:
#   xsample : binary variable with 1 indicating success occurs
#   ysample : variable of the diagnostic test results
# Output:
#   xy.roc : pairs of points (fpr, tpr) of the ROC curve
#
points.curve <- function(xsample, ysample) {
    fpr.p <- NULL; sen.p <- NULL
    x.p <- xsample[which(is.na(xsample)==FALSE & is.na(ysample)==FALSE)]
    y.p <- ysample[which(is.na(xsample)==FALSE & is.na(ysample)==FALSE)]


    pts <- sort(y.p)
    pts <- append(pts[-length(pts)]+diff(pts)/2, min(pts)-1, 0)
    pts <- append(pts, max(y.p)+1, length(pts))

    for (i.pt in 1:length(pts)) {
        pt <- pts[i.pt]
        pre.p <- (y.p>pt)*1
        fpr.p[i.pt] <- sum((pre.p==1)*(x.p==0))/sum(x.p==0)
        sen.p[i.pt] <- sum((pre.p==1)*(x.p==1))/sum(x.p==1)
    }

    if (is.unsorted(sen.p)) {
        sen.p <- rev(sen.p)
        fpr.p <- rev(fpr.p)
    }
    xy.roc <- cbind(fpr.p,sen.p)
    return(xy.roc)
}

#' Defined function to check points
points.thresholds <- function(xsample, ysample) {
    x.p <- xsample[which(is.na(xsample) == FALSE & is.na(ysample) == FALSE)]
    y.p <- ysample[which(is.na(xsample) == FALSE & is.na(ysample) == FALSE)]

    pts <- sort(y.p)
    pts <- append(pts[-length(pts)] + diff(pts) / 2, min(pts) - 1, 0)
    pts <- append(pts, max(y.p) + 1, length(pts))
}