Obliczyć AUC w R?

Question

Biorąc pod uwagę wektor wyników i wektor rzeczywistych etykiet klas, w jaki sposób obliczyć jednoliczbową metrykę AUC dla binarnego klasyfikatora w języku R lub prostym angielskim?

Strona 9 z "AUC: a Better Measure..." wydaje się wymagać znajomości etykiety klasy, a tu jest an example in MATLAB gdzie nie rozumiem

R(Actual == 1)) 

Ponieważ R (nie mylić z językiem R) jest zdefiniowany wektor ale używane jako funkcja?

Answer 1

Jak wspomniano przez innych, można obliczyć wartość AUC przy użyciu pakietu ROCR. Za pomocą pakietu ROCR można również wykreślić krzywą ROC, krzywą podniesienia i inne miary wyboru modelu.

Możesz obliczyć AUC bezpośrednio, bez użycia żadnego pakietu, wykorzystując fakt, że AUC jest równe prawdopodobieństwu, że prawdziwy wynik pozytywny jest większy niż prawdziwy minus.

Na przykład, jeśli pos.scores jest wektor zawierający ocenę pozytywnych przykładów i neg.scores jest wektor zawierający negatywne przykłady to AUC przybliżone przez:

> mean(sample(pos.scores,1000,replace=T) > sample(neg.scores,1000,replace=T)) 
[1] 0.7261 

daje przybliżoną wartość AUC . Można również oszacować wariancję AUC przez ładowania początkowego:

> aucs = replicate(1000,mean(sample(pos.scores,1000,replace=T) > sample(neg.scores,1000,replace=T))) 

Answer 2

The ROCR package obliczy AUC między innymi statystykami:

auc.tmp <- performance(pred,"auc"); auc <- as.numeric(auc.tmp@y.values) 

Answer 3

Z pakietem pROC można użyć funkcji auc() jak ten przykład ze strony pomocy:

> data(aSAH) 
> 
> # Syntax (response, predictor): 
> auc(aSAH$outcome, aSAH$s100b) 
Area under the curve: 0.7314 

link to pROC

Answer 4

Zwykle używam funkcji ROC z pakietu DiagnosisMed. Podoba mi się wykres, który produkuje. AUC jest zwracane wraz z przedziałem ufności i jest również wspomniane na wykresie.

ROC(classLabels,scores,Full=TRUE) 

Answer 5

Wzorując się odpowiedzi Erika, należy również być w stanie obliczyć ROC bezpośrednio poprzez porównanie wszystkich możliwych par wartości od pos.scores i neg. wyniki:

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) 

pewno mniej efektywne niż podejście próbki lub Proc :: AUC, ale bardziej stabilne niż poprzednio i wymagające mniej instalacji niż ten ostatni.

Powiązane: gdy próbowałem to dało podobne wyniki do wartości pROC, ale nie do końca takie samo (wyłączone o 0,02 lub więcej); wynik był bliższy przykładowemu podejściu z bardzo wysoką wartością N. Jeśli ktoś ma pomysły, dlaczego tak się stało, byłbym zainteresowany.

Answer 6

Bez żadnych dodatkowych pakietów:

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

Answer 7

Łącząc kod z ISL 9.6.3 ROC Curves wraz z @J. Odpowiedź Won. Na to pytanie i kilka innych miejsc, poniżej przedstawiono krzywą ROC i drukuje AUC w prawym dolnym rogu działki.

Poniżej probs jest liczbowym wektorem przewidywanych prawdopodobieństw dla klasyfikacji binarnej, a test$label zawiera prawdziwe etykiety danych testowych.

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

Daje działkę takiego:

Answer 8

znalazłem niektóre z rozwiązaniami tutaj być powolny i/lub mylące (a niektóre z nich nie obsługuje poprawnie więzi), tak Napisałem własną funkcję opartą na data.table w moim pakiecie 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 

Answer 9

Obecnie najpopularniejsza odpowiedź jest niepoprawna, ponieważ nie uwzględnia powiązań. Gdy wyniki dodatnie i ujemne są równe, AUC powinno wynosić 0,5. Poniżej znajduje się poprawiony przykład.

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