ve β ilişkilidir. Konuyu bir tanı testi ile göstermeye çalışacağım. Diyelim ki bir kan markerinin seviyesini ölçen bir teşhis testiniz var. Belli bir hastalığı olan insanların bu markanın sağlıklı insanlara göre daha düşük seviyelere sahip olduğu bilinmektedir. Hemen altında, bir kişinin "hasta" olarak sınıflandırıldığı bir kesme değerine karar vermeniz gerektiği açıktır, oysa bu kesmenin üstünde değerleri olan kişilerin sağlıklı olduğu düşünülmektedir. Bu bloodmarker dağılımı bile ölçüde değişiklik olduğunu, ancak, büyük olasılıklaiçindehasta ve sağlıklı insanlar. Bazı sağlıklı kişiler mükemmel sağlıklı olmalarına rağmen çok düşük kan markeri seviyelerine sahip olabilirler. Ve bazı hasta insanlar, hastalığa sahip olmalarına rağmen yüksek düzeyde kan markerine sahiptir.αβ
Oluşabilecek dört olasılık vardır:
- hasta bir kişi doğru olarak hasta olarak tanımlanır (gerçek pozitif = TP)
- hasta bir kişi yanlış bir şekilde sağlıklı olarak sınıflandırılır (yanlış negatif = FN)
- sağlıklı bir insan doğru olarak sağlıklı olarak tanımlanır (gerçek negatif = TN)
- sağlıklı bir kişi yanlış bir şekilde hasta olarak sınıflandırılır (yanlış pozitif = FP)
Bu olasılıklar 2x2 tablo ile gösterilebilir :
Sick Healthy
Test positive TP FP
Test negative FN TN
αα = FP/ (FP+ TN-)ββ= FN-/ (TP+ FN-)R
alphabeta <- function(mean.sick=100, sd.sick=10, mean.healthy=130, sd.healthy=10, cutoff=120, n=10000, side="below", do.plot=TRUE) {
popsick <- rnorm(n, mean=mean.sick, sd=sd.sick)
pophealthy <- rnorm(n, mean=mean.healthy, sd=sd.healthy)
if ( side == "below" ) {
truepos <- length(popsick[popsick <= cutoff])
falsepos <- length(pophealthy[pophealthy <= cutoff])
trueneg <- length(pophealthy[pophealthy > cutoff])
falseneg <- length(popsick[popsick > cutoff])
} else if ( side == "above" ) {
truepos <- length(popsick[popsick >= cutoff])
falsepos <- length(pophealthy[pophealthy >= cutoff])
trueneg <- length(pophealthy[pophealthy < cutoff])
falseneg <- length(popsick[popsick < cutoff])
}
twotable <- matrix(c(truepos, falsepos, falseneg, trueneg), 2, 2, byrow=T)
rownames(twotable) <- c("Test positive", "Test negative")
colnames(twotable) <- c("Sick", "Healthy")
spec <- twotable[2,2]/(twotable[2,2] + twotable[1,2])
alpha <- 1 - spec
sens <- pow <- twotable[1,1]/(twotable[1,1] + twotable[2,1])
beta <- 1 - sens
pos.pred <- twotable[1,1]/(twotable[1,1] + twotable[1,2])
neg.pred <- twotable[2,2]/(twotable[2,2] + twotable[2,1])
if ( do.plot == TRUE ) {
dsick <- density(popsick)
dhealthy <- density(pophealthy)
par(mar=c(5.5, 4, 0.5, 0.5))
plot(range(c(dsick$x, dhealthy$x)), range(c(c(dsick$y, dhealthy$y))), type = "n", xlab="", ylab="", axes=FALSE)
box()
axis(1, at=mean(pophealthy), lab=substitute(mu[H[0]]~paste("=",m, sep=""), list(m=mean.healthy)), cex.axis=1.5,tck=0.02)
axis(1, at=mean(popsick), lab=substitute(mu[H[1]]~paste("=",m, sep=""), list(m=mean.sick)), cex.axis=1.5, tck=0.02)
axis(1, at=cutoff, lab=substitute(italic(paste("Cutoff=",coff, sep="")), list(coff=cutoff)), pos=-0.004, tick=FALSE, cex.axis=1.25)
lines(dhealthy, col = "steelblue", lwd=2)
if ( side == "below" ) {
polygon(c(cutoff, dhealthy$x[dhealthy$x<=cutoff], cutoff), c(0, dhealthy$y[dhealthy$x<=cutoff],0), col = "grey65")
} else if ( side == "above" ) {
polygon(c(cutoff, dhealthy$x[dhealthy$x>=cutoff], cutoff), c(0, dhealthy$y[dhealthy$x>=cutoff],0), col = "grey65")
}
lines(dsick, col = "red", lwd=2)
if ( side == "below" ) {
polygon(c(cutoff,dsick$x[dsick$x>cutoff],cutoff),c(0,dsick$y[dsick$x>cutoff],0) , col="grey90")
} else if ( side == "above" ) {
polygon(c(cutoff,dsick$x[dsick$x<=cutoff],cutoff),c(0,dsick$y[dsick$x<=cutoff],0) , col="grey90")
}
legend("topleft",
legend=(c(as.expression(substitute(alpha~paste("=", a), list(a=round(alpha,3)))),
as.expression(substitute(beta~paste("=", b), list(b=round(beta,3)))))), fill=c("grey65", "grey90"), cex=1.2, bty="n")
abline(v=mean(popsick), lty=3)
abline(v=mean(pophealthy), lty=3)
abline(v=cutoff, lty=1, lwd=1.5)
abline(h=0)
}
#list(specificity=spec, sensitivity=sens, alpha=alpha, beta=beta, power=pow, positiv.predictive=pos.pred, negative.predictive=neg.pred)
c(alpha, beta)
}
Bir örneğe bakalım. Hasta insanlar arasındaki kan markerinin ortalama seviyesinin standart 10 sapma ile 100 olduğunu varsayıyoruz. Sağlıklı insanlar arasında ortalama kan seviyesi 140'tır ve standart sapma 15'tir. Klinisyen kesimi 120 olarak ayarlar.
alphabeta(mean.sick=100, sd.sick=10, mean.healthy=140, sd.healthy=15, cutoff=120, n=100000, do.plot=TRUE, side="below")
Sick Healthy
Test positive 9764 901
Test negative 236 9099
α = 901 / ( 901 + 9099 ) ≈ 0,09β= 236 / ( 236 + 9764 ) ≈ 0.024
Sick Healthy
Test positive 6909 90
Test negative 3091 9910
αβ
αβ
cutoffs <- seq(0, 200, by=0.1)
cutoff.grid <- expand.grid(cutoffs)
plot.frame <- apply(cutoff.grid, MARGIN=1, FUN=alphabeta, mean.sick=100, sd.sick=10, mean.healthy=140, sd.healthy=15, n=100000, do.plot=FALSE, side="below")
plot(plot.frame[1,]~cutoffs, type="l", las=1, xlab="Cutoff value", ylab="Alpha/Beta", lwd=2, cex.axis=1.5, cex.lab=1.2)
lines(plot.frame[2,]~cutoffs, col="steelblue", lty=2, lwd=2)
legend("topleft", legend=c(expression(alpha), expression(beta)), lwd=c(2,2),lty=c(1,2), col=c("black", "steelblue"), bty="n", cex=1.2)
αβ
Burada 150 kesilmesinin hastayı sağlıklı olandan ayırdığı anlamında "mükemmel" bir testimiz var.
Bonferroni ayarları
αββ0.020.31α0.090.01