-
Notifications
You must be signed in to change notification settings - Fork 5
/
g_pauc.R
129 lines (126 loc) · 3.76 KB
/
g_pauc.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
#' Retrieve a data frame of pAUC scores
#'
#' The \code{auc} function takes an \code{S3} object generated by
#' \code{\link{part}} and \code{\link{evalmod}} and retrieves a data frame
#' with the partial AUC scores of ROC and Precision-Recall curves.
#'
#' @param curves An \code{S3} object generated by \code{\link{part}} and
#' \code{\link{evalmod}}. The \code{pauc} function accepts the following
#' S3 objects.
#'
#' \tabular{lll}{
#' \strong{\code{S3} object}
#' \tab \strong{# of models}
#' \tab \strong{# of test datasets} \cr
#'
#' sscurves \tab single \tab single \cr
#' mscurves \tab multiple \tab single \cr
#' smcurves \tab single \tab multiple \cr
#' mmcurves \tab multiple \tab multiple
#' }
#'
#' See the \strong{Value} section of \code{\link{evalmod}} for more details.
#'
#' @return The \code{auc} function returns a data frame with pAUC scores.
#'
#' @seealso \code{\link{evalmod}} for generating \code{S3} objects with
#' performance evaluation measures. \code{\link{part}} for calculation of
#' pAUCs. \code{\link{auc}} for retrieving a dataset of AUCs.
#'
#' @examples
#'
#' ##################################################
#' ### Single model & single test dataset
#' ###
#'
#' ## Load a dataset with 10 positives and 10 negatives
#' data(P10N10)
#'
#' ## Generate an sscurve object that contains ROC and Precision-Recall curves
#' sscurves <- evalmod(scores = P10N10$scores, labels = P10N10$labels)
#'
#' ## Calculate partial AUCs
#' sscurves.part <- part(sscurves, xlim = c(0.25, 0.75))
#'
#' ## Shows pAUCs
#' pauc(sscurves.part)
#'
#' ##################################################
#' ### Multiple models & single test dataset
#' ###
#'
#' ## Create sample datasets with 100 positives and 100 negatives
#' samps <- create_sim_samples(1, 100, 100, "all")
#' mdat <- mmdata(samps[["scores"]], samps[["labels"]],
#' modnames = samps[["modnames"]]
#' )
#'
#' ## Generate an mscurve object that contains ROC and Precision-Recall curves
#' mscurves <- evalmod(mdat)
#'
#' ## Calculate partial AUCs
#' mscurves.part <- part(mscurves, xlim = c(0, 0.75), ylim = c(0.25, 0.75))
#'
#' ## Shows pAUCs
#' pauc(mscurves.part)
#'
#' ##################################################
#' ### Single model & multiple test datasets
#' ###
#'
#' ## Create sample datasets with 100 positives and 100 negatives
#' samps <- create_sim_samples(4, 100, 100, "good_er")
#' mdat <- mmdata(samps[["scores"]], samps[["labels"]],
#' modnames = samps[["modnames"]],
#' dsids = samps[["dsids"]]
#' )
#'
#' ## Generate an smcurve object that contains ROC and Precision-Recall curves
#' smcurves <- evalmod(mdat, raw_curves = TRUE)
#'
#' ## Calculate partial AUCs
#' smcurves.part <- part(smcurves, xlim = c(0.25, 0.75))
#'
#' ## Shows pAUCs
#' pauc(smcurves.part)
#'
#' ##################################################
#' ### Multiple models & multiple test datasets
#' ###
#'
#' ## Create sample datasets with 100 positives and 100 negatives
#' samps <- create_sim_samples(4, 100, 100, "all")
#' mdat <- mmdata(samps[["scores"]], samps[["labels"]],
#' modnames = samps[["modnames"]],
#' dsids = samps[["dsids"]]
#' )
#'
#' ## Generate an mscurve object that contains ROC and Precision-Recall curves
#' mmcurves <- evalmod(mdat, raw_curves = TRUE)
#'
#' ## Calculate partial AUCs
#' mmcurves.part <- part(mmcurves, xlim = c(0, 0.25))
#'
#' ## Shows pAUCs
#' pauc(mmcurves.part)
#'
#' @export
pauc <- function(curves) UseMethod("pauc", curves)
#' @export
pauc.default <- function(curves) {
stop("An object of unknown class is specified")
}
#
# Print AUC scores
#
#' @rdname pauc
#' @export
pauc.aucs <- function(curves) {
# Validation
.validate(curves)
if (!attr(curves, "partial")) {
stop("part() should be used first.")
}
# Return AUC scores
attr(curves, "paucs")
}