-
Notifications
You must be signed in to change notification settings - Fork 0
/
pairedroc.R
128 lines (124 loc) · 5.07 KB
/
pairedroc.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
#' AUC Test for Paired Two-sample Measurements
#'
#' @description `r lifecycle::badge("experimental")`
#'
#' This function compares two AUC of paired two-sample diagnostic assays by
#' standardized difference method, which has a little difference in SE calculation
#' with unpaired design. In order to compare the two assays, this function provides
#' three assessments including 'difference', 'non-inferiority' and 'superiority'.
#' This method of comparing is referred from Liu(2006)'s article that can be
#' found in reference section below.
#'
#' @param x (`numeric`)\cr reference/standard diagnostic assay.
#' @param y (`numeric`)\cr test diagnostic assay.
#' @param response (`numeric` or `factor`)\cr a vector of responses to represent
#' the type of classes, typically encoded with 0(controls) and 1(cases).
#' @param h0 (`numeric`)\cr a specified hypothesized value of the margin between
#' the two assays, default is 0 for difference method. If you select the
#' non-inferiority method, the `h0` should be negative value. And if select
#' superiority method, then it's non-negative value.
#' @param conf.level (`numeric`)\cr significance level between 0 and 1 (non-inclusive)
#' for the returned confidence interval.
#' @param method (`string`)\cr string specifying the type of hypothesis test,
#' must be one of "difference" (default), "non-inferiority" or "superiority".
#' @param ... other arguments to be passed to [pROC::roc()].
#'
#' @details
#' If the samples are not considered independent, such as in a paired design,
#' the SE can not be computed by the method of Delong provided in `pROC` package.
#' Here the `aucTest` function use the standardized difference approach from
#' Liu(2006) publication to compute the SE and corresponding hypothesis test
#' statistic for a paired design study.
#' - `difference` is to test the difference between two diagnostic tests, the
#' default h0 is zero.
#' - `non-inferiority` is to test the new diagnostic tests is no worse than the
#' standard diagnostic test in a specific margin, but the same time maybe it's
#' safer, easier to administer or cost less.
#' - `superiority` is to test the test the new diagnostic tests is better than the
#' standard diagnostic test in a specific margin(default is zero), having better efficacy.
#'
#' @note
#' The test of significance for the difference is not equal to the result of EP24A2
#' Appendix D. Table D2. Because the Table D2 uses the method of Hanley & McNeil
#' (1982), whereas this function here uses the method of DeLong et al. (1988), which
#' results in the difference of SE. Thus the corresponding Z statistic and P value
#' will be not equal as well.
#'
#' @references Jen-Pei Liu (2006) "Tests of equivalence and non-inferiority for
#' diagnostic accuracy based on the paired areas under ROC curves". *Statist. Med.*
#' , 25:1219–1238. DOI: 10.1002/sim.2358.
#'
#' @return A `RefInt` object contains relevant results in comparing the paired
#' ROC of two-sample assays.
#' @export
#'
#' @examples
#' data("ldlroc")
#' # H0 : Difference between areas = 0:
#' aucTest(x = ldlroc$LDL, y = ldlroc$OxLDL, response = ldlroc$Diagnosis)
#'
#' # H0 : Superiority margin <= 0.1:
#' aucTest(
#' x = ldlroc$LDL, y = ldlroc$OxLDL, response = ldlroc$Diagnosis,
#' method = "superiority", h0 = 0.1
#' )
#'
#' # H0 : Non-inferiority margin <= -0.1:
#' aucTest(
#' x = ldlroc$LDL, y = ldlroc$OxLDL, response = ldlroc$Diagnosis,
#' method = "non-inferiority", h0 = -0.1
#' )
aucTest <- function(x, y,
response,
h0 = 0,
conf.level = 0.95,
method = c("difference", "non-inferiority", "superiority"),
...) {
assert_numeric(x)
assert_numeric(y)
assert_true(length(x) == length(y))
assert_number(h0)
method <- match.arg(method, c("difference", "non-inferiority", "superiority"), several.ok = FALSE)
refroc <- pROC::roc(response, x, ...)
testroc <- suppressMessages(pROC::roc(response, y, ...))
paircov <- pROC::cov(refroc, testroc)
refvar <- pROC::var(refroc)
testvar <- pROC::var(testroc)
auc_d <- as.numeric(testroc$auc) - as.numeric(refroc$auc)
se <- sqrt(testvar + refvar - 2 * paircov)
sign_z <- qnorm(1 - ((1 - conf.level) / 2))
ci <- c(auc_d - sign_z * se, auc_d + sign_z * se)
zstat <- (auc_d - h0) / se
pval <- if (method == "difference") {
2 * pnorm(abs(zstat), lower.tail = F)
} else if (method == "non-inferiority") {
if (h0 > 0) {
stop("h0 should be negative when non-inferiority method is selected.")
}
pnorm(abs(zstat), lower.tail = F)
} else if (method == "superiority") {
if (h0 < 0) {
stop("h0 should be non-negative when superiority method is selected.")
}
pnorm(abs(zstat), lower.tail = F)
}
tpROC(
testROC = c(unclass(testroc), list(
ci = ci.auc(testroc)[c(1, 3)],
se = sqrt(var(testroc))
)),
refROC = c(unclass(refroc), list(
ci = ci.auc(refroc)[c(1, 3)],
se = sqrt(var(refroc))
)),
method = method,
H0 = h0,
stat = list(
diffauc = auc_d,
se = se,
ci = ci,
zstat = zstat,
pval = pval
)
)
}