curva - roc curve in r example
Calcular AUC en R? (10)
Dado un vector de puntajes y un vector de etiquetas de clase reales, ¿cómo se calcula una métrica AUC de un solo número para un clasificador binario en el lenguaje R o en inglés simple?
La página 9 de "AUC: a Better Measure ..." parece requerir conocer las etiquetas de clase, y aquí hay un ejemplo en MATLAB donde no entiendo
R(Actual == 1))
Porque R (que no debe confundirse con el lenguaje R) se define como un vector pero se usa como una función?
A lo largo de las líneas de la respuesta de erik, también debería ser capaz de calcular el ROC directamente comparando todos los pares posibles de valores de pos.scores y neg.scores:
score.pairs <- merge(pos.scores, neg.scores)
names(score.pairs) <- c("pos.score", "neg.score")
sum(score.pairs$pos.score > score.pairs$neg.score) / nrow(score.pairs)
Ciertamente menos eficiente que el método de muestra o el método pROC :: auc, pero más estable que el anterior y que requiere menos instalación que este último.
Relacionado: cuando probé esto, dio resultados similares al valor de pROC, pero no exactamente igual (menos de 0.02); el resultado fue más cercano al enfoque de la muestra con una N muy alta. Si alguien tiene ideas sobre por qué podría ser, estaría interesado.
Actualmente, la respuesta más votado es incorrecta, porque no tiene en cuenta los vínculos. Cuando los puntajes positivos y negativos son iguales, entonces el AUC debería ser 0.5. A continuación se muestra un ejemplo corregido.
computeAUC <- function(pos.scores, neg.scores, n_sample=100000) {
# Args:
# pos.scores: scores of positive observations
# neg.scores: scores of negative observations
# n_samples : number of samples to approximate AUC
pos.sample <- sample(pos.scores, n_sample, replace=T)
neg.sample <- sample(neg.scores, n_sample, replace=T)
mean(1.0*(pos.sample > neg.sample) + 0.5*(pos.sample==neg.sample))
}
Combinando código de ISL 9.6.3 Curvas ROC , junto con @J. La respuesta de Won. A esta pregunta y algunos lugares más, la siguiente traza la curva ROC e imprime el AUC en la parte inferior derecha de la trama.
Below probs es un vector numérico de probabilidades pronosticadas para clasificación binaria y test$label contiene las etiquetas verdaderas de los datos de prueba.
require(ROCR)
require(pROC)
rocplot <- function(pred, truth, ...) {
predob = prediction(pred, truth)
perf = performance(predob, "tpr", "fpr")
plot(perf, ...)
area <- auc(truth, pred)
area <- format(round(area, 4), nsmall = 4)
text(x=0.8, y=0.1, labels = paste("AUC =", area))
# the reference x=y line
segments(x0=0, y0=0, x1=1, y1=1, col="gray", lty=2)
}
rocplot(probs, test$label, col="blue")
Esto da una trama como esta:
Como lo mencionaron otros, puede calcular el AUC usando el paquete ROCR . Con el paquete ROCR también puede trazar la curva ROC, la curva de elevación y otras medidas de selección del modelo.
Puede calcular el AUC directamente sin utilizar ningún paquete utilizando el hecho de que el AUC es igual a la probabilidad de que un verdadero positivo tenga una puntuación mayor que un verdadero negativo.
Por ejemplo, si pos.scores es un vector que contiene una puntuación de los ejemplos positivos, y neg.scores es un vector que contiene los ejemplos negativos, entonces el AUC se aproxima por:
> mean(sample(pos.scores,1000,replace=T) > sample(neg.scores,1000,replace=T))
[1] 0.7261
dará una aproximación del AUC. También puede estimar la varianza del AUC mediante el arranque:
> aucs = replicate(1000,mean(sample(pos.scores,1000,replace=T) > sample(neg.scores,1000,replace=T)))
Con el paquete pROC puede usar la función auc() como este ejemplo de la página de ayuda:
> data(aSAH)
>
> # Syntax (response, predictor):
> auc(aSAH$outcome, aSAH$s100b)
Area under the curve: 0.7314
Encontré que algunas de las soluciones aquí son lentas y / o confusas (y algunas de ellas no manejan las data.table correctamente) así que escribí mi propia función basada en auc_roc() en mi paquete R mltools .
library(data.table)
library(mltools)
preds <- c(.1, .3, .3, .9)
actuals <- c(0, 0, 1, 1)
auc_roc(preds, actuals) # 0.875
auc_roc(preds, actuals, returnDT=TRUE)
Pred CountFalse CountTrue CumulativeFPR CumulativeTPR AdditionalArea CumulativeArea
1: 0.9 0 1 0.0 0.5 0.000 0.000
2: 0.3 1 1 0.5 1.0 0.375 0.375
3: 0.1 1 0 1.0 1.0 0.500 0.875
Puede obtener más información sobre AUROC en esta publicación de blog de Miron Kursa :
Él proporciona una función rápida para AUROC:
# By Miron Kursa https://mbq.me
auroc <- function(score, bool) {
n1 <- sum(!bool)
n2 <- sum(bool)
U <- sum(rank(score)[!bool]) - n1 * (n1 + 1) / 2
return(1 - U / n1 / n2)
}
Vamos a probarlo:
set.seed(42)
score <- rnorm(1e3)
bool <- sample(c(TRUE, FALSE), 1e3, replace = TRUE)
pROC::auc(bool, score)
mltools::auc_roc(score, bool)
ROCR::performance(ROCR::prediction(score, bool), "auc")@y.values[[1]]
auroc(score, bool)
0.51371668847094
0.51371668847094
0.51371668847094
0.51371668847094
auroc() es 100 veces más rápido que pROC::auc() y computeAUC() .
auroc() es 10 veces más rápido que mltools::auc_roc() y ROCR::performance() .
print(microbenchmark(
pROC::auc(bool, score),
computeAUC(score[bool], score[!bool]),
mltools::auc_roc(score, bool),
ROCR::performance(ROCR::prediction(score, bool), "auc")@y.values,
auroc(score, bool)
))
Unit: microseconds
expr min
pROC::auc(bool, score) 21000.146
computeAUC(score[bool], score[!bool]) 11878.605
mltools::auc_roc(score, bool) 5750.651
ROCR::performance(ROCR::prediction(score, bool), "auc")@y.values 2899.573
auroc(score, bool) 236.531
lq mean median uq max neval cld
22005.3350 23738.3447 22206.5730 22710.853 32628.347 100 d
12323.0305 16173.0645 12378.5540 12624.981 233701.511 100 c
6186.0245 6495.5158 6325.3955 6573.993 14698.244 100 b
3019.6310 3300.1961 3068.0240 3237.534 11995.667 100 ab
245.4755 253.1109 251.8505 257.578 300.506 100 a
Sin ningún paquete adicional:
true_Y = c(1,1,1,1,2,1,2,1,2,2)
probs = c(1,0.999,0.999,0.973,0.568,0.421,0.382,0.377,0.146,0.11)
getROC_AUC = function(probs, true_Y){
probsSort = sort(probs, decreasing = TRUE, index.return = TRUE)
val = unlist(probsSort$x)
idx = unlist(probsSort$ix)
roc_y = true_Y[idx];
stack_x = cumsum(roc_y == 2)/sum(roc_y == 2)
stack_y = cumsum(roc_y == 1)/sum(roc_y == 1)
auc = sum((stack_x[2:length(roc_y)]-stack_x[1:length(roc_y)-1])*stack_y[2:length(roc_y)])
return(list(stack_x=stack_x, stack_y=stack_y, auc=auc))
}
aList = getROC_AUC(probs, true_Y)
stack_x = unlist(aList$stack_x)
stack_y = unlist(aList$stack_y)
auc = unlist(aList$auc)
plot(stack_x, stack_y, type = "l", col = "blue", xlab = "False Positive Rate", ylab = "True Positive Rate", main = "ROC")
axis(1, seq(0.0,1.0,0.1))
axis(2, seq(0.0,1.0,0.1))
abline(h=seq(0.0,1.0,0.1), v=seq(0.0,1.0,0.1), col="gray", lty=3)
legend(0.7, 0.3, sprintf("%3.3f",auc), lty=c(1,1), lwd=c(2.5,2.5), col="blue", title = "AUC")
Usualmente uso la función ROC del paquete DiagnosisMed. Me gusta el gráfico que produce. AUC se devuelve junto con su intervalo de confianza y también se menciona en el gráfico.
ROC(classLabels,scores,Full=TRUE)
ROCR calculará el AUC entre otras estadísticas:
auc.tmp <- performance(pred,"auc"); auc <- as.numeric([email protected])