Il pourrait être utile d'ajouter un autre exemple, peut-être plus simple, à l'excellente réponse de Stephen.
Considérons un test médical, dont le résultat est normalement distribué, à la fois chez les personnes malades et chez les personnes en bonne santé, avec des paramètres différents bien sûr (mais pour simplifier, supposons une homoscédasticité, c'est-à-dire que la variance est la même):Notons la prévalence de la maladie avec (c'est-à-dire ), donc ceci, avec ce qui précède, qui sont essentiellement des distributions conditionnelles, spécifie entièrement la distribution conjointe.T∣D⊖∼N(μ−,σ2)T∣D⊕∼N(μ+,σ2).
pD⊕∼Bern(p)
Ainsi, la matrice de confusion avec le seuil (c'est-à-dire que ceux dont les résultats des tests sont supérieurs à sont classés comme malades) estbb⎛⎝⎜T⊕T⊖D⊕p(1−Φ+(b))pΦ+(b)D⊖(1−p)(1−Φ−(b))(1−p)Φ−(b)⎞⎠⎟.
Approche basée sur la précision
La précision estp(1−Φ+(b))+(1−p)Φ−(b),
nous prenons sa dérivée wrt , la mettons égale à 0, multiplions avec et réorganisons un peu: Le premier terme ne peut pas être zéro, donc la seule façon dont le produit peut être zéro est si le deuxième terme est zéro:b1πσ2−−−−√−pφ+(b)+φ−(b)−pφ−(b)=0e−(b−μ−)22σ2[(1−p)−pe−2b(μ−−μ+)+(μ2+−μ2−)2σ2]=0
(1−p)−pe−2b(μ−−μ+)+(μ2+−μ2−)2σ2=0−2b(μ−−μ+)+(μ2+−μ2−)2σ2=log1−pp2b(μ+−μ−)+(μ2−−μ2+)=2σ2log1−pp
La solution est doncb∗=(μ2+−μ2−)+2σ2log1−pp2(μ+−μ−)=μ++μ−2+σ2μ+−μ−log1−pp.
Notez que cela - bien sûr - ne dépend pas des coûts.
Si les classes sont équilibrées, l'optimum est la moyenne des valeurs de test moyennes chez les personnes malades et en bonne santé, sinon il est déplacé en fonction du déséquilibre.
Approche basée sur les coûts
En utilisant la notation de Stephen, le coût global attendu estPrenez sa dérivée par rapport à et fixez-la à zéro: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)pc+d−φ−(b)(1−p)c−d=0,
en utilisant la notation que j'ai introduite dans mes commentaires ci-dessous la réponse de Stephen, c.-à-d. et .c+d=c+−−c++c−d=c−+−c−−
Le seuil optimal est donc donné par la solution de l'équationDeux choses sont à noter ici:φ+(b)φ−(b)=(1−p)c−dpc+d.
- Ce résultat est totalement générique et fonctionne pour n'importe quelle distribution des résultats de test, pas seulement normal. ( dans ce cas signifie bien sûr la fonction de densité de probabilité de la distribution, pas la densité normale.)φ
- Quelle que soit la solution de , c'est sûrement une fonction de . (C'est-à-dire que nous voyons immédiatement à quel point les coûts comptent - en plus du déséquilibre de classe!)b(1−p)c−dpc+d
Je serais vraiment intéressé de voir si cette équation a une solution générique pour (paramétrée par les s), mais je serais surpris.bφ
Néanmoins, nous pouvons le faire pour normal! s annuler sur le côté gauche, nous avons donc donc la solution est2πσ2−−−−√e−12((b−μ+)2σ2−(b−μ−)2σ2)=(1−p)c−dpc+d(b−μ−)2−(b−μ+)2=2σ2log(1−p)c−dpc+d2b(μ+−μ−)+(μ2−−μ2+)=2σ2log(1−p)c−dpc+d
b∗=(μ2+−μ2−)+2σ2log(1−p)c−dpc+d2(μ+−μ−)=μ++μ−2+σ2μ+−μ−log(1−p)c−dpc+d.
(Comparez-le au résultat précédent! Nous voyons qu'ils sont égaux si et seulement si , c'est-à-dire que les différences de coût de mauvaise classification par rapport au coût d'une classification correcte sont les mêmes chez les malades et les sains. gens.)c−d=c+d
Une courte démonstration
Disons que (c'est assez naturel médicalement), et que (on peut toujours l'obtenir en divisant les coûts par , c'est-à-dire en mesurant chaque coût en unités ). Disons que la prévalence est . Supposons également que , et .c−−=0c++=1c++c++p=0.2μ−=9.5μ+=10.5σ=1
Dans ce cas:
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 )
} )
Le résultat est (les points représentent le coût minimum, et la ligne verticale montre le seuil optimal avec l'approche basée sur la précision):
Nous pouvons très bien voir comment l'optimum basé sur les coûts peut être différent de l'optimum basé sur la précision. Il est instructif de réfléchir à la raison: s'il est plus coûteux de classer une personne malade en mauvaise santé que l'inverse ( est élevé, est faible) que le le seuil descend, car nous préférons classer plus facilement dans la catégorie malade, en revanche, s'il est plus coûteux de classer une personne saine malade par erreur que l'inverse ( est faible, est élevé) que le seuil monte, car nous préférons classer plus facilement dans la catégorie sain. (Vérifiez-les sur la figure!)c+−c−+c+−c−+
Un exemple concret
Jetons un regard sur un exemple empirique, au lieu d'une dérivation théorique. Cet exemple sera fondamentalement différent de deux aspects:
- Au lieu de supposer la normalité, nous utiliserons simplement les données empiriques sans une telle hypothèse.
- Au lieu d'utiliser un seul test, et ses résultats dans ses propres unités, nous utiliserons plusieurs tests (et les combinerons avec une régression logistique). Un seuil sera donné à la probabilité finale prédite. C'est en fait l'approche préférée, voir le chapitre 19 - Diagnostic - dans le BBR de Frank Harrell .
L' ensemble de données ( acath
de l'emballage Hmisc
) provient de la banque de données sur les maladies cardiovasculaires de l'Université Duke et indique si le patient souffrait d'une maladie coronarienne importante, telle qu'évaluée par cathétérisme cardiaque, ce sera notre étalon-or, à savoir le véritable état de la maladie et le "test" "sera la combinaison de l'âge, du sexe, du taux de cholestérol et de la durée des symptômes du sujet:
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 )
Il vaut la peine de tracer les risques prévus à l'échelle logit, pour voir à quel point ils sont normaux (essentiellement, c'est ce que nous avons supposé précédemment, avec un seul test!):
densityplot( ~predict( fit ), groups = acath$sigdz, plot.points = FALSE, ref = TRUE,
auto.key = list( columns = 2 ) )
Eh bien, ce n'est pas normal ...
Continuons et calculons le coût global attendu:
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 )
Et tracons-la pour tous les coûts possibles (une note de calcul: nous n'avons pas besoin d'itérer sans réfléchir par des nombres de 0 à 1, nous pouvons parfaitement reconstruire la courbe en la calculant pour toutes les valeurs uniques des probabilités prédites):
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 )
} )
Nous pouvons très bien voir où nous devons mettre le seuil pour optimiser le coût global attendu (sans utiliser de sensibilité, de spécificité ou de valeurs prédictives n'importe où!). C'est la bonne approche.
Il est particulièrement instructif de comparer ces mesures:
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 )
Nous pouvons maintenant analyser les métriques qui sont parfois spécifiquement annoncées comme étant capables de proposer un seuil optimal sans frais, et le comparer avec notre approche basée sur les coûts! Utilisons les trois métriques les plus utilisées:
- Précision (maximiser la précision)
- Règle de Youden (maximiser )Sens+Spec−1
- Règle du peuple (minimiser )(1−Sens)2+(1−Spec)2
(Par souci de simplicité, nous soustraireons les valeurs ci-dessus de 1 pour le Youden et la règle de précision afin d'avoir un problème de minimisation partout.)
Voyons les résultats:
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 )
Cela concerne bien sûr une structure de coûts spécifique, , , , (cela n'a évidemment d'importance que pour la décision de coût optimal). Pour étudier l'effet de la structure des coûts, choisissons simplement le seuil optimal (au lieu de tracer toute la courbe), mais tracer-le en fonction des coûts. Plus précisément, comme nous l'avons déjà vu, le seuil optimal ne dépend des quatre coûts que par le biais du rapport , nous allons donc tracer le seuil optimal en fonction de cela, ainsi que le type généralement utilisé mesures qui n'utilisent pas de coûts:c−−=0c++=1c−+=2c+−=4c−d/c+d
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 )
} )
Les lignes horizontales indiquent les approches qui n'utilisent pas de coûts (et sont donc constantes).
Encore une fois, nous voyons bien qu'à mesure que le coût supplémentaire des erreurs de classification dans le groupe sain augmente par rapport à celui du groupe malade, le seuil optimal augmente: si nous ne voulons vraiment pas que les personnes en bonne santé soient classées comme malades, nous utiliserons un seuil plus élevé (et inversement, bien sûr!).
Et, enfin, nous voyons encore une fois pourquoi ces méthodes qui n'utilisent pas de coûts ne sont pas ( et ne peuvent pas! ) Être toujours optimales.