Add geom_polygon_auc function (issue #129)

NAMESPACE

@@ -153,6 +153,11 @@ S3method("ggroc", "roc")
 S3method("ggroc", "smooth.roc")
 S3method("ggroc", "list")
 
+export(geom_polygon_auc)
+S3method("geom_polygon_auc", "auc")
+S3method("geom_polygon_auc", "roc")
+S3method("geom_polygon_auc", "smooth.roc")
+
 #export(select)
 #export(select_)
 #importFrom("dplyr", "select")

R/geom_polygon_auc.R

@@ -0,0 +1,48 @@
+geom_polygon_auc <- function(data, ...) {
+	UseMethod("geom_polygon_auc")
+}
+
+geom_polygon_auc.auc <- function(data, legacy.axes = FALSE, ...) {
+	# Get the roc data with coords
+	roc <- attr(data, "roc")
+	roc$auc <- data
+	df <- get.coords.for.ggplot(roc, ignore.partial.auc = FALSE)
+
+	# Add bottom-right point
+	partial.auc <- attr(data, "partial.auc")
+	one.or.hundred <- ifelse(attr(data, "percent"), 100, 1)
+	if (legacy.axes) {
+		if (identical(partial.auc, FALSE)) {
+			df[nrow(df) + 1, ] <- c(NA, one.or.hundred, 0, one.or.hundred)
+		}
+		else if (attr(data, "partial.auc.focus") == "sensitivity") {
+			df[nrow(df) + c(1, 2), ] <- c(NA, NA, one.or.hundred, one.or.hundred, partial.auc, one.or.hundred, one.or.hundred)
+		}
+		else { # partial.auc.focus == "specificity"
+			df[nrow(df) + c(1, 2), ] <- c(NA, NA, rev(partial.auc), 0, 0, one.or.hundred - rev(partial.auc))
+		}
+	}
+	else {
+		if (identical(partial.auc, FALSE)) {
+			df[nrow(df) + 1, ] <- c(NA, 0, 0, 0)
+		}
+		else if (attr(data, "partial.auc.focus") == "sensitivity") {
+			df[nrow(df) + c(1, 2), ] <- c(NA, NA, 0, 0, partial.auc, 0, 0)
+		}
+		else { # partial.auc.focus == "specificity"
+			df[nrow(df) + c(1, 2), ] <- c(NA, NA, rev(partial.auc), 0, 0, one.or.hundred - rev(partial.auc))
+		}
+	}
+
+	# Prepare the aesthetics
+	aes <- get.aes.for.ggplot(attr(data, "roc"), legacy.axes)
+
+	# Do the plotting
+	ggplot2::geom_polygon(aes$aes, data=df, ...)
+}
+
+geom_polygon_auc.roc <- function(data, ...) {
+	geom_polygon_auc(data$auc, ...)
+}
+
+geom_polygon_auc.smooth.roc <- geom_polygon_auc.roc

R/ggroc.R

@@ -1,7 +1,7 @@
 
 # Returns the coords as a data.frame in the right ordering for ggplot2 
-get.coords.for.ggplot <- function(roc) {
-	df <- coords(roc, "all", transpose = FALSE)
+get.coords.for.ggplot <- function(roc, ignore.partial.auc) {
+	df <- coords(roc, "all", transpose = FALSE, ignore.partial.auc = ignore.partial.auc)
 	df[["1-specificity"]] <- ifelse(roc$percent, 100, 1) - df[["specificity"]]
 	return(df[rev(seq(nrow(df))),])
 }
@@ -61,7 +61,7 @@ ggroc <- function(data, ...) {
 ggroc.roc <- function(data, legacy.axes = FALSE, ...) {
 	load.ggplot2()
 	# Get the roc data with coords
-	df <- get.coords.for.ggplot(data)
+	df <- get.coords.for.ggplot(data, ignore.partial.auc = TRUE)
 
 	# Prepare the aesthetics
 	aes <- get.aes.for.ggplot(data, legacy.axes)
@@ -101,7 +101,7 @@ ggroc.list <- function(data, aes = c("colour", "alpha", "linetype", "linewidth",
 	}
 
 	# Get the coords
-	coord.dfs <- sapply(data, get.coords.for.ggplot, simplify = FALSE)
+	coord.dfs <- sapply(data, get.coords.for.ggplot, simplify = FALSE, ignore.partial.auc = TRUE)
 
 	# Add a "name" colummn
 	for (i in seq_along(coord.dfs)) {

man/geom_polygon_auc.roc.Rd

@@ -0,0 +1,56 @@
+\encoding{UTF-8}
+\name{geom_polygon_auc}
+\alias{geom_polygon_auc.auc}
+\alias{geom_polygon_auc.roc}
+\alias{geom_polygon_auc.smooth.roc}
+\alias{geom_polygon_auc}
+
+\title{
+  Add an AUC polygon to a ggroc plot
+}
+\description{
+  EXPERIMENTAL - Add an AUC polygon to a ggroc plot.
+}
+\usage{
+\S3method{geom_polygon_auc}{roc}(data, legacy.axes = FALSE, ...)
+\S3method{geom_polygon_auc}{smooth.roc}(data, legacy.axes = FALSE, ...)
+}
+
+\arguments{
+  \item{data}{a roc object from the \link{roc} function, same as the one
+  used to build the ggroc initially.
+  }
+  \item{legacy.axes}{must match the value given to \code{ggroc}.
+  }
+  \item{...}{additional aesthetics for \code{\link[ggplot2:geom_polygon]{geom_polygon}}
+    to set: \code{alpha}, \code{colour}, \code{linetype} and \code{linewidth}.
+  }
+}
+
+\details{
+}
+
+
+\seealso{
+\code{\link{ggroc}}
+}
+\examples{
+
+# Create a ROC curve:
+data(aSAH)
+roc.s100b <- roc(aSAH$outcome, aSAH$s100b)
+roc.s100b.percent <- roc(aSAH$outcome, aSAH$s100b, percent = TRUE)
+
+ggroc(roc.s100b) + geom_polygon_auc(roc.s100b$auc)
+
+# legacy.axes must be repeated
+ggroc(roc.s100b.percent, legacy.axes=TRUE) + geom_polygon_auc(roc.s100b.percent, legacy.axes=TRUE)
+
+# Partial AUCs
+auc.s100b.partial.sp <- auc(roc.s100b, partial.auc = c(0.9, 1))
+auc.s100b.partial.se <- auc(roc.s100b, partial.auc = c(0.8, 0.9), partial.auc.focus="se")
+
+ggroc(roc.s100b) + geom_polygon_auc(auc.s100b.partial.sp)
+ggroc(roc.s100b) + geom_polygon_auc(auc.s100b.partial.se)
+
+}