1

2
#' Returns the coords as a data.frame in the right ordering for ggplot2 
3
get.coords.for.ggplot <- function(roc) {
4 33
	df <- coords(roc, "all", transpose = FALSE)
5 33
	return(df[rev(seq(nrow(df))),])
6
}
7

8
get.aes.for.ggplot <- function(roc, legacy.axes, extra_aes = c()) {
9
	# Prepare the aesthetics
10 33
	if(roc$percent) {
11 33
		if (legacy.axes) {
12 0
			aes_list <- list(x = "1-specificity", y = "sensitivity")
13 0
			xlims <- ggplot2::scale_x_continuous(lim=c(0, 100))		
14
		}
15
		else {
16 33
			aes_list <- list(x = "specificity", y = "sensitivity")
17 33
			xlims <- ggplot2::scale_x_reverse(lim=c(100, 0))
18
		}
19
	}
20
	else {
21 33
		if (legacy.axes) {
22 0
			aes_list <- list(x = "1-specificity", y = "sensitivity")
23 0
			xlims <- ggplot2::scale_x_continuous(lim=c(0, 1))
24
		}
25
		else {
26 33
			aes_list <- list(x = "specificity", y = "sensitivity")
27 33
			xlims <- ggplot2::scale_x_reverse(lim=c(1, 0))
28
		}
29
	}
30
	# Add extra aes
31 33
	for (ae in extra_aes) {
32 33
		aes_list[[ae]] <- "name"
33
	}
34 33
	aes <- do.call(ggplot2::aes_string, aes_list)
35
	
36 33
	return(list(aes=aes, xlims=xlims))
37
}
38

39
load.ggplot2 <- function() {
40 33
	if (! isNamespaceLoaded("ggplot2")) {
41 33
		message('You may need to call library(ggplot2) if you want to add layers, etc.')
42
	}
43 33
	load.suggested.package("ggplot2")
44
}
45

46
ggroc <- function(data, ...) {
47 33
	UseMethod("ggroc")
48
}
49

50
ggroc.roc <- function(data, legacy.axes = FALSE, ...) {
51 33
	load.ggplot2()
52
	# Get the roc data with coords
53 33
	df <- get.coords.for.ggplot(data)
54

55
	# Prepare the aesthetics
56 33
	aes <- get.aes.for.ggplot(data, legacy.axes)
57

58
	# Do the plotting
59 33
	ggplot2::ggplot(df) + ggplot2::geom_line(aes$aes, ...) + aes$xlims
60
}
61

62
ggroc.list <- function(data, aes = c("colour", "alpha", "linetype", "size", "group"), legacy.axes = FALSE, ...) {
63 33
	load.ggplot2()
64 33
	if (missing(aes)) {
65 33
		aes <- "colour"
66
	}
67 33
	aes <- sub("color", "colour", aes)
68 33
	aes <- match.arg(aes, several.ok = TRUE)
69

70
	# Make sure data is a list and every element is a roc object
71 33
	if (! all(sapply(data, methods::is, "roc"))) {
72 0
		stop("All elements in 'data' must be 'roc' objects.")
73
	}
74
	
75
	# Make sure percent is consistent
76 33
	percents <- sapply(data, `[[`, "percent")
77 33
	if (!(all(percents) || all(!percents))) {
78 0
		stop("ROC curves use percent inconsistently and cannot be plotted together")
79
	}
80
	
81
	# Make sure the data is a named list
82 33
	if (is.null(names(data))) {
83 0
		names(data) <- seq(data)
84
	}
85
	# Make sure names are unique:
86 33
	if (any(duplicated(names(data)))) {
87 0
		stop("Names of 'data' must be unique")
88
	}
89
	
90
	# Get the coords
91 33
	coord.dfs <- sapply(data, get.coords.for.ggplot, simplify = FALSE)
92

93
	# Add a "name" colummn
94 33
	for (i in seq_along(coord.dfs)) {
95 33
		coord.dfs[[i]]$name <- names(coord.dfs)[i]
96
	}
97
	
98
	# Make a big data.frame
99 33
	coord.dfs <- do.call(rbind, coord.dfs)
100 33
    coord.dfs$name <- factor(coord.dfs$name, as.vector(names(data)))
101
	
102
	# Prepare the aesthetics
103 33
	aes.ggplot <- get.aes.for.ggplot(data[[1]], legacy.axes, aes)
104

105
	# Do the plotting
106 33
	ggplot2::ggplot(coord.dfs, aes.ggplot$aes) + ggplot2::geom_line(...) + aes.ggplot$xlims
107
}

Read our documentation on viewing source code .

Loading