ROCR/0000755000176200001440000000000013653304235011023 5ustar liggesusersROCR/NAMESPACE0000644000176200001440000000106113653005516012240 0ustar liggesusers# Generated by roxygen2: do not edit by hand S3method(plot,performance) export(performance) export(prediction) exportClasses(performance) exportClasses(prediction) exportMethods(plot) import(graphics) import(methods) import(stats) importFrom(grDevices,chull) importFrom(grDevices,rainbow) importFrom(grDevices,xy.coords) importFrom(graphics,par) importFrom(graphics,plot.default) importFrom(graphics,plot.xy) importFrom(stats,approxfun) importFrom(stats,chisq.test) importFrom(stats,median) importFrom(stats,sd) importFrom(stats,uniroot) ROCR/demo/0000755000176200001440000000000013644317760011756 5ustar liggesusersROCR/demo/ROCR.R0000644000176200001440000002261313644317760012652 0ustar liggesusers## ----------------------------------------------------------------------------------- ## Demo file for ROCR; start with 'demo(ROCR)' ## ----------------------------------------------------------------------------------- # if(dev.cur() <= 1) get(getOption("device"))() if(dev.cur() <= 1) dev.new() opar <- par(ask = interactive() && (.Device %in% c("X11", "GTK", "gnome", "windows","quartz"))) data(ROCR.hiv) pp <- ROCR.hiv$hiv.svm$predictions ll <- ROCR.hiv$hiv.svm$labels par(mfrow=c(2,2)) pred<- prediction(pp, ll) perf <- performance(pred, "tpr", "fpr") plot(perf, avg= "threshold", colorize=TRUE, lwd= 3, main= "With ROCR you can produce standard plots like ROC curves ...") plot(perf, lty=3, col="grey78", add=TRUE) perf <- performance(pred, "prec", "rec") plot(perf, avg= "threshold", colorize=TRUE, lwd= 3, main= "... Precision/Recall graphs ...") plot(perf, lty=3, col="grey78", add=TRUE) perf <- performance(pred, "sens", "spec") plot(perf, avg= "threshold", colorize=TRUE, lwd= 3, main="... Sensitivity/Specificity plots ...") plot(perf, lty=3, col="grey78", add=TRUE) perf <- performance(pred, "lift", "rpp") plot(perf, avg= "threshold", colorize=TRUE, lwd= 3, main= "... and Lift charts.") plot(perf, lty=3, col="grey78", add=TRUE) # ------------------------------------------------------------------------------------ data(ROCR.xval) pp <- ROCR.xval$predictions ll <- ROCR.xval$labels pred <- prediction(pp,ll) perf <- performance(pred,'tpr','fpr') par(mfrow=c(2,2)) plot(perf, colorize=TRUE, lwd=2,main='ROC curves from 10-fold cross-validation') plot(perf, avg='vertical', spread.estimate='stderror',lwd=3,main='Vertical averaging + 1 standard error',col='blue') plot(perf, avg='horizontal', spread.estimate='boxplot',lwd=3,main='Horizontal averaging + boxplots',col='blue') plot(perf, avg='threshold', spread.estimate='stddev',lwd=2, main='Threshold averaging + 1 standard deviation',colorize=TRUE) # ------------------------------------------------------------------------------------ data(ROCR.hiv) pp.unnorm <- ROCR.hiv$hiv.svm$predictions ll <- ROCR.hiv$hiv.svm$labels # normalize predictions to 0..1 v <- unlist(pp.unnorm) pp <- lapply(pp.unnorm, function(run) {approxfun(c(min(v), max(v)), c(0,1))(run)}) par(mfrow=c(2,2)) pred<- prediction(pp, ll) perf <- performance(pred, "tpr", "fpr") plot(perf, avg= "threshold", colorize=TRUE, lwd= 3, coloraxis.at=seq(0,1,by=0.2), main= "ROC curve") plot(perf, col="gray78", add=TRUE) plot(perf, avg= "threshold", colorize=TRUE, colorkey=FALSE,lwd= 3, main= "ROC curve",add=TRUE) perf <- performance(pred, "acc") plot(perf, avg= "vertical", spread.estimate="boxplot", lwd=3,col='blue', show.spread.at= seq(0.1, 0.9, by=0.1), main= "Accuracy across the range of possible cutoffs") plot(performance(pred, "cal", window.size= 10), avg="vertical", main= "How well are the probability predictions calibrated?") plot(0,0,type="n", xlim= c(0,1), ylim=c(0,7), xlab="Cutoff", ylab="Density", main="How well do the predictions separate the classes?") for (runi in 1:length(pred@predictions)) { lines(density(pred@predictions[[runi]][pred@labels[[runi]]=="-1"]), col= "red") lines(density(pred@predictions[[runi]][pred@labels[[runi]]=="1"]), col="green") } #--------------------------------------------------------------------- par(mfrow= c(2,2)) # ...you can freely combine performance measures (pcmiss,lift) data(ROCR.xval) pred <- prediction(ROCR.xval$predictions, ROCR.xval$labels) perf <- performance(pred,"pcmiss","lift") # plot(perf, colorize=TRUE) plot(perf, colorize=TRUE, print.cutoffs.at=seq(0,1,by=0.1), text.adj=c(1.2,1.2), avg="threshold", lwd=3, main= "You can freely combine performance measures ...") data(ROCR.simple) pred <- prediction(ROCR.simple$predictions, ROCR.simple$labels) perf <- performance(pred,"tpr","fpr") plot(perf, colorize=TRUE, colorkey.pos="top", print.cutoffs.at=seq(0,1,by=0.1), text.cex=1, text.adj=c(1.2, 1.2), lwd=2) # ... cutoff stacking data(ROCR.xval) pred <- prediction(ROCR.xval$predictions, ROCR.xval$labels) perf <- performance(pred,"tpr","fpr") plot(perf, print.cutoffs.at=seq(0,1,by=0.2), text.cex=0.8, text.y=lapply(as.list(seq(0,0.5,by=0.05)), function(x) { rep(x,length(perf@x.values[[1]])) } ), col= as.list(terrain.colors(10)), text.col= as.list(terrain.colors(10)), points.col= as.list(terrain.colors(10)), main= "Cutoff stability") # .... no functional dependencies needed, truly parametrized curve data(ROCR.xval) pred <- prediction(ROCR.xval$predictions, ROCR.xval$labels) perf <- performance(pred,"acc","lift") plot(perf, colorize=TRUE, main="Truly parametrized curves") plot(perf, colorize=TRUE, print.cutoffs.at=seq(0,1,by=0.1), add=TRUE, text.adj=c(1.2, 1.2), avg="threshold", lwd=3) # -------------------------------------------------------------------- # (Expected cost) curve + ROC convex hull par(mfrow=c(1,2)) data(ROCR.hiv) plot(0,0,xlim=c(0,1),ylim=c(0,1),xlab='Probability cost function', ylab="Normalized expected cost", main='HIV data: Expected cost curve (Drummond & Holte)') pred<-prediction(ROCR.hiv$hiv.nn$predictions,ROCR.hiv$hiv.nn$labels) lines(c(0,1),c(0,1)) lines(c(0,1),c(1,0)) perf1 <- performance(pred,'fpr','fnr') for (i in 1:length(perf1@x.values)) { for (j in 1:length(perf1@x.values[[i]])) { lines(c(0,1),c(perf1@y.values[[i]][j], perf1@x.values[[i]][j]),col=rev(terrain.colors(10))[i],lty=3) } } perf<-performance(pred,'ecost') plot(perf,lwd=1.5,xlim=c(0,1),ylim=c(0,1),add=TRUE) # RCH data(ROCR.simple) ROCR.simple$labels[ROCR.simple$predictions >= 0.7 & ROCR.simple$predictions < 0.85] <- 0 #as.numeric(!labels[predictions >= 0.6 & predictions < 0.85]) pred <- prediction(ROCR.simple$predictions, ROCR.simple$labels) perf <- performance(pred,'tpr','fpr') plot(perf, main="ROC curve with concavities (suboptimal) and ROC convex hull (Fawcett)") perf1 <- performance(pred,'rch') plot(perf1,add=TRUE,col='red',lwd=2) #--------------------------------------------------------------------- # (plotting cutoff vs. measure) data(ROCR.hiv) pp <- ROCR.hiv$hiv.svm$predictions ll <- ROCR.hiv$hiv.svm$labels measures <- c('tpr','fpr','acc','err','rec','sens','fnr','tnr','spec', 'ppv','prec','npv','fall','miss','pcfall','pcmiss', 'phi','mat','mi','chisq','odds','lift','f') ## Don't be surprised by the decreased cutoff regions produced by 'odds ratio'. ## Cf. ?performance for details. pred <- prediction(pp, ll) par(mfrow=c(5,5)) for (measure in measures) { perf <- performance(pred, measure) plot(perf,avg="vertical",spread.estimate="boxplot") } #--------------------------------------------------------------------- measures <- c('tpr','err','prec','phi','mi','chisq','odds','lift','f') par(mfrow=c(6,6)) for (i in 1:(length(measures)-1)) { for (j in (i+1):length(measures)) { perf <- performance(pred, measures[i], measures[j]) plot(perf, avg="threshold", colorize=TRUE) } } #--------------------------------------------------------------------- data(ROCR.hiv) pp <- ROCR.hiv$hiv.svm$predictions ll <- ROCR.hiv$hiv.svm$labels data(ROCR.xval) pp <- ROCR.xval$predictions ll <- ROCR.xval$labels pred <- prediction(pp, ll) par(mfrow=c(3,3)) perf <- performance(pred, "odds", "fpr") plot(perf, colorize=TRUE) plot(perf, avg="threshold", lwd=2, add=TRUE) perf <- performance(pred, "phi", "err") plot(perf, colorize=TRUE) plot(perf, avg="threshold", lwd=2, add=TRUE) perf <- performance(pred, "f", "err") plot(perf, colorize=TRUE) plot(perf, avg="threshold", lwd=2, add=TRUE) perf <- performance(pred, "f", "ppv") plot(perf, colorize=TRUE) plot(perf, avg="threshold", lwd=2, add=TRUE) perf <- performance(pred, "mat", "ppv") plot(perf, colorize=TRUE) plot(perf, avg="threshold", lwd=2, add=TRUE) perf <- performance(pred, "npv", "ppv") plot(perf, colorize=TRUE) plot(perf, avg="threshold", lwd=2, add=TRUE) perf <- performance(pred, "acc", "phi") plot(perf, colorize=TRUE) plot(perf, avg="threshold", lwd=2, add=TRUE) perf <- performance(pred, "lift", "phi") plot(perf, colorize=TRUE) plot(perf, avg="threshold", lwd=2, add=TRUE) perf <- performance(pred, "f", "phi") plot(perf, colorize=TRUE) plot(perf, avg="threshold", lwd=2, add=TRUE) perf <- performance(pred, "mi", "phi") plot(perf, colorize=TRUE) plot(perf, avg="threshold", lwd=2, add=TRUE) perf <- performance(pred, "chisq", "phi") plot(perf, colorize=TRUE) plot(perf, avg="threshold", lwd=2, add=TRUE) perf <- performance(pred, "acc", "mi") plot(perf, colorize=TRUE) plot(perf, avg="threshold", lwd=2, add=TRUE) perf <- performance(pred, "fall", "odds") plot(perf, colorize=TRUE) plot(perf, avg="threshold", lwd=2, add=TRUE) perf <- performance(pred, "tpr", "lift") plot(perf, colorize=TRUE) plot(perf, avg="threshold", lwd=2, add=TRUE) perf <- performance(pred, "fall", "lift") plot(perf, colorize=TRUE) plot(perf, avg="threshold", lwd=2, add=TRUE) perf <- performance(pred, "npv", "f") plot(perf, colorize=TRUE) plot(perf, avg="threshold", lwd=2, add=TRUE) perf <- performance(pred, "prec", "f") plot(perf, colorize=TRUE) plot(perf, avg="threshold", lwd=2, add=TRUE) perf <- performance(pred, "tpr", "f") plot(perf, colorize=TRUE) plot(perf, avg="threshold", lwd=2, add=TRUE) par(opar) ROCR/demo/00Index0000644000176200001440000000007713644317760013114 0ustar liggesusersROCR demonstrates some of the graphical capabilities of ROCR ROCR/README.md0000644000176200001440000001047013647572625012321 0ustar liggesusers# ROCR [![R-CMD-check](https://github.com/ipa-tys/ROCR/workflows/R-CMD-check/badge.svg)](https://github.com/ipa-tys/ROCR/actions?query=workflow:R-CMD-check) [![CRAN Status](https://www.r-pkg.org/badges/version/ROCR)](https://CRAN.r-project.org/package=ROCR) [![codecov](https://codecov.io/gh/ipa-tys/ROCR/branch/master/graph/badge.svg)](https://codecov.io/gh/ipa-tys/ROCR) *visualizing classifier performance in R, with only 3 commands* ![](https://raw.githubusercontent.com/ipa-tys/ROCR/rocr-images/ourplot_website.gif) ### Please support our work by citing the ROCR article in your publications: ***Sing T, Sander O, Beerenwinkel N, Lengauer T. [2005] ROCR: visualizing classifier performance in R. Bioinformatics 21(20):3940-1.*** Free full text: http://bioinformatics.oxfordjournals.org/content/21/20/3940.full [](https://www.mpi-inf.mpg.de/home/) `ROCR` was originally developed at the [Max Planck Institute for Informatics](https://www.mpi-inf.mpg.de/home/) ## Introduction `ROCR` (with obvious pronounciation) is an R package for evaluating and visualizing classifier performance. It is... - ...easy to use: adds only three new commands to R. - ...flexible: integrates tightly with R's built-in graphics facilities. - ...powerful: Currently, 28 performance measures are implemented, which can be freely combined to form parametric curves such as ROC curves, precision/recall curves, or lift curves. Many options such as curve averaging (for cross-validation or bootstrap), augmenting the averaged curves by standard error bar or boxplots, labeling cutoffs to the curve, or coloring curves according to cutoff. ### Performance measures that `ROCR` knows: Accuracy, error rate, true positive rate, false positive rate, true negative rate, false negative rate, sensitivity, specificity, recall, positive predictive value, negative predictive value, precision, fallout, miss, phi correlation coefficient, Matthews correlation coefficient, mutual information, chi square statistic, odds ratio, lift value, precision/recall F measure, ROC convex hull, area under the ROC curve, precision/recall break-even point, calibration error, mean cross-entropy, root mean squared error, SAR measure, expected cost, explicit cost. ### `ROCR` features: ROC curves, precision/recall plots, lift charts, cost curves, custom curves by freely selecting one performance measure for the x axis and one for the y axis, handling of data from cross-validation or bootstrapping, curve averaging (vertically, horizontally, or by threshold), standard error bars, box plots, curves that are color-coded by cutoff, printing threshold values on the curve, tight integration with Rs plotting facilities (making it easy to adjust plots or to combine multiple plots), fully customizable, easy to use (only 3 commands). ## Installation of `ROCR` The most straightforward way to install and use `ROCR` is to install it from `CRAN` by starting `R` and using the `install.packages` function: ``` install.packages("ROCR") ``` Alternatively you can install it from command line using the tar ball like this: ``` R CMD INSTALL ROCR_*.tar.gz ``` ## Getting started from withing R ... ``` library(ROCR) demo(ROCR) help(package=ROCR) ``` ## Examples Using ROCR's 3 commands to produce a simple ROC plot: ``` pred <- prediction(predictions, labels) perf <- performance(pred, measure = "tpr", x.measure = "fpr") plot(perf, col=rainbow(10)) ``` ## Documentation - The Reference Manual found [here](https://CRAN.r-project.org/package=ROCR) - Slide deck for a tutorial talk (feel free to re-use for teaching, but please give appropriate credits and write us an email) [[PPT](https://raw.githubusercontent.com/ipa-tys/ROCR/rocr-images/ROCR_Talk_Tobias_Sing.ppt)] - A few pointers to the literature on classifier evaluation ## Contact Questions, comments, and suggestions are very welcome. Open an issue on GitHub and we can discuss. We are also interested in seeing how ROCR is used in publications. Thus, if you have prepared a paper using ROCR we'd be happy to know. ROCR/data/0000755000176200001440000000000013644317760011743 5ustar liggesusersROCR/data/ROCR.xval.rda0000644000176200001440000005012113644317760014150 0ustar liggesusersŽX7](v 6&آ؊-*("at. ,؅:}~,u{S3s9g̜/ .hi#Cڵ[1O-: ̛k[ԩv_9oƜ8ߜ7\;7$ ]Ny6(K%^~@)s)y9}Bl'"O)ϨIj rz6>Rc(-䴅Sg|z~LJ J|BނS(|#[ÁrMXB:>2›˹Ot"*ψTbҏ(E,Ne't _ZJombMJsF'v9W7;Kywo1SH8N;T&e_a(I 'U<@J؂t:M&^1;Q 0:ݎ!o\Wx_)U%sqO#:L𝯌-)cQɱQn-M1tĹGgkcP&MyN /=p^gA~&؞!(?%rql&muriO~6qCY鄧D2oK[$xޤ,)~c۰/wj#MRʳEe,ȝ,\My+!_#'\r Bt Zt*] x4£MXgyDX{R}3e3Qb^T_!XGz cyM _1vS~s;֗B bd t%W7XZAoŠ# џy+[3nKӁExR,)l}qj )\[rZ'z)pJ~I A~A~Z4^͢*/N |)}oHp+2jiu$sr9LBrUk^z5IW[aډhӰ;`;c Φ,L3̏uƟh#f?.5/pG򿄙OD]8""I7/<7]fB>yzM / o}kOE;9$;eYC|^{n-~!t\:QK3~CyyNrk}ӂ|ź2qsN~53%WK]I-8'(|[Fi?-%z'K7;($za=SP36iի6'#;w̢h7M/@=ZzBoY}@+YܐHRB}3͌:Cb~ݱokO2';SRIzs zbztx; _!~'(1~UQ 'qQ&ԾDa%Q;6ʅ<Iey0haRh@#aB dc'ֺO^@1efO^o_V./Av/yƽ;wH1^P^]R)X}I}p(Ҥ ?7RŏB\8S]41ط(f":F ;/wW;=*!=;y`.sS;{{*/95?v$M!sd`] K=-?#mĒྭ3 tr}D픿P.dQ (&>=MZdBt _x1/?o] aLכx!{Quʇ< Ž ا3nK~;"z9F)M-꜏b4#3 rHNDʝNlGXJo͒`ziׇুW0E<rat| _ZߞC&)-~| 瘴kJ H.ɳ-'2z,fLV`tHzՌۨ^wf^⭇2&I.1'̆{{x;;EߛҘ?RĘ:9aXf$rSԣuwA$JW5|p1_p_KpsBJ!on4r̈́I4xt|gg<qP;hf իm/zQXgR/ rw?f9 W@oR_{؝9ɱ _1yŏ}1b7*Tݷ /&igjfcJYR9:R2˃/97h(W5N]^~-;M.O2|yz20A&SZ{uI>mK左Qo ASh?!vo7rz7 g#>ѡi !s8eN}D/GNEm,Y-4>៨?z< 37QXѐ}0fi48G|A*qhBRf@ׯV~ߨ^u{7}g }fX:P?iW!lG| )nUP*Où2(0>lg/PՙNĝ!˼1oH,El3~R)j_Bs"˘1)zlCOlq_cITu;Q$uZ };^@1c^=OYPӡo ~!9<ڕwv[xhEN1ʧ?/4i׾X/ _^ǼpT9ʇMa7,Ym+{u1n 1{^*ȣ|17c:W?܇~qLu5{]j6mm Ks_40.ĺod|(Mn='<+/m#~9Tv{tHt-OJ-Tݹxh ADg~޷D̟^j3_ގ~$:!|8HR?eDԿ0z/&+QV!Ϛ>gHxr,_C=z7R8G(,᡽h%|7co -d\\J兂 [הNxo=2$Ң֓$%W p ss2/PӺԎ:w9;CN'[$'=@x[/Ɲ?4$:Xvm:xeqp_ LgObo!:2 ~I'GR}%Ҵ zÎ65`TT#o~9q ~c _{ bӦԮ$t1K7`J?+śW . :پ#8!'Er+˩*~Opr=֜G^9Oqvڀ}C:IBo0ڱ^n4j-}A+wR*v8zk6bwiFt;DUsgRֲPya%5ߢ<}ƝiT`=̫h^_НP`a}di ~\rRY|s..5].p .gu@;+ab_J#Vo 9H~þs+kF0(/pG\Dz|yo Joi9J/Kp`7y W3 ǔ.1>0զOfx%F& =-#%6Fڐ2?JݗQlzPnx#aaDK5+4ڕ8mXa~u`gA[}尤QT/L|yu}-qjաc_:;xVi+-)!^|1D(UEJ7ԛ"u+/ ~FA/R>Ɣ>*[@>n @ޞϐ/#enn~Ɲ~).# W=|Ae r)y˧ OwuL3LI67q_B|{:ϵ3.r/ vm1@WlةOQ$]AYULpT/8r w Ǐ ;X{Ŕ6^ viJcb_<t ErVڛӜWƙb}X~j`es؛vCaֲ`~:s?(fIC4[@9*sfb[Y܂??zc:Gqq6R} CX$HWfYocP*O q. |i _~k]̺TqW$ص?_w,C?( \KWC\ϝf}swhr ^l.?Fr8;(ŨոZCp9n^|«~?܂?_%M.At8~n5r*m@f'Ig4օv][ %m^Ƚsk_4Q\ʪCˡԾ4">@iãB·񧩽`N;j$h78v`N5|at^+_Hq8mXL"W 3|1eY%xMNe ?p7aXc9Ԯ(򦝾9w QmՇ_:{ݺFDߠ=ztb[q6}T}g<6KhH =9#vzth'vi y8d?7n8-a' <hnx"8ʼnPK kOh-%>ȾgQˆ9wPOfrH }_BYyR{o£j9+nCN&%n$)k23 eG影 >sŗ]jăֈw|NxL?o23@y?R][h yOw(&׆\n9mS}ZnqtzNpjFO:ը?`'4oDyu1O.m~mFD~bn|~kpĉ.q@듻@BQe'Kf{^tiنwZx$u'm>ZiDD!_A"]״OWXs zcUIWp 'p2G,P̜eIgc=ڽ)m }Ҹ>Ч77:a:?L-+{Jm\D1]Ϋ'5q0Nv |ܺNBY#qO>:?.1_SI [oqJ=ްo @${迬#[`H{?)䜛Rk/t?gqݣ5Ii44/QQ?CL;X Fܙérro;OOgA~|ڳSGQB!w`6NxTn=REs 2[AXg®.8qAW_)gfP}f_#2# -q`d] [ %X Un8s Vm1\3iSBC( ီaЏ SP%jgP<ŶOk'zZ)ct J핧:e8u~ $52 ȣK7 xmO x?ַͣ"' Qu O#"$yiSJzZQOwsycFHzO#gßqiuj'q?l98ܒ#o2^:Ryq4A}wܻD=!1r[Cwt7a$?EG`_bn a6gsD|vQ&<lu#X{2cBS=uCCyR9@]BJ0;oc`SLE| kI9 ̋zl` #,ļy}Q|~;1ދpǍb~(@%Q57 :N[O4˥Idߓc&a(ݶRKJŔgh_CYFu]o}ߺ arc\,ɴMem^qH 2ݳG9F~#-)8W5M^4.\ :9s)ȱr<g`Q[x x:""}`*ܣK z2kێ9D㝲OFqq@?NDZRyhMJq$8^Qgbv.@Kj|Iٚ4ߏMq_M Л"vC?1y8WeOߐue2]C\Nd :{Li1mtLN<{#/^2 |-' sJ;r؟^݅{hM7$ۢq?˵NEj'; `3e9N[q2_3Nw}~Hě-F{w #u~"~D~|φEF[j*[@|3\hyRT !v ~r#Ya ':c=̆ܜy,#>*.ù˜_ vS-jޱ$yZ,K>}]sWH_ay7z79rKW8j'|*|㩼̠JN*~9h/Ex=6ӌ oﮌ4y"Sv.Zߡ'[)%GL;NN}ĽTn~@媏M7Жރ^iNr_(}{X7l v)YĂ՛m8ԙ`V8oG|[žV$:y 6<4 J5^J{A<2#wOInj%2>ijǹHyqb=g0x_ 8F@5y~͎} Y`^*z{yq.V_}A\]V2%{l9higī3d ,{ "|s#Z0ɲ|yr ߕ NKӤ ?A|rn##'QU> o_B΃?+WiȹĞ 6!x݈Gʨv‚8 .)uCF @R͇)|*?]Cfɦr7c}ȞCpOJ6#E݆u3g3_Z{:MI/f!6DyXxwiMF~rLdvE9סJնƥ?k]Dxm My%q) _Qy`p@+u35[|ŷdtU痹$0唚ŔW~ 򺤻c ˔9? 8b$B>Q,W((g-Ws- ABEKNG@ny˦DW#;z|xT.- \dTm|xu)BsWfgՕ!N/G1 +Au;0'?ü${5yEݸ&+?8Eu:8SqOCrhGaڼ4J?_Ac^n"LۚxXdsyx/KAs?Q衈kT.!z{SX2 R6]FcKqxg7D\ȋDָ/DM .nN];)؇%dawn^RYecuGW]o67TxD/wa(WM9q'm}cCG|5Z"^JsO;2N“lȭ>|_C{_e6r!n=C` ֩8⠲%@~ ߚ<$rr*9}`~Α+?._q%qީ)c^7 Y0$G QF<\uӅ%ס'wRLgokvTy/\^D ;8/"89&nuG%.'#٘a];!.2 ibMIqpNܠ 9wlEG!E)g9Sh*8b~WoVC!L_knQ?lDIybD4BI-H;J匸a1Fј>mck*w?ݔl-(a$qM}~jِٞ3ZljAͽj:^K?"΃8=FWcIXT bA*ESW#>/L'_/M}@>R?MYnCztn> w$ 4AxU1~Ų?Я{vE'sʢV}ifvι筄WjO|5߇_Au<=?|)_?@NduHN}O]6[@Jo;Z*JIHv̽kB;='{뎄/vw<6YS^mIO>&KSZ9x_=."qΓ M}KT&R#Kc.?r?f,%zFwd)K]Ǿ$l!K( tz ^nqꖋx/ Y.vX݅WSznE>?l{i)xΙ{SŭBč)ߞ$x";;DO| ͙_~M׻.~rWݐ.yk 쀼j8fP؝&=>m9c=HK_L'3ly¼۱/ϵq2=S)iv/X6GiN:vOEq G{ u0N+~HxoŹZa03[6Fj`~(mR^3/>~~!}>U6gŀS_(lP"b$X4@B~Kͻ{_tX / W'}DJ-w1/x2禃q)}k jWJ8ֽ|^va ovR=[n>KWUH}QS:b{)*ֺa'!! {lE |xnwqO>N@dI1K+12O20{98cߛznjٗ Dr?9N̨ٖ*W]j&03K([)j{'vwý>k7反BR"ʔ.$t?<6r,;q#zvk]q2@< r:b\ďOOJ̡r>,Lo¥Oa?`]2F~,8[E/{BgXLoĹDk y)Iu߯ T#+ b4_p\)қ5~Z}z{Q\@W4 ̋mOxZr7°n?O& ;v73eG + h86n&?S,WdI-0couL<zÞuqto ⏣U|IS>Lil5Y ?|~=؏$!yx24cIKc>6~WN޳hLtԱ^"H:DZW|yND[f5+p>BoΣpxkw7}q.洅=Ab+[DitéЇO"=۟@xT;5g&9>t>In vył~,胹"|cnJyʟ|sדnQ&1Bog Z;GIP9$]K'6m1%us{1:בD\)]x#l?yN}g{t礟=c\Sva|;:Ȍ_+ 0< ҽ3{yٯ4q%>7ʅٻpOSn6_ZFORċ[m' J/xavvd]/^s"fn8LmZb])w\&N{)N/y we@=Ot'}v>]e=[ͺGliWWGCϣq/x=E+Sw?rvۧ?-.tIkn5+~A#gv4RQ'ӊΖ9v}M`At#g3j#^HY=`]`)Y ;=8 9"]c}OgXb7Jp7a( }Q͇_9ƥrjo2ྱ!V$oh˚ݐgۈZA1sRS} rl1.%~Gq~>gv= =41L/w@ozי98?DMrstRRIz rҾ_|s 7@I)/+ Ts)RSwo|73$Y7>C_H|~Aբލxz|!x@o-+NEypnbLn Xoj)uXŠr$ sF Y/gҊʳ\%sP_'m8  a3nGk!צ gWWfz!)l O 'OLah6iz-N}|'roP t;dD_෋ *;1[+l7g㽭l2챙W✉K{~_ ͂m,}^e[\w %װ)g ybɠ<O0PJ}dt34rN x b:[)Y6r=8??#׏΍ } b5 g)Ǖ!&[>[Xa7q-ξYzz-%p?/nuyߘѠXoșk_ w&{cx}xT9#eȾl!xƸGNDνFca7  "2?V] ΅,7{{up~eW xx _83Că#~Kyۦ Ms.U:.Qܰ'oVYKn:㻃,˓:/Y⽢1 TZ{TxY-G [%'(ڵ2.Ep9aǕ6Mtx|}G4?]6UkMyWa'@*I#zA~Gv?c9] 7㼗d<@\UI-TҎ.=GM ;ž6 &S`{vq 8v4^\~/~>b$ NyԔ< {h+ԏWl1a<#*vǀO ?{.ӈ,f~yu)Rcy!KnP{~3{!e#%q"N#90y ;ĝi顙^U0[?Qx>nxi*Oh;\{[Gu.עB;KJ%tO"_p,Dӓ}Ku74 Y= Ge x'8k?CVs<1snze'!RɆ?Rp6s~{:E`|b*|8`RwrwtSm},Y])qm?oI5mE =m_To Y93Ni;T+'gsCsm@i؅@/a/c?ك*<>;eS[Sp=B̵ԛ |[ ~5Xq}kH׮¹-@wS A#v#)aJ'(>g[ݠ8t7 G3˘]H+?CM3}}PB o);SM}Cy=cU8oyp?JC@=@SlGE#zCߑ<}hcTZgn\$G}| L&eGD<(1aA{8wj2̉^#s,'&?rNnq)=¡=hks5T 4ٰ 8& ^s)S9s``||BT+>#hzvN;zxg-n3`N<-@/fCMgY||d9k'(R"W7r|حK2PpPۖM-(Nח蔟?8AOq'G;GQ]ĺ}NsV lQvI+OѐNe"JLj;- UꖈopÜT |7ΌA4.Ϊx?uif{j'ٻ p"|OӮvKյw:[}haĽM~?Bt%9!_^i=Xy z1x7awoR}:Z*W$m<?K^B }[;hSA^W9Ey\F.*}~oܛ4\GH-I-!$--#z$yN$2WkGRA(z{f7ȷ!}jqҒMgk|#N N!g{om }Oi9o_>_!YExͷ࿪d a:`/h BRw"\kGxFU"mwTNhY׊6f.SVP8Rp*|wq^^/Box}NDW!-O6O@4;=PȫLĻƠW߀qAR ՆC3woqƥ8aQ{=Bqۚx?ʼn+ƾ3vu/2v 5_˖N zm?Qz(~l{Y.g3f]KSS{^] ߽.:/IO@a!L#|L!-޻^439_Q/ޙ.{b qoK:38)Th~6@\qk2R {onN~cteKhDlۦCaѾwHa9{g'gdnXi\^:΄18GOd{F%EeWya^$a۽Fg?>^g9ݨ]XJeEZ,|5 =o#!.zs8Ge*3o-~k|yXJzzSagZq~nz4&@-w+ DN&S G3lF:8ƩJq+ڲѣ9S=Mƫ5k龃1oO.'d[} x"&C4M@85set$vE=KGX9"_V0 ߕIq+ wuD>fxp>g/ETj!@hrFu{xG-^%9[mJ?nK֗<8,_4«4}VVTMUvwEP乪`M?["U~UkJWS|^UW=}<5]_Y;9W_uk轕o*ה\TWyPyy~\^o3_qT_|yUWQyUW_uڕ"z{T_uϽ¯iy>jz_+|eVOTW}?+KOUݿ*z}*祦/=^z}{NU{.4ԹUYSѪ*].]5ŗ?[__M;_|j+/_}UW]:ǚk}UU^sou]rު5EwMU6_r}Oe뫺W_uZZtTR<}y"<ח }UWJWe쯺WvZU5=­j\*©}UWEp+ZQᅪ*+j/z.WUZ:yE?}@Ype[^?k_Se5>+ uǚ_]K?+ÿ?T?*_^yUUYWuY|EtV5"8UWeUWu}u+75MOy?})}W}ב㮮|UW]z+ w©Ε~oU׮~O_(}E+OUsuUԾ+=W?**Uw*/_nj.ꮃ5%/՘m_ޯ=WEt[XEx+_^;}_UV~U;N}繦ۚZեw+og|*}5ӗUmWU]5=/ї~SP^){oe^}AUU~u{?)]uUSr}EtԔPYo7U.U_,U{.3_tTgUXՓj}}}]]}<8QyWY/빲si"*WJ뼪*ۯvWw>m~ꋿ_U;ʶ.+ ?5}UwrRYo35}^dk]t!ve-[z!V(x|3 1yQ;D~1 $Ow0t W 5H]_>JHszh'Y'7u!Ykd䁝s&=b (.srQ1Rҧ5Mfvi֓x1 )بqImHOV۟}*E=+v WY/W?>i3]V:rz1dG4 kyz^{"z콯9;"/* 5YYR^p0"⬴>{I~oM]HA31ck͚ e!nvzuo)7t i h-3 Dze()2蚐ڮ7[ӲhpeN~ {&BzjO73(|M|.\:nHA6]l:/Cgtڦ?Y/@>k4$;FuQIk@-*b-րɥ^vn?B{4GC|]kG+FN ̎?3u혇fp uo>M|sgkgVͲX";qM;P~,Y茼ej+>1"K]&d̅48j!PR{ZG4?oz:K\;[(d筚z4`s]vu)]9tݰA Io]IBlrm'V?J+uD| ^1}9}&, ѷDn'91Վ5 ?,B&.[bm]4AXB}#f-+%IAp D}6o_~nr3nA{H;7CU|]ӟ m@SRi;]|-hM\ q_AwZʬ*7$ a[BڈkM6E߯&dv[o Ã5 87@UO?Xj /+=a_ ۃ6!-&;.@ƛ}QhLeK5 dB=Na]v>!cD]g̓lִn(vu`7 /C->r Ri?vΡןq.›C:u2=<4Mi{z$Q3ptM=}qС!Y:,"͵]L!>^]!v q>]1Xo+mwgPu|7dGYC l Y5~Hdy8B;RRKr5Vؗ5EeO#/,WwI̕Kvv1֐$:P[Yv8cz|O iq*9Ԍy@w"rT =ڈc!-Z4Ԉ4x>[yl 7FGqNԖ֧|TҼt;4..݇. K@Vc⽁>Wʼn9R2.`:mz%ecG"ՙF#}9*(*eдGo>VWuׁ5}7H?pQM㗕4>e8wkY}A3ِSz "ЏޫBT0Z=<bG,HĔ|BVː4~ޮ}h}8Rhܤxt+ZLDE`!8WƦi< 馕wz#lk.SFG!a? ӸdW䇣kB9&kרUҰvD VGKewQFYe!QhHARf6j q؇V_3 &N[![دvU'D7Vf\џiÉȻgA Zp Zv|M82zڮ$giL'Œ rÜ(PN|ƒDR)ەb hZ) ҎW NӸ[7 'Q&r%W>~D>#7iAE8;VwY[(S?R/"'?)2"e!^ZS Iƹ[Ar%WMzK84<Q}y-cUwؖ(vHzΜY{DM '"d &?XB7πT}|e4z,ׄMꛊ-Cpt/z5sgmؕh?͋<XOvقƮٖI>Lsl;C/.. =HvQ3fɹ~)T Cs(_sK$濸k3~j*3"{̂lpg5 >yR$_MYC6fOpZIrnw:zr,7\ѥa:.L-DW39 z_Լ~F#A݂Oc` \7ká:}I ݜ ˞DEK%$*~4^ڱ!i00 ZL"wMcs `S^7CiiQP;h: _}/dq4Bd*HMWoP74NlzZo{}ŷv-lJAH\<< zK:]CB^Յ?e+Pӻk͡_5Ci97W[=8$IAԣPHBTή_L㑡Gi1m~ bhOnGݷAfGo['C*siA¦vLFE벏lNk*sy8biΨkZ/qZ4 \@z'ٛOhZ\:מV :7ySh=^%~ /Uu' `auNo,蛫ДN*٭#Mw^9YmsTOEYG!~XW.8K[~zk+iCΠ|LӖ@Z2,7G.Uuiq?~y6Y}_vs/YSx- IBjO5<^) Z'Ah{JHr}Br~7#}iFϼ=ANǷxklYB ^ fAyt N,'%4AO'́ |";śaۢ ×_D5SsAr\Uz7ϥy}B>yjh\JۡLx"$EǨG 9YXUTœۅ!㟏!&Q}ForjjK~юɏ̉af^`.;_w- J}96繜xX>k {i^S8tD%&ٚO1 E7Ļy= Lud \Ѹr{r4u JyoJ>AIq&-JQ!^u4V8{yjV_OϬ%1?"mg*2zӃ)!!,Г$7:Ōx̻1wk n>+yOSpA _j$cQh.i^1sZO"C͋T}Gx+ԝ?lH㻆W^h5 ohm+&j!1yٽ_fѸzZAnt[] ǨY5TWzMVMiH<\d k67oʫ 557=B6m_!uiFpŽO³AUX^Bbݭ4.nxh98LPc}?O y}#g@ vݐ[ &kM>U=G#xNx8" ߧFIQvRP~*4}KwW3j7Eo5A6ƻ~a I.a4_E#b+/z~ uJIm /oI"ڪ7$-_Ut''pNv|_YLu߬G_ Cm4¦w/:ץɈj(l u!k LCAuCީMU-M-.M;i^n姓h;||c"wnA3qw~ ;nҶkyrf4 M.0ns g>neGf&A٨3G}*"Ґ LOdo}a Y^z(gVЃ(@wy48ʸ(_7v:7VxTHrѱ(!P: .i}bywV O|s-ڊ3 %TV펿 TibBpo/JTF7uh@w_Xz^; scD"ʹE#qhh :6 &gw?h{ }׌C: غY#?!-9޲`%"f}GcѥLZNmxs,}_dzOoTk5BPwnLD?j Ƌ4ҭ08oh*%ą/ÏEz'!~ 3ӃUH(YeK!So<4>gؙxT92сCA'FG}lޠvBnZđ9UCxf HٶVR|;{ԷF(LWf]&1R&ef_bf$ މN@63H˅s|Nxhq=_7 Nx=/?˺Q@33OyQ6=Dǰ76f_3"G*OPUD7*s̗CtxԏW]6n3iܟn~6cw8AIzsKtL%bYd?nOlQhrޗZ4Q\짐6e d-U$m׫]g KnJ[Ijx} !-=[0`6/4.P;Ҟf,qhBο7oAg03 @\No(y2} 9yxGo6kAc,/-NpIl|G;=߽LAD9[w9rfxB {i2ugYj'+ҳ#[bIYc MUą\SQ𝽐]gH zzxǑ}ɍC0#9}b vդ _T=Vrg4_qd 3xX47g]~7d޶ !jxg?[z 9mG~[ m vp02d}+,2-_rLMfLYP#6< ?URڄ#H֫ٶ9nm M!?v&coso$ 2m-A^)`MN bG)}rI @mKn5 #InamC4>x_O1$}|, 1""NM{@2,ȵy('}.d˳" j5[wׅ5 G$Uh^Ra:`H/$L*ZW^?[ \4$F7pq; K^At3z[pml?$5-,>-YO 3>7U~$> {4^6 D](7>+Τapōd <.{~أ*_}2O;1M+?ys!`0d s__C\=аQv!!23 G-]opmv*17C%{Ut Q(/&}Vk`G@~c 9|=lhʬwN<@oak'ʏ7!:jUsV_^ 86S5|HDgzv{(>xНћ&u#qߣe6rܙf:ͷ&dAl+v6F5A:7R#]e^ 4A9ٙlkK?A@QW#JNC0>|A)8PEölƒĮgn' >$XfKaEs sjqLpO+ALywwPxpy]-jnffZ?+o;Dyuϵj)DqOl!~?/INo#:Zo&,&lܘh^ɄA3*$q(iގQT~=,c@]W<~e˻ЬHo *:ɑ~YY_v޷Qס +^!h>X5Ud,:׾~Sv6pɲ;/΁~zю۫HڼS/h,Ouj1nP?*8?uUA/ns>]pJskJJBJՙ,PZe_RYgX'9W$WIY(Wփ7h\VwyȻe76Cxۗ׀ay%Fo~.7I- iw& %yTD@w {Rqx1ozXPŌ$ⲥnVм5q|d !ՙo"t DmAPAOlAb5ѻhQW1G iVu |hjGtU_p59ÇÍپJ[Qdn4.xzפpͫwM|g;ug/Wzgs.u-_ ܚ/FkAs"EikvlR߬TI5Fht$rͼpxCˍ {mW"< ~ACwOt ef{A~l ɴn/3mlȿ~֭gNq12fg,Qލs`y"YS|'_CzO;Nd/+pL,yyչ
SANhTY5K+EMT60kuguqW/\q[>RHvi:~qY-#!r$]mouz: xWt _5L%2LZr/% f Cäq*'}Е@:n;ְFvoP{.CC~KρF8~?oo*CR#UF]GvBPwӳDv[Q^cՕ[ί_#;-ؤȤ"gE3lREP4UGE}=6>ȴ#0cc$u7 \ -`l?VwXJ׽Ô|I[x Ce%7r;qhnN2bkHH9I VkUyP9v0OQS.=nMcaV4N;jF[ϓ#rh{&m{$7a1/H9<ø 1c׹o:hѬ5 S4KТw{JRZޜ3փwAw&mhS_@w7`N:enܠE"lS =owHW_.6늵!#> /IW~j9am*t=#?EW\*DS&Nzds\d?]&=I%=UWnRWZì5( Z} ն?X=uw gM7@Ȅ= w ݞ y@z2xC]Oaʹ<9~6MW Mҷ &< 5O-jf^*\/E' [PƢ#o]31(AI$~ʯTCI kPTٽ{91i=ȫzR0<( <}NK\o!<{l0!Vh jԉ #Tj}|u{[T zB]m-L8T!UA| Y] ֠2.DQGh|σ!˞b_ WU9@ٽk һ<+sq1-HV_N\YZ6[hw}s.קo3H\u(Dl&⑧6`k H˵DO}xkg EG1|N?~8cs'lKn,{ OρEjy>\qJ@Xm]C E¹)t~Jne䴮Qjh7~۳;h7)џG Cu>F˅~"uSVD\e3mї4Vvt!T2iќQ:V9TԱ Kζ7 |7[`dJZ!'.1k(ds'ЀƟ+gguB"Vc*E7+uB~p+Z ~Iѷ,Ş= ?q;@9f$+=2ho$jVYS щ9VUh>O5r1/OkӾ`zwc3٫[ UbʩIqvz@k(] 4Jdr;"z1e \F)xEq.4OL0"/ڮwO=F/ӻia>oW`&rJi㴽 O ^mnAv/4?G>e3jHB '/C`v|x?iw(ߖ+@/ MK%buE^U4~6΅dY?G<= (Q 2E_0A /=!E7tB!MKtHymqjyѰ ԓ7`pHs+  hڑlEICVyD anDDӃ/]βCQKiN'1e?)\zbս[ŏj|YZPWB>Lgo%؍WMV_- ytBu|Go&LV Ia\wHP1Yha>:s)An;^ПooH']?s˧oѻO|d NK _zi8(WJl6DzPmm#^a=4ZKY3ztHyG'qS~jE}2]2clD 48z /\y jhV'D _ІtơaWz ^t ˎ/Y5^jyx 4ŭ(yc6JH}%#iܭ9|5rG0*`nH>'6io#}pI ƀnRUl 5KCHbMzApgIf|V1:o3ȕ>6rhcrYǗID\Z&C\p%#CH㟺7,#\D Xia6)"; 9~ĈH.Zݹ`ath{fNo ׄ>IG-@3oek(.+p!Xf^ Yvwϩ "ا<&_|۝Σ!i51۟ 72mm~̀,?h|Lrcr<><3ϼC.~-hA Gm(ă%{PwHdݯAeLrwgu>, lP~՚8ZߊLkiݽϰ4ʢB ˝PJ_jMj(ϗǙBhIh$}8i=Za.W7QX"bҼCGIA,bqONҍ>vه> 쾢︹vҔG!T`02(a+Qc ?%fGCIU74yyʌo)!%\N$Ai]wH9E JTGNݾ8E]T3%_N=׳ [lgVQWֱ)^i7Y6r:ɛa /liּ`n,t9{V> ꦢ/Oaw:)ĄzCb|op8-$'2u=gA);CAb,ӹ~.JDlF٫Ua:SU/|O?uSOYĤO!讈 |=&\M[ѪauQ+ӆiP !]&& wљ O^R> DC4fH4dfl!)-7FMԑf9cKi9x"{S<9v-vNn=ҦY3 !nCC p+-FXJJX2(⒍KjO/: d=΂9Va1^8QN{CMs =x1v(@wHpߩh9FnEoSkA1}IC HL6o^^ dE^QVC4|5vGP2}'1m,< J[FMFlBg>|խ9fPi/yI`F;GYAR7\b\ufhHs$" ?dAؘbij@Quΐh E?db!zZIG>s:[?{_3sd;/r >2p&A~`&Z|DwhCNiְ! m{8\Ulso3GլjUZ: h6Hx]yoÈ]*WXB z|ȺobTi B ^z/CtR)d&ξ-OUƊc 42Qԏ}C j$<v6ȢOL@d jAٿ ?=ÙwuT4vE<݁R4RIAԍxh` >^cv\afw6ͽ! l%w&|"F~V֑5]MEqvףFAI`ZC4O;ršVouƍVuwkldj8vI ^Q~CTEoIBrzS3_Z;,p㺰|.i?AU6m; 0!X@W)/ZDõ~N?2䃻d9H+shTҢz:S}X/&K6\yޕo)3/p0k(Q ̞ I۬-@tz+CC~Ɇk~BȴF=Dq!gP?/i\Ztu xVtMپ遦Zݏ2+:M7ԥ)ҵ9LڞIry,;ؾt+8nbL.βͤ{bz0fD}i|bνr8)W9x'!Sُ քsYع8^myP< ??ӂ/U!uﭐM2in_) =YW*Si1f*9q$5csd*Cf}]9rhv&`4Obk]ݜ:+,?[7+xs2[HY[gO_[L{ooG~njW}_q".*);f{av&R93U-ɴ^֥*^_KG8y!iӢm(ţv!]2s} n>xnlR]fx~?Ncq}{huI!`Ԩ7DWᾨDdbV6S:Q4-LxDLc-+anxTT5 &^:'d1OW]!kl՟~g}p9}Ti; $ib]X_racs!5hHnpkZoll' ~@ۻ< ؝0"̌QkWEx%=,;.)@~/_i8HfҺ} _l~9'z5@HX 7<~Agol6V;s%#fACKMuݞAriK.LÞa ǓTu;ix'v%3%9r-T̕9.U 3'E'ۊ8BDP0 Դ'A[1G_n*2X iJ'.3j/ʚLj}L¹xxfتhy b>M\ĄfEQ)(m)dWה=w LW=±5zG?}aܺٛw@jnR@Ro5^]_ ?iJ3_:2|s -bCp{EѠrvl? =."2bF[ P rvC )Eu. B>H a~ %JK㛬ZPs3 CBv hJeQuD@OȇpZ$gVwYzg\>B}G]OW{]c?Ɇ΁Q-jˇhbNx|Z|] iGg_7ް7WC|@a?6x u3Ҵ_Lw& gα5 ֫p B>?^d/~81d:jlzXnP Ŝ$\q퀡WO@5 1c&lJi/W悿d;֠m"*  !ӭ4Ƶ‘LE4!9sq덷 g,i 伦a rv!ِM}1ӟ|:!,@ז+F i|ɱ~f׳b8ʶd: -Ws!\vITE_ Q߸j3i)<D.4N'7P[޴|:! A 3&)C "g ׏h\ɕ (b}iy \ !fK 1}/lGSp^~_ ⡊yÂLٓ!5дXT Q/UQߨq6rf?s O_f^R6n w[vk Q mw֋C3:zTg2cGBz4^^ƿ)8Ix L9v-H:V{qgw%KTV}D$4x\IJds@PDْORUs{XZ/¡}V]AYƛO:Kjl K߆Tɸ7i}#DP4}1Rl}3ќUrc˂v Ibn}+xu!qιѐ5ۧu+Ml!'}fBi^Eg_!0jn)aݻHx!~ I9v $Sro"ztxr ([^ ܚp H3e; UŴ~96̝E0eTi+7_>ay|ɟ9^~ڡ~)ly}.eCK{BȦKG[!iCܣPoZ{foƘ_[>ѼI ̒$*\$p$_*g3~itԭs[2*Hv·UQ Vy+3Rݯtu@3i0h!`{_P[ Ŵql"&|zIA^E J0]'03о ?G_>+b+Ú/'k;-ߎM忲S=hkM{$$e,(950s.9~hFU]Cp]&)V3?|0k7#ț,s_W+M0@=~?:7n^+g/4u P=|㘖}އn}@ W5u<"3 |";'!{ ky9Us\/}} u.gQ!hhapLMujNl݁cUf?`Nt(1t&mlr@8qv` mFJl:f4|Fݬ;("ˎgbZPsAPu>")SiPDޚke6u/ܬK ]F8 'N_AgTx"W}l4 CSznB4fdpE|xm<8ՌIAt_'}n]^}]A3[RV2$@u2~vY_4mRs6$*4|W\Q9(3y$~f+SiTMFMuKB T褐pt&/ni[oԙp%9VdIZܽq%"ukU{lX=UjSf>q~sPs7} /_ O/δ&T&,{+|xy Ä́5ţQ7w(ʼ:߻!u`GV867cW· UouF TvɄ%\԰Rmฺ5˧&V$iϚx|dDS|KڨO>e^C^3M 1\J UqۍC{s'Ne}"RshA-e~N[舚kTI]]0op:TL<;il'J~64N ^u78wda=FS;`U<6é W7~QVn\oo]/Ss~3`p# S'%gNFpfh $ZʻsRLF[}|Çȍ.W< ǣqJԳGyN_V5Z$?qoA)x~׻}3W(ߒyOmҥBp,`RvԹ^rc ўnףAIQ |x]MOPpf֌fky;fxC"6TD7`5-^lbށ_nѭ:GsűJ+aCjO+|pT4d.Њe#ۛaJ(vh-zn$ve>Y| ]Ϡ"z7lfr> I1[ݢĤLzX9}!Q'qSޘ֧!t ʽwfXtD֏(?oW0ئQc\!{lI@7h%a0.{$;nӐ$|4yI7 bx] ԭoPeue"oƭg'/}&A&.(UU=ø h5 'OXK.s'$<sڶO[y2Id]ϛQhzc^Jm WB~_MKys*F֞|A9cC䨺t=^y1//SCPԻ jUή_ Al;|~nz$h`Iޭute)ǡvfc u!K^ wus!#yI!*d+$ch睿!$,oĕ]G>%JK"~ZoBJx]?z_V,LV 4,4:g'j|Vmdb4UxMUFYr^{2+ _7|y7 q:󐙼s[V~sA֋`WxeAc"1NxBsߺyWIy6+p*WYf^ǍM}^qGi5D 9?+fgIYȫȏ#1A9HEjQ 錴Mi9Ǒkf׈S;+;Kk5Cwqhk`{0~`wEhݴp,2?fSo|Ͼr2Pe!ӆ]E|is F |Y;rk9KM67%W~ g85ۍbg@xey9`l/v-G.[ @~+¬~$Mt߃WWa[-w!NYaz ?3vjq"5$p'WaӞns~1.:w͘YVsJ ɐ06Y~oCC苘cYG=vx.*? j=_G( ]$2maW]Yw{WUvxO+Z噟#vgk`9+ *Fsymp~@xH+!/+,%ŷ׏WM.#wk#ݴLP:txgP?pUZ-N4B3Eh2ƷQ:g kPЛi*b nL 1(2ߵb} M h)H ~\)4>ql;q1kcGn04qs~W%ӯǽ}_G6.B}^ 2>S$E^بJҹץ pΆj .qWco5;ey"QZX<^-g'tUg{_-h_'l=M\:|Ep9 s,EHRQEҔw{3C_}8_?e+b/\ҘMи) +PNV|3'&gޠ\']5젷]暧_[c:YMr87'E7c@<Y^3OvGS/NKi $,@Pi= Ԯ? B~ǏWV4G>`ݯ=Eѹ]M;Z9y`uy^yڼF[Eyªh`YJēvǾqDX❾nz|L|cbF68 ]QPkU"S%NǢo@0L(Ѕ>V-9^;*yxXY6 Rk7Δq;\oJ=_gmyz|%ek>e?c~y!.memh䁵9x6:6ۋֻÓD%y\ 'TG\q֎in&+Fnȓ)ezTՎD j3y8vF@VdEj%ioDS%AQ{ƥp . gNA̜໗MaH{Mx{IOkZ 8ztŒ_qx̧}]r=Y{yk% ZEjn.çC]/DN8Bj9WFGk+'Nq^$Z [o䧍ݵ(1 g\{$qOr D8a ɏ HɣNc"S.ÿ́Ş4^Lr`TOvqsGsP=Lo>m j)X IX5/ ^(.g_ WQ@E˯_83yϡ̀{tP=SΝ7M%}݃竧_ؾ}/em`F>پ09JX։Ks_'l[U%Qj3(i̘Ù ΢qw?zÆUYFM;?V4פRZ>;x^ێ& l/'dds(kVѐg J۴Qe 6=a(x3hLQ{UהSɢ,m 2~}5w >WU&t}Wy]I U|Zo-X'.Njtǩa]q4O8|!JP6çKݗ F@׫;ƀ?3dXMxRu sgך_Rm/G٨JK+,pd؞Kw~;s;zU;3׆Ʈ{6UՔ8pK*Bz'xlD~5LcE;^-zkU۷HwTCi.&\jwiYt$Z= %kkGuҕ??=XNil[9pI c{v]ˉ[gNOW=,7eGO4$Smh+Ow,؍bFۉJAg!_OVs-'ieeSyKĥEàh}6~h1kۣgISGi޵"l.뵠\᫅|k(GJN0#ԹO3jz vg}Oi9wo.'ё 9Z?۵1.Qb5? ;_3n PJ*Z)] %{LX*Y|BŹ.` N0&x|W#żq{IZC/$]kŅ]A%-҈׮sAcԃ%A 6a&H.__C5m GmvgdD^© 7 q;)y7SH-تj42*voO6GvVʷn=#՗ ukV }N-tݙmȭ 苺dwM=&35QܽuCTS}l6]ڿP9<Ʈ?)4򉳨ܶaVҶky&=>S]BdHFXX B ^ W^`mɄk9<`=L?U6M #)?>L|G{c_[\uNj^47cbn8XߏKC#Ny7v@1WYzJJ7lb%džGss}6ey!XzM㥑Iu,p-B܁p<'ŠB}~#aT} nϑޡ)Dw]6koZ-.=GIԔy@hQ<>-Wneᵟ>,ٓ PUh,Oi`pH 3+ZIr{r!BguNTkKMq xON nݳ49g{ի ih.ꍇ笰JgƁqPtq>Izsnzjxt%2??Tw&蛧 3^]fȡ(w $^mGij@{cC+J~_pز2?b%kl6 Wmf^9R !ǂg#̋P?I'm'\#Fϴ4pxu^hv;&")Qr5j='ĪMyA]=a]k !j&7l\M&)NFVz{l̵ >W OnnvnzÛxSٛŷޟ=I5:Yaoh5*Q/F>+:hqf`]xzoA>H!0$4~y#i syNFG]P@߱edIid0Wt֟/g]G@~vQKEShZ=erƟ GwQ3WO/Ge2UNHZ`hL,qDR>L,ݗ}廁v)(K7|ko4}m+FZ|fz\KW]U 7+?cfk~^K:J㗸tZ/)wC6bcuP#zm:}!x.2#cpB#5z1L8F[v>Oc=hޤf—h3^ٻ+b|+7R!m4Lv+%~^Bj\ =G7RAJ|!{[gq|;ҔT1gl<Efܺ # s3Q6[4?nBG> "-ޢ=h;kEi];8eBU?3b}Iƣ3fIbdkjFmo!c(vl*w~+@ӹ]]G @Y.qd$9( nuCӶoh&N0rr=Ģ3n!NV m΅oI+['BK<ڋǒƍ!&]E&w7W~'o۽B} Gj@Gi=|4.*(sFP#\_owBW-Y֝‘E_:Y;CgpV+g T~.8}7FiѠ#ݤqD6=b (d{0V>ImcGƌBf鑍LlD` LMBCߚ)izao. &_0bLpʾ퓫eAױːu((0.mr)Z}_DSG= v;i*x4x;_5{nuE#|PcHn +Nn8Lf޴}|_j9j1׿)9&ZeQB]JM24tɓ#~Wj g9`ϋ]{gQytˈ8~FI3@UJ?@w~Dg V{F/ )Ci|QbITp 3Ɨ_-zoc/+J(kZݭSsǛnZ`_ʛ19-~=6yn+뽳hk|ˆٶ-|[ѭO_m %MH]ު$x|#iš;)X˽QnԊ͈y(ef'|vO֯wt% ǬܷԹ v]vUS#4晵jMQʐTAԠy [EYPA!(Cʐ!QA|y_~׺Zue=gϳ_y eW?Zl_FYX eΘu~l͇||Px(7M$ 9iP] @{tGD͒7vkyzupbƚ[fQPlPM& ִea(>_O7y7V{m,W xo[{4ae8:TA.%$NIw4|a;sBR*C5.cA)Co}F@îq+]@:8X*Am0W x{ƀ:zf3 "~>CfRY}פf .ߑ'O ܯ>|~,9zj!)^ZR?edL){wQ}5!/ r+=|-WFBGї˙S =ٶ1~Jԟ 7 s\׃w_s ͎eN+/Ŧ[GҘxp\Kv=?U޹#XCJo?ros$IЊh[O/ FR8HvM?@Uhz0x{^ 'T9Hwpg'.@OoOvyv{_]\r|nps~mˬǶVׂf25{{͛VEp8i_no=O;uʢ4[藒@Ji8WJeLnDMP+E2W*_Ē9n3gWzJf+z)k%XXxj/ :PZu ]$<w O+1!ͮYY([(zvϱ~҉>S}ۮ#`,YrJ%]Noq*.vnkn*=`?6{b*;5mXp7M<ǡ_uWhmx}Sg#ޟEاjս<-\B{x|~ԅ'>.^ Wt@7QQ WD^<wLg!~7:ʭQe N%&&~^3B)V^`B0oPDOΈ$}ȋƽ}VԢ~ S!ئ@V>%J%`}!6nx4蠚spmy'|o[{.ZwiZN;\Jz r׼`|wO*ձA߉d.B)@ԉEl NngQcqr>eu[d6tt?)7 J˘؉g@'}wolD >֨ʾ]KW|=%> ٌW#JF!]q?xƍzQq<OsUW:i֮)GQCm:uTs{$HrԊmMJScPzP{mrXP5_;XhZ.Q_?sߖTmpJEgCufGixL3:cԳ?ݸGd_n^W#'<۳łUهZ|tջtEuv ʊm.+CS^uߞ|P7#FkSs`RyHk_&`X^r77/| mF*oG<Ыu/{^EY:Ts/!ijݏB%gjd2o6qud=vRtlȔ~pM'&=`ދy@#+Lk ×kL Gd\e '6#;s]? tuwFo nw|Jpol&z:Aߗ?S/ A庂yɱL/w32MDO]R JDǨn̓ shoJ ^|AߜYTXlz$t,&DUڝVx: -.qI>O%Liwz=f>,pҒ5T2g6 I׋kZe V绪wmLd,@} ''egj' 4I>eH9%M=v~͞"`]'n zÌo3_˿HP= ٯ+@_3Z9y&rOay:uTj;XWNdzXߴm(@U%|xA$Y?WVNDݗAQt0;t^sկ˲ hp{EgI /zv.3ΞH$}@hOm'|!>tc^7"8I4|_e'v-L%j_~4q>w5^Gu) evh6ZK(mn0ԕ%vC{T]~UPv{ wx/Y1׼<, xpW^]-\P]fM7ߑc`xv#!R:ЮYӱi{ "SÎFÉ3K|9qwkjX$ab?`vvZ/K׮"/ݚhˈ`kVEҭOܿ 7G5|x8S\nݷ S A=c7XM}Z7 Al6Q JÜWփ6GG45.rP8e`|2Q7Ѣ-p44M݇xXv 1&?xGeaz/O->hiγq>}œ3nF=}ʃD4xJ~+3!t` ۜ;[=㹗>2#apDG?+.A*`gRID ~^%Fۖ'.$2~AGah_4z\ׯ'?>yyE={ǤW#&]RG:T\~n}8WW ^%SGX.~OywZ6es˯B}+To9ڴoE2.^ɋ۠# pB zg׷?%"M}`ٱ7dQn,ܐ؅z|lЙ%R<-ZSE,qz8WPV3^K.`K^Q?SW}4؁M>ڼXW6f5Io7SЖtX}<野lx/7*VjNy]AnKy;)j* ,$;2a;E06y!@ٗblJ /%~i;5XǿcQpB>ekW\%v&\%h-h6ߍG_]DD7[|W/p䪛o h2e6.2ڊ>#`iZs,JQvH gXJ hmŢ.Oס\_4@透*+.Lvyv^2>E33ب5U[3ܫY?Ac!닮S扥\0\vC%3UEo1,4U%Ef%!jG6z֧.B{)7Pjdilv8*UE ecUINTǫ@K9f7 =[;%SU^άŢdͷۤ~}/|s}NVvBt\j| o" Mw.xHizej/c Ơa{SU)#Ze}+OZ5X='>-R;5%Q㜭A_֘Gs: ?"ٝpor8xuZO>p֘L\Ǔ&sWY̼ߥ _j=>ct ~s=_}G[ [&/6혃'r5`t{gasq{j@G=p v$$@).yJH;C!ĖDׯ6'MOQjo,}=6C'K$ AmEG?~Y'$nU6 R"d\N2^|(|:< ZpQE,'WDv }r7`uKCU?U,փIWu/Aw[?ZLXѝf0^^x_s휟 = Ôn< x\@;@5I8{~Rx?J4، صmz{c œ=`Qg-R^{7dgg|H\ނeyztۃY[+XÞ AС3hо>j rzxBF97 usZ%|fau#8[K{G۸+^S^;}zKyE1d+hES!T^Yu g5%|]dO)-nTVU햟u`LϟwEt RC8ᛉg꺛"Zv5Dhiqih1e"Ȃͷc}Dmzi:&} т3&kw(8:NAkr~k iҕ?R-HL4a"gG^N 3^  A7~:]t}%6v-Tk^_)/o}7MNAu2 sWiNX-?sHwޒ 栚J%*)~c'QuO5;LX)T\ԢApfƄ$~5ڰ K9W?E t}z?`J9NNC]ĽbWB2zEjM=o"[C=q)`[&xShWE5Q?{V2h FN`9KIHt P)X3nzû$DGz{=7W?WsNϾ[5w,х`dRJw'͚ծ9h;B?20Ʀ5ϓK70pD΅1Zh5 4pm=c'RRY}RI_Id^{4 8 7qb)p8ҷe]PM"`ʰO|Ruu~կiCAT))= W fj/~ 7wYn ^춙+zti>K)=hXa'u2Sa"<3( QH[N4XCO^}J@k;":~`UrhBɛjx.fĠ%TM`_t}4ҏ}quhж%yˎuӎUQv^3"=o?l%?%k9th?c/ѻg'v%[xTSjߝ>X ڞj7yXo㸸d.x. ՃT~ϨOϵG9 ke9R<ء]l̉ ɷ:L켼7i,g'Y~A=MKƁ8IVg{Uvm,d]*C<9ιk nݼUN癁gS߭A.(>;:{*{Yn`-} =F?EEN+ ͒ FJ^itXۥ]_!iqCxh?9{:8in]V(~$ /Wd%S]p/g$wDC 'D~B{l~'Vk OɰoW?~=Gɴ <}~lЩeelBsYpPRJ@l= u?6شP"hhvzQko _zg)Ywwx;.OMӷ09gK$d\$J7ĆTp XT ޸Ks4fh&AiKRQZ4 /S.%9ē~nE^0N*x-ŋ>Bp+'g~Yn.J5/v 4yOsG{lSL,aU?= rgF O33TUrWkF9e^x0͞w+O!V[^ =me}Y7&=` 1`2h&v%a6)vyaU2%a_;wHY3H>ܻr_s?jX X{d]+P( AvVRz/XAdUAw3pFB˪Sͩc|wYOIV\y-Mr.MW9\(S~n{GvEɯ@/Jg5ˋVw{`yi0h۴WSGAur0#>Ԡ{L%TXv]#ȼT7Xӳ35H@;_Y-"犰'YW&}d#ƀ#.w_VVaBJ<3ƬG{οmyHULP=w7t4CjdJ]%{2mV'*MmS/2S^**-JZncVLYo38t*F 3s7~3˥{M)&8v<'L۫vM^h.':jfjɚ'r.8~ CGoe]>3qc MB?e6qc>/r/CZܰMX`PMKв6nyMdy?,\[FG^'q]#֊h"x-tG A:Õ`.z꿆ٞ;籪Kn^PJʺSd:!Pݑ{?KA_!]TO7smjlزuI;{4|(=ʬB8Rc?^^#gΖn۴8% =cU9$4ڞ%u:zNoL%:0`UWw&ω#nNsx=cB Ml)Hop(zL ߈!aYڐ]H+K%b=9=@mNseX='ˈO>捠]p5I\J__QOKлl3x 5Wo -k88oeQM[f,@s~֨sUǩ.#j=h::);x1xO 7/K;S.>=)k¿`^܆W 搚Q8wmy ^`0>sR2Oq+'~S6ߵrzۚ\{IꎃLJ)-% G]BA45i:/ߊg&W<:(h[q ghM~7[{eI:{Æ#x>jqϦIC|%`5-=jQI;Nőw];QNZ4]Gp5X.vo;%\d+7偹Ydʘzp)iGky'CB²';4cm'z{򘏑~[nJ]ϚI_zCi|(-If"W_?Kq8UKm&G/c @t1 -JY_DV5ɀ,v5e>6^Jo;olu'E3еubv˸ Zg`ZX}_EJNqkH=F*OLŵa;퐦=8jP,;8Ȣ۵kFP ]0s{+Yῧ*hq?) |"ҸlN = 4k z.qD'jwme<5+&XK\(V͗j(U%પ83 F륍bzy܃e\U0.-:V~O[ӈ7>]X]\__mb";IX֕@oHW GUá5kҙ[O!naKPB,@WW Z3ZՀ6ڍZ~D rO e5B4ٓfÛ[ I(% 6=Ǹۀ~ڧ_GlG{sbWwO;s&Xr;š||yZGgQrkw\`v`*z>P &it>]t ͺo ]TRMgk ۽`=Myr|2`NV\ AP:pO3ZJR3wo 5= 9 Ok0J2a6>rihװWz]]&zUR,b6iuYt j'.j lY) pG.wO~;hq':&E6k\e} f^oN!4WN,0\-Guqrhk:Cmtr$zY7Wbp3/.<rk;|[ȣVDk/5DWLޝ' J: [=ETBQS}#:&sƽC'[l(0;S%uj{J -_HkUjw2xj؟>o$}UӘbt~ضx +jV~EOjt;yϏ\SC3 n]mV∣ *$fK|\忘'-vC}6kU䧇QoՏ_ipd 򋘺Q`^iX t%}žDج‰wxRQsH/Qrմ5SV/\^tʗalo5`>@T\jWuP{`m;5n9u*-5J?\4xwEe ,~`%{"ҭY$cZtUN՚ `$9,#?}e,g;\&BI\Eݻ?7NhXq&͠9$3LۀG[LHu} b;(bޠ\Չy-穂8s&"sem2hϦn`U'ț JF+`NvZ+ ñv)2 ֲ#oE}Gy~ !}wG~s$sIh,x : oHLՓcW .#\ D5'A^.V9zF)h3_/[kbhry_Mќz~y#](ni xz8Hۏ`uDAXQ׆hRk}G@pBfLspp*HY ??i%h:3~%3ɃsŃQO f΋J{/[fRn: kϋFw_ov[)#c~6DTlsHuMDglriFoF?|hq,0SCkcRv#"DǺQEDoOA`Yē\lKEѲ`6Yp']Y |'o:HJ|CI]:#Q@צA-{z*Q+N^^Rw=!cpDZ>⬴k?:)؝*yOX4އșl*h?Eh sVk}Iq%dxIv?y4L`OKU{FO~?՛9nv"J"N/ Kp<E˳YO# _#aE^CgkPN˵^ (g]ރ@nRw.[ѤfY)(ռ%8>#xR.s~MZ7D?]x$rYOɷ- n>4Ityaz׼:X\NP?߿r)^:`] Pi̸`T, xߴ]ZJS'jn[PY)~PsqlXm08)^ψ,!i>=𕌮V:.]Mafh݋⋼ 8]cfYoGD{ъLqN,һJzǤ޶]E )S3<ɼ5x>Woʲd]akY@{mդ?xnrx"+珸iIvv`?fۇ߶ 0%`&k_GT(~Gpha@]c7؅XuV"_>@E]jM#k@=lk;TPUb%PłM۲'  vF=XZ+g1D!^L ^F}˔ ѲVe,P% ih6.0}w\ 뜣lxﴳn#>yFڥ\xhh4"*'j/[?L#xE8f㣘>hS(uBA]-7/RP4i(O}pq2xAwSS@o3 M-ȺxGԇ tPbrǔsϲϸAO*:kM43mWܲsd.*Q "Ofh>]~E^|*A?ksmw'}knFucSHO:V5!gdS7r,BZ?.Zk >nhҔ#Y ,ڎ뉧4P5_h{ks!@7hbt<7yaN F*y*5GΜt\Io @ 6=6~Bti%ƿ 6EwWbଋqܛfpI %>lY s.vKRwFH\sӬ[>un׊%38Ѳ*c2Юޞ 1%`ͮ7!Y]W3?LCÎTDtDCWd~s ܱteI>+4ѻEl: @ i mL|FpV螖 ݾ칩O O!x/sKr0y~mQ+qfA`-ޚ#';.Ə%s!ÈM|w-`yʨ ɐ1{v?^'YЌix5"~`췟$(*I])^! u+=#+;+B*n.:̉]tCR/6ُf;ZowN.u(|f)O["= 5ڢwv8]g5`{7N*wEHU`̸};W]@qnq]х_%w@ha^:>7o*TҟiGw!@Z>mkHk,JΘϰ/mzB jG8?6Œ za)F Ѩ #}U-Gq9fk<'XdmAzCk-]. [A %6 #" +B^; yB^FF!0NF!#Qߕq yed22 yB^FF!/QDx}vD7 (o7 B^FF!/#QDx}Q(ed7 BFa|B>DB^FF!/Q#Q?(Q(cdB>FaB>FF!0NFF!/#Q(oB>FaB>FF!/#Q(cd7 oB>FaB>F!#Q'#Q(edB>Aa|B^FF!/#Q?(Q(edB^FF!0>F!#Q(o(ed%"2j|!K"Q챣6G۝Uևٞ#_ _$yy93gD{ROCR/data/ROCR.simple.rda0000644000176200001440000000252513644317760014474 0ustar liggesusersWiPg"J=ZA.:V-J9ZQqZl=J T #3T 3i0I6Lb>=:\<8p'S<ℶ[TU1-Eî F] [3^kɧ<}>{[j2MrVo/T=sOIz in{ךyld1<ȑ: SjEE`6$cZ>ҍ]ϗ6"_ߒN\! {+NTM}LN*]vzyo#͙hin ՗݂j,]yJ1;3ji.at^VYx*wNq7/sO>9ch'o&`E.pS;I/_h,Ȃ;^/XDsR/}M@ dӉԡz`wmį~ ub*DNtˢvϠroeu_Ut`W?Jx圷WW %Syh/KDxArnQܽ 3}O}s3kRI{q6$&tUC*ו!4ӘwO/J tHE5h~{hOޅ=+D@Ntn~0vntqÏ/sH: dBSYOn߸,;څ񰻂>킔 inSq@|OVP.,P 9Lqj{fG[ϙ:gmf[gsm6}{;W||ϵmBBwfk_~;t4$Rc"NBzXsӢC!N/ y ROCR/man/0000755000176200001440000000000013644317760011605 5ustar liggesusersROCR/man/ROCR.simple.Rd0000644000176200001440000000154613644317760014137 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/zzz.R \docType{data} \name{ROCR.simple} \alias{ROCR.simple} \title{Data set: Simple artificial prediction data for use with ROCR} \format{ A two element list. The first element, \code{ROCR.simple$predictions}, is a vector of numerical predictions. The second element, \code{ROCR.simple$labels}, is a vector of corresponding class labels. } \usage{ data(ROCR.simple) } \description{ A mock data set containing a simple set of predictions and corresponding class labels. } \examples{ # plot a ROC curve for a single prediction run # and color the curve according to cutoff. library(ROCR) data(ROCR.simple) pred <- prediction(ROCR.simple$predictions, ROCR.simple$labels) pred perf <- performance(pred,"tpr","fpr") perf plot(perf,colorize=TRUE) } \keyword{datasets} ROCR/man/prediction-class.Rd0000644000176200001440000000451413644317760015343 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/zzz.R \docType{class} \name{prediction-class} \alias{prediction-class} \title{Class \code{prediction}} \description{ Object to encapsulate numerical predictions together with the corresponding true class labels, optionally collecting predictions and labels for several cross-validation or bootstrapping runs. } \section{Slots}{ \describe{ \item{\code{predictions}}{A list, in which each element is a vector of predictions (the list has length > 1 for x-validation data.} \item{\code{labels}}{Analogously, a list in which each element is a vector of true class labels.} \item{\code{cutoffs}}{A list in which each element is a vector of all necessary cutoffs. Each cutoff vector consists of the predicted scores (duplicates removed), in descending order.} \item{\code{fp}}{A list in which each element is a vector of the number (not the rate!) of false positives induced by the cutoffs given in the corresponding 'cutoffs' list entry.} \item{\code{tp}}{As fp, but for true positives.} \item{\code{tn}}{As fp, but for true negatives.} \item{\code{fn}}{As fp, but for false negatives.} \item{\code{n.pos}}{A list in which each element contains the number of positive samples in the given x-validation run.} \item{\code{n.neg}}{As n.pos, but for negative samples.} \item{\code{n.pos.pred}}{A list in which each element is a vector of the number of samples predicted as positive at the cutoffs given in the corresponding 'cutoffs' entry.} \item{\code{n.neg.pred}}{As n.pos.pred, but for negatively predicted samples.} }} \note{ Every \code{prediction} object contains information about the 2x2 contingency table consisting of tp,tn,fp, and fn, along with the marginal sums n.pos,n.neg,n.pos.pred,n.neg.pred, because these form the basis for many derived performance measures. } \section{Objects from the Class}{ Objects can be created by using the \code{prediction} function. } \references{ A detailed list of references can be found on the ROCR homepage at \url{http://rocr.bioinf.mpi-sb.mpg.de}. } \seealso{ \code{\link{prediction}}, \code{\link{performance}}, \code{\link{performance-class}}, \code{\link{plot.performance}} } \author{ Tobias Sing \email{tobias.sing@gmail.com}, Oliver Sander \email{osander@gmail.com} } ROCR/man/performance-class.Rd0000644000176200001440000000600513644317760015501 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/zzz.R \docType{class} \name{performance-class} \alias{performance-class} \title{Class \code{performance}} \description{ Object to capture the result of a performance evaluation, optionally collecting evaluations from several cross-validation or bootstrapping runs. } \details{ A \code{performance} object can capture information from four different evaluation scenarios: \itemize{ \item The behaviour of a cutoff-dependent performance measure across the range of all cutoffs (e.g. \code{performance( predObj, 'acc' )} ). Here, \code{x.values} contains the cutoffs, \code{y.values} the corresponding values of the performance measure, and \code{alpha.values} is empty.\cr \item The trade-off between two performance measures across the range of all cutoffs (e.g. \code{performance( predObj, 'tpr', 'fpr' )} ). In this case, the cutoffs are stored in \code{alpha.values}, while \code{x.values} and \code{y.values} contain the corresponding values of the two performance measures.\cr \item A performance measure that comes along with an obligatory second axis (e.g. \code{performance( predObj, 'ecost' )} ). Here, the measure values are stored in \code{y.values}, while the corresponding values of the obligatory axis are stored in \code{x.values}, and \code{alpha.values} is empty.\cr \item A performance measure whose value is just a scalar (e.g. \code{performance( predObj, 'auc' )} ). The value is then stored in \code{y.values}, while \code{x.values} and \code{alpha.values} are empty. } } \section{Slots}{ \describe{ \item{\code{x.name}}{Performance measure used for the x axis.} \item{\code{y.name}}{Performance measure used for the y axis.} \item{\code{alpha.name}}{Name of the unit that is used to create the parametrized curve. Currently, curves can only be parametrized by cutoff, so \code{alpha.name} is either \code{none} or \code{cutoff}.} \item{\code{x.values}}{A list in which each entry contains the x values of the curve of this particular cross-validation run. \code{x.values[[i]]}, \code{y.values[[i]]}, and \code{alpha.values[[i]]} correspond to each other.} \item{\code{y.values}}{A list in which each entry contains the y values of the curve of this particular cross-validation run.} \item{\code{alpha.values}}{A list in which each entry contains the cutoff values of the curve of this particular cross-validation run.} }} \section{Objects from the Class}{ Objects can be created by using the \code{performance} function. } \references{ A detailed list of references can be found on the ROCR homepage at \url{http://rocr.bioinf.mpi-sb.mpg.de}. } \seealso{ \code{\link{prediction}} \code{\link{performance}}, \code{\link{prediction-class}}, \code{\link{plot.performance}} } \author{ Tobias Sing \email{tobias.sing@gmail.com}, Oliver Sander \email{osander@gmail.com} } ROCR/man/prediction.Rd0000644000176200001440000000645513644317760014246 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/prediction.R \name{prediction} \alias{prediction} \title{Function to create prediction objects} \usage{ prediction(predictions, labels, label.ordering = NULL) } \arguments{ \item{predictions}{A vector, matrix, list, or data frame containing the predictions.} \item{labels}{A vector, matrix, list, or data frame containing the true class labels. Must have the same dimensions as \code{predictions}.} \item{label.ordering}{The default ordering (cf.details) of the classes can be changed by supplying a vector containing the negative and the positive class label.} } \value{ An S4 object of class \code{prediction}. } \description{ Every classifier evaluation using ROCR starts with creating a \code{prediction} object. This function is used to transform the input data (which can be in vector, matrix, data frame, or list form) into a standardized format. } \details{ \code{predictions} and \code{labels} can simply be vectors of the same length. However, in the case of cross-validation data, different cross-validation runs can be provided as the *columns* of a matrix or data frame, or as the entries of a list. In the case of a matrix or data frame, all cross-validation runs must have the same length, whereas in the case of a list, the lengths can vary across the cross-validation runs. Internally, as described in section 'Value', all of these input formats are converted to list representation. Since scoring classifiers give relative tendencies towards a negative (low scores) or positive (high scores) class, it has to be declared which class label denotes the negative, and which the positive class. Ideally, labels should be supplied as ordered factor(s), the lower level corresponding to the negative class, the upper level to the positive class. If the labels are factors (unordered), numeric, logical or characters, ordering of the labels is inferred from R's built-in \code{<} relation (e.g. 0 < 1, -1 < 1, 'a' < 'b', FALSE < TRUE). Use \code{label.ordering} to override this default ordering. Please note that the ordering can be locale-dependent e.g. for character labels '-1' and '1'. Currently, ROCR supports only binary classification (extensions toward multiclass classification are scheduled for the next release, however). If there are more than two distinct label symbols, execution stops with an error message. If all predictions use the same two symbols that are used for the labels, categorical predictions are assumed. If there are more than two predicted values, but all numeric, continuous predictions are assumed (i.e. a scoring classifier). Otherwise, if more than two symbols occur in the predictions, and not all of them are numeric, execution stops with an error message. } \examples{ # create a simple prediction object library(ROCR) data(ROCR.simple) pred <- prediction(ROCR.simple$predictions,ROCR.simple$labels) pred } \references{ A detailed list of references can be found on the ROCR homepage at \url{http://rocr.bioinf.mpi-sb.mpg.de}. } \seealso{ \code{\link{prediction-class}}, \code{\link{performance}}, \code{\link{performance-class}}, \code{\link{plot.performance}} } \author{ Tobias Sing \email{tobias.sing@gmail.com}, Oliver Sander \email{osander@gmail.com} } ROCR/man/ROCR.xval.Rd0000644000176200001440000000230113644317760013606 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/zzz.R \docType{data} \name{ROCR.xval} \alias{ROCR.xval} \title{Data set: Artificial cross-validation data for use with ROCR} \format{ A two element list. The first element, \code{ROCR.xval$predictions}, is itself a 10 element list. Each of these 10 elements is a vector of numerical predictions for each cross-validation run. Likewise, the second list entry, \code{ROCR.xval$labels} is a 10 element list in which each element is a vector of true class labels corresponding to the predictions. } \usage{ data(ROCR.xval) } \description{ A mock data set containing 10 sets of predictions and corresponding labels as would be obtained from 10-fold cross-validation. } \examples{ # plot ROC curves for several cross-validation runs (dotted # in grey), overlaid by the vertical average curve and boxplots # showing the vertical spread around the average. library(ROCR) data(ROCR.xval) pred <- prediction(ROCR.xval$predictions, ROCR.xval$labels) pred perf <- performance(pred,"tpr","fpr") perf plot(perf,col="grey82",lty=3) plot(perf,lwd=3,avg="vertical",spread.estimate="boxplot",add=TRUE) } \keyword{datasets} ROCR/man/ROCR.hiv.Rd0000644000176200001440000000334513644317760013433 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/zzz.R \docType{data} \name{ROCR.hiv} \alias{ROCR.hiv} \title{Data set: Support vector machines and neural networks applied to the prediction of HIV-1 coreceptor usage} \format{ A list consisting of the SVM (\code{ROCR.hiv$hiv.svm}) and NN (\code{ROCR.hiv$hiv.nn}) classification data. Each of those is in turn a list consisting of the two elements \code{$predictions} and \code{$labels} (10 element list representing cross-validation data). } \usage{ data(ROCR.hiv) } \description{ Linear support vector machines (libsvm) and neural networks (R package nnet) were applied to predict usage of the coreceptors CCR5 and CXCR4 based on sequence data of the third variable loop of the HIV envelope protein. } \examples{ library(ROCR) data(ROCR.hiv) attach(ROCR.hiv) pred.svm <- prediction(hiv.svm$predictions, hiv.svm$labels) pred.svm perf.svm <- performance(pred.svm, 'tpr', 'fpr') perf.svm pred.nn <- prediction(hiv.nn$predictions, hiv.svm$labels) pred.nn perf.nn <- performance(pred.nn, 'tpr', 'fpr') perf.nn plot(perf.svm, lty=3, col="red",main="SVMs and NNs for prediction of HIV-1 coreceptor usage") plot(perf.nn, lty=3, col="blue",add=TRUE) plot(perf.svm, avg="vertical", lwd=3, col="red", spread.estimate="stderror",plotCI.lwd=2,add=TRUE) plot(perf.nn, avg="vertical", lwd=3, col="blue", spread.estimate="stderror",plotCI.lwd=2,add=TRUE) legend(0.6,0.6,c('SVM','NN'),col=c('red','blue'),lwd=3) } \references{ Sing, T. & Beerenwinkel, N. & Lengauer, T. "Learning mixtures of localized rules by maximizing the area under the ROC curve". 1st International Workshop on ROC Analysis in AI, 89-96, 2004. } \keyword{datasets} ROCR/man/performance.Rd0000644000176200001440000002721313644317760014402 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/performance.R \name{performance} \alias{performance} \title{Function to create performance objects} \usage{ performance(prediction.obj, measure, x.measure = "cutoff", ...) } \arguments{ \item{prediction.obj}{An object of class \code{prediction}.} \item{measure}{Performance measure to use for the evaluation. A complete list of the performance measures that are available for \code{measure} and \code{x.measure} is given in the 'Details' section.} \item{x.measure}{A second performance measure. If different from the default, a two-dimensional curve, with \code{x.measure} taken to be the unit in direction of the x axis, and \code{measure} to be the unit in direction of the y axis, is created. This curve is parametrized with the cutoff.} \item{...}{Optional arguments (specific to individual performance measures).} } \value{ An S4 object of class \code{performance}. } \description{ All kinds of predictor evaluations are performed using this function. } \details{ Here is the list of available performance measures. Let Y and \eqn{\hat{Y}}{Yhat} be random variables representing the class and the prediction for a randomly drawn sample, respectively. We denote by \eqn{\oplus}{+} and \eqn{\ominus}{-} the positive and negative class, respectively. Further, we use the following abbreviations for empirical quantities: P (\# positive samples), N (\# negative samples), TP (\# true positives), TN (\# true negatives), FP (\# false positives), FN (\# false negatives). \describe{ \item{\code{acc}:}{Accuracy. \eqn{P(\hat{Y}=Y)}{P(Yhat = Y)}. Estimated as: \eqn{\frac{TP+TN}{P+N}}{(TP+TN)/(P+N)}.} \item{\code{err}:}{Error rate. \eqn{P(\hat{Y}\ne Y)}{P(Yhat != Y)}. Estimated as: \eqn{\frac{FP+FN}{P+N}}{(FP+FN)/(P+N)}.} \item{\code{fpr}:}{False positive rate. \eqn{P(\hat{Y}=\oplus | Y = \ominus)}{P(Yhat = + | Y = -)}. Estimated as: \eqn{\frac{FP}{N}}{FP/N}.} \item{\code{fall}:}{Fallout. Same as \code{fpr}.} \item{\code{tpr}:}{True positive rate. \eqn{P(\hat{Y}=\oplus|Y=\oplus)}{P(Yhat = + | Y = +)}. Estimated as: \eqn{\frac{TP}{P}}{TP/P}.} \item{\code{rec}:}{Recall. Same as \code{tpr}.} \item{\code{sens}:}{Sensitivity. Same as \code{tpr}.} \item{\code{fnr}:}{False negative rate. \eqn{P(\hat{Y}=\ominus|Y=\oplus)}{P(Yhat = - | Y = +)}. Estimated as: \eqn{\frac{FN}{P}}{FN/P}.} \item{\code{miss}:}{Miss. Same as \code{fnr}.} \item{\code{tnr}:}{True negative rate. \eqn{P(\hat{Y} = \ominus|Y=\ominus)}{P(Yhat = - | Y = -)}.} \item{\code{spec}:}{Specificity. Same as \code{tnr}.} \item{\code{ppv}:}{Positive predictive value. \eqn{P(Y=\oplus|\hat{Y}=\oplus)}{P(Y = + | Yhat = +)}. Estimated as: \eqn{\frac{TP}{TP+FP}}{TP/(TP+FP)}.} \item{\code{prec}:}{Precision. Same as \code{ppv}.} \item{\code{npv}:}{Negative predictive value. \eqn{P(Y=\ominus|\hat{Y}=\ominus)}{P(Y = - | Yhat = -)}. Estimated as: \eqn{\frac{TN}{TN+FN}}{TN/(TN+FN)}.} \item{\code{pcfall}:}{Prediction-conditioned fallout. \eqn{P(Y=\ominus|\hat{Y}=\oplus)}{P(Y = - | Yhat = +)}. Estimated as: \eqn{\frac{FP}{TP+FP}}{FP/(TP+FP)}.} \item{\code{pcmiss}:}{Prediction-conditioned miss. \eqn{P(Y=\oplus|\hat{Y}=\ominus)}{P(Y = + | Yhat = -)}. Estimated as: \eqn{\frac{FN}{TN+FN}}{FN/(TN+FN)}.} \item{\code{rpp}:}{Rate of positive predictions. \eqn{P( \hat{Y} = \oplus)}{P(Yhat = +)}. Estimated as: (TP+FP)/(TP+FP+TN+FN).} \item{\code{rnp}:}{Rate of negative predictions. \eqn{P( \hat{Y} = \ominus)}{P(Yhat = -)}. Estimated as: (TN+FN)/(TP+FP+TN+FN).} \item{\code{phi}:}{Phi correlation coefficient. \eqn{\frac{TP \cdot TN - FP \cdot FN}{\sqrt{ (TP+FN) \cdot (TN+FP) \cdot (TP+FP) \cdot (TN+FN)}}}{(TP*TN - FP*FN)/(sqrt((TP+FN)*(TN+FP)*(TP+FP)*(TN+FN)))}. Yields a number between -1 and 1, with 1 indicating a perfect prediction, 0 indicating a random prediction. Values below 0 indicate a worse than random prediction.} \item{\code{mat}:}{Matthews correlation coefficient. Same as \code{phi}.} \item{\code{mi}:}{Mutual information. \eqn{I(\hat{Y},Y) := H(Y) - H(Y|\hat{Y})}{I(Yhat, Y) := H(Y) - H(Y | Yhat)}, where H is the (conditional) entropy. Entropies are estimated naively (no bias correction).} \item{\code{chisq}:}{Chi square test statistic. \code{?chisq.test} for details. Note that R might raise a warning if the sample size is too small.} \item{\code{odds}:}{Odds ratio. \eqn{\frac{TP \cdot TN}{FN \cdot FP}}{(TP*TN)/(FN*FP)}. Note that odds ratio produces Inf or NA values for all cutoffs corresponding to FN=0 or FP=0. This can substantially decrease the plotted cutoff region.} \item{\code{lift}:}{Lift value. \eqn{\frac{P(\hat{Y}=\oplus|Y=\oplus)}{P(\hat{Y}=\oplus)}}{P(Yhat = + | Y = +)/P(Yhat = +)}.} \item{\code{f}:}{Precision-recall F measure (van Rijsbergen, 1979). Weighted harmonic mean of precision (P) and recall (R). \eqn{F = \frac{1}{\alpha \frac{1}{P} + (1-\alpha)\frac{1}{R}}}{F = 1/ (alpha*1/P + (1-alpha)*1/R)}. If \eqn{\alpha=\frac{1}{2}}{alpha=1/2}, the mean is balanced. A frequent equivalent formulation is \eqn{F = \frac{(\beta^2+1) \cdot P \cdot R}{R + \beta^2 \cdot P}}{F = (beta^2+1) * P * R / (R + beta^2 * P)}. In this formulation, the mean is balanced if \eqn{\beta=1}{beta=1}. Currently, ROCR only accepts the alpha version as input (e.g. \eqn{\alpha=0.5}{alpha=0.5}). If no value for alpha is given, the mean will be balanced by default.} \item{\code{rch}:}{ROC convex hull. A ROC (=\code{tpr} vs \code{fpr}) curve with concavities (which represent suboptimal choices of cutoff) removed (Fawcett 2001). Since the result is already a parametric performance curve, it cannot be used in combination with other measures.} \item{\code{auc}:}{Area under the ROC curve. This is equal to the value of the Wilcoxon-Mann-Whitney test statistic and also the probability that the classifier will score are randomly drawn positive sample higher than a randomly drawn negative sample. Since the output of \code{auc} is cutoff-independent, this measure cannot be combined with other measures into a parametric curve. The partial area under the ROC curve up to a given false positive rate can be calculated by passing the optional parameter \code{fpr.stop=0.5} (or any other value between 0 and 1) to \code{performance}.} \item{\code{aucpr}:}{Area under the Precision/Recall curve. Since the output of \code{aucpr} is cutoff-independent, this measure cannot be combined with other measures into a parametric curve.} \item{\code{prbe}:}{Precision-recall break-even point. The cutoff(s) where precision and recall are equal. At this point, positive and negative predictions are made at the same rate as their prevalence in the data. Since the output of \code{prbe} is just a cutoff-independent scalar, this measure cannot be combined with other measures into a parametric curve.} \item{\code{cal}:}{Calibration error. The calibration error is the absolute difference between predicted confidence and actual reliability. This error is estimated at all cutoffs by sliding a window across the range of possible cutoffs. The default window size of 100 can be adjusted by passing the optional parameter \code{window.size=200} to \code{performance}. E.g., if for several positive samples the output of the classifier is around 0.75, you might expect from a well-calibrated classifier that the fraction of them which is correctly predicted as positive is also around 0.75. In a well-calibrated classifier, the probabilistic confidence estimates are realistic. Only for use with probabilistic output (i.e. scores between 0 and 1).} \item{\code{mxe}:}{Mean cross-entropy. Only for use with probabilistic output. \eqn{MXE :=-\frac{1}{P+N}( \sum_{y_i=\oplus} ln(\hat{y}_i) + \sum_{y_i=\ominus} ln(1-\hat{y}_i))}{MXE := - 1/(P+N) \sum_{y_i=+} ln(yhat_i) + \sum_{y_i=-} ln(1-yhat_i)}. Since the output of \code{mxe} is just a cutoff-independent scalar, this measure cannot be combined with other measures into a parametric curve.} \item{\code{rmse}:}{Root-mean-squared error. Only for use with numerical class labels. \eqn{RMSE:=\sqrt{\frac{1}{P+N}\sum_i (y_i - \hat{y}_i)^2}}{RMSE := sqrt(1/(P+N) \sum_i (y_i - yhat_i)^2)}. Since the output of \code{rmse} is just a cutoff-independent scalar, this measure cannot be combined with other measures into a parametric curve.} \item{\code{sar}:}{Score combinining performance measures of different characteristics, in the attempt of creating a more "robust" measure (cf. Caruana R., ROCAI2004): SAR = 1/3 * ( Accuracy + Area under the ROC curve + Root mean-squared error ).} \item{\code{ecost}:}{Expected cost. For details on cost curves, cf. Drummond&Holte 2000,2004. \code{ecost} has an obligatory x axis, the so-called 'probability-cost function'; thus it cannot be combined with other measures. While using \code{ecost} one is interested in the lower envelope of a set of lines, it might be instructive to plot the whole set of lines in addition to the lower envelope. An example is given in \code{demo(ROCR)}.} \item{\code{cost}:}{Cost of a classifier when class-conditional misclassification costs are explicitly given. Accepts the optional parameters \code{cost.fp} and \code{cost.fn}, by which the costs for false positives and negatives can be adjusted, respectively. By default, both are set to 1.} } } \note{ Here is how to call \code{performance()} to create some standard evaluation plots: \describe{ \item{ROC curves:}{measure="tpr", x.measure="fpr".} \item{Precision/recall graphs:}{measure="prec", x.measure="rec".} \item{Sensitivity/specificity plots:}{measure="sens", x.measure="spec".} \item{Lift charts:}{measure="lift", x.measure="rpp".} } } \examples{ # computing a simple ROC curve (x-axis: fpr, y-axis: tpr) library(ROCR) data(ROCR.simple) pred <- prediction( ROCR.simple$predictions, ROCR.simple$labels) pred perf <- performance(pred,"tpr","fpr") perf plot(perf) # precision/recall curve (x-axis: recall, y-axis: precision) perf <- performance(pred, "prec", "rec") perf plot(perf) # sensitivity/specificity curve (x-axis: specificity, # y-axis: sensitivity) perf <- performance(pred, "sens", "spec") perf plot(perf) } \references{ A detailed list of references can be found on the ROCR homepage at \url{http://rocr.bioinf.mpi-sb.mpg.de}. } \seealso{ \code{\link{prediction}}, \code{\link{prediction-class}}, \code{\link{performance-class}}, \code{\link{plot.performance}} } \author{ Tobias Sing \email{tobias.sing@gmail.com}, Oliver Sander \email{osander@gmail.com} } ROCR/man/plot-methods.Rd0000644000176200001440000001454513644317760014524 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/zzz.R \name{plot-methods} \alias{plot-methods} \alias{plot,performance,missing-method} \alias{plot.performance} \title{Plot method for performance objects} \usage{ \S4method{plot}{performance,missing}( x, y, ..., avg = "none", spread.estimate = "none", spread.scale = 1, show.spread.at = c(), colorize = FALSE, colorize.palette = rev(rainbow(256, start = 0, end = 4/6)), colorkey = colorize, colorkey.relwidth = 0.25, colorkey.pos = "right", print.cutoffs.at = c(), cutoff.label.function = function(x) { round(x, 2) }, downsampling = 0, add = FALSE ) \method{plot}{performance}(...) } \arguments{ \item{x}{an object of class \code{performance}} \item{y}{not used} \item{...}{Optional graphical parameters to adjust different components of the performance plot. Parameters are directed to their target component by prefixing them with the name of the component (\code{component.parameter}, e.g. \code{text.cex}). The following components are available: \code{xaxis}, \code{yaxis}, \code{coloraxis}, \code{box} (around the plotting region), \code{points}, \code{text}, \code{plotCI} (error bars), \code{boxplot}. The names of these components are influenced by the R functions that are used to create them. Thus, \code{par(component)} can be used to see which parameters are available for a given component (with the expection of the three axes; use \code{par(axis)} here). To adjust the canvas or the performance curve(s), the standard \code{plot} parameters can be used without any prefix.} \item{avg}{If the performance object describes several curves (from cross-validation runs or bootstrap evaluations of one particular method), the curves from each of the runs can be averaged. Allowed values are \code{none} (plot all curves separately), \code{horizontal} (horizontal averaging), \code{vertical} (vertical averaging), and \code{threshold} (threshold (=cutoff) averaging). Note that while threshold averaging is always feasible, vertical and horizontal averaging are not well-defined if the graph cannot be represented as a function x->y and y->x, respectively.} \item{spread.estimate}{When curve averaging is enabled, the variation around the average curve can be visualized as standard error bars (\code{stderror}), standard deviation bars (\code{stddev}), or by using box plots (\code{boxplot}). Note that the function \code{plotCI}, which is used internally by ROCR to draw error bars, might raise a warning if the spread of the curves at certain positions is 0.} \item{spread.scale}{For \code{stderror} or \code{stddev}, this is a scalar factor to be multiplied with the length of the standard error/deviation bar. For example, under normal assumptions, \code{spread.scale=2} can be used to get approximate 95\% confidence intervals.} \item{show.spread.at}{For vertical averaging, this vector determines the x positions for which the spread estimates should be visualized. In contrast, for horizontal and threshold averaging, the y positions and cutoffs are determined, respectively. By default, spread estimates are shown at 11 equally spaced positions.} \item{colorize}{This logical determines whether the curve(s) should be colorized according to cutoff.} \item{colorize.palette}{If curve colorizing is enabled, this determines the color palette onto which the cutoff range is mapped.} \item{colorkey}{If true, a color key is drawn into the 4\% border region (default of \code{par(xaxs)} and \code{par(yaxs)}) of the plot. The color key visualizes the mapping from cutoffs to colors.} \item{colorkey.relwidth}{Scalar between 0 and 1 that determines the fraction of the 4\% border region that is occupied by the colorkey.} \item{colorkey.pos}{Determines if the colorkey is drawn vertically at the \code{right} side, or horizontally at the \code{top} of the plot.} \item{print.cutoffs.at}{This vector specifies the cutoffs which should be printed as text along the curve at the corresponding curve positions.} \item{cutoff.label.function}{By default, cutoff annotations along the curve or at the color key are rounded to two decimal places before printing. Using a custom \code{cutoff.label.function}, any other transformation can be performed on the cutoffs instead (e.g. rounding with different precision or taking the logarithm).} \item{downsampling}{ROCR can efficiently compute most performance measures even for data sets with millions of elements. However, plotting of large data sets can be slow and lead to PS/PDF documents of considerable size. In that case, performance curves that are indistinguishable from the original can be obtained by using only a fraction of the computed performance values. Values for downsampling between 0 and 1 indicate the fraction of the original data set size to which the performance object should be downsampled, integers above 1 are interpreted as the actual number of performance values to which the curve(s) should be downsampled.} \item{add}{If \code{TRUE}, the curve(s) is/are added to an already existing plot; otherwise a new plot is drawn.} } \description{ This is the method to plot all objects of class performance. } \examples{ # plotting a ROC curve: library(ROCR) data(ROCR.simple) pred <- prediction( ROCR.simple$predictions, ROCR.simple$labels ) pred perf <- performance( pred, "tpr", "fpr" ) perf plot( perf ) # To entertain your children, make your plots nicer # using ROCR's flexible parameter passing mechanisms # (much cheaper than a finger painting set) par(bg="lightblue", mai=c(1.2,1.5,1,1)) plot(perf, main="ROCR fingerpainting toolkit", colorize=TRUE, xlab="Mary's axis", ylab="", box.lty=7, box.lwd=5, box.col="gold", lwd=17, colorkey.relwidth=0.5, xaxis.cex.axis=2, xaxis.col='blue', xaxis.col.axis="blue", yaxis.col='green', yaxis.cex.axis=2, yaxis.at=c(0,0.5,0.8,0.85,0.9,1), yaxis.las=1, xaxis.lwd=2, yaxis.lwd=3, yaxis.col.axis="orange", cex.lab=2, cex.main=2) } \references{ A detailed list of references can be found on the ROCR homepage at \url{http://rocr.bioinf.mpi-sb.mpg.de}. } \seealso{ \code{\link{prediction}}, \code{\link{performance}}, \code{\link{prediction-class}}, \code{\link{performance-class}} } \author{ Tobias Sing \email{tobias.sing@gmail.com}, Oliver Sander \email{osander@gmail.com} } ROCR/DESCRIPTION0000644000176200001440000000452413653304235012536 0ustar liggesusersPackage: ROCR Authors@R: c(person("Tobias","Sing", email = "tobias.sing@gmail.com",role="aut"), person("Oliver","Sander", email = "osander@gmail.com",role="aut"), person("Niko","Beerenwinkel", role="aut"), person("Thomas","Lengauer", role="aut"), person("Thomas","Unterthiner", role="ctb"), person("Felix G.M.","Ernst", email = "felix.gm.ernst@outlook.com",role="cre", comment = c(ORCID = "0000-0001-5064-0928"))) Version: 1.0-11 Date: 2020-05-01 Title: Visualizing the Performance of Scoring Classifiers Description: ROC graphs, sensitivity/specificity curves, lift charts, and precision/recall plots are popular examples of trade-off visualizations for specific pairs of performance measures. ROCR is a flexible tool for creating cutoff-parameterized 2D performance curves by freely combining two from over 25 performance measures (new performance measures can be added using a standard interface). Curves from different cross-validation or bootstrapping runs can be averaged by different methods, and standard deviations, standard errors or box plots can be used to visualize the variability across the runs. The parameterization can be visualized by printing cutoff values at the corresponding curve positions, or by coloring the curve according to cutoff. All components of a performance plot can be quickly adjusted using a flexible parameter dispatching mechanism. Despite its flexibility, ROCR is easy to use, with only three commands and reasonable default values for all optional parameters. Encoding: UTF-8 License: GPL (>= 2) NeedsCompilation: no Depends: R (>= 3.6) Imports: methods, graphics, grDevices, gplots, stats Suggests: testthat, knitr, rmarkdown URL: http://ipa-tys.github.io/ROCR/ BugReports: https://github.com/ipa-tys/ROCR/issues RoxygenNote: 7.1.0 VignetteBuilder: knitr Packaged: 2020-05-01 11:43:23 UTC; flixr Author: Tobias Sing [aut], Oliver Sander [aut], Niko Beerenwinkel [aut], Thomas Lengauer [aut], Thomas Unterthiner [ctb], Felix G.M. Ernst [cre] () Maintainer: Felix G.M. Ernst Repository: CRAN Date/Publication: 2020-05-02 14:50:05 UTC ROCR/build/0000755000176200001440000000000013653005532012120 5ustar liggesusersROCR/build/vignette.rds0000644000176200001440000000027313653005532014461 0ustar liggesusersb```b`@YH394Gs^Pn 8 HM6$7M ba(Dd *ּb4.y) 3Gwwjey~L62sRad9.nP&c0Gq?gQ~Pmݣ9JI,IK+ROCR/tests/0000755000176200001440000000000013644317760012174 5ustar liggesusersROCR/tests/testthat/0000755000176200001440000000000013653304235014025 5ustar liggesusersROCR/tests/testthat/test-plot.r0000644000176200001440000003051513653001011016131 0ustar liggesusers context("plot") test_that("plot:",{ some.predictions <- c(0.02495517, 0.92535646, 0.86251887, 0.80946685, 0.70922858, 0.69762824, 0.50604485, 0.25446810, 0.10837728, 0.07250349) some.labels <- c(0,1,1,0,1,1,0,1,0,0) .get.performance <- function(pred) { tpr <- performance(pred, "tpr") fpr <- performance(pred, "fpr") acc <- performance(pred, "acc") err <- performance(pred, "err") rec <- performance(pred, "rec") sens<- performance(pred, "sens") fnr <- performance(pred, "fnr") tnr <- performance(pred, "tnr") spec<- performance(pred, "spec") ppv <- performance(pred, "ppv") prec<- performance(pred, "prec") npv <- performance(pred, "npv") fall<- performance(pred, "fall") miss<- performance(pred, "miss") pcfall <- performance(pred, "pcfall") pcmiss <- performance(pred, "pcmiss") rpp <- performance(pred, "rpp") rnp <- performance(pred, "rnp") auc <- performance(pred, "auc") prbe<- performance(pred, "prbe") rch <- performance(pred, "rch") mxe <- performance(pred, "mxe") rmse<- performance(pred, "rmse") phi <- performance(pred, "phi") mat <- performance(pred, "mat") mi <- performance(pred, "mi") chisq<- performance(pred, "chisq") odds<- performance(pred, "odds") lift<- performance(pred, "lift") f <- performance(pred, "f") sar <- performance(pred,"sar") ecost <- performance(pred, "ecost") cost <- performance(pred, "cost") return(list(tpr=tpr, fpr=fpr, acc=acc, err=err, rec=rec, sens=sens, fnr=fnr, tnr=tnr, spec=spec, ppv=ppv, prec=prec, npv=npv, fall=fall, miss=miss, pcfall=pcfall, pcmiss=pcmiss, rpp=rpp, rnp=rnp, auc=auc, prbe=prbe, rch=rch, mxe=mxe, rmse=rmse, phi=phi, mat=mat, mi=mi, chisq=chisq, odds=odds, lift=lift, f=f, sar=sar, ecost=ecost, cost=cost)) } pred <- prediction(some.predictions, some.labels) measures <- expect_warning(.get.performance(pred), "Chi-squared approximation may be incorrect") actual1 <- measures[[1]] expect_error(plot(measures[[1]], colorize = TRUE), "Threshold coloring or labeling cannot be performed") for(i in seq_along(measures)){ if(names(measures[i]) %in% c("auc","mxe","rmse")){ expect_error(plot(measures[[i]])) } } data(ROCR.hiv) pp <- ROCR.hiv$hiv.svm$predictions ll <- ROCR.hiv$hiv.svm$labels pred <- prediction(pp, ll) expect_error(ROCR:::.combine.performance.objects(actual1,performance(pred, "fpr")), "Only performance objects with identical number of cross-validation") # plot failures perf <- performance(pred, "tpr", "fpr") perf@x.values <- list(c(1)) expect_error(plot(perf), "Performance object cannot be plotted") perf <- performance(pred, "tpr", "fpr") perf@y.values <- list(c(1)) expect_error(plot(perf), "Performance object cannot be plotted") perf <- performance(pred, "tpr", "fpr") perf@alpha.values <- list() expect_null({ plot <- plot(perf) # no error }) expect_error(plot(perf,colorize = TRUE), "Threshold coloring or labeling cannot be performed") expect_error(plot(perf,print.cutoffs.at = 0.5), "Threshold coloring or labeling cannot be performed") perf <- performance(pred, "tpr", "fpr") expect_null({ plot <- plot(perf,avg = "horizontal") # no error }) expect_error(plot(perf,avg = "horizontal", colorize=TRUE), "Threshold coloring or labeling is only") expect_error(plot(perf,avg = "horizontal", print.cutoffs.at=0.5), "Threshold coloring or labeling is only") # perf <- performance(pred, "tpr", "fpr") expect_null({ plot(perf, avg= "threshold", colorize=TRUE, lwd= 3, main= "With ROCR you can produce standard plots like ROC curves ...") plot(perf, lty=3, col="grey78", add=TRUE) }) expect_null({ plot.performance(perf, avg= "threshold", colorize=TRUE, lwd= 3, main= "With ROCR you can produce standard plots like ROC curves ...") plot.performance(perf, lty=3, col="grey78", add=TRUE) }) perf <- performance(pred, "prec", "rec") expect_null({ plot(perf, avg= "threshold", colorize=TRUE, lwd= 3, main= "... Precision/Recall graphs ...") plot(perf, lty=3, col="grey78", add=TRUE) }) perf <- performance(pred, "sens", "spec") expect_null({ plot(perf, avg= "threshold", colorize=TRUE, lwd= 3, main="... Sensitivity/Specificity plots ...") plot(perf, lty=3, col="grey78", add=TRUE) }) perf <- performance(pred, "lift", "rpp") expect_null({ plot(perf, avg= "threshold", colorize=TRUE, lwd= 3, main= "... and Lift charts.") plot(perf, lty=3, col="grey78", add=TRUE) }) perf <- performance(pred, "tpr", "fpr") expect_null({ plot(perf, avg= "threshold", colorize=TRUE, lwd= 3, main= "With ROCR you can produce standard plots like ROC curves ...", downsampling = 0.5) }) expect_null({ plot(perf, avg= "threshold", colorize=TRUE, lwd= 3, main= "With ROCR you can produce standard plots like ROC curves ...", downsampling = 0.9) }) expect_null({ plot(perf, avg= "threshold", colorize=TRUE, lwd= 3, main= "With ROCR you can produce standard plots like ROC curves ...", downsampling = 1) }) data(ROCR.xval) pp <- ROCR.xval$predictions ll <- ROCR.xval$labels pred <- prediction(pp,ll) perf <- performance(pred,'tpr','fpr') expect_null({ plot(perf, colorize=TRUE, lwd=2, main='ROC curves from 10-fold cross-validation') }) expect_null({ plot(perf, avg='vertical', spread.estimate='stderror',lwd=3, main='Vertical averaging + 1 standard error',col='blue') }) expect_null({ plot(perf, avg='horizontal', spread.estimate='stderror',lwd=3, main='Horizontal averaging + boxplots',col='blue') }) expect_null({ plot(perf, avg='horizontal', spread.estimate='boxplot',lwd=3, main='Horizontal averaging + boxplots',col='blue') }) expect_null({ plot(perf, avg='vertical', spread.estimate='boxplot',lwd=3, main='Horizontal averaging + boxplots',col='blue') }) expect_null({ plot(perf, avg='threshold', spread.estimate='stddev',lwd=2, main='Threshold averaging + 1 standard deviation',colorize=TRUE) }) expect_null({ plot(perf, avg='threshold', spread.estimate='boxplot',lwd=2, main='Threshold averaging + 1 standard deviation',colorize=TRUE) }) expect_null({ plot(perf, avg='threshold', spread.estimate='boxplot',lwd=2, main='Threshold averaging + 1 standard deviation',colorize=TRUE, colorkey.pos="top") }) expect_null({ plot(perf, print.cutoffs.at=seq(0,1,by=0.2), text.cex=0.8, text.y=lapply(as.list(seq(0,0.5,by=0.05)), function(x) { rep(x,length(perf@x.values[[1]])) } ), col= as.list(terrain.colors(10)), text.col= as.list(terrain.colors(10)), points.col= as.list(terrain.colors(10)), main= "Cutoff stability") }) ############################################################################ # removed because vdiffr is not available on mac ############################################################################ # vdiffr # skip_on_ci() # skip_on_os("mac") # skip_if_not_installed("vdiffr") # for(i in seq_along(measures)){ # if(!(names(measures[i]) %in% c("auc","mxe","rmse"))){ # vdiffr::expect_doppelganger(names(measures[i]), plot(measures[[i]])) # } else { # expect_error(plot(measures[[i]])) # } # } # # data(ROCR.hiv) # pp <- ROCR.hiv$hiv.svm$predictions # ll <- ROCR.hiv$hiv.svm$labels # pred <- prediction(pp, ll) # expect_error(ROCR:::.combine.performance.objects(actual1,performance(pred, "fpr")), # "Only performance objects with identical number of cross-validation") # perf <- performance(pred, "tpr", "fpr") # vdiffr::expect_doppelganger("ROC-curve",{ # plot(perf, avg= "threshold", colorize=TRUE, lwd= 3, # main= "With ROCR you can produce standard plots like ROC curves ...") # plot(perf, lty=3, col="grey78", add=TRUE) # }) # perf <- performance(pred, "prec", "rec") # vdiffr::expect_doppelganger("Precision-Recall-graph",{ # plot(perf, avg= "threshold", colorize=TRUE, lwd= 3, # main= "... Precision/Recall graphs ...") # plot(perf, lty=3, col="grey78", add=TRUE) # }) # perf <- performance(pred, "sens", "spec") # vdiffr::expect_doppelganger("Sensitivity-Specificity-plots",{ # plot(perf, avg= "threshold", colorize=TRUE, lwd= 3, # main="... Sensitivity/Specificity plots ...") # plot(perf, lty=3, col="grey78", add=TRUE) # }) # perf <- performance(pred, "lift", "rpp") # vdiffr::expect_doppelganger("lift-chart",{ # plot(perf, avg= "threshold", colorize=TRUE, lwd= 3, # main= "... and Lift charts.") # plot(perf, lty=3, col="grey78", add=TRUE) # }) # # perf <- performance(pred, "tpr", "fpr") # vdiffr::expect_doppelganger("ROC-curve-downsampling1",{ # plot(perf, avg= "threshold", colorize=TRUE, lwd= 3, # main= "With ROCR you can produce standard plots like ROC curves ...", # downsampling = 0.5) # }) # vdiffr::expect_doppelganger("ROC-curve-downsampling2",{ # plot(perf, avg= "threshold", colorize=TRUE, lwd= 3, # main= "With ROCR you can produce standard plots like ROC curves ...", # downsampling = 0.9) # }) # vdiffr::expect_doppelganger("ROC-curve-downsampling3",{ # plot(perf, avg= "threshold", colorize=TRUE, lwd= 3, # main= "With ROCR you can produce standard plots like ROC curves ...", # downsampling = 1) # }) # expect_error(plot(perf, avg= "threshold", colorize=TRUE, lwd= 3, # main= "With ROCR you can produce standard plots like ROC curves ...", # downsampling = 1.1), # "'from' must be a finite number") # dev.off() # # data(ROCR.xval) # pp <- ROCR.xval$predictions # ll <- ROCR.xval$labels # pred <- prediction(pp,ll) # perf <- performance(pred,'tpr','fpr') # # vdiffr::expect_doppelganger("ROC-cross-valid",{ # plot(perf, colorize=TRUE, lwd=2, # main='ROC curves from 10-fold cross-validation') # }) # vdiffr::expect_doppelganger("ROC-vertical-avg",{ # plot(perf, avg='vertical', spread.estimate='stderror',lwd=3, # main='Vertical averaging + 1 standard error',col='blue') # }) # vdiffr::expect_doppelganger("ROC-horizontal-avg",{ # plot(perf, avg='horizontal', spread.estimate='boxplot',lwd=3, # main='Horizontal averaging + boxplots',col='blue') # }) # vdiffr::expect_doppelganger("ROC-vertical-avg-box",{ # plot(perf, avg='vertical', spread.estimate='boxplot',lwd=3, # main='Horizontal averaging + boxplots',col='blue') # }) # vdiffr::expect_doppelganger("ROC-threshold-avg",{ # plot(perf, avg='threshold', spread.estimate='stddev', # lwd=2, # main='Threshold averaging + 1 standard deviation',colorize=TRUE) # }) }) ROCR/tests/testthat/test-consistency.r0000644000176200001440000004526213644317760017546 0ustar liggesuserscontext("consistency") test_that("consistency:",{ .get.performance.measures <- function(pred, measures) { ans <- list() for (measure in measures) { ## need to enclose y.values into a list to avoid flattening perf <- performance(pred, measure) .check.performance.object( perf ) ans <- c(ans, list(perf@y.values)) } names(ans) <- measures ans } .check.consistency <- function(measures) { ## check entries of contingency table for consistency for (measure in c("acc", "err", "fnr", "tpr", "fpr", "tnr", "pcfall", "prec", "npv", "pcmiss",'rpp','rnp')) { if (!measure %in% names(measures)) { stop(paste("Performance measure", measure, "not in argument list.")) } } for (i in 1:length(measures$acc)) { finite.bool <- is.finite(measures$acc[[i]]) & is.finite(measures$err[[i]]) expect_equal(measures$acc[[i]][finite.bool] + measures$err[[i]][finite.bool], rep(1,length(measures$acc[[i]]))[finite.bool]) finite.bool <- is.finite(measures$fnr[[i]]) & is.finite(measures$tpr[[i]]) expect_equal(measures$fnr[[i]][finite.bool] + measures$tpr[[i]][finite.bool], rep(1,length(measures$fnr[[i]]))[finite.bool]) finite.bool <- is.finite(measures$fpr[[i]]) & is.finite(measures$tnr[[i]]) expect_equal(measures$fpr[[i]][finite.bool] + measures$tnr[[i]][finite.bool], rep(1,length(measures$fpr[[i]]))[finite.bool]) finite.bool <- is.finite(measures$prec[[i]]) & is.finite(measures$pcfall[[i]]) expect_equal(measures$prec[[i]][finite.bool] + measures$pcfall[[i]][finite.bool], rep(1,length(measures$acc[[i]]))[finite.bool]) finite.bool <- is.finite(measures$npv[[i]]) & is.finite(measures$pcmiss[[i]]) expect_equal(measures$npv[[i]][finite.bool] + measures$pcmiss[[i]][finite.bool], rep(1,length(measures$acc[[i]]))[finite.bool]) expect_equal(measures$rpp[[i]] + measures$rnp[[i]], rep(1, length(measures$rpp[[i]]))) } } ############################################################ # test length of performance measures .check.performance.object <- function(perf) { ylen <- length(perf@y.values) xlen <- length(perf@x.values) alphalen <- length(perf@alpha.values) expect_equal( (xlen==0 || xlen==ylen) && (alphalen==0 || (alphalen==xlen && alphalen==ylen)), T ) if (xlen==ylen) { for (i in 1:ylen) expect_equal( length(perf@x.values[[i]]), length(perf@y.values[[i]]) ) } if (alphalen==ylen) { for (i in 1:ylen) expect_equal( length(perf@alpha.values[[i]]), length(perf@y.values[[i]]) ) } } .check.prediction.object <- function( pred) { # 1. all entries in prediction object must have equals number of cross-validation runs lenvec <- c(length(pred@predictions), length(pred@labels), length(pred@cutoffs), length(pred@fp), length(pred@tp), length(pred@fn), length(pred@tn), length(pred@n.pos), length(pred@n.neg), length(pred@n.pos.pred), length(pred@n.neg.pred)) expect_equal( length(unique(lenvec)), 1) # 2. inside: xval runs: for (i in 1:length(pred@predictions)) { expect_equal( length(pred@predictions[[i]]), length(pred@labels[[i]])) lenvec <- c(length(pred@cutoffs[[i]]), length(pred@fp[[i]]), length(pred@tp[[i]]), length(pred@fn[[i]]), length(pred@tn[[i]]), length(pred@n.pos.pred[[i]]), length(pred@n.neg.pred[[i]])) expect_equal( length(unique(lenvec)), 1) expect_equal( unique(lenvec), length(unique(pred@predictions[[i]]))+1 ) } # 3. cutoffs sorted in descending order? for (i in 1:length(pred@predictions)) { expect_equal( sort(pred@cutoffs[[i]], decreasing=TRUE ), pred@cutoffs[[i]] ) } # 4. check 2x2 table for consistency with marginal sums for (i in 1:length(pred@predictions)) { expect_equal( pred@tp[[i]] + pred@fp[[i]], pred@n.pos.pred[[i]] ) expect_equal( pred@fn[[i]] + pred@tn[[i]], pred@n.neg.pred[[i]] ) expect_equal( pred@tp[[i]] + pred@fn[[i]], rep( pred@n.pos[[i]], length(pred@tp[[i]])) ) expect_equal( pred@fp[[i]] + pred@tn[[i]], rep( pred@n.neg[[i]], length(pred@tp[[i]])) ) expect_equal(pred@n.pos.pred[[i]] + pred@n.neg.pred[[i]], rep( pred@n.pos[[i]] + pred@n.neg[[i]], length(pred@n.pos.pred[[i]])) ) expect_equal(pred@n.pos[[i]] + pred@n.neg[[i]], length(pred@labels[[i]])) } } # .mock.prediction <- function( n.predictions, error.rate ) { if ( length(n.predictions) > 1 && length(error.rate)==1) { error.rate <- rep(error.rate, length(n.predictions) ) } if (length(n.predictions)>1) { predictions <- list() labels <- list() } else { predictions <- c() labels <- c() } for (i in 1:length(n.predictions)) { current.predictions <- runif( n.predictions[i] ) current.labels <- as.numeric( current.predictions >= 0.5) flip.indices <- sample( n.predictions[i], round( error.rate[i] * n.predictions[i] )) current.labels[ flip.indices ] <- !current.labels[ flip.indices ] # current.labels[ current.labels=="1" ] <- "+" # current.labels[ current.labels=="0" ] <- "-" if (length(n.predictions)>1) { predictions <- c( predictions, list( current.predictions )) labels <- c( labels, list( current.labels )) } } if (length( n.predictions)==1) { predictions <- list(current.predictions) labels <- list(current.labels) } ans <- list(predictions= predictions, labels= labels) # ensure, that random labels have exactly two levels if (any( sapply(labels, function(run) {length(unique(run))}) != rep(2, length(labels)) )) { # print(paste("XXX", labels, str(n.predictions), str(error.rate))) return(.mock.prediction(n.predictions, error.rate)) } else return( ans ) } ############################################################################## # consistency for (i in 1:100) { n.folds <- sample(1:10,1) fold.sizes <- sample(10:100, n.folds, replace=T) error.rates <- runif( n.folds ) pp <- .mock.prediction( fold.sizes, error.rates ) pred <- prediction( pp$predictions, pp$labels ) .check.prediction.object(pred) a <- .get.performance.measures( pred, c('acc','err','fpr','tpr','fnr','tnr','prec','pcfall','npv','pcmiss','rpp','rnp')) .check.consistency( a) } ############################################################################## # test errors crashCases <- list( ## cases that are ok to crash: list(pred= c(0), lab= c(0)), #-> Number of classes is not equal to 2. list(pred= c(1), lab= c(1)), #-> Number of classes is not equal to 2. list(pred= c(0.1, 0.2, 0.5), lab= c(1,1,1)), #-> Number of classes is not equal to 2. list(pred= c(0.1, 0.2, 0.5), lab= c(0,0,0)), #-> Number of classes is not equal to 2. list(pred= c(0.1, 0.2, 0.5), lab= c("a", "a", "a")), #-> Number of classes is not equal to 2. list(pred= c(0.1, 0.2, 0.5), lab= c(T, T, T)), #-> Number of classes is not equal to 2. list(pred= c(0.1, 0.2, 0.5), lab= c(F, F, F)) #-> Number of classes is not equal to 2. ) for (case in crashCases) { # cat(case$pred, " ", case$lab, "\n") expect_error(pred <- prediction(case$pred, case$lab)) #checkException(measures <- .get.performance.measures(pred)) } ############################################################################## ## use consistency checks to validate results on pathological input cases performance.measures <- c('tpr','fpr','acc','err','rec','sens','fnr','tnr','spec', 'ppv','prec','npv','fall','miss','pcfall','pcmiss','rpp','rnp', 'auc','prbe','rch','mxe','rmse','phi','mat','mi','chisq', 'odds','lift','f','sar','ecost','cost') # mxe needs 0,1 labels (warning otherwise), # rmse needs numeric labels (warning otherwise), sar as well pred <- prediction( c(0.1, 0.2, 0.5), c("a", "a", "b")) .check.prediction.object(pred) measures.to.evaluate <- performance.measures[ performance.measures != 'mxe' & performance.measures != 'rmse' & performance.measures != 'sar'] measures <- expect_warning(.get.performance.measures(pred, measures.to.evaluate), "Chi-squared approximation may be incorrect") .check.consistency( measures) pred <- prediction( c(0.1, 0.2, 0.5), c(F, F, T)) .check.prediction.object(pred) measures.to.evaluate <- performance.measures[ performance.measures != 'mxe' & performance.measures != 'rmse' & performance.measures != 'sar'] measures <- expect_warning(.get.performance.measures(pred, measures.to.evaluate), "Chi-squared approximation may be incorrect") .check.consistency( measures) pred <- prediction( c(0.1, 0.2, 0.5), c("1", "1", "0")) .check.prediction.object(pred) measures.to.evaluate <- performance.measures measures <- expect_warning(.get.performance.measures(pred, measures.to.evaluate), "Chi-squared approximation may be incorrect") .check.consistency( measures) pred <- prediction( c(0.1, 0.2, 0.5), c(T, F, F)) .check.prediction.object(pred) measures.to.evaluate <- performance.measures[ performance.measures != 'mxe' & performance.measures != 'rmse' & performance.measures != 'sar' ] measures <- expect_warning(.get.performance.measures(pred, measures.to.evaluate), "Chi-squared approximation may be incorrect") .check.consistency( measures) # prbe cannot be computed, because only one prec/rec pair available. pred <- prediction( c(0,0,0), c(0,1,1)) .check.prediction.object(pred) measures.to.evaluate <- performance.measures[ performance.measures != 'prbe' ] measures <- expect_warning(.get.performance.measures(pred, measures.to.evaluate), "Chi-squared approximation may be incorrect") .check.consistency( measures) pred <- prediction( c(0,0,0), ordered(c(0,0,0), levels=c(0,1))) .check.prediction.object(pred) measures.to.evaluate <- performance.measures[ performance.measures != 'auc' & performance.measures != 'prbe' & performance.measures != 'rch' & performance.measures != 'sar' & performance.measures != 'ecost'] measures <- expect_warning(.get.performance.measures(pred, measures.to.evaluate), "Chi-squared approximation may be incorrect") .check.consistency( measures) pred <- prediction( c(-1,-0.2,-0.6), ordered(c(1,0,1), levels=c(0,1))) .check.prediction.object(pred) measures.to.evaluate <- performance.measures[ performance.measures != 'mxe' ] measures <- expect_warning(.get.performance.measures(pred, measures.to.evaluate), "Chi-squared approximation may be incorrect") .check.consistency( measures) pred <- prediction( c(-1,-0.2,-0.6), c(-1,1,-1)) .check.prediction.object(pred) measures.to.evaluate <- performance.measures[ performance.measures != 'mxe'] measures <- expect_warning(.get.performance.measures(pred, measures.to.evaluate), "Chi-squared approximation may be incorrect") .check.consistency( measures) pred <- prediction( c(-1,-0.2,-0.6), c(3,2,3)) .check.prediction.object(pred) measures.to.evaluate <- performance.measures[ performance.measures != 'mxe'] measures <- expect_warning(.get.performance.measures(pred, measures.to.evaluate), "Chi-squared approximation may be incorrect") .check.consistency( measures) pred <- prediction( c(1), ordered(c("a"),levels=c('a','b'))) .check.prediction.object(pred) measures.to.evaluate <- performance.measures[ performance.measures != 'auc' & performance.measures != 'prbe' & performance.measures != 'rch' & performance.measures != 'mxe' & performance.measures != 'rmse' & performance.measures != 'sar' & performance.measures != 'ecost'] measures <- expect_warning(.get.performance.measures(pred, measures.to.evaluate), "Chi-squared approximation may be incorrect") .check.consistency( measures) ############################################################################## # test measures for consistency on supplied data sets data(ROCR.simple) pred <- prediction(ROCR.simple$predictions, ROCR.simple$labels) .check.prediction.object(pred) measures.to.evaluate <- performance.measures measures <- expect_warning(.get.performance.measures(pred, measures.to.evaluate), "Chi-squared approximation may be incorrect") .check.consistency( measures) data(ROCR.xval) pred <- prediction(ROCR.xval$predictions, ROCR.xval$labels) .check.prediction.object(pred) measures.to.evaluate <- performance.measures measures <- expect_warning(.get.performance.measures(pred, measures.to.evaluate), "Chi-squared approximation may be incorrect") .check.consistency( measures) data(ROCR.hiv) pred <- prediction(ROCR.hiv$hiv.nn$predictions, ROCR.hiv$hiv.nn$labels) .check.prediction.object(pred) measures.to.evaluate <- performance.measures[performance.measures != 'mxe' & performance.measures != 'cal'] measures <- expect_warning(.get.performance.measures(pred, measures.to.evaluate), "Chi-squared approximation may be incorrect") .check.consistency( measures) pred <- prediction(ROCR.hiv$hiv.svm$predictions, ROCR.hiv$hiv.svm$labels) .check.prediction.object(pred) measures.to.evaluate <- performance.measures[performance.measures != 'mxe' & performance.measures != 'cal'] measures <- expect_warning(.get.performance.measures(pred, measures.to.evaluate), "Chi-squared approximation may be incorrect") .check.consistency( measures) skip_on_cran() skip_on_ci() ############################################################################## # Combining measures <- c('tpr','fpr','acc','err','rec','sens','fnr','tnr','spec', 'ppv','prec','npv','fall','miss','pcfall','pcmiss','rpp','rnp', 'phi','mat','mi','chisq','odds','lift') # 'auc','prbe','rch','mxe','rmse','phi','mat','mi','chisq', # 'odds','lift','f','sar','ecost','cost') for (measure1 in measures) { # print(measure1) for (measure2 in measures) { n.folds <- sample(1:2,1) fold.sizes <- sample(10:20, n.folds, replace=T) error.rates <- runif( n.folds ) pp <- .mock.prediction( fold.sizes, error.rates ) pred <- prediction( pp$predictions, pp$labels ) .check.prediction.object(pred) perf1 <- suppressWarnings(performance( pred, measure1 )) perf2 <- suppressWarnings(performance( pred, measure2 )) perf3 <- suppressWarnings(performance( pred, measure2, measure1 )) .check.performance.object(perf1) .check.performance.object(perf2) .check.performance.object(perf3) for (i in 1:n.folds) { #check elements expect_equal(setequal( c( perf1@x.values[[i]], perf2@x.values[[i]]), perf3@alpha.values[[i]] ),T) expect_equal(setequal( perf1@y.values[[i]], perf3@x.values[[i]] ),T) expect_equal(setequal( perf2@y.values[[i]], perf3@y.values[[i]] ),T) #check order ind <- sapply( perf1@x.values[[i]], function(x) { min(which(x==perf3@alpha.values[[i]]))}) expect_equal( unname(perf1@y.values[[i]]), perf3@x.values[[i]][ind] ) expect_equal( unname(perf2@y.values[[i]]), perf3@y.values[[i]][ind] ) } } } ############################################################################## # test datavase combine measures <- c('tpr','fpr','acc','err','rec','sens','fnr','tnr','spec', 'ppv','prec','npv','fall','miss','pcfall','pcmiss','rpp','rnp', 'phi','mat','mi','chisq','odds','lift') #'auc','prbe','rch','mxe','rmse','phi','mat','mi','chisq', #'odds','lift','f','sar','ecost','cost') # print("Database combine test deactivated.") data(ROCR.simple) data(ROCR.xval) data(ROCR.hiv) all.pred <- list(prediction(ROCR.simple$predictions, ROCR.simple$labels), prediction(ROCR.xval$predictions, ROCR.xval$labels), prediction(ROCR.hiv$hiv.nn$predictions, ROCR.hiv$hiv.nn$labels), prediction(ROCR.hiv$hiv.svm$predictions, ROCR.hiv$hiv.svm$labels)) lapply(all.pred, .check.prediction.object) for (pred in all.pred) { for (measure1 in measures) { # print(measure1) for (measure2 in measures) { perf1 <- suppressWarnings(performance( pred, measure1 )) perf2 <- suppressWarnings(performance( pred, measure2 )) perf3 <- suppressWarnings(performance( pred, measure2, measure1 )) .check.performance.object(perf1) .check.performance.object(perf2) .check.performance.object(perf3) for (i in 1:length(pred@labels)) { #check elements expect_equal(setequal( c( perf1@x.values[[i]], perf2@x.values[[i]]), perf3@alpha.values[[i]] ),T) expect_equal(setequal( perf1@y.values[[i]], perf3@x.values[[i]] ),T) expect_equal(setequal( perf2@y.values[[i]], perf3@y.values[[i]] ),T) # check order ind <- sapply( perf1@x.values[[i]], function(x) { min(which(x==perf3@alpha.values[[i]]))}) expect_equal( unname(perf1@y.values[[i]]), perf3@x.values[[i]][ind] ) expect_equal( unname(perf2@y.values[[i]]), perf3@y.values[[i]][ind] ) } } } } }) ROCR/tests/testthat/test-aux.r0000644000176200001440000000367513644317760016004 0ustar liggesuserscontext("aux") test_that("aux:",{ # Farg ll <- list(arg1=c(1,2,3), arg2=c(4,5,6)) expect_equal(.farg(ll, arg3=c(7,8,9)), list(arg1=c(1,2,3), arg2=c(4,5,6), arg3=c(7,8,9))) expect_equal(.farg(ll, arg1=c(1,4,3)), list(arg1=c(1,2,3), arg2=c(4,5,6))) # Garg ll <- list(arg1=list(1,2,3), arg2=list(4,5,6)) expect_equal(.garg(ll, 'arg1'), 1) expect_equal(.garg(ll, 'arg1',2), 2) expect_equal(.garg(ll, 'arg2',3), 6) expect_equal(.garg(ll, 'arg3'), ll$arg3) # Slice ll <- list(arg1=list(c(1,2,3), c(2,3,4), c(3,4,5)), arg2=list('a', 'b', 'c')) expect_equal(.slice.run(ll, 1), list(arg1=c(1,2,3), arg2='a')) expect_equal(.slice.run(ll, 2), list(arg1=c(2,3,4), arg2='b')) expect_equal(.slice.run(ll, 3), list(arg1=c(3,4,5), arg2='c')) ll <- list(arg1=list(c(1,2,3), c(2,3,4), c(3,4,5)), arg2=c('a', 'b', 'c')) expect_equal(.slice.run(ll, 1), list(arg1=c(1,2,3), arg2=c('a', 'b', 'c'))) expect_equal(.slice.run(ll, 2), list(arg1=c(2,3,4), arg2=c('a', 'b', 'c'))) expect_equal(.slice.run(ll, 3), list(arg1=c(3,4,5), arg2=c('a', 'b', 'c'))) # .select.args actual <- ROCR:::.select.args(ll, "arg1") expect_equal(actual,ll["arg1"]) actual <- ROCR:::.select.args(ll, "arg1", complement = TRUE) expect_equal(actual,ll["arg2"]) # .construct.linefunct actual <- ROCR:::.construct.linefunct(1,2,3,4) expect_type(actual, "closure") expect_error(ROCR:::.construct.linefunct(1,2,1,4), "Cannot construct a function from data.") # .intersection.point f <- ROCR:::.construct.linefunct(1,2,3,4) g <- ROCR:::.construct.linefunct(2,3,4,5) actual <- ROCR:::.intersection.point(f,g) expect_equal(actual, c(Inf,Inf)) g <- ROCR:::.construct.linefunct(2,3,1,5) actual <- ROCR:::.intersection.point(f,g) expect_equal(actual, c(2,3)) }) ROCR/tests/testthat/test-simple.r0000644000176200001440000003672113644317760016476 0ustar liggesuserscontext("simple") test_that("simple:",{ some.predictions <- c(0.02495517, 0.92535646, 0.86251887, 0.80946685, 0.70922858, 0.69762824, 0.50604485, 0.25446810, 0.10837728, 0.07250349) some.labels <- c(0,1,1,0,1,1,0,1,0,0) tp.reference <- c(0, 1, 2, 2, 3, 4, 4, 5, 5, 5, 5) fp.reference <- c(0, 0, 0, 1, 1, 1, 2, 2, 3, 4, 5) pp.reference <- c(0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10) np.reference <- c(10, 9, 8, 7, 6, 5, 4, 3, 2, 1, 0) p.reference <- rep(5, 11) n.reference <- rep(5, 11) tn.reference <- n.reference-fp.reference fn.reference <- p.reference-tp.reference # manually calculated reference measures rpp.reference <- c(0,0.1,0.2,0.3,0.4,0.5,0.6,0.7,0.8,0.9,1.0) rnp.reference <- c(1.0, 0.9, 0.8, 0.7, 0.6, 0.5, 0.4, 0.3, 0.2, 0.1, 0.0) tpr.reference <- c(0.0, 0.2, 0.4, 0.4, 0.6, 0.8, 0.8, 1.0, 1.0, 1.0, 1.0) fpr.reference <- c(0.0, 0.0, 0.0, 0.2, 0.2, 0.2, 0.4, 0.4, 0.6, 0.8, 1.0) acc.reference <- c(0.5, 0.6, 0.7, 0.6, 0.7, 0.8, 0.7, 0.8, 0.7, 0.6, 0.5) err.reference <- c(0.5, 0.4, 0.3, 0.4, 0.3, 0.2, 0.3, 0.2, 0.3, 0.4, 0.5) rec.reference <- tpr.reference sens.reference<- tpr.reference fnr.reference <- c(1.0, 0.8, 0.6, 0.6, 0.4, 0.2, 0.2, 0.0, 0.0, 0.0, 0.0) tnr.reference <- c(1.0, 1.0, 1.0, 0.8, 0.8, 0.8, 0.6, 0.6, 0.4, 0.2, 0.0) spec.reference<- tnr.reference ppv.reference <- c(0/0, 1/1, 2/2, 2/3, 3/4, 4/5, 4/6, 5/7, 5/8, 5/9, 5/10) npv.reference <- c(5/10, 5/9, 5/8, 4/7, 4/6, 4/5, 3/4, 3/3, 2/2, 1/1, 0/0) prec.reference<- ppv.reference fall.reference <- fpr.reference miss.reference <- fnr.reference pcfall.reference <- c(0/0, 0/1, 0/2, 1/3, 1/4, 1/5, 2/6, 2/7, 3/8, 4/9, 5/10) pcmiss.reference <- c(5/10, 4/9, 3/8, 3/7, 2/6, 1/5, 1/4, 0/3, 0/2, 0/1, 0/0) auc.reference <- 0.84 aucpr.reference <- 0.8814286 cal.reference <- c() ind <- rev(order(some.predictions)) sorted.predictions <- some.predictions[ind] sorted.labels <- some.labels[ind] for (i in 1:8) { mean.pred <- mean( sorted.predictions[i:(i+2)] ) frac.pos <- sum( sorted.labels[i:(i+2)] ) / 3 cal.reference <- c(cal.reference, abs( mean.pred - frac.pos )) } prbe.reference<- 0.8 prbe.reference.x <- 0.69762824 rch.reference.x <- fpr.reference[c(1,3,6,8,11)] rch.reference.y <- tpr.reference[c(1,3,6,8,11)] mxe.reference <- -(1/length(some.predictions)) * sum(some.labels*log(some.predictions) + (1-some.labels)*log(1-some.predictions)) rmse.reference <- sqrt((1/length(some.predictions)) * sum((some.predictions-some.labels)^2)) phi.reference <- (tp.reference*tn.reference-fp.reference*fn.reference) / sqrt(p.reference*n.reference*pp.reference*np.reference) mat.reference <- phi.reference my.log2 <- function( x ) { ans <- log2(x) ans[ ans==-Inf ] <- 0 ans } mi.reference <- (tn.reference * my.log2( tn.reference / (n.reference*np.reference)) + fn.reference*my.log2(fn.reference/(np.reference*p.reference)) + fp.reference*my.log2(fp.reference/(n.reference*pp.reference)) + tp.reference*my.log2(tp.reference/(p.reference*pp.reference))) / length(some.labels) + log2(length(some.labels)) chisq.reference <- (((pp.reference*p.reference/length(some.predictions)) - tp.reference)^2 / (pp.reference*p.reference/length(some.predictions)) + ((pp.reference*n.reference/length(some.predictions)) - fp.reference)^2 / (pp.reference*n.reference/length(some.predictions)) + ((np.reference*p.reference/length(some.predictions)) - fn.reference)^2 / (np.reference*p.reference/length(some.predictions)) + ((np.reference*n.reference/length(some.predictions)) - tn.reference)^2 / (np.reference*n.reference/length(some.predictions))) odds.reference <- (tp.reference*tn.reference) / (fn.reference*fp.reference) lift.reference <- (tp.reference/p.reference) / (pp.reference/(p.reference+n.reference)) f.reference <- 1 / (0.5 * ((1/prec.reference) + (1/rec.reference))) sar.reference <- 1/3 * (acc.reference + auc.reference + (1-rmse.reference)) cost.reference <- (fpr.reference * n.reference/length(some.labels) * 1 + fnr.reference * p.reference/length(some.labels) * 1) .get.performance.measures <- function(pred) { .get.performance.measure.result <- function(pred, measure){ perf <- performance(pred, measure) show(perf) perf@y.values[[1]] } tpr <- .get.performance.measure.result(pred, "tpr") fpr <- .get.performance.measure.result(pred, "fpr") acc <- .get.performance.measure.result(pred, "acc") err <- .get.performance.measure.result(pred, "err") rec <- .get.performance.measure.result(pred, "rec") sens<- .get.performance.measure.result(pred, "sens") fnr <- .get.performance.measure.result(pred, "fnr") tnr <- .get.performance.measure.result(pred, "tnr") spec<- .get.performance.measure.result(pred, "spec") ppv <- .get.performance.measure.result(pred, "ppv") prec<- .get.performance.measure.result(pred, "prec") npv <- .get.performance.measure.result(pred, "npv") fall<- .get.performance.measure.result(pred, "fall") miss<- .get.performance.measure.result(pred, "miss") pcfall <- .get.performance.measure.result(pred, "pcfall") pcmiss <- .get.performance.measure.result(pred, "pcmiss") rpp <- .get.performance.measure.result(pred, "rpp") rnp <- .get.performance.measure.result(pred, "rnp") auc <- performance(pred, "auc")@y.values[[1]] aucpr <- performance(pred, "aucpr")@y.values[[1]] prbe<- performance(pred, "prbe")@y.values[[1]] rch <- performance(pred, "rch")@y.values[[1]] mxe <- .get.performance.measure.result(pred, "mxe") rmse<- .get.performance.measure.result(pred, "rmse") phi <- .get.performance.measure.result(pred, "phi") mat <- .get.performance.measure.result(pred, "mat") mi <- .get.performance.measure.result(pred, "mi") chisq<- .get.performance.measure.result(pred, "chisq") odds<- .get.performance.measure.result(pred, "odds") lift<- .get.performance.measure.result(pred, "lift") f <- .get.performance.measure.result(pred, "f") sar <- .get.performance.measure.result(pred,"sar") ecost <- .get.performance.measure.result(pred, "ecost") cost <- .get.performance.measure.result(pred, "cost") return(list(tpr=tpr, fpr=fpr, acc=acc, err=err, rec=rec, sens=sens, fnr=fnr, tnr=tnr, spec=spec, ppv=ppv, prec=prec, npv=npv, fall=fall, miss=miss, pcfall=pcfall, pcmiss=pcmiss, rpp=rpp, rnp=rnp, auc=auc, aucpr=aucpr, prbe=prbe, rch=rch, mxe=mxe, rmse=rmse, phi=phi, mat=mat, mi=mi, chisq=chisq, odds=odds, lift=lift, f=f, sar=sar, ecost=ecost, cost=cost)) } ############################################################################## # test PerformanceMeasuresReference expect_error(prediction(some.predictions[-1], some.labels), "Number of predictions in each run must be equal") expect_error(prediction(c(NA,some.predictions[-1]), some.labels), "'predictions' contains NA.") expect_error(prediction(as.list(matrix(some.predictions)), some.labels), "Number of cross-validation runs must be equal") expect_error(prediction(some.predictions, factor(some.labels,ordered = TRUE), label.ordering = c(1,0)), "'labels' is already ordered. No additional 'label.ordering'") expect_error() pred <- prediction(some.predictions, some.labels) expect_output(show(pred)) actual <- prediction(some.predictions, factor(some.labels), label.ordering = c(0,1)) expect_equal(pred, actual) expect_error(performance("tpr",pred), "Wrong argument types") expect_error(performance(pred,"tpr","mxe"), "The performance measure mxe can only be used as 'measure'") actual1 <- performance(pred, "tpr") actual2 <- performance(pred, "fpr") actual <- ROCR:::.combine.performance.objects(actual1,actual2) expect_s4_class(actual,"performance") actual3 <- performance(pred, "mxe") expect_error(ROCR:::.combine.performance.objects(actual1,actual3), "Objects need to have identical x axis") expect_error(ROCR:::.combine.performance.objects(actual,actual), "At least one of the two objects has already been merged") measures <- expect_output( expect_warning(.get.performance.measures(pred), "Chi-squared approximation may be incorrect")) attach(measures) expect_equal(tpr, tpr.reference) expect_equal(fpr, fpr.reference) expect_equal(acc, acc.reference) expect_equal(err, err.reference) expect_equal(rec, rec.reference) expect_equal(sens, sens.reference) expect_equal(fnr, fnr.reference) expect_equal(tnr, tnr.reference) expect_equal(spec, spec.reference) expect_equal(ppv, ppv.reference) expect_equal(prec,prec.reference) expect_equal(npv, npv.reference) expect_equal(fall, fall.reference) expect_equal(miss,miss.reference) expect_equal(pcfall, pcfall.reference) expect_equal(pcmiss,pcmiss.reference) expect_equal(rpp, rpp.reference) expect_equal(rnp,rnp.reference) expect_equal(auc, auc.reference) expect_equal(aucpr, aucpr.reference, tolerance = .0000001) expect_equal(prbe, prbe.reference) expect_equal(mxe, mxe.reference) expect_equal(rmse, rmse.reference) expect_equal(phi, phi.reference) expect_equal(mat, mat.reference) expect_equal(mi, mi.reference) expect_equal(unname(chisq), chisq.reference) expect_equal(odds, odds.reference) expect_equal(lift, lift.reference) expect_equal(f, f.reference) expect_equal(sar,sar.reference) expect_equal(cost, cost.reference) ############################################################################## # ecost ecost.x.reference <- c(0,1/3,0.5,1) ecost.y.reference <- c(0,0.2,0.2,0) pred <- prediction(some.predictions, some.labels) perf <- performance(pred, "ecost") ecost.x <- perf@x.values[[1]] ecost.y <- perf@y.values[[1]] expect_equal( ecost.x, ecost.x.reference ) expect_equal( ecost.y, ecost.y.reference ) ############################################################################## # test cal pred <- prediction(some.predictions, some.labels) cal <- performance(pred, "cal", window.size=floor(length(pred@predictions[[1]])/3))@y.values[[1]] cal.x <- performance(pred, "cal", window.size=floor(length(pred@predictions[[1]])/3))@x.values[[1]] cal.x.reference <- rev(sort( some.predictions ))[2:(length(some.predictions)-1)] expect_equal( cal, cal.reference) expect_equal( cal.x, cal.x.reference) ############################################################################## # test cost pred <- prediction(some.predictions, some.labels) for (cost.fp in rnorm(50)) { cost.fn <- rnorm(1) perf <- performance(pred, "cost", cost.fp=cost.fp, cost.fn=cost.fn) cost <- perf@y.values[[1]] my.cost.reference <- (fpr.reference * n.reference/length(some.labels) * cost.fp + fnr.reference * p.reference/length(some.labels) * cost.fn) expect_equal( cost, my.cost.reference) } ############################################################################## # test Rch pred <- prediction(some.predictions, some.labels) perf <- performance( pred, "rch") rch.x <- perf@x.values[[1]] rch.y <- perf@y.values[[1]] expect_equal( rch.x, rch.reference.x ) expect_equal( rch.y, rch.reference.y ) ############################################################################## # test RMSE pred <- prediction(c(0, 0, 1, 1), ordered(c(0, 0, 1, 1))) rmse <- performance(pred, "rmse")@y.values[[1]] expect_equal(rmse, 0) pred <- prediction(c(0.0, 0.0, 1.0, 1.0), ordered(c(1, 1, 0, 0), levels=c(1,0))) rmse <- performance(pred, "rmse")@y.values[[1]] expect_equal(rmse, 1) pred <- prediction(c(0.0, 0.0, 1.0, 1.0), ordered(c(2, 2, 3, 3))) rmse <- performance(pred, "rmse")@y.values[[1]] expect_equal( rmse, 2) pred <- prediction(c(-0.5, 0.2, 2.5, 0.3), ordered(c(-1, -1, 1, 1))) rmse <- performance(pred, "rmse")@y.values[[1]] expect_equal( rmse, sqrt(1/4*(0.5^2 + 1.2^2 + 1.5^2 + 0.7^2))) ############################################################################## # test PRBE pred <- prediction(some.predictions, some.labels) prbe.y <- performance(pred, "prbe")@y.values[[1]] prbe.x <- performance(pred, "prbe")@x.values[[1]] expect_equal(prbe.y, prbe.reference) expect_equal(prbe.x, prbe.reference.x) ############################################################################## # test prediction interface pred <- prediction(seq(0, 1, length=10), c(rep(0,5), rep(1,5))) expect_equal(performance(pred, "auc")@y.values[[1]], 1) pred <- prediction(seq(1, 0, length=10), c(rep(0,5), rep(1,5))) expect_equal(performance(pred, "auc")@y.values[[1]], 0) pred <- prediction(seq(0, 1, length=10), factor(c(rep(0,5), rep(1,5)))) expect_equal(performance(pred, "auc")@y.values[[1]], 1) pred <- prediction(seq(0, 1, length=10), ordered(c(rep(0,5), rep(1,5)))) expect_equal(performance(pred, "auc")@y.values[[1]], 1) pred <- prediction(seq(0, 1, length=10), ordered(c(rep(0,5), rep(1,5)), levels=c(1,0))) expect_equal(performance(pred, "auc")@y.values[[1]], 0) pred <- prediction(seq(0, 1, length=10), ordered(c(rep("A",5), rep("B",5)))) expect_equal(performance(pred, "auc")@y.values[[1]], 1) expect_error(pred <- prediction(seq(0, 1, length=10), c(rep(0,5), rep(1,5)), label.ordering=c(1,2))) expect_error(pred <- prediction(list(c(0.1,0.3,0.7,1), c(0,0.2,0.8,1)), list(factor(c(0,0,1,1)), factor(c(1,1,2,2))))) expect_error(pred <- prediction(list(c(0.2,0.3,0.7,1), c(0,0.2,0.8,1)), list(factor(c(0,0,1,1)), ordered(c(0,0,1,1))))) pred <- prediction(list(c(0,0.3,0.7,1), c(0,0.2,0.8,1)), list(factor(c(0,0,1,1)), factor(c(0,0,1,1)))) expect_equal(performance(pred, "auc")@y.values, list(1, 1)) pred1 <- prediction(data.frame(c(0,0.3,0.7,1), c(0,0.2,0.8,1)), data.frame(factor(c(0,0,1,1)), factor(c(0,0,1,1)))) expect_equal( pred, pred1) pred2 <- prediction(cbind(c(0,0.3,0.7,1), c(0,0.2,0.8,1)), cbind(c(0,0,1,1), c(0,0,1,1))) expect_equal(pred, pred2) }) ROCR/tests/testthat.R0000644000176200001440000000007013644317760014154 0ustar liggesuserslibrary(testthat) library(ROCR) test_check("ROCR") ROCR/vignettes/0000755000176200001440000000000013653005533013032 5ustar liggesusersROCR/vignettes/references.bibtex0000644000176200001440000001571613644317760016374 0ustar liggesusers @article{Sing2005, author = {Sing, Tobias and Sander, Oliver and Beerenwinkel, Niko and Lengauer, Thomas}, title = "{ROCR: visualizing classifier performance in R}", journal = {Bioinformatics}, volume = {21}, number = {20}, pages = {3940-3941}, year = {2005}, month = {08}, abstract = "{Summary: ROCR is a package for evaluating and visualizing the performance of scoring classifiers in the statistical language R. It features over 25 performance measures that can be freely combined to create two-dimensional performance curves. Standard methods for investigating trade-offs between specific performance measures are available within a uniform framework, including receiver operating characteristic (ROC) graphs, precision/recall plots, lift charts and cost curves. ROCR integrates tightly with R's powerful graphics capabilities, thus allowing for highly adjustable plots. Being equipped with only three commands and reasonable default values for optional parameters, ROCR combines flexibility with ease of usage.Availability:http://rocr.bioinf.mpi-sb.mpg.de. ROCR can be used under the terms of the GNU General Public License. Running within R, it is platform-independent.Contact:tobias.sing@mpi-sb.mpg.de}", issn = {1367-4803}, doi = {10.1093/bioinformatics/bti623}, url = {https://doi.org/10.1093/bioinformatics/bti623}, eprint = {https://academic.oup.com/bioinformatics/article-pdf/21/20/3940/522867/bti623.pdf}, } @book{Baldi2001, author = {Pierre Baldi and Søren Brunak}, title = {Bioinformatics: The Machine Learning Approach.}, year = {2001}, publisher = {MIT Press, Cambridge, MA.} } @article{Beerenwinkel2003, author = {Beerenwinkel, Niko and Däumer, Martin and Oette, Mark and Korn, Klaus and Hoffmann, Daniel and Kaiser, Rolf and Lengauer, Thomas and Selbig, Joachim and Walter, Hauke}, title = "{Geno2pheno: estimating phenotypic drug resistance from HIV-1 genotypes}", journal = {Nucleic Acids Research}, volume = {31}, number = {13}, pages = {3850-3855}, year = {2003}, month = {07}, abstract = "{Therapeutic success of anti-HIV therapies is limited by the development of drug resistant viruses. These genetic variants display complex mutational patterns in their pol gene, which codes for protease and reverse transcriptase, the molecular targets of current antiretroviral therapy. Genotypic resistance testing depends on the ability to interpret such sequence data, whereas phenotypic resistance testing directly measures relative in vitro susceptibility to a drug. From a set of 650 matched genotype–phenotype pairs we construct regression models for the prediction of phenotypic drug resistance from genotypes. Since the range of resistance factors varies considerably between different drugs, two scoring functions are derived from different sets of predicted phenotypes. Firstly, we compare predicted values to those of samples derived from 178 treatment-naive patients and report the relative deviance. Secondly, estimation of the probability density of 2000 predicted phenotypes gives rise to an intrinsic definition of a susceptible and a resistant subpopulation. Thus, for a predicted phenotype, we calculate the probability of membership in the resistant subpopulation. Both scores provide standardized measures of resistance that can be calculated from the genotype and are comparable between drugs. The geno2pheno system makes these genotype interpretations available via the Internet (http://www.genafor.org/).}", issn = {0305-1048}, doi = {10.1093/nar/gkg575}, url = {https://doi.org/10.1093/nar/gkg575}, eprint = {https://academic.oup.com/nar/article-pdf/31/13/3850/9487404/gkg575.pdf}, } @article{Beerenwinkel2002, author = {Beerenwinkel, Niko and Schmidt, Barbara and Walter, Hauke and Kaiser, Rolf and Lengauer, Thomas and Hoffmann, Daniel and Korn, Klaus and Selbig, Joachim}, title = {Diversity and complexity of HIV-1 drug resistance: A bioinformatics approach to predicting phenotype from genotype}, volume = {99}, number = {12}, pages = {8271--8276}, year = {2002}, doi = {10.1073/pnas.112177799}, publisher = {National Academy of Sciences}, abstract = {Drug resistance testing has been shown to be beneficial for clinical management of HIV type 1 infected patients. Whereas phenotypic assays directly measure drug resistance, the commonly used genotypic assays provide only indirect evidence of drug resistance, the major challenge being the interpretation of the sequence information. We analyzed the significance of sequence variations in the protease and reverse transcriptase genes for drug resistance and derived models that predict phenotypic resistance from genotypes. For 14 antiretroviral drugs, both genotypic and phenotypic resistance data from 471 clinical isolates were analyzed with a machine learning approach. Information profiles were obtained that quantify the statistical significance of each sequence position for drug resistance. For the different drugs, patterns of varying complexity were observed, including between one and nine sequence positions with substantial information content. Based on these information profiles, decision tree classifiers were generated to identify genotypic patterns characteristic of resistance or susceptibility to the different drugs. We obtained concise and easily interpretable models to predict drug resistance from sequence information. The prediction quality of the models was assessed in leave-one-out experiments in terms of the prediction error. We found prediction errors of 9.6{\textendash}15.5\% for all drugs except for zalcitabine, didanosine, and stavudine, with prediction errors between 25.4\% and 32.0\%. A prediction service is freely available at http://cartan.gmd.de/geno2pheno.html. HIV-1,HIV type 1;NRTIs,nucleoside inhibitors of the reverse transcriptase;ZDV,zidovudine;ddC,zalcitabine;ddI,didanosine;d4T,stavudine;3TC,lamivudine;ABC,abacavir;NNRTI,nonnucleoside reverse transcriptase inhibitors;NVP,nevirapine;DLV,delavirdine;EFV,efavirenz;PI,protease inhibitor;SQV,saquinavir;IDV,indinavir;RTV,ritonavir;NFV,nelfinavir;APV,amprenavir;RT,reverse transcriptase}, issn = {0027-8424}, URL = {https://www.pnas.org/content/99/12/8271}, eprint = {https://www.pnas.org/content/99/12/8271.full.pdf}, journal = {Proceedings of the National Academy of Sciences} } @inproceedings{Fawcett2004, author = {T. Fawcett}, title = {ROC graphs: notes and practical considerations for researchers.}, booktitle = {HPL-2003-4.}, year = {2004}, pages = {89--96}, publisher = {HP Labs, Palo Alto, CA.} } @inproceedings{Sing04learningmixtures, author = {Tobias Sing and Niko Beerenwinkel and Thomas Lengauer}, title = {Learning Mixtures of Localized Rules by Maximizing the Area Under the ROC Curve}, booktitle = {In et al José Hernández-Orallo, editor, 1st International Workshop on ROC Analysis in Artificial Intelligence}, year = {2004}, pages = {89--96} } ROCR/vignettes/ROCR.Rmd0000644000176200001440000003132213644317760014254 0ustar liggesusers--- title: "ROCR: visualizing classifier performance in R" output: rmarkdown::html_vignette author: Tobias Sing, Oliver Sander, Niko Beerenwinkel, Thomas Lengauer abstract: ROCR is a package for evaluating and visualizing the performance of scoring classifiers in the statistical language R. It features over 25 performance measures that can be freely combined to create two-dimensional performance curves. Standard methods for investigating trade-offs between specific performance measures are available within a uniform framework, including receiver operating characteristic (ROC) graphs, precision/recall plots, lift charts and cost curves. ROCR integrates tightly with R's powerful graphics capabilities, thus allowing for highly adjustable plots. Being equipped with only three commands and reasonable default values for optional parameters, ROCR combines flexibility with ease of usage. vignette: > %\VignetteIndexEntry{ROCR} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} bibliography: references.bibtex --- ```{r, include = FALSE} knitr::opts_chunk$set( collapse = TRUE, comment = "#>" ) ``` # Introduction ```{r setup} library(ROCR) ``` Pattern classification has become a central tool in bioinformatics, offering rapid insights into large data sets [[@Baldi2001]](#References). While one area of our work involves predicting phenotypic properties of HIV-1 from genotypic information [[@Beerenwinkel2002;@Beerenwinkel2003;@Sing04learningmixtures]](#References), scoring or ranking predictors are also vital in a wide range of other biological problems. Examples include microarray analysis (e.g. prediction of tissue condition based on gene expression), protein structural and functional characterization (remote homology detection, prediction of post-translational modifications and molecular function annotation based on sequence or structural motifs), genome annotation (gene finding and splice site identification), protein–ligand interactions (virtual screening and molecular docking) and structure–activity relationships (predicting bioavailability or toxicity of drug compounds). In many of these cases, considerable class skew, class-specific misclassification costs, and extensive noise due to variability in experimental assays complicate predictive modelling. Thus, careful predictor validation is compulsory. ```{r, echo = FALSE, results = 'asis'} table <- data.frame(group = c("Contingency ratios", "Discrete covariation measures", "Information retrieval measures", "Performance in ROC space", "Absolute scoring performance", "Cost measures"), measure = c("error rate, accuracy, sensitivity, specificity, true/false positive rate, fallout, miss, precision, recall, negative predictive value, prediction-conditioned fallout/miss.", "Phi/Matthews correlation coefficient, mutual information, Chi-squared test statistic, odds ratio", "F-measure, lift, precision-recall break-even point", "ROC convex hull, area under the ROC curve", "calibration error, mean cross-entropy, root mean-squared error", "expected cost, explicit cost")) knitr::kable(table, caption = "***Table 1:**Performance measures in the ROCR package*", col.names = c("",""), align = "l") ``` The real-valued output of scoring classifiers is turned into a binary class decision by choosing a cutoff. As no cutoff is optimal according to all possible performance criteria, cutoff choice involves a trade-off among different measures. Typically, a trade-off between a pair of criteria (e.g. sensitivity versus specificity) is visualized as a cutoff-parametrized curve in the plane spanned by the two measures. Popular examples of such trade-off visualizations include receiver operating characteristic (ROC) graphs, sensitivity/specificity curves, lift charts and precision/recall plots. [@Fawcett2004](#References) provides a general introduction into evaluating scoring classifiers with a focus on ROC graphs. Although functions for drawing ROC graphs are provided by the Bioconductor project (http://www.bioconductor.org) or by the machine learning package Weka (http://www.cs.waikato.ac.nz/ml), for example, no comprehensive evaluation suite is available to date. ROCR is a flexible evaluation package for R (https://www.r-project.org), a statistical language that is widely used in biomedical data analysis. Our tool allows for creating cutoff-parametrized performance curves by freely combining two out of more than 25 performance measures (Table 1). Curves from different cross-validation or bootstrapping runs can be averaged by various methods. Standard deviations, standard errors and box plots are available to summarize the variability across the runs. The parametrization can be visualized by printing cutoff values at the corresponding curve positions, or by coloring the curve according to the cutoff. All components of a performance plot are adjustable using a flexible mechanism for dispatching optional arguments. Despite this flexibility, ROCR is easy to use, with only three commands and reasonable default values for all optional parameters. In the example below, we will briefly introduce ROCR's three commands—prediction, performance and plot—applied to a 10-fold cross-validation set of predictions and corresponding class labels from a study on predicting HIV coreceptor usage from the sequence of the viral envelope protein. After loading the dataset, a prediction object is created from the raw predictions and class labels. ```{r} data(ROCR.hiv) predictions <- ROCR.hiv$hiv.svm$predictions labels <- ROCR.hiv$hiv.svm$labels pred <- prediction(predictions, labels) pred ``` Performance measures or combinations thereof are computed by invoking the performance method on this prediction object. The resulting performance object can be visualized using the method plot. For example, an ROC curve that trades off the rate of true positives against the rate of false positives is obtained as follows: ```{r, fig.asp=1, fig.width=5, fig.align='center'} perf <- performance(pred, "tpr", "fpr") perf plot(perf, avg="threshold", spread.estimate="boxplot") ``` The optional parameter avg selects a particular form of performance curve averaging across the validation runs; the visualization of curve variability is determined with the parameter spread.estimate. ```{r, echo=FALSE, results='asis', fig.asp=0.35, fig.width=7, fig.align='center',fig.cap="***Fig 1:** Visualizations of classifier performance (HIV coreceptor usage data): (a) receiver operating characteristic (ROC) curve; (b) peak accuracy across a range of cutoffs; (c) absolute difference between empirical and predicted rate of positives for windowed cutoff ranges, in order to evaluate how well the scores are calibrated as probability estimates. Owing to the probabilistic interpretation, cutoffs need to be in the interval [0,1], in contrast to other performance plots. (d) Score density estimates for the negative (solid) and positive (dotted) class.*"} data(ROCR.hiv) pp.unnorm <- ROCR.hiv$hiv.svm$predictions ll <- ROCR.hiv$hiv.svm$labels # normalize predictions to 0..1 v <- unlist(pp.unnorm) pp <- lapply(pp.unnorm, function(run) {approxfun(c(min(v), max(v)), c(0,1))(run)}) par(mfrow=c(1,4)) pred<- prediction(pp, ll) perf <- performance(pred, "tpr", "fpr") plot(perf, avg= "threshold", colorize=TRUE, lwd= 3, coloraxis.at=seq(0,1,by=0.2),) plot(perf, col="gray78", add=TRUE) plot(perf, avg= "threshold", colorize=TRUE, colorkey=FALSE,lwd= 3,,add=TRUE) mtext(paste0("(a)"), side = 3, adj = 0.01,line = 1) perf <- performance(pred, "acc") plot(perf, avg= "vertical", spread.estimate="boxplot", lwd=3,col='blue', show.spread.at= seq(0.1, 0.9, by=0.1),) mtext(paste0("(b)"), side = 3, adj = 0.01,line = 1) plot(performance(pred, "cal", window.size= 10), avg="vertical",) mtext(paste0("(c)"), side = 3, adj = 0.01,line = 1) plot(0,0,type="n", xlim= c(0,1), ylim=c(0,7), xlab="Cutoff", ylab="Density",) mtext(paste0("(d)"), side = 3, adj = 0.01,line = 1) for (runi in 1:length(pred@predictions)) { lines(density(pred@predictions[[runi]][pred@labels[[runi]]=="-1"]), col= "red") lines(density(pred@predictions[[runi]][pred@labels[[runi]]=="1"]), col="green") } ``` Issuing `demo(ROCR)` starts a demonstration of further graphical capabilities of ROCR. The command `help(package=ROCR)` points to the available help pages. In particular, a complete list of available performance measures can be obtained via help(performance). A reference manual can be downloaded from the ROCR website. In conclusion, ROCR is a comprehensive tool for evaluating scoring classifiers and producing publication-quality figures. It allows for studying the intricacies inherent to many biological datasets and their implications on classifier performance. ## Additional examples Below you can find many additional examples of ROCR's features of performance measurement and the possibilites in plotting. However, this only a first taste. For more examples, please run `demo(ROCR)` and make sure the plotting deminsions are big enough. ### ROC curves, Precision/Recall graphs and more ... ```{r, fig.asp=1, fig.width=5, fig.align='center'} perf <- performance(pred, "tpr", "fpr") plot(perf, avg= "threshold", colorize=TRUE, lwd= 3, main= "With ROCR you can produce standard plots\nlike ROC curves ...") plot(perf, lty=3, col="grey78", add=TRUE) ``` ```{r, fig.asp=1, fig.width=5, fig.align='center'} perf <- performance(pred, "prec", "rec") plot(perf, avg= "threshold", colorize=TRUE, lwd= 3, main= "... Precision/Recall graphs ...") plot(perf, lty=3, col="grey78", add=TRUE) ``` ```{r, fig.asp=1, fig.width=5, fig.align='center'} perf <- performance(pred, "sens", "spec") plot(perf, avg= "threshold", colorize=TRUE, lwd= 3, main="... Sensitivity/Specificity plots ...") plot(perf, lty=3, col="grey78", add=TRUE) ``` ```{r, fig.asp=1, fig.width=5, fig.align='center'} perf <- performance(pred, "lift", "rpp") plot(perf, avg= "threshold", colorize=TRUE, lwd= 3, main= "... and Lift charts.") plot(perf, lty=3, col="grey78", add=TRUE) ``` ### Averaging over multiple predictions Multiple batches of predictions can be analyzed at the same time. ```{r} data(ROCR.xval) predictions <- ROCR.xval$predictions labels <- ROCR.xval$labels length(predictions) ``` ```{r} pred <- prediction(predictions, labels) perf <- performance(pred,'tpr','fpr') ``` This can be used for plotting averages using the `avg` argument. ```{r, fig.asp=1, fig.width=5, fig.align='center'} plot(perf, colorize=TRUE, lwd=2, main='ROC curves from 10-fold cross-validation') ``` ```{r, fig.asp=1, fig.width=5, fig.align='center'} plot(perf, avg='vertical', spread.estimate='stderror', lwd=3,main='Vertical averaging + 1 standard error', col='blue') ``` ```{r, fig.asp=1, fig.width=5, fig.align='center'} plot(perf, avg='horizontal', spread.estimate='boxplot', lwd=3, main='Horizontal averaging + boxplots', col='blue') ``` ```{r, fig.asp=1, fig.width=5, fig.align='center'} plot(perf, avg='threshold', spread.estimate='stddev', lwd=2, main='Threshold averaging + 1 standard deviation', colorize=TRUE) ``` ### Cutoff stacking ```{r, fig.asp=1, fig.width=6, fig.align='center'} plot(perf, print.cutoffs.at=seq(0,1,by=0.2), text.cex=0.8, text.y=lapply(as.list(seq(0,0.5,by=0.05)), function(x) { rep(x,length(perf@x.values[[1]])) } ), col= as.list(terrain.colors(10)), text.col= as.list(terrain.colors(10)), points.col= as.list(terrain.colors(10)), main= "Cutoff stability") ``` ### Combination of performance measures Performance measures can be combined freely. ```{r} perf <- performance(pred,"pcmiss","lift") ``` ```{r, fig.asp=1, fig.width=5, fig.align='center'} plot(perf, colorize=TRUE, print.cutoffs.at=seq(0,1,by=0.1), text.adj=c(1.2,1.2), avg="threshold", lwd=3, main= "You can freely combine performance measures ...") ``` # Acknowledgement Work at MPI supported by EU NoE BioSapiens (LSHG-CT-2003-503265). # References ROCR/NEWS0000644000176200001440000000204313644317760011530 0ustar liggesusersThis file documents changes and updates to the ROCR package. Version 1.0-10 (Mar 31, 2020) - added area under the Precision/Recall curve (aucpr) Version 1.0-8 (Mar 26, 2020) - Changed maintainer email address - fixed issues for R 4.0 Version 1.0-7 (Mar 26, 2015) - Changed maintainer email address Version 1.0-5 (May 12, 2013) - Used standardized license specification in DESCRIPTION file - Removed LICENCE file - Removed .First.lib in zzz.R - CITATION moved into inst folder and adjusted Version 1.0-4 (Dec 08, 2009) - fixes bug with 1.0-3 that prevented plot arguments getting passed through Version 1.0-3 - adapted to more strict R CMD CHECK rules in R > 2.9 Version 1.0-2 (Jan 27, 2007) - fixed minor bug in 'prediction' function concerning the optional parameter 'label.ordering' (thanks to Robert Perdisci for notifying us). - added an optional parameter 'fpr.stop' to the performance measure 'auc', allowing to calculate the partial area under the ROC curve up to the false positive rate given by 'fpr.stop'. ROCR/R/0000755000176200001440000000000013644317760011233 5ustar liggesusersROCR/R/performance_measures.R0000644000176200001440000004243013644317760015566 0ustar liggesusers## ------------------------------------------------------------------------ ## classical machine learning contingency table measures ## ------------------------------------------------------------------------ .performance.accuracy <- function(predictions, labels, cutoffs, fp, tp, fn, tn, n.pos, n.neg, n.pos.pred, n.neg.pred) { list( cutoffs, (tn+tp) / length(predictions) ) } .performance.error.rate <- function(predictions, labels, cutoffs, fp, tp, fn, tn, n.pos, n.neg, n.pos.pred, n.neg.pred) { list( cutoffs, (fn+fp) / length(predictions) ) } .performance.false.positive.rate <- function(predictions, labels, cutoffs, fp, tp, fn, tn, n.pos, n.neg, n.pos.pred, n.neg.pred) { list( cutoffs, fp / n.neg ) } .performance.true.positive.rate <- function(predictions, labels, cutoffs, fp, tp, fn, tn, n.pos, n.neg, n.pos.pred, n.neg.pred) { list( cutoffs, tp / n.pos ) } .performance.false.negative.rate <- function(predictions, labels, cutoffs, fp, tp, fn, tn, n.pos, n.neg, n.pos.pred, n.neg.pred) { list( cutoffs, fn / n.pos ) } .performance.true.negative.rate <- function(predictions, labels, cutoffs, fp, tp, fn, tn, n.pos, n.neg, n.pos.pred, n.neg.pred) { list( cutoffs, tn / n.neg ) } .performance.positive.predictive.value <- function(predictions, labels, cutoffs, fp, tp, fn, tn, n.pos, n.neg, n.pos.pred, n.neg.pred) { ppv <- tp / (fp + tp) list( cutoffs, ppv ) } .performance.negative.predictive.value <- function(predictions, labels, cutoffs, fp, tp, fn, tn, n.pos, n.neg, n.pos.pred, n.neg.pred) { npv <- tn / (tn + fn) list( cutoffs, npv ) } .performance.prediction.conditioned.fallout <- function(predictions, labels, cutoffs, fp, tp, fn, tn, n.pos, n.neg, n.pos.pred, n.neg.pred) { ppv <- .performance.positive.predictive.value(predictions, labels, cutoffs, fp, tp, fn, tn, n.pos, n.neg, n.pos.pred, n.neg.pred)[[2]] list( cutoffs, 1 - ppv ) } .performance.prediction.conditioned.miss <- function(predictions, labels, cutoffs, fp, tp, fn, tn, n.pos, n.neg, n.pos.pred, n.neg.pred) { npv <- .performance.negative.predictive.value(predictions, labels, cutoffs, fp, tp, fn, tn, n.pos, n.neg, n.pos.pred, n.neg.pred)[[2]] list( cutoffs, 1 - npv ) } ## ------------------------------------------------------------------------ ## ...not actually performance measures, but very useful as a second axis ## against which to plot a "real" performance measure ## (popular example: lift charts) ## ------------------------------------------------------------------------ .performance.rate.of.positive.predictions <- function(predictions, labels, cutoffs, fp, tp, fn, tn, n.pos, n.neg, n.pos.pred, n.neg.pred) { list( cutoffs, n.pos.pred / (n.pos + n.neg) ) } .performance.rate.of.negative.predictions <- function(predictions, labels, cutoffs, fp, tp, fn, tn, n.pos, n.neg, n.pos.pred, n.neg.pred) { list( cutoffs, n.neg.pred / (n.pos + n.neg) ) } ## ------------------------------------------------------------------------ ## Classical statistical contingency table measures ## ------------------------------------------------------------------------ .performance.phi <- function(predictions, labels, cutoffs, fp, tp, fn, tn, n.pos, n.neg, n.pos.pred, n.neg.pred) { list(cutoffs, (tn*tp - fn*fp) / (sqrt(n.pos) * sqrt(n.neg) * sqrt(n.pos.pred) * sqrt(n.neg.pred)) ) } .performance.mutual.information <- function(predictions, labels, cutoffs, fp, tp, fn, tn, n.pos, n.neg, n.pos.pred, n.neg.pred) { n.samples <- n.pos + n.neg mi <- c() for (k in 1:length(cutoffs)) { kij <- rbind( c(tn[k],fn[k]), c(fp[k],tp[k]) ) ki.j. <- rbind(c(n.neg * n.neg.pred[k], n.neg.pred[k] * n.pos), c(n.neg * n.pos.pred[k], n.pos * n.pos.pred[k])) log.matrix <- log2( kij / ki.j.) log.matrix[kij/ki.j.==0] <- 0 mi <- c(mi, log2(n.samples) + sum( kij * log.matrix) / n.samples ) } list( cutoffs, mi ) } #' @importFrom stats chisq.test .performance.chisq <- function(predictions, labels, cutoffs, fp, tp, fn, tn, n.pos, n.neg, n.pos.pred, n.neg.pred) { chisq <- c() for (i in 1:length(cutoffs)) { A <- rbind( c( tn[i], fn[i]), c(fp[i], tp[i]) ) chisq <- c(chisq, stats::chisq.test(A, correct=FALSE)$statistic ) } list( cutoffs, chisq ) } .performance.odds.ratio <- function(predictions, labels, cutoffs, fp, tp, fn, tn, n.pos, n.neg, n.pos.pred, n.neg.pred) { list( cutoffs, tp * tn / (fn * fp) ) } ## ------------------------------------------------------------------------ ## Other measures based on contingency tables ## ------------------------------------------------------------------------ .performance.lift <- function(predictions, labels, cutoffs, fp, tp, fn, tn, n.pos, n.neg, n.pos.pred, n.neg.pred) { n.samples <- n.pos + n.neg list( cutoffs, (tp / n.pos) / (n.pos.pred / n.samples) ) } .performance.f <- function(predictions, labels, cutoffs, fp, tp, fn, tn, n.pos, n.neg, n.pos.pred, n.neg.pred, alpha) { prec <- .performance.positive.predictive.value(predictions, labels, cutoffs, fp, tp, fn, tn, n.pos, n.neg, n.pos.pred, n.neg.pred)[[2]] list( cutoffs, 1/ ( alpha*(1/prec) + (1-alpha)*(1/(tp/n.pos)) ) ) } #' @importFrom grDevices chull .performance.rocconvexhull <- function(predictions, labels, cutoffs, fp, tp, fn, tn, n.pos, n.neg, n.pos.pred, n.neg.pred) { x <- fp / n.neg y <- tp / n.pos finite.bool <- is.finite(x) & is.finite(y) x <- x[ finite.bool ] y <- y[ finite.bool ] if (length(x) < 2) { stop("Not enough distinct predictions to compute ROC convex hull.") } ## keep only points on the convex hull ind <- grDevices::chull(x, y) x.ch <- x[ind] y.ch <- y[ind] ## keep only convex hull points above the diagonal, except (0,0) ## and (1,1) ind.upper.triangle <- x.ch < y.ch x.ch <- c(0, x.ch[ind.upper.triangle], 1) y.ch <- c(0, y.ch[ind.upper.triangle], 1) ## sort remaining points by ascending x value ind <- order(x.ch) x.ch <- x.ch[ind] y.ch <- y.ch[ind] list( x.ch, y.ch ) } ## ---------------------------------------------------------------------------- ## Cutoff-independent measures ## ---------------------------------------------------------------------------- #' @importFrom stats approxfun .performance.auc <- function(predictions, labels, cutoffs, fp, tp, fn, tn, n.pos, n.neg, n.pos.pred, n.neg.pred, fpr.stop) { x <- fp / n.neg y <- tp / n.pos finite.bool <- is.finite(x) & is.finite(y) x <- x[ finite.bool ] y <- y[ finite.bool ] if (length(x) < 2) { stop(paste("Not enough distinct predictions to compute area", "under the ROC curve.")) } if (fpr.stop < 1) { ind <- max(which( x <= fpr.stop )) tpr.stop <- stats::approxfun( x[ind:(ind+1)], y[ind:(ind+1)] )(fpr.stop) x <- c(x[1:ind], fpr.stop) y <- c(y[1:ind], tpr.stop) } ans <- list() auc <- 0 for (i in 2:length(x)) { auc <- auc + 0.5 * (x[i] - x[i-1]) * (y[i] + y[i-1]) } ans <- list( c(), auc) names(ans) <- c("x.values","y.values") return(ans) } # written by Thomas Unterthiner (unterthiner@bioinf.jku.at) .performance.aucpr <- function(predictions, labels, cutoffs, fp, tp, fn, tn, n.pos, n.neg, n.pos.pred, n.neg.pred) { tmp <- aggregate(list(fp=fp), by=list(tp=tp), min) tp <- tmp$tp fp <- tmp$fp prec <- tp / (fp + tp) rec <- tp / n.pos if (fp[1] == 0 & tp[1] == 0) { prec[1] = 1 } finite.bool <- is.finite(prec) & is.finite(rec) prec <- prec[ finite.bool ] rec <- rec[ finite.bool ] if (length(rec) < 2) { stop(paste("Not enough distinct predictions to compute area", "under the Precision/Recall curve.")) } # if two points are too distant from each other, we need to # correctly interpolate between them. This is done according to # Davis & Goadrich, #"The Relationship Between Precision-Recall and ROC Curves", ICML'06 for (i in seq_along(rec[-length(rec)])) { if (tp[i+1] - tp[i] > 2) { skew = (fp[i+1]-fp[i]) / (tp[i+1]-tp[i]) x = seq(1, tp[i+1]-tp[i], by=1) rec <- append(rec, (x+tp[i])/n.pos, after=i) prec <- append(prec, (x+tp[i])/(tp[i]+fp[i]+x+ skew*x), after=i) } } auc <- 0 for (i in seq.int(from = 2, to = length(rec))) { auc <- auc + 0.5 * (rec[i] - rec[i-1]) * (prec[i] + prec[i-1]) } ans <- list( c(), auc) names(ans) <- c("x.values","y.values") return(ans) } #' @importFrom stats uniroot approxfun .performance.precision.recall.break.even.point <- function(predictions, labels, cutoffs, fp, tp, fn, tn, n.pos, n.neg, n.pos.pred, n.neg.pred) { pred <- prediction( predictions, labels) perf <- performance( pred, measure="prec", x.measure="rec") x <- rev(perf@x.values[[1]]) y <- rev(perf@y.values[[1]]) alpha <- rev(perf@alpha.values[[1]]) finite.bool <- is.finite(alpha) & is.finite(x) & is.finite(y) x <- x[ finite.bool ] y <- y[ finite.bool ] alpha <- alpha[ finite.bool ] if (length(x) < 2) { stop(paste("Not enough distinct predictions to compute", "precision/recall intersections.")) } intersection.cutoff <- c() intersection.pr <- c() ## find all intersection points by looking at all intervals (i,i+1): ## if the difference function between x and y has different signs at the ## interval boundaries, then an intersection point is in the interval; ## compute as the root of the difference function if ( (x[1]-y[1]) == 0) { intersection.cutoff <- c( alpha[1] ) intersection.pr <- c( x[1] ) } for (i in (1:(length(alpha)-1))) { if ((x[i+1]-y[i+1]) == 0) { intersection.cutoff <- c( intersection.cutoff, alpha[i+1] ) intersection.pr <- c( intersection.pr, x[i+1] ) } else if ((x[i]-y[i])*(x[i+1]-y[i+1]) < 0 ) { ans <- stats::uniroot(stats::approxfun(c(alpha[i], alpha[i+1] ), c(x[i]-y[i], x[i+1]-y[i+1])), c(alpha[i],alpha[i+1])) intersection.cutoff <- c(intersection.cutoff, ans$root) intersection.pr <- c(intersection.pr, ans$f.root) } } list( rev(intersection.cutoff), rev(intersection.pr) ) } #' @importFrom stats median .performance.calibration.error <- function(predictions, labels, cutoffs, fp, tp, fn, tn, n.pos, n.neg, n.pos.pred, n.neg.pred, window.size) { if (window.size > length(predictions)) { stop("Window size exceeds number of predictions.") } if (min(predictions)<0 || max(predictions)>1) { stop("Calibration error needs predictions between 0 and 1") } pos.label <- levels(labels)[2] neg.label <- levels(labels)[1] ordering <- rev(order( predictions )) predictions <- predictions[ ordering ] labels <- labels[ ordering ] median.cutoffs <- c() calibration.errors <- c() for (left.index in 1 : (length(predictions) - window.size+1) ) { right.index <- left.index + window.size - 1 pos.fraction <- sum(labels[left.index : right.index] == pos.label) / window.size mean.prediction <- mean( predictions[ left.index : right.index ] ) calibration.errors <- c(calibration.errors, abs(pos.fraction - mean.prediction)) median.cutoffs <- c(median.cutoffs, stats::median(predictions[left.index:right.index])) } list( median.cutoffs, calibration.errors ) } .performance.mean.cross.entropy <- function(predictions, labels, cutoffs, fp, tp, fn, tn, n.pos, n.neg, n.pos.pred, n.neg.pred) { if (! all(levels(labels)==c(0,1)) || any(predictions<0) || any(predictions>1) ) { stop(paste("Class labels need to be 0 and 1 and predictions between", "0 and 1 for mean cross entropy.")) } pos.label <- levels(labels)[2] neg.label <- levels(labels)[1] list( c(), - 1/length(predictions) * (sum( log( predictions[which(labels==pos.label)] )) + sum( log( 1 - predictions[which(labels==neg.label)] ))) ) } .performance.root.mean.squared.error <- function(predictions, labels, cutoffs, fp, tp, fn, tn, n.pos, n.neg, n.pos.pred, n.neg.pred) { ## convert labels from factor to numeric values labels <- as.numeric(levels(labels))[labels] if (any(is.na(labels))) { stop("For rmse predictions have to be numeric.") } list( c(), sqrt( 1/length(predictions) * sum( (predictions - labels)^2 )) ) } ## ---------------------------------------------------------------------------- ## Derived measures: ## ---------------------------------------------------------------------------- .performance.sar <- function( predictions, labels, cutoffs, fp, tp, fn, tn, n.pos, n.neg, n.pos.pred, n.neg.pred) { pred <- prediction( predictions, labels) perf.acc <- performance( pred, measure="acc") perf.rmse <- performance( pred, measure="rmse") perf.auc <- performance( pred, measure="auc") list(cutoffs, 1/3 * (perf.acc@y.values[[1]] + (1 - perf.rmse@y.values[[1]]) + perf.auc@y.values[[1]])) } ## ---------------------------------------------------------------------------- ## Measures taking into account actual cost considerations ## ---------------------------------------------------------------------------- .performance.expected.cost <- function(predictions, labels, cutoffs, fp, tp, fn, tn, n.pos, n.neg, n.pos.pred, n.neg.pred) { ## kick out suboptimal values (i.e. fpr/tpr pair for which another one ## with same fpr and higher tpr exists, ## or one for which one with same tpr but lower fpr exists if (n.neg==0 || n.pos==0) { stop(paste("At least one positive and one negative sample are", "needed to compute a cost curve.")) } fpr <- fp / n.neg tpr <- tp / n.pos ## sort by fpr (ascending), in case of ties by descending tpr ind <- order(fpr,-tpr) fpr <- fpr[ind] tpr <- tpr[ind] ## for tied fprs, only the one with the highest tpr is kept ind <- !duplicated(fpr) fpr <- fpr[ind] tpr <- tpr[ind] ## for tied tprs, only keep the one with the lowest fpr ind <- order(-tpr,fpr) fpr <- fpr[ind] tpr <- tpr[ind] ind <- !duplicated(tpr) fpr <- fpr[ind] tpr <- tpr[ind] if (!any(0==fpr & 0==tpr)) { fpr <- c(0,fpr) tpr <- c(0,tpr) } if (!any(1==fpr & 1==tpr)) { fpr <- c(fpr,1) tpr <- c(tpr,1) } ## compute all functions f <- list() for (i in 1:length(fpr)) { f <- c(f, .construct.linefunct( 0, fpr[i], 1, 1-tpr[i] )) } ## compute all intersection points x.values <- c() y.values <- c() for (i in 1:(length(fpr)-1)) { for (j in (i+1):length(fpr)) { ans <- .intersection.point( f[[i]], f[[j]] ) if (all(is.finite(ans))) { y.values.at.current.x <- c() for (k in 1:length(f)) { y.values.at.current.x <- c(y.values.at.current.x, f[[k]](ans[1])) } if (abs(ans[2] - min(y.values.at.current.x )) < sqrt(.Machine$double.eps)) { x.values <- c(x.values, ans[1]) y.values <- c(y.values, ans[2]) } } } } if (!any(0==x.values & 0==y.values)) { x.values <- c(0,x.values) y.values <- c(0,y.values) } if (!any(1==x.values & 0==y.values)) { x.values <- c(x.values,1) y.values <- c(y.values,0) } ind <- order( x.values) list( x.values[ind], y.values[ind] ) } .performance.cost <- function(predictions, labels, cutoffs, fp, tp, fn, tn, n.pos, n.neg, n.pos.pred, n.neg.pred, cost.fp, cost.fn) { n.samples <- n.pos + n.neg cost <- ((n.pos / n.samples) * (fn / n.pos) * cost.fn + (n.neg / n.samples) * (fp / n.neg) * cost.fp) list( cutoffs, cost ) } ROCR/R/zzz.R0000644000176200001440000004641013644317760012220 0ustar liggesusers#' @import methods NULL #' @name prediction-class #' @aliases prediction-class #' #' @title Class \code{prediction} #' #' @description #' Object to encapsulate numerical predictions together with the #' corresponding true class labels, optionally collecting predictions and #' labels for several cross-validation or bootstrapping runs. #' #' @section Objects from the Class: #' Objects can be created by using the \code{prediction} function. #' #' @note #' Every \code{prediction} object contains information about the 2x2 #' contingency table consisting of tp,tn,fp, and fn, along with the #' marginal sums n.pos,n.neg,n.pos.pred,n.neg.pred, because these form #' the basis for many derived performance measures. #' #' @slot predictions A list, in which each element is a vector of predictions #' (the list has length > 1 for x-validation data. #' @slot labels Analogously, a list in which each element is a vector of true #' class labels. #' @slot cutoffs A list in which each element is a vector of all necessary #' cutoffs. Each cutoff vector consists of the predicted scores (duplicates #' removed), in descending order. #' @slot fp A list in which each element is a vector of the number (not the #' rate!) of false positives induced by the cutoffs given in the corresponding #' 'cutoffs' list entry. #' @slot tp As fp, but for true positives. #' @slot tn As fp, but for true negatives. #' @slot fn As fp, but for false negatives. #' @slot n.pos A list in which each element contains the number of positive #' samples in the given x-validation run. #' @slot n.neg As n.pos, but for negative samples. #' @slot n.pos.pred A list in which each element is a vector of the number of #' samples predicted as positive at the cutoffs given in the corresponding #' 'cutoffs' entry. #' @slot n.neg.pred As n.pos.pred, but for negatively predicted samples. #' #' @references #' A detailed list of references can be found on the ROCR homepage at #' \url{http://rocr.bioinf.mpi-sb.mpg.de}. #' #' @author #' Tobias Sing \email{tobias.sing@gmail.com}, Oliver Sander #' \email{osander@gmail.com} #' #' @seealso #' \code{\link{prediction}}, #' \code{\link{performance}}, #' \code{\link{performance-class}}, #' \code{\link{plot.performance}} #' #' @export setClass("prediction", representation(predictions = "list", labels = "list", cutoffs = "list", fp = "list", tp = "list", tn = "list", fn = "list", n.pos = "list", n.neg = "list", n.pos.pred = "list", n.neg.pred = "list")) setMethod("show","prediction", function(object){ cat("A ", class(object), " instance\n", sep = "") if(length(object@predictions) > 1L){ cat(" with ", length(object@predictions)," cross ", "validation runs ", sep = "") if(length(unique(vapply(object@predictions,length,integer(1))))){ cat("(equal lengths)", sep = "") } else { cat("(different lengths)", sep = "") } } else { cat(" with ", length(object@predictions[[1L]]), " data points", sep = "") } }) #' @name performance-class #' @aliases performance-class #' #' @title Class \code{performance} #' #' @description #' Object to capture the result of a performance evaluation, optionally #' collecting evaluations from several cross-validation or bootstrapping runs. #' #' @section Objects from the Class: #' Objects can be created by using the \code{performance} function. #' #' @details #' A \code{performance} object can capture information from four #' different evaluation scenarios: #' \itemize{ #' \item The behaviour of a cutoff-dependent performance measure across #' the range of all cutoffs (e.g. \code{performance( predObj, 'acc' )} ). Here, #' \code{x.values} contains the cutoffs, \code{y.values} the #' corresponding values of the performance measure, and #' \code{alpha.values} is empty.\cr #' \item The trade-off between two performance measures across the #' range of all cutoffs (e.g. \code{performance( predObj, #' 'tpr', 'fpr' )} ). In this case, the cutoffs are stored in #' \code{alpha.values}, while \code{x.values} and \code{y.values} #' contain the corresponding values of the two performance measures.\cr #' \item A performance measure that comes along with an obligatory #' second axis (e.g. \code{performance( predObj, 'ecost' )} ). Here, the measure values are #' stored in \code{y.values}, while the corresponding values of the #' obligatory axis are stored in \code{x.values}, and \code{alpha.values} #' is empty.\cr #' \item A performance measure whose value is just a scalar #' (e.g. \code{performance( predObj, 'auc' )} ). The value is then stored in #' \code{y.values}, while \code{x.values} and \code{alpha.values} are #' empty. #' } #' #' @slot x.name Performance measure used for the x axis. #' @slot y.name Performance measure used for the y axis. #' @slot alpha.name Name of the unit that is used to create the parametrized #' curve. Currently, curves can only be parametrized by cutoff, so #' \code{alpha.name} is either \code{none} or \code{cutoff}. #' @slot x.values A list in which each entry contains the x values of the curve #' of this particular cross-validation run. \code{x.values[[i]]}, #' \code{y.values[[i]]}, and \code{alpha.values[[i]]} correspond to each #' other. #' @slot y.values A list in which each entry contains the y values of the curve #' of this particular cross-validation run. #' @slot alpha.values A list in which each entry contains the cutoff values of #' the curve of this particular cross-validation run. #' #' @references #' A detailed list of references can be found on the ROCR homepage at #' \url{http://rocr.bioinf.mpi-sb.mpg.de}. #' #' @author #' Tobias Sing \email{tobias.sing@gmail.com}, Oliver Sander #' \email{osander@gmail.com} #' #' @seealso #' \code{\link{prediction}} #' \code{\link{performance}}, #' \code{\link{prediction-class}}, #' \code{\link{plot.performance}} #' #' @export setClass("performance", representation(x.name = "character", y.name = "character", alpha.name = "character", x.values = "list", y.values = "list", alpha.values = "list" )) setMethod("show","performance", function(object){ cat("A ", class(object), " instance\n", sep = "") if(length(object@y.values[[1L]]) > 1L){ cat(" '", object@x.name, "' vs. '", object@y.name, "' (alpha: '",object@alpha.name,"')\n", sep = "") } else { cat(" '", object@y.name, "'\n", sep = "") } if(length(object@y.values) > 1L){ cat(" for ", length(object@y.values)," cross ", "validation runs ", sep = "") } else { if(length(object@y.values[[1L]]) > 1L){ cat(" with ", length(object@y.values[[1L]])," data points", sep = "") } } }) #' @name plot-methods #' @aliases plot,performance,missing-method plot.performance #' #' @title Plot method for performance objects #' #' @description #' This is the method to plot all objects of class performance. #' #' @param x an object of class \code{performance} #' @param y not used #' @param ... Optional graphical parameters to adjust different components of #' the performance plot. Parameters are directed to their target component by #' prefixing them with the name of the component (\code{component.parameter}, #' e.g. \code{text.cex}). The following components are available: #' \code{xaxis}, \code{yaxis}, \code{coloraxis}, \code{box} (around the #' plotting region), \code{points}, \code{text}, \code{plotCI} (error bars), #' \code{boxplot}. The names of these components are influenced by the R #' functions that are used to create them. Thus, \code{par(component)} can be #' used to see which parameters are available for a given component (with the #' expection of the three axes; use \code{par(axis)} here). To adjust the #' canvas or the performance curve(s), the standard \code{plot} parameters can #' be used without any prefix. #' @param avg If the performance object describes several curves (from #' cross-validation runs or bootstrap evaluations of one particular method), #' the curves from each of the runs can be averaged. Allowed values are #' \code{none} (plot all curves separately), \code{horizontal} (horizontal #' averaging), \code{vertical} (vertical averaging), and \code{threshold} #' (threshold (=cutoff) averaging). Note that while threshold averaging is #' always feasible, vertical and horizontal averaging are not well-defined if #' the graph cannot be represented as a function x->y and y->x, respectively. #' @param spread.estimate When curve averaging is enabled, the variation around #' the average curve can be visualized as standard error bars #' (\code{stderror}), standard deviation bars (\code{stddev}), or by using box #' plots (\code{boxplot}). Note that the function \code{plotCI}, which is used #' internally by ROCR to draw error bars, might raise a warning if the spread #' of the curves at certain positions is 0. #' @param spread.scale For \code{stderror} or \code{stddev}, this is a scalar #' factor to be multiplied with the length of the standard error/deviation #' bar. For example, under normal assumptions, \code{spread.scale=2} can be #' used to get approximate 95\% confidence intervals. #' @param show.spread.at For vertical averaging, this vector determines the x #' positions for which the spread estimates should be visualized. In contrast, #' for horizontal and threshold averaging, the y positions and cutoffs are #' determined, respectively. By default, spread estimates are shown at 11 #' equally spaced positions. #' @param colorize This logical determines whether the curve(s) should be #' colorized according to cutoff. #' @param colorize.palette If curve colorizing is enabled, this determines the #' color palette onto which the cutoff range is mapped. #' @param colorkey If true, a color key is drawn into the 4\% border #' region (default of \code{par(xaxs)} and \code{par(yaxs)}) of the #' plot. The color key visualizes the mapping from cutoffs to colors. #' @param colorkey.relwidth Scalar between 0 and 1 that determines the #' fraction of the 4\% border region that is occupied by the colorkey. #' @param colorkey.pos Determines if the colorkey is drawn vertically at #' the \code{right} side, or horizontally at the \code{top} of the #' plot. #' @param print.cutoffs.at This vector specifies the cutoffs which should #' be printed as text along the curve at the corresponding curve positions. #' @param cutoff.label.function By default, cutoff annotations along the curve #' or at the color key are rounded to two decimal places before printing. #' Using a custom \code{cutoff.label.function}, any other transformation can #' be performed on the cutoffs instead (e.g. rounding with different precision #' or taking the logarithm). #' @param downsampling ROCR can efficiently compute most performance measures #' even for data sets with millions of elements. However, plotting of large #' data sets can be slow and lead to PS/PDF documents of considerable size. In #' that case, performance curves that are indistinguishable from the original #' can be obtained by using only a fraction of the computed performance #' values. Values for downsampling between 0 and 1 indicate the fraction of #' the original data set size to which the performance object should be #' downsampled, integers above 1 are interpreted as the actual number of #' performance values to which the curve(s) should be downsampled. #' @param add If \code{TRUE}, the curve(s) is/are added to an already existing #' plot; otherwise a new plot is drawn. #' #' @references #' A detailed list of references can be found on the ROCR homepage at #' \url{http://rocr.bioinf.mpi-sb.mpg.de}. #' #' @author #' Tobias Sing \email{tobias.sing@gmail.com}, Oliver Sander #' \email{osander@gmail.com} #' #' @seealso #' \code{\link{prediction}}, #' \code{\link{performance}}, #' \code{\link{prediction-class}}, #' \code{\link{performance-class}} #' #' @export #' #' @examples #' # plotting a ROC curve: #' library(ROCR) #' data(ROCR.simple) #' pred <- prediction( ROCR.simple$predictions, ROCR.simple$labels ) #' pred #' perf <- performance( pred, "tpr", "fpr" ) #' perf #' plot( perf ) #' #' # To entertain your children, make your plots nicer #' # using ROCR's flexible parameter passing mechanisms #' # (much cheaper than a finger painting set) #' par(bg="lightblue", mai=c(1.2,1.5,1,1)) #' plot(perf, main="ROCR fingerpainting toolkit", colorize=TRUE, #' xlab="Mary's axis", ylab="", box.lty=7, box.lwd=5, #' box.col="gold", lwd=17, colorkey.relwidth=0.5, xaxis.cex.axis=2, #' xaxis.col='blue', xaxis.col.axis="blue", yaxis.col='green', yaxis.cex.axis=2, #' yaxis.at=c(0,0.5,0.8,0.85,0.9,1), yaxis.las=1, xaxis.lwd=2, yaxis.lwd=3, #' yaxis.col.axis="orange", cex.lab=2, cex.main=2) setMethod("plot", signature(x="performance",y="missing"), function(x, y, ..., avg = "none", spread.estimate = "none", spread.scale = 1, show.spread.at = c(), colorize = FALSE, colorize.palette = rev(rainbow(256, start = 0, end = 4 / 6)), colorkey = colorize, colorkey.relwidth = 0.25, colorkey.pos = "right", print.cutoffs.at = c(), cutoff.label.function = function(x) { round(x, 2) }, downsampling = 0, add = FALSE ) { .plot.performance(x,..., avg = avg, spread.estimate = spread.estimate, spread.scale = spread.scale, show.spread.at = show.spread.at, colorize = colorize, colorize.palette = colorize.palette, colorkey = colorkey, colorkey.relwidth = colorkey.relwidth, colorkey.pos = colorkey.pos, print.cutoffs.at = print.cutoffs.at, cutoff.label.function = cutoff.label.function, downsampling = downsampling, add = add) } ) #' @rdname plot-methods #' @method plot performance #' @export "plot.performance" <- function(...) plot(...) #' @name ROCR.hiv #' #' @docType data #' @keywords datasets #' #' @title Data set: Support vector machines and neural networks applied to the #' prediction of HIV-1 coreceptor usage #' #' @description #' Linear support vector machines (libsvm) and neural networks (R package #' nnet) were applied to predict usage of the coreceptors CCR5 and CXCR4 #' based on sequence data of the third variable loop of the HIV envelope #' protein. #' #' @format #' A list consisting of the SVM (\code{ROCR.hiv$hiv.svm}) and NN #' (\code{ROCR.hiv$hiv.nn}) classification data. Each of those is in turn a list #' consisting of the two elements \code{$predictions} and \code{$labels} (10 #' element list representing cross-validation data). #' #' @references #' Sing, T. & Beerenwinkel, N. & Lengauer, T. "Learning mixtures #' of localized rules by maximizing the area under the ROC curve". 1st #' International Workshop on ROC Analysis in AI, 89-96, 2004. #' #' @usage data(ROCR.hiv) #' #' @examples #' library(ROCR) #' data(ROCR.hiv) #' attach(ROCR.hiv) #' pred.svm <- prediction(hiv.svm$predictions, hiv.svm$labels) #' pred.svm #' perf.svm <- performance(pred.svm, 'tpr', 'fpr') #' perf.svm #' pred.nn <- prediction(hiv.nn$predictions, hiv.svm$labels) #' pred.nn #' perf.nn <- performance(pred.nn, 'tpr', 'fpr') #' perf.nn #' plot(perf.svm, lty=3, col="red",main="SVMs and NNs for prediction of #' HIV-1 coreceptor usage") #' plot(perf.nn, lty=3, col="blue",add=TRUE) #' plot(perf.svm, avg="vertical", lwd=3, col="red", #' spread.estimate="stderror",plotCI.lwd=2,add=TRUE) #' plot(perf.nn, avg="vertical", lwd=3, col="blue", #' spread.estimate="stderror",plotCI.lwd=2,add=TRUE) #' legend(0.6,0.6,c('SVM','NN'),col=c('red','blue'),lwd=3) "ROCR.hiv" #' @name ROCR.simple #' #' @docType data #' @keywords datasets #' #' @title Data set: Simple artificial prediction data for use with ROCR #' #' @description #' A mock data set containing a simple set of predictions and corresponding #' class labels. #' #' @format #' A two element list. The first element, \code{ROCR.simple$predictions}, is a #' vector of numerical predictions. The second element, #' \code{ROCR.simple$labels}, is a vector of corresponding class labels. #' #' @usage data(ROCR.simple) #' #' @examples #' # plot a ROC curve for a single prediction run #' # and color the curve according to cutoff. #' library(ROCR) #' data(ROCR.simple) #' pred <- prediction(ROCR.simple$predictions, ROCR.simple$labels) #' pred #' perf <- performance(pred,"tpr","fpr") #' perf #' plot(perf,colorize=TRUE) "ROCR.simple" #' @name ROCR.xval #' #' @docType data #' @keywords datasets #' #' @title Data set: Artificial cross-validation data for use with ROCR #' #' @description #' A mock data set containing 10 sets of predictions and corresponding labels as #' would be obtained from 10-fold cross-validation. #' #' @format #' A two element list. The first element, \code{ROCR.xval$predictions}, is #' itself a 10 element list. Each of these 10 elements is a vector of numerical #' predictions for each cross-validation run. Likewise, the second list entry, #' \code{ROCR.xval$labels} is a 10 element list in which each element is a #' vector of true class labels corresponding to the predictions. #' #' @usage data(ROCR.xval) #' #' @examples #' # plot ROC curves for several cross-validation runs (dotted #' # in grey), overlaid by the vertical average curve and boxplots #' # showing the vertical spread around the average. #' library(ROCR) #' data(ROCR.xval) #' pred <- prediction(ROCR.xval$predictions, ROCR.xval$labels) #' pred #' perf <- performance(pred,"tpr","fpr") #' perf #' plot(perf,col="grey82",lty=3) #' plot(perf,lwd=3,avg="vertical",spread.estimate="boxplot",add=TRUE) "ROCR.xval" ROCR/R/performance_plots.R0000644000176200001440000006071313652775327015115 0ustar liggesusers## ---------------------------------------------------------------------------- ## plot method for objects of class 'performance' ## ---------------------------------------------------------------------------- #' @importFrom graphics plot.default plot.xy par .get.arglist <- function( fname, arglist ) { if (fname=='plot') return(.select.args(arglist, union(names(formals(graphics::plot.default)), names(graphics::par())))) else if (fname=='plot.xy') return(.select.args(arglist, union( names(formals(graphics::plot.xy)), names(graphics::par())))) else return( .select.prefix( arglist, fname) ) } .downsample <- function( perf, downsampling ) { for (i in 1:length(perf@alpha.values)) { if (downsampling < 1 && downsampling > 0) ind <- round(seq(1, length(perf@alpha.values[[i]]), length=(length(perf@alpha.values[[i]]) * downsampling))) else if (downsampling > 1) ind <- round(seq(1, length(perf@alpha.values[[i]]), length=downsampling)) else ind <- 1:length(perf@alpha.values[[i]]) perf@alpha.values[[i]] <- perf@alpha.values[[i]][ind] perf@x.values[[i]] <- perf@x.values[[i]][ind] perf@y.values[[i]] <- perf@y.values[[i]][ind] } return(perf) } .check_performance_for_plotting <- function(perf, colorize, print.cutoffs.at, avg){ if (length(perf@y.values) != length(perf@x.values)) { stop("Performance object cannot be plotted. Length of x and y values ", "does not match.", call. = FALSE) } if ((is.null(perf@alpha.values) || length(perf@alpha.values) == 0L) && (colorize==TRUE || length(print.cutoffs.at) > 0L)) { stop("Threshold coloring or labeling cannot be performed: ", "performance object has no threshold information.", call. = FALSE) } if ((avg=="vertical" || avg=="horizontal") && (colorize==TRUE || length(print.cutoffs.at) > 0L)) { stop("Threshold coloring or labeling is only well-defined for", "'no' or 'threshold' averaging.", call. = FALSE) } } #' @importFrom grDevices rainbow .plot.performance <- function(perf, ..., avg = "none", spread.estimate = "none", spread.scale = 1, show.spread.at = c(), colorize = FALSE, colorize.palette = rev(grDevices::rainbow(256, start = 0, end = 4 / 6)), colorkey = colorize, colorkey.relwidth = 0.25, colorkey.pos = "right", print.cutoffs.at = c(), cutoff.label.function = function(x) { round(x, 2) }, downsampling = 0, add = FALSE) { # Input checks .check_performance_for_plotting(perf, colorize, print.cutoffs.at, avg) # getting the arguments arglist <- c(lapply(as.list(environment()), eval ), list(...) ) if (downsampling >0 ) perf <- .downsample( perf, downsampling) ## for infinite cutoff, assign maximal finite cutoff + mean difference ## between adjacent cutoff pairs if (length(perf@alpha.values) != 0) { FUN <- function(x) { isfin <- is.finite(x) # if only one finite is available the mean cannot be calculated without # the first/last value, since the leaves no value if(sum(isfin) > 1L){ inf_replace <- max(x[isfin]) + mean(abs(x[isfin][-1] - x[isfin][-length(x[isfin])])) } else { inf_replace <- 0 } x[is.infinite(x)] <- inf_replace x } perf@alpha.values <- lapply(perf@alpha.values,FUN) } ## remove samples with x or y not finite for (i in 1:length(perf@x.values)) { ind.bool <- (is.finite(perf@x.values[[i]]) & is.finite(perf@y.values[[i]])) if (length(perf@alpha.values)>0) perf@alpha.values[[i]] <- perf@alpha.values[[i]][ind.bool] perf@x.values[[i]] <- perf@x.values[[i]][ind.bool] perf@y.values[[i]] <- perf@y.values[[i]][ind.bool] } arglist <- .sarg( arglist, perf=perf) if (add==FALSE) do.call( ".performance.plot.canvas", arglist ) if (avg=="none") do.call(".performance.plot.no.avg", arglist) else if (avg=="vertical") do.call(".performance.plot.vertical.avg", arglist) else if (avg=="horizontal") do.call(".performance.plot.horizontal.avg", arglist) else if (avg=="threshold") do.call(".performance.plot.threshold.avg", arglist) } ## --------------------------------------------------------------------------- ## initializing plots and plotting a canvas ## (can be skipped using 'plot( ..., add=TRUE)' ## --------------------------------------------------------------------------- #' @import stats #' @import graphics .performance.plot.canvas <- function(perf, avg, ...) { # requireNamespace("stats") # requireNamespace("graphics") arglist <- list(...) axis.names <- list(x=perf@x.name, y=perf@y.name) if (avg=="horizontal" || avg=="threshold") axis.names$x <- paste("Average", tolower(axis.names$x)) if (avg=="vertical" || avg=="threshold") axis.names$y <- paste("Average", tolower(axis.names$y)) arglist <- .farg(arglist, xlab=axis.names$x, ylab=axis.names$y) arglist <- .farg(arglist, xlim=c(min(unlist(perf@x.values)), max(unlist(perf@x.values))), ylim=c(min(unlist(perf@y.values)), max(unlist(perf@y.values)))) do.call("plot", .sarg(.slice.run(.get.arglist('plot', arglist)), x=0.5, y=0.5, type='n', axes=FALSE)) do.call( "axis", .sarg(.slice.run(.get.arglist('xaxis', arglist)), side=1)) do.call( "axis", .sarg(.slice.run(.get.arglist('yaxis', arglist)), side=2)) if (.garg(arglist,'colorkey')==TRUE) { colors <- rev( .garg(arglist,'colorize.palette') ) max.alpha <- max(unlist(perf@alpha.values)) min.alpha <- min(unlist(perf@alpha.values)) col.cutoffs <- rev(seq(min.alpha,max.alpha, length=length( colors ))) if ( .garg(arglist,'colorkey.pos')=="right") { ## axis drawing (ticks + labels) ## The interval [min.alpha,max.alpha] needs to be mapped onto ## the interval [min.y,max.y], rather than onto the interval ## [ylim[1],ylim[2]] ! In the latter case, NAs could occur in ## approxfun below, because axTicks can be out of the ylim-range ## ('yxaxs': 4%region) max.y <- max(axTicks(4)) min.y <- min(axTicks(4)) alpha.ticks <- .garg( arglist, c("coloraxis.at")) if (length(alpha.ticks)==0) alpha.ticks <- approxfun(c(min.y, max.y), c(min.alpha, max.alpha)) (axTicks(4)) alpha2y <- approxfun(c(min(alpha.ticks), max(alpha.ticks)), c(min.y,max.y)) arglist <- .sarg(arglist, coloraxis.labels=.garg(arglist, 'cutoff.label.function')(alpha.ticks), coloraxis.at=alpha2y(alpha.ticks)) do.call("axis", .sarg(.slice.run(.get.arglist('coloraxis', arglist)), side=4)) ## draw colorkey ## each entry in display.bool corresponds to one rectangle of ## the colorkey. ## Only rectangles within the alpha.ticks range are plotted. ## y.lower, y.upper, and colors, are the attributes of the visible ## rectangles (those for which display.bool=TRUE) display.bool <- (col.cutoffs >= min(alpha.ticks) & col.cutoffs < max(alpha.ticks)) y.lower <- alpha2y( col.cutoffs )[display.bool] colors <- colors[display.bool] if (length(y.lower>=2)) { y.width <- y.lower[2] - y.lower[1] y.upper <- y.lower + y.width x.left <- .garg(arglist,'xlim')[2] + ((.garg(arglist,'xlim')[2] - .garg(arglist,'xlim')[1]) * (1-.garg(arglist,'colorkey.relwidth'))*0.04) x.right <- .garg(arglist,'xlim')[2] + (.garg(arglist,'xlim')[2] -.garg(arglist,'xlim')[1]) * 0.04 rect(x.left, y.lower, x.right, y.upper, col=colors, border=colors,xpd=NA) } } else if (.garg(arglist, 'colorkey.pos') == "top") { ## axis drawing (ticks + labels) max.x <- max(axTicks(3)) min.x <- min(axTicks(3)) alpha.ticks <- .garg( arglist, c("coloraxis.at")) if (length(alpha.ticks)==0) { alpha.ticks <- approxfun(c(min.x, max.x), c(min.alpha, max.alpha))(axTicks(3)) } alpha2x <- approxfun(c( min(alpha.ticks), max(alpha.ticks)), c( min.x, max.x)) arglist <- .sarg(arglist, coloraxis.labels=.garg(arglist, 'cutoff.label.function')(alpha.ticks), coloraxis.at= alpha2x(alpha.ticks)) do.call("axis", .sarg(.slice.run( .get.arglist('coloraxis', arglist)), side=3)) ## draw colorkey display.bool <- (col.cutoffs >= min(alpha.ticks) & col.cutoffs < max(alpha.ticks)) x.left <- alpha2x( col.cutoffs )[display.bool] colors <- colors[display.bool] if (length(x.left)>=2) { x.width <- x.left[2] - x.left[1] x.right <- x.left + x.width y.lower <- .garg(arglist,'ylim')[2] + (.garg(arglist,'ylim')[2] - .garg(arglist,'ylim')[1]) * (1-.garg(arglist,'colorkey.relwidth'))*0.04 y.upper <- .garg(arglist,'ylim')[2] + (.garg(arglist,'ylim')[2] - .garg(arglist,'ylim')[1]) * 0.04 rect(x.left, y.lower, x.right, y.upper, col=colors, border=colors, xpd=NA) } } } do.call( "box", .slice.run( .get.arglist( 'box', arglist))) } ## ---------------------------------------------------------------------------- ## plotting performance objects when no curve averaging is wanted ## ---------------------------------------------------------------------------- #' @importFrom grDevices xy.coords #' @importFrom stats approxfun .performance.plot.no.avg <- function( perf, ... ) { arglist <- list(...) arglist <- .farg(arglist, type= 'l') if (.garg(arglist, 'colorize') == TRUE) { colors <- rev( .garg( arglist, 'colorize.palette') ) max.alpha <- max(unlist(perf@alpha.values)) min.alpha <- min(unlist(perf@alpha.values)) col.cutoffs <- rev(seq(min.alpha,max.alpha, length=length(colors)+1)) col.cutoffs <- col.cutoffs[2:length(col.cutoffs)] } for (i in 1:length(perf@x.values)) { if (.garg(arglist, 'colorize') == FALSE) { do.call("plot.xy", .sarg(.slice.run(.get.arglist('plot.xy', arglist), i), xy=(grDevices::xy.coords(perf@x.values[[i]], perf@y.values[[i]])))) } else { for (j in 1:(length(perf@x.values[[i]])-1)) { segment.coloring <- colors[min(which(col.cutoffs <= perf@alpha.values[[i]][j]))] do.call("plot.xy", .sarg(.slice.run(.get.arglist('plot.xy', arglist), i), xy=(grDevices::xy.coords(perf@x.values[[i]][j:(j+1)], perf@y.values[[i]][j:(j+1)])), col= segment.coloring)) } } print.cutoffs.at <- .garg(arglist, 'print.cutoffs.at',i) if (! is.null(print.cutoffs.at)) { text.x <- stats::approxfun(perf@alpha.values[[i]], perf@x.values[[i]], rule=2, ties=mean)(print.cutoffs.at) text.y <- stats::approxfun(perf@alpha.values[[i]], perf@y.values[[i]], rule=2, ties=mean)(print.cutoffs.at) do.call("points", .sarg(.slice.run(.get.arglist('points', arglist),i), x= text.x, y= text.y)) do.call("text", .farg(.slice.run( .get.arglist('text', arglist),i), x= text.x, y= text.y, labels=(.garg(arglist, 'cutoff.label.function', i)(print.cutoffs.at)))) } } } ## ---------------------------------------------------------------------------- ## plotting performance objects when vertical curve averaging is wanted ## ---------------------------------------------------------------------------- #' @importFrom stats approxfun sd .performance.plot.vertical.avg <- function( perf, ...) { arglist <- list(...) arglist <- .farg(arglist, show.spread.at= (seq(min(unlist(perf@x.values)), max(unlist(perf@x.values)), length=11))) perf.avg <- perf x.values <- seq(min(unlist(perf@x.values)), max(unlist(perf@x.values)), length=max( sapply(perf@x.values, length))) for (i in 1:length(perf@y.values)) { perf.avg@y.values[[i]] <- stats::approxfun(perf@x.values[[i]], perf@y.values[[i]], ties=mean, rule=2)(x.values) } perf.avg@y.values <- list(rowMeans( data.frame( perf.avg@y.values ))) perf.avg@x.values <- list(x.values) perf.avg@alpha.values <- list() ## y.values at show.spread.at (midpoint of error bars ) show.spread.at.y.values <- lapply(as.list(1:length(perf@x.values)), function(i) { stats::approxfun(perf@x.values[[i]], perf@y.values[[i]], rule=2, ties=mean)( .garg(arglist, 'show.spread.at')) }) show.spread.at.y.values <- as.matrix(data.frame(show.spread.at.y.values )) colnames(show.spread.at.y.values) <- c() ## now, show.spread.at.y.values[i,] contains the curve y values at the ## sampling x value .garg(arglist,'show.spread.at')[i] if (.garg(arglist, 'spread.estimate') == "stddev" || .garg(arglist, 'spread.estimate') == "stderror") { bar.width <- apply(show.spread.at.y.values, 1, stats::sd) if (.garg(arglist, 'spread.estimate') == "stderror") { bar.width <- bar.width / sqrt( ncol(show.spread.at.y.values) ) } bar.width <- .garg(arglist, 'spread.scale') * bar.width suppressWarnings(do.call(gplots::plotCI, .farg(.sarg(.get.arglist('plotCI', arglist), x=.garg(arglist, 'show.spread.at'), y=rowMeans( show.spread.at.y.values), uiw= bar.width, liw= bar.width, err= 'y', add= TRUE), gap= 0, type= 'n'))) } if (.garg(arglist, 'spread.estimate') == "boxplot") { do.call("boxplot", .farg(.sarg(.get.arglist( 'boxplot', arglist), x= data.frame(t(show.spread.at.y.values)), at= .garg(arglist, 'show.spread.at'), add= TRUE, axes= FALSE), boxwex= (1/(2*(length(.garg(arglist, 'show.spread.at'))))))) do.call("points", .sarg(.get.arglist( 'points', arglist), x= .garg(arglist, 'show.spread.at'), y= rowMeans(show.spread.at.y.values))) } do.call( ".plot.performance", .sarg(arglist, perf= perf.avg, avg= 'none', add= TRUE)) } ## ---------------------------------------------------------------------------- ## plotting performance objects when horizontal curve averaging is wanted ## ---------------------------------------------------------------------------- #' @importFrom stats approxfun sd .performance.plot.horizontal.avg <- function( perf, ...) { arglist <- list(...) arglist <- .farg(arglist, show.spread.at= seq(min(unlist(perf@y.values)), max(unlist(perf@y.values)), length=11)) perf.avg <- perf y.values <- seq(min(unlist(perf@y.values)), max(unlist(perf@y.values)), length=max( sapply(perf@y.values, length))) for (i in 1:length(perf@x.values)) { perf.avg@x.values[[i]] <- stats::approxfun(perf@y.values[[i]], perf@x.values[[i]], ties=mean, rule=2)(y.values) } perf.avg@x.values <- list(rowMeans( data.frame( perf.avg@x.values ))) perf.avg@y.values <- list(y.values) perf.avg@alpha.values <- list() ## x.values at show.spread.at (midpoint of error bars ) show.spread.at.x.values <- lapply(as.list(1:length(perf@y.values)), function(i) { stats::approxfun(perf@y.values[[i]], perf@x.values[[i]], rule=2, ties=mean)(.garg(arglist,'show.spread.at')) } ) show.spread.at.x.values <- as.matrix(data.frame(show.spread.at.x.values)) colnames(show.spread.at.x.values) <- c() ## now, show.spread.at.x.values[i,] contains the curve x values at the ## sampling y value .garg(arglist,'show.spread.at')[i] if (.garg(arglist,'spread.estimate') == 'stddev' || .garg(arglist,'spread.estimate') == 'stderror') { bar.width <- apply(show.spread.at.x.values, 1, stats::sd) if (.garg(arglist,'spread.estimate')== 'stderror') { bar.width <- bar.width / sqrt( ncol(show.spread.at.x.values) ) } bar.width <- .garg(arglist,'spread.scale') * bar.width suppressWarnings(do.call(gplots::plotCI, .farg(.sarg(.get.arglist('plotCI', arglist), x= rowMeans( show.spread.at.x.values), y= .garg(arglist, 'show.spread.at'), uiw= bar.width, liw= bar.width, err= 'x', add= TRUE), gap= 0, type= 'n'))) } if (.garg(arglist,'spread.estimate') == "boxplot") { do.call("boxplot", .farg(.sarg(.get.arglist( 'boxplot', arglist), x= data.frame(t(show.spread.at.x.values)), at= .garg(arglist,'show.spread.at'), add= TRUE, axes= FALSE, horizontal= TRUE), boxwex= 1/(2*(length(.garg(arglist,'show.spread.at')))))) do.call("points", .sarg(.get.arglist( 'points', arglist), x= rowMeans(show.spread.at.x.values), y= .garg(arglist,'show.spread.at'))) } do.call( ".plot.performance", .sarg(arglist, perf= perf.avg, avg= 'none', add= TRUE)) } ## ---------------------------------------------------------------------------- ## plotting performance objects when threshold curve averaging is wanted ## ---------------------------------------------------------------------------- #' @importFrom stats approxfun sd .performance.plot.threshold.avg <- function( perf, ...) { arglist <- list(...) arglist <- .farg(arglist, show.spread.at= seq(min(unlist(perf@x.values)), max(unlist(perf@x.values)), length=11)) perf.sampled <- perf alpha.values <- rev(seq(min(unlist(perf@alpha.values)), max(unlist(perf@alpha.values)), length=max( sapply(perf@alpha.values, length)))) for (i in 1:length(perf.sampled@y.values)) { perf.sampled@x.values[[i]] <- stats::approxfun(perf@alpha.values[[i]],perf@x.values[[i]], rule=2, ties=mean)(alpha.values) perf.sampled@y.values[[i]] <- stats::approxfun(perf@alpha.values[[i]], perf@y.values[[i]], rule=2, ties=mean)(alpha.values) } ## compute average curve perf.avg <- perf.sampled perf.avg@x.values <- list( rowMeans( data.frame( perf.avg@x.values))) perf.avg@y.values <- list(rowMeans( data.frame( perf.avg@y.values))) perf.avg@alpha.values <- list( alpha.values ) x.values.spread <- lapply(as.list(1:length(perf@x.values)), function(i) { stats::approxfun(perf@alpha.values[[i]], perf@x.values[[i]], rule=2, ties=mean)(.garg(arglist,'show.spread.at')) } ) x.values.spread <- as.matrix(data.frame( x.values.spread )) y.values.spread <- lapply(as.list(1:length(perf@y.values)), function(i) { stats::approxfun(perf@alpha.values[[i]], perf@y.values[[i]], rule=2, ties=mean)(.garg(arglist,'show.spread.at')) } ) y.values.spread <- as.matrix(data.frame( y.values.spread )) if (.garg(arglist,'spread.estimate')=="stddev" || .garg(arglist,'spread.estimate')=="stderror") { x.bar.width <- apply(x.values.spread, 1, stats::sd) y.bar.width <- apply(y.values.spread, 1, stats::sd) if (.garg(arglist,'spread.estimate')=="stderror") { x.bar.width <- x.bar.width / sqrt( ncol(x.values.spread) ) y.bar.width <- y.bar.width / sqrt( ncol(x.values.spread) ) } x.bar.width <- .garg(arglist,'spread.scale') * x.bar.width y.bar.width <- .garg(arglist,'spread.scale') * y.bar.width suppressWarnings( do.call(gplots::plotCI, .farg(.sarg(.get.arglist('plotCI', arglist), x= rowMeans(x.values.spread), y= rowMeans(y.values.spread), uiw= x.bar.width, liw= x.bar.width, err= 'x', add= TRUE), gap= 0, type= 'n'))) suppressWarnings( do.call(gplots::plotCI, .farg(.sarg(.get.arglist('plotCI', arglist), x= rowMeans(x.values.spread), y= rowMeans(y.values.spread), uiw= y.bar.width, liw= y.bar.width, err= 'y', add= TRUE), gap= 0, type= 'n'))) } if (.garg(arglist,'spread.estimate')=="boxplot") { do.call("boxplot", .farg(.sarg(.get.arglist('boxplot', arglist), x= data.frame(t(x.values.spread)), at= rowMeans(y.values.spread), add= TRUE, axes= FALSE, horizontal= TRUE), boxwex= 1/(2*(length(.garg(arglist,'show.spread.at')))))) do.call("boxplot", .farg(.sarg(.get.arglist('boxplot', arglist), x= data.frame(t(y.values.spread)), at= rowMeans(x.values.spread), add= TRUE, axes= FALSE), boxwex= 1/(2*(length(.garg(arglist,'show.spread.at')))))) do.call("points", .sarg(.get.arglist('points', arglist), x= rowMeans(x.values.spread), y= rowMeans(y.values.spread))) } do.call( ".plot.performance", .sarg(arglist, perf= perf.avg, avg= 'none', add= TRUE)) } ROCR/R/ROCR_aux.R0000644000176200001440000000561213644317760013004 0ustar liggesusers## --------------------------------------------------------------------------- ## Dealing with argument lists, especially '...' ## --------------------------------------------------------------------------- ## return list of selected arguments, skipping those that ## are not present in arglist .select.args <- function( arglist, args.to.select, complement=FALSE) { match.bool <- names(arglist) %in% args.to.select if (complement==TRUE) match.bool <- !match.bool return( arglist[ match.bool] ) } ## return arguments in arglist which match prefix, with prefix removed ## ASSUMPTION: prefix is separated from rest by a '.'; this is removed along ## with the prefix .select.prefix <- function( arglist, prefixes, complement=FALSE ) { match.expr <- paste(paste('(^',prefixes,'\\.)',sep=""),collapse='|') match.bool <- (1:length(arglist)) %in% grep( match.expr, names(arglist) ) if (complement==TRUE) match.bool <- !match.bool arglist <- arglist[ match.bool] names(arglist) <- sub( match.expr, '', names(arglist)) return( arglist ) } .garg <- function( arglist, arg, i=1) { if (is.list(arglist[[arg]])) arglist[[ arg ]][[i]] else arglist[[ arg ]] } .sarg <- function( arglist, ...) { ll <- list(...) for (argname in names(ll) ) { arglist[[ argname ]] <- ll[[ argname ]] } return(arglist) } .farg <- function( arglist, ...) { ll <- list(...) for (argname in names(ll) ) { if (length(arglist[[argname]])==0) arglist[[ argname ]] <- ll[[ argname ]] } return(arglist) } .slice.run <- function( arglist, runi=1) { r <- lapply( names(arglist), function(name) .garg( arglist, name, runi)) names(r) <- names(arglist) r } ## --------------------------------------------------------------------------- ## Line segments ## --------------------------------------------------------------------------- .construct.linefunct <- function( x1, y1, x2, y2) { if (x1==x2) { stop("Cannot construct a function from data.") } lf <- eval(parse(text=paste("function(x) {", "m <- (",y2,"-",y1,") / (",x2,"-",x1,");", "c <- ",y1," - m * ",x1,";", "return( m * x + c)}",sep=" "))) lf } #' @importFrom stats uniroot .intersection.point <- function( f, g ) { ## if lines are parallel, no intersection point if (f(1)-f(0) == g(1)-g(0)) { return( c(Inf,Inf) ) } ## otherwise, choose search interval imin <- -1 imax <- 1 while (sign(f(imin)-g(imin)) == sign(f(imax)-g(imax))) { imin <- 2*imin imax <- 2*imax } h <- function(x) { f(x) - g(x) } intersect.x <- stats::uniroot( h, interval=c(imin-1,imax+1) )$root intersect.y <- f( intersect.x ) return( c(intersect.x, intersect.y )) } ROCR/R/prediction.R0000644000176200001440000002340613644317760013523 0ustar liggesusers#' @name prediction #' #' @title Function to create prediction objects #' #' @description #' Every classifier evaluation using ROCR starts with creating a #' \code{prediction} object. This function is used to transform the input data #' (which can be in vector, matrix, data frame, or list form) into a #' standardized format. #' #' @details #' \code{predictions} and \code{labels} can simply be vectors of the same #' length. However, in the case of cross-validation data, different #' cross-validation runs can be provided as the *columns* of a matrix or #' data frame, or as the entries of a list. In the case of a matrix or #' data frame, all cross-validation runs must have the same length, whereas #' in the case of a list, the lengths can vary across the cross-validation #' runs. Internally, as described in section 'Value', all of these input #' formats are converted to list representation. #' #' Since scoring classifiers give relative tendencies towards a negative #' (low scores) or positive (high scores) class, it has to be declared #' which class label denotes the negative, and which the positive class. #' Ideally, labels should be supplied as ordered factor(s), the lower #' level corresponding to the negative class, the upper level to the #' positive class. If the labels are factors (unordered), numeric, #' logical or characters, ordering of the labels is inferred from #' R's built-in \code{<} relation (e.g. 0 < 1, -1 < 1, 'a' < 'b', #' FALSE < TRUE). Use \code{label.ordering} to override this default #' ordering. Please note that the ordering can be locale-dependent #' e.g. for character labels '-1' and '1'. #' #' Currently, ROCR supports only binary classification (extensions toward #' multiclass classification are scheduled for the next release, #' however). If there are more than two distinct label symbols, execution #' stops with an error message. If all predictions use the same two #' symbols that are used for the labels, categorical predictions are #' assumed. If there are more than two predicted values, but all numeric, #' continuous predictions are assumed (i.e. a scoring #' classifier). Otherwise, if more than two symbols occur in the #' predictions, and not all of them are numeric, execution stops with an #' error message. #' #' @param predictions A vector, matrix, list, or data frame containing the #' predictions. #' @param labels A vector, matrix, list, or data frame containing the true class #' labels. Must have the same dimensions as \code{predictions}. #' @param label.ordering The default ordering (cf.details) of the classes can #' be changed by supplying a vector containing the negative and the positive #' class label. #' #' @return An S4 object of class \code{prediction}. #' #' @references #' A detailed list of references can be found on the ROCR homepage at #' \url{http://rocr.bioinf.mpi-sb.mpg.de}. #' #' @author #' Tobias Sing \email{tobias.sing@gmail.com}, Oliver Sander #' \email{osander@gmail.com} #' #' @seealso #' \code{\link{prediction-class}}, #' \code{\link{performance}}, #' \code{\link{performance-class}}, #' \code{\link{plot.performance}} #' #' @export #' #' @examples #' # create a simple prediction object #' library(ROCR) #' data(ROCR.simple) #' pred <- prediction(ROCR.simple$predictions,ROCR.simple$labels) #' pred prediction <- function(predictions, labels, label.ordering=NULL) { ## bring 'predictions' and 'labels' into list format, ## each list entry representing one x-validation run ## convert predictions into canonical list format if (is.data.frame(predictions)) { names(predictions) <- c() predictions <- as.list(predictions) } else if (is.matrix(predictions)) { predictions <- as.list(data.frame(predictions)) names(predictions) <- c() } else if (is.vector(predictions) && !is.list(predictions)) { predictions <- list(predictions) } else if (!is.list(predictions)) { stop("Format of predictions is invalid. It couldn't be coerced to a list.", call. = FALSE) } ## if predictions is a list -> keep unaltered if(any(vapply(predictions,anyNA,logical(1)))){ stop("'predictions' contains NA.", call. = FALSE) } ## convert labels into canonical list format if (is.data.frame(labels)) { names(labels) <- c() labels <- as.list( labels) } else if (is.matrix(labels)) { labels <- as.list( data.frame( labels)) names(labels) <- c() } else if ((is.vector(labels) || is.ordered(labels) || is.factor(labels)) && !is.list(labels)) { labels <- list( labels) } else if (!is.list(labels)) { stop("Format of labels is invalid. It couldn't be coerced to a list.", call. = FALSE) } ## if labels is a list -> keep unaltered ## Length consistency checks if (length(predictions) != length(labels)) stop(paste("Number of cross-validation runs must be equal", "for predictions and labels.")) if (! all(sapply(predictions, length) == sapply(labels, length))) stop(paste("Number of predictions in each run must be equal", "to the number of labels for each run.")) ## only keep prediction/label pairs that are finite numbers for (i in 1:length(predictions)) { finite.bool <- is.finite( predictions[[i]] ) predictions[[i]] <- predictions[[i]][ finite.bool ] labels[[i]] <- labels[[i]][ finite.bool ] } ## abort if 'labels' format is inconsistent across ## different cross-validation runs label.format="" ## one of 'normal','factor','ordered' if (all(sapply( labels, is.factor)) && !any(sapply(labels, is.ordered))) { label.format <- "factor" } else if (all(sapply( labels, is.ordered))) { label.format <- "ordered" } else if (all(sapply( labels, is.character)) || all(sapply( labels, is.numeric)) || all(sapply( labels, is.logical))) { label.format <- "normal" } else { stop(paste("Inconsistent label data type across different", "cross-validation runs.")) } ## abort if levels are not consistent across different ## cross-validation runs if (! all(sapply(labels, levels)==levels(labels[[1]])) ) { stop(paste("Inconsistent factor levels across different", "cross-validation runs.")) } ## convert 'labels' into ordered factors, aborting if the number ## of classes is not equal to 2. levels <- c() if ( label.format == "ordered" ) { if (!is.null(label.ordering)) { stop(paste("'labels' is already ordered. No additional", "'label.ordering' must be supplied.")) } else { levels <- levels(labels[[1]]) } } else { if ( is.null( label.ordering )) { if ( label.format == "factor" ) levels <- sort(levels(labels[[1]])) else levels <- sort( unique( unlist( labels))) } else { ## if (!setequal( levels, label.ordering)) { if (!setequal( unique(unlist(labels)), label.ordering )) { stop("Label ordering does not match class labels.") } levels <- label.ordering } for (i in 1:length(labels)) { if (is.factor(labels)) labels[[i]] <- ordered(as.character(labels[[i]]), levels=levels) else labels[[i]] <- ordered( labels[[i]], levels=levels) } } if (length(levels) != 2) { message <- paste("Number of classes is not equal to 2.\n", "ROCR currently supports only evaluation of ", "binary classification tasks.",sep="") stop(message) } ## determine whether predictions are continuous or categorical ## (in the latter case stop; scheduled for the next ROCR version) if (!is.numeric( unlist( predictions ))) { stop("Currently, only continuous predictions are supported by ROCR.") } ## compute cutoff/fp/tp data cutoffs <- list() fp <- list() tp <- list() fn <- list() tn <- list() n.pos <- list() n.neg <- list() n.pos.pred <- list() n.neg.pred <- list() for (i in 1:length(predictions)) { n.pos <- c( n.pos, sum( labels[[i]] == levels[2] )) n.neg <- c( n.neg, sum( labels[[i]] == levels[1] )) ans <- .compute.unnormalized.roc.curve( predictions[[i]], labels[[i]] ) cutoffs <- c( cutoffs, list( ans$cutoffs )) fp <- c( fp, list( ans$fp )) tp <- c( tp, list( ans$tp )) fn <- c( fn, list( n.pos[[i]] - tp[[i]] )) tn <- c( tn, list( n.neg[[i]] - fp[[i]] )) n.pos.pred <- c(n.pos.pred, list(tp[[i]] + fp[[i]]) ) n.neg.pred <- c(n.neg.pred, list(tn[[i]] + fn[[i]]) ) } return( new("prediction", predictions=predictions, labels=labels, cutoffs=cutoffs, fp=fp, tp=tp, fn=fn, tn=tn, n.pos=n.pos, n.neg=n.neg, n.pos.pred=n.pos.pred, n.neg.pred=n.neg.pred)) } ## fast fp/tp computation based on cumulative summing .compute.unnormalized.roc.curve <- function( predictions, labels ) { ## determine the labels that are used for the pos. resp. neg. class : pos.label <- levels(labels)[2] neg.label <- levels(labels)[1] pred.order <- order(predictions, decreasing=TRUE) predictions.sorted <- predictions[pred.order] tp <- cumsum(labels[pred.order]==pos.label) fp <- cumsum(labels[pred.order]==neg.label) ## remove fp & tp for duplicated predictions ## as duplicated keeps the first occurrence, but we want the last, two ## rev are used. ## Highest cutoff (Infinity) corresponds to tp=0, fp=0 dups <- rev(duplicated(rev(predictions.sorted))) tp <- c(0, tp[!dups]) fp <- c(0, fp[!dups]) cutoffs <- c(Inf, predictions.sorted[!dups]) return(list( cutoffs=cutoffs, fp=fp, tp=tp )) } ROCR/R/performance.R0000644000176200001440000006432713644317760013673 0ustar liggesusers #' @name performance #' #' @title Function to create performance objects #' #' @description #' All kinds of predictor evaluations are performed using this function. #' #' @details #' Here is the list of available performance measures. Let Y and #' \eqn{\hat{Y}}{Yhat} be random variables representing the class and the prediction for #' a randomly drawn sample, respectively. We denote by #' \eqn{\oplus}{+} and \eqn{\ominus}{-} the positive and #' negative class, respectively. Further, we use the following #' abbreviations for empirical quantities: P (\# positive #' samples), N (\# negative samples), TP (\# true positives), TN (\# true #' negatives), FP (\# false positives), FN (\# false negatives). #' \describe{ #' \item{\code{acc}:}{Accuracy. \eqn{P(\hat{Y}=Y)}{P(Yhat = Y)}. Estimated #' as: \eqn{\frac{TP+TN}{P+N}}{(TP+TN)/(P+N)}.} #' \item{\code{err}:}{Error rate. \eqn{P(\hat{Y}\ne Y)}{P(Yhat != #' Y)}. Estimated as: \eqn{\frac{FP+FN}{P+N}}{(FP+FN)/(P+N)}.} #' \item{\code{fpr}:}{False positive rate. \eqn{P(\hat{Y}=\oplus | Y = #' \ominus)}{P(Yhat = + | Y = -)}. Estimated as: #' \eqn{\frac{FP}{N}}{FP/N}.} #' \item{\code{fall}:}{Fallout. Same as \code{fpr}.} #' \item{\code{tpr}:}{True positive #' rate. \eqn{P(\hat{Y}=\oplus|Y=\oplus)}{P(Yhat = + | Y = +)}. Estimated #' as: \eqn{\frac{TP}{P}}{TP/P}.} #' \item{\code{rec}:}{Recall. Same as \code{tpr}.} #' \item{\code{sens}:}{Sensitivity. Same as \code{tpr}.} #' \item{\code{fnr}:}{False negative #' rate. \eqn{P(\hat{Y}=\ominus|Y=\oplus)}{P(Yhat = - | Y = #' +)}. Estimated as: \eqn{\frac{FN}{P}}{FN/P}.} #' \item{\code{miss}:}{Miss. Same as \code{fnr}.} #' \item{\code{tnr}:}{True negative rate. \eqn{P(\hat{Y} = #' \ominus|Y=\ominus)}{P(Yhat = - | Y = -)}.} #' \item{\code{spec}:}{Specificity. Same as \code{tnr}.} #' \item{\code{ppv}:}{Positive predictive #' value. \eqn{P(Y=\oplus|\hat{Y}=\oplus)}{P(Y = + | Yhat = #' +)}. Estimated as: \eqn{\frac{TP}{TP+FP}}{TP/(TP+FP)}.} #' \item{\code{prec}:}{Precision. Same as \code{ppv}.} #' \item{\code{npv}:}{Negative predictive #' value. \eqn{P(Y=\ominus|\hat{Y}=\ominus)}{P(Y = - | Yhat = #' -)}. Estimated as: \eqn{\frac{TN}{TN+FN}}{TN/(TN+FN)}.} #' \item{\code{pcfall}:}{Prediction-conditioned #' fallout. \eqn{P(Y=\ominus|\hat{Y}=\oplus)}{P(Y = - | Yhat = #' +)}. Estimated as: \eqn{\frac{FP}{TP+FP}}{FP/(TP+FP)}.} #' \item{\code{pcmiss}:}{Prediction-conditioned #' miss. \eqn{P(Y=\oplus|\hat{Y}=\ominus)}{P(Y = + | Yhat = #' -)}. Estimated as: \eqn{\frac{FN}{TN+FN}}{FN/(TN+FN)}.} #' \item{\code{rpp}:}{Rate of positive predictions. \eqn{P( \hat{Y} = #' \oplus)}{P(Yhat = +)}. Estimated as: (TP+FP)/(TP+FP+TN+FN).} #' \item{\code{rnp}:}{Rate of negative predictions. \eqn{P( \hat{Y} = #' \ominus)}{P(Yhat = -)}. Estimated as: (TN+FN)/(TP+FP+TN+FN).} #' \item{\code{phi}:}{Phi correlation coefficient. \eqn{\frac{TP \cdot #' TN - FP \cdot FN}{\sqrt{ (TP+FN) \cdot (TN+FP) \cdot (TP+FP) #' \cdot (TN+FN)}}}{(TP*TN - #' FP*FN)/(sqrt((TP+FN)*(TN+FP)*(TP+FP)*(TN+FN)))}. Yields a #' number between -1 and 1, with 1 indicating a perfect #' prediction, 0 indicating a random prediction. Values below 0 #' indicate a worse than random prediction.} #' \item{\code{mat}:}{Matthews correlation coefficient. Same as \code{phi}.} #' \item{\code{mi}:}{Mutual information. \eqn{I(\hat{Y},Y) := H(Y) - #' H(Y|\hat{Y})}{I(Yhat, Y) := H(Y) - H(Y | Yhat)}, where H is the #' (conditional) entropy. Entropies are estimated naively (no bias #' correction).} #' \item{\code{chisq}:}{Chi square test statistic. \code{?chisq.test} #' for details. Note that R might raise a warning if the sample size #' is too small.} #' \item{\code{odds}:}{Odds ratio. \eqn{\frac{TP \cdot TN}{FN \cdot #' FP}}{(TP*TN)/(FN*FP)}. Note that odds ratio produces #' Inf or NA values for all cutoffs corresponding to FN=0 or #' FP=0. This can substantially decrease the plotted cutoff region.} #' \item{\code{lift}:}{Lift #' value. \eqn{\frac{P(\hat{Y}=\oplus|Y=\oplus)}{P(\hat{Y}=\oplus)}}{P(Yhat = + | #' Y = +)/P(Yhat = +)}.} #' \item{\code{f}:}{Precision-recall F measure (van Rijsbergen, 1979). Weighted #' harmonic mean of precision (P) and recall (R). \eqn{F = #' \frac{1}{\alpha \frac{1}{P} + (1-\alpha)\frac{1}{R}}}{F = 1/ #' (alpha*1/P + (1-alpha)*1/R)}. If #' \eqn{\alpha=\frac{1}{2}}{alpha=1/2}, the mean is balanced. A #' frequent equivalent formulation is #' \eqn{F = \frac{(\beta^2+1) \cdot P \cdot R}{R + \beta^2 \cdot #' P}}{F = (beta^2+1) * P * R / (R + beta^2 * P)}. In this formulation, the #' mean is balanced if \eqn{\beta=1}{beta=1}. Currently, ROCR only accepts #' the alpha version as input (e.g. \eqn{\alpha=0.5}{alpha=0.5}). If no #' value for alpha is given, the mean will be balanced by default.} #' \item{\code{rch}:}{ROC convex hull. A ROC (=\code{tpr} vs \code{fpr}) curve #' with concavities (which represent suboptimal choices of cutoff) removed #' (Fawcett 2001). Since the result is already a parametric performance #' curve, it cannot be used in combination with other measures.} #' \item{\code{auc}:}{Area under the ROC curve. This is equal to the value of the #' Wilcoxon-Mann-Whitney test statistic and also the probability that the #' classifier will score are randomly drawn positive sample higher than a #' randomly drawn negative sample. Since the output of #' \code{auc} is cutoff-independent, this #' measure cannot be combined with other measures into a parametric #' curve. The partial area under the ROC curve up to a given false #' positive rate can be calculated by passing the optional parameter #' \code{fpr.stop=0.5} (or any other value between 0 and 1) to #' \code{performance}.} #' \item{\code{aucpr}:}{Area under the Precision/Recall curve. Since the output #' of \code{aucpr} is cutoff-independent, this measure cannot be combined #' with other measures into a parametric curve.} #' \item{\code{prbe}:}{Precision-recall break-even point. The cutoff(s) where #' precision and recall are equal. At this point, positive and negative #' predictions are made at the same rate as their prevalence in the #' data. Since the output of #' \code{prbe} is just a cutoff-independent scalar, this #' measure cannot be combined with other measures into a parametric curve.} #' \item{\code{cal}:}{Calibration error. The calibration error is the #' absolute difference between predicted confidence and actual reliability. This #' error is estimated at all cutoffs by sliding a window across the #' range of possible cutoffs. The default window size of 100 can be #' adjusted by passing the optional parameter \code{window.size=200} #' to \code{performance}. E.g., if for several #' positive samples the output of the classifier is around 0.75, you might #' expect from a well-calibrated classifier that the fraction of them #' which is correctly predicted as positive is also around 0.75. In a #' well-calibrated classifier, the probabilistic confidence estimates #' are realistic. Only for use with #' probabilistic output (i.e. scores between 0 and 1).} #' \item{\code{mxe}:}{Mean cross-entropy. Only for use with #' probabilistic output. \eqn{MXE :=-\frac{1}{P+N}( \sum_{y_i=\oplus} #' ln(\hat{y}_i) + \sum_{y_i=\ominus} ln(1-\hat{y}_i))}{MXE := - 1/(P+N) \sum_{y_i=+} #' ln(yhat_i) + \sum_{y_i=-} ln(1-yhat_i)}. Since the output of #' \code{mxe} is just a cutoff-independent scalar, this #' measure cannot be combined with other measures into a parametric curve.} #' \item{\code{rmse}:}{Root-mean-squared error. Only for use with #' numerical class labels. \eqn{RMSE:=\sqrt{\frac{1}{P+N}\sum_i (y_i #' - \hat{y}_i)^2}}{RMSE := sqrt(1/(P+N) \sum_i (y_i - #' yhat_i)^2)}. Since the output of #' \code{rmse} is just a cutoff-independent scalar, this #' measure cannot be combined with other measures into a parametric curve.} #' \item{\code{sar}:}{Score combinining performance measures of different #' characteristics, in the attempt of creating a more "robust" #' measure (cf. Caruana R., ROCAI2004): #' SAR = 1/3 * ( Accuracy + Area under the ROC curve + Root #' mean-squared error ).} #' \item{\code{ecost}:}{Expected cost. For details on cost curves, #' cf. Drummond&Holte 2000,2004. \code{ecost} has an obligatory x #' axis, the so-called 'probability-cost function'; thus it cannot be #' combined with other measures. While using \code{ecost} one is #' interested in the lower envelope of a set of lines, it might be #' instructive to plot the whole set of lines in addition to the lower #' envelope. An example is given in \code{demo(ROCR)}.} #' \item{\code{cost}:}{Cost of a classifier when #' class-conditional misclassification costs are explicitly given. #' Accepts the optional parameters \code{cost.fp} and #' \code{cost.fn}, by which the costs for false positives and #' negatives can be adjusted, respectively. By default, both are set #' to 1.} #' } #' #' @note #' Here is how to call \code{performance()} to create some standard #' evaluation plots: #' \describe{ #' \item{ROC curves:}{measure="tpr", x.measure="fpr".} #' \item{Precision/recall graphs:}{measure="prec", x.measure="rec".} #' \item{Sensitivity/specificity plots:}{measure="sens", x.measure="spec".} #' \item{Lift charts:}{measure="lift", x.measure="rpp".} #' } #' #' @param prediction.obj An object of class \code{prediction}. #' @param measure Performance measure to use for the evaluation. A complete list #' of the performance measures that are available for \code{measure} and #' \code{x.measure} is given in the 'Details' section. #' @param x.measure A second performance measure. If different from the default, #' a two-dimensional curve, with \code{x.measure} taken to be the unit in #' direction of the x axis, and \code{measure} to be the unit in direction of #' the y axis, is created. This curve is parametrized with the cutoff. #' @param ... Optional arguments (specific to individual performance measures). #' #' @return An S4 object of class \code{performance}. #' #' @references #' A detailed list of references can be found on the ROCR homepage at #' \url{http://rocr.bioinf.mpi-sb.mpg.de}. #' #' @author #' Tobias Sing \email{tobias.sing@gmail.com}, Oliver Sander #' \email{osander@gmail.com} #' #' @seealso #' \code{\link{prediction}}, #' \code{\link{prediction-class}}, #' \code{\link{performance-class}}, #' \code{\link{plot.performance}} #' #' @export #' #' @examples #' # computing a simple ROC curve (x-axis: fpr, y-axis: tpr) #' library(ROCR) #' data(ROCR.simple) #' pred <- prediction( ROCR.simple$predictions, ROCR.simple$labels) #' pred #' perf <- performance(pred,"tpr","fpr") #' perf #' plot(perf) #' #' # precision/recall curve (x-axis: recall, y-axis: precision) #' perf <- performance(pred, "prec", "rec") #' perf #' plot(perf) #' #' # sensitivity/specificity curve (x-axis: specificity, #' # y-axis: sensitivity) #' perf <- performance(pred, "sens", "spec") #' perf #' plot(perf) performance <- function(prediction.obj, measure, x.measure="cutoff", ...) { ## define the needed environments envir.list <- .define.environments() long.unit.names <- envir.list$long.unit.names function.names <- envir.list$function.names obligatory.x.axis <- envir.list$obligatory.x.axis optional.arguments <- envir.list$optional.arguments default.values <- envir.list$default.values ## abort in case of misuse if (class(prediction.obj) != 'prediction' || !exists(measure, where=long.unit.names, inherits=FALSE) || !exists(x.measure, where=long.unit.names, inherits=FALSE)) { stop(paste("Wrong argument types: First argument must be of type", "'prediction'; second and optional third argument must", "be available performance measures!")) } ## abort, if attempt is made to use a measure that has an obligatory ## x.axis as the x.measure (cannot be combined) if (exists( x.measure, where=obligatory.x.axis, inherits=FALSE )) { message <- paste("The performance measure", x.measure, "can only be used as 'measure', because it has", "the following obligatory 'x.measure':\n", get( x.measure, envir=obligatory.x.axis)) stop(message) } ## if measure is a performance measure with obligatory x.axis, then ## enforce this axis: if (exists( measure, where=obligatory.x.axis, inherits=FALSE )) { x.measure <- get( measure, envir=obligatory.x.axis ) } if (x.measure == "cutoff" || exists( measure, where=obligatory.x.axis, inherits=FALSE )) { ## fetch from '...' any optional arguments for the performance ## measure at hand that are given, otherwise fill up the default values optional.args <- list(...) argnames <- c() if ( exists( measure, where=optional.arguments, inherits=FALSE )) { argnames <- get( measure, envir=optional.arguments ) default.arglist <- list() for (i in 1:length(argnames)) { default.arglist <- c(default.arglist, get(paste(measure,":",argnames[i],sep=""), envir=default.values, inherits=FALSE)) } names(default.arglist) <- argnames for (i in 1:length(argnames)) { templist <- list(optional.args, default.arglist[[i]]) names(templist) <- c('arglist', argnames[i]) optional.args <- do.call('.farg', templist) } } optional.args <- .select.args( optional.args, argnames ) ## determine function name function.name <- get( measure, envir=function.names ) ## for each x-validation run, compute the requested performance measure x.values <- list() y.values <- list() for (i in 1:length( prediction.obj@predictions )) { argumentlist <- .sarg(optional.args, predictions= prediction.obj@predictions[[i]], labels= prediction.obj@labels[[i]], cutoffs= prediction.obj@cutoffs[[i]], fp= prediction.obj@fp[[i]], tp= prediction.obj@tp[[i]], fn= prediction.obj@fn[[i]], tn= prediction.obj@tn[[i]], n.pos= prediction.obj@n.pos[[i]], n.neg= prediction.obj@n.neg[[i]], n.pos.pred= prediction.obj@n.pos.pred[[i]], n.neg.pred= prediction.obj@n.neg.pred[[i]]) ans <- do.call( function.name, argumentlist ) if (!is.null(ans[[1]])) x.values <- c( x.values, list( ans[[1]] )) y.values <- c( y.values, list( ans[[2]] )) } if (! (length(x.values)==0 || length(x.values)==length(y.values)) ) { stop("Consistency error.") } ## create a new performance object return( new("performance", x.name = get( x.measure, envir=long.unit.names ), y.name = get( measure, envir=long.unit.names ), alpha.name = "none", x.values = x.values, y.values = y.values, alpha.values = list() )) } else { perf.obj.1 <- performance( prediction.obj, measure=x.measure, ... ) perf.obj.2 <- performance( prediction.obj, measure=measure, ... ) return( .combine.performance.objects( perf.obj.1, perf.obj.2 ) ) } } #' @importFrom stats approxfun .combine.performance.objects <- function( p.obj.1, p.obj.2 ) { ## some checks for misusage (in any way, this function is ## only for internal use) if ( p.obj.1@x.name != p.obj.2@x.name ) { stop("Error: Objects need to have identical x axis.") } if ( p.obj.1@alpha.name != "none" || p.obj.2@alpha.name != "none") { stop("Error: At least one of the two objects has already been merged.") } if (length(p.obj.1@x.values) != length(p.obj.2@x.values)) { stop(paste("Only performance objects with identical number of", "cross-validation runs can be combined.")) } x.values <- list() x.name <- p.obj.1@y.name y.values <- list() y.name <- p.obj.2@y.name alpha.values <- list() alpha.name <- p.obj.1@x.name for (i in 1:length( p.obj.1@x.values )) { x.values.1 <- p.obj.1@x.values[[i]] y.values.1 <- p.obj.1@y.values[[i]] x.values.2 <- p.obj.2@x.values[[i]] y.values.2 <- p.obj.2@y.values[[i]] ## cutoffs of combined object = merged cutoffs of simple objects cutoffs <- sort( unique( c(x.values.1, x.values.2)), decreasing=TRUE ) ## calculate y.values at cutoffs using step function y.values.int.1 <- stats::approxfun(x.values.1, y.values.1, method="constant",f=1,rule=2)(cutoffs) y.values.int.2 <- stats::approxfun(x.values.2, y.values.2, method="constant",f=1,rule=2)(cutoffs) ## 'approxfun' ignores NA and NaN objs <- list( y.values.int.1, y.values.int.2) objs.x <- list( x.values.1, x.values.2 ) na.cutoffs.1.bool <- is.na( y.values.1) & !is.nan( y.values.1 ) nan.cutoffs.1.bool <- is.nan( y.values.1) na.cutoffs.2.bool <- is.na( y.values.2) & !is.nan( y.values.2 ) nan.cutoffs.2.bool <- is.nan( y.values.2) bools <- list(na.cutoffs.1.bool, nan.cutoffs.1.bool, na.cutoffs.2.bool, nan.cutoffs.2.bool) values <- c(NA,NaN,NA,NaN) for (j in 1:4) { for (k in which(bools[[j]])) { interval.max <- objs.x[[ ceiling(j/2) ]][k] interval.min <- -Inf if (k < length(objs.x[[ ceiling(j/2) ]])) { interval.min <- objs.x[[ ceiling(j/2) ]][k+1] } objs[[ ceiling(j/2) ]][cutoffs <= interval.max & cutoffs > interval.min ] <- values[j] } } alpha.values <- c(alpha.values, list(cutoffs)) x.values <- c(x.values, list(objs[[1]])) y.values <- c(y.values, list(objs[[2]])) } return( new("performance", x.name=x.name, y.name=y.name, alpha.name=alpha.name, x.values=x.values, y.values=y.values, alpha.values=alpha.values)) } .define.environments <- function() { ## There are five environments: long.unit.names, function.names, ## obligatory.x.axis, optional.arguments, default.values ## Define long names corresponding to the measure abbreviations. long.unit.names <- new.env() assign("none","None", envir=long.unit.names) assign("cutoff", "Cutoff", envir=long.unit.names) assign("acc", "Accuracy", envir=long.unit.names) assign("err", "Error Rate", envir=long.unit.names) assign("fpr", "False positive rate", envir=long.unit.names) assign("tpr", "True positive rate", envir=long.unit.names) assign("rec", "Recall", envir=long.unit.names) assign("sens", "Sensitivity", envir=long.unit.names) assign("fnr", "False negative rate", envir=long.unit.names) assign("tnr", "True negative rate", envir=long.unit.names) assign("spec", "Specificity", envir=long.unit.names) assign("ppv", "Positive predictive value", envir=long.unit.names) assign("prec", "Precision", envir=long.unit.names) assign("npv", "Negative predictive value", envir=long.unit.names) assign("fall", "Fallout", envir=long.unit.names) assign("miss", "Miss", envir=long.unit.names) assign("pcfall", "Prediction-conditioned fallout", envir=long.unit.names) assign("pcmiss", "Prediction-conditioned miss", envir=long.unit.names) assign("rpp", "Rate of positive predictions", envir=long.unit.names) assign("rnp", "Rate of negative predictions", envir=long.unit.names) assign("auc","Area under the ROC curve", envir=long.unit.names) assign("aucpr","Area under the Precision/Recall curve", envir=long.unit.names) assign("cal", "Calibration error", envir=long.unit.names) assign("mwp", "Median window position", envir=long.unit.names) assign("prbe","Precision/recall break-even point", envir=long.unit.names) assign("rch", "ROC convex hull", envir=long.unit.names) assign("mxe", "Mean cross-entropy", envir=long.unit.names) assign("rmse","Root-mean-square error", envir=long.unit.names) assign("phi", "Phi correlation coefficient", envir=long.unit.names) assign("mat","Matthews correlation coefficient", envir=long.unit.names) assign("mi", "Mutual information", envir=long.unit.names) assign("chisq", "Chi-square test statistic", envir=long.unit.names) assign("odds","Odds ratio", envir=long.unit.names) assign("lift", "Lift value", envir=long.unit.names) assign("f","Precision-Recall F measure", envir=long.unit.names) assign("sar", "SAR", envir=long.unit.names) assign("ecost", "Expected cost", envir=long.unit.names) assign("cost", "Explicit cost", envir=long.unit.names) ## Define function names corresponding to the measure abbreviations. function.names <- new.env() assign("acc", ".performance.accuracy", envir=function.names) assign("err", ".performance.error.rate", envir=function.names) assign("fpr", ".performance.false.positive.rate", envir=function.names) assign("tpr", ".performance.true.positive.rate", envir=function.names) assign("rec", ".performance.true.positive.rate", envir=function.names) assign("sens", ".performance.true.positive.rate", envir=function.names) assign("fnr", ".performance.false.negative.rate", envir=function.names) assign("tnr", ".performance.true.negative.rate", envir=function.names) assign("spec", ".performance.true.negative.rate", envir=function.names) assign("ppv", ".performance.positive.predictive.value", envir=function.names) assign("prec", ".performance.positive.predictive.value", envir=function.names) assign("npv", ".performance.negative.predictive.value", envir=function.names) assign("fall", ".performance.false.positive.rate", envir=function.names) assign("miss", ".performance.false.negative.rate", envir=function.names) assign("pcfall", ".performance.prediction.conditioned.fallout", envir=function.names) assign("pcmiss", ".performance.prediction.conditioned.miss", envir=function.names) assign("rpp", ".performance.rate.of.positive.predictions", envir=function.names) assign("rnp", ".performance.rate.of.negative.predictions", envir=function.names) assign("auc", ".performance.auc", envir=function.names) assign("aucpr", ".performance.aucpr", envir=function.names) assign("cal", ".performance.calibration.error", envir=function.names) assign("prbe", ".performance.precision.recall.break.even.point", envir=function.names) assign("rch", ".performance.rocconvexhull", envir=function.names) assign("mxe", ".performance.mean.cross.entropy", envir=function.names) assign("rmse", ".performance.root.mean.squared.error", envir=function.names) assign("phi", ".performance.phi", envir=function.names) assign("mat", ".performance.phi", envir=function.names) assign("mi", ".performance.mutual.information", envir=function.names) assign("chisq", ".performance.chisq", envir=function.names) assign("odds", ".performance.odds.ratio", envir=function.names) assign("lift", ".performance.lift", envir=function.names) assign("f", ".performance.f", envir=function.names) assign("sar", ".performance.sar", envir=function.names) assign("ecost", ".performance.expected.cost", envir=function.names) assign("cost", ".performance.cost", envir=function.names) ## If a measure comes along with an obligatory x axis (including "none"), ## list it here. obligatory.x.axis <- new.env() assign("mxe", "none", envir=obligatory.x.axis) assign("rmse", "none", envir=obligatory.x.axis) assign("prbe", "none", envir=obligatory.x.axis) assign("auc", "none", envir=obligatory.x.axis) assign("aucpr", "none", envir=obligatory.x.axis) assign("rch","none", envir=obligatory.x.axis) ## ecost requires probability cost function as x axis, which is handled ## implicitly, not as an explicit performance measure. assign("ecost","none", envir=obligatory.x.axis) ## If a measure has optional arguments, list the names of the ## arguments here. optional.arguments <- new.env() assign("cal", "window.size", envir=optional.arguments) assign("f", "alpha", envir=optional.arguments) assign("cost", c("cost.fp", "cost.fn"), envir=optional.arguments) assign("auc", "fpr.stop", envir=optional.arguments) ## If a measure has additional arguments, list the default values ## for them here. Naming convention: e.g. "cal" has an optional ## argument "window.size" the key to use here is "cal:window.size" ## (colon as separator) default.values <- new.env() assign("cal:window.size", 100, envir=default.values) assign("f:alpha", 0.5, envir=default.values) assign("cost:cost.fp", 1, envir=default.values) assign("cost:cost.fn", 1, envir=default.values) assign("auc:fpr.stop", 1, envir=default.values) list(long.unit.names=long.unit.names, function.names=function.names, obligatory.x.axis=obligatory.x.axis, optional.arguments=optional.arguments, default.values=default.values) } ROCR/MD50000644000176200001440000000345113653304235011336 0ustar liggesusers929ef2ee7c82a205c4fded5df765f9c8 *DESCRIPTION 0b7ae19d64f9121936826eeda3ced802 *NAMESPACE dfdef656b14071451bfb81f8d85b3b2a *NEWS 8e6acd7985738b147021f586f43b8cc9 *R/ROCR_aux.R 28402caac5f47efeb58e83605f2505ae *R/performance.R 673949c7018967d2da4953a31cdeaca3 *R/performance_measures.R a89d501af16fac35a0dc2b906c90a0b0 *R/performance_plots.R 9ccdabe4d7a34ac3064cd7072c90c0f4 *R/prediction.R ce90a669e702dd3d19c493b6b64aadd6 *R/zzz.R 06c18c051b3ff0ca5a8a52092536ff6c *README.md 78bc8fc994f58c40855e9b5d3a3cc8b0 *build/vignette.rds 497d34bf928630ed582476e043a68f18 *data/ROCR.hiv.rda a6b723208917a41ca8d978a95640f1cc *data/ROCR.simple.rda e4d3b38035f21f0bd36606cd08b3ded3 *data/ROCR.xval.rda 4593314ea62a4f184e25aceee2a3cfd0 *demo/00Index 4ba4a692fa050d2312b3e3ca9091297f *demo/ROCR.R ef242c30ca9435d9e24ea628ff72c9f2 *inst/CITATION 48170ca7d35c60f48b51c4e4147f48db *inst/doc/ROCR.R a6c6b0c84749fc981777a92e3e0aa2b3 *inst/doc/ROCR.Rmd 2da0b49b86c07abfec184af714cf0ccc *inst/doc/ROCR.html 9ff3521d7c646083d76fc763457a1bce *man/ROCR.hiv.Rd 0fce1efd4305836eee19c9d4cc1a7783 *man/ROCR.simple.Rd a27a1275f2d024d7d0450fdc595e9809 *man/ROCR.xval.Rd 37afb1c91d0dd8014eb973bd1503d8df *man/performance-class.Rd 894a204e6baa20af0e3e8a3e7b375a45 *man/performance.Rd bdf004b37bcdb7b5896a3547b658f82a *man/plot-methods.Rd 2936c65a04e2ebed0f46e21222c82e45 *man/prediction-class.Rd da8e113c7be063983cdd4608c629124a *man/prediction.Rd c3cd3ed4bdaeb75a7bc7ebdcfcaa628e *tests/testthat.R 3f54ab8be1a9f704174f871841be018d *tests/testthat/test-aux.r 6e418f64b7f1b75fdb0abf37c56cdaf2 *tests/testthat/test-consistency.r de0e4e7a6b743412fa1471d75f307759 *tests/testthat/test-plot.r a4ccef13e877457c73070bddb4c878a1 *tests/testthat/test-simple.r a6c6b0c84749fc981777a92e3e0aa2b3 *vignettes/ROCR.Rmd f4d20c7bb157b62a464cc624772b4711 *vignettes/references.bibtex ROCR/inst/0000755000176200001440000000000013653005532011776 5ustar liggesusersROCR/inst/doc/0000755000176200001440000000000013653005532012543 5ustar liggesusersROCR/inst/doc/ROCR.R0000644000176200001440000001604413653005532013440 0ustar liggesusers## ---- include = FALSE--------------------------------------------------------- knitr::opts_chunk$set( collapse = TRUE, comment = "#>" ) ## ----setup-------------------------------------------------------------------- library(ROCR) ## ---- echo = FALSE, results = 'asis'------------------------------------------ table <- data.frame(group = c("Contingency ratios", "Discrete covariation measures", "Information retrieval measures", "Performance in ROC space", "Absolute scoring performance", "Cost measures"), measure = c("error rate, accuracy, sensitivity, specificity, true/false positive rate, fallout, miss, precision, recall, negative predictive value, prediction-conditioned fallout/miss.", "Phi/Matthews correlation coefficient, mutual information, Chi-squared test statistic, odds ratio", "F-measure, lift, precision-recall break-even point", "ROC convex hull, area under the ROC curve", "calibration error, mean cross-entropy, root mean-squared error", "expected cost, explicit cost")) knitr::kable(table, caption = "***Table 1:**Performance measures in the ROCR package*", col.names = c("",""), align = "l") ## ----------------------------------------------------------------------------- data(ROCR.hiv) predictions <- ROCR.hiv$hiv.svm$predictions labels <- ROCR.hiv$hiv.svm$labels pred <- prediction(predictions, labels) pred ## ---- fig.asp=1, fig.width=5, fig.align='center'------------------------------ perf <- performance(pred, "tpr", "fpr") perf plot(perf, avg="threshold", spread.estimate="boxplot") ## ---- echo=FALSE, results='asis', fig.asp=0.35, fig.width=7, fig.align='center',fig.cap="***Fig 1:** Visualizations of classifier performance (HIV coreceptor usage data): (a) receiver operating characteristic (ROC) curve; (b) peak accuracy across a range of cutoffs; (c) absolute difference between empirical and predicted rate of positives for windowed cutoff ranges, in order to evaluate how well the scores are calibrated as probability estimates. Owing to the probabilistic interpretation, cutoffs need to be in the interval [0,1], in contrast to other performance plots. (d) Score density estimates for the negative (solid) and positive (dotted) class.*"---- data(ROCR.hiv) pp.unnorm <- ROCR.hiv$hiv.svm$predictions ll <- ROCR.hiv$hiv.svm$labels # normalize predictions to 0..1 v <- unlist(pp.unnorm) pp <- lapply(pp.unnorm, function(run) {approxfun(c(min(v), max(v)), c(0,1))(run)}) par(mfrow=c(1,4)) pred<- prediction(pp, ll) perf <- performance(pred, "tpr", "fpr") plot(perf, avg= "threshold", colorize=TRUE, lwd= 3, coloraxis.at=seq(0,1,by=0.2),) plot(perf, col="gray78", add=TRUE) plot(perf, avg= "threshold", colorize=TRUE, colorkey=FALSE,lwd= 3,,add=TRUE) mtext(paste0("(a)"), side = 3, adj = 0.01,line = 1) perf <- performance(pred, "acc") plot(perf, avg= "vertical", spread.estimate="boxplot", lwd=3,col='blue', show.spread.at= seq(0.1, 0.9, by=0.1),) mtext(paste0("(b)"), side = 3, adj = 0.01,line = 1) plot(performance(pred, "cal", window.size= 10), avg="vertical",) mtext(paste0("(c)"), side = 3, adj = 0.01,line = 1) plot(0,0,type="n", xlim= c(0,1), ylim=c(0,7), xlab="Cutoff", ylab="Density",) mtext(paste0("(d)"), side = 3, adj = 0.01,line = 1) for (runi in 1:length(pred@predictions)) { lines(density(pred@predictions[[runi]][pred@labels[[runi]]=="-1"]), col= "red") lines(density(pred@predictions[[runi]][pred@labels[[runi]]=="1"]), col="green") } ## ---- fig.asp=1, fig.width=5, fig.align='center'------------------------------ perf <- performance(pred, "tpr", "fpr") plot(perf, avg= "threshold", colorize=TRUE, lwd= 3, main= "With ROCR you can produce standard plots\nlike ROC curves ...") plot(perf, lty=3, col="grey78", add=TRUE) ## ---- fig.asp=1, fig.width=5, fig.align='center'------------------------------ perf <- performance(pred, "prec", "rec") plot(perf, avg= "threshold", colorize=TRUE, lwd= 3, main= "... Precision/Recall graphs ...") plot(perf, lty=3, col="grey78", add=TRUE) ## ---- fig.asp=1, fig.width=5, fig.align='center'------------------------------ perf <- performance(pred, "sens", "spec") plot(perf, avg= "threshold", colorize=TRUE, lwd= 3, main="... Sensitivity/Specificity plots ...") plot(perf, lty=3, col="grey78", add=TRUE) ## ---- fig.asp=1, fig.width=5, fig.align='center'------------------------------ perf <- performance(pred, "lift", "rpp") plot(perf, avg= "threshold", colorize=TRUE, lwd= 3, main= "... and Lift charts.") plot(perf, lty=3, col="grey78", add=TRUE) ## ----------------------------------------------------------------------------- data(ROCR.xval) predictions <- ROCR.xval$predictions labels <- ROCR.xval$labels length(predictions) ## ----------------------------------------------------------------------------- pred <- prediction(predictions, labels) perf <- performance(pred,'tpr','fpr') ## ---- fig.asp=1, fig.width=5, fig.align='center'------------------------------ plot(perf, colorize=TRUE, lwd=2, main='ROC curves from 10-fold cross-validation') ## ---- fig.asp=1, fig.width=5, fig.align='center'------------------------------ plot(perf, avg='vertical', spread.estimate='stderror', lwd=3,main='Vertical averaging + 1 standard error', col='blue') ## ---- fig.asp=1, fig.width=5, fig.align='center'------------------------------ plot(perf, avg='horizontal', spread.estimate='boxplot', lwd=3, main='Horizontal averaging + boxplots', col='blue') ## ---- fig.asp=1, fig.width=5, fig.align='center'------------------------------ plot(perf, avg='threshold', spread.estimate='stddev', lwd=2, main='Threshold averaging + 1 standard deviation', colorize=TRUE) ## ---- fig.asp=1, fig.width=6, fig.align='center'------------------------------ plot(perf, print.cutoffs.at=seq(0,1,by=0.2), text.cex=0.8, text.y=lapply(as.list(seq(0,0.5,by=0.05)), function(x) { rep(x,length(perf@x.values[[1]])) } ), col= as.list(terrain.colors(10)), text.col= as.list(terrain.colors(10)), points.col= as.list(terrain.colors(10)), main= "Cutoff stability") ## ----------------------------------------------------------------------------- perf <- performance(pred,"pcmiss","lift") ## ---- fig.asp=1, fig.width=5, fig.align='center'------------------------------ plot(perf, colorize=TRUE, print.cutoffs.at=seq(0,1,by=0.1), text.adj=c(1.2,1.2), avg="threshold", lwd=3, main= "You can freely combine performance measures ...") ROCR/inst/doc/ROCR.html0000644000176200001440000063241413653005532014210 0ustar liggesusers ROCR: visualizing classifier performance in R

ROCR: visualizing classifier performance in R

Tobias Sing, Oliver Sander, Niko Beerenwinkel, Thomas Lengauer

Abstract

ROCR is a package for evaluating and visualizing the performance of scoring classifiers in the statistical language R. It features over 25 performance measures that can be freely combined to create two-dimensional performance curves. Standard methods for investigating trade-offs between specific performance measures are available within a uniform framework, including receiver operating characteristic (ROC) graphs, precision/recall plots, lift charts and cost curves. ROCR integrates tightly with R’s powerful graphics capabilities, thus allowing for highly adjustable plots. Being equipped with only three commands and reasonable default values for optional parameters, ROCR combines flexibility with ease of usage.

Introduction

Pattern classification has become a central tool in bioinformatics, offering rapid insights into large data sets (Baldi and Brunak 2001). While one area of our work involves predicting phenotypic properties of HIV-1 from genotypic information (Beerenwinkel et al. 2002, 2003; Sing, Beerenwinkel, and Lengauer 2004), scoring or ranking predictors are also vital in a wide range of other biological problems. Examples include microarray analysis (e.g. prediction of tissue condition based on gene expression), protein structural and functional characterization (remote homology detection, prediction of post-translational modifications and molecular function annotation based on sequence or structural motifs), genome annotation (gene finding and splice site identification), protein–ligand interactions (virtual screening and molecular docking) and structure–activity relationships (predicting bioavailability or toxicity of drug compounds). In many of these cases, considerable class skew, class-specific misclassification costs, and extensive noise due to variability in experimental assays complicate predictive modelling. Thus, careful predictor validation is compulsory.

Table 1:Performance measures in the ROCR package
Contingency ratios error rate, accuracy, sensitivity, specificity, true/false positive rate, fallout, miss, precision, recall, negative predictive value, prediction-conditioned fallout/miss.
Discrete covariation measures Phi/Matthews correlation coefficient, mutual information, Chi-squared test statistic, odds ratio
Information retrieval measures F-measure, lift, precision-recall break-even point
Performance in ROC space ROC convex hull, area under the ROC curve
Absolute scoring performance calibration error, mean cross-entropy, root mean-squared error
Cost measures expected cost, explicit cost

The real-valued output of scoring classifiers is turned into a binary class decision by choosing a cutoff. As no cutoff is optimal according to all possible performance criteria, cutoff choice involves a trade-off among different measures. Typically, a trade-off between a pair of criteria (e.g. sensitivity versus specificity) is visualized as a cutoff-parametrized curve in the plane spanned by the two measures. Popular examples of such trade-off visualizations include receiver operating characteristic (ROC) graphs, sensitivity/specificity curves, lift charts and precision/recall plots. (Fawcett 2004)(#References) provides a general introduction into evaluating scoring classifiers with a focus on ROC graphs.

Although functions for drawing ROC graphs are provided by the Bioconductor project (http://www.bioconductor.org) or by the machine learning package Weka (http://www.cs.waikato.ac.nz/ml), for example, no comprehensive evaluation suite is available to date. ROCR is a flexible evaluation package for R (https://www.r-project.org), a statistical language that is widely used in biomedical data analysis. Our tool allows for creating cutoff-parametrized performance curves by freely combining two out of more than 25 performance measures (Table 1). Curves from different cross-validation or bootstrapping runs can be averaged by various methods. Standard deviations, standard errors and box plots are available to summarize the variability across the runs. The parametrization can be visualized by printing cutoff values at the corresponding curve positions, or by coloring the curve according to the cutoff. All components of a performance plot are adjustable using a flexible mechanism for dispatching optional arguments. Despite this flexibility, ROCR is easy to use, with only three commands and reasonable default values for all optional parameters.

In the example below, we will briefly introduce ROCR’s three commands—prediction, performance and plot—applied to a 10-fold cross-validation set of predictions and corresponding class labels from a study on predicting HIV coreceptor usage from the sequence of the viral envelope protein. After loading the dataset, a prediction object is created from the raw predictions and class labels.

Performance measures or combinations thereof are computed by invoking the performance method on this prediction object. The resulting performance object can be visualized using the method plot. For example, an ROC curve that trades off the rate of true positives against the rate of false positives is obtained as follows:

The optional parameter avg selects a particular form of performance curve averaging across the validation runs; the visualization of curve variability is determined with the parameter spread.estimate.

***Fig 1:** Visualizations of classifier performance (HIV coreceptor usage data): (a) receiver operating characteristic (ROC) curve; (b) peak accuracy across a range of cutoffs; (c) absolute difference between empirical and predicted rate of positives for windowed cutoff ranges, in order to evaluate how well the scores are calibrated as probability estimates. Owing to the probabilistic interpretation, cutoffs need to be in the interval [0,1], in contrast to other performance plots. (d) Score density estimates for the negative (solid) and positive (dotted) class.*

Fig 1: Visualizations of classifier performance (HIV coreceptor usage data): (a) receiver operating characteristic (ROC) curve; (b) peak accuracy across a range of cutoffs; (c) absolute difference between empirical and predicted rate of positives for windowed cutoff ranges, in order to evaluate how well the scores are calibrated as probability estimates. Owing to the probabilistic interpretation, cutoffs need to be in the interval [0,1], in contrast to other performance plots. (d) Score density estimates for the negative (solid) and positive (dotted) class.

Issuing demo(ROCR) starts a demonstration of further graphical capabilities of ROCR. The command help(package=ROCR) points to the available help pages. In particular, a complete list of available performance measures can be obtained via help(performance). A reference manual can be downloaded from the ROCR website.

In conclusion, ROCR is a comprehensive tool for evaluating scoring classifiers and producing publication-quality figures. It allows for studying the intricacies inherent to many biological datasets and their implications on classifier performance.

Additional examples

Below you can find many additional examples of ROCR’s features of performance measurement and the possibilites in plotting. However, this only a first taste. For more examples, please run demo(ROCR) and make sure the plotting deminsions are big enough.

Acknowledgement

Work at MPI supported by EU NoE BioSapiens (LSHG-CT-2003-503265).

References

Baldi, Pierre, and Søren Brunak. 2001. Bioinformatics: The Machine Learning Approach. MIT Press, Cambridge, MA.

Beerenwinkel, Niko, Martin Däumer, Mark Oette, Klaus Korn, Daniel Hoffmann, Rolf Kaiser, Thomas Lengauer, Joachim Selbig, and Hauke Walter. 2003. “Geno2pheno: estimating phenotypic drug resistance from HIV-1 genotypes.” Nucleic Acids Research 31 (13): 3850–5. https://doi.org/10.1093/nar/gkg575.

Beerenwinkel, Niko, Barbara Schmidt, Hauke Walter, Rolf Kaiser, Thomas Lengauer, Daniel Hoffmann, Klaus Korn, and Joachim Selbig. 2002. “Diversity and Complexity of Hiv-1 Drug Resistance: A Bioinformatics Approach to Predicting Phenotype from Genotype.” Proceedings of the National Academy of Sciences 99 (12): 8271–6. https://doi.org/10.1073/pnas.112177799.

Fawcett, T. 2004. “ROC Graphs: Notes and Practical Considerations for Researchers.” In HPL-2003-4., 89–96. HP Labs, Palo Alto, CA.

Sing, Tobias, Niko Beerenwinkel, and Thomas Lengauer. 2004. “Learning Mixtures of Localized Rules by Maximizing the Area Under the Roc Curve.” In In et Al José Hernández-Orallo, Editor, 1st International Workshop on Roc Analysis in Artificial Intelligence, 89–96.

ROCR/inst/doc/ROCR.Rmd0000644000176200001440000003132213644317760013766 0ustar liggesusers--- title: "ROCR: visualizing classifier performance in R" output: rmarkdown::html_vignette author: Tobias Sing, Oliver Sander, Niko Beerenwinkel, Thomas Lengauer abstract: ROCR is a package for evaluating and visualizing the performance of scoring classifiers in the statistical language R. It features over 25 performance measures that can be freely combined to create two-dimensional performance curves. Standard methods for investigating trade-offs between specific performance measures are available within a uniform framework, including receiver operating characteristic (ROC) graphs, precision/recall plots, lift charts and cost curves. ROCR integrates tightly with R's powerful graphics capabilities, thus allowing for highly adjustable plots. Being equipped with only three commands and reasonable default values for optional parameters, ROCR combines flexibility with ease of usage. vignette: > %\VignetteIndexEntry{ROCR} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} bibliography: references.bibtex --- ```{r, include = FALSE} knitr::opts_chunk$set( collapse = TRUE, comment = "#>" ) ``` # Introduction ```{r setup} library(ROCR) ``` Pattern classification has become a central tool in bioinformatics, offering rapid insights into large data sets [[@Baldi2001]](#References). While one area of our work involves predicting phenotypic properties of HIV-1 from genotypic information [[@Beerenwinkel2002;@Beerenwinkel2003;@Sing04learningmixtures]](#References), scoring or ranking predictors are also vital in a wide range of other biological problems. Examples include microarray analysis (e.g. prediction of tissue condition based on gene expression), protein structural and functional characterization (remote homology detection, prediction of post-translational modifications and molecular function annotation based on sequence or structural motifs), genome annotation (gene finding and splice site identification), protein–ligand interactions (virtual screening and molecular docking) and structure–activity relationships (predicting bioavailability or toxicity of drug compounds). In many of these cases, considerable class skew, class-specific misclassification costs, and extensive noise due to variability in experimental assays complicate predictive modelling. Thus, careful predictor validation is compulsory. ```{r, echo = FALSE, results = 'asis'} table <- data.frame(group = c("Contingency ratios", "Discrete covariation measures", "Information retrieval measures", "Performance in ROC space", "Absolute scoring performance", "Cost measures"), measure = c("error rate, accuracy, sensitivity, specificity, true/false positive rate, fallout, miss, precision, recall, negative predictive value, prediction-conditioned fallout/miss.", "Phi/Matthews correlation coefficient, mutual information, Chi-squared test statistic, odds ratio", "F-measure, lift, precision-recall break-even point", "ROC convex hull, area under the ROC curve", "calibration error, mean cross-entropy, root mean-squared error", "expected cost, explicit cost")) knitr::kable(table, caption = "***Table 1:**Performance measures in the ROCR package*", col.names = c("",""), align = "l") ``` The real-valued output of scoring classifiers is turned into a binary class decision by choosing a cutoff. As no cutoff is optimal according to all possible performance criteria, cutoff choice involves a trade-off among different measures. Typically, a trade-off between a pair of criteria (e.g. sensitivity versus specificity) is visualized as a cutoff-parametrized curve in the plane spanned by the two measures. Popular examples of such trade-off visualizations include receiver operating characteristic (ROC) graphs, sensitivity/specificity curves, lift charts and precision/recall plots. [@Fawcett2004](#References) provides a general introduction into evaluating scoring classifiers with a focus on ROC graphs. Although functions for drawing ROC graphs are provided by the Bioconductor project (http://www.bioconductor.org) or by the machine learning package Weka (http://www.cs.waikato.ac.nz/ml), for example, no comprehensive evaluation suite is available to date. ROCR is a flexible evaluation package for R (https://www.r-project.org), a statistical language that is widely used in biomedical data analysis. Our tool allows for creating cutoff-parametrized performance curves by freely combining two out of more than 25 performance measures (Table 1). Curves from different cross-validation or bootstrapping runs can be averaged by various methods. Standard deviations, standard errors and box plots are available to summarize the variability across the runs. The parametrization can be visualized by printing cutoff values at the corresponding curve positions, or by coloring the curve according to the cutoff. All components of a performance plot are adjustable using a flexible mechanism for dispatching optional arguments. Despite this flexibility, ROCR is easy to use, with only three commands and reasonable default values for all optional parameters. In the example below, we will briefly introduce ROCR's three commands—prediction, performance and plot—applied to a 10-fold cross-validation set of predictions and corresponding class labels from a study on predicting HIV coreceptor usage from the sequence of the viral envelope protein. After loading the dataset, a prediction object is created from the raw predictions and class labels. ```{r} data(ROCR.hiv) predictions <- ROCR.hiv$hiv.svm$predictions labels <- ROCR.hiv$hiv.svm$labels pred <- prediction(predictions, labels) pred ``` Performance measures or combinations thereof are computed by invoking the performance method on this prediction object. The resulting performance object can be visualized using the method plot. For example, an ROC curve that trades off the rate of true positives against the rate of false positives is obtained as follows: ```{r, fig.asp=1, fig.width=5, fig.align='center'} perf <- performance(pred, "tpr", "fpr") perf plot(perf, avg="threshold", spread.estimate="boxplot") ``` The optional parameter avg selects a particular form of performance curve averaging across the validation runs; the visualization of curve variability is determined with the parameter spread.estimate. ```{r, echo=FALSE, results='asis', fig.asp=0.35, fig.width=7, fig.align='center',fig.cap="***Fig 1:** Visualizations of classifier performance (HIV coreceptor usage data): (a) receiver operating characteristic (ROC) curve; (b) peak accuracy across a range of cutoffs; (c) absolute difference between empirical and predicted rate of positives for windowed cutoff ranges, in order to evaluate how well the scores are calibrated as probability estimates. Owing to the probabilistic interpretation, cutoffs need to be in the interval [0,1], in contrast to other performance plots. (d) Score density estimates for the negative (solid) and positive (dotted) class.*"} data(ROCR.hiv) pp.unnorm <- ROCR.hiv$hiv.svm$predictions ll <- ROCR.hiv$hiv.svm$labels # normalize predictions to 0..1 v <- unlist(pp.unnorm) pp <- lapply(pp.unnorm, function(run) {approxfun(c(min(v), max(v)), c(0,1))(run)}) par(mfrow=c(1,4)) pred<- prediction(pp, ll) perf <- performance(pred, "tpr", "fpr") plot(perf, avg= "threshold", colorize=TRUE, lwd= 3, coloraxis.at=seq(0,1,by=0.2),) plot(perf, col="gray78", add=TRUE) plot(perf, avg= "threshold", colorize=TRUE, colorkey=FALSE,lwd= 3,,add=TRUE) mtext(paste0("(a)"), side = 3, adj = 0.01,line = 1) perf <- performance(pred, "acc") plot(perf, avg= "vertical", spread.estimate="boxplot", lwd=3,col='blue', show.spread.at= seq(0.1, 0.9, by=0.1),) mtext(paste0("(b)"), side = 3, adj = 0.01,line = 1) plot(performance(pred, "cal", window.size= 10), avg="vertical",) mtext(paste0("(c)"), side = 3, adj = 0.01,line = 1) plot(0,0,type="n", xlim= c(0,1), ylim=c(0,7), xlab="Cutoff", ylab="Density",) mtext(paste0("(d)"), side = 3, adj = 0.01,line = 1) for (runi in 1:length(pred@predictions)) { lines(density(pred@predictions[[runi]][pred@labels[[runi]]=="-1"]), col= "red") lines(density(pred@predictions[[runi]][pred@labels[[runi]]=="1"]), col="green") } ``` Issuing `demo(ROCR)` starts a demonstration of further graphical capabilities of ROCR. The command `help(package=ROCR)` points to the available help pages. In particular, a complete list of available performance measures can be obtained via help(performance). A reference manual can be downloaded from the ROCR website. In conclusion, ROCR is a comprehensive tool for evaluating scoring classifiers and producing publication-quality figures. It allows for studying the intricacies inherent to many biological datasets and their implications on classifier performance. ## Additional examples Below you can find many additional examples of ROCR's features of performance measurement and the possibilites in plotting. However, this only a first taste. For more examples, please run `demo(ROCR)` and make sure the plotting deminsions are big enough. ### ROC curves, Precision/Recall graphs and more ... ```{r, fig.asp=1, fig.width=5, fig.align='center'} perf <- performance(pred, "tpr", "fpr") plot(perf, avg= "threshold", colorize=TRUE, lwd= 3, main= "With ROCR you can produce standard plots\nlike ROC curves ...") plot(perf, lty=3, col="grey78", add=TRUE) ``` ```{r, fig.asp=1, fig.width=5, fig.align='center'} perf <- performance(pred, "prec", "rec") plot(perf, avg= "threshold", colorize=TRUE, lwd= 3, main= "... Precision/Recall graphs ...") plot(perf, lty=3, col="grey78", add=TRUE) ``` ```{r, fig.asp=1, fig.width=5, fig.align='center'} perf <- performance(pred, "sens", "spec") plot(perf, avg= "threshold", colorize=TRUE, lwd= 3, main="... Sensitivity/Specificity plots ...") plot(perf, lty=3, col="grey78", add=TRUE) ``` ```{r, fig.asp=1, fig.width=5, fig.align='center'} perf <- performance(pred, "lift", "rpp") plot(perf, avg= "threshold", colorize=TRUE, lwd= 3, main= "... and Lift charts.") plot(perf, lty=3, col="grey78", add=TRUE) ``` ### Averaging over multiple predictions Multiple batches of predictions can be analyzed at the same time. ```{r} data(ROCR.xval) predictions <- ROCR.xval$predictions labels <- ROCR.xval$labels length(predictions) ``` ```{r} pred <- prediction(predictions, labels) perf <- performance(pred,'tpr','fpr') ``` This can be used for plotting averages using the `avg` argument. ```{r, fig.asp=1, fig.width=5, fig.align='center'} plot(perf, colorize=TRUE, lwd=2, main='ROC curves from 10-fold cross-validation') ``` ```{r, fig.asp=1, fig.width=5, fig.align='center'} plot(perf, avg='vertical', spread.estimate='stderror', lwd=3,main='Vertical averaging + 1 standard error', col='blue') ``` ```{r, fig.asp=1, fig.width=5, fig.align='center'} plot(perf, avg='horizontal', spread.estimate='boxplot', lwd=3, main='Horizontal averaging + boxplots', col='blue') ``` ```{r, fig.asp=1, fig.width=5, fig.align='center'} plot(perf, avg='threshold', spread.estimate='stddev', lwd=2, main='Threshold averaging + 1 standard deviation', colorize=TRUE) ``` ### Cutoff stacking ```{r, fig.asp=1, fig.width=6, fig.align='center'} plot(perf, print.cutoffs.at=seq(0,1,by=0.2), text.cex=0.8, text.y=lapply(as.list(seq(0,0.5,by=0.05)), function(x) { rep(x,length(perf@x.values[[1]])) } ), col= as.list(terrain.colors(10)), text.col= as.list(terrain.colors(10)), points.col= as.list(terrain.colors(10)), main= "Cutoff stability") ``` ### Combination of performance measures Performance measures can be combined freely. ```{r} perf <- performance(pred,"pcmiss","lift") ``` ```{r, fig.asp=1, fig.width=5, fig.align='center'} plot(perf, colorize=TRUE, print.cutoffs.at=seq(0,1,by=0.1), text.adj=c(1.2,1.2), avg="threshold", lwd=3, main= "You can freely combine performance measures ...") ``` # Acknowledgement Work at MPI supported by EU NoE BioSapiens (LSHG-CT-2003-503265). # References ROCR/inst/CITATION0000644000176200001440000000136713644317760013153 0ustar liggesuserscitHeader("To cite ROCR in publications use:") bibentry(entry="article", title = "ROCR: visualizing classifier performance in R", author = personList(as.person("T. Sing"), as.person("O. Sander"), as.person("N. Beerenwinkel"), as.person("T. Lengauer")), year = "2005", journal = "Bioinformatics", volume = 21, number = 20, pages = 3940--3941, bibtype = "Article", url = "http://rocr.bioinf.mpi-sb.mpg.de" ) citFooter("We have invested a lot of time and effort in creating ROCR,", "please cite it when using it for data analysis.")