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 3
  UseMethod("roc.utils.unpercent")
27
}
28

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

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

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

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

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

91
roc.utils.unpercent.ci.se <- function(x) {
92 3
	if (attr(x, "roc")$percent) {
93 3
		x[] <- x / 100
94 3
		attr(x, "specificities") <- attr(x, "specificities") / 100
95 3
		rownames(x) <- attr(x, "specificities")
96 3
		attr(x, "roc") <- roc.utils.unpercent(attr(x, "roc"))
97
	}
98 3
	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 3
  UseMethod("roc.utils.topercent")
108
}
109

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

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

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

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

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

172
roc.utils.topercent.ci.se <- function(x) {
173 3
	if (! attr(x, "roc")$percent) {
174 3
		x[] <- x * 100
175 3
		attr(x, "specificities") <- attr(x, "specificities") * 100
176 3
		rownames(x) <- paste(attr(x, "specificities"), "%", sep="")
177 3
		attr(x, "roc") <- roc.utils.topercent(attr(x, "roc"))
178
	}
179 3
	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