Exemplo ao usar a precisão como uma medida de resultado levará a uma conclusão errada

Estou analisando várias medidas de desempenho para modelos preditivos. Muito foi escrito sobre problemas no uso da precisão, em vez de algo mais contínuo para avaliar o desempenho do modelo. Frank Harrell http://www.fharrell.com/post/class-damage/ fornece um exemplo ao adicionar uma variável informativa a um modelo, levando a uma queda na precisão, claramente contra-intuitiva e conclusão errada.

No entanto, neste caso, isso parece ser causado por ter classes desequilibradas e, portanto, pode ser resolvido apenas com a precisão equilibrada ((sens + spec) / 2). Existe algum exemplo em que o uso da precisão em um conjunto de dados equilibrado levará a algumas conclusões claramente erradas ou contra-intuitivas?

Editar

Estou procurando algo em que a precisão caia mesmo quando o modelo é claramente melhor ou que o uso da precisão levará a uma seleção positiva falsa de alguns recursos. É fácil criar exemplos de falsos negativos, em que a precisão é a mesma para dois modelos em que um é claramente melhor usando outros critérios.

Vou trapacear.

Especificamente, argumentei com frequência (por exemplo, aqui ) que a parte estatística da modelagem e previsão se estende apenas a fazer previsões probabilísticas para associações de classe (ou fornecer densidades preditivas, no caso de previsão numérica). Tratar uma instância específica como se pertencesse a uma classe específica (ou previsões de pontos no caso numérico) não é mais uma estatística adequada. Faz parte do aspecto teórico da decisão .

E as decisões não devem ser baseadas apenas na previsão probabilística, mas também nos custos de classificações incorretas e em uma série de outras ações possíveis . Por exemplo, mesmo se você tiver apenas duas classes possíveis, "doente" vs. "saudável", poderá realizar uma grande variedade de ações possíveis, dependendo da probabilidade de um paciente sofrer da doença, de enviá-lo para casa porque é quase certamente saudável, dar a ele duas aspirinas, executar testes adicionais, chamar imediatamente uma ambulância e colocá-lo em suporte de vida.

A avaliação da precisão pressupõe essa decisão. A precisão como métrica de avaliação para classificação é um erro de categoria .

Portanto, para responder sua pergunta, seguirei o caminho de apenas um erro de categoria. Consideraremos um cenário simples com classes equilibradas em que a classificação sem levar em consideração os custos da classificação incorreta realmente nos enganará.

---

Suponha que uma epidemia de Gutrot Maligno ocorra galopante na população. Felizmente, podemos rastrear todos facilmente alguma característica $t$ ( $0\leq t \leq 1$ ), e sabemos que a probabilidade de desenvolver MG depende linearmente de $t$ , $p=\gamma t$ para algum parâmetro $\gamma$ ( $0\leq \gamma \leq 1$ ). O traço $t$ é uniformemente distribuído na população.

Felizmente, existe uma vacina. Infelizmente, é caro, e os efeitos colaterais são muito desconfortáveis. (Vou deixar sua imaginação fornecer os detalhes.) No entanto, eles são melhores do que sofrer de MG.

No interesse da abstração, afirmo que, de fato, existem apenas dois cursos de ação possíveis para um determinado paciente, dado o seu valor de característica $t$ : vacinar ou não.

Assim, a pergunta é: como devemos decidir quem deve ser vacinado e quem não deve, dado $t$ ? Seremos utilitários sobre isso e pretendemos ter os menores custos totais esperados. É óbvio que isso se resume em escolher um limiar $\theta$ e vacinar todos com $t\geq\theta$ .

---

O modelo e a decisão 1 são orientados pela precisão. Encaixe um modelo. Felizmente, já conhecemos o modelo. Escolha o limiar $\theta$ que maximiza a precisão ao classificar os pacientes e vacine todos com $t\geq \theta$ . Vemos facilmente que $\theta=\frac{1}{2\gamma}$ é o número mágico - todos com$t\geq \theta$têm uma chance maior de contrair MG do que não e vice-versa, portanto esselimite de probabilidade de classificaçãomaximizará a precisão. Supondo classes equilibradas,$\gamma=1$, vacinaremos metade da população. Curiosamente, se$\gamma<\frac{1}{2}$ , não vamos vacinarninguém. (Estamos principalmente interessados ​​em aulas equilibradas, então vamos desconsiderar que deixamos parte da população morrer por uma morte dolorosa horrível.)

Escusado será dizer que isso não leva em consideração os custos diferenciais da classificação incorreta.

---

Modelo-and-decisão 2 alavancagem tanto a nossa previsão probabilística ( "dada a sua característica $t$ , sua probabilidade de contrair MG é $\gamma t$ ") e a estrutura de custos.

Primeiro, aqui está um pequeno gráfico. O eixo horizontal fornece a característica, o eixo vertical a probabilidade MG. O triângulo sombreado indica a proporção da população que contrairá MG. A linha vertical fornece algum $\theta$ particular . A linha tracejada horizontal em $\gamma\theta$ tornará os cálculos abaixo um pouco mais fáceis de seguir. Assumimos $\gamma>\frac{1}{2}$ , apenas para facilitar a vida.

Vamos dar nomes aos nossos custos e calcular suas contribuições para os custos totais esperados, dados $\theta$ e $\gamma$ (e o fato de que a característica é distribuída uniformemente na população).

• Vamos $c^+_+$ denotar o custo para um paciente que é vacinado e teria contraído MG. Dado $\theta$ , a proporção da população que incorre nesse custo é o trapézio sombreado no canto inferior direito com a área $$(1-\theta)\gamma\theta + \frac{1}{2}(1-\theta)(\gamma-\gamma\theta).$$
• Vamos $c^-_+$ denotar o custo para um paciente que é vacinado e não teria contraído MG. Dado $\theta$ , a proporção da população que incorre nesse custo é o trapézio sem sombra no canto superior direito com a área $$(1-\theta)(1-\gamma) + \frac{1}{2}(1-\theta)(\gamma-\gamma\theta).$$
• Vamos $c^-_-$ denotar o custo para um paciente que não é vacinado e não teria contraído MG. Dado $\theta$ , a proporção da população que incorre nesse custo é o trapézio sem sombra no canto superior esquerdo com a área $$\theta(1-\gamma\theta) + \frac{1}{2}\theta\gamma\theta.$$
• Vamos $c^+_-$ denotar o custo para um paciente que não é vacinado e teria contraído MG. Dado $\theta$ , a proporção da população que incorre nesse custo é o triângulo sombreado na parte inferior esquerda da área $$\frac{1}{2}\theta\gamma\theta.$$

(Em cada trapézio, primeiro calculo a área do retângulo e depois adiciono a área do triângulo.)

Os custos totais esperados são

$$c^+_+\bigg((1-\theta)\gamma\theta + \frac{1}{2}(1-\theta)(\gamma-\gamma\theta)\bigg) + c^-_+\bigg((1-\theta)(1-\gamma) + \frac{1}{2}(1-\theta)(\gamma-\gamma\theta)\bigg) + c^-_-\bigg(\theta(1-\gamma\theta) + \frac{1}{2}\theta\gamma\theta\bigg) + c^+_-\frac{1}{2}\theta\gamma\theta.$$

Diferenciando e definindo a derivada como zero, obtemos que os custos esperados são minimizados por

$$\theta^\ast = \frac{c^-_+-c^-_-}{\gamma(c^+_-+c^-_+-c^+_+-c^-_-)}.$$

Isso é apenas igual ao valor maximizador da precisão de $\theta$ para uma estrutura de custos muito específica, ou seja, se e somente se

$$\frac{1}{2\gamma} = \frac{c^-_+-c^-_-}{\gamma(c^+_-+c^-_+-c^+_+-c^-_-)},$$ ou $$\frac{1}{2} = \frac{c^-_+-c^-_-}{c^+_-+c^-_+-c^+_+-c^-_-}.$$

Como exemplo, suponha que $\gamma=1$ para classes equilibradas e que os custos sejam

$$c^+_+ = 1, \quad c^-_+=2, \quad c^+_-=10, \quad c^-_-=0.$$ Então a precisão maximizando$\theta=\frac{1}{2}$ produzirá custos esperados de$1.875$, enquanto o custo que minimiza$\theta=\frac{2}{11}$ trará custos esperados de$1.318$.

Neste exemplo, basear nossas decisões em classificações não probabilísticas que maximizavam a precisão levavam a mais vacinas e custos mais altos do que o uso de uma regra de decisão que explicitamente usava as estruturas de custos diferenciais no contexto de uma previsão probabilística.

---

Conclusão: a precisão é apenas um critério de decisão válido se

• existe um relacionamento individual entre classes e possíveis ações
• e os custos das ações aplicadas às classes seguem uma estrutura muito específica.

No caso geral, avaliar a precisão faz uma pergunta errada e maximizar a precisão é o chamado erro do tipo III: fornecer a resposta correta para a pergunta errada.

---

Código R:

rm(list=ls())
gamma <- 0.7

cost_treated_positive <- 1          # cost of treatment, side effects unimportant
cost_treated_negative <- 2          # cost of treatment, side effects unnecessary
cost_untreated_positive <- 10       # horrible, painful death
cost_untreated_negative <- 0        # nothing

expected_cost <- function ( theta ) {
    cost_treated_positive * ( (1-theta)*theta*gamma + (1-theta)*(gamma-gamma*theta)/2 ) +
    cost_treated_negative * ( (1-theta)*(1-gamma) + (1-theta)*(gamma-gamma*theta)/2 ) +
    cost_untreated_negative *( theta*(1-gamma*theta) + theta*gamma*theta/2 ) +
    cost_untreated_positive * theta*gamma*theta/2
}

(theta <- optim(par=0.5,fn=expected_cost,lower=0,upper=1,method="L-BFGS-B")$par)
(cost_treated_negative-cost_untreated_negative)/
    (gamma*(cost_treated_negative+cost_untreated_positive-cost_treated_positive-cost_untreated_negative))

plot(c(0,1),c(0,1),type="n",bty="n",xaxt="n",xlab="Trait t",yaxt="n",ylab="MG probability")
rect(0,0,1,1)
axis(1,c(0,theta,1),c(0,"theta",1),lty=0,line=-1)
axis(2,c(0,1),lty=0,line=-1,las=1)
axis(4,c(0,gamma,1),c(0,"gamma",1),lty=0,line=-1.8,las=1)
polygon(c(0,1,1),c(0,0,gamma),col="lightgray")
abline(v=theta,col="red",lwd=2)
abline(h=gamma*theta,lty=2,col="red",lwd=2)

expected_cost(1/(2*gamma))
expected_cost(theta)

Talvez valha a pena acrescentar outro exemplo, talvez mais direto, à excelente resposta de Stephen.

$$\begin{gather*}T \mid D \ominus \sim \mathcal{N}\left(\mu_{-},\sigma^2\right)\\T \mid D \oplus \sim \mathcal{N}\left(\mu_{+},\sigma^2\right)\end{gather*}.$$ $p$$D\oplus\sim Bern\left(p\right)$

$b$$b$

$$\begin{pmatrix} & D\oplus & D\ominus\\ T\oplus & p\left(1-\Phi_{+}\left(b\right)\right) & \left(1-p\right)\left(1-\Phi_{-}\left(b\right)\right)\\ T\ominus & p\Phi_{+}\left(b\right) & \left(1-p\right)\Phi_{-}\left(b\right)\\ \end{pmatrix}.$$

---

Abordagem baseada em precisão

$$p\left(1-\Phi_{+}\left(b\right)\right)+\left(1-p\right)\Phi_{-}\left(b\right),$$

$b$$\sqrt{1\pi\sigma^2}$

$$\begin{gather*} -p\varphi_{+}\left(b\right)+\varphi_{-}\left(b\right)-p\varphi_{-}\left(b\right)=0\\ e^{-\frac{\left(b-\mu_{-}\right)^2}{2\sigma^2}}\left[\left(1-p\right)-pe^{-\frac{2b\left(\mu_{-}-\mu_{+}\right)+\left(\mu_{+}^2-\mu_{-}^2\right)}{2\sigma^2}}\right]=0\end{gather*}$$ $$\begin{gather*}\left(1-p\right)-pe^{-\frac{2b\left(\mu_{-}-\mu_{+}\right)+\left(\mu_{+}^2-\mu_{-}^2\right)}{2\sigma^2}}=0\\-\frac{2b\left(\mu_{-}-\mu_{+}\right)+\left(\mu_{+}^2-\mu_{-}^2\right)}{2\sigma^2}=\log\frac{1-p}{p}\\ 2b\left(\mu_{+}-\mu_{-}\right)+\left(\mu_{-}^2-\mu_{+}^2\right)=2\sigma^2\log\frac{1-p}{p}\\ \end{gather*}$$ $$b^{\ast}=\frac{\left(\mu_{+}^2-\mu_{-}^2\right)+2\sigma^2\log\frac{1-p}{p}}{2\left(\mu_{+}-\mu_{-}\right)}=\frac{\mu_{+}+\mu_{-}}{2}+\frac{\sigma^2}{\mu_{+}-\mu_{-}}\log\frac{1-p}{p}.$$

Observe que isso - é claro - não depende dos custos.

Se as aulas são equilibradas, o ideal é a média dos valores médios dos testes em pessoas doentes e saudáveis, caso contrário, ela é deslocada com base no desequilíbrio.

---

Abordagem baseada em custos

Usando a notação de Stephen, o custo total esperado é

$$c_{+}^{+}p\left(1-\Phi_{+}\left(b\right)\right) + c_{+}^{-}\left(1-p\right)\left(1-\Phi_{-}\left(b\right)\right) + c_{-}^{+} p\Phi_{+}\left(b\right) + c_{-}^{-} \left(1-p\right)\Phi_{-}\left(b\right).$$ Tome seu derivado wrt $b$ e defina-o como zero: $$\begin{gather*} -c_{+}^{+} p \varphi_{+}\left(b\right)-c_{+}^{-}\left(1-p\right)\varphi_{-}\left(b\right)+c_{-}^{+}p\varphi_{+}\left(b\right)+c_{-}^{-}\left(1-p\right)\varphi_{-}\left(b\right)=\\ =\varphi_{+}\left(b\right)p\left(c_{-}^{+}-c_{+}^{+}\right)+\varphi_{-}\left(b\right)\left(1-p\right)\left(c_{-}^{-}-c_{+}^{-}\right)=\\ = \varphi_{+}\left(b\right)pc_d^{+}-\varphi_{-}\left(b\right)\left(1-p\right)c_d^{-}= 0,\end{gather*}$$ using the notation I introduced in my comments below Stephen's answer, i.e., $c_d^{+}=c_{-}^{+}-c_{+}^{+}$ and $c_d^{-}=c_{+}^{-}-c_{-}^{-}$.

The optimal threshold is therefore given by the solution of the equation

$$\boxed{\frac{\varphi_{+}\left(b\right)}{\varphi_{-}\left(b\right)}=\frac{\left(1-p\right)c_d^{-}}{pc_d^{+}}}.$$ Duas coisas devem ser observadas aqui:

1. Esse resultado é totalmente genérico e funciona para qualquer distribuição dos resultados do teste, não apenas o normal. ($\varphi$ nesse caso, é claro, significa a função de densidade de probabilidade da distribuição, não a densidade normal.)
2. Qualquer que seja a solução para $b$ é, certamente, uma função de $\frac{\left(1-p\right)c_d^{-}}{pc_d^{+}}$. (Ou seja, vemos imediatamente como os custos são importantes - além do desequilíbrio de classe!)

Eu ficaria realmente interessado em ver se esta equação tem uma solução genérica para $b$ (parametrizado pelo $\varphi$s), mas eu ficaria surpreso.

No entanto, podemos resolver isso normalmente! $\sqrt{2\pi\sigma^2}$s cancelar no lado esquerdo, por isso temos

$$\begin{gather*} e^{-\frac{1}{2}\left(\frac{\left(b-\mu_{+}\right)^2}{\sigma^2}-\frac{\left(b-\mu_{-}\right)^2}{\sigma^2}\right)}=\frac{\left(1-p\right)c_d^{-}}{pc_d^{+}} \\ \left(b-\mu_{-}\right)^2-\left(b-\mu_{+}\right)^2 =2\sigma^2 \log \frac{\left(1-p\right)c_d^{-}}{pc_d^{+}} \\ 2b\left(\mu_{+}-\mu_{-}\right)+\left(\mu_{-}^2-\mu_{+}^2\right) =2\sigma^2 \log \frac{\left(1-p\right)c_d^{-}}{pc_d^{+}}\end{gather*}$$ portanto, a solução é $$b^{\ast}=\frac{\left(\mu_{+}^2-\mu_{-}^2\right)+2\sigma^2 \log \frac{\left(1-p\right)c_d^{-}}{pc_d^{+}}}{2\left(\mu_{+}-\mu_{-}\right)}=\frac{\mu_{+}+\mu_{-}}{2}+\frac{\sigma^2}{\mu_{+}-\mu_{-}}\log \frac{\left(1-p\right)c_d^{-}}{pc_d^{+}}.$$

(Compare com o resultado anterior! Vemos que eles são iguais se e somente se $c_d^{-}=c_d^{+}$, ou seja, as diferenças no custo da classificação incorreta em comparação com o custo da classificação correta são as mesmas em pessoas doentes e saudáveis.)

---

Uma breve demonstração

Digamos $c_{-}^{-}=0$ (é bastante natural em termos médicos), e que $c_{+}^{+}=1$ (sempre podemos obtê-lo dividindo os custos com $c_{+}^{+}$, medindo todos os custos em $c_{+}^{+}$unidades). Digamos que a prevalência é$p=0.2$. Além disso, digamos que$\mu_{-}=9.5$, $\mu_{+}=10.5$ e $\sigma=1$.

Nesse caso:

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 )
        } )

O resultado é (os pontos representam o custo mínimo e a linha vertical mostra o limite ideal com a abordagem baseada na precisão):

Podemos ver muito bem como o ótimo baseado em custo pode ser diferente do ideal baseado em precisão. É instrutivo pensar no porquê: se é mais caro classificar pessoas doentes erroneamente saudáveis ​​do que o contrário ($c_{-}^{+}$ é alto, $c_{+}^{-}$ é baixo) do que o limiar diminui, pois preferimos classificar mais facilmente na categoria doente, por outro lado, se for mais caro classificar pessoas saudáveis ​​erroneamente doentes do que o contrário ($c_{-}^{+}$ é baixo, $c_{+}^{-}$é alto) do que o limite aumenta, pois preferimos classificar mais facilmente na categoria saudável. (Verifique estes na figura!)

---

Um exemplo da vida real

Vamos dar uma olhada em um exemplo empírico, em vez de uma derivação teórica. Este exemplo será diferente basicamente de dois aspectos:

• Em vez de assumir a normalidade, simplesmente usaremos os dados empíricos sem essa hipótese.
• Em vez de usar um único teste e seus resultados em suas próprias unidades, usaremos vários testes (e os combinaremos com uma regressão logística). O limite será dado à probabilidade final prevista. Esta é realmente a abordagem preferida, consulte o Capítulo 19 - Diagnóstico - no BBR de Frank Harrell .

O conjunto de dados ( acathdo pacote Hmisc) é do Banco de Dados de Doenças Cardiovasculares da Universidade de Duke e contém se o paciente teve doença coronariana significativa, avaliada por cateterismo cardíaco, este será nosso padrão ouro, ou seja, o verdadeiro status da doença e o "teste "será a combinação da idade, sexo, nível de colesterol e duração dos sintomas do sujeito:

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 )

Vale a pena traçar os riscos previstos em escala logit, para ver como eles são normais (essencialmente, foi o que assumimos anteriormente, com um único teste!):

densityplot( ~predict( fit ), groups = acath$sigdz, plot.points = FALSE, ref = TRUE,
             auto.key = list( columns = 2 ) )

Bem, eles não são normais ...

Vamos continuar e calcular o custo total esperado:

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 )

E vamos plotá-lo para todos os custos possíveis (uma observação computacional: não precisamos iterar irremediavelmente através de números de 0 a 1, podemos reconstruir perfeitamente a curva calculando-a para todos os valores exclusivos de probabilidades previstas):

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 )
        } )

Podemos ver muito bem onde devemos colocar o limite para otimizar o custo geral esperado (sem usar sensibilidade, especificidade ou valores preditivos em qualquer lugar!). Essa é a abordagem correta.

É especialmente instrutivo contrastar essas métricas:

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 )

Agora, podemos analisar as métricas que às vezes são anunciadas especificamente como capazes de criar um ponto de corte ideal sem custos, e contrastá-lo com nossa abordagem baseada em custos! Vamos usar as três métricas mais usadas:

• Precisão (maximizar precisão)
• Regra de Youden (maximizar $Sens+Spec-1$)
• Regra de Topleft (minimizar $\left(1-Sens\right)^2+\left(1-Spec\right)^2$)

(Por uma questão de simplicidade, subtrairemos os valores acima de 1 para a regra de Youden e de Precisão, para que tenhamos um problema de minimização em todos os lugares.)

Vamos ver os resultados:

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 )

Obviamente, isso se refere a uma estrutura de custos específica, $c_{-}^{-}=0$, $c_{+}^{+}=1$, $c_{+}^{-}=2$, $c_{-}^{+}=4$(isso obviamente é importante apenas para a decisão de custo ideal). Para investigar o efeito da estrutura de custos, escolha apenas o limite ideal (em vez de rastrear toda a curva), mas plote-o em função dos custos. Mais especificamente, como já vimos, o limite ideal depende dos quatro custos apenas através do$c_d^{-}/c_d^{+}$ , vamos traçar o ponto de corte ideal em função disso, juntamente com as métricas normalmente usadas que não usam custos:

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 )
        } )

Linhas horizontais indicam as abordagens que não usam custos (e, portanto, são constantes).

Novamente, vemos bem que, à medida que o custo adicional da classificação incorreta no grupo saudável aumenta em comparação com o grupo doente, o limiar ideal aumenta: se realmente não queremos que as pessoas saudáveis ​​sejam classificadas como doentes, usaremos pontos de corte mais altos (e o contrário, é claro!).

E, finalmente, mais uma vez vemos por que os métodos que não usam custos nem sempre são ( e não podem! ) Ser sempre ótimos.