Es könnte sich lohnen, Stephens hervorragender Antwort ein weiteres, vielleicht einfacheres Beispiel hinzuzufügen.
Betrachten wir einen medizinischen Test, dessen Ergebnis normalerweise sowohl bei kranken als auch bei gesunden Menschen mit unterschiedlichen Parametern verteilt ist (aber der Einfachheit halber nehmen wir Homoskedastizität an, dh die Varianz ist dieselbe): T.∣ D ⊖ ∼ N.( μ- -, σ2)T.∣ D ⊕ ∼ N.( μ+, σ2).
pD ⊕ ∼ B e r n ( p )
bb⎛⎝⎜T.⊕T.⊖D ⊕p ( 1 - Φ+( b ) )p Φ+( b )D ⊖( 1 - p ) ( 1 - Φ- -( b ) )( 1 - p ) Φ- -( b )⎞⎠⎟.
Genauigkeitsbasierter Ansatz
p ( 1 - Φ+( b ) ) + ( 1 - p ) Φ- -( b ) ,
b1 πσ2- -- -- -- -√- p φ+( b ) + φ- -( b ) - p φ- -( b ) = 0e- ( b - μ- -)22 σ2[ ( 1 - p ) - p e- 2 b ( μ- -- μ+) + ( μ2+- μ2- -)2 σ2] =0
( 1 - p ) - p e- 2 b ( μ- -- μ+) + ( μ2+- μ2- -)2 σ2= 0- 2 b ( μ- -- μ+) + ( μ2+- μ2- -)2 σ2= log1 - pp2 b ( μ+- μ- -) + ( μ2- -- μ2+) =2 σ2Log1 - pp
b∗= ( μ2+- μ2- -) +2 σ2Log1 - pp2 ( μ+- μ- -)= μ++ μ- -2+ σ2μ+- μ- -Log1 - pp.
Beachten Sie, dass dies natürlich nicht von den Kosten abhängt.
Wenn die Klassen ausgeglichen sind, ist das Optimum der Durchschnitt der mittleren Testwerte bei kranken und gesunden Menschen, andernfalls wird es aufgrund des Ungleichgewichts verschoben.
Kostenbasierter Ansatz
c++p ( 1 - Φ+( b ) ) + c- -+( 1 - p ) ( 1 - Φ- -( b ) ) + c+- -p Φ+( b ) + c- -- -( 1 - p ) Φ- -( b ) .
b- c++p φ+( b ) - c- -+( 1 - p ) φ- -( b ) + c+- -p φ+( b ) + c- -- -( 1 - p ) φ- -( b ) == φ+( b ) p ( c+- -- c++) + φ- -( b ) ( 1 - p ) ( c- -- -- c- -+) == φ+( b ) p c+d- φ- -( b ) ( 1 - p ) c- -d= 0 ,
unter Verwendung der Notation, die ich in meinen Kommentaren unter Stephens Antwort eingeführt habe, dh c+d= c+- -- c++ und c- -d= c- -+- c- -- -.
Die optimale Schwelle ergibt sich daher aus der Lösung der Gleichung φ+( b )φ- -( b )= ( 1 - p ) c- -dp c+d.
Zwei Dinge sollten hier beachtet werden:
- Dieses Ergebnis ist völlig allgemein gehalten und funktioniert für jede Verteilung der Testergebnisse, nicht nur normal. (φ in diesem Fall bedeutet natürlich die Wahrscheinlichkeitsdichtefunktion der Verteilung, nicht die normale Dichte.)
- Was auch immer die Lösung für b ist, es ist sicherlich eine Funktion von ( 1 - p ) c- -dp c+d. (Dh wir sehen sofort, wie wichtig Kosten sind - zusätzlich zum Klassenungleichgewicht!)
Es würde mich wirklich interessieren, ob diese Gleichung eine generische Lösung für hat b (parametrisiert durch die φs), aber ich wäre überrascht.
Trotzdem können wir es normal ausarbeiten! 2 πσ2- -- -- -- -√s Abbrechen auf der linken Seite, also haben wir e- 12( ( b - μ+)2σ2- ( b - μ- -)2σ2)= ( 1 - p ) c- -dp c+d( b - μ- -)2- ( b - μ+)2= 2 σ2Log( 1 - p ) c- -dp c+d2 b ( μ+- μ- -) + ( μ2- -- μ2+) =2 σ2Log( 1 - p ) c- -dp c+d
daher ist die Lösung b∗= ( μ2+- μ2- -) +2 σ2Log( 1 - p ) c- -dp c+d2 ( μ+- μ- -)= μ++ μ- -2+ σ2μ+- μ- -Log( 1 - p ) c- -dp c+d.
(Vergleichen Sie das vorherige Ergebnis! Wir sehen, dass sie genau dann gleich sind, wenn c- -d= c+ddh die Unterschiede zwischen den Kosten für die Fehlklassifizierung und den Kosten für die korrekte Klassifizierung sind bei kranken und gesunden Menschen gleich.)
Eine kurze Demonstration
Sagen wir c- -- -= 0 (es ist medizinisch ganz natürlich), und das c++= 1 (Wir können es immer erhalten, indem wir die Kosten mit teilen c++dh durch Messen aller Kosten in c++Einheiten). Nehmen wir an, die Prävalenz istp = 0,2. Sagen wir das auchμ- -= 9,5, μ+= 10,5 und σ= 1.
In diesem Fall:
library( data.table )
library( lattice )
cminusminus <- 0
cplusplus <- 1
p <- 0.2
muminus <- 9.5
muplus <- 10.5
sigma <- 1
res <- data.table( expand.grid( b = seq( 6, 17, 0.1 ),
cplusminus = c( 1, 5, 10, 50, 100 ),
cminusplus = c( 2, 5, 10, 50, 100 ) ) )
res$cost <- cplusplus*p*( 1-pnorm( res$b, muplus, sigma ) ) +
res$cplusminus*(1-p)*(1-pnorm( res$b, muminus, sigma ) ) +
res$cminusplus*p*pnorm( res$b, muplus, sigma ) +
cminusminus*(1-p)*pnorm( res$b, muminus, sigma )
xyplot( cost ~ b | factor( cminusplus ), groups = cplusminus, ylim = c( -1, 22 ),
data = res, type = "l", xlab = "Threshold",
ylab = "Expected overall cost", as.table = TRUE,
abline = list( v = (muplus+muminus)/2+
sigma^2/(muplus-muminus)*log((1-p)/p) ),
strip = strip.custom( var.name = expression( {"c"^{"+"}}["-"] ),
strip.names = c( TRUE, TRUE ) ),
auto.key = list( space = "right", points = FALSE, lines = TRUE,
title = expression( {"c"^{"-"}}["+"] ) ),
panel = panel.superpose, panel.groups = function( x, y, col.line, ... ) {
panel.xyplot( x, y, col.line = col.line, ... )
panel.points( x[ which.min( y ) ], min( y ), pch = 19, col = col.line )
} )
Das Ergebnis ist (Punkte stellen die minimalen Kosten dar und die vertikale Linie zeigt den optimalen Schwellenwert mit dem auf Genauigkeit basierenden Ansatz):
Wir können sehr gut sehen, wie sich das kostenbasierte Optimum vom genauigkeitsbasierten Optimum unterscheiden kann. Es ist lehrreich darüber nachzudenken, warum: wenn es teurer ist, kranke Menschen fälschlicherweise gesund zu klassifizieren als umgekehrt (c+- - ist hoch, c- -+ ist niedrig) als der Schwellenwert sinkt, da wir es vorziehen, leichter in die Kategorie krank einzustufen, wenn es andererseits teurer ist, ein gesundes Volk zu fälschen, das fälschlicherweise krank ist, als umgekehrt (c+- - ist niedrig, c- -+ist hoch) als der Schwellenwert steigt, da wir es vorziehen, leichter in die Kategorie gesund zu klassifizieren. (Überprüfen Sie diese auf der Abbildung!)
Ein reales Beispiel
Schauen wir uns ein empirisches Beispiel anstelle einer theoretischen Ableitung an. Dieses Beispiel unterscheidet sich grundlegend von zwei Aspekten:
- Anstatt Normalität anzunehmen, werden wir einfach die empirischen Daten ohne eine solche Annahme verwenden.
- Anstatt einen einzelnen Test und seine Ergebnisse in eigenen Einheiten zu verwenden, werden wir mehrere Tests verwenden (und diese mit einer logistischen Regression kombinieren). Der Schwellenwert wird für die endgültige vorhergesagte Wahrscheinlichkeit angegeben. Dies ist eigentlich der bevorzugte Ansatz, siehe Kapitel 19 - Diagnose - in Frank Harrells BBR .
Der Datensatz ( acath
aus dem PaketHmisc
) stammt aus der Datenbank für kardiovaskuläre Erkrankungen der Duke University und enthält, ob der Patient eine signifikante Koronarerkrankung hatte, wie durch Herzkatheterisierung festgestellt. Dies ist unser Goldstandard, dh der wahre Krankheitsstatus und der "Test" "wird die Kombination aus Alter, Geschlecht, Cholesterinspiegel und Dauer der Symptome des Probanden sein:
library( rms )
library( lattice )
library( latticeExtra )
library( data.table )
getHdata( "acath" )
acath <- acath[ !is.na( acath$choleste ), ]
dd <- datadist( acath )
options( datadist = "dd" )
fit <- lrm( sigdz ~ rcs( age )*sex + rcs( choleste ) + cad.dur, data = acath )
Es lohnt sich, die vorhergesagten Risiken im Logit-Maßstab aufzuzeichnen, um zu sehen, wie normal sie sind (im Wesentlichen haben wir dies zuvor mit einem einzigen Test angenommen!):
densityplot( ~predict( fit ), groups = acath$sigdz, plot.points = FALSE, ref = TRUE,
auto.key = list( columns = 2 ) )
Nun, sie sind kaum normal ...
Lassen Sie uns fortfahren und die erwarteten Gesamtkosten berechnen:
ExpectedOverallCost <- function( b, p, y, cplusminus, cminusplus,
cplusplus = 1, cminusminus = 0 ) {
sum( table( factor( p>b, levels = c( FALSE, TRUE ) ), y )*matrix(
c( cminusminus, cplusminus, cminusplus, cplusplus ), nc = 2 ) )
}
table( predict( fit, type = "fitted" )>0.5, acath$sigdz )
ExpectedOverallCost( 0.5, predict( fit, type = "fitted" ), acath$sigdz, 2, 4 )
Und zeichnen wir es für alle möglichen Kosten auf (ein rechnerischer Hinweis: Wir müssen nicht gedankenlos durch Zahlen von 0 bis 1 iterieren, wir können die Kurve perfekt rekonstruieren, indem wir sie für alle eindeutigen Werte der vorhergesagten Wahrscheinlichkeiten berechnen):
ps <- sort( unique( c( 0, 1, predict( fit, type = "fitted" ) ) ) )
xyplot( sapply( ps, ExpectedOverallCost,
p = predict( fit, type = "fitted" ), y = acath$sigdz,
cplusminus = 2, cminusplus = 4 ) ~ ps, type = "l", xlab = "Threshold",
ylab = "Expected overall cost", panel = function( x, y, ... ) {
panel.xyplot( x, y, ... )
panel.points( x[ which.min( y ) ], min( y ), pch = 19, cex = 1.1 )
panel.text( x[ which.min( y ) ], min( y ), round( x[ which.min( y ) ], 3 ),
pos = 3 )
} )
Wir können sehr gut sehen, wo wir den Schwellenwert setzen sollten, um die erwarteten Gesamtkosten zu optimieren (ohne irgendwo Sensitivität, Spezifität oder Vorhersagewerte zu verwenden!). Dies ist der richtige Ansatz.
Es ist besonders lehrreich, diese Metriken gegenüberzustellen:
ExpectedOverallCost2 <- function( b, p, y, cplusminus, cminusplus,
cplusplus = 1, cminusminus = 0 ) {
tab <- table( factor( p>b, levels = c( FALSE, TRUE ) ), y )
sens <- tab[ 2, 2 ] / sum( tab[ , 2 ] )
spec <- tab[ 1, 1 ] / sum( tab[ , 1 ] )
c( `Expected overall cost` = sum( tab*matrix( c( cminusminus, cplusminus, cminusplus,
cplusplus ), nc = 2 ) ),
Sensitivity = sens,
Specificity = spec,
PPV = tab[ 2, 2 ] / sum( tab[ 2, ] ),
NPV = tab[ 1, 1 ] / sum( tab[ 1, ] ),
Accuracy = 1 - ( tab[ 1, 1 ] + tab[ 2, 2 ] )/sum( tab ),
Youden = 1 - ( sens + spec - 1 ),
Topleft = ( 1-sens )^2 + ( 1-spec )^2
)
}
ExpectedOverallCost2( 0.5, predict( fit, type = "fitted" ), acath$sigdz, 2, 4 )
res <- melt( data.table( ps, t( sapply( ps, ExpectedOverallCost2,
p = predict( fit, type = "fitted" ),
y = acath$sigdz,
cplusminus = 2, cminusplus = 4 ) ) ),
id.vars = "ps" )
p1 <- xyplot( value ~ ps, data = res, subset = variable=="Expected overall cost",
type = "l", xlab = "Threshold", ylab = "Expected overall cost",
panel=function( x, y, ... ) {
panel.xyplot( x, y, ... )
panel.abline( v = x[ which.min( y ) ],
col = trellis.par.get()$plot.line$col )
panel.points( x[ which.min( y ) ], min( y ), pch = 19 )
} )
p2 <- xyplot( value ~ ps, groups = variable,
data = droplevels( res[ variable%in%c( "Expected overall cost",
"Sensitivity",
"Specificity", "PPV", "NPV" ) ] ),
subset = variable%in%c( "Sensitivity", "Specificity", "PPV", "NPV" ),
type = "l", xlab = "Threshold", ylab = "Sensitivity/Specificity/PPV/NPV",
auto.key = list( columns = 3, points = FALSE, lines = TRUE ) )
doubleYScale( p1, p2, use.style = FALSE, add.ylab2 = TRUE )
Wir können jetzt die Metriken analysieren, für die manchmal speziell geworben wird, um einen optimalen Cutoff ohne Kosten zu erzielen, und dies unserem kostenbasierten Ansatz gegenüberstellen! Verwenden wir die drei am häufigsten verwendeten Metriken:
- Genauigkeit (maximale Genauigkeit)
- Youden-Regel (maximieren S.e n s + S.p e c - 1)
- Topleft-Regel (minimieren ( 1 - S.e n s )2+ ( 1 - S.p e c )2)
(Der Einfachheit halber subtrahieren wir die obigen Werte von 1 für die Youden- und die Genauigkeitsregel, damit wir überall ein Minimierungsproblem haben.)
Lassen Sie uns die Ergebnisse sehen:
p3 <- xyplot( value ~ ps, groups = variable,
data = droplevels( res[ variable%in%c( "Expected overall cost", "Accuracy",
"Youden", "Topleft" ) ] ),
subset = variable%in%c( "Accuracy", "Youden", "Topleft" ),
type = "l", xlab = "Threshold", ylab = "Accuracy/Youden/Topleft",
auto.key = list( columns = 3, points = FALSE, lines = TRUE ),
panel = panel.superpose, panel.groups = function( x, y, col.line, ... ) {
panel.xyplot( x, y, col.line = col.line, ... )
panel.abline( v = x[ which.min( y ) ], col = col.line )
panel.points( x[ which.min( y ) ], min( y ), pch = 19, col = col.line )
} )
doubleYScale( p1, p3, use.style = FALSE, add.ylab2 = TRUE )
Dies betrifft natürlich eine bestimmte Kostenstruktur, c- -- -= 0, c++= 1, c- -+= 2, c+- -= 4(Dies ist natürlich nur für die optimale Kostenentscheidung von Bedeutung). Um den Effekt der Kostenstruktur zu untersuchen, wählen wir nur den optimalen Schwellenwert (anstatt die gesamte Kurve zu verfolgen), zeichnen ihn jedoch als Funktion der Kosten auf. Genauer gesagt, wie wir bereits gesehen haben, hängt die optimale Schwelle von den vier Kosten nur durch die abc- -d/ c+d Verhältnis, also zeichnen wir den optimalen Cutoff als Funktion davon zusammen mit den normalerweise verwendeten Metriken, die keine Kosten verwenden:
res2 <- data.frame( rat = 10^( seq( log10( 0.02 ), log10( 50 ), length.out = 500 ) ) )
res2$OptThreshold <- sapply( res2$rat,
function( rat ) ps[ which.min(
sapply( ps, Vectorize( ExpectedOverallCost, "b" ),
p = predict( fit, type = "fitted" ),
y = acath$sigdz,
cplusminus = rat,
cminusplus = 1,
cplusplus = 0 ) ) ] )
xyplot( OptThreshold ~ rat, data = res2, type = "l", ylim = c( -0.1, 1.1 ),
xlab = expression( {"c"^{"-"}}["d"]/{"c"^{"+"}}["d"] ), ylab = "Optimal threshold",
scales = list( x = list( log = 10, at = c( 0.02, 0.05, 0.1, 0.2, 0.5, 1,
2, 5, 10, 20, 50 ) ) ),
panel = function( x, y, resin = res[ ,.( ps[ which.min( value ) ] ),
.( variable ) ], ... ) {
panel.xyplot( x, y, ... )
panel.abline( h = resin[variable=="Youden"] )
panel.text( log10( 0.02 ), resin[variable=="Youden"], "Y", pos = 3 )
panel.abline( h = resin[variable=="Accuracy"] )
panel.text( log10( 0.02 ), resin[variable=="Accuracy"], "A", pos = 3 )
panel.abline( h = resin[variable=="Topleft"] )
panel.text( log10( 0.02 ), resin[variable=="Topleft"], "TL", pos = 1 )
} )
Horizontale Linien geben die Ansätze an, die keine Kosten verwenden (und daher konstant sind).
Wir sehen wieder gut, dass mit steigenden zusätzlichen Kosten für eine Fehlklassifizierung in der gesunden Gruppe im Vergleich zu denen der erkrankten Gruppe die optimale Schwelle steigt: Wenn wir wirklich nicht wollen, dass gesunde Menschen als krank eingestuft werden, werden wir einen höheren Grenzwert verwenden (und umgekehrt natürlich!).
Und schließlich sehen wir noch einmal, warum Methoden, die keine Kosten verwenden, nicht immer optimal sind ( und auch nicht können! ).