ROCR/0000755000175100001440000000000012145174500011034 5ustar hornikusersROCR/MD50000644000175100001440000000316412145174500011350 0ustar hornikusersd049cf7c66a67fd3ed44c1f40db78464 *DESCRIPTION 5bcf86510d848a44f8d943b9231320be *INSTALL dc33bb94a44f11db390a8ab5510d1a42 *NAMESPACE 8172e158dfb6a806339a3029d93a558b *NEWS 8f3a897135420e5fb99b1adebc4c8765 *R/ROCR_aux.R 08c4ee8081fb13b7da90b8a6faa28ea0 *R/performance.R c1d7f42127f1fca5957f11086e8c3357 *R/performance_measures.R 166e801703a416aa2a2cdbde298651db *R/performance_plots.R c6520d9937a5432bba0921b1c1ddc154 *R/prediction.R 19c3994bf2948eb6a694b7b7e7ae4590 *R/zzz.R 4913ca5661a5a89bd61706da40976871 *README 252544c94f32bde5458fa7eea14002ec *README.unittests 059483257ec3bdb9cc47bb832deb6e83 *data/ROCR.hiv.rda 2b43bef554841b0008144a4a8aaa93e9 *data/ROCR.simple.rda 2cdc114005f1471d597b992da649ed72 *data/ROCR.xval.rda abe80443628a3c11d359a0f49d81dad0 *data/datalist bede4a3f07350fa3132b98b4d73eee33 *demo/00Index 618e74cf61daf4d6aa7419ebcd886bef *demo/ROCR.R 194b3f7d6c63a4a7d798b55f93f7221a *inst/CITATION d236e8f1d4e4c4a6e36ee3a7165d931a *man/ROCR.hiv.Rd b6269194a8faa5f9b3f7aaf2080af90a *man/ROCR.simple.Rd 6effa7e0b9bbc40346f616baf52b79ca *man/ROCR.xval.Rd b64409618258bd89926c7786ca252fea *man/performance-class.Rd d15a50e5ff272d4885c6d54c37ee0f63 *man/performance.Rd 729a749d6275f8c077351762e8494b6d *man/plot-methods.Rd 8393928cc1e8a96ab92b68e7650de96a *man/prediction-class.Rd 6e511f8b8439e40585eec050842a4665 *man/prediction.Rd 09ff700221b6ed63f7144b7e33d4cd19 *unittests/XXXrunit.ROCR.aux.RXXX 5056a46205152d57056250b299e17885 *unittests/runit.aux.r c0154cae711af582b73facb505446f7c *unittests/runit.consistency.r 3408f3e11ddb96b430a14734e033f631 *unittests/runit.simple.r 221863191a9bc6548f52a4711b9ac966 *unittests/testsuite.ROCR.R ROCR/NAMESPACE0000644000175100001440000000031312145151064012250 0ustar hornikusers# Default NAMESPACE created by R # Remove the previous line if you edit this file # Export all names exportPattern(".") # Import all packages listed as Imports or Depends import( gplots, methods ) ROCR/INSTALL0000644000175100001440000000067012143705053012071 0ustar hornikusersINSTALLATION INSTRUCTION FOR ROCR: ---------------------------------- If you read this, you've probably done too much already: it is not necessary to unpack the package. R has a very simple package installation mechanism: Linux/Unix: ----------- R CMD INSTALL ROCR_1.0-4.tar.gz Windows: -------- From the 'Packages' menu choose the item 'Install package(s) from local zip files'. Select the ROCR zip file, and you're done. * Have fun! ROCR/unittests/0000755000175100001440000000000012143705053013077 5ustar hornikusersROCR/unittests/runit.consistency.r0000644000175100001440000004334312143705053016772 0ustar hornikusers## ## ## library(RUnit) library(ROCR) # source("tests/runit.simple.r") # needed for .get.performance.measures ## predict performance measures on random data and check their consistency testConsistency <- function() { 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) } } testCombining <- function() { 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 <- performance( pred, measure1 ) perf2 <- performance( pred, measure2 ) perf3 <- performance( pred, measure2, measure1 ) .check.performance.object(perf1) .check.performance.object(perf2) .check.performance.object(perf3) for (i in 1:n.folds) { #check elements checkEquals(setequal( c( perf1@x.values[[i]], perf2@x.values[[i]]), perf3@alpha.values[[i]] ),T) checkEquals(setequal( perf1@y.values[[i]], perf3@x.values[[i]] ),T) checkEquals(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]]))}) checkEquals( perf1@y.values[[i]], perf3@x.values[[i]][ind] ) checkEquals( perf2@y.values[[i]], perf3@y.values[[i]][ind] ) } } } } .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]]) checkEquals(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]]) checkEquals(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]]) checkEquals(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]]) checkEquals(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]]) checkEquals(measures$npv[[i]][finite.bool] + measures$pcmiss[[i]][finite.bool], rep(1,length(measures$acc[[i]]))[finite.bool]) checkEquals(measures$rpp[[i]] + measures$rnp[[i]], rep(1, length(measures$rpp[[i]]))) } } ## 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') testPathological <- function() { # 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 <- .get.performance.measures(pred, measures.to.evaluate) .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 <- .get.performance.measures(pred, measures.to.evaluate) .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 <- .get.performance.measures(pred, measures.to.evaluate) .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 <- .get.performance.measures(pred, measures.to.evaluate) .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 <- .get.performance.measures(pred, measures.to.evaluate) .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 <- .get.performance.measures(pred, measures.to.evaluate) .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 <- .get.performance.measures(pred, measures.to.evaluate) .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 <- .get.performance.measures(pred, measures.to.evaluate) .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 <- .get.performance.measures(pred, measures.to.evaluate) .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 <- .get.performance.measures(pred, measures.to.evaluate) .check.consistency( measures) } ############################################################ # 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) checkEquals( (xlen==0 || xlen==ylen) && (alphalen==0 || (alphalen==xlen && alphalen==ylen)), T ) if (xlen==ylen) { for (i in 1:ylen) checkEquals( length(perf@x.values[[i]]), length(perf@y.values[[i]]) ) } if (alphalen==ylen) { for (i in 1:ylen) checkEquals( 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)) checkEquals( length(unique(lenvec)), 1) # 2. inside: xval runs: for (i in 1:length(pred@predictions)) { checkEquals( 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]])) checkEquals( length(unique(lenvec)), 1) checkEquals( unique(lenvec), length(unique(pred@predictions[[i]]))+1 ) } # 3. cutoffs sorted in descending order? for (i in 1:length(pred@predictions)) { checkEquals( 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)) { checkEquals( pred@tp[[i]] + pred@fp[[i]], pred@n.pos.pred[[i]] ) checkEquals( pred@fn[[i]] + pred@tn[[i]], pred@n.neg.pred[[i]] ) checkEquals( pred@tp[[i]] + pred@fn[[i]], rep( pred@n.pos[[i]], length(pred@tp[[i]])) ) checkEquals( pred@fp[[i]] + pred@tn[[i]], rep( pred@n.neg[[i]], length(pred@tp[[i]])) ) checkEquals(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]])) ) checkEquals(pred@n.pos[[i]] + pred@n.neg[[i]], length(pred@labels[[i]])) } } ############################################################ # test measures for consistency on supplied data sets testDatabase <- function() { data(ROCR.simple) pred <- prediction(ROCR.simple$predictions, ROCR.simple$labels) .check.prediction.object(pred) measures.to.evaluate <- performance.measures measures <- .get.performance.measures(pred, measures.to.evaluate) .check.consistency( measures) data(ROCR.xval) pred <- prediction(ROCR.xval$predictions, ROCR.xval$labels) .check.prediction.object(pred) measures.to.evaluate <- performance.measures measures <- .get.performance.measures(pred, measures.to.evaluate) .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 <- .get.performance.measures(pred, measures.to.evaluate) .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 <- .get.performance.measures(pred, measures.to.evaluate) .check.consistency( measures) } ## remove XXX below to include testDatabaseCombine (currently disabled for speed ## reasons) in the test suite. tXXXestDatabasesCombine <- function() { 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 <- performance( pred, measure1 ) perf2 <- performance( pred, measure2 ) perf3 <- 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 checkEquals(setequal( c( perf1@x.values[[i]], perf2@x.values[[i]]), perf3@alpha.values[[i]] ),T) checkEquals(setequal( perf1@y.values[[i]], perf3@x.values[[i]] ),T) checkEquals(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]]))}) checkEquals( perf1@y.values[[i]], perf3@x.values[[i]][ind] ) checkEquals( perf2@y.values[[i]], perf3@y.values[[i]][ind] ) } } } } } ############################################################ 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. ) # list(pred= c(), lab= c()), #-> Number of classes is not equal to 2. testCrash <- function() { for (case in crashCases) { cat(case$pred, " ", case$lab, "\n") checkException(pred <- prediction(case$pred, case$lab)) #checkException(measures <- .get.performance.measures(pred)) } } # .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 ) } ROCR/unittests/runit.aux.r0000644000175100001440000000227512143705053015225 0ustar hornikuserslibrary(RUnit) library(ROCR) testFarg <- function() { ll <- list(arg1=c(1,2,3), arg2=c(4,5,6)) print(str(.farg(ll, arg3=c(7,8,9)) )) checkEquals(.farg(ll, arg3=c(7,8,9)), list(arg1=c(1,2,3), arg2=c(4,5,6), arg3=c(7,8,9))) checkEquals(.farg(ll, arg1=c(1,4,3)), list(arg1=c(1,2,3), arg2=c(4,5,6))) } testGarg <- function() { ll <- list(arg1=list(1,2,3), arg2=list(4,5,6)) checkEquals(.garg(ll, 'arg1'), 1) checkEquals(.garg(ll, 'arg1',2), 2) checkEquals(.garg(ll, 'arg2',3), 6) checkEquals(.garg(ll, 'arg3'), ll$arg3) } testSlice <- function() { ll <- list(arg1=list(c(1,2,3), c(2,3,4), c(3,4,5)), arg2=list('a', 'b', 'c')) checkEquals(.slice.run(ll, 1), list(arg1=c(1,2,3), arg2='a')) checkEquals(.slice.run(ll, 2), list(arg1=c(2,3,4), arg2='b')) checkEquals(.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')) checkEquals(.slice.run(ll, 1), list(arg1=c(1,2,3), arg2=c('a', 'b', 'c'))) checkEquals(.slice.run(ll, 2), list(arg1=c(2,3,4), arg2=c('a', 'b', 'c'))) checkEquals(.slice.run(ll, 3), list(arg1=c(3,4,5), arg2=c('a', 'b', 'c'))) } ROCR/unittests/testsuite.ROCR.R0000644000175100001440000000041212143705053016014 0ustar hornikuserslibrary(RUnit) library(ROCR) myTestSuite <- defineTestSuite("ROCR test suite", "unittests") isValidTestSuite(myTestSuite) testData <- runTestSuite(myTestSuite) printTextProtocol(testData, showDetails=TRUE) printHTMLProtocol(testData, "unittests/testresults.html") ROCR/unittests/runit.simple.r0000644000175100001440000003125012143705053015714 0ustar hornikusers library(RUnit) library(ROCR) #source("prediction.R") #source("performance.R") #source("performance_measures.R") #source("zzz.R") 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 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) { tpr <- performance(pred, "tpr")@y.values[[1]] fpr <- performance(pred, "fpr")@y.values[[1]] acc <- performance(pred, "acc")@y.values[[1]] err <- performance(pred, "err")@y.values[[1]] rec <- performance(pred, "rec")@y.values[[1]] sens<- performance(pred, "sens")@y.values[[1]] fnr <- performance(pred, "fnr")@y.values[[1]] tnr <- performance(pred, "tnr")@y.values[[1]] spec<- performance(pred, "spec")@y.values[[1]] ppv <- performance(pred, "ppv")@y.values[[1]] prec<- performance(pred, "prec")@y.values[[1]] npv <- performance(pred, "npv")@y.values[[1]] fall<- performance(pred, "fall")@y.values[[1]] miss<- performance(pred, "miss")@y.values[[1]] pcfall <- performance(pred, "pcfall")@y.values[[1]] pcmiss <- performance(pred, "pcmiss")@y.values[[1]] rpp <- performance(pred, "rpp")@y.values[[1]] rnp <- performance(pred, "rnp")@y.values[[1]] auc <- performance(pred, "auc")@y.values[[1]] prbe<- performance(pred, "prbe")@y.values[[1]] rch <- performance(pred, "rch")@y.values[[1]] mxe <- performance(pred, "mxe")@y.values[[1]] rmse<- performance(pred, "rmse")@y.values[[1]] phi <- performance(pred, "phi")@y.values[[1]] mat <- performance(pred, "mat")@y.values[[1]] mi <- performance(pred, "mi")@y.values[[1]] chisq<- performance(pred, "chisq")@y.values[[1]] odds<- performance(pred, "odds")@y.values[[1]] lift<- performance(pred, "lift")@y.values[[1]] f <- performance(pred, "f")@y.values[[1]] sar <- performance(pred,"sar")@y.values[[1]] ecost <- performance(pred, "ecost")@y.values[[1]] cost <- performance(pred, "cost")@y.values[[1]] 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)) } testEcost <- function() { 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]] checkEquals( ecost.x, ecost.x.reference ) checkEquals( ecost.y, ecost.y.reference ) } testCal <- function() { 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)] checkEquals( cal, cal.reference) checkEquals( cal.x, cal.x.reference) } testCost <- function() { 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) checkEquals( cost, my.cost.reference) } } testRch <- function() { pred <- prediction(some.predictions, some.labels) perf <- performance( pred, "rch") rch.x <- perf@x.values[[1]] rch.y <- perf@y.values[[1]] checkEquals( rch.x, rch.reference.x ) checkEquals( rch.y, rch.reference.y ) } testPerformanceMeasuresReference <- function() { pred <- prediction(some.predictions, some.labels) measures <- .get.performance.measures(pred) attach(measures) checkEquals(tpr, tpr.reference) checkEquals(fpr, fpr.reference) checkEquals(acc, acc.reference) checkEquals(err, err.reference) checkEquals(rec, rec.reference) checkEquals(sens, sens.reference) checkEquals(fnr, fnr.reference) checkEquals(tnr, tnr.reference) checkEquals(spec, spec.reference) checkEquals(ppv, ppv.reference) checkEquals(prec,prec.reference) checkEquals(npv, npv.reference) checkEquals(fall, fall.reference) checkEquals(miss,miss.reference) checkEquals(pcfall, pcfall.reference) checkEquals(pcmiss,pcmiss.reference) checkEquals(rpp, rpp.reference) checkEquals(rnp,rnp.reference) checkEquals(auc, auc.reference) checkEquals(prbe, prbe.reference) checkEquals(mxe, mxe.reference) checkEquals(rmse, rmse.reference) checkEquals(phi, phi.reference) checkEquals(mat, mat.reference) checkEquals(mi, mi.reference) checkEquals(chisq, chisq.reference) checkEquals(odds, odds.reference) checkEquals(lift, lift.reference) checkEquals(f, f.reference) checkEquals(sar,sar.reference) checkEquals(cost, cost.reference) } testRMSE <- function() { pred <- prediction(c(0, 0, 1, 1), ordered(c(0, 0, 1, 1))) rmse <- performance(pred, "rmse")@y.values[[1]] checkEquals(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]] checkEquals(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]] checkEquals( 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]] checkEquals( rmse, sqrt(1/4*(0.5^2 + 1.2^2 + 1.5^2 + 0.7^2))) } testPRBE <- function() { pred <- prediction(some.predictions, some.labels) prbe.y <- performance(pred, "prbe")@y.values[[1]] prbe.x <- performance(pred, "prbe")@x.values[[1]] checkEquals(prbe.y, prbe.reference) checkEquals(prbe.x, prbe.reference.x) } testPredictionInterface <- function() { pred <- prediction(seq(0, 1, length=10), c(rep(0,5), rep(1,5))) checkEquals(performance(pred, "auc")@y.values[[1]], 1) pred <- prediction(seq(1, 0, length=10), c(rep(0,5), rep(1,5))) checkEquals(performance(pred, "auc")@y.values[[1]], 0) pred <- prediction(seq(0, 1, length=10), factor(c(rep(0,5), rep(1,5)))) checkEquals(performance(pred, "auc")@y.values[[1]], 1) pred <- prediction(seq(0, 1, length=10), ordered(c(rep(0,5), rep(1,5)))) checkEquals(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))) checkEquals(performance(pred, "auc")@y.values[[1]], 0) pred <- prediction(seq(0, 1, length=10), ordered(c(rep("A",5), rep("B",5)))) checkEquals(performance(pred, "auc")@y.values[[1]], 1) checkException(pred <- prediction(seq(0, 1, length=10), c(rep(0,5), rep(1,5)), label.ordering=c(1,2))) checkException(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))))) checkException(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)))) checkEquals(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)))) checkEquals( 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))) checkEquals(pred, pred2) } ROCR/unittests/XXXrunit.ROCR.aux.RXXX0000644000175100001440000000040112143705053016736 0ustar hornikuserslibrary(RUnit) myTestSuite <- defineTestSuite("ROCR test suite", "tests","runit.aux.r") isValidTestSuite(myTestSuite) testData <- runTestSuite(myTestSuite) printTextProtocol(testData, showDetails=TRUE) printHTMLProtocol(testData, "tests/testresults.html") ROCR/demo/0000755000175100001440000000000012143705053011761 5ustar hornikusersROCR/demo/00Index0000644000175100001440000000007612143705053013116 0ustar hornikusersROCR demonstrates some of the graphical capabilities of ROCR ROCR/demo/ROCR.R0000644000175100001440000002172112143705053012654 0ustar hornikusers## ----------------------------------------------------------------------------------- ## 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=T, lwd= 3, main= "With ROCR you can produce standard plots like ROC curves ...") plot(perf, lty=3, col="grey78", add=T) perf <- performance(pred, "prec", "rec") plot(perf, avg= "threshold", colorize=T, lwd= 3, main= "... Precision/Recall graphs ...") plot(perf, lty=3, col="grey78", add=T) perf <- performance(pred, "sens", "spec") plot(perf, avg= "threshold", colorize=T, lwd= 3, main="... Sensitivity/Specificity plots ...") plot(perf, lty=3, col="grey78", add=T) perf <- performance(pred, "lift", "rpp") plot(perf, avg= "threshold", colorize=T, lwd= 3, main= "... and Lift charts.") plot(perf, lty=3, col="grey78", add=T) # ------------------------------------------------------------------------------------ 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=T, 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=T) # ------------------------------------------------------------------------------------ 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=T, lwd= 3, coloraxis.at=seq(0,1,by=0.2), main= "ROC curve") plot(perf, col="gray78", add=T) plot(perf, avg= "threshold", colorize=T, colorkey=F,lwd= 3, main= "ROC curve",add=T) 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=T) plot(perf, colorize=T, 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=T, 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=T, main="Truly parametrized curves") plot(perf, colorize=T, print.cutoffs.at=seq(0,1,by=0.1), add=T, 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=T) # 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=T,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=T) } } #--------------------------------------------------------------------- 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=T) plot(perf, avg="threshold", lwd=2, add=T) perf <- performance(pred, "phi", "err") plot(perf, colorize=T) plot(perf, avg="threshold", lwd=2, add=T) perf <- performance(pred, "f", "err") plot(perf, colorize=T) plot(perf, avg="threshold", lwd=2, add=T) perf <- performance(pred, "f", "ppv") plot(perf, colorize=T) plot(perf, avg="threshold", lwd=2, add=T) perf <- performance(pred, "mat", "ppv") plot(perf, colorize=T) plot(perf, avg="threshold", lwd=2, add=T) perf <- performance(pred, "npv", "ppv") plot(perf, colorize=T) plot(perf, avg="threshold", lwd=2, add=T) perf <- performance(pred, "acc", "phi") plot(perf, colorize=T) plot(perf, avg="threshold", lwd=2, add=T) perf <- performance(pred, "lift", "phi") plot(perf, colorize=T) plot(perf, avg="threshold", lwd=2, add=T) perf <- performance(pred, "f", "phi") plot(perf, colorize=T) plot(perf, avg="threshold", lwd=2, add=T) perf <- performance(pred, "mi", "phi") plot(perf, colorize=T) plot(perf, avg="threshold", lwd=2, add=T) perf <- performance(pred, "chisq", "phi") plot(perf, colorize=T) plot(perf, avg="threshold", lwd=2, add=T) perf <- performance(pred, "acc", "mi") plot(perf, colorize=T) plot(perf, avg="threshold", lwd=2, add=T) perf <- performance(pred, "fall", "odds") plot(perf, colorize=T) plot(perf, avg="threshold", lwd=2, add=T) perf <- performance(pred, "tpr", "lift") plot(perf, colorize=T) plot(perf, avg="threshold", lwd=2, add=T) perf <- performance(pred, "fall", "lift") plot(perf, colorize=T) plot(perf, avg="threshold", lwd=2, add=T) perf <- performance(pred, "npv", "f") plot(perf, colorize=T) plot(perf, avg="threshold", lwd=2, add=T) perf <- performance(pred, "prec", "f") plot(perf, colorize=T) plot(perf, avg="threshold", lwd=2, add=T) perf <- performance(pred, "tpr", "f") plot(perf, colorize=T) plot(perf, avg="threshold", lwd=2, add=T) par(opar) ROCR/R/0000755000175100001440000000000012143706213011235 5ustar hornikusersROCR/R/performance_plots.R0000644000175100001440000006030012143705053015102 0ustar hornikusers## ---------------------------------------------------------------------------- ## plot method for objects of class 'performance' ## ---------------------------------------------------------------------------- .get.arglist <- function( fname, arglist ) { if (fname=='plot') return(.select.args(arglist, union(names(formals(plot.default)), names(par())))) else if (fname=='plot.xy') return(.select.args(arglist, union( names(formals(plot.xy)), names(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) } .plot.performance <- function(perf, ..., 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) { arglist <- c(lapply( as.list(environment()), eval ), list(...) ) if (length(perf@y.values) != length(perf@x.values)) { stop("Performance object cannot be plotted.") } if (is.null(perf@alpha.values) && (colorize==TRUE || length(print.cutoffs.at)>0)) { stop(paste("Threshold coloring or labeling cannot be performed:", "performance object has no threshold information.")) } if ((avg=="vertical" || avg=="horizontal") && (colorize==TRUE || length(print.cutoffs.at)>0)) { stop(paste("Threshold coloring or labeling is only well-defined for", "'no' or 'threshold' averaging.")) } 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) perf@alpha.values <- lapply(perf@alpha.values, function(x) { isfin <- is.finite(x); x[is.infinite(x)] <- (max(x[isfin]) + mean(abs(x[isfin][-1] - x[isfin][-length(x[isfin])]))); x } ) ## 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)' ## --------------------------------------------------------------------------- .performance.plot.canvas <- function(perf, avg, ...) { 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 ## ---------------------------------------------------------------------------- .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=(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=(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 <- approxfun(perf@alpha.values[[i]], perf@x.values[[i]], rule=2, ties=mean)(print.cutoffs.at) text.y <- 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 ## ---------------------------------------------------------------------------- .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]] <- 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) { 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, 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("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 ## ---------------------------------------------------------------------------- .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]] <- 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) { 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, 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("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 ## ---------------------------------------------------------------------------- .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]] <- approxfun(perf@alpha.values[[i]],perf@x.values[[i]], rule=2, ties=mean)(alpha.values) perf.sampled@y.values[[i]] <- 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) { 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) { 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, sd) y.bar.width <- apply(y.values.spread, 1, 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("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("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.R0000644000175100001440000000530712143705053013010 0ustar hornikusers## --------------------------------------------------------------------------- ## 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 } .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 <- uniroot( h, interval=c(imin-1,imax+1) )$root intersect.y <- f( intersect.x ) return( c(intersect.x, intersect.y )) } ROCR/R/zzz.R0000644000175100001440000000432012143706213012214 0ustar hornikuserssetClass("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")) setClass("performance", representation(x.name = "character", y.name = "character", alpha.name = "character", x.values = "list", y.values = "list", alpha.values = "list" )) #setMethod("plot",signature(x="performance",y="missing"), # function(x,y,...) { # .plot.performance(x,...) # }) 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) }) ## .First.lib <- function( libname, pkgname, where) { ## if (!require(methods)) { ## stop("Require Methods package") ## } ## if (!require(gplots)) { ## stop("Require gplots package") ## } ## where <- match(paste("package:",pkgname, sep=""), search()) ## } ROCR/R/performance_measures.R0000644000175100001440000003741212143705053015575 0ustar hornikusers## ------------------------------------------------------------------------ ## 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 * n.neg * n.pos.pred * 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 ) } .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, 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)) ) ) } .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 <- 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 ## ---------------------------------------------------------------------------- .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 <- 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) } .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 <- uniroot(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) ) } .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, 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/prediction.R0000644000175100001440000001500612143705053013523 0ustar hornikusersprediction <- 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.") } ## if predictions is a list -> keep unaltered ## 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.") } ## 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.R0000644000175100001440000003474512143705053013677 0ustar hornikusersperformance <- 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 ) ) } } .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 <- approxfun(x.values.1, y.values.1, method="constant",f=1,rule=2)(cutoffs) y.values.int.2 <- 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("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("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("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/DESCRIPTION0000644000175100001440000000302112145174500012536 0ustar hornikusersPackage: ROCR Title: Visualizing the performance of scoring classifiers. Version: 1.0-5 Date: 2013-05-12 Depends: gplots, methods Author: Tobias Sing, Oliver Sander, Niko Beerenwinkel, Thomas Lengauer 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. Maintainer: Tobias Sing License: GPL (>= 2) URL: http://rocr.bioinf.mpi-sb.mpg.de/ Packaged: 2013-05-16 12:33:56 UTC; tys NeedsCompilation: no Repository: CRAN Date/Publication: 2013-05-16 17:20:32 ROCR/inst/0000755000175100001440000000000012145151064012011 5ustar hornikusersROCR/inst/CITATION0000644000175100001440000000134512144702455013156 0ustar hornikuserscitHeader("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.") ROCR/man/0000755000175100001440000000000012143705053011610 5ustar hornikusersROCR/man/performance.Rd0000644000175100001440000002507512143705053014411 0ustar hornikusers\name{performance} \alias{performance} \title{Function to create performance objects} \description{All kinds of predictor evaluations are performed using this function. } \usage{ performance(prediction.obj, measure, x.measure="cutoff", \dots) } \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).} } \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{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.} } } \value{An S4 object of class 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@mpi-sb.mpg.de}, Oliver Sander \email{osander@mpi-sb.mpg.de}} \note{Here is how to call '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".} } } \seealso{\code{\link{prediction}}, \code{\link{prediction-class}}, \code{\link{performance-class}}, \code{\link{plot.performance}} } \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) perf <- performance(pred,"tpr","fpr") plot(perf) ## precision/recall curve (x-axis: recall, y-axis: precision) perf1 <- performance(pred, "prec", "rec") plot(perf1) ## sensitivity/specificity curve (x-axis: specificity, ## y-axis: sensitivity) perf1 <- performance(pred, "sens", "spec") plot(perf1) } \keyword{classif} ROCR/man/ROCR.hiv.Rd0000644000175100001440000000307412143705053013435 0ustar hornikusers\name{ROCR.hiv} \alias{ROCR.hiv} \docType{data} \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. } \usage{data(ROCR.hiv)} \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.} \examples{ data(ROCR.hiv) attach(ROCR.hiv) pred.svm <- prediction(hiv.svm$predictions, hiv.svm$labels) perf.svm <- performance(pred.svm, 'tpr', 'fpr') pred.nn <- prediction(hiv.nn$predictions, hiv.svm$labels) perf.nn <- performance(pred.nn, 'tpr', 'fpr') 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) } \keyword{datasets} ROCR/man/ROCR.xval.Rd0000644000175100001440000000210112143705053013607 0ustar hornikusers\name{ROCR.xval} \alias{ROCR.xval} \docType{data} \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. } \usage{data(ROCR.xval)} \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.} \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. data(ROCR.xval) pred <- prediction(ROCR.xval$predictions, ROCR.xval$labels) perf <- performance(pred,"tpr","fpr") plot(perf,col="grey82",lty=3) plot(perf,lwd=3,avg="vertical",spread.estimate="boxplot",add=TRUE) } \keyword{datasets} ROCR/man/ROCR.simple.Rd0000644000175100001440000000135012143705053014133 0ustar hornikusers\name{ROCR.simple} \alias{ROCR.simple} \docType{data} \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. } \usage{data(ROCR.simple)} \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.} \examples{ # plot a ROC curve for a single prediction run # and color the curve according to cutoff. data(ROCR.simple) pred <- prediction(ROCR.simple$predictions, ROCR.simple$labels) perf <- performance(pred,"tpr","fpr") plot(perf,colorize=TRUE) } \keyword{datasets} ROCR/man/performance-class.Rd0000644000175100001440000000557312143705053015515 0ustar hornikusers\name{performance-class} \docType{class} \alias{performance-class} \title{Class "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.} \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. x.values[[i]], y.values[[i]], and 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.} } } \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. } } \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@mpi-sb.mpg.de}, Oliver Sander \email{osander@mpi-sb.mpg.de}} \seealso{\code{\link{prediction}}, \code{\link{performance}}, \code{\link{prediction-class}}, \code{\link{plot.performance}} } \keyword{classes} ROCR/man/prediction.Rd0000644000175100001440000000634312143705053014245 0ustar hornikusers\name{prediction} \alias{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.} \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 '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.} } \details{'predictions' and '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.} \value{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@mpi-sb.mpg.de}, Oliver Sander \email{osander@mpi-sb.mpg.de}} \seealso{\code{\link{prediction-class}}, \code{\link{performance}}, \code{\link{performance-class}}, \code{\link{plot.performance}} } \examples{ # create a simple prediction object library(ROCR) data(ROCR.simple) pred <- prediction(ROCR.simple$predictions,ROCR.simple$labels) } \keyword{classif}ROCR/man/prediction-class.Rd0000644000175100001440000000446712143705053015355 0ustar hornikusers\name{prediction-class} \docType{class} \alias{prediction-class} \title{Class "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.} \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.} \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@mpi-sb.mpg.de}, Oliver Sander \email{osander@mpi-sb.mpg.de}} \seealso{\code{\link{prediction}}, \code{\link{performance}}, \code{\link{performance-class}}, \code{\link{plot.performance}} } \keyword{classes} ROCR/man/plot-methods.Rd0000644000175100001440000001455012143705053014523 0ustar hornikusers\name{plot-methods} \docType{methods} \alias{plot.performance} \alias{plot-methods} \alias{plot,performance-method} \alias{plot,performance,missing-method} \title{Plot method for performance objects} \description{This is the method to plot all objects of class performance.} \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 ) } \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.} } % \details{} \references{A detailed list of references can be found on the ROCn'COST homepage at \url{http://rocr.bioinf.mpi-sb.mpg.de}.} \author{Tobias Sing \email{tobias.sing@mpi-sb.mpg.de}, Oliver Sander \email{osander@mpi-sb.mpg.de}} % \note{} \seealso{\code{\link{prediction}}, \code{\link{performance}}, \code{\link{prediction-class}}, \code{\link{performance-class}}} \examples{ # plotting a ROC curve: library(ROCR) data(ROCR.simple) pred <- prediction( ROCR.simple$predictions, ROCR.simple$labels ) perf <- performance( pred, "tpr", "fpr" ) 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) } \keyword{hplot} ROCR/NEWS0000644000175100001440000000142612144702612011536 0ustar hornikusersThis file documents changes and updates to the ROCR package. 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/README0000644000175100001440000000154312143705053011720 0ustar hornikusersPlease 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 Getting started with ROCR: -------------------------- * After installation (cf. file 'INSTALL'), and starting R, load the package with 'library(ROCR)'. * For a short overview of ROCR: demo(ROCR) * For an overview of ROCR's online help: help(package=ROCR) * ROCR help pages: help(prediction) help(performance) help(plot.performance) help('prediction-class') help('performance-class') * For more information, visit the ROCR website: http://rocr.bioinf.mpi-sb.mpg.de * Good luck! ROCR/data/0000755000175100001440000000000012143705053011746 5ustar hornikusersROCR/data/ROCR.xval.rda0000644000175100001440000005011712145151064014157 0ustar hornikusersŽX7](v 6&آ؊-*("at. ,؅:}~,}S3s9g̜/ .hi#Cf k:Sᅥo) LMk440:5n6'{͘k£)/|ӆWew 7e4A=7B(mTi7=IAQ.TGj_x̳ŝPy^OϏIiԵW)O[oeOpdK~8\ K^]'էYFxsx9)N\XD1P;M/lJkQlֻM4.A)Y#Ƒ{!ʹL5Tj >c.^ Vvcи&M%CjU8CLQ8üEשnW4v?ዛ=VKi OlIin7.>&8wg)=n4->|JAtByGݤ+c94 _x?tvށGh@[0N~_#_k>y'3J$:^G1>mK +9TW~3)sD E?u:39v~2׍"u\6n8hlm/ؤ)I% 3?b$@.MBCۤA8)ϦTz0eR٥Ǩ:sL. şF fY$<).9ӽX' N×!7ApyP)$Kބ>e}T΃! 4VvQ2>+뮑!yGkO ^Fx /k_WxFlrc"Wҋ=[T>H]d,o >>FnJzn^H>ARan q_+5{v!3|uz|{"ߍuu):0R(OeR?m4N!k>^NDp=N/Ca=}3oQ^QƫYtCŁҩ}]s//4 nv[F2mN.'xё V_jMpk7z^#jK7̃@;#ztߣwpry!ٔ ~6Ր-|yօ&B0ȳ ~uSdT^$楛熠+L'oC _TOxm)v>'d? 1|(kكuܡ?onQCW'*<cIy/}(/O<ߜInO5{Z\o^XWf#BSb._ Orj)+:/s ҨvGT_SM;`}1 ^~UHxoQ\cc]̚=O;͢s1IFTvgJS/IvRA/RZSo!+dO1??#j$4. |wքڗ>$}Ϧ}R=Xf?s~nH|lڢ}P9?K8qw3f(M׆y46ډ5>fm:!߷S#άz묄>ⱙR_T bVMбءbO׻Bi&7qMT¤qzOsYmll<c~9)F7gϼi7Խ #OXޙBC G9LZR6;}5ѕ)zEvf|Ґ[c!Pʒ7rms_)Ol8{c+𠔿y[+o O^ ,fOC˿Hx%[,4|[aI3\=l&LMPy`g4I S^1U[-XHt$ XhsSzY\aڛlxZi (P+j1%"%{bظ"c]uN)Gb_Q(x.I3|aH[4g;kK7KV* /oEF0ŸQ GCp fR>l^D(a vT%2c|4ezj'c|O%CC|$)rLw;xgDXܷz]4 ߅,JUd֗vS}ħI,]t /G!W_>zS/x>*N'+8k:[S^# }KKe ];S! %q$ ?lT_{ޕFE/rDtLSFpWy 74UwQZbBv'փ{t/_a>c}mrGD/4;E^ ;&z>sfA|i HhKiY~X/<͐4Jg@.lZc.b}3Kz$:ŏOvM %yoDFvEX_S? Tuի_Np݋}RYfԖҤ#<_%7po/cgH{SGj|W9' ˌ_.|zN7Di2 2u nNH)͵]P?退&nl^ڠ8Nj',zT/wLjEA/L46jbMk#'9Ѣ~`>>/0C,FO 96y=c[?MTQ͌}L)K*Q\J9^Csy㗗Pɧv9-bt"JSa?~s ?@^oB4{Lp$W':3-`7S5ĸbǼlۉSh()42>' i8R)=1W6_Ɲ|ʳ4KTϘ,VG͞9eB}t3, 'EBcOwp?=zy ?f8:%I=/O'_#EXGu~y !X٭؄$ ,T^p1c?~ƛߍV|4R/}.yXw~&݇E?ae&'UGGz!r7j+6rQl"mg=H~?CMTH^P*9 >w5uqիnƺ0 X'8*m/\P?ح Ji8B%&\އ:3ܝک[3r7 Őz( t|O*ź\MKZqN^};f7AY9Ep9BaHR?p7#4k,zb<û}:Qogk(66~̫Q)~:-R/$#'R _?^Nt|KmݾI>F%&ڷ% V똗4[sNJx"gB67x9%K~{Ϣv9C9-?fCy/fL'G`ߒXcϐ?94SnfKa-|iڅBX75/X5cɭ>{rm/g1n/NpɝnP^%Iɕ;Ov/("s^K {kߏDxy7GXo0 5ETu|Eg\'sȼo`1wux z| gena@n6KIv!G"c5V7:gKa=Ljgv&8AOS(i^g]X? p-ByS/t<5Y'~W OkG¸]P3#a%< صx-ye\P0v8߼rҩ؟;mXDSZz4½$Q=sn:\T< jZ~].`gɷs˞DgC׹Os ŸӶ@'D uޮ-X̢>nNyz\Aߖ<윶o_7B?>2SWu~ѯ>鄟BO\ĔRU6xsYoƽ~_<` mï82O{l!kϳ]aWltڕĘ4fuWswCX@tt}x]RqcexX'۷vG7Bnb9A ?T.ܼg Ϛ3(+ 1NoHG=iZM2Q; ^0h45pNJGQ?FS.͈΢}瓨j|L*ZRV~*/Lu[s< y 2 ,#<,p3K.P*rcڅRޅ栫2|g%LKi[! ?sRowuzBe=wH+ҐUϝ"m`Y8- x;GiEo }&>4r7q\s]B%f߇?ڔ;ԾDGePߨ^RG)2JMݶB /Ry8/c_{EFR +,ONL8t/4o=R9%^:TcqKg* r%>ks6fXzOd~y2Eʱ\#_ǘRGe Ǎqۓ%{,3Ҹsޏ#<ţ~jB6̼ATQ=%}:iF))ƀ1KoOW<6uJX8Sگ^ }{n(ZqoCgS}TgZ^, zfk"G[}. Yx"[g"pXo ~Y](.nFO{J, mJ)A0Nܥ/0+o-Yw9Du뎅{e!X7PuQ`l/=pn _9V.MǡHn|g0VMFҲ7??q?x_VJc jQ^1ނّ*#Y7dڝ}Dj/3 P{Gi,72rh/7pNpƧ=O4Qk.ǭМ+OAxGP|[˞Ʌ7nv`m:FzBNB ,Ր$iƺPk+v$- wQF7KYu\c9Ԛ7{c_(2mx?CAr@(_64lߞiGZm6Yg]ұډF/.?5vt i0ؗ3n>3< +]!7q6,+Ԑܻ? ɿL!!6!О7ٛ&L}5B޴wU< ~":Zg[׈@N {8F ~Gܦv Mci3gîR>{#!''%Dg{=MOcǺ8yIà9xٷ,jW1|J"8>)XNtik[hq5+0O6_W~MxT-Gt%W?USm|ɤč7#y\fsFV75grnc\xճQyu)/MfZc\c Gj=~+tqk!I[cEB5M _!VRطF_48L燩eeO)U;8w\y@=S>;ӉNv[7vW^8k$G"Ű?t*ɱ^~4NI'"6`\_\dud )u/Ƿ8sRq:G=.{}ޗ8)2Qt|%j3b_3W'y3iDܨ;s8 v6|:U)v`zߪRٶ4fNX=t<`mWSCi6=8m#nLsc9P!! cQ>kaGï}` /^Pϟ~Ey4c<#\}Ar*EoLh~Ԟ{(p{yC~4FH1318gdޕQ*2<VRQVP?}-W2#4OYQ0m>SZJNaCp*08`wc3qa 'm0cYk^LC\xřUgL{qo+ӍaϞ1}Spғ( Mw.=ڑ ,ȏO<|;=P{v(Y(C}S -vP}.Af ;lW1n5#hџ*+ʳό2o~5|9s=&zX>k9_}$!n@l8W㻫`ooApU DMgrj-fQk&b6̀tJ(H!U1 QaJX ʕgSa"y-|AO5b}ޘaCT'7l2uGv7/aY#F&xbyyFvO Iy6[0.ۃ;i[$/mJiYO_k3* @{v26ö]奄xwc3. 7Ndc6 ^1'-[rd"M+WG* g z0Ai?bq׵f;{rCЛc6쐒EV*rI,!ߚk7(u~Ϣ=c[w!~Q.7}@< U"N26X{1`o>8|窦 =+ѝƥk_'g.vހ9Vl3s O^GULٝ{v)>AOf|1={SR #tGىHT"S*)UI4w5y:?R,#uJm eW1qJ# i_UN2- \{;RY 0=`qa?*Ys,|x Xw^?_~v%QqX 5-G؟.֔2eLj}qW$߱Ǻ0vyN(avJ7#;S;I1>S`ɸ#SLj' l5YD_ܤ}[zQy̵+^ج6X/=dLg>XzxĥjZR^5{[ {rYwCOV6ݯ.hm3!u)fW 79㧢)'㰏I?5qV/O >UA߮=O1|:"+1!;ےr:K1|%dm~bɸG}I>4)qSa>:[=)6n ˽~zSDn'1& 򿎂Lf qȂ۞ lSZgs ; ?ub6ߩgoDZwdaW{/Cr@?<ëp/- d[4g!Љ򷈃C3Uxg3;Lyֳ4qi#nQf Os.ϏxhSa.oT_oqH9(whK^m]wkOt -Sʜj!Oy?+!$[g̢<ِ3eGŅw8Wc˚n7Ym;D1Y+}k2X|0'm][Od~u<ĖB!h=-ĥ#@C:ٮ^Vbe`W, 2 "fKoؓ~! d*6཮k}Dp'F\&8Xn 6BăOV#=?u<]qBIeЯ2Źݵb?b"W>v?ݕ!3Rd*%^}@U;Dq:D?4W=#ɩm}Rq\){KT?7UN {|d$ʧKyP'}*|97ؓ2@wAT&OHWŽQX5S%eS}>]7Ok~Ҍ3T.xF#vsN]}ކUЃuĻ۰nl" Sk/_G = ^,#܆3 ᮶]< #O.i.(]=:T`U)ָg $|)D4.6"_1.h1nsQ/֐7l3?}n2SRWÏA^t7v_axR_8'GD\hR7;;e%=^? rB\`b9Ա=Hh )uH-O{ٔJ^cqGڂʥe៑KxTacP;EH"y 2%(~r?ng?zt&/hA:á=wE[gJv0ObȁWw(Cwו4U_kqv#S#q,ՋMi[sK t.yi?_~s'j7=q %Dt`JK&ᾞYʆS=khlsU8 +ҶyE%ͩq>̖^>NԍkQ*+lyȀ& oH~c.Ly)4?tr׽o{x(v_KQ$KiɻxGIx ܇kh`7̦vTk ?'z3O-3rUX 8>豹W @rk)XG\y ~,IkS@><;A_6|U#>hj)R}k hӇQ*:i5 mHN !# 6fXU`ϮdNY DŽӿ="` ar*U+˳A?V$y_;52|d,,PN--}Aʜヤ/RO[j@}O_{3uj,>܍_t&.->}5٩ߴ"J&lKٌp݄~kLڭ=k)i/҆T. qoNٍ,*{T~i\D\ oj^Q^oF'bYC uJϭ'g /6-rU9s/~U1ۓOdu/[9s4O2Iz?w]NjRv3=o :@BrbǬ Ԥևܠ-ai +s-/_c;se6Ng o7;->(I')׺u7VsoRyg<֝j?c~b2]p>;]4;u??w: *3iS;ݙڕX>x5y7.5{>* Mp Fm's/=!X !#P9kju_8|爯>$Eͧ&8i o8W ?lFtu:H  @+1t /ģχ]{`pcWD Hܯw Yyt+aew*DS^.68v[tp<:o~A\IǺK.lmXguw͇u))/jJ26^}[,}/%^]Z7Gl+wxzWxa_eYczI}U/O {ʏ&V`Vc|ŧ4$qMh!s<:7 蝌")?"ri;~%F)qT/gGx|,qrW{SO2tS @>a]85vR4^Vf{}7BZZ+=tq E u]Nngy;QSV]؅.]GRxg"cw^ONuû+N7?ANguZLXqi[<~9Xge-_)GbKfh؏ghEwOw־78uד&U^AK`(i ;Ĵb:|f>-}nn6Fg:ל+ž˻x`"xƒ-t'ωp#N\t}J8WҖ`Ggk%vaCw&4<&v!Dܧf_0{iR`KԈy\x|K?£-dA)a}>,~7@Ύk`R Caݍ~MK?eKĩx/%2ډwE?/^ CC?;;n}c7y@/.Ka- 8o?1r.+˟9R1.ٛ,M}-#'?Yёmyߑ<7ڿc(y4eѸhze'CS^.C~oŅ#i{=٭Ӄs/s̎F3{ZX2'n 9nlFms ) v, >%KaP=A|:;WҰ] c q K,F9Cq^}}&dt!:Jk9ǸT\ R7;;`ԊD wYrqZ=4(y}N ~YAb-[%(ΏgZ#n<6g&wu2?eMח@:3燨iZn_@J5 SAN⋯q>]!{=3yaz.w[j qb^>#g Ioد4?Z߻o]5-w%#މ۸q:΍BQB-a2M3T.}N٨5eLZQyd6MyG{BA~5{F"ޭh-ă3]W*J ZB_S>>?8-I~?Wv8&@Zݩ_Q^o/D jAna] v]Ez ƵJ)czbݔTiu??!\l~0wX|x?4KFg׹Q5᷏x<`Al}؟! ?e2$wˇ|˓sw+&%ٷ?+rzCPoD6¿.ӷ8t 9?zk.dZ{ /5>Y?t ~א-3)ٹר}5Fy__8+ =ϹB|oOOJzOwaZqKg&rh{x`oI9`۴aTi.ޥJB'bW=6$͊<]< xMg|wP{yR%/KW4&A^JWq9K%}+߽RV_s;ޥn;iD/O"WS܎c1GKf*EJe{G` _zaGs&ad~ ~8 .A֎ƑkeϧV;AY0 1g`͜u7!7_pritυ^{qŌQ/.E^j =>/d jo:cf/,{/Ni?>+Df;o,zA{8yl&g~Ӄf1bE _Ҵ/Ғ~K`@OOܸ "SEg N|^ȉM*& Zw1nDn'.WЎwe;/j.s0x/Ms%잚@#yj='z ZÞhWrhgK>^`a6սo픂U8״xJU7<}n#> Pix$9ŧlBh~fSy޸?>-egcj_6Ot(9vx G-vGi'9{ʝ_txd_/c;Ozcm?bJ L4K5oB ݤ쨙c%>c@< 0诚cO'>NS9+vuTu$GWɭзx!?G8m-qJ^f?BaÄW! y;Eb<|wLO^rcqgMoΕiGos,MP7|IEll#q?'wE]\^J FnrI"1|۲)'(0)h|B8 7uXXqΊ3M7;Ž:iw>)U? LD\Yɖ)WmgE]XqNzSt=tߵܙ1ƥY.lpOm${ē]iڕn|_ǺZw |:W`I/Gd;'7>kqE޸{3&|k(%>8d#$cDQ$v@Y{\޷w(Q*h}[Oq9D=O`SU"nQZrq{?#lci6A)7Lq~m>-k<$?B6W=LZm6a]SJBĞsMT}޵J JbiͲ=KZ;f e  G B~::}s^c[|.N ThMЉ{8")cз;q^ yɘx#.H {rh-.q¸]<',}׶\HW#n[S8q7g.zU.tw|Mi4m3yWZUU<եRUyg}+)}kUW}+KgUXrQV][{.VT_kP[让vU+[l}U._^kW*/TUSroU,Uw*Nu\S뿲緢XYWS^M UC_Y8Nu"=_+*W|ՀW_uwESZ*[_}C_jz|=W+_]5=觯>kl{}+Gyk쯦geVݿ{}XS7}gye5վ|gAE+_Vu* ~[.+ΪWW쯪n?}妦)>/ҡ:wՕKoecu]Y85ԹRO*ڕׯ"+嵯~eۿ|nW_u建窾GeT]E_˃RCM[uPWUukoEk/*¯*6}ǩ<~[S봺4Γ?}"8,חU}*ۿ뵦E_8]^oj+e,뻏>W]9*¯o'嵫.*_UzZ*G_,,]U_^Uy՗OWU܊T:kjVD_U+[^5.?/YsKE{׿ЗUNԯ/Os«j}M}yjz{KWE'֗ՅW^kz_^?}k~]+Wu_ٟzRMѣᆵ︫o":;* Wu=Wx^q5T"USSQ}UwW^e׮~O}Wj}Yv_|eoϡo5VWN* x}ϋ^7՝©\ToEtT+U対+[XE+v:j;mwl?*l{ [۲k*v픣?BjB2ROCR/data/ROCR.hiv.rda0000644000175100001440000014303312145151064013773 0ustar hornikuserswT[-" *`BQDLTDT@T P N,9(9jEʭb=ޯ^;w}57Ŭf9F#Z3k#5k.]tU]Kn_Sz]m`aڅ:} {X// HUsi3RXr֞4?^_bA&>U9S!zx:UIoA8@H~;v"whT2*~<yďK !41WMW&0zUMZDڽr߇,`n1:m}^/$NpExbd1NB4Rvh!q/曎A:JiKxˇZ |v?&}.$kMxJ3F4@TI<.s>z-b!5/9IjS o2Ngt*g | P_4h&_]z=^ko{_DUփ5gGEPe: KW f!"Jmǁ Zp(ޅ4-=>{q!o:vYXNWfmP=~-rÛPN!^?2/},[±! INo{5- SG g|-g|sc`gbzz_[ )=?ަM ]~򌓗NԢg `p_U6*i EE; Y茄4ֶh~tEIW@~N"ރX~ͧϳ\wnw?8jos?q9g|} =St됔9 Qnw SqG ({Pc4}:Ȣ4:u'BpҮ*b c LN -?[v 4?[b&'i*l秓E *ڿhZP_/ m2t#_5ӄ =~kˠծq!Xfz:PnxYk  G%^Y_7i1]\nd=nYBeJ/^Vgx'qJ_h4ny)<#:s.dSv $@ÏxY2# յicf{GR-9AS&AsI˃HsٔGGEG %":hǫ߾+nם!6!!=Ym. l2~15Wv߻);"oQPhG _jVβW R"Q}0Ej."rpVڎ2f}W'jw+g!Y0,BO_ $m9N%'^>pU_CI{C4Cq,$;ENH![|DŽ0Hott|Omi}1X-KC !}袰tn5s^(, !%S~Li@ئ{jF[YZvi;v$8HRi;kؗbP*~PRں3HpmyUw]]7t%:4~Y/zN[Fs?{fYɑe1O1pT_Som_ 2j D/?s=!./ĂGL*m I:{ǁQqQ?MڏJe2/m@xHTseLݐnZ)=qw>7yǶY>e|4"vi0q;L{A~8?&$vP% +DmiY?]6o ?h8Q/UΏtٞY$e]Mr!ATk Ri+d ;ܮ c~ʌ+!mp8y,^tA˘GVFoAbZ_۵sڬ"FAnsajX` OxhQ*?łpaא^8$\M+Ajw+[F1~D͞u&m0p-ky e G7A'ECyKuk 8gPH6_NY{A4ƕ1*z/ҸeڠwYڐG޴ 1?~r=.Bl҃/tH8SLswr-NG Ax"1: GG^3&?{]Ѽ˓hXdH-hmx郮ʤʊ;;ȶP;k!d[E:c[B ?8R.?T@wm8O-]R%A$z ̦'mBKߵ)k N]+I^NGQeK 7Tb񗚺J~&gU4YQ}2H[0 LՙK}|?Bzm8oO_yC7g@3'Q9%| ʇ_ ׼v|eDZm-O@89:]܂0P/~TzW_~W>nRFL_AbM^3e4 ]\+VmoCvN%WI; ɢWgBuCu>$U]OZV5lU3ƃOeJABI@Tu'JK&{v®~桊9bu'Xo|ÁPrxr"BJɸVMr;J215s '#1m^!T{IR`q6G')g ]@Ekr H [Iȸw~ok$'Rs3 ԯ=9&x{hܴ(>1}Ye͌simN ;%1;a{ߣV.ک[BCf._nt ɜ ]# =};Ls0dzOT:x#z_Ns?8/{d)sx/;c,]a3xSdȊtBe; R?l/Bpq'*W>N 85x ovv++?H\n~;^tH@ܒ8Lw_YSCy! Q9~A3Gn9fGF//-Z?uޚY[!$4P5M bD64|P˂$2@Թ|XֹݘB:-isVx>ap= szCfQ޷ހG\ PROnK oj{j[:,: g?gwyAXuPYs^I3vMdzҒgYhq=tR>g̒q֣˳H<\ඛ{!Țrk(PuOR{^|ҕHn׊8٭m DC{,VBw[7,(9ӿO뗯0jU` xHv7=[+r}ЬTbf745ӭfApb-~RB4.9ю~lH ˧,+Xy(V-~|y4Z:Ôo9E"A09?h=IkVXljM(Z/Tߌ癚.<4!ֱ|e' +tbS%{zŸF$m ǪM~>/Ϝ`x6y]FS&ղIfHwƱ>G&$quCtl8Sxr!2-/K/F`g\ChA=qW|}++ sh^|=#мϮm$v(>xFi1Q;HN;|UUvoHwAiឱƿ-JQ!^uZ}]w+]<5 oίg撘3Yw=Oi}OOfmIBmbFA<ܻ57ɼ?A/5T1( `44/1v'y!J+ލ@j#<^N6eq$]C|]pB+/ ѐ7UkY5Ő,yٽ_}gҸzZAnt[.f}Qc+̼ h&&4$.L[2ŎO7UtSWP}s m:4{#8aG'٠i\ qCKVs֠7Al<wg ^1j\J'HvwR-vYJN^F>o?xվƥ N{KhwŜc!/FNQ҇u:Hm4%Gքo奱D?[$|p~[!80m7_[pFŦr{yC>U[ѲǪx! 4 RDv$́L#/u6~͔ DwfY@X4Ҡ6n@toӐpo[rEU"u'54aRtXi>'}U<׾ͳx nD-Nk#<'EAƯǐϑ/GZOF,Wz1 _ihXKFO6l]~4h81f;TnG{MeZJ3j|35?3q114[g%K25􌽠Aq: w {M )l!RE]ElGSXGC+ڋ\$ëdOhE073  {@4E4?34yeƗNE~3AfGVgM {Z/16J֮1n肶k!ް36Q)>kO4W绥vNpe#νvl1Stu&ovr$3 ['Ci>_>DzϥQƽ Dә"&3@7o&EZIpi>H[?;Sֶm4'} ChVi(iJjlwRGM&wDŽ{C~5uU5!u]4H3FW#i9ଊY ɽ"Ch~˽LS?M&kM7j%uʼBjÖ_<4j ibg{kRsilڮ~xW m*'9˺W\EV_CTvz8E]xo4xp 8S^5mAڵ"65tƐ &3еyy{}ƒ 4|2>۫A4N;驙4" @ϨSh0.OlqvgQ+_B'aIX$р1ڢȟi- V"N>ow4] } . 7|<4}>(Vj(IeV#}7tHp  kH#JPc.&/RaOX0"?X}iW77C?=]i*B]6oq)w7`ፇ2lJ?;SS*^&:Z:}<9bσlyڎZK83'jO^by,a3)6ъQowH[ V=XbЬ$FCJV>6LBK̍3@uQ;}vCfIи{)2OtM3iOFB wY R47ُeSCy {hck@H)8Yeb7(#UElNC~ۀLiX߇xMNu҃>lIkۓ [qT8j94Pkz&* }d?l_ z DWrh9mI 1O!g ϢE~&4cGӌA!MB{<>?-W Bs&s 5 l;OO$?9mv|t6H~e`a.1Sw]Gbi4?8g.GCάG6 \So7 Y$3~_zRw$yKlb4)kz,A)k&  $:mV/ZO8#?Z. ;ĢQ捐BrZ&҃=wN ʹXq#͓H$9Џ&GR\\ƍh7,(x ;XO@XQϮϿf[ Az[pdM;2L{=CkwH?'!6(* 8]@fl ym$!'*/cm"m {]&qRurtͶ h.~;j'mLcN'E'5y@!D7;_~$_r;9oP Ϸ r͝a |37jҚ5-wU EugnݔAthv_P3fiLIT&ņ6))@}5^^4'tt}"#l<؅\idh{ E;W;>׏8Fs}ӋIK6ok<&@(T>j-[6ʥy{Y[sgnq([H5.H/w!/Q|uGbGt mch^m|K8^j&Ξyڭ7 r־}qo/ߛ Z6=Y1CI@< m7ȖiťmYG3~ڏH{{+ߕ wnNWGSDz!yRHv -^ b/C^aaߐ)oCg/No2gbYBHJ@^_5q;dn{_h+G_4A{{!^8g9Jૃo59u&_<t/t}=Őj!>+Ę܊t<8>g6[I }k/όHlwLܫ4n]4KWyIYK Nbh0tH^M{Lo3`;o|y84,Mẓn]uݲQԴHdI ?v/|πS ϻm HmJ>\D%!hܩF*H#/R7o왤N?u%}Ȼ E$T59`m )-̮D{P;GA=ywGHN,mw~Ő.;u6P{ϵvA]x"?llmWi48z:l\j@m/I>Z3q-B5.$)ڠEsi ;q`4mYn/ʃ<|ԜuVy/-_ši=! +~ٿBݖ)l6V+g8Xw r}MlP݌cAa2B꺇`<$/?i{@G#_۰WJ-/@g@ԅ1}㳂NLXH,O=g"A 1 eJ0C  j>l2"s<ê@pſ>,| csX [ү'I_HEb`v1-}G<=#͇sƭIj.Q;y4(W 4N&x#WUُX''mU_y,m9xF{:xL'w|)҇3(zRѡ${C.;LƈjҸ7Sa/E^E=^:am${mWO1D֏-cíe6Dj]smpEZ Q\SfH@xS.爢V +Kh= ;z#W2u IeJci@Ti4UB/_<7) |}UwAxHj$kʹ˧<ӌ3֘62 e;yZw@}EH".  Lq>)F0o^o T7v?t0QGq~\eIAnq4$dZ|ʺw VnC9bH5Y/X2R^}h;|(IA2)ԙYvyxq~4qsI5/%GF1 A),FE];$(Њa_H AY}h)I9KqK=B.]wB>z5s=B<ԏgѢhU4HM_}6#Vwx.^DI[xY@P; tloSu/4u;}Ht[ LwAKׂ}zHn.9,yD RIbG b e^f[ՅT%_yt9 ;9 VkeZ?o۽ӕ9y~#_8 ~ߡ =N0Tĕ%;};fUFOz۪scwE/Nڦ@57%a!@~,7NMj@Gf+=Vys!^q]fwP?5-$1^{ޑ|6)Ve3}7ա.A$oj~H"H>z-cr>_@sT&q!JN/В@HRGcaC-ͣmd2sؘpYJj ǯӫ+^vi7+/\ƂS2Ի2P >n%UJ}ۭ gwmCu7TO#Ǜ%)oP$ )C^/YB=Wׂo5͓iYrULfC>!_!l[|m:7Y5ѼL}/w79Z2K9D1^{*iaXC)~v4>о,eeVDȴ@4ơGW۔+I<т/Y7~:WΣ8T0I*Z>^%"N<ȆnL<`׬dE[\]Ct!t_ 1wXvtvl9 *i[3{A-xyȦ"pmݘ0)oG-ZzMS4si~CGm815cDAc<'|Ⱦэh\q>IN[ !9̛\$w,^t8]bU[ӿ5^! EE8BؤYS(I$=9r"Ѩ䉎ཛq;30o\ӗC<3ͯExh6;d /(, L^grY[Ϝ6c/zbdxKZڣ DP3>r"cMNNН(^'WA贙Z?Ts=S &o гfkWz$m$5?`*4¯^AȷW%}jϓJr@HϳJ[F@6I\u- =5DjJdșrC'\J0Ic7UK+#n +uڕ vQ+{/.O&=z]({c F2 ~2Y8 pL #]T<~=G>5#Ifg춢>PQΫ+؝_sFtXIig!DΊ!^gJ⥊|h"!zZm*m'}iMGQ0H~o;w[~Z7"쿔ޯ{7M*ZHm'iJn<^C_ožiheZvđsʫB%fqYa~]zݶPC$thwԌu'K'MHYo'eC5^U4rxqc·Ǯst~Ykka 1pTEॴ9NL3B[1"&'nLtNy A۟! %EBg٦6({*WhYJ]mg@F|^Ȅ0 ɾ?8L|J{<BkP4(!m!{z!}Kqlso4 {@ "=N}dơ䷇;3iL^i{aS#yrm@RI8 -$|$AQenƤ-"ZKA8€9-s%A4X_˃_S'2ˎPU mYS5 {53RPOT]5E24Kku} Xg˸U&U>,{A)_UVܛ 3;Dg3J̈Hcǹ|u!Y}aIsj>g)S juڄo ,_ߥ9H^0q!w֡IgGǣ}6$.׆Γ?a⭝ϟy1>RtO8sk;˝N-4)=qe%^/pe+Mph:`uv 'u 炮?]bG*wzF٪c6wWADCpڮ{#" niSޤD/j Y/T!KMY曖#,*#Mi u3JrIPɤ=_DsFATWZ@SQ&,9ے0ly n*i+Hh&CǰO^~aXE߬ `k+B%E߲t&{F4x4\4&ÒԟYgaL)G'g[UA-mL*R)GL Men=T)R& r,0V} gFc=wo gyEϐpL?| LHiB!0)vҳbAFGTBY]hҙ%j}2h~?Ϳ^Vi~KH1+P&O[}MexRhw ҵܠE>,YG8O/QEh8pU~܄+I}G^1H6mj*k(򪢑~u$:C'n SmDᝍb)gߟ0ӝAbJcqZ4F Rp&y P(yiڪt@ksSd^C[1mh,pDӎ$f,OzB {OO gou[ "<x5ܗwG_Ťxʛ/z17^8%q!]YOLwO!;B,>2"ϋӆ< Ւq" 1 T]:uvjLP=FHbղzU@JBFo=7;3] : c(9bA(1ɐ>_o0%n:G09Ԋ3+Z IZ7"Rĝxn[O)5i;iKiT]1)Ld?)Ѱ=V}'?Au9`tk%0դȋ7z\cCܫC V91i$MWO IXfe!W=Hk6lxgb gn ;ٟEO/Ѿfl)Ug>/חetJp?0Ի_'@bW0YҼem~(ֵfO6A(0m}vc#5ArhgO&5ݾELq9ݛ)+sh$Vr?rf.NkK[ .uW In$ 'cA?yb h}RuwO㱱s"U*Y!?pFaj NG‡mQI*VD<7% 8 T7Lm~Q@nf2$qm%0]<b10 -LTGg<5m M8 deWKii[mx?0=wxi:l!'Ǖ^iͱ,.>Tj:2L f"4ݢ_S0m:`-|ȶWyӼCgC4Nzlٟc /pzKߓrf R3Iku5vVg]۝rʧ=!BjRXrH\W1FN ь1՞ҟhӜ}!xz~jw| 6g/X=E4ZKY3zTHyG'qS~jE2]2clD 48z /\y jhV'D_ԁtWz ^t ˎ/Y5^jyx4ŭ(yc6JH}%#iܭ5l5r3*` nH>'6io#}pI ƀiRՀl45KCHbzApgIf|V1:o3ȕ>6rhczYחID\Z&A\p%#kOH"ۺ|PrV]ړ!|՜m4/u ܇#Lxuu 6%e:uS+k'N~Nu S(:S9oof}4o9d?Y5C8K.'"R2aR+9Y NCֶɆpI("g`=>2tE*bZw֞(/)v";MHŤ/ Ȳ ,L^>wNބ|0SxaKv"NhCcn.t]2ȔOnB֦A{M+!&Ѫ;da$>CjL!0ŞҪx)3Kg-jm_,tH)hށ "gN*|F9*FBF{:4RU1y) i{aMāL[2Y$ucLp{yURm1Z2=!Q @3g4zh忠b~X/el[(,Mݿ 9QDθ*DVjMʅ?, >G|7 SqlRYIi7jB6c[:HQ鸞_u!7䠾7! =K|1%E|-*?Mb-j;sh2;ɥ6a{.n QquṮkٷsRuHf*?4!b4 nuz+)YbTBꢈK6.=0$^g8 VXEDzJD: 7|!i  5CxOu|1mRy|?_ hVGi=>? [7W=RD=(\9ǴӘ -|EPpwͻgbjւb ,\Փt݁mPڽI9jȇJi*5#yj*>voe2Od!YxC$R/Q3 ؄| [sR͠}WIJ_d6L1>w^iI\rIlCsՙ!!W̱.bڋqIg D-:;9Cpl 209%vWLHlf Y PCP[DAbMQ(QԫAJ-U^}tef7ςgw 'hZgٯL҅$?N +XieBŐO>K?-. ٪NbƯʿ 3M҄=I ==BbbZ`I7wU~ O^M9ﺲe>/ƛu2{VTW\LsOusщ֏;F1p&w|̸nC9 1{<9 ۹d^NHߘĨzȌÙʋ~Zpk~W͢W ;}"YCC0]c!sU1 ~U֪uWi} r@USuUj3ڳ>çu\a y\g s!뾽: R%'X 4Uz:xV}nEupt|VF;?Uy+&e7gML%G;Rn`B/Yյq<._Hy|_Cb`$Hfn`7ӳ _`N6];B5!/ŧ=[!LF6k]%L՟7Adjv?TBX!`).-ؐUDf>hN”`1%[Fpse?ڟx~LW,qo;Cڶessh?-Rq]O _$]#Ռrs%2!apXHBZ36CXۿ:nnif7ܕ#w&9miM$&Yӊ"_uCM1'ナuH%Կ1c*tb!+jx#v7V R~IgYF;Ǘv4)5%)[@>c d&_դec5h3 YEo'O]Vql7g)0c|O\i&cv.&7ҎmB!.-:^2eEA~Bw40m Ϛw>٪{/[:yCQ´<.ą}:1D[yxy#.GRsēBC|޴׏-<Ip_ծ4?$ԠE\TS:5f0(Yǵ[iKY);pB|'PG7B4d޵7A|zY̚}}.a|%B:[Q7r;Yo63Eo.\}QfɄ%l'whjV{4𛋩˫Mp8tO ߯2Bdj<=Trxw_i6CY&ʼߨF t&13L_< P}!m˽g('J*.f2_;|D6`&>wb}Y&fD=uܣ!­iﳙrh6}|xm:$`woXO23F qm,+G#_uز̻&\%S&dte[;] 7A7h嬄Yz\UEe>+S@a~7% oSԋ]|&~@ANK|R7YF]%#\wB9l >є4v@&́>Sᄵ`IP1 R<)wZ}w}PMxha~'v  ZV224Ŝh5<$Ҏ>nas/j opNmfiL@ck@_;xBV) ?}p`z-÷B)׀\*b&Uۀ*{r6 GNq#y4x0.:iڢT9%ߌ}zV CL7b.@5>hk!R7U`|7;G>]eZ<+#!ջM˷Sy0cҼ;*A-|־<z\"G歞 b&ݿ CBlPmQv4. 7,ȴ58RC-5Re_E`#m'xTqov%iCz!k ~e1&hPFKpg8;㫬 Oy&3{wMe͔cgނԭcwG8?x|F~X(zDe7HDBuM_= E7:[  Kݧkum?is$6о,mHyַ8LLZIce+ULCdg2B/AfHtӂͮI޼{;ڱOwiǠdig`Kr v_D.(Y}~l[RڽAÚ!,w=6/`L\yɕ| sw{.ٺLYtM4d&B*\`8х8vWh;zbqH6H^h3n_^]/7=!8,XHsk;\~ǃˌ %SuύlL5tFL?Q1w`ʻY= _WJl^=^'(T7sFP$6FżiA=z{ـ!u$pth=uab%Mdb$, ġZӻtoA ̹rp =i159~\*:w/Z:)eW"}~>5'w+Ml!'}fJ9j^Eg_!0Rºw /B4Pgr>Hǧ2BE6dP=OA5kcw@ix95mChqPe?VҾ&@* ?Sxr92VaͽWQX0'Y+(]Idr*}LC*n= .2F́|/=El'M"z*RⷼgI420<N;3mRC/O5BKN9NILWaݚ⹡gRѸs@*T^=dDz9N(Tg駀?M6c]j*~S\Kpo>{ޘiE@%/ɐ1c-,@ltbFyW”ZǽGgX̖HWOZG96̙IPeTi+7_>ay|ɟ9^:~)l5x}.X?TѨD '!MB*G1IYߴT߄ѥ|y"?+'YI&T/Hn;IITf5\0n[\He"T.LWf#_*g^`CZ!wuP[ Աl"&|zIA^E B0]'03о ?G_>3b+C/'k[ퟎM忲S=hkM{$$e,(95??Rka/o.M11,ђC\ /L{Pze/>Z5AR Hqp|1> ȔPf8\eIKsD̦͈(p~Lnva&7f:vvAoԪdȶk@hP3`gͼ;/RO,xaN q-5W4kU'8?*<56 Vv`Swo 群epRYqvAe.؎'R/~~'}wK# 0$5n I_)c!T\{$Pܫ{rwi]2ɓ*b4n?5|p{&M庨}uŊɭq|}6R㚶 ]VNlc8X /i[Q(&~z7ܯ4|sԧ7K&-mٿft%:)}pz> 7͟ ޒʗ`E\\%ynFְcѴIuϕې`y\qrFVQ>͛)N=CB R5A5iF, %EzO-h? 7iQ6v#BzΔ+.ɡ7ר";쟭O +θ[ӯBc:yR32< 10#̈O~gxqf~g74xe7\qu^_j&a/gclFU9F ;z.DZ w>o}3jKƧ.ɦ†G&n՝$>5y"Ig\ss%&[F)s:R8'b)hdXq}QRRx- L!K0i!X~{]I;KyM?%S _wIEtW1e]OP_vKivSҴ?w`7kwK] VlE*տ <<71X Rɲh_sKkP x.eB7֟ۖOf'ׇdo7v OYO8H%9u#jjf R%ekFtuECP3|ıfH*y8!x݄I4 QRM xmS]NkP7QVn\om]/S {s~3`p#LU'%gvFpf $ZʻsVLF[}|ȍ.W< ǡqJ4tF ~N_V5ZK}p7z] y{dCTC+oI'Q6Y{!8fp;Z/h}`pިsA ?N'{+A8#kz5 U fkf0Ds- C]E/uTuVXrzs﹍X }ѰF{^c5T O'xp4d׎e#ۛJ(vh-zƜn$v.x4)8W-x5AwsCDZ9w}@bFͽEi-7s,XC= ։Q,9~ޮ`FBULYyo8Kޡ](Hv ӟOEdy$~]V?w SAՕ ٻvC-FFJ pl^U tڂ'4~E.IzdsϝWxږvTn>uI:7'u=oFᏍ/z)v5+,^ !U|5Y?OEY{Q:uBrzu0DL FIS. U9~A3E[^u?hփj$1zѕhl ۭ]7_=0/={Ao,78o Wkj<u&5_{yL;~ʞ{KWJW~t{03႞i~ /+vUDcs{|^(w3ɿ[)/Фb"?~tHm;}#XAƒed^}Wg4Ze y;^|\!0Cf)oZI=X/;A9^_yɗn\gL; +݌._%Y_f9x76yƥ#E?q`ݲn,h%e!"^?#?\#E-r3B68GwS.ۯE#6_#7~<T^No.YtQ];,<l`_8`N [E4]i~^^Mo;yف4کlj\`~o,N{&C)Ǹt܍7fYa)18'Cl dO /b)g50~T,(]_|E?-#52A]vea^UAQ=>Wh g|r{Lڝ}R~,IES.A`0Sr65u|ucISQGI娊W\뉒)UQaը-2Tmh֚iמBCfn`+g<a~{y)_lnCvpz%|m[?}W7:pɯܟL?owѴy[,AN*pLv5 :Ypk#fhXC77poelhYQ=]ޟ}d͹sv1kWB_V;IZKo9ٯ4T_F~֖G 7\uitq!$>[@a{?gФyN͇<|s83G!e=a݀lah]kO>xToψGw)Εs64.@ KMESnhR у>ۨ n<0U, ֔C/ew.<E"SDZF-nK{*~)D9{'`o6Z?}FԊMHգ:en%|ZcHqYa oBn&DX3_5JGԬG /ׄcnECt`u(p-GVGcҢüq1hpw+͐\hO]bg7R ԥyۜtqʙ>8CfUaaʨMrLO_kQ|z4.lX5eF)}f}1CMedTg6d>s3ƵQg k`Лi*b nL 1(2ߵb} M!h)H v\)4>q,;qkcGn42qs뾃V%ӯǽs_G4.D}4^ 2>S$E^بJԽץ@pΆj .qWco5=ey"QZX<-gwUg֖_ܯ|~&-g"9AE"s$"Rsirλ=HCZ!ϯW{D]셀 WV);qji->?̉7(qIw +);/x׺T`㕃*zyyQZ;'cO:+Ouuh?o_PT+Xx.7K-Y㖉o_z>ZL'#c _j JdXT3Чst۪;GkGe;O+Ԃ=ư^Q|$x&{|B۱Y/tAR{!=O.Gμ@9(;>!#_鎺X ƃ @EYOٕi/f\SOvmZќ6(-q)sǙYC\ej@4&*1||6(L߻:3A1u/ڤ=N=]nSÈ᝿〩p9 uUkzx$S/42/\ U=V'y VsZkm.5<he=9umioU"paf t] 7Q=qXX<)7lM[F$]:4.p/\?ST+G<{ 3PKDDܥ6( 5 V!3uL#߳>]Oʶ۷M=}TQW;э棳nE[j&n+r&,3OezO"=m~~vv톝nKHZ?OqmwZt/Sqcp-WѸe2՚MR%r}Gc?QP*NH1Ʌ?k,Vqe?^`Tw]"ܙwT>GiAQ6 7ߝ_nߪϝk#=jrv8%!=Ƃ<&"e&챢M / =۵M?ۍc$;}Av* TBޡ} r|}BF ;,nuLO~vʟ{'ZH4WXR؞]r4`O8MQ)M9 v ܃C0vcvbFY||+v wvYYB޷?/q)j003{/pߥ;9/\Yp֑bw;1 zoWtjҷ7L'u.wjD3>p|'J7_nFۓBԟ h#PHwOۅ/T(K^~픮|=TX.YtBŹ.` J0&x|W eq㾭>]H$ J[257]~OKG?f K4u-8\ #k:?7P4 F>S4nAE)vHeSnܧG$ױUhܽevӫU([Ƨ 8lmέooć{1G/Aԭ׬y&=>S]BdHF _P @ B ^ W^`mɄk9<`=}L?U4M #)?>L|G{c_[YuNj^47cbn8XߏKC##Oչ7v@1&WYzJJ7t" $ĔFGss}6yB2_K#XZMጹyN@Z|G>þ|1ܞ#fCS l^-߬ė[\@{>nд:s )y$}7[$rM{E9_k?}Y'~rl8͇HMSӀ0|ghW NCק,2R[֖!U%ӛB2"G͛zg igs6WaOS]ԛ YaκΡ6X6ݴcQ5xJd08o{(M$7Oe~CPL)AHڪYՐy +}mc\h#旌n/קg_ j>q4bJD[042/B'ϟp͏0u?}#{i@`'GEը6[v2nv5`xN'Pl1mglo\0IhO p2|c g@=_7,iٹoM]go{+'p{f2Q.sg<&GL#8ꠉz q_u=0驪g² $uxts桏)9 Ŀv=uA~ǒ]&M붒qèr{[\!R1X E* PNQE4Q4?ZvdbDž Xbc;ߌ ʵjȫsqCAQ|3fF/O7{ػ퍖vr-=.R@ۙ͑UIaz DUݏ&=a}|ޙ#&{fͭ߻\P5=4z?fm/GYN^#T Ar{wu.- PYX g5N>*(s %-HTu~Zޝ~ a:jwDtsy& 2ßD}TʝGh~`.%8X-Fΰ`mQW?_Z #ƀ-|78;J>[o+jrwkNY2pגhi"F=CSMݠ> J]AZ`h{:isue7SeFը szA\كZ$B:${ZW*4Bo@N;NSv|Y] 4sڎY0?*pVd@$4Uklspj2M9Vaێ];OM}8:# +Ѵ^g;`ԍ;=F|g@;(&o'4Z7?a_oASĘC-DMNڹ.cB21O2<13MS_CPU3wm W%3'EcS=ָץ_9H:B"t%$qAM8^xp Z4rP8EŒɹcH {OMJVwj #qkѹ<T*Ši3iRΞ@uo={^NV*Ye{ƥ9y,(# XzϨh5nK~h]g=+?@^8h &o\GQ@WY;ycZgHlB =Ԭޅ;D򩡝'E#g`UO=[0r5KKQ,#})%v`_u.&%~>|}]n'/qʨXps"32b>~9|?cʔ! ۖ:=OS5cxz.?~QitXo]|_k`c*;s"xDx^'Tm$_|4ZmEhy5^ 4hj-Pv+$:r\0>u l7z"]`OcXJ!>u Q}q+DVw.FdmEKL%d}cCtaF4lS1e3iɁ/^tLeAQgbHC)gSFh6MsuKMOU˸4[W>jp?vYJ-EUtlG<ݸ(V^3ENɵ\FS77E 9`f8@>^̣Kc_?7Vb1SvJrCc-~޸ {@An2U)IY,}mUڋ_g9݆+F} ̡KfOgaH>znqS;Tz\K=p:O-S ڥ )JK+3סKnޯmZLfoCy갽 c^Yd9ję?sӴbjM 5c"ǒ_T"u8FϡCedq?uMGiNYT]Fp RȼS|4'j63<@Tzɍ|rH1JVˣX2>ԍ~flJOɌ3sE/emd oZEA*Z3#;|kg.W~7&5+ eKv'n -jWm z w V==&jw}`pu=c{`[p^g9`$;O<Ѥ־ ʭ;yE9V?[Bo=P:чp`ue9K^ 3ū<9xmWL&'ŵ'3 Q%7!Wגo]hbK3$X&vdhS ܋B| l&/עKO1pz^'1ѵaΜ5DQيSX AxgϥPC.Ui疫_)Qr}~UROA\PZ_I:V?;p|0^Y>e_:}Cɍ0j,QΧ n&:&Ai; hz>ChU7c˂yϴs|Yc'?YW^6*CCuDèc}[>+nOøQ}[/='i|Jg45%4jQgt:j|^d~;CZucûIij` jZO*wM wm_ԥ6?âC[C" ~QQ|nے cOhqz965 ДiFs,VzVv]lP}䄧#x{X*AQz`nHG7魙@*9`OFܗf !ɵO ;%r /_it#1KWN揼 >o4uU~T]*_4,% Zs2DqKFڡW~U8 Oeyz'S ?OYBٻԣVNAYeehJ7۫N38c`Fohmj<W*5/`yBN楿WܗhT_ hz}/r`rֽ=KZjՔ%xQ"zCLLݦԀ .n4_ZΙ NĄQ8V{q[:=y``d|idpr{}ۣ $fx>tug뇁.nh͟ynO n휍ބVQ 0{0=Ȳ\W0|}6/9iQ}Cܲy:ˠR*T{9AՍy226=!.Mk>W23 MtR%ۤ5>H8 \ Oy!%6;nz50Z?:ޑ:Q g!RZ&Xw6XXF^U38ɖzq |_36]Պ|Wu}>CI%s?9}@䤕Ld&"r V")nwOS[c\~MAU-|o C\!U1a"5zk&aT]9|=dQ)L?2OgJmK xנ} ʕ]d6O{<$*JC٩_28(f swuYv~:#,]Eew u/ǟnFw# wԮDc&ÇӋ.E[}-B}R_}Mѣ ƑDshK~ׯ JSr2ne7<3㚗'p ثeOVQ޲ x;|uW {DP=3DW'55{:6m@ds(~8qW`/'nM Du:Ll\=NE}ICRU䅴[!6VvlͷʵVnnBD:s*PÎfId\K+I\d,|^>/m9c(Yު]}why{RKf%fP!}rOnNY{PB[ǝě?G<5 ܽh\ha¯آMA#\10%f@n ]awp}]١ʎc׼~0McTr3IGܭ M@lP@d7E(vMtTEtoۃ@t1MES'qzS0 L/3AK~Ȭ^ ET׶OgBOA4h&s@xz=H<ޠ%TJ'ޢlZ[f#&Z'+;23Wk ^ ,"[ҋ O4/Rv{k,mn',́.;%=le%BQުLY+OI?8  Ag{?',gy|`~GXrS9n0$$?O9l[Z?lBi%u5y6nէxr-HRy?_]`E~Xs&ssg8cy<ҧZo7 ]^<`ԝ%V෿wS*5 hՁϫH?vpcR5]e^DSُ^6((,=+rFkggQ2/ohǡ1rOtjD+0YR _m5/ꪂ”v٫3t|2S]֯)Xˆrn5u^ȹoE-WOE+yuxd~NhAoG7нXdC,;^z5oMJ#j w@[س3"^=J2s:0 Ő {ηY1Nf.Xpia'z0i5U%]~rgT땩!+ ϟs|ۨʍzY 7*j}cLZE`ϟZ ~W'btM ;W͏0ew>pCBd#/9D?{o6.i{jFsEvڶ8:oz`1NQ#k&3_d⾇S'd-w%z8A.dkO7܀jJKASf<m\zpz"hq03'}7"As,6Gۀ'^;ڜ9=!v]';m9ହc$:ܯ=i8ppׁ~:ijR^uʮs% _p'"9w`խɸs]?6<3p,uʳ1r'R~'Xg/Ze/ː ,}tgw⟠is7xEAY2HIuz+ +{c4+D>-n"}">'gO'mR+`sŏD[1EjlqD* 匤!RNszh/C(p (L?wյ-zjMaB1)/ǯ(taqp?g:C?`Ϗ :,p Zh. J*VBT(7JmpMN/jmty~Ro>,T oz6&'LuI[^$D*?1:jwwi. ^$t?C ~՝.1pHMSC+5tO$5P)ܓMtj}1%^FtuyԤ2Npuݟ\`7g?sd>S, :7}Y35S}VX S5ބy7CT98ƮߜDAwo bgQgu? Ѵg{ծb ۥәR_g]͌"S 4Y3~DNǯw(|𿬫'{<wLb!IX'ܼF3΂}}}RneȼqZ i [ZV-S=OykCd2 ~DZSoN`޳!9Z=8?}%QZU5sǃm@-;-}EqG .Ʋڍc_Si&U}헇tͩmj2ycfx-GX&]7]-: d"O]J,gR,LNbvto/>|;8ܼNG.mAdϗl@<07]S.e8-\h-d~HHXv]cflDap_1v9}kߠ~ۍUk Y3K"^Ow2 O%Ld]ˑGz3gcD^rqyUS.&0Vu_<2Ȫ&. n'"Q4=OVI!ԃ֔wr1-AoХ`C4d^ tPT=7ww~ڪSv\U5gFX^|Ahԟ]@/4{з ŴEjPoikg׳ 688yz>k3U4C1cx˕𢡄pV z[t'˺22_} )J!j8tSrM:Tc|ˑ)68l TDKtFKFq]ُ5!D)RhF<{r8bxS!2;?u%aF'7wp/6[t5urNLBy^Yn)ygRnGX8؁/O"L9Jn~ ̎LEѓjU$"<ǢNYm0a}ԗCzM~w>29)o]bR&)Cߊ!H_J_5{f}@K^jzNmc4fT!i F [?6=g_]7 "*WkX/JELӦ{^3mp.A9[66+=c)?t75DGf pKo7,)p6"ʉfw?(.SBm1^g-\6sAW޷$>_/+J,nǟ@WnM1uo_#6yԊ(X@z?ʞػ$AI7^cȴ`ʳ[:qoDGdøwh1d9 FxgĢNM{OI?p0uJ]A 獤/jSlOR!|Ws]Zn';k~hfK JqAl雏k_r35@߾n]{Ϧ~p? sX+ WLwT~S7 + KdsطŸU|V8sc OJ_#j9%JNfj˫^p]?ͺ̧T-jܛ< q緦~-WNSeԁqPF #vف&z4aŏZ~~OW<\51+ӟdCk 70Z5b5lU$egL z؛DQ|T:#sZ[{ݿGƩ "nBB51s4ǷvƸiPh UlEL3?cwv :qx=/P[9D/FZ . sڪEf^S-'Զg  ;n: [%ǁ}-sPD'k8 D@GEP>q>hzc!JŞ2oFp//!dopܽu. A/Ag9! ɛ‚z2`슽^wd d$(R_t"˥*"G( >c+Ezk-^lzCSM.)SC/x$ M?mOiQRP#H+Pз-Ujv(Y^NhvֶN)[A燑<5DzW's/dӍ^DIiEs ǽ1Hzy֘; vz5lܵk|U^It˝2{-@ΥW}+ <ә5 =巚gҙgV60Cen{ٯIF>2w+RVzC.8Aa4./5@WSiJW.3ŋ2W*͠^<,U=KK{DMm+*K0ů}j.n fc3eBk\6D1 WBߧU;ɮlPAzZ}d O}# kyc7>KdWLJpMy~qE2{-QH(~§o 6TҨwcvJ2)S"dxYUpV%CVW^ E}~YMrR6!R3%rC{=ÁFpao-z6 <mZRԓGc=6=I~69_%Oߠgu|u5ЪN֋+]]iDS DWhb h ڹ͟Z2Po7ኊ"?krq;}J0]R-=n~a!z I/(Z7ɩ[Ԁ3i+C3=UCG󗛢SAkҿfX߶'d٥<0 ݆ ǮM,i8z }MДq`N24XIv=gjc0ձ㖮)1_/xPD}#w;}ړW%Ǚ]k"8I s?8߆GƯ\.JYu7"{S .SD҇-4k^{e߮}IΈK6{yuyuBmZdPu~7ZVeLu;3{a ٵ&$+ji{ؑ.?՘hH[oA;n,g&zt B[]hw> VWVP/$eY4y8+$]cg~{gEHݍCG?99Yx`HŦٞ7lv_yCRK[ɥcLc=E sUbG|=\[˿lI(j|c|7@+65=k> n(?KgM`WZ2n>dySݧmx-V%MO(AXrAobu87,(w~ST6uc/z(;l M7(XoBurܱ+ern!ߢpB^FF!/#Q(o7ώB>F|B>F!#Q(ed22W22 yB^F!#Q(QȇȿB=_P(o7 cd22 12 y|"B=_Q(Q(o(ed22 y|"B=_Q(Q(ed22 y|B>Fa"B=_Q(Q(cd7 dd7 "B=_Q?(Q(ed7 yq12 y"B=_Q((cd22 y<""bDDF /d/pQ#m* [l, _$yy93gDlK{ROCR/data/datalist0000644000175100001440000000003712143705053013476 0ustar hornikusersROCR.simple ROCR.xval ROCR.hiv ROCR/data/ROCR.simple.rda0000644000175100001440000000252412145151064014475 0ustar hornikusersWyPu*(" &KiK*6\bA$qȥhfG 0 GGr,Dz ,,R$L2 f~}}{zc0 a"l]yy|=:,2*"TZEP׼y'pKȎk&~_;kd+zy7H6h|+%/>H7L"5U79w |).=u\#' 0mi:NOŊ,9j:ԕ*P'S^{G|yP,^!yIU$z߯doI?j+a^g}8=nNMBJDjJW|E_귥9s'QU}sm7sE#}37x%qD9 #ID:Ϋ"۽hmisvz׳b1_#r[l a3EuX?*cvEZX>$6CzOt rA4Os^$>SsqڳE<4/7ΌyYUM)XY1] !1.΍p/hozZd%)zҊH*%4'u7 5\ԗ=|g~VM*n_SZ'rh^ |ox yukx߯ ]iq9o B h/+GyAqnR\٤ eE#oo^pum5NRbHXU۱q]?Z@m0yH~?<Ojgڀij皸ҩ\P ;aoӹ!4۹iv߃.$d_!}Oe?ͧ.Tey0 R^(}NYM}N"ZX{d>3Lq3ig˫mmuj;sW_h?g뜵mڞqq\o?zf{_= 7 ߅ޛ}9?ɢs$824ZaϏu,Tv蓰G5- 6oVE ROCR/README.unittests0000644000175100001440000000024312143705053013755 0ustar hornikusersYou need the R package 'RUnit' to run the unit tests for ROCR. You can start the test suite by typing: R --vanilla < unittests/runit.ROCR.R from _this_ directory.