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
ci <- function(...) {
21 33
  UseMethod("ci")
22
}
23

24
ci.formula <- function(formula, data, ...) {
25 33
	data.missing <- missing(data)
26 33
	roc.data <- roc.utils.extract.formula(formula, data, ..., 
27 33
										  data.missing = data.missing,
28 33
										  call = match.call())
29 33
	if (length(roc.data$predictor.name) > 1) {
30 0
		stop("Only one predictor supported in 'ci'.")
31
	}
32 33
	response <- roc.data$response
33 33
	predictor <- roc.data$predictors[, 1]
34 33
	ci.roc(roc(response, predictor, ...), ...)
35
}
36

37
ci.default <- function(response, predictor, ...) {
38 33
	roc <- roc.default(response, predictor, ci = FALSE, ...)
39 33
	if (methods::is(roc, "smooth.roc")) {
40 0
		return(ci.roc(smooth.roc = roc, ...))
41
	}
42
	else {
43 33
		return(ci.roc(roc = roc, ...))
44
	}
45
}
46

47
ci.smooth.roc <- function(smooth.roc, of = c("auc", "sp", "se", "coords"), ...) {
48 0
  of <- match.arg(of)
49
  
50 0
  if (of == "auc")
51 0
    ci <- ci.auc.smooth.roc(smooth.roc, ...)
52 0
  else if (of == "sp")
53 0
    ci <- ci.sp.smooth.roc(smooth.roc, ...)
54 0
  else if (of == "se")
55 0
    ci <- ci.se.smooth.roc(smooth.roc, ...)
56 0
  else if (of == "coords")
57 0
  	ci <- ci.coords.smooth.roc(smooth.roc, ...)
58
  else
59 0
  	stop(sprintf("Unknown 'of' for CI: %s", of))
60

61 0
  return(ci)
62
}
63

64
ci.roc <- function(roc, of = c("auc", "thresholds", "sp", "se", "coords"), ...) {
65 33
  of <- match.arg(of)
66
  
67 33
  if (of == "auc")
68 33
    ci <- ci.auc.roc(roc, ...)
69 33
  else if (of == "thresholds")
70 33
    ci <- ci.thresholds.roc(roc, ...)
71 33
  else if (of == "sp")
72 33
    ci <- ci.sp.roc(roc, ...)
73 33
  else if (of == "se")
74 33
    ci <- ci.se.roc(roc, ...)
75 33
  else if (of == "coords")
76 33
  	ci <- ci.coords.roc(roc, ...)
77
  else
78 33
  	stop(sprintf("Unknown 'of' for CI: %s", of))
79

80 33
  return(ci)
81
}
82

83
ci.multiclass.roc <- function(multiclass.roc, of = "auc", ...) {
84 0
	stop("CI of a multiclass ROC curve not implemented")
85
}
86

87
ci.multiclass.auc <- function(multiclass.auc, of = "auc", ...) {
88 0
	stop("CI of a multiclass AUC not implemented")
89
}
90

Read our documentation on viewing source code .

Loading