diff --git a/NAMESPACE b/NAMESPACE
index 0fa2efb..8e78021 100644
--- a/NAMESPACE
+++ b/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")
diff --git a/R/geom_polygon_auc.R b/R/geom_polygon_auc.R
new file mode 100644
index 0000000..453a0db
--- /dev/null
+++ b/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
diff --git a/R/ggroc.R b/R/ggroc.R
index 9308377..d0723e7 100644
--- a/R/ggroc.R
+++ b/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)) {
diff --git a/man/geom_polygon_auc.roc.Rd b/man/geom_polygon_auc.roc.Rd
new file mode 100644
index 0000000..e838f99
--- /dev/null
+++ b/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)
+
+}
diff --git a/tests/testthat/_snaps/geom_polygon_auc/geom-polygon-auc-partial-screenshot.svg b/tests/testthat/_snaps/geom_polygon_auc/geom-polygon-auc-partial-screenshot.svg
new file mode 100644
index 0000000..c982a0b
--- /dev/null
+++ b/tests/testthat/_snaps/geom_polygon_auc/geom-polygon-auc-partial-screenshot.svg
@@ -0,0 +1,76 @@
+
+
diff --git a/tests/testthat/_snaps/geom_polygon_auc/geom-polygon-auc-percent-legacy-screenshot.svg b/tests/testthat/_snaps/geom_polygon_auc/geom-polygon-auc-percent-legacy-screenshot.svg
new file mode 100644
index 0000000..c852d3e
--- /dev/null
+++ b/tests/testthat/_snaps/geom_polygon_auc/geom-polygon-auc-percent-legacy-screenshot.svg
@@ -0,0 +1,75 @@
+
+
diff --git a/tests/testthat/_snaps/geom_polygon_auc/geom-polygon-auc-screenshot.svg b/tests/testthat/_snaps/geom_polygon_auc/geom-polygon-auc-screenshot.svg
new file mode 100644
index 0000000..d67e13d
--- /dev/null
+++ b/tests/testthat/_snaps/geom_polygon_auc/geom-polygon-auc-screenshot.svg
@@ -0,0 +1,75 @@
+
+
diff --git a/tests/testthat/helper-rocs.R b/tests/testthat/helper-rocs.R
index 5d42248..ed90fb2 100644
--- a/tests/testthat/helper-rocs.R
+++ b/tests/testthat/helper-rocs.R
@@ -21,3 +21,4 @@ r.ndka.percent.partial1 <- roc(aSAH$outcome, aSAH$ndka, percent = TRUE, quiet =
r.s100b.percent.partial1 <- roc(aSAH$outcome, aSAH$s100b, percent = TRUE, quiet = TRUE, partial.auc = c(90, 99))
r.s100b.partial2 <- roc(aSAH$outcome, aSAH$s100b, quiet = TRUE, partial.auc = c(.9, .99), partial.auc.focus = "se")
+r.s100b.percent.partial2 <- roc(aSAH$outcome, aSAH$s100b, percent = TRUE, quiet = TRUE, partial.auc = c(90, 99), partial.auc.focus = "se")
diff --git a/tests/testthat/test-geom_polygon_auc.R b/tests/testthat/test-geom_polygon_auc.R
new file mode 100644
index 0000000..1140918
--- /dev/null
+++ b/tests/testthat/test-geom_polygon_auc.R
@@ -0,0 +1,27 @@
+context("geom_polygon_auc")
+
+test_that("geom_polygon_auc works", {
+ test_geom_polygon_auc_screenshot <- function() {
+ print(ggroc(r.s100b) + geom_polygon_auc(r.s100b$auc))
+ }
+ expect_ggroc_doppelganger("geom_polygon_auc.screenshot", test_geom_polygon_auc_screenshot)
+})
+
+test_that("geom_polygon_auc works with percent and legacy.axes = TRUE", {
+ test_geom_polygon_auc_percent_legacy_screenshot <- function() {
+ print(ggroc(r.s100b.percent, legacy.axes = TRUE) + geom_polygon_auc(r.s100b.percent$auc, legacy.axes = TRUE))
+ }
+ expect_ggroc_doppelganger("geom_polygon_auc.percent.legacy.screenshot", test_geom_polygon_auc_percent_legacy_screenshot)
+})
+
+
+test_that("geom_polygon_auc works with percent and legacy.axes = TRUE", {
+ test_geom_polygon_auc_partial_screenshot <- function() {
+ auc_sp = auc(roc.s100b, partial.auc = c(0.8, 0.9), partial.auc.focus="sp")
+ auc_se = auc(roc.s100b, partial.auc = c(0.8, 0.9), partial.auc.focus="se")
+ print(ggroc(roc.s100b) +
+ geom_polygon_auc(auc_se) +
+ geom_polygon_auc(auc_sp))
+ }
+ expect_ggroc_doppelganger("geom_polygon_auc.partial.screenshot", test_geom_polygon_auc_partial_screenshot)
+})