# R/RocCurve.R In HenrikBengtsson/aroma.cn.eval: Objective Assessment of Copy-Number Estimates

###########################################################################/**
# @RdocClass RocCurve
#
# @title "The RocCurve class"
#
# \description{
#  @classhierarchy
# }
#
# @synopsis
#
# \arguments{
#   \item{roc}{A @matrix with N (FP,TP) rate data points.}
#   \item{cuts}{A @numerical @vector of N+1 cuts.}
#   \item{counts}{A @numerical @vector of N+1 cuts.}
#   \item{...}{Not used.}
# }
#
# \section{Fields and Methods}{
#  @allmethods "public"
# }
#
# @author
#*/###########################################################################
setConstructorS3("RocCurve", function(roc=NULL, cuts=NULL, counts=NULL, ...) {
# Argument 'roc':
if (is.list(roc)) {
rocList <- roc;
if (!is.element("roc", names(rocList))) {
throw("When argument 'roc' is a list, it must contain element 'roc'.");
}
roc <- rocList$roc; if (is.element("cuts", names(rocList))) cuts <- rocList$cuts;
if (is.element("counts", names(rocList))) counts <- rocList$counts; } if (!is.null(roc)) { if (!is.matrix(roc)) { stop("Argument 'roc' must be a matrix: ", class(roc)[1L]); } } if (!is.null(cuts)) { if (!is.numeric(cuts)) { stop("Argument 'cuts' must be a numeric vector: ", class(cuts)[1L]); } if (length(cuts) != nrow(roc) + 1L) { stop("Length argument 'cuts' is not one more than the number of rows in argument 'roc': ", length(cuts), " != ", nrow(roc) + 1L); } } extend(BasicObject(), "RocCurve", roc=roc, cuts=cuts, counts=counts ) }) setMethodS3("as.character", "RocCurve", function(x, ...) { # To please R CMD check object <- x; s <- sprintf("%s: ", class(object)[1]); s <- c(s, sprintf("AUC: %.4g", auc(object))); s <- c(s, sprintf("Number of cuts: %d", length(object$cuts)));
counts <- getCounts(object);
if (is.null(counts)) counts <- c(NA_integer_, NA_integer_);
s <- c(s, sprintf("Number of positives: %d (%.2f%%) of %d", counts[1L], 100*counts[1L]/sum(counts), sum(counts)));

GenericSummary(s);
})

setMethodS3("getCounts", "RocCurve", function(object, ...) {
object$counts; }) setMethodS3("getFpRate", "RocCurve", function(object, ...) { object$roc[,"fpRate"];
})

setMethodS3("getTpRate", "RocCurve", function(object, ...) {
object$roc[,"tpRate"]; }) setMethodS3("auc", "RocCurve", function(object, ...) { roc <- object$roc[,c("fpRate","tpRate")];

roc0 <- roc[1L,]
if (roc0[1] != 0 || roc0[2] != 0) roc <- rbind(c(0,0), roc);

roc1 <- roc[nrow(roc),]
if (roc1[1] != 1 || roc1[2] != 1) roc <- rbind(roc, c(1,1));

trapezint(roc[,"fpRate"], roc[,"tpRate"], a=0, b=1);
})

setMethodS3("plot", "RocCurve", function(x, lwd=2, xlim=c(0,1), ylim=c(1-diff(xlim),1), xlab="FP rate", ylab="TP rate", ...) {
# To please R CMD check
object <- x;

plot(object$roc, type="l", lwd=lwd, xlab=xlab, ylab=ylab, xlim=xlim, ylim=ylim, ...); }) setMethodS3("points", "RocCurve", function(x, ...) { # To please R CMD check object <- x; points(object$roc, ...);
})

setMethodS3("lines", "RocCurve", function(x, lwd=2, ...) {
# To please R CMD check
object <- x;

lines(object\$roc, lwd=lwd, ...);
})

############################################################################
# HISTORY:
# 2014-03-24
# o Now RocCurve also stored total counts.
# o ROBUSTNESS: Added validation of arguments to RocCurve().
# o Now RocCurve() also accepts a list with element 'roc' and 'cuts'.
# 2007-08-20
# o Added file caching to fitRoc2().
# 2007-08-19
# o Renamed argument 'call' to 'toCall' in fitRoc().
# 2007-04-15