R/roc.R

#' @include Classifiers-class.R
NULL


# Data extraction ----

#' Extract roc data from a Classifier object.
#'
#' @param Classifier Classifier object.
#'
#' @return data.frame
#' @export
setGeneric("roc", function(Classifier, ...) standardGeneric("roc"))


#' @rdname roc
setMethod("roc",
          signature = c(Classifier="ClassifierCurve"),
          function(Classifier){
              pred <- ROCR::prediction(predictions=Classifier@pY, labels=Classifier@Y)
              roc_perf <- ROCR::performance(pred, measure="tpr", x.measure="fpr")
              roc_dat = data.frame(
                  x = roc_perf@x.values %>% unlist,
                  y = roc_perf@y.values %>% unlist,
                  alpha = roc_perf@alpha.values %>% unlist)
              return(roc_dat)}
          )


#' @rdname roc
setMethod("roc",
          signature = c(Classifier="ClassifierPoint"),
          function(Classifier) {
              roc_dat <- data.frame(
                  x = sum(Classifier@Y_ & !Classifier@Y) / sum(!Classifier@Y),
                  y = sum(Classifier@Y_ & Classifier@Y) / sum(Classifier@Y)
                )
              return(roc_dat)})


# ROC vizualization ----
gg_roc_layers <- list(
    ggplot2::geom_abline(alpha=0.3),
    ggplot2::labs(title="ROC Curve", x = '1-Specificity', y = 'Sensitivity'),
    ggplot2::coord_equal(xlim=c(0, 1), ylim=c(0, 1), expand=FALSE)
)


#' Plot an roc curve for a classifier
#'
#' @param x classifier object
#' @param ... tbd
#'
#' @return ggplot object
#' @export
setGeneric("gg_roc", function(x, ...) standardGeneric("gg_roc"))

#' @rdname gg_roc
#' @export
setMethod("gg_roc",
          signature = c(x="ClassifierCurve"),
          function(x) {
              ggplot(roc(x), aes(x=x, y=y)) +
                  geom_line() +
                  gg_roc_layers})

#' @rdname gg_roc
#' @export
setMethod("gg_roc",
          signature = c(x="ClassifierPoint"),
          function(x) {
              ggplot(roc(x), aes(x=x, y=y)) +
                  geom_point() +
                  gg_roc_layers
        })
mbadge/AnalysisToolkitR documentation built on May 27, 2019, 1:08 p.m.