1
# pROC: Tools Receiver operating characteristic (ROC curves) with
2
# (partial) area under the curve, confidence intervals and comparison. 
3
# Copyright (C) 2010-2014 Xavier Robin, Alexandre Hainard, Natacha Turck,
4
# Natalia Tiberti, Frédérique Lisacek, Jean-Charles Sanchez
5
# and Markus Müller
6
#
7
# This program is free software: you can redistribute it and/or modify
8
# it under the terms of the GNU General Public License as published by
9
# the Free Software Foundation, either version 3 of the License, or
10
# (at your option) any later version.
11
#
12
# This program is distributed in the hope that it will be useful,
13
# but WITHOUT ANY WARRANTY; without even the implied warranty of
14
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15
# GNU General Public License for more details.
16
#
17
# You should have received a copy of the GNU General Public License
18
# along with this program.  If not, see <http://www.gnu.org/licenses/>.
19

20
# Helper functions to safely convert ROC objects from percent=TRUE to percent=FALSE
21
# and inversely. These are internal and experimental. They shouldn't be exposed
22
# to the end user.
23

24
# Returns a ROC curve with percent=FALSE
25
roc.utils.unpercent <- function(x) {
26 33
  UseMethod("roc.utils.unpercent")
27
}
28

29
roc.utils.unpercent.roc <- function(x) {
30 33
	if (x$percent) {
31 33
		if (! is.null(x$auc)) {
32 33
			x$auc <- roc.utils.unpercent(x$auc)
33
		}
34 33
		x$sensitivities <- x$sensitivities / 100
35 33
		x$specificities <- x$specificities / 100
36 33
		x$percent <- FALSE
37 33
		if (!is.null(x$call)) {
38 33
		  x$call$percent <- FALSE
39
		}
40 33
		if (!is.null(x$ci)) {
41 33
			x$ci <- roc.utils.unpercent(x$ci)
42
		}
43
	}
44
	
45 33
	return(x)
46
}
47

48
roc.utils.unpercent.auc <- function(x) {
49 33
	if (attr(x, "percent")) {
50 33
		newx <- x / 100
51 33
		attributes(newx) <- attributes(x)
52 33
		x <- newx
53 33
		attr(x, "percent") <- FALSE
54 33
		if (is.numeric(attr(x, "partial.auc"))) {
55 33
			attr(x, "partial.auc") <- attr(x, "partial.auc") / 100
56
		}
57 33
		if (! is.null(attr(x, "roc"))) {
58 33
			attr(x, "roc") <- roc.utils.unpercent(attr(x, "roc"))
59
		}
60
	}
61 33
	return(x)
62
}
63

64
roc.utils.unpercent.ci.auc <- function(x) {
65 33
	if (attr(attr(x, "auc"), "percent")) {
66 33
		x[] <- x / 100
67 33
		attr(x, "auc") <- roc.utils.unpercent(attr(x, "auc"))
68
	}
69 33
	return(x)
70
}
71

72
roc.utils.unpercent.ci.thresholds <- function(x) {
73 33
	if (attr(x, "roc")$percent) {
74 33
		x$sensitivity[] <- x$sensitivity / 100
75 33
		x$specificity[] <- x$specificity / 100
76 33
		attr(x, "roc") <- roc.utils.unpercent(attr(x, "roc"))
77
	}
78 33
	return(x)
79
}
80

81
roc.utils.unpercent.ci.sp <- function(x) {
82 33
	if (attr(x, "roc")$percent) {
83 33
		x[] <- x / 100
84 33
		attr(x, "sensitivities") <- attr(x, "sensitivities") / 100
85 33
		rownames(x) <- attr(x, "sensitivities")
86 33
		attr(x, "roc") <- roc.utils.unpercent(attr(x, "roc"))
87
	}
88 33
	return(x)
89
}
90

91
roc.utils.unpercent.ci.se <- function(x) {
92 33
	if (attr(x, "roc")$percent) {
93 33
		x[] <- x / 100
94 33
		attr(x, "specificities") <- attr(x, "specificities") / 100
95 33
		rownames(x) <- attr(x, "specificities")
96 33
		attr(x, "roc") <- roc.utils.unpercent(attr(x, "roc"))
97
	}
98 33
	return(x)
99
}
100

101
roc.utils.unpercent.ci.coords <- function(x) {
102 0
	stop("Cannot convert ci.coords object to percent = FALSE")
103
}
104

105
# Returns a ROC curve with percent=TRUE
106
roc.utils.topercent <- function(x) {
107 33
  UseMethod("roc.utils.topercent")
108
}
109

110
roc.utils.topercent.roc <- function(x) {
111 33
	if (! x$percent) {
112 33
		if (! is.null(x$auc)) {
113 33
			x$auc <- roc.utils.topercent(x$auc)
114
		}
115 33
		x$sensitivities <- x$sensitivities * 100
116 33
		x$specificities <- x$specificities * 100
117 33
		x$percent <- TRUE
118 33
		if (!is.null(x$call)) {
119 33
		  x$call$percent <- TRUE
120
		}
121 33
		if (!is.null(x$ci)) {
122 33
			x$ci <- roc.utils.topercent(x$ci)
123
		}
124
	}
125
 
126 33
  return(x)
127
}
128

129
roc.utils.topercent.auc <- function(x) {
130 33
	if (! attr(x, "percent")) {
131 33
		newx <- x * 100
132 33
		attributes(newx) <- attributes(x)
133 33
		x <- newx
134 33
		attr(x, "percent") <- TRUE
135 33
		if (is.numeric(attr(x, "partial.auc"))) {
136 33
			attr(x, "partial.auc") <- attr(x, "partial.auc") * 100
137
		}
138 33
		if (! is.null(attr(x, "roc"))) {
139 33
			attr(x, "roc") <- roc.utils.topercent(attr(x, "roc"))
140
		}
141
	}
142 33
	return(x)
143
}
144

145
roc.utils.topercent.ci.auc <- function(x) {
146 33
	if (! attr(attr(x, "auc"), "percent")) {
147 33
		x[] <- x * 100
148 33
		attr(x, "auc") <- roc.utils.topercent(attr(x, "auc"))
149
	}
150 33
	return(x)
151
}
152

153
roc.utils.topercent.ci.thresholds <- function(x) {
154 33
	if (! attr(x, "roc")$percent) {
155 33
		x$sensitivity[] <- x$sensitivity * 100
156 33
		x$specificity[] <- x$specificity * 100
157 33
		attr(x, "roc") <- roc.utils.topercent(attr(x, "roc"))
158
	}
159 33
	return(x)
160
}
161

162
roc.utils.topercent.ci.sp <- function(x) {
163 33
	if (! attr(x, "roc")$percent) {
164 33
		x[] <- x * 100
165 33
		attr(x, "sensitivities") <- attr(x, "sensitivities") * 100
166 33
		rownames(x) <- paste(attr(x, "sensitivities"), "%", sep="")
167 33
		attr(x, "roc") <- roc.utils.topercent(attr(x, "roc"))
168
	}
169 33
	return(x)
170
}
171

172
roc.utils.topercent.ci.se <- function(x) {
173 33
	if (! attr(x, "roc")$percent) {
174 33
		x[] <- x * 100
175 33
		attr(x, "specificities") <- attr(x, "specificities") * 100
176 33
		rownames(x) <- paste(attr(x, "specificities"), "%", sep="")
177 33
		attr(x, "roc") <- roc.utils.topercent(attr(x, "roc"))
178
	}
179 33
	return(x)
180
}
181

182
roc.utils.topercent.ci.coords <- function(x) {
183 0
	stop("Cannot convert ci.coords object to percent = TRUE")
184
}

Read our documentation on viewing source code .

Loading