Suppose I have two models $A$ an $B$ that predict class labels. If these give binary predictions, these will appear as pairs of (false positive rate, true positive rate) in the ROC space. We should be able to construct different models to achieve any tpr and fpr along the linear interpolation of these curves by assigning the mis-matched points to class 1 or 0 according to some probability (as illustrated in the hand drawn figure below).
Let us say that model $A$ achieves a true positive rate of $t_A$ at a false positive rate of $f_A$, and $B$ similarly achieves $t_B$ at $f_B$. Now I am trying to stay at the convex hull of the two models, and predict for a false positive rate of $f$. I use the following formula:
- If $f \leq f_A$, predict $f/f_A$ of the samples predicted by $A$ as $1$, and the rest as $0$.
- If $f_A \lt f \leq f_B$, predict $1$ for all those predicted by $A$, and also $1$ for $(f-f_A)/(f_B-f_A)$ of those predicted by $B$ but not $A$.
- If $f_B \le f$, predict $1$ for all those predicted by $A$ or $B$, and also $1$ for $(f-f_B)/(1-f_B)$ of the rest.
This is what I get using this.
It seems though that something is wrong in this formula. As we can see, I am consistently predicting below the lines connecting $A$ and $B$. This is not due to randomness since I am doing an almost perfect job between the origin and $A$, and also I have used a lot of samples to generate this graph. For one, in the range $f>f_B$, we are actually interpolating between $B$ and $(1,1)$ so we should disregard $A$. I have only written it this way to keep continuity between region 2 and 3. It should actually be predict $1$ for those predicted by $b$ and $(f-f_B)/(1-f_B)$ fraction of the rest. My main question is, what is the correct formula for interpolating between $A$ and $B$?
This is my code for generating this graph in R:
n <- 1e6
labels <- c(rep(0,n/2),rep(1,n/2))
fA <- .2; tA <- .6; fB <- .7; tB <- .95
A <- rep(0,n)
A[sample(n/2,fA*n/2)] = 1; A[(n/2)+sample(n/2,tA*n/2)]=1
B <- rep(0,n)
B[sample(n/2,fB*n/2)] = 1; B[(n/2)+sample(n/2,tB*n/2)]=1
Ainds = Filter(function(x) {A[[x]]}, 1:n)
Binds = Filter(function(x) {B[[x]]}, 1:n)
BnotA = Filter(function(x) {B[[x]]&(! A[[x]])}, 1:n)
AorB = Filter(function(x) {A[[x]]|B[[x]]}, 1:n)
notAnotB = Filter(function(x) {! (A[[x]]|B[[x]])}, 1:n)
library(ROCR)
pred.a <- prediction(A,labels)
pred.b <- prediction(B,labels)
pdf("ROC_Interpolated.pdf")
# plot a and b
plot(performance(pred.a,"tpr","fpr"),col="blue",lty=0,type='o',pch=2)
plot(performance(pred.b,"tpr","fpr"),col="blue",lty=0,type='o',pch=2,add=T)
i <- 0
C = list()
pred.c = list()
p = list()
f = list()
for (fgoal in ((1:29)/30)) {
i <- i+1
f[[i]] = fgoal
C[[i]] <- rep(0,n)
if (fgoal<=fA) {
p[[i]] = fgoal/fA
C[[i]][sample(Ainds, p[[i]]*length(Ainds))] = 1
# C[[i]] <- sapply(1:(2*n),function(x) {if (A[[x]]) rbinom(1,1,p[[i]]) else 0})
} else if (fgoal<=fB) {
p[[i]] = (fgoal-fA)/(fB-fA)
C[[i]][Ainds] = 1
C[[i]][sample(BnotA,p[[i]]*length(BnotA))] = 1
# C[[i]] <- sapply(1:(2*n),function(x) {if (A[[x]]) 1 else if (B[[x]]) rbinom(1,1,p[[i]]) else 0})
} else {
p[[i]] = (fgoal-fB)/(1-fB)
C[[i]][AorB] = 1
C[[i]][sample(notAnotB,p[[i]] * length(notAnotB))] = 1
# C[[i]] <- sapply(1:(2*n),function(x) {if (A[[x]]|B[[x]]) 1 else rbinom(1,1,p[[i]]) })
}
pred.c[[i]] = prediction(C[[i]],labels)
plot(performance(pred.c[[i]],"tpr","fpr"),col="red",lty=0,type='o',pch=5,add=T)
}
lines(c(0,fA,fB,1),c(0,tA,tB,1),lty=2,col="black")
legend(.4,0.4,legend=c("A","B","interpolated by sampling","theoretical"),lty=c(0,0,0,2),pch=c(2,2,5,NaN),col=c("blue","blue","red","black"))
dev.off()