-
Notifications
You must be signed in to change notification settings - Fork 2
/
Copy pathpowfun_UIT.R
155 lines (133 loc) · 6.88 KB
/
powfun_UIT.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
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
# Specify the clinical design methods: 's1' indicates one-stage design; 's2.sf' indicates two-stage
# design with early stop for both superiority and futility; 's2.f' indicates two-stage design with
# early stop for only futility.
design.methods <- c("s1", "s2.sf", "s2.f")
UIT.power <- function(method = design.methods, s1.rej, s1.acc, t1.rej, t1.acc, s2.rej, t2.rej, n1, n2,
n, p.s, p.t, output.all = FALSE) {
binom.dens <- function(x, size, prob) {
choose(size, x) * prob^x * (1 - prob)^(size - x)
}
s1.pow <- function(s2.rej, t2.rej, n, p.s, p.t) {
## this block uses the following parameters: s2.rej, t2.rej, n, p.s, p.t
# s2.rej, t2.rej : rejection boundary of pCR and ePD
# n: sample size
# p.s, p.t : probability of pCR and ePD
pmf <- 0
for (t in (t2.rej + 1):n) {
for (s in 0:min(s2.rej, n - t)) {
pmf <- pmf + binom.dens(s, size = n - t, prob = p.s/(1 - p.t)) * binom.dens(t, size = n,
prob = p.t)
}
}
return(1 - pmf)
}
method <- match.arg(method)
switch(method, s1 = {
return(s1.pow(s2.rej, t2.rej, n, p.s, p.t))
}, s2.sf = {
## this block uses the following parameters:s1.rej, t1.rej, s1.acc, t1.acc, s2.rej, t2.rej, n1, n2, p.s, p.t
# H0: p1 <= p01 and p2 >= p02
# s1.rej, t1.rej : rejection boundary of H0 at the first stage -- s >= s1.rej OR t <= t1.rej
# s1.acc, t1.acc : acceptance boundary of H0 at the first stage -- s <= s1.acc AND t >= t1.acc
# s2.rej, t2.rej : reject boundary of H0 at the second stage
# n1, n2 : sample sizes of the first and the second stages
# p.s, p.t: probability of pCR and ePD
## reject H0 at the first stage
pmf <- s1.pow(s1.rej, t1.rej, n1, p.s, p.t)
## set initial probability of continue to the second stage as 0
PCon <- 0
## continue after the first stage and then reject H0 at the second stage
# first continuation region: s2 < si < s1 and 0 <= ti < n1-si
if ((t1.acc > n1 - s1.acc) & (t1.rej > n1 - s1.rej)) {
for (ti in (t1.rej + 1):(t1.acc - 1)) {
for (si in 0:(n1 - ti)) {
# replace the infinite single stage power by max limit 1
p <- s1.pow(s2.rej - si, t2.rej - ti, n2, p.s, p.t)
p[is.nan(p)] = 1
pmf <- pmf + binom.dens(ti, size = n1 - ti, prob = p.s/(1 - p.t)) * binom.dens(ti,
size = n1, prob = p.t) * p
PCon <- PCon + binom.dens(ti, size = n1 - ti, prob = p.s/(1 - p.t)) * binom.dens(ti,
size = n1, prob = p.t)
}
}
} else {
# second continuation region: ( s2 < si < s1 and 0 <= ti <= t1 ) and ( s2 < si < n1-ti and t1 < ti
# <= n1-s2 )
for (si in 0:min(s1.acc, n1 - t1.acc)) {
for (ti in (t1.rej + 1):(t1.rej - 1)) {
p <- s1.pow(s2.rej - si, t2.rej - ti, n2, p.s, p.t)
p[is.nan(p)] = 1
pmf <- pmf + binom.dens(ti, size = n1 - si, prob = p.t/(1 - p.s)) * binom.dens(si,
size = n1, prob = p.s) * p
PCon <- PCon + binom.dens(ti, size = n1 - si, prob = p.t/(1 - p.s)) * binom.dens(si,
size = n1, prob = p.s)
}
}
for (si in (min(s1.acc, n1 - t1.acc) + 1):min((n1 - t1.rej), (s1.rej - 1))) {
for (ti in (t1.rej + 1):(n1 - si)) {
p <- s1.pow(s2.rej - si, t2.rej - ti, n2, p.s, p.t)
p[is.nan(p)] = 1
pmf <- pmf + binom.dens(ti, size = n1 - si, prob = p.t/(1 - p.s)) * binom.dens(si,
size = n1, prob = p.s) * p
PCon <- PCon + binom.dens(ti, size = n1 - si, prob = p.t/(1 - p.s)) * binom.dens(si,
size = n1, prob = p.s)
}
}
}
}, s2.f = {
## this block use the following parameters: s1.acc, t1.acc, s2.rej, t2.rej, n1, n2, p.s, p.t
# s1.acc, t1.acc : acceptance boundary of H0 at the first stage -- s <= s1.acc OR t >= t1.acc
# s2.rej, t2.rej : reject boundary of H0 at the second stage
# n1, n2 : sample sizes of the first and the second stages
# p.s, p.t: probability of pCR and ePD
# for UIT, the continuous region is s2 < s <= N1 or 0 <= t < t2
## Set initial power as 0
pmf <- 0
## set initial continue probability as 0
PCon <- 0
## continue after the first stage and then reject H0 at the second stage
# first continuation region: s2 < si <= n1 and 0 <= ti < n1-si
if (t1.acc <= n1 - s1.acc) {
for (si in 0:s1.acc) {
for (ti in 0:(t1.acc - 1)) {
# replace the infinite single stage power by max limit 1
p <- s1.pow(s2.rej - si, t2.rej - ti, n2, p.s, p.t)
p[is.nan(p)] = 1
pmf <- pmf + binom.dens(ti, size = n1 - si, prob = p.t/(1 - p.s)) * binom.dens(si,
size = n1, prob = p.s) * p
PCon <- PCon + binom.dens(ti, size = n1 - si, prob = p.t/(1 - p.s)) * binom.dens(si,
size = n1, prob = p.s)
}
}
for (si in (s1.acc + 1):n1) {
for (ti in 0:(n1 - si)) {
# replace the infinite single stage power by max limit 1
p <- s1.pow(s2.rej - si, t2.rej - ti, n2, p.s, p.t)
p[is.nan(p)] = 1
pmf <- pmf + binom.dens(ti, size = n1 - si, prob = p.t/(1 - p.s)) * binom.dens(si,
size = n1, prob = p.s) * p
}
}
}
# second continuation region: 0 <= ti < t2 and s2 < si < n1-ti
if (t1.acc > n1 - s1.acc) {
for (ti in 0:(t1.acc - 1)) {
for (si in 0:(n1 - ti)) {
p <- s1.pow(s2.rej - si, t2.rej - ti, n2, p.s, p.t)
p[is.nan(p)] = 1
pmf <- pmf + binom.dens(si, size = n1 - ti, prob = p.s/(1 - p.t)) * binom.dens(ti,
size = n1, prob = p.t) * p
PCon <- PCon + binom.dens(si, size = n1 - ti, prob = p.s/(1 - p.t)) * binom.dens(ti,
size = n1, prob = p.t)
}
}
}
})
if (output.all == FALSE) {
return(pmf)
} else if (output.all == TRUE) {
PET <- 1 - PCon
EN <- n1 * PET + (n1 + n2) * (1 - PET)
return(c(pmf, PET, EN))
}
}