i β są powiązane. Spróbuję zilustrować tę kwestię testem diagnostycznym. Powiedzmy, że masz test diagnostyczny, który mierzy poziom markera krwi. Wiadomo, że osoby cierpiące na określoną chorobę mają niższe poziomy tego markera w porównaniu do osób zdrowych. Od razu wiadomo, że musisz zdecydować o wartości granicznej, poniżej której dana osoba jest klasyfikowana jako „chora”, podczas gdy osoby o wartościach powyżej tej granicy są uważane za zdrowe. Jest jednak bardzo prawdopodobne, że rozmieszczenie znacznika krwi różni się znacznie nawetwśródchorych i zdrowych osób. Niektóre zdrowe osoby mogą mieć bardzo niskie poziomy markerów krwi, nawet jeśli są całkowicie zdrowe. A niektórzy chorzy mają wysoki poziom markera krwi, nawet jeśli chorują.αβ
Istnieją cztery możliwości, które mogą wystąpić:
- chory jest prawidłowo zidentyfikowany jako chory (prawdziwie pozytywny = TP)
- chory jest fałszywie sklasyfikowany jako zdrowy (fałszywie ujemny = FN)
- zdrowa osoba jest poprawnie zidentyfikowana jako zdrowa (prawdziwie negatywna = TN)
- zdrowa osoba jest fałszywie sklasyfikowana jako chora (fałszywie dodatnia = FP)
Te możliwości można zilustrować za pomocą tabeli 2x2 :
Sick Healthy
Test positive TP FP
Test negative FN TN
oznacza fałszywie dodatni, który jest α = F P / ( K P + T N ) . β jest fałszywych negatywne, co jest β = K N / ( T P + C N ) . Napisałem prostyskrypt, aby zilustrować graficznie sytuację.αα = FP./ (F.P.+ TN.)ββ= F.N./ ( TP.+ F.N.)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)
}
Spójrzmy na przykład. Zakładamy, że średni poziom markera krwi wśród chorych wynosi 100 przy standardowym odchyleniu wynoszącym 10. Wśród zdrowych osób średni poziom krwi wynosi 140 przy standardowym odchyleniu wynoszącym 15. Klinicysta ustawia wartość graniczną na 120.
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)
αβ
Tutaj mamy „idealny” test w tym sensie, że granica 150 odróżnia chorych od zdrowych.
Korekty Bonferroniego
αββ0,020,31α0,090,01