pROC/0000755000176200001440000000000014114354132011053 5ustar liggesuserspROC/NAMESPACE0000644000176200001440000000774114114130125012275 0ustar liggesusersexport(are.paired) S3method("are.paired", "auc") S3method("are.paired", "roc") S3method("are.paired", "smooth.roc") export(auc) S3method("auc", "roc") S3method("auc", "smooth.roc") S3method("auc", "formula") S3method("auc", "default") S3method("auc", "multiclass.roc") S3method("auc", "mv.multiclass.roc") export(ci) S3method("ci", "roc") S3method("ci", "smooth.roc") S3method("ci", "default") S3method("ci", "formula") S3method("ci", "auc") S3method("ci", "multiclass.roc") S3method("ci", "multiclass.auc") export(ci.coords) S3method("ci.coords", "roc") S3method("ci.coords", "smooth.roc") S3method("ci.coords", "default") S3method("ci.coords", "formula") export(ci.thresholds) S3method("ci.thresholds", "roc") S3method("ci.thresholds", "smooth.roc") S3method("ci.thresholds", "default") S3method("ci.thresholds", "formula") export(ci.sp) S3method("ci.sp", "roc") S3method("ci.sp", "smooth.roc") S3method("ci.sp", "default") S3method("ci.sp", "formula") export(ci.se) S3method("ci.se", "roc") S3method("ci.se", "smooth.roc") S3method("ci.se", "default") S3method("ci.se", "formula") export(ci.auc) S3method("ci.auc", "roc") S3method("ci.auc", "smooth.roc") S3method("ci.auc", "default") S3method("ci.auc", "formula") S3method("ci.auc", "auc") S3method("ci.auc", "multiclass.roc") S3method("ci.auc", "multiclass.auc") export(coords) S3method("coords", "roc") S3method("coords", "smooth.roc") export(cov) S3method("cov", "roc") S3method("cov", "smooth.roc") S3method("cov", "default") S3method("cov", "auc") export(has.partial.auc) S3method("has.partial.auc", "roc") S3method("has.partial.auc", "smooth.roc") S3method("has.partial.auc", "auc") export(multiclass.roc) S3method("multiclass.roc", "default") S3method("multiclass.roc", "formula") export(power.roc.test) S3method("power.roc.test", "roc") S3method("power.roc.test", "numeric") S3method("power.roc.test", "list") S3method("print", "roc") S3method("print", "smooth.roc") S3method("print", "auc") S3method("print", "ci.auc") S3method("print", "ci.thresholds") S3method("print", "ci.se") S3method("print", "ci.sp") S3method("print", "ci.coords") S3method("print", "multiclass.roc") S3method("print", "multiclass.auc") S3method("print", "mv.multiclass.roc") S3method("print", "mv.multiclass.auc") export(roc) S3method("roc", "default") S3method("roc", "formula") S3method("roc", "data.frame") export(roc_) export(roc.test) S3method("roc.test", "roc") S3method("roc.test", "smooth.roc") S3method("roc.test", "default") S3method("roc.test", "formula") S3method("roc.test", "auc") export(smooth) S3method("smooth", "roc") S3method("smooth", "smooth.roc") S3method("smooth", "default") export(var) S3method("var", "roc") S3method("var", "smooth.roc") S3method("var", "default") S3method("var", "auc") S3method("Ops", "auc") S3method("Ops", "ci.se") S3method("Ops", "ci.sp") S3method("Ops", "ci.auc") S3method("Math", "auc") S3method("Math", "ci.se") S3method("Math", "ci.sp") S3method("Math", "ci.auc") S3method("lines", "roc") S3method("lines", "smooth.roc") export(lines.roc) S3method("lines.roc", "roc") S3method("lines.roc", "smooth.roc") S3method("lines.roc", "formula") S3method("lines.roc", "default") S3method("plot", "roc") S3method("plot", "smooth.roc") S3method("plot", "ci.thresholds") S3method("plot", "ci.sp") S3method("plot", "ci.se") export(plot.roc) S3method("plot.roc", "roc") S3method("plot.roc", "smooth.roc") S3method("plot.roc", "formula") S3method("plot.roc", "default") export(ggroc) S3method("ggroc", "roc") S3method("ggroc", "smooth.roc") S3method("ggroc", "list") #export(select) #export(select_) #importFrom("dplyr", "select") #importFrom("dplyr", "select_") #S3method("select", "roc") #S3method("select_", "roc") # Fix R CMD check warning false positives # "apparent S3 methods exported but not registered" # Note: these methods have an export() above S3method("roc", "test") S3method("ci", "coords") S3method("ci", "se") S3method("ci", "sp") S3method("ci", "thresholds") import(plyr, Rcpp, grDevices, graphics, stats) useDynLib(pROC, .registration = TRUE) pROC/README.md0000644000176200001440000001361614114132412012334 0ustar liggesusers[![Build Status](https://api.travis-ci.com/xrobin/pROC.svg?branch=master)](https://app.travis-ci.com/github/xrobin/pROC) [![AppVeyor build status](https://ci.appveyor.com/api/projects/status/github/xrobin/pROC?branch=master&svg=true)](https://ci.appveyor.com/project/xrobin/pROC) [![Codecov coverage](https://codecov.io/github/xrobin/pROC/branch/master/graphs/badge.svg)](https://codecov.io/github/xrobin/pROC) [![CRAN Version](http://www.r-pkg.org/badges/version/pROC)](https://cran.r-project.org/package=pROC) [![Downloads](http://cranlogs.r-pkg.org/badges/pROC)](https://cran.r-project.org/package=pROC) pROC ============= An [R](https://www.r-project.org/) package to display and analyze ROC curves. For more information, see: 1. Xavier Robin, Natacha Turck, Alexandre Hainard, *et al.* (2011) “pROC: an open-source package for R and S+ to analyze and compare ROC curves”. *BMC Bioinformatics*, **7**, 77. DOI: [10.1186/1471-2105-12-77](http://dx.doi.org/10.1186/1471-2105-12-77) 2. [The official web page on ExPaSy](http://www.expasy.org/tools/pROC/) 3. [The CRAN page](https://cran.r-project.org/package=pROC) 4. [My blog](http://xavier.robin.name/tag/pROC/) 5. [The FAQ](https://github.com/xrobin/pROC/wiki/FAQ---Frequently-asked-questions) Stable ------- The latest stable version is best installed from the CRAN: install.packages("pROC") Getting started ------- If you don't want to read the manual first, try the following: ### Loading ```R library(pROC) data(aSAH) ``` ### Basic ROC / AUC analysis ```R roc(aSAH$outcome, aSAH$s100b) roc(outcome ~ s100b, aSAH) ``` ### Smoothing ```R roc(outcome ~ s100b, aSAH, smooth=TRUE) ``` ### more options, CI and plotting ```R roc1 <- roc(aSAH$outcome, aSAH$s100b, percent=TRUE, # arguments for auc partial.auc=c(100, 90), partial.auc.correct=TRUE, partial.auc.focus="sens", # arguments for ci ci=TRUE, boot.n=100, ci.alpha=0.9, stratified=FALSE, # arguments for plot plot=TRUE, auc.polygon=TRUE, max.auc.polygon=TRUE, grid=TRUE, print.auc=TRUE, show.thres=TRUE) # Add to an existing plot. Beware of 'percent' specification! roc2 <- roc(aSAH$outcome, aSAH$wfns, plot=TRUE, add=TRUE, percent=roc1$percent) ``` ### Coordinates of the curve ```R coords(roc1, "best", ret=c("threshold", "specificity", "1-npv")) coords(roc2, "local maximas", ret=c("threshold", "sens", "spec", "ppv", "npv")) ``` ### Confidence intervals ```R # Of the AUC ci(roc2) # Of the curve sens.ci <- ci.se(roc1, specificities=seq(0, 100, 5)) plot(sens.ci, type="shape", col="lightblue") plot(sens.ci, type="bars") # need to re-add roc2 over the shape plot(roc2, add=TRUE) # CI of thresholds plot(ci.thresholds(roc2)) ``` ### Comparisons ```R # Test on the whole AUC roc.test(roc1, roc2, reuse.auc=FALSE) # Test on a portion of the whole AUC roc.test(roc1, roc2, reuse.auc=FALSE, partial.auc=c(100, 90), partial.auc.focus="se", partial.auc.correct=TRUE) # With modified bootstrap parameters roc.test(roc1, roc2, reuse.auc=FALSE, partial.auc=c(100, 90), partial.auc.correct=TRUE, boot.n=1000, boot.stratified=FALSE) ``` ### Sample size ```R # Two ROC curves power.roc.test(roc1, roc2, reuse.auc=FALSE) power.roc.test(roc1, roc2, power=0.9, reuse.auc=FALSE) # One ROC curve power.roc.test(auc=0.8, ncases=41, ncontrols=72) power.roc.test(auc=0.8, power=0.9) power.roc.test(auc=0.8, ncases=41, ncontrols=72, sig.level=0.01) power.roc.test(ncases=41, ncontrols=72, power=0.9) ``` Getting Help ------------ * Type `?pROC` on the R command line * Make sure you've [read the FAQ](https://github.com/xrobin/pROC/wiki/FAQ---Frequently-asked-questions) * Search for [questions tagged with pROC-R-package on Stack Overflow](https://stackoverflow.com/questions/tagged/proc-r-package?tab=Votes) If you still can't find an answer, you can: * [Ask a question on Stack Overflow with the pROC-r-package tag](https://stackoverflow.com/questions/ask?tags=pROC-r-package) * [Bug reports should be submitted to the GitHub issue tracker](https://github.com/xrobin/pROC/issues) Development ------- ### Installing the development version Download the source code from git, unzip it if necessary, and then type `R CMD INSTALL pROC`. Alternatively, you can use the [devtools](https://github.com/r-lib/devtools/wiki) package by [Hadley Wickham](http://hadley.nz) to automate the process (make sure you follow [the full instructions to get started](https://devtools.r-lib.org/)): ```R if (! requireNamespace("devtools")) install.packages("devtools") devtools::install_github("xrobin/pROC") ``` ### Check To run all automated tests, including slow tests: ``` cd .. # Run from parent directory VERSION=$(grep Version pROC/DESCRIPTION | sed "s/.\+ //") R CMD build pROC RUN_SLOW_TESTS=true R CMD check pROC_$VERSION.tar.gz ``` ### vdiffr The [vdiffr](https://github.com/r-lib/vdiffr) package is used for visual tests of plots. To run all the test cases (incl. slow ones) from the command line: ```R run_slow_tests <- TRUE vdiffr::manage_cases() ``` To run the checks upon R CMD check, set environment variable `NOT_CRAN=1`: ``` NOT_CRAN=1 RUN_SLOW_TESTS=true R CMD check pROC_$VERSION.tar.gz ``` ### Release steps 1. Get new version to release: `VERSION=$(grep Version pROC/DESCRIPTION | sed "s/.\+ //") && echo $VERSION` 1. Build & check package: `R CMD build pROC && R CMD check --as-cran pROC_$VERSION.tar.gz` 1. Check with slow tests: `NOT_CRAN=1 RUN_SLOW_TESTS=true R CMD check pROC_$VERSION.tar.gz` 1. Check with R-devel: `rhub::check_for_cran()` 1. Check reverse dependencies: `revdepcheck::revdep_check(num_workers=8, timeout = as.difftime(60, units = "mins"))` 1. Update `Version` and `Date` in `DESCRIPTION` 1. Update version and date in `NEWS` 1. Create a tag: `git tag v$VERSION && git push --tags` 1. [Submit to CRAN](https://cran.r-project.org/submit.html) pROC/data/0000755000176200001440000000000013607143106011767 5ustar liggesuserspROC/data/aSAH.RData0000644000176200001440000000316313607143106013463 0ustar liggesusers WKlTe3skh&G_2I+u~PP((ioCLB7M&b E"Rh7W9|gr3N:y;toh*P8N pnBIH]q"SiOM4n#Y.\=XM>}>CuK} |^y ]Fx5[s; ZY}ҵyy7`ز\˦`Ou:ϲv|غ\ڵ| Yr~[[WgWE赟C " "gp&%wmZG⓷vXh̹/Gq~NI$s5)>Wu㉋Way'??Я VUW\wL|6PkvpW?{SˋU$٫Ξ!U: toIZV' w֩e%zL!D&L2e-y&L2frDk&L22fbˤI0X&LNG9c&LR:Bj3gH0_{!u{ 6'<@xa#G 4E`Ù9M [}~!M؊r8Ä'OFOv&  /^&Bx, ɺDLЮ _iZ]pROC/man/0000755000176200001440000000000014114130125011620 5ustar liggesuserspROC/man/ci.coords.Rd0000644000176200001440000002074114114130125013776 0ustar liggesusers\encoding{UTF-8} \name{ci.coords} \alias{ci.coords} \alias{ci.coords.default} \alias{ci.coords.formula} \alias{ci.coords.roc} \alias{ci.coords.smooth.roc} \title{ Compute the confidence interval of arbitrary coordinates } \description{ This function computes the confidence interval (CI) of the coordinates of a ROC curves with the \code{\link{coords}} function. By default, the 95\% CI are computed with 2000 stratified bootstrap replicates. } \usage{ # ci.coords(...) \S3method{ci.coords}{roc}(roc, x, input=c("threshold", "specificity", "sensitivity"), ret=c("threshold", "specificity", "sensitivity"), best.method=c("youden", "closest.topleft"), best.weights=c(1, 0.5), best.policy = c("stop", "omit", "random"), conf.level=0.95, boot.n=2000, boot.stratified=TRUE, progress=getOption("pROCProgress")$name, ...) \S3method{ci.coords}{formula}(formula, data, ...) \S3method{ci.coords}{smooth.roc}(smooth.roc, x, input=c("specificity", "sensitivity"), ret=c("specificity", "sensitivity"), best.method=c("youden", "closest.topleft"), best.weights=c(1, 0.5), best.policy = c("stop", "omit", "random"), conf.level=0.95, boot.n=2000, boot.stratified=TRUE, progress=getOption("pROCProgress")$name, ...) \S3method{ci.coords}{default}(response, predictor, ...) } \arguments{ \item{roc, smooth.roc}{a \dQuote{roc} object from the \code{\link{roc}} function, or a \dQuote{smooth.roc} object from the \code{\link[=smooth.roc]{smooth}} function. } \item{response, predictor}{arguments for the \code{\link{roc}} function.} \item{formula, data}{a formula (and possibly a data object) of type response~predictor for the \code{\link{roc}} function. } \item{x, input, ret, best.method, best.weights}{Arguments passed to \code{\link{coords}}. See there for more details. The only difference is on the \code{x} argument which cannot be \dQuote{all} or \dQuote{local maximas}. } \item{best.policy}{The policy follow when multiple \dQuote{best} thresholds are returned by \code{\link{coords}}. \dQuote{stop} will abort the processing with \code{\link{stop}} (default), \dQuote{omit} will ignore the sample (as in \code{\link{NA}}) and \dQuote{random} will select one of the threshold randomly. } \item{conf.level}{the width of the confidence interval as [0,1], never in percent. Default: 0.95, resulting in a 95\% CI. } \item{boot.n}{the number of bootstrap replicates. Default: 2000.} \item{boot.stratified}{should the bootstrap be stratified (default, same number of cases/controls in each replicate than in the original sample) or not. } \item{progress}{the name of progress bar to display. Typically \dQuote{none}, \dQuote{win}, \dQuote{tk} or \dQuote{text} (see the \code{name} argument to \code{\link[plyr]{create_progress_bar}} for more information), but a list as returned by \code{\link[plyr]{create_progress_bar}} is also accepted. See also the \dQuote{Progress bars} section of \link[=pROC-package]{this package's documentation}. } \item{\dots}{further arguments passed to or from other methods, especially arguments for \code{\link{roc}} and \code{ci.coords.roc} when calling \code{ci.coords.default} or \code{ci.coords.formula}. Arguments for \code{\link{txtProgressBar}} (only \code{char} and \code{style}) if applicable. } } \details{ \code{ci.coords.formula} and \code{ci.coords.default} are convenience methods that build the ROC curve (with the \code{\link{roc}} function) before calling \code{ci.coords.roc}. You can pass them arguments for both \code{\link{roc}} and \code{ci.coords.roc}. Simply use \code{ci.coords} that will dispatch to the correct method. This function creates \code{boot.n} bootstrap replicate of the ROC curve, and evaluates the coordinates specified by the \code{x}, \code{input}, \code{ret}, \code{best.method} and \code{best.weights} arguments. Then it computes the confidence interval as the percentiles given by \code{conf.level}. When \code{x="best"}, the best threshold is determined at each bootstrap iteration, effectively assessing the confidence interval of choice of the "best" threshold itself. This differs from the behavior of \code{\link{ci.thresholds}}, where the "best" threshold is assessed on the given ROC curve before resampling. For more details about the bootstrap, see the Bootstrap section in \link[=pROC-package]{this package's documentation}. } \section{Warnings}{ If \code{boot.stratified=FALSE} and the sample has a large imbalance between cases and controls, it could happen that one or more of the replicates contains no case or control observation, producing a \code{NA} area. The warning \dQuote{NA value(s) produced during bootstrap were ignored.} will be issued and the observation will be ignored. If you have a large imbalance in your sample, it could be safer to keep \code{boot.stratified=TRUE}. This warning will also be displayed if you chose \code{best.policy = "omit"} and a ROC curve with multiple \dQuote{best} threshold was generated during at least one of the replicates. } \value{ \bold{Note:} changed in version 1.16. A list of the same length as \code{ret} and named as \code{ret}, and of class \dQuote{ci.thresholds}, \dQuote{ci} and \dQuote{list} (in this order). Each element of the list is a matrix of the confidence intervals with rows given by \code{x} and with 3 columns, the lower bound of the CI, the median, and the upper bound of the CI. Additionally, the list has the following attributes: \item{conf.level}{the width of the CI, in fraction.} \item{boot.n}{the number of bootstrap replicates.} \item{boot.stratified}{whether or not the bootstrapping was stratified.} \item{input}{the input coordinate, as given in argument.} \item{x}{the coordinates used to calculate the CI, as given in argument.} \item{ret}{the return values, as given in argument or substituted by \code{link{coords}}.} \item{roc}{the object of class \dQuote{\link{roc}} that was used to compute the CI. } } \references{ James Carpenter and John Bithell (2000) ``Bootstrap condence intervals: when, which, what? A practical guide for medical statisticians''. \emph{Statistics in Medicine} \bold{19}, 1141--1164. DOI: \doi{10.1002/(SICI)1097-0258(20000515)19:9<1141::AID-SIM479>3.0.CO;2-F}. Tom Fawcett (2006) ``An introduction to ROC analysis''. \emph{Pattern Recognition Letters} \bold{27}, 861--874. DOI: \doi{10.1016/j.patrec.2005.10.010}. Hadley Wickham (2011) ``The Split-Apply-Combine Strategy for Data Analysis''. \emph{Journal of Statistical Software}, \bold{40}, 1--29. URL: \href{https://www.jstatsoft.org/v40/i01}{www.jstatsoft.org/v40/i01}. } \seealso{ \code{\link{roc}}, \code{\link{coords}}, \code{\link{ci}} CRAN package \pkg{plyr}, employed in this function. } \examples{ # Create a ROC curve: data(aSAH) roc1 <- roc(aSAH$outcome, aSAH$s100b) ## Basic example ## \dontrun{ ci.coords(roc1, x="best", input = "threshold", ret=c("specificity", "ppv", "tp")) ## More options ## ci.coords(roc1, x=0.9, input = "sensitivity", ret="specificity") ci.coords(roc1, x=0.9, input = "sensitivity", ret=c("specificity", "ppv", "tp")) ci.coords(roc1, x=c(0.1, 0.5, 0.9), input = "sensitivity", ret="specificity") ci.coords(roc1, x=c(0.1, 0.5, 0.9), input = "sensitivity", ret=c("specificity", "ppv", "tp")) # Return everything we can: rets <- c("threshold", "specificity", "sensitivity", "accuracy", "tn", "tp", "fn", "fp", "npv", "ppv", "1-specificity", "1-sensitivity", "1-accuracy", "1-npv", "1-ppv") ci.coords(roc1, x="best", input = "threshold", ret=rets)}\dontshow{ ci.coords(roc1, x=0.9, input = "sensitivity", ret="specificity", boot.n=10) ci.coords(roc1, x=0.9, input = "sensitivity", ret=c("specificity", "ppv", "tp"), boot.n=10) ci.coords(roc1, x=c(0.1, 0.5, 0.9), input = "sensitivity", ret="specificity", boot.n=10) ci.coords(roc1, x=c(0.1, 0.5, 0.9), input = "sensitivity", ret=c("specificity", "ppv", "tp"), boot.n=10) rets <- c("threshold", "specificity", "sensitivity", "accuracy", "tn", "tp", "fn", "fp", "npv", "ppv", "1-specificity", "1-sensitivity", "1-accuracy", "1-npv", "1-ppv") ci.coords(roc1, x="best", input = "threshold", ret=rets, boot.n=10)} ## On smoothed ROC curves with bootstrap ## \dontrun{ ci.coords(smooth(roc1), x=0.9, input = "sensitivity", ret=c("specificity", "ppv", "tp"))}\dontshow{ ci.coords(smooth(roc1), x=0.9, input = "sensitivity", ret=c("specificity", "ppv", "tp"), boot.n = 10)} } \keyword{univar} \keyword{nonparametric} \keyword{utilities} \keyword{roc} pROC/man/var.Rd0000644000176200001440000002460714114130125012710 0ustar liggesusers\encoding{UTF-8} \name{var.roc} \alias{var} \alias{var.roc} \alias{var.auc} \alias{var.smooth.roc} \alias{var.default} \title{ Variance of a ROC curve } \description{ These functions compute the variance of the AUC of a ROC curve. } \usage{ var(...) \S3method{var}{default}(...) \S3method{var}{auc}(auc, ...) \S3method{var}{roc}(roc, method=c("delong", "bootstrap", "obuchowski"), boot.n = 2000, boot.stratified = TRUE, reuse.auc=TRUE, progress = getOption("pROCProgress")$name, parallel=FALSE, ...) \S3method{var}{smooth.roc}(smooth.roc, ...) } \arguments{ \item{roc, smooth.roc, auc}{a \dQuote{roc} object from the \code{\link{roc}} function, a \dQuote{smooth.roc} object from the \code{\link[=smooth.roc]{smooth}} function or an \dQuote{auc} object from the \code{\link{auc}} function. } \item{method}{the method to use, either \dQuote{delong} or \dQuote{bootstrap}. The first letter is sufficient. If omitted, the appropriate method is selected as explained in details. } \item{reuse.auc}{if \code{TRUE} (default) and the \dQuote{roc} objects contain an \dQuote{auc} field, re-use these specifications for the test. See details. } \item{boot.n}{for \code{method="bootstrap"} only: the number of bootstrap replicates or permutations. Default: \var{2000}. } \item{boot.stratified}{for \code{method="bootstrap"} only: should the bootstrap be stratified (same number of cases/controls in each replicate than in the original sample) or not. Default: \var{TRUE}. } \item{progress}{the name of progress bar to display. Typically \dQuote{none}, \dQuote{win}, \dQuote{tk} or \dQuote{text} (see the \code{name} argument to \code{\link[plyr]{create_progress_bar}} for more information), but a list as returned by \code{\link[plyr]{create_progress_bar}} is also accepted. See also the \dQuote{Progress bars} section of \link[=pROC-package]{this package's documentation}. } \item{parallel}{if TRUE, the bootstrap is processed in parallel, using parallel backend provided by plyr (foreach). } \item{\dots}{further arguments passed to or from other methods, especially arguments for \code{var.roc} when calling \code{var}, \code{var.auc} and \code{var.smooth.roc}. Arguments for \code{\link{auc}} (if \code{reuse.auc=FALSE}) and \code{\link{txtProgressBar}} (only \code{char} and \code{style}) if applicable. } } \details{ The \code{var} function computes the variance of the AUC of a ROC curve. It is typically called with the \link{roc} object of interest. Two methods are available: \dQuote{delong} and \dQuote{bootstrap} (see \dQuote{Computational details} section below). The default is to use \dQuote{delong} method except for with partial AUC and smoothed curves where \dQuote{bootstrap} is employed. Using \dQuote{delong} for partial AUC and smoothed ROCs is not supported. For \link[=smooth.roc]{smoothed ROC curves}, smoothing is performed again at each bootstrap replicate with the parameters originally provided. If a density smoothing was performed with user-provided \code{density.cases} or \code{density.controls} the bootstrap cannot be performed and an error is issued. \code{var.default} forces the usage of the \code{\link[stats:cor]{var}} function in the \pkg{stats} package, so that other code relying on \code{var} should continue to function normally. } \section{AUC specification}{ \code{var} needs a specification of the AUC to compute the variance of the AUC of the ROC curve. The specification is defined by: \enumerate{ \item the \dQuote{auc} field in the \dQuote{\link{roc}} objects if \code{reuse.auc} is set to \code{TRUE} (default) \item passing the specification to \code{\link{auc}} with \dots (arguments \code{partial.auc}, \code{partial.auc.correct} and \code{partial.auc.focus}). In this case, you must ensure either that the \code{\link{roc}} object do not contain an \code{auc} field (if you called \code{\link{roc}} with \code{auc=FALSE}), or set \code{reuse.auc=FALSE}. } If \code{reuse.auc=FALSE} the \code{\link{auc}} function will always be called with \code{\dots} to determine the specification, even if the \dQuote{\link{roc}} objects do contain an \code{auc} field. As well if the \dQuote{\link{roc}} objects do not contain an \code{auc} field, the \code{\link{auc}} function will always be called with \code{\dots} to determine the specification. Warning: if the roc object passed to roc.test contains an \code{auc} field and \code{reuse.auc=TRUE}, \link{auc} is not called and arguments such as \code{partial.auc} are silently ignored. } \section{Computation details}{ With \code{method="bootstrap"}, the processing is done as follow: \enumerate{ \item \code{boot.n} bootstrap replicates are drawn from the data. If \code{boot.stratified} is \var{TRUE}, each replicate contains exactly the same number of controls and cases than the original sample, otherwise if \var{FALSE} the numbers can vary. \item for each bootstrap replicate, the AUC of the ROC curve is computed and stored. \item the variance of the resampled AUCs are computed and returned. } With \code{method="delong"}, the processing is done as described in Hanley and Hajian-Tilaki (1997) using the algorithm by Sun and Xu (2014). With \code{method="obuchowski"}, the processing is done as described in Obuchowski and McClish (1997), Table 1 and Equation 4, p. 1530--1531. The computation of \eqn{g} for partial area under the ROC curve is modified as: \deqn{expr1 * (2 * pi * expr2) ^ {(-1)} * (-expr4) - A * B * expr1 * (2 * pi * expr2^3) ^ {(-1/2)} * expr3}. } \section{Binormality assumption}{ The \dQuote{obuchowski} method makes the assumption that the data is binormal. If the data shows a deviation from this assumption, it might help to normalize the data first (that is, before calling \code{\link{roc}}), for example with quantile normalization: \preformatted{ norm.x <- qnorm(rank(x)/(length(x)+1)) var(roc(response, norm.x, ...), ...) } \dQuote{delong} and \dQuote{bootstrap} methods make no such assumption. } \value{ The numeric value of the variance. } \section{Warnings}{ If \code{method="delong"} and the AUC specification specifies a partial AUC, the warning \dQuote{Using DeLong for partial AUC is not supported. Using bootstrap test instead.} is issued. The \code{method} argument is ignored and \dQuote{bootstrap} is used instead. If \code{method="delong"} and the ROC curve is smoothed, the warning \dQuote{Using DeLong for smoothed ROCs is not supported. Using bootstrap test instead.} is issued. The \code{method} argument is ignored and \dQuote{bootstrap} is used instead. If \code{boot.stratified=FALSE} and the sample has a large imbalance between cases and controls, it could happen that one or more of the replicates contains no case or control observation, or that there are not enough points for smoothing, producing a \code{NA} area. The warning \dQuote{NA value(s) produced during bootstrap were ignored.} will be issued and the observation will be ignored. If you have a large imbalance in your sample, it could be safer to keep \code{boot.stratified=TRUE}. When the ROC curve has an \code{\link{auc}} of 1 (or 100\%), the variance will always be null. This is true for both \dQuote{delong} and \dQuote{bootstrap} methods that can not properly assess the variance in this case. This result is misleading, as the variance is of course not null. A \code{\link{warning}} will be displayed to inform of this condition, and of the misleading output. } \section{Errors}{ If \code{density.cases} and \code{density.controls} were provided for smoothing, the error \dQuote{Cannot compute the covariance on ROC curves smoothed with density.controls and density.cases.} is issued. } \references{ Elisabeth R. DeLong, David M. DeLong and Daniel L. Clarke-Pearson (1988) ``Comparing the areas under two or more correlated receiver operating characteristic curves: a nonparametric approach''. \emph{Biometrics} \bold{44}, 837--845. James A. Hanley and Karim O. Hajian-Tilaki (1997) ``Sampling variability of nonparametric estimates of the areas under receiver operating characteristic curves: An update''. \emph{Academic Radiology} \bold{4}, 49--58. DOI: \doi{10.1016/S1076-6332(97)80161-4}. Nancy A. Obuchowski, Donna K. McClish (1997). ``Sample size determination for diagnostic accurary studies involving binormal ROC curve indices''. \emph{Statistics in Medicine}, \bold{16}(13), 1529--1542. DOI: \doi{10.1002/(SICI)1097-0258(19970715)16:13<1529::AID-SIM565>3.0.CO;2-H}. Xu Sun and Weichao Xu (2014) ``Fast Implementation of DeLongs Algorithm for Comparing the Areas Under Correlated Receiver Operating Characteristic Curves''. \emph{IEEE Signal Processing Letters}, \bold{21}, 1389--1393. DOI: \doi{10.1109/LSP.2014.2337313}. Hadley Wickham (2011) ``The Split-Apply-Combine Strategy for Data Analysis''. \emph{Journal of Statistical Software}, \bold{40}, 1--29. URL: \href{https://www.jstatsoft.org/v40/i01}{www.jstatsoft.org/v40/i01}. } \seealso{ \code{\link{roc}}, \code{\link{cov.roc}} CRAN package \pkg{plyr}, employed in this function. } \examples{ data(aSAH) ## Basic example roc1 <- roc(aSAH$outcome, aSAH$s100b) roc2 <- roc(aSAH$outcome, aSAH$wfns) var(roc1) var(roc2) # We could also write it in one line: var(roc(aSAH$outcome, aSAH$s100b)) \dontrun{ # The latter used Delong. To use bootstrap: var(roc1, method="bootstrap") # Decrease boot.n for a faster execution var(roc1,method="bootstrap", boot.n=1000) } # To use obuchowski: var(roc1, method="obuchowski") \dontrun{ # Variance of smoothed ROCs: # Smoothing is re-done at each iteration, and execution is slow var(smooth(roc1)) } # or from an AUC (no smoothing) var(auc(roc1)) ## Test data from Hanley and Hajian-Tilaki, 1997 disease.present <- c("Yes", "No", "Yes", "No", "No", "Yes", "Yes", "No", "No", "Yes", "No", "No", "Yes", "No", "No") field.strength.1 <- c(1, 2, 5, 1, 1, 1, 2, 1, 2, 2, 1, 1, 5, 1, 1) field.strength.2 <- c(1, 1, 5, 1, 1, 1, 4, 1, 2, 2, 1, 1, 5, 1, 1) roc3 <- roc(disease.present, field.strength.1) roc4 <- roc(disease.present, field.strength.2) # Assess the variance: var(roc3) var(roc4) \dontrun{ # With bootstrap: var(roc3, method="bootstrap") var(roc4, method="bootstrap") } } \keyword{univar} \keyword{nonparametric} \keyword{utilities} \keyword{roc} pROC/man/ci.thresholds.Rd0000644000176200001440000001554614114130125014673 0ustar liggesusers\encoding{UTF-8} \name{ci.thresholds} \alias{ci.thresholds} \alias{ci.thresholds.default} \alias{ci.thresholds.formula} \alias{ci.thresholds.roc} \alias{ci.thresholds.smooth.roc} \title{ Compute the confidence interval of thresholds } \description{ This function computes the confidence interval (CI) of the sensitivity and specificity of the thresholds given in argument. By default, the 95\% CI are computed with 2000 stratified bootstrap replicates. } \usage{ # ci.thresholds(...) \S3method{ci.thresholds}{roc}(roc, conf.level=0.95, boot.n=2000, boot.stratified=TRUE, thresholds = "local maximas", progress=getOption("pROCProgress")$name, parallel=FALSE, ...) \S3method{ci.thresholds}{formula}(formula, data, ...) \S3method{ci.thresholds}{smooth.roc}(smooth.roc, ...) \S3method{ci.thresholds}{default}(response, predictor, ...) } \arguments{ \item{roc}{a \dQuote{roc} object from the \code{\link{roc}} function.} \item{smooth.roc}{not available for \link[=smooth.roc]{smoothed} ROC curves, available only to catch the error and provide a clear error message. } \item{response, predictor}{arguments for the \code{\link{roc}} function.} \item{formula, data}{a formula (and possibly a data object) of type response~predictor for the \code{\link{roc}} function. } \item{conf.level}{the width of the confidence interval as [0,1], never in percent. Default: 0.95, resulting in a 95\% CI. } \item{boot.n}{the number of bootstrap replicates. Default: 2000.} \item{boot.stratified}{should the bootstrap be stratified (default, same number of cases/controls in each replicate than in the original sample) or not. } \item{thresholds}{on which thresholds to evaluate the CI. Either the numeric values of the thresholds, a logical vector (as index of \code{roc$thresholds}) or a character \dQuote{all}, \dQuote{local maximas} or \dQuote{best} that will be used to determine the threshold(s) on the supplied curve with \code{\link{coords}} (not on the resampled curves). } \item{progress}{the name of progress bar to display. Typically \dQuote{none}, \dQuote{win}, \dQuote{tk} or \dQuote{text} (see the \code{name} argument to \code{\link[plyr]{create_progress_bar}} for more information), but a list as returned by \code{\link[plyr]{create_progress_bar}} is also accepted. See also the \dQuote{Progress bars} section of \link[=pROC-package]{this package's documentation}. } \item{parallel}{if TRUE, the bootstrap is processed in parallel, using parallel backend provided by plyr (foreach). } \item{\dots}{further arguments passed to or from other methods, especially arguments for \code{\link{roc}} and \code{ci.thresholds.roc} when calling \code{ci.thresholds.default} or \code{ci.thresholds.formula}. Arguments for \code{\link{txtProgressBar}} (only \code{char} and \code{style}) if applicable. Arguments \code{best.method} and \code{best.weights} to \code{\link{coords}}. } } \details{ \code{ci.thresholds.formula} and \code{ci.thresholds.default} are convenience methods that build the ROC curve (with the \code{\link{roc}} function) before calling \code{ci.thresholds.roc}. You can pass them arguments for both \code{\link{roc}} and \code{ci.thresholds.roc}. Simply use \code{ci.thresholds} that will dispatch to the correct method. This function creates \code{boot.n} bootstrap replicate of the ROC curve, and evaluates the sensitivity and specificity at thresholds given by the \code{thresholds} argument. Then it computes the confidence interval as the percentiles given by \code{conf.level}. A threshold given as a \code{logical} vector or \code{character} is converted to the corresponding numeric vector once \emph{using the supplied ROC curve}, and not at each bootstrap iteration. See \code{\link{ci.coords}} for the latter behaviour. For more details about the bootstrap, see the Bootstrap section in \link[=pROC-package]{this package's documentation}. } \section{Warnings}{ If \code{boot.stratified=FALSE} and the sample has a large imbalance between cases and controls, it could happen that one or more of the replicates contains no case or control observation, producing a \code{NA} area. The warning \dQuote{NA value(s) produced during bootstrap were ignored.} will be issued and the observation will be ignored. If you have a large imbalance in your sample, it could be safer to keep \code{boot.stratified=TRUE}. } \value{ A list of length 2 and class \dQuote{ci.thresholds}, \dQuote{ci} and \dQuote{list} (in this order), with the confidence intervals of the CI and the following items: \item{specificity}{a matrix of CI for the specificity. Row (names) are the thresholds, the first column the lower bound, the 2nd column the median and the 3rd column the upper bound. } \item{sensitivity}{same than specificity.} Additionally, the list has the following attributes: \item{conf.level}{the width of the CI, in fraction.} \item{boot.n}{the number of bootstrap replicates.} \item{boot.stratified}{whether or not the bootstrapping was stratified.} \item{thresholds}{the thresholds, as given in argument.} \item{roc}{the object of class \dQuote{\link{roc}} that was used to compute the CI. } } \references{ James Carpenter and John Bithell (2000) ``Bootstrap condence intervals: when, which, what? A practical guide for medical statisticians''. \emph{Statistics in Medicine} \bold{19}, 1141--1164. DOI: \doi{10.1002/(SICI)1097-0258(20000515)19:9<1141::AID-SIM479>3.0.CO;2-F}. Tom Fawcett (2006) ``An introduction to ROC analysis''. \emph{Pattern Recognition Letters} \bold{27}, 861--874. DOI: \doi{10.1016/j.patrec.2005.10.010}. Xavier Robin, Natacha Turck, Alexandre Hainard, \emph{et al.} (2011) ``pROC: an open-source package for R and S+ to analyze and compare ROC curves''. \emph{BMC Bioinformatics}, \bold{7}, 77. DOI: \doi{10.1186/1471-2105-12-77}. Hadley Wickham (2011) ``The Split-Apply-Combine Strategy for Data Analysis''. \emph{Journal of Statistical Software}, \bold{40}, 1--29. URL: \href{https://www.jstatsoft.org/v40/i01}{www.jstatsoft.org/v40/i01}. } \seealso{ \code{\link{roc}}, \code{\link{ci}} } \examples{ data(aSAH) # Create a ROC curve: data(aSAH) roc1 <- roc(aSAH$outcome, aSAH$s100b) ## Basic example ## # Compute CI of all local maxima thresholds \dontrun{ ci.thresholds(roc1)}\dontshow{ci.thresholds(roc1, boot.n = 10)} ## More options ## # Customized bootstrap and thresholds: \dontrun{ ci.thresholds(roc1, thresholds=c(0.5, 1, 2), boot.n=10000, conf.level=0.9, stratified=FALSE)}\dontshow{ ci.thresholds(roc1, thresholds=c(0.5, 1, 2), boot.n=10, conf.level=0.9, stratified=FALSE)} ## Plotting the CI ## \dontrun{ ci1 <- ci.thresholds(roc1)}\dontshow{ ci1 <- ci.thresholds(roc1, boot.n = 10)} plot(roc1) plot(ci1) } \keyword{univar} \keyword{nonparametric} \keyword{utilities} \keyword{roc} pROC/man/ci.Rd0000644000176200001440000001032014114130125012476 0ustar liggesusers\encoding{UTF-8} \name{ci} \alias{ci} \alias{ci.default} \alias{ci.formula} \alias{ci.roc} \alias{ci.smooth.roc} \alias{ci.multiclass.roc} \alias{ci.multiclass.auc} \title{ Compute the confidence interval of a ROC curve } \description{ This function computes the confidence interval (CI) of a ROC curve. The \code{of} argument controls the type of CI that will be computed. By default, the 95\% CI are computed with 2000 stratified bootstrap replicates. } \usage{ ci(...) \S3method{ci}{roc}(roc, of = c("auc", "thresholds", "sp", "se", "coords"), ...) \S3method{ci}{smooth.roc}(smooth.roc, of = c("auc", "sp", "se", "coords"), ...) \S3method{ci}{multiclass.roc}(multiclass.roc, of = "auc", ...) \S3method{ci}{multiclass.auc}(multiclass.auc, of = "auc", ...) \S3method{ci}{formula}(formula, data, ...) \S3method{ci}{default}(response, predictor, ...) } \arguments{ \item{roc, smooth.roc}{a \dQuote{roc} object from the \code{\link{roc}} function, or a \dQuote{smooth.roc} object from the \code{\link[=smooth.roc]{smooth}} function. } \item{multiclass.roc, multiclass.auc}{not implemented.} \item{response, predictor}{arguments for the \code{\link{roc}} function.} \item{formula, data}{a formula (and possibly a data object) of type response~predictor for the \code{\link{roc}} function. } \item{of}{The type of confidence interval. One of \dQuote{auc}, \dQuote{thresholds}, \dQuote{sp}, \dQuote{se} or \dQuote{coords}. Note that confidence interval on \dQuote{thresholds} are not available for smoothed ROC curves. } \item{\dots}{further arguments passed to or from other methods, especially \code{\link{auc}}, \code{\link{roc}}, and the specific \code{ci} functions \code{\link{ci.auc}}, \code{\link{ci.se}}, \code{\link{ci.sp}} and \code{\link{ci.thresholds}}. } } \details{ \code{ci.formula} and \code{ci.default} are convenience methods that build the ROC curve (with the \code{\link{roc}} function) before calling \code{ci.roc}. You can pass them arguments for both \code{\link{roc}} and \code{ci.roc}. Simply use \code{ci} that will dispatch to the correct method. This function is typically called from \code{\link{roc}} when \code{ci=TRUE} (not by default). Depending on the \code{of} argument, the specific \code{ci} functions \code{\link{ci.auc}}, \code{\link{ci.thresholds}}, \code{\link{ci.sp}}, \code{\link{ci.se}} or \code{\link{ci.coords}} are called. When the ROC curve has an \code{\link{auc}} of 1 (or 100\%), the confidence interval will always be null (there is no interval). This is true for both \dQuote{delong} and \dQuote{bootstrap} methods that can not properly assess the variance in this case. This result is misleading, as the variance is of course not null. A \code{\link{warning}} will be displayed to inform of this condition, and of the misleading output. CI of multiclass ROC curves and AUC is not implemented yet. Attempting to call these methods returns an error. } \value{ The return value of the specific \code{ci} functions \code{\link{ci.auc}}, \code{\link{ci.thresholds}}, \code{\link{ci.sp}}, \code{\link{ci.se}} or \code{\link{ci.coords}}, depending on the \code{of} argument. } \references{ Xavier Robin, Natacha Turck, Alexandre Hainard, \emph{et al.} (2011) ``pROC: an open-source package for R and S+ to analyze and compare ROC curves''. \emph{BMC Bioinformatics}, \bold{7}, 77. DOI: \doi{10.1186/1471-2105-12-77}. } \seealso{ \code{\link{roc}}, \code{\link{auc}}, \code{\link{ci.auc}}, \code{\link{ci.thresholds}}, \code{\link{ci.sp}}, \code{\link{ci.se}}, \code{\link{ci.coords}} } \examples{ # Create a ROC curve: data(aSAH) roc1 <- roc(aSAH$outcome, aSAH$s100b) ## AUC ## ci(roc1) # this is equivalent to: ci(roc1, of = "auc") # or: ci.auc(roc1) ## Coordinates ## \dontrun{ # Thresholds ci(roc1, of = "thresholds") ci(roc1, of = "thresholds", thresholds = "all") ci(roc1, of = "thresholds", thresholds = 0.51) # equivalent to: ci.thresholds(roc1, thresholds = 0.51) # SE/SP ci(roc1, of = "sp", sensitivities = c(.95, .9, .85)) ci.sp(roc1) ci(roc1, of = "se") ci.se(roc1) # Arbitrary coordinates ci(roc1, of = "coords", "best") ci.coords(roc1, 0.51, "threshold")} } \keyword{univar} \keyword{nonparametric} \keyword{utilities} \keyword{roc} pROC/man/smooth.Rd0000644000176200001440000004103614114130125013424 0ustar liggesusers\encoding{UTF-8} \name{smooth} \alias{smooth} \alias{smooth.roc} \alias{smooth.smooth.roc} \alias{smooth.default} \title{ Smooth a ROC curve } \description{ This function smoothes a ROC curve of numeric predictor. By default, a binormal smoothing is performed, but density or custom smoothings are supported. } \usage{ smooth(...) \S3method{smooth}{default}(...) \S3method{smooth}{roc}(roc, method=c("binormal", "density", "fitdistr", "logcondens", "logcondens.smooth"), n=512, bw = "nrd0", density=NULL, density.controls=density, density.cases=density, start=NULL, start.controls=start, start.cases=start, reuse.auc=TRUE, reuse.ci=FALSE, ...) \S3method{smooth}{smooth.roc}(smooth.roc, ...) } \arguments{ \item{roc, smooth.roc}{a \dQuote{roc} object from the \code{\link{roc}} function, or a \dQuote{smooth.roc} object from the \code{\link[=smooth.roc]{smooth}} function. } \item{method}{\dQuote{binormal}, \dQuote{density}, \dQuote{fitdistr}, \dQuote{logcondens}, \dQuote{"logcondens.smooth"}. } \item{n}{ the number of equally spaced points where the smoothed curve will be calculated. } \item{bw}{ if \code{method="density"} and \code{density.controls} and \code{density.cases} are not provided, \code{bw} is passed to \code{\link{density}} to determine the bandwidth of the density Can be a character string (\dQuote{nrd0}, \dQuote{nrd}, \dQuote{ucv}, \dQuote{bcv} or \dQuote{SJ}, but any name \link[base:match.fun]{matching} a function prefixed with \dQuote{bw.} is supported) or a numeric value, as described in \code{\link{density}}. Defaults to \dQuote{\link[stats:bandwidth]{nrd0}}. } \item{density, density.controls, density.cases}{if \code{method="density"}, a numeric value of density (over the y axis) or a function returning a density (such as \code{\link{density}}. If \code{method="fitdistr"}, a \code{densfun} argument for \code{\link[MASS]{fitdistr}}. If the value is different for control and case observations, \code{density.controls} and \code{density.cases} can be employed instead, otherwise \code{density} will be propagated to both \code{density.controls} and \code{density.cases}. } \item{start, start.controls, start.cases}{if \code{method="fitdistr"}, optionnal \code{start} arguments for . \code{start.controls} and \code{start.cases} allows to specify different distributions for controls and cases. } \item{reuse.auc, reuse.ci}{if \code{TRUE} (default for reuse.auc) and the \dQuote{roc} objects contain \dQuote{auc} or \dQuote{ci} fields, re-use these specifications to regenerate \code{\link{auc}} or \code{\link{ci}} on the smoothed ROC curve with the original parameters. If \code{FALSE}, the object returned will not contain \dQuote{auc} or \dQuote{ci} fields. It is currently not possible to redefine \code{\link{auc}} and \code{\link{ci}} options directly: you need to call \code{\link{auc}} or \code{\link{ci}} later for that. } \item{\dots}{further arguments passed to or from other methods, and especially to \code{\link{density}} (only \code{cut}, \code{adjust}, and \code{kernel}, plus \code{window} for compatibility with S+) and \code{\link[MASS]{fitdistr}}. } } \details{ If \code{method="binormal"}, a linear model is fitted to the quantiles of the sensitivities and specificities. Smoothed sensitivities and specificities are then generated from this model on \code{n} points. This simple approach was found to work well for most ROC curves, but it may produce hooked smooths in some situations (see in Hanley (1988)). With \code{method="density"}, the \code{\link{density}} function is employed to generate a smooth kernel density of the control and case observations as described by Zhou \emph{et al.} (1997), unless \code{density.controls} or \code{density.cases} are provided directly. \code{bw} can be given to specify a bandwidth to use with \code{\link{density}}. It can be a numeric value or a character string (\dQuote{nrd0}, \dQuote{nrd}, \dQuote{ucv}, \dQuote{bcv} or \dQuote{SJ}, but any name \link[base:match.fun]{matching} a function prefixed with \dQuote{bw.} is supported). In the case of a character string, the whole predictor data is employed to determine the numeric value to use on both controls and cases. Depending on your data, it might be a good idea to specify the \code{kernel} argument for \code{\link{density}}. By default, \dQuote{gaussian} is used, but \dQuote{epanechnikov}, \dQuote{rectangular}, \dQuote{triangular}, \dQuote{biweight}, \dQuote{cosine} and \dQuote{optcosine} are supported. As all the kernels are symetrical, it might help to normalize the data first (that is, before calling \code{\link{roc}}), for example with quantile normalization: \preformatted{ norm.x <- qnorm(rank(x)/(length(x)+1)) smooth(roc(response, norm.x, ...), ...) } Additionally, \code{density} can be a function which must return either a numeric vector of densities over the y axis or a \link{list} with a \dQuote{y} item like the \code{\link{density}} function. It must accept the following input: \preformatted{ density.fun(x, n, from, to, bw, kernel, ...) } It is important to honour \code{n}, \code{from} and \code{to} in order to have the densities evaluated on the same points for controls and cases. Failing to do so and returning densities of different length will produce an error. It is also a good idea to use a constant smoothing parameter (such as \code{bw}) especially when controls and cases have a different number of observations, to avoid producing smoother or rougher densities. If \code{method="fitdistr"}, the \code{\link[MASS]{fitdistr}} function from the \pkg{MASS} package is employed to fit parameters for the density function \code{density} with optionnal start parameters \code{start}. The density function are fitted separately in control (\code{density.controls}, \code{start.controls}) and case observations (\code{density.cases}, \code{start.cases}). \code{density} can be one of the character values allowed by \code{\link[MASS]{fitdistr}} or a density function (such as \code{\link{dnorm}}, \code{\link{dweibull}}, ...). The \code{method="logcondens"} and \code{method="logcondens.smooth"} use the \pkg{logcondens} package to generate a non smoothed or smoothed (respectively) log-concave density estimate of of the control and case observation with the \link[logcondens]{logConROC} function. \code{smooth.default} forces the usage of the \code{\link[stats]{smooth}} function in the \pkg{stats} package, so that other code relying on \code{smooth} should continue to function normally. Smoothed ROC curves can be passed to smooth again. In this case, the smoothing is not re-applied on the smoothed ROC curve but the original \dQuote{\link{roc}} object will be re-used. Note that a \code{smooth.roc} curve has no threshold. } \value{ A list of class \dQuote{smooth.roc} with the following fields: \item{sensitivities}{the smoothed sensitivities defining the ROC curve.} \item{specificities}{the smoothed specificities defining the ROC curve.} \item{percent}{if the sensitivities, specificities and AUC are reported in percent, as defined in argument. } \item{direction}{the direction of the comparison, as defined in argument.} \item{call}{how the function was called. See \code{\link{match.call}} for more details. } \item{smoothing.args}{a list of the arguments used for the smoothing. Will serve to apply the smoothing again in further bootstrap operations. } \item{auc}{if the original ROC curve contained an AUC, it is computed again on the smoothed ROC. } \item{ci}{if the original ROC curve contained a CI, it is computed again on the smoothed ROC. } \item{fit.controls, fit.cases}{with \code{method="fitdistr"} only: the result of \pkg{MASS}'s \code{\link{fitdistr}} function for controls and cases, with an additional \dQuote{densfun} item indicating the density function, if possible as character. } \item{logcondens}{with \code{method="logcondens"} and \code{method="logcondens.smooth"} only: the result of \pkg{logcondens}'s \link[logcondens]{logConROC} function. } \item{model}{with \code{method="binormal"} only: the linear model from \code{\link{lm}} used to smooth the ROC curve. } \subsection{Attributes}{ Additionally, the original \code{\link{roc}} object is stored as a \dQuote{roc} attribute. } } \section{Errors}{ The message \dQuote{The 'density' function must return a numeric vector or a list with a 'y' item.} will be displayed if the \code{density} function did not return a valid output. The message \dQuote{Length of 'density.controls' and 'density.cases' differ.} will be displayed if the returned value differ in length. Binormal smoothing cannot smooth ROC curve defined by only one point. Any such attempt will fail with the error \dQuote{ROC curve not smoothable (not enough points).}. If the smooth ROC curve was generated by \code{\link{roc}} with \code{density.controls} and \code{density.cases} numeric arguments, it cannot be smoothed and the error \dQuote{Cannot smooth a ROC curve generated directly with numeric 'density.controls' and 'density.cases'.} is produced. \code{fitdistr} and \code{density} smoothing methods require a \link{numeric} \code{predictor}. If the ROC curve to smooth was generated with an ordered factor only binormal smoothing can be applied and the message \dQuote{ROC curves of ordered predictors can be smoothed only with binormal smoothing.} is displayed otherwise. \code{fitdistr}, \code{logcondens} and \code{logcondens.smooth} methods require additional packages. If not available, the following message will be displayed with the required command to install the package: \dQuote{Package ? not available, required with method='?'. Please install it with 'install.packages("?")'. } } \references{ James E. Hanley (1988) ``The robustness of the ``binormal'' assumptions used in fitting ROC curves''. \emph{Medical Decision Making} \bold{8}, 197--203. Lutz Duembgen, Kaspar Rufibach (2011) ``logcondens: Computations Related to Univariate Log-Concave Density Estimation''. \emph{Journal of Statistical Software}, \bold{39}, 1--28. URL: \href{https://www.jstatsoft.org/v39/i06/}{jstatsoft.org/v39/i06}. Xavier Robin, Natacha Turck, Alexandre Hainard, \emph{et al.} (2011) ``pROC: an open-source package for R and S+ to analyze and compare ROC curves''. \emph{BMC Bioinformatics}, \bold{7}, 77. DOI: \doi{10.1186/1471-2105-12-77}. Kaspar Rufibach (2011) ``A Smooth ROC Curve Estimator Based on Log-Concave Density Estimates''. \emph{The International Journal of Biostatistics}, \bold{8}, accepted. DOI: \doi{10.1515/1557-4679.1378}. arXiv: \href{https://arxiv.org/abs/1103.1787}{1103.1787}. William N. Venables, Brian D. Ripley (2002). ``Modern Applied Statistics with S''. New York, Springer. \href{http://books.google.ch/books?id=974c4vKurNkC}{Google books}. Kelly H. Zou, W. J. Hall and David E. Shapiro (1997) ``Smooth non-parametric receiver operating characteristic (ROC) curves for continuous diagnostic tests''. \emph{Statistics in Medicine} \bold{18}, 2143--2156. DOI: \doi{10.1002/(SICI)1097-0258(19971015)16:19<2143::AID-SIM655>3.0.CO;2-3}. } \seealso{ \code{\link{roc}} CRAN packages \pkg{MASS} and \pkg{logcondens} employed in this function. } \examples{ data(aSAH) ## Basic example rocobj <- roc(aSAH$outcome, aSAH$s100b) smooth(rocobj) # or directly with roc() roc(aSAH$outcome, aSAH$s100b, smooth=TRUE) # plotting plot(rocobj) rs <- smooth(rocobj, method="binormal") plot(rs, add=TRUE, col="green") rs2 <- smooth(rocobj, method="density") plot(rs2, add=TRUE, col="blue") rs3 <- smooth(rocobj, method="fitdistr", density="lognormal") plot(rs3, add=TRUE, col="magenta") if (requireNamespace("logcondens")) { rs4 <- smooth(rocobj, method="logcondens") plot(rs4, add=TRUE, col="brown") rs5 <- smooth(rocobj, method="logcondens.smooth") plot(rs5, add=TRUE, col="orange") } legend("bottomright", legend=c("Empirical", "Binormal", "Density", "Log-normal", "Log-concave density", "Smoothed log-concave density"), col=c("black", "green", "blue", "magenta", "brown", "orange"), lwd=2) ## Advanced smoothing # if we know the distributions are normal with sd=0.1 and an unknown mean: smooth(rocobj, method="fitdistr", density=dnorm, start=list(mean=1), sd=.1) # different distibutions for controls and cases: smooth(rocobj, method="fitdistr", density.controls="normal", density.cases="lognormal") # with densities bw <- bw.nrd0(rocobj$predictor) density.controls <- density(rocobj$controls, from=min(rocobj$predictor) - 3 * bw, to=max(rocobj$predictor) + 3*bw, bw=bw, kernel="gaussian") density.cases <- density(rocobj$cases, from=min(rocobj$predictor) - 3 * bw, to=max(rocobj$predictor) + 3*bw, bw=bw, kernel="gaussian") smooth(rocobj, method="density", density.controls=density.controls$y, density.cases=density.cases$y) # which is roughly what is done by a simple: smooth(rocobj, method="density") \dontrun{ ## Smoothing artificial ROC curves rand.unif <- runif(1000, -1, 1) rand.exp <- rexp(1000) rand.norm <- rnorm(1000) # two normals roc.norm <- roc(controls=rnorm(1000), cases=rnorm(1000)+1, plot=TRUE) plot(smooth(roc.norm), col="green", lwd=1, add=TRUE) plot(smooth(roc.norm, method="density"), col="red", lwd=1, add=TRUE) plot(smooth(roc.norm, method="fitdistr"), col="blue", lwd=1, add=TRUE) if (requireNamespace("logcondens")) { plot(smooth(roc.norm, method="logcondens"), col="brown", lwd=1, add=TRUE) plot(smooth(roc.norm, method="logcondens.smooth"), col="orange", lwd=1, add=TRUE) } legend("bottomright", legend=c("empirical", "binormal", "density", "fitdistr", "logcondens", "logcondens.smooth"), col=c(par("fg"), "green", "red", "blue", "brown", "orange"), lwd=c(2, 1, 1, 1)) # deviation from the normality roc.norm.exp <- roc(controls=rnorm(1000), cases=rexp(1000), plot=TRUE) plot(smooth(roc.norm.exp), col="green", lwd=1, add=TRUE) plot(smooth(roc.norm.exp, method="density"), col="red", lwd=1, add=TRUE) # Wrong fitdistr: normality assumed by default plot(smooth(roc.norm.exp, method="fitdistr"), col="blue", lwd=1, add=TRUE) # Correct fitdistr plot(smooth(roc.norm.exp, method="fitdistr", density.controls="normal", density.cases="exponential"), col="purple", lwd=1, add=TRUE) if (requireNamespace("logcondens")) { plot(smooth(roc.norm.exp, method="logcondens"), col="brown", lwd=1, add=TRUE) plot(smooth(roc.norm.exp, method="logcondens.smooth"), col="orange", lwd=1, add=TRUE) } legend("bottomright", legend=c("empirical", "binormal", "density", "wrong fitdistr", "correct fitdistr", "logcondens", "logcondens.smooth"), col=c(par("fg"), "green", "red", "blue", "purple", "brown", "orange"), lwd=c(2, 1, 1, 1, 1)) # large deviation from the normality roc.unif.exp <- roc(controls=runif(1000, 2, 3), cases=rexp(1000)+2, plot=TRUE) plot(smooth(roc.unif.exp), col="green", lwd=1, add=TRUE) plot(smooth(roc.unif.exp, method="density"), col="red", lwd=1, add=TRUE) plot(smooth(roc.unif.exp, method="density", bw="ucv"), col="magenta", lwd=1, add=TRUE) # Wrong fitdistr: normality assumed by default (uniform distributions not handled) plot(smooth(roc.unif.exp, method="fitdistr"), col="blue", lwd=1, add=TRUE) if (requireNamespace("logcondens")) { plot(smooth(roc.unif.exp, method="logcondens"), col="brown", lwd=1, add=TRUE) plot(smooth(roc.unif.exp, method="logcondens.smooth"), col="orange", lwd=1, add=TRUE) } legend("bottomright", legend=c("empirical", "binormal", "density", "density ucv", "wrong fitdistr", "logcondens", "logcondens.smooth"), col=c(par("fg"), "green", "red", "magenta", "blue", "brown", "orange"), lwd=c(2, 1, 1, 1, 1)) } # 2 uniform distributions with a custom density function unif.density <- function(x, n, from, to, bw, kernel, ...) { smooth.x <- seq(from=from, to=to, length.out=n) smooth.y <- dunif(smooth.x, min=min(x), max=max(x)) return(smooth.y) } roc.unif <- roc(controls=runif(1000, -1, 1), cases=runif(1000, 0, 2), plot=TRUE) s <- smooth(roc.unif, method="density", density=unif.density) plot(roc.unif) plot(s, add=TRUE, col="grey") \dontrun{ # you can bootstrap a ROC curve smoothed with a density function: ci(s, boot.n=100) } } \keyword{univar} \keyword{nonparametric} \keyword{utilities} \keyword{roc} \keyword{smooth} pROC/man/multiclass.Rd0000644000176200001440000001516214114130125014274 0ustar liggesusers\encoding{UTF-8} \name{multiclass.roc} \alias{multiclass.roc} \alias{multiclass.roc.default} \alias{multiclass.roc.formula} \title{ Multi-class AUC } \description{ This function builds builds multiple ROC curve to compute the multi-class AUC as defined by Hand and Till. } \usage{ multiclass.roc(...) \S3method{multiclass.roc}{formula}(formula, data, ...) \S3method{multiclass.roc}{default}(response, predictor, levels=base::levels(as.factor(response)), percent=FALSE, direction = c("auto", "<", ">"), ...) } \arguments{ \item{response}{a factor, numeric or character vector of responses (true class), typically encoded with 0 (controls) and 1 (cases), as in \code{\link{roc}}. } \item{predictor}{either a numeric vector, containing the value of each observation, as in \code{\link{roc}}, or, a matrix giving the decision value (e.g. probability) for each class. } \item{formula}{a formula of the type \code{response~predictor}.} \item{data}{a matrix or data.frame containing the variables in the formula. See \code{\link{model.frame}} for more details.} \item{levels}{the value of the response for controls and cases respectively. In contrast with \code{levels} argument to \code{\link{roc}}, all the levels are used and \link[=combn]{combined} to compute the multiclass AUC. } \item{percent}{if the sensitivities, specificities and AUC must be given in percent (\code{TRUE}) or in fraction (\code{FALSE}, default). } \item{direction}{in which direction to make the comparison? \dQuote{auto} (default for univariate curves): automatically define in which group the median is higher and take the direction accordingly. Not available for multivariate curves. \dQuote{>} (default for multivariate curves): if the predictor values for the control group are higher than the values of the case group (controls > t >= cases). \dQuote{<}: if the predictor values for the control group are lower or equal than the values of the case group (controls < t <= cases). } \item{...}{further arguments passed to \code{\link{roc}}. } } \details{ This function performs multiclass AUC as defined by Hand and Till (2001). A multiclass AUC is a mean of several \code{\link{auc}} and cannot be plotted. Only AUCs can be computed for such curves. Confidence intervals, standard deviation, smoothing and comparison tests are not implemented. The \code{multiclass.roc} function can handle two types of datasets: uni- and multi-variate. In the univariate case, a single \code{predictor} vector is passed and all the combinations of responses are assessed. I the multivariate case, a \code{\link{matrix}} or \code{\link{data.frame}} is passed as \code{predictor}. The columns must be named according to the levels of the \code{response}. This function has been much less tested than the rest of the package and is more subject to bugs. Please report them if you find one. } \value{ If \code{predictor} is a vector, a list of class \dQuote{multiclass.roc} (univariate) or \dQuote{mv.multiclass.roc} (multivariate), with the following fields: \item{auc}{if called with \code{auc=TRUE}, a numeric of class \dQuote{auc} as defined in \code{\link{auc}}. Note that this is not the standard AUC but the multi-class AUC as defined by Hand and Till. } \item{ci}{if called with \code{ci=TRUE}, a numeric of class \dQuote{ci} as defined in \code{\link{ci}}. } \item{response}{the response vector as passed in argument. If \code{NA} values were removed, a \code{na.action} attribute similar to \code{\link{na.omit}} stores the row numbers. } \item{predictor}{the predictor vector as passed in argument. If \code{NA} values were removed, a \code{na.action} attribute similar to \code{\link{na.omit}} stores the row numbers. } \item{levels}{the levels of the response as defined in argument.} \item{percent}{if the sensitivities, specificities and AUC are reported in percent, as defined in argument. } \item{call}{how the function was called. See \code{\link{match.call}} for more details. } } \section{Warnings}{ If \code{response} is an ordered factor and one of the levels specified in \code{levels} is missing, a warning is issued and the level is ignored. } \references{ David J. Hand and Robert J. Till (2001). A Simple Generalisation of the Area Under the ROC Curve for Multiple Class Classification Problems. \emph{Machine Learning} \bold{45}(2), p. 171--186. DOI: \doi{10.1023/A:1010920819831}. } \seealso{ \code{\link{auc}} } \examples{ #### # Examples for a univariate decision value #### data(aSAH) # Basic example multiclass.roc(aSAH$gos6, aSAH$s100b) # Produces an innocuous warning because one level has no observation # Select only 3 of the aSAH$gos6 levels: multiclass.roc(aSAH$gos6, aSAH$s100b, levels=c(3, 4, 5)) # Give the result in percent multiclass.roc(aSAH$gos6, aSAH$s100b, percent=TRUE) #### # Examples for multivariate decision values (e.g. class probabilities) #### \dontrun{ # Example with a multinomial log-linear model from nnet # We use the iris dataset and split into a training and test set requireNamespace("nnet") data(iris) iris.sample <- sample(1:150) iris.train <- iris[iris.sample[1:75],] iris.test <- iris[iris.sample[76:150],] mn.net <- nnet::multinom(Species ~ ., iris.train) # Use predict with type="prob" to get class probabilities iris.predictions <- predict(mn.net, newdata=iris.test, type="prob") head(iris.predictions) # This can be used directly in multiclass.roc: multiclass.roc(iris.test$Species, iris.predictions) } # Let's see an other example with an artificial dataset n <- c(100, 80, 150) responses <- factor(c(rep("X1", n[1]), rep("X2", n[2]), rep("X3", n[3]))) # construct prediction matrix: one column per class preds <- lapply(n, function(x) runif(x, 0.4, 0.6)) predictor <- as.matrix(data.frame( "X1" = c(preds[[1]], runif(n[2] + n[3], 0, 0.7)), "X2" = c(runif(n[1], 0.1, 0.4), preds[[2]], runif(n[3], 0.2, 0.8)), "X3" = c(runif(n[1] + n[2], 0.3, 0.7), preds[[3]]) )) multiclass.roc(responses, predictor) # One can change direction , partial.auc, percent, etc: multiclass.roc(responses, predictor, direction = ">") multiclass.roc(responses, predictor, percent = TRUE, partial.auc = c(100, 90), partial.auc.focus = "se") # Limit set of levels multiclass.roc(responses, predictor, levels = c("X1", "X2")) # Use with formula. Here we need a data.frame to store the responses as characters data <- cbind(as.data.frame(predictor), "response" = responses) multiclass.roc(response ~ X1+X3, data) } \keyword{univar} \keyword{nonparametric} \keyword{utilities} \keyword{roc} pROC/man/coords.Rd0000644000176200001440000003424514114130125013410 0ustar liggesusers\encoding{UTF-8} \name{coords} \alias{coords} \alias{coords.roc} \alias{coords.smooth.roc} \title{ Coordinates of a ROC curve } \description{ This function returns the coordinates of the ROC curve at the specified point. } \usage{ coords(...) \S3method{coords}{roc}(roc, x, input="threshold", ret=c("threshold", "specificity", "sensitivity"), as.list=FALSE, drop=TRUE, best.method=c("youden", "closest.topleft"), best.weights=c(1, 0.5), transpose = FALSE, as.matrix=FALSE, ...) \S3method{coords}{smooth.roc}(smooth.roc, x, input, ret=c("specificity", "sensitivity"), as.list=FALSE, drop=TRUE, best.method=c("youden", "closest.topleft"), best.weights=c(1, 0.5), transpose = FALSE, as.matrix=FALSE, ...) } \arguments{ \item{roc, smooth.roc}{a \dQuote{roc} object from the \code{\link{roc}} function, or a \dQuote{smooth.roc} object from the \code{\link[=smooth.roc]{smooth}} function. } \item{x}{ the coordinates to look for. Numeric (if so, their meaning is defined by the \code{input} argument) or one of \dQuote{all} (all the points of the ROC curve), \dQuote{local maximas} (the local maximas of the ROC curve) or \dQuote{best} (see \code{best.method} argument). If missing or \code{NULL}, defaults to \dQuote{all}. } \item{input}{ If \code{x} is numeric, the kind of input coordinate (x). Typically one of \dQuote{threshold}, \dQuote{specificity} or \dQuote{sensitivity}, but can be any of the monotone coordinate available, see the \dQuote{Valid input} column under \dQuote{Available coordinates}. Can be shortened like \code{ret}. Defaults to \dQuote{threshold}. Note that \dQuote{threshold} is not allowed in \code{coords.smooth.roc} and that the argument is ignored when \code{x} is a character. } \item{ret}{The coordinates to return. See \dQuote{Available coordinates} section below. Alternatively, the single value \dQuote{all} can be used to return every coordinate available. } \item{as.list}{DEPRECATED. If the returned object must be a list. Will be removed in a future version. } \item{drop}{If \code{TRUE} the result is coerced to the lowest possible dimension, as per \link{Extract}. By default only drops if \code{transpose = TRUE} and either \code{ret} or \code{x} is of length 1. } \item{best.method}{if \code{x="best"}, the method to determine the best threshold. See details in the \sQuote{Best thresholds} section. } \item{best.weights}{if \code{x="best"}, the weights to determine the best threshold. See details in the \sQuote{Best thresholds} section. } \item{transpose}{whether to return the thresholds in columns (\code{TRUE}) or rows (\code{FALSE}). Since pROC 1.16 the default value is \code{FALSE}. See \link{coords_transpose} for more details the change. } \item{as.matrix}{if \code{transpose} is \code{FALSE}, whether to return a \code{\link{matrix}} (\code{TRUE}) or a \code{\link{data.frame}} (\code{FALSE}, the default). A \code{data.frame} is more convenient and flexible to use, but incurs a slight speed penalty. Consider setting this argument to \code{TRUE} if you are calling the function repeatedly. } \item{\dots}{further arguments passed from other methods. Ignored.} } \details{ This function takes a \dQuote{roc} or \dQuote{smooth.roc} object as first argument, on which the coordinates will be determined. The coordinates are defined by the \code{x} and \code{input} arguments. \dQuote{threshold} coordinates cannot be determined in a smoothed ROC. If \code{input="threshold"}, the coordinates for the threshold are reported, even if the exact threshold do not define the ROC curve. The following convenience characters are allowed: \dQuote{all}, \dQuote{local maximas} and \dQuote{best}. They will return all the thresholds, only the thresholds defining local maximas (upper angles of the ROC curve), or only the threshold(s) corresponding to the best sum of sensitivity + specificity respectively. Note that \dQuote{best} can return more than one threshold. If \code{x} is a character, the coordinates are limited to the thresholds within the partial AUC if it has been defined, and not necessarily to the whole curve. For \code{input="specificity"} and \code{input="sensitivity"}, the function checks if the specificity or sensitivity is one of the points of the ROC curve (in \code{roc$sensitivities} or \code{roc$specificities}). More than one point may match (in \emph{step} curves), then only the upper-left-most point coordinates are returned. Otherwise, the specificity and specificity of the point is interpolated and \code{NA} is returned as threshold. The coords function in this package is a generic, but it might be superseded by functions in other packages such as \pkg{colorspace} or \pkg{spatstat} if they are loaded after \pkg{pROC}. In this case, call the \code{pROC::coords} explicitly. \subsection{Best thresholds}{ If \code{x="best"}, the \code{best.method} argument controls how the optimal threshold is determined. \describe{ \item{\dQuote{youden}}{ Youden's J statistic (Youden, 1950) is employed. The optimal cut-off is the threshold that maximizes the distance to the identity (diagonal) line. Can be shortened to \dQuote{y}. The optimality criterion is: \deqn{max(sensitivities + specificities)}{max(sensitivities + specificities)} } \item{\dQuote{closest.topleft}}{ The optimal threshold is the point closest to the top-left part of the plot with perfect sensitivity or specificity. Can be shortened to \dQuote{c} or \dQuote{t}. The optimality criterion is: \deqn{min((1 - sensitivities)^2 + (1- specificities)^2)}{min((1 - sensitivities)^2 + (1- specificities)^2)} } } In addition, weights can be supplied if false positive and false negative predictions are not equivalent: a numeric vector of length 2 to the \code{best.weights} argument. The elements define \enumerate{ \item the relative cost of of a false negative classification (as compared with a false positive classification) \item the prevalence, or the proportion of cases in the population (\eqn{\frac{n_{cases}}{n_{controls}+n_{cases}}}{n.cases/(n.controls+n.cases)}). } The optimality criteria are modified as proposed by Perkins and Schisterman: \describe{ \item{\dQuote{youden}}{ \deqn{max(sensitivities + r * specificities)}{max(sensitivities + r \times specificities)} } \item{\dQuote{closest.topleft}}{ \deqn{min((1 - sensitivities)^2 + r * (1- specificities)^2)}{min((1 - sensitivities)^2 + r \times (1- specificities)^2)} } } with \deqn{r = \frac{1 - prevalence}{cost * prevalence}}{r = (1 - prevalence) / (cost * prevalence)} By default, prevalence is 0.5 and cost is 1 so that no weight is applied in effect. Note that several thresholds might be equally optimal. } \subsection{Available coordinates}{ The following table lists the coordinates that are available in the \code{ret} and \code{input} arguments. \tabular{rllll}{ Value \tab Description \tab Formula \tab Synonyms \tab Valid input \cr \code{threshold} \tab The threshold value \tab - \tab - \tab Yes \cr \code{tn} \tab True negative count \tab - \tab - \tab Yes \cr \code{tp} \tab True positive count \tab - \tab - \tab Yes \cr \code{fn} \tab False negative count \tab - \tab - \tab Yes \cr \code{fp} \tab False positive count \tab - \tab - \tab Yes \cr \code{specificity} \tab Specificity \tab tn / (tn + fp) \tab tnr \tab Yes \cr \code{sensitivity} \tab Sensitivity \tab tp / (tp + fn) \tab recall, tpr \tab Yes \cr \code{accuracy} \tab Accuracy \tab (tp + tn) / N \tab - \tab No \cr \code{npv} \tab Negative Predictive Value \tab tn / (tn + fn) \tab - \tab No \cr \code{ppv} \tab Positive Predictive Value \tab tp / (tp + fp) \tab precision \tab No \cr \code{precision} \tab Precision \tab tp / (tp + fp) \tab ppv \tab No \cr \code{recall} \tab Recall \tab tp / (tp + fn) \tab sensitivity, tpr \tab Yes \cr \code{tpr} \tab True Positive Rate \tab tp / (tp + fn) \tab sensitivity, recall \tab Yes \cr \code{fpr} \tab False Positive Rate \tab fp / (tn + fp) \tab 1-specificity \tab Yes \cr \code{tnr} \tab True Negative Rate \tab tn / (tn + fp) \tab specificity \tab Yes \cr \code{fnr} \tab False Negative Rate \tab fn / (tp + fn) \tab 1-sensitivity \tab Yes \cr \code{fdr} \tab False Discovery Rate \tab fp / (tp + fp) \tab 1-ppv \tab No \cr \code{youden} \tab Youden Index \tab se + r * sp \tab - \tab No \cr \code{closest.topleft} \tab Distance to the top left corner of the ROC space \tab - ((1 - se)^2 + r * (1 - sp)^2) \tab - \tab No \cr } The value \dQuote{threshold} is not allowed in \code{coords.smooth.roc}. Values can be shortenend (for example to \dQuote{thr}, \dQuote{sens} and \dQuote{spec}, or even to \dQuote{se}, \dQuote{sp} or \dQuote{1-np}). In addition, some values can be prefixed with \code{1-} to get their complement: \code{1-specificity}, \code{1-sensitivity}, \code{1-accuracy}, \code{1-npv}, \code{1-ppv}. The values \code{npe} and \code{ppe} are automatically replaced with \code{1-npv} and \code{1-ppv}, respectively (and will therefore not appear as is in the output, but as \code{1-npv} and \code{1-ppv} instead). These must be used verbatim in ROC curves with \code{percent=TRUE} (ie. \dQuote{100-ppv} is never accepted). The \dQuote{youden} and \dQuote{closest.topleft} are weighted with \code{r}, according to the value of the \code{best.weights} argument. See the \dQuote{Best thresholds} section above for more details. For \code{ret}, the single value \dQuote{all} can be used to return every coordinate available. } } % details \value{ Depending on the length of \code{x} and \code{as.list} argument. \tabular{lll}{ \tab length(x) == 1 or length(ret) == 1 \tab length(x) > 1 or length(ret) > 1 or drop == FALSE \cr \code{as.list=TRUE} \tab a list of the length of, in the order of, and named after, \code{ret}. \tab a list of the length of, and named after, \code{x}. Each element of this list is a list of the length of, in the order of, and named after, \code{ret}. \cr \code{as.list=FALSE} \tab a numeric vector of the length of, in the order of, and named after, \code{ret} (if \code{length(x) == 1}) or a numeric vector of the length of, in the order of, and named after, \code{x} (if \code{length(ret) == 1}.\tab a numeric matrix with one row for each \code{ret} and one column for each \code{x}\cr } In all cases if \code{input="specificity"} or \code{input="sensitivity"} and interpolation was required, threshold is returned as \code{NA}. Note that if giving a character as \code{x} (\dQuote{all}, \dQuote{local maximas} or \dQuote{best}), you cannot predict the dimension of the return value unless \code{drop=FALSE}. Even \dQuote{best} may return more than one value (for example if the ROC curve is below the identity line, both extreme points). \code{coords} may also return \code{NULL} when there a partial area is defined but no point of the ROC curve falls within the region. } \references{ Neil J. Perkins, Enrique F. Schisterman (2006) ``The Inconsistency of "Optimal" Cutpoints Obtained using Two Criteria based on the Receiver Operating Characteristic Curve''. \emph{American Journal of Epidemiology} \bold{163}(7), 670--675. DOI: \doi{10.1093/aje/kwj063}. Xavier Robin, Natacha Turck, Alexandre Hainard, \emph{et al.} (2011) ``pROC: an open-source package for R and S+ to analyze and compare ROC curves''. \emph{BMC Bioinformatics}, \bold{7}, 77. DOI: \doi{10.1186/1471-2105-12-77}. W. J. Youden (1950) ``Index for rating diagnostic tests''. \emph{Cancer}, \bold{3}, 32--35. DOI: \doi{10.1002/1097-0142(1950)3:1<32::AID-CNCR2820030106>3.0.CO;2-3}. } \seealso{ \code{\link{roc}}, \code{\link{ci.coords}} } \examples{ # Create a ROC curve: data(aSAH) roc.s100b <- roc(aSAH$outcome, aSAH$s100b, percent = TRUE) # Get the coordinates of S100B threshold 0.55 coords(roc.s100b, 0.55, transpose = FALSE) # Get the coordinates at 50\% sensitivity coords(roc=roc.s100b, x=50, input="sensitivity", transpose = FALSE) # Can be abbreviated: coords(roc.s100b, 50, "se", transpose = FALSE) # Works with smoothed ROC curves coords(smooth(roc.s100b), 90, "specificity", transpose = FALSE) # Get the sensitivities for all thresholds cc <- coords(roc.s100b, "all", ret="sensitivity", transpose = FALSE) print(cc$sensitivity) # Get the best threshold coords(roc.s100b, "best", ret="threshold", transpose = FALSE) # Get the best threshold according to different methods roc.ndka <- roc(aSAH$outcome, aSAH$ndka, percent=TRUE) coords(roc.ndka, "best", ret="threshold", transpose = FALSE, best.method="youden") # default coords(roc.ndka, "best", ret="threshold", transpose = FALSE, best.method="closest.topleft") # and with different weights coords(roc.ndka, "best", ret="threshold", transpose = FALSE, best.method="youden", best.weights=c(50, 0.2)) coords(roc.ndka, "best", ret="threshold", transpose = FALSE, best.method="closest.topleft", best.weights=c(5, 0.2)) # This is available with the plot.roc function too: plot(roc.ndka, print.thres="best", print.thres.best.method="youden", print.thres.best.weights=c(50, 0.2)) # Return more values: coords(roc.s100b, "best", ret=c("threshold", "specificity", "sensitivity", "accuracy", "precision", "recall"), transpose = FALSE) # Return all values coords(roc.s100b, "best", ret = "all", transpose = FALSE) # You can use coords to plot for instance a sensitivity + specificity vs. cut-off diagram plot(specificity + sensitivity ~ threshold, coords(roc.ndka, "all", transpose = FALSE), type = "l", log="x", subset = is.finite(threshold)) # Plot the Precision-Recall curve plot(precision ~ recall, coords(roc.ndka, "all", ret = c("recall", "precision"), transpose = FALSE), type="l", ylim = c(0, 100)) # Alternatively plot the curve with TPR and FPR instead of SE/SP # (identical curve, only the axis change) plot(tpr ~ fpr, coords(roc.ndka, "all", ret = c("tpr", "fpr"), transpose = FALSE), type="l") } \keyword{univar} \keyword{nonparametric} \keyword{utilities} \keyword{roc} pROC/man/power.roc.test.Rd0000644000176200001440000002620114114130125015004 0ustar liggesusers\encoding{UTF-8} \name{power.roc.test} \alias{power.roc.test} \alias{power.roc.test.numeric} \alias{power.roc.test.roc} \alias{power.roc.test.list} \title{ Sample size and power computation for ROC curves } \description{ Computes sample size, power, significance level or minimum AUC for ROC curves. } \usage{ power.roc.test(...) # One or Two ROC curves test with roc objects: \S3method{power.roc.test}{roc}(roc1, roc2, sig.level = 0.05, power = NULL, kappa = NULL, alternative = c("two.sided", "one.sided"), reuse.auc=TRUE, method = c("delong", "bootstrap", "obuchowski"), ...) # One ROC curve with a given AUC: \S3method{power.roc.test}{numeric}(auc = NULL, ncontrols = NULL, ncases = NULL, sig.level = 0.05, power = NULL, kappa = 1, alternative = c("two.sided", "one.sided"), ...) # Two ROC curves with the given parameters: \S3method{power.roc.test}{list}(parslist, ncontrols = NULL, ncases = NULL, sig.level = 0.05, power = NULL, kappa = 1, alternative = c("two.sided", "one.sided"), ...) } \arguments{ \item{roc1, roc2}{one or two \dQuote{roc} object from the \code{\link{roc}} function. } \item{auc}{ expected AUC. } \item{parslist}{ a \code{\link{list}} of parameters for the two ROC curves test with Obuchowski variance when no empirical ROC curve is known: \describe{ \item{A1}{binormal A parameter for ROC curve 1} \item{B1}{binormal B parameter for ROC curve 1} \item{A2}{binormal A parameter for ROC curve 2} \item{B2}{binormal B parameter for ROC curve 2} \item{rn}{correlation between the variables in control patients} \item{ra}{correlation between the variables in case patients} \item{delta}{the difference of AUC between the two ROC curves} } For a partial AUC, the following additional parameters must be set: \describe{ \item{FPR11}{Upper bound of FPR (1 - specificity) of ROC curve 1} \item{FPR12}{Lower bound of FPR (1 - specificity) of ROC curve 1} \item{FPR21}{Upper bound of FPR (1 - specificity) of ROC curve 2} \item{FPR22}{Lower bound of FPR (1 - specificity) of ROC curve 2} } } \item{ncontrols, ncases}{ number of controls and case observations available. } \item{sig.level}{expected significance level (probability of type I error). } \item{power}{expected power of the test (1 - probability of type II error). } \item{kappa}{ expected balance between control and case observations. Must be positive. Only for sample size determination, that is to determine \code{ncontrols} and \code{ncases}. } \item{alternative}{whether a one or two-sided test is performed.} \item{reuse.auc}{if \code{TRUE} (default) and the \dQuote{roc} objects contain an \dQuote{auc} field, re-use these specifications for the test. See the \emph{AUC specification} section for more details. } \item{method}{the method to compute \link[=var.roc]{variance} and \link[=cov.roc]{covariance}, either \dQuote{delong}, \dQuote{bootstrap} or \dQuote{obuchowski}. The first letter is sufficient. Only for Two ROC curves power calculation. See \code{\link{var}} and \code{\link{cov}} documentations for more details. } \item{\dots}{further arguments passed to or from other methods, especially \code{\link{auc}} (with \code{reuse.auc=FALSE} or no AUC in the ROC curve), \code{\link{cov}} and \code{\link{var}} (especially arguments \code{method}, \code{boot.n} and \code{boot.stratified}). Ignored (with a warning) with a \code{parslist}. } } \section{One ROC curve power calculation}{ If one or no ROC curves are passed to \code{power.roc.test}, a one ROC curve power calculation is performed. The function expects either \code{power}, \code{sig.level} or \code{auc}, or both \code{ncontrols} and \code{ncases} to be missing, so that the parameter is determined from the others with the formula by Obuchowski \emph{et al.}, 2004 (formulas 2 and 3, p. 1123). For the sample size, \code{ncases} is computed directly from formulas 2 and 3 and ncontrols is deduced with \code{kappa} (defaults to the ratio of controls to cases). AUC is optimized by \code{\link{uniroot}} while \code{sig.level} and \code{power} are solved as quadratic equations. \code{power.roc.test} can also be passed a \code{roc} object from the \code{\link{roc}} function, but the empirical ROC will not be used, only the number of patients and the AUC. } \section{Two paired ROC curves power calculation}{ If two ROC curves are passed to \code{power.roc.test}, the function will compute either the required sample size (if \code{power} is supplied), the significance level (if \code{sig.level=NULL} and \code{power} is supplied) or the power of a test of a difference between to AUCs according to the formula by Obuchowski and McClish, 1997 (formulas 2 and 3, p. 1530--1531). The null hypothesis is that the AUC of \code{roc1} is the same than the AUC of \code{roc2}, with \code{roc1} taken as the reference ROC curve. For the sample size, \code{ncases} is computed directly from formula 2 and ncontrols is deduced with \code{kappa} (defaults to the ratio of controls to cases in \code{roc1}). \code{sig.level} and \code{power} are solved as quadratic equations. The variance and covariance of the ROC curve are computed with the \code{\link{var}} and \code{\link{cov}} functions. By default, DeLong method using the algorithm by Sun and Xu (2014) is used for full AUCs and the bootstrap for partial AUCs. It is possible to force the use of Obuchowski's variance by specifying \code{method="obuchowski"}. Alternatively when no empirical ROC curve is known, or if only one is available, a list can be passed to \code{power.roc.test}, with the contents defined in the \dQuote{Arguments} section. The variance and covariance are computed from Table 1 and Equation 4 and 5 of Obuchowski and McClish (1997), p. 1530--1531. Power calculation for unpaired ROC curves is not implemented. } \section{AUC specification}{ The comparison of the AUC of the ROC curves needs a specification of the AUC. The specification is defined by: \enumerate{ \item the \dQuote{auc} field in the \dQuote{\link{roc}} objects if \code{reuse.auc} is set to \code{TRUE} (default) \item passing the specification to \code{\link{auc}} with \dots (arguments \code{partial.auc}, \code{partial.auc.correct} and \code{partial.auc.focus}). In this case, you must ensure either that the \code{\link{roc}} object do not contain an \code{auc} field (if you called \code{\link{roc}} with \code{auc=FALSE}), or set \code{reuse.auc=FALSE}. } If \code{reuse.auc=FALSE} the \code{\link{auc}} function will always be called with \code{\dots} to determine the specification, even if the \dQuote{\link{roc}} objects do contain an \code{auc} field. As well if the \dQuote{\link{roc}} objects do not contain an \code{auc} field, the \code{\link{auc}} function will always be called with \code{\dots} to determine the specification. Warning: if the roc object passed to roc.test contains an \code{auc} field and \code{reuse.auc=TRUE}, \link{auc} is not called and arguments such as \code{partial.auc} are silently ignored. } \value{ An object of class \code{power.htest} (such as that given by \code{\link{power.t.test}}) with the supplied and computed values. } \section{Acknowledgements}{ The authors would like to thank Christophe Combescure and Anne-Sophie Jannot for their help with the implementation of this section of the package. } \references{ Elisabeth R. DeLong, David M. DeLong and Daniel L. Clarke-Pearson (1988) ``Comparing the areas under two or more correlated receiver operating characteristic curves: a nonparametric approach''. \emph{Biometrics} \bold{44}, 837--845. Nancy A. Obuchowski, Donna K. McClish (1997). ``Sample size determination for diagnostic accurary studies involving binormal ROC curve indices''. \emph{Statistics in Medicine}, \bold{16}, 1529--1542. DOI: \doi{10.1002/(SICI)1097-0258(19970715)16:13<1529::AID-SIM565>3.0.CO;2-H}. Nancy A. Obuchowski, Micharl L. Lieber, Frank H. Wians Jr. (2004). ``ROC Curves in Clinical Chemistry: Uses, Misuses, and Possible Solutions''. \emph{Clinical Chemistry}, \bold{50}, 1118--1125. DOI: \doi{10.1373/clinchem.2004.031823}. Xu Sun and Weichao Xu (2014) ``Fast Implementation of DeLongs Algorithm for Comparing the Areas Under Correlated Receiver Operating Characteristic Curves''. \emph{IEEE Signal Processing Letters}, \bold{21}, 1389--1393. DOI: \doi{10.1109/LSP.2014.2337313}. } \seealso{ \code{\link{roc}}, \code{\link{roc.test}} } \examples{ data(aSAH) #### One ROC curve #### # Build a roc object: rocobj <- roc(aSAH$outcome, aSAH$s100b) # Determine power of one ROC curve: power.roc.test(rocobj) # Same as: power.roc.test(ncases=41, ncontrols=72, auc=0.73, sig.level=0.05) # sig.level=0.05 is implicit and can be omitted: power.roc.test(ncases=41, ncontrols=72, auc=0.73) # Determine ncases & ncontrols: power.roc.test(auc=rocobj$auc, sig.level=0.05, power=0.95, kappa=1.7) power.roc.test(auc=0.73, sig.level=0.05, power=0.95, kappa=1.7) # Determine sig.level: power.roc.test(ncases=41, ncontrols=72, auc=0.73, power=0.95, sig.level=NULL) # Derermine detectable AUC: power.roc.test(ncases=41, ncontrols=72, sig.level=0.05, power=0.95) #### Two ROC curves #### ### Full AUC roc1 <- roc(aSAH$outcome, aSAH$ndka) roc2 <- roc(aSAH$outcome, aSAH$wfns) ## Sample size # With DeLong variance (default) power.roc.test(roc1, roc2, power=0.9) # With Obuchowski variance power.roc.test(roc1, roc2, power=0.9, method="obuchowski") ## Power test # With DeLong variance (default) power.roc.test(roc1, roc2) # With Obuchowski variance power.roc.test(roc1, roc2, method="obuchowski") ## Significance level # With DeLong variance (default) power.roc.test(roc1, roc2, power=0.9, sig.level=NULL) # With Obuchowski variance power.roc.test(roc1, roc2, power=0.9, sig.level=NULL, method="obuchowski") ### Partial AUC roc3 <- roc(aSAH$outcome, aSAH$ndka, partial.auc=c(1, 0.9)) roc4 <- roc(aSAH$outcome, aSAH$wfns, partial.auc=c(1, 0.9)) ## Sample size # With bootstrap variance (default) \dontrun{ power.roc.test(roc3, roc4, power=0.9) } # With Obuchowski variance power.roc.test(roc3, roc4, power=0.9, method="obuchowski") ## Power test # With bootstrap variance (default) \dontrun{ power.roc.test(roc3, roc4) # This is exactly equivalent: power.roc.test(roc1, roc2, reuse.auc=FALSE, partial.auc=c(1, 0.9)) } # With Obuchowski variance power.roc.test(roc3, roc4, method="obuchowski") ## Significance level # With bootstrap variance (default) \dontrun{ power.roc.test(roc3, roc4, power=0.9, sig.level=NULL) } # With Obuchowski variance power.roc.test(roc3, roc4, power=0.9, sig.level=NULL, method="obuchowski") ## With only binormal parameters given # From example 2 of Obuchowski and McClish, 1997. ob.params <- list(A1=2.6, B1=1, A2=1.9, B2=1, rn=0.6, ra=0.6, FPR11=0, FPR12=0.2, FPR21=0, FPR22=0.2, delta=0.037) power.roc.test(ob.params, power=0.8, sig.level=0.05) power.roc.test(ob.params, power=0.8, sig.level=NULL, ncases=107) power.roc.test(ob.params, power=NULL, sig.level=0.05, ncases=107) } \keyword{univar} \keyword{nonparametric} \keyword{utilities} \keyword{roc} pROC/man/ci.sp.Rd0000644000176200001440000001531314114130125013126 0ustar liggesusers\encoding{UTF-8} \name{ci.sp} \alias{ci.sp} \alias{ci.sp.default} \alias{ci.sp.formula} \alias{ci.sp.roc} \alias{ci.sp.smooth.roc} \title{ Compute the confidence interval of specificities at given sensitivities } \description{ This function computes the confidence interval (CI) of the specificity at the given sensitivity points. By default, the 95\% CI are computed with 2000 stratified bootstrap replicates. } \usage{ # ci.sp(...) \S3method{ci.sp}{roc}(roc, sensitivities = seq(0, 1, .1) * ifelse(roc$percent, 100, 1), conf.level=0.95, boot.n=2000, boot.stratified=TRUE, progress=getOption("pROCProgress")$name, parallel=FALSE, ...) \S3method{ci.sp}{smooth.roc}(smooth.roc, sensitivities = seq(0, 1, .1) * ifelse(smooth.roc$percent, 100, 1), conf.level=0.95, boot.n=2000, boot.stratified=TRUE, progress=getOption("pROCProgress")$name, parallel=FALSE, ...) \S3method{ci.sp}{formula}(formula, data, ...) \S3method{ci.sp}{default}(response, predictor, ...) } \arguments{ \item{roc, smooth.roc}{a \dQuote{roc} object from the \code{\link{roc}} function, or a \dQuote{smooth.roc} object from the \code{\link[=smooth.roc]{smooth}} function. } \item{response, predictor}{arguments for the \code{\link{roc}} function.} \item{formula, data}{a formula (and possibly a data object) of type response~predictor for the \code{\link{roc}} function. } \item{sensitivities}{on which sensitivities to evaluate the CI. } \item{conf.level}{the width of the confidence interval as [0,1], never in percent. Default: 0.95, resulting in a 95\% CI. } \item{boot.n}{the number of bootstrap replicates. Default: 2000.} \item{boot.stratified}{should the bootstrap be stratified (default, same number of cases/controls in each replicate than in the original sample) or not. } \item{progress}{the name of progress bar to display. Typically \dQuote{none}, \dQuote{win}, \dQuote{tk} or \dQuote{text} (see the \code{name} argument to \code{\link[plyr]{create_progress_bar}} for more information), but a list as returned by \code{\link[plyr]{create_progress_bar}} is also accepted. See also the \dQuote{Progress bars} section of \link[=pROC-package]{this package's documentation}. } \item{parallel}{if TRUE, the bootstrap is processed in parallel, using parallel backend provided by plyr (foreach). } \item{\dots}{further arguments passed to or from other methods, especially arguments for \code{\link{roc}} and \code{ci.sp.roc} when calling \code{ci.sp.default} or \code{ci.sp.formula}. Arguments for \code{\link{txtProgressBar}} (only \code{char} and \code{style}) if applicable. } } \details{ \code{ci.sp.formula} and \code{ci.sp.default} are convenience methods that build the ROC curve (with the \code{\link{roc}} function) before calling \code{ci.sp.roc}. You can pass them arguments for both \code{\link{roc}} and \code{ci.sp.roc}. Simply use \code{ci.sp} that will dispatch to the correct method. The \code{ci.sp.roc} function creates \code{boot.n} bootstrap replicate of the ROC curve, and evaluates the specificity at sensitivities given by the \code{sensitivities} argument. Then it computes the confidence interval as the percentiles given by \code{conf.level}. For more details about the bootstrap, see the Bootstrap section in \link[=pROC-package]{this package's documentation}. For \link[=smooth.roc]{smoothed ROC curves}, smoothing is performed again at each bootstrap replicate with the parameters originally provided. If a density smoothing was performed with user-provided \code{density.cases} or \code{density.controls} the bootstrap cannot be performed and an error is issued. } \section{Warnings}{ If \code{boot.stratified=FALSE} and the sample has a large imbalance between cases and controls, it could happen that one or more of the replicates contains no case or control observation, or that there are not enough points for smoothing, producing a \code{NA} area. The warning \dQuote{NA value(s) produced during bootstrap were ignored.} will be issued and the observation will be ignored. If you have a large imbalance in your sample, it could be safer to keep \code{boot.stratified=TRUE}. } \section{Errors}{ If \code{density.cases} and \code{density.controls} were provided for smoothing, the error \dQuote{Cannot compute the statistic on ROC curves smoothed with density.controls and density.cases.} is issued. } \value{ A matrix of class \dQuote{ci.sp}, \dQuote{ci} and \dQuote{matrix} (in this order) containing the given specificities. Row (names) are the sensitivities, the first column the lower bound, the 2nd column the median and the 3rd column the upper bound. Additionally, the list has the following attributes: \item{conf.level}{the width of the CI, in fraction.} \item{boot.n}{the number of bootstrap replicates.} \item{boot.stratified}{whether or not the bootstrapping was stratified.} \item{sensitivities}{the sensitivities as given in argument.} \item{roc}{the object of class \dQuote{\link{roc}} that was used to compute the CI. } } \references{ James Carpenter and John Bithell (2000) ``Bootstrap condence intervals: when, which, what? A practical guide for medical statisticians''. \emph{Statistics in Medicine} \bold{19}, 1141--1164. DOI: \doi{10.1002/(SICI)1097-0258(20000515)19:9<1141::AID-SIM479>3.0.CO;2-F}. Tom Fawcett (2006) ``An introduction to ROC analysis''. \emph{Pattern Recognition Letters} \bold{27}, 861--874. DOI: \doi{10.1016/j.patrec.2005.10.010}. Xavier Robin, Natacha Turck, Alexandre Hainard, \emph{et al.} (2011) ``pROC: an open-source package for R and S+ to analyze and compare ROC curves''. \emph{BMC Bioinformatics}, \bold{7}, 77. DOI: \doi{10.1186/1471-2105-12-77}. Hadley Wickham (2011) ``The Split-Apply-Combine Strategy for Data Analysis''. \emph{Journal of Statistical Software}, \bold{40}, 1--29. URL: \href{https://www.jstatsoft.org/v40/i01}{www.jstatsoft.org/v40/i01}. } \seealso{ \code{\link{roc}}, \code{\link{ci}}, \code{\link{ci.se}}, \code{\link{plot.ci}} } \examples{ # Create a ROC curve: data(aSAH) roc1 <- roc(aSAH$outcome, aSAH$s100b) ## Basic example ## \dontrun{ ci.sp(roc1)}\dontshow{ci.sp(roc1, boot.n = 10)} ## More options ## # Customized bootstrap and sensitivities: \dontrun{ ci.sp(roc1, c(.95, .9, .85), boot.n=10000, conf.level=0.9, stratified=FALSE)}\dontshow{ ci.sp(roc1, c(.95, .9, .85), boot.n=10, conf.level=0.9, stratified=FALSE)} ## Plotting the CI ## ci1 <- ci.sp(roc1, boot.n = 10) plot(roc1) plot(ci1) ## On smoothed ROC curves with bootstrap ## \dontrun{ ci.sp(smooth(roc1, method="density"))}\dontshow{ ci.sp(smooth(roc1, method="density"), boot.n = 10)} } \keyword{univar} \keyword{nonparametric} \keyword{utilities} \keyword{roc} pROC/man/plot.roc.Rd0000644000176200001440000003356114114130125013657 0ustar liggesusers\encoding{UTF-8} \name{plot.roc} \alias{plot} \alias{plot.roc} \alias{plot.roc.roc} \alias{plot.smooth.roc} \alias{plot.roc.smooth.roc} \alias{plot.roc.default} \alias{plot.roc.formula} \title{ Plot a ROC curve } \description{ This function plots a ROC curve. It can accept many arguments to tweak the appearance of the plot. Two syntaxes are possible: one object of class \dQuote{\link{roc}}, or either two vectors (response, predictor) or a formula (response~predictor) as in the \code{\link{roc}} function. } \usage{ \S3method{plot}{roc}(x, ...) \S3method{plot}{smooth.roc}(x, ...) \S3method{plot.roc}{roc}(x, add=FALSE, reuse.auc=TRUE, axes=TRUE, legacy.axes=FALSE, # Generic arguments for par: xlim=if(x$percent){c(100, 0)} else{c(1, 0)}, ylim=if(x$percent){c(0, 100)} else{c(0, 1)}, xlab=ifelse(x$percent, ifelse(legacy.axes, "100 - Specificity (\%)", "Specificity (\%)"), ifelse(legacy.axes, "1 - Specificity", "Specificity")), ylab=ifelse(x$percent, "Sensitivity (\%)", "Sensitivity"), asp=1, mar=c(4, 4, 2, 2)+.1, mgp=c(2.5, 1, 0), # col, lty and lwd for the ROC line only col=par("col"), lty=par("lty"), lwd=2, type="l", # Identity line identity=!add, identity.col="darkgrey", identity.lty=1, identity.lwd=1, # Print the thresholds on the plot print.thres=FALSE, print.thres.pch=20, print.thres.adj=c(-.05,1.25), print.thres.col="black", print.thres.pattern=ifelse(x$percent, "\%.1f (\%.1f\%\%, \%.1f\%\%)", "\%.3f (\%.3f, \%.3f)"), print.thres.cex=par("cex"), print.thres.pattern.cex=print.thres.cex, print.thres.best.method=NULL, print.thres.best.weights=c(1, 0.5), # Print the AUC on the plot print.auc=FALSE, print.auc.pattern=NULL, print.auc.x=ifelse(x$percent, 50, .5), print.auc.y=ifelse(x$percent, 50, .5), print.auc.adj=c(0,1), print.auc.col=col, print.auc.cex=par("cex"), # Grid grid=FALSE, grid.v={if(is.logical(grid) && grid[1]==TRUE) {seq(0, 1, 0.1) * ifelse(x$percent, 100, 1)} else if(is.numeric(grid)) {seq(0, ifelse(x$percent, 100, 1), grid[1])} else {NULL}}, grid.h={if (length(grid) == 1) {grid.v} else if (is.logical(grid) && grid[2]==TRUE) {seq(0, 1, 0.1) * ifelse(x$percent, 100, 1)} else if(is.numeric(grid)) {seq(0, ifelse(x$percent, 100, 1), grid[2])} else {NULL}}, grid.lty=3, grid.lwd=1, grid.col="#DDDDDD", # Polygon for the AUC auc.polygon=FALSE, auc.polygon.col="gainsboro", auc.polygon.lty=par("lty"), auc.polygon.density=NULL, auc.polygon.angle=45, auc.polygon.border=NULL, # Polygon for the maximal AUC possible max.auc.polygon=FALSE, max.auc.polygon.col="#EEEEEE", max.auc.polygon.lty=par("lty"), max.auc.polygon.density=NULL, max.auc.polygon.angle=45, max.auc.polygon.border=NULL, # Confidence interval ci=!is.null(x$ci), ci.type=c("bars", "shape", "no"), ci.col=ifelse(ci.type=="bars", par("fg"), "gainsboro"), ...) \S3method{plot.roc}{formula}(x, data, subset, na.action, ...) \S3method{plot.roc}{default}(x, predictor, ...) \S3method{plot.roc}{smooth.roc}(x, ...) } \arguments{ \item{x}{a roc object from the \link{roc} function (for plot.roc.roc), a formula (for plot.roc.formula) or a response vector (for plot.roc.default). } \item{predictor, data}{arguments for the \link{roc} function.} \item{subset,na.action}{arguments for \code{\link{model.frame}}} \item{add}{if TRUE, the ROC curve will be added to an existing plot. If FALSE (default), a new plot will be created. } \item{reuse.auc}{if \code{TRUE} (default) and the \dQuote{roc} object contains an \dQuote{auc} field, re-use these specifications for the plot (specifically \code{print.auc}, \code{auc.polygon} and \code{max.auc.polygon} arguments). See details. } \item{axes}{a logical indicating if the plot axes must be drawn.} \item{legacy.axes}{a logical indicating if the specificity axis (x axis) must be plotted as as decreasing \dQuote{specificity} (\code{FALSE}, the default) or increasing \dQuote{1 - specificity} (\code{TRUE}) as in most legacy software. This affects only the axis, not the plot coordinates.} \item{xlim, ylim, xlab, ylab, asp, mar, mgp}{Generic arguments for the plot. See \link{plot} and \link{plot.window} for more details. Only used if \code{add=FALSE}. } \item{col,lty, lwd}{color, line type and line width for the ROC curve. See \link{par} for more details. } \item{type}{type of plotting as in \code{\link{plot}}.} \item{identity}{logical: whether or not the identity line (no discrimination line) must be displayed. Default: only on new plots. } \item{identity.col, identity.lty, identity.lwd}{color, line type and line width for the identity line. Used only if identity=TRUE. See \link{par} for more details. } \item{print.thres}{Should a selected set of thresholds be displayed on the ROC curve? \code{FALSE}, \code{NULL} or \dQuote{no}: no threshold is displayed. \code{TRUE} or \dQuote{best}: the threshold with the highest sum sensitivity + specificity is plotted (this might be more than one threshold). \dQuote{all}: all the points of the ROC curve. \dQuote{local maximas}: all the local maximas. Numeric vector: direct definition of the thresholds to display. Note that on a smoothed ROC curve, only \dQuote{best} is supported. } \item{print.thres.pch, print.thres.adj, print.thres.col, print.thres.cex}{the plotting character (pch), text string adjustment (adj), color (col) and character expansion factor (cex) parameters for the printing of the thresholds. See \link{points} and \link{par} for more details. } \item{print.thres.pattern}{the text pattern for the thresholds, as a \link{sprintf} format. Three numerics are passed to sprintf: threshold, specificity, sensitivity. } \item{print.thres.pattern.cex}{the character expansion factor (cex) for the threshold text pattern. See \link{par} for more details. } \item{print.thres.best.method, print.thres.best.weights}{if \code{print.thres="best"} or \code{print.thres=TRUE}, what method must be used to determine which threshold is the best. See argument \code{best.method} and \code{best.weights} to \code{\link{coords}} for more details. } \item{print.auc}{boolean. Should the numeric value of AUC be printed on the plot? } \item{print.auc.pattern}{the text pattern for the AUC, as a \link{sprintf} format. If NULL, a reasonable value is computed that takes partial AUC, CI and percent into account. If the CI of the AUC was computed, three numerics are passed to sprintf: AUC, lower CI bound, higher CI bound. Otherwise, only AUC is passed. } \item{print.auc.x, print.auc.y}{x and y position for the printing of the AUC. } \item{print.auc.adj, print.auc.cex, print.auc.col}{the text adjustment, character expansion factor and color for the printing of the AUC. See \link{par} for more details. } \item{grid}{boolean or numeric vector of length 1 or 2. Should a background grid be added to the plot? Numeric: show a grid with the specified interval between each line; Logical: show the grid or not. Length 1: same values are taken for horizontal and vertical lines. Length 2: grid value for vertical (grid[1]) and horizontal (grid[2]). Note that these values are used to compute grid.v and grid.h. Therefore if you specify a grid.h and grid.v, it will be ignored. } \item{grid.v, grid.h}{numeric. The x and y values at which a vertical or horizontal line (respectively) must be drawn. NULL if no line must be added. } \item{grid.lty, grid.lwd, grid.col}{the line type (lty), line width (lwd) and color (col) of the lines of the grid. See \link{par} for more details. Note that you can pass vectors of length 2, in which case it specifies the vertical (1) and horizontal (2) lines. } \item{auc.polygon}{boolean. Whether or not to display the area as a polygon. } \item{auc.polygon.col, auc.polygon.lty, auc.polygon.density, auc.polygon.angle, auc.polygon.border}{color (col), line type (lty), density, angle and border for the AUC polygon. See \code{\link{polygon}} and \code{\link{par}} for more details. } \item{max.auc.polygon}{boolean. Whether or not to display the maximal possible area as a polygon. } \item{max.auc.polygon.col, max.auc.polygon.lty, max.auc.polygon.density, max.auc.polygon.angle, max.auc.polygon.border}{color (col), line type (lty), density, angle and border for the maximum AUC polygon. See \code{\link{polygon}} and \code{\link{par}} for more details. } \item{ci}{boolean. Should we plot the confidence intervals?} \item{ci.type, ci.col}{\code{type} and \code{col} arguments for \code{\link{plot.ci}}. The special value \dQuote{no} disables the plotting of confidence intervals. } \item{\dots}{further arguments passed to or from other methods, especially arguments for \code{\link{roc}} and \code{plot.roc.roc} when calling \code{plot.roc.default} or \code{plot.roc.formula}. Note that the \code{plot} argument for \code{\link{roc}} is not allowed. Arguments for \code{\link{auc}} and graphical functions \code{\link{plot}}, \code{\link{abline}}, \code{\link{polygon}}, \code{\link{points}}, \code{\link{text}} and \code{\link{plot.ci}} if applicable. } } \details{ This function is typically called from \code{\link{roc}} when plot=TRUE (not by default). \code{plot.roc.formula} and \code{plot.roc.default} are convenience methods that build the ROC curve (with the \code{\link{roc}} function) before calling \code{plot.roc.roc}. You can pass them arguments for both \code{\link{roc}} and \code{plot.roc.roc}. Simply use \code{plot.roc} that will dispatch to the correct method. The plotting is done in the following order: \enumerate{ \item A new plot is created if \code{add=FALSE}. \item The grid is added if \code{grid.v} and \code{grid.h} are not NULL. \item The maximal AUC polygon is added if \code{max.auc.polygon=TRUE}. \item The CI shape is added if \code{ci=TRUE}, \code{ci.type="shape"} and \code{x$ci} isn't a \dQuote{ci.auc}. \item The AUC polygon is added if \code{auc.polygon=TRUE}. \item The identity line if \code{identity=TRUE}. \item The actual ROC line is added. \item The CI bars are added if \code{ci=TRUE}, \code{ci.type="bars"} and \code{x$ci} isn't a \dQuote{ci.auc}. \item The selected thresholds are printed if \code{print.thres} is \code{TRUE} or numeric. \item The AUC is printed if \code{print.auc=TRUE}. } Graphical functions are called with \link{suppressWarnings}. } \section{AUC specification}{ For \code{print.auc}, \code{auc.polygon} and \code{max.auc.polygon} arguments, an AUC specification is required. By default, the total AUC is plotted, but you may want a partial AUCs. The specification is defined by: \enumerate{ \item the \dQuote{auc} field in the \dQuote{\link{roc}} object if \code{reuse.auc} is set to \code{TRUE} (default). It is naturally inherited from any call to \code{\link{roc}} and fits most cases. \item passing the specification to \code{\link{auc}} with \dots (arguments \code{partial.auc}, \code{partial.auc.correct} and \code{partial.auc.focus}). In this case, you must ensure either that the \code{\link{roc}} object do not contain an \code{auc} field (if you called \code{\link{roc}} with \code{auc=FALSE}), or set \code{reuse.auc=FALSE}. } If \code{reuse.auc=FALSE} the \code{\link{auc}} function will always be called with \code{\dots} to determine the specification, even if the \dQuote{\link{roc}} object do contain an \code{auc} field. As well if the \dQuote{\link{roc}} object do not contain an \code{auc} field, the \code{\link{auc}} function will always be called with \code{\dots} to determine the specification. Warning: if the roc object passed to plot.roc contains an \code{auc} field and \code{reuse.auc=TRUE}, \link{auc} is not called and arguments such as \code{partial.auc} are silently ignored. } \value{ This function returns a list of class \dQuote{roc} invisibly. See \link{roc} for more details. } \references{ Xavier Robin, Natacha Turck, Alexandre Hainard, \emph{et al.} (2011) ``pROC: an open-source package for R and S+ to analyze and compare ROC curves''. \emph{BMC Bioinformatics}, \bold{7}, 77. DOI: \doi{10.1186/1471-2105-12-77}. } \seealso{ \code{\link{roc}}, \code{\link{auc}}, \code{\link{ci}} } \examples{ # Create a few ROC curves: data(aSAH) roc.s100b <- roc(aSAH$outcome, aSAH$s100b) roc.wfns <- roc(aSAH$outcome, aSAH$wfns) roc.ndka <- roc(aSAH$outcome, aSAH$wfns) # Simple example: plot(roc.s100b) # Add a smoothed ROC: plot(smooth(roc.s100b), add=TRUE, col="blue") legend("bottomright", legend=c("Empirical", "Smoothed"), col=c(par("fg"), "blue"), lwd=2) # With more options: plot(roc.s100b, print.auc=TRUE, auc.polygon=TRUE, grid=c(0.1, 0.2), grid.col=c("green", "red"), max.auc.polygon=TRUE, auc.polygon.col="lightblue", print.thres=TRUE) # To plot a different partial AUC, we need to ignore the existing value # with reuse.auc=FALSE: plot(roc.s100b, print.auc=TRUE, auc.polygon=TRUE, partial.auc=c(1, 0.8), partial.auc.focus="se", grid=c(0.1, 0.2), grid.col=c("green", "red"), max.auc.polygon=TRUE, auc.polygon.col="lightblue", print.thres=TRUE, print.thres.adj = c(1, -1), reuse.auc=FALSE) # Add a second ROC curve to the previous plot: plot(roc.wfns, add=TRUE) # Plot some thresholds, add them to the same plot plot(roc.ndka, print.thres="best", print.thres.best.method="youden") plot(roc.ndka, print.thres="best", print.thres.best.method="closest.topleft", add = TRUE) plot(roc.ndka, print.thres="best", print.thres.best.method="youden", print.thres.best.weights=c(50, 0.2), print.thres.adj = c(1.1, 1.25), add = TRUE) } \keyword{univar} \keyword{nonparametric} \keyword{utilities} \keyword{aplot} \keyword{hplot} \keyword{roc} pROC/man/aSAH.Rd0000644000176200001440000000352314114130125012666 0ustar liggesusers\encoding{UTF-8} \name{aSAH} \docType{data} \alias{aSAH} \title{ Subarachnoid hemorrhage data } \description{ This dataset summarizes several clinical and one laboratory variable of 113 patients with an aneurysmal subarachnoid hemorrhage. } \usage{aSAH} \format{A data.frame containing 113 observations of 7 variables.} \source{ Natacha Turck, Laszlo Vutskits, Paola Sanchez-Pena, Xavier Robin, Alexandre Hainard, Marianne Gex-Fabry, Catherine Fouda, Hadiji Bassem, Markus Mueller, Frédérique Lisacek, Louis Puybasset and Jean-Charles Sanchez (2010) ``A multiparameter panel method for outcome prediction following aneurysmal subarachnoid hemorrhage''. \emph{Intensive Care Medicine} \bold{36}(1), 107--115. DOI: \doi{10.1007/s00134-009-1641-y}. } \seealso{ Other examples can be found in all the documentation pages of this package: \code{\link{roc}}, \code{\link{auc}}, \code{\link{ci}}, \code{\link{ci.auc}}, \code{\link{ci.se}}, \code{\link{ci.sp}}, \code{\link{ci.thresholds}}, \code{\link{coords}}, \code{\link{plot.ci}}, \code{\link{plot.roc}}, \code{\link{print.roc}}, \code{\link{roc.test}} and \code{\link{smooth}}. An example analysis with pROC is shown in: Xavier Robin, Natacha Turck, Alexandre Hainard, \emph{et al.} (2011) ``pROC: an open-source package for R and S+ to analyze and compare ROC curves''. \emph{BMC Bioinformatics}, \bold{7}, 77. DOI: \doi{10.1186/1471-2105-12-77} } \examples{ # load the dataset data(aSAH) # Gender, outcome and set with(aSAH, table(gender, outcome)) # Age with(aSAH, by(age, outcome, mean)) with(aSAH, by(age, outcome, function(x) sprintf("mean: \%.1f (+/- \%.1f), median: \%.1f (\%i-\%i)", mean(x), sd(x), median(x), min(x), max(x)))) # WFNS score with(aSAH, table(wfns=ifelse(wfns<=2, "1-2", "3-4-5"), outcome)) } \keyword{datasets} pROC/man/plot.ci.Rd0000644000176200001440000000677414114130125013475 0ustar liggesusers\encoding{UTF-8} \name{plot.ci} \alias{plot.ci} \alias{plot.ci.thresholds} \alias{plot.ci.se} \alias{plot.ci.sp} \title{ Plot confidence intervals } \description{ This function adds confidence intervals to a ROC curve plot, either as bars or as a confidence shape. } \usage{ \S3method{plot}{ci.thresholds}(x, length=.01*ifelse(attr(x, "roc")$percent, 100, 1), col=par("fg"), ...) \S3method{plot}{ci.sp}(x, type=c("bars", "shape"), length=.01*ifelse(attr(x, "roc")$percent, 100, 1), col=ifelse(type=="bars", par("fg"), "gainsboro"), no.roc=FALSE, ...) \S3method{plot}{ci.se}(x, type=c("bars", "shape"), length=.01*ifelse(attr(x, "roc")$percent, 100, 1), col=ifelse(type=="bars", par("fg"), "gainsboro"), no.roc=FALSE, ...) } \arguments{ \item{x}{a confidence interval object from the functions \code{\link{ci.thresholds}}, \code{\link{ci.se}} or \code{\link{ci.sp}}. } \item{type}{type of plot, \dQuote{bars} or \dQuote{shape}. Can be shortened to \dQuote{b} or \dQuote{s}. \dQuote{shape} is only available for \code{ci.se} and \code{ci.sp}, not for \code{ci.thresholds}. } \item{length}{the length (as plot coordinates) of the bar ticks. Only if \code{type="bars"}. } \item{no.roc}{ if \code{FALSE}, the ROC line is re-added over the shape. Otherwise if \code{TRUE}, only the shape is plotted. Ignored if \code{type="bars"} } \item{col}{color of the bars or shape.} \item{\dots}{further arguments for \code{\link{segments}} (if \code{type="bars"}) or \code{\link{polygon}} (if \code{type="shape"}). } } \details{ This function adds confidence intervals to a ROC curve plot, either as bars or as a confidence shape, depending on the state of the \code{type} argument. The shape is plotted over the ROC curve, so that the curve is re-plotted unless \code{no.roc=TRUE}. Graphical functions are called with \link{suppressWarnings}. } \section{Warnings}{ With \code{type="shape"}, the warning \dQuote{Low definition shape} is issued when the shape is defined by less than 15 confidence intervals. In such a case, the shape is not well defined and the ROC curve could pass outside the shape. To get a better shape, increase the number of intervals, for example with: \preformatted{plot(ci.sp(rocobj, sensitivities=seq(0, 1, .01)), type="shape")} } \value{ This function returns the confidence interval object invisibly. } \references{ Xavier Robin, Natacha Turck, Alexandre Hainard, \emph{et al.} (2011) ``pROC: an open-source package for R and S+ to analyze and compare ROC curves''. \emph{BMC Bioinformatics}, \bold{7}, 77. DOI: \doi{10.1186/1471-2105-12-77}. } \seealso{ \code{\link{plot.roc}}, \code{\link{ci.thresholds}}, \code{\link{ci.sp}}, \code{\link{ci.se}} } \examples{ data(aSAH) \dontrun{ # Start a ROC plot rocobj <- plot.roc(aSAH$outcome, aSAH$s100b) plot(rocobj) # Thresholds ci.thresolds.obj <- ci.thresholds(rocobj) plot(ci.thresolds.obj) # Specificities plot(rocobj) # restart a new plot ci.sp.obj <- ci.sp(rocobj, boot.n=500) plot(ci.sp.obj) # Sensitivities plot(rocobj) # restart a new plot ci.se.obj <- ci(rocobj, of="se", boot.n=500) plot(ci.se.obj) # Plotting a shape. We need more ci.sp.obj <- ci.sp(rocobj, sensitivities=seq(0, 1, .01), boot.n=100) plot(rocobj) # restart a new plot plot(ci.sp.obj, type="shape", col="blue") # Direct syntax (response, predictor): plot.roc(aSAH$outcome, aSAH$s100b, ci=TRUE, of="thresholds") } } \keyword{univar} \keyword{nonparametric} \keyword{utilities} \keyword{aplot} \keyword{hplot} \keyword{roc} pROC/man/roc.Rd0000644000176200001440000004401014114130125012671 0ustar liggesusers\encoding{UTF-8} \name{roc} \alias{roc} \alias{roc_} \alias{roc.formula} \alias{roc.data.frame} \alias{roc.default} \title{ Build a ROC curve } \description{ This is the main function of the pROC package. It builds a ROC curve and returns a \dQuote{roc} object, a list of class \dQuote{roc}. This object can be \code{print}ed, \code{plot}ted, or passed to the functions \code{\link{auc}}, \code{\link{ci}}, \code{\link{smooth.roc}} and \code{\link{coords}}. Additionally, two \code{roc} objects can be compared with \code{\link{roc.test}}. } \usage{ roc(...) \S3method{roc}{formula}(formula, data, ...) \S3method{roc}{data.frame}(data, response, predictor, ret = c("roc", "coords", "all_coords"), ...) \S3method{roc}{default}(response, predictor, controls, cases, density.controls, density.cases, levels=base::levels(as.factor(response)), percent=FALSE, na.rm=TRUE, direction=c("auto", "<", ">"), algorithm = 6, quiet = FALSE, smooth=FALSE, auc=TRUE, ci=FALSE, plot=FALSE, smooth.method="binormal", smooth.n=512, ci.method=NULL, density=NULL, ...) roc_(data, response, predictor, ret = c("roc", "coords", "all_coords"), ...) } \arguments{ \item{response}{a factor, numeric or character vector of responses (true class), typically encoded with 0 (controls) and 1 (cases). Only two classes can be used in a ROC curve. If the vector contains more than two unique values, or if their order could be ambiguous, use \code{levels} to specify which values must be used as control and case value. If the first argument was a \code{\link{data.frame}}, \code{response} should be the name of the column in \code{data} containing the response, quoted for \code{roc_}, and optionally quoted for \code{roc.data.frame} (non-standard evaluation or NSE). } \item{predictor}{a \code{\link{numeric}} or \code{\link{ordered}} vector of the same length than \code{response}, containing the predicted value of each observation. If the first argument was a \code{\link{data.frame}}, \code{predictor} should be the name of the column in \code{data} containing the predictor, quoted for \code{roc_}, and optionally quoted for \code{roc.data.frame} (non-standard evaluation or NSE). } \item{controls, cases}{instead of \code{response}, \code{predictor}, the data can be supplied as two \code{\link{numeric}} or \code{\link{ordered}} vectors containing the predictor values for control and case observations. } \item{density.controls, density.cases}{a smoothed ROC curve can be built directly from two densities on identical \code{x} points, as in \code{\link[=smooth.roc]{smooth}}. } \item{formula, data}{a formula of the type \code{response~predictor}. If mulitple predictors are passed, a named list of \code{roc} objects will be returned. Additional arguments \code{data} and \code{subset}, but not \code{na.action} are supported, see \code{\link{model.frame}} for more details. } \item{levels}{the value of the response for controls and cases respectively. By default, the first two values of \code{levels(as.factor(response))} are taken, and the remaining levels are ignored. It usually captures two-class factor data correctly, but will frequently fail for other data types (response factor with more than 2 levels, or for example if your response is coded \dQuote{controls} and \dQuote{cases}, the levels will be inverted) and must then be specified here. If your data is coded as \code{0} and \code{1} with \code{0} being the controls, you can safely omit this argument. } \item{percent}{if the sensitivities, specificities and AUC must be given in percent (\code{TRUE}) or in fraction (\code{FALSE}, default). } \item{na.rm}{if \code{TRUE}, the \code{NA} values will be removed (ignored by \code{roc.formula}). } \item{direction}{in which direction to make the comparison? \dQuote{auto} (default): automatically define in which group the median is higher and take the direction accordingly. \dQuote{>}: if the predictor values for the control group are higher than the values of the case group (controls > t >= cases). \dQuote{<}: if the predictor values for the control group are lower or equal than the values of the case group (controls < t <= cases). You should set this explicity to \dQuote{>} or \dQuote{<} whenever you are resampling or randomizing the data, otherwise the curves will be biased towards higher AUC values. } \item{algorithm}{the method used to compute sensitivity and specificity, an integer of length 1 between \code{0} and \code{6}. \code{1}: a safe, well-tested, pure-\R code that is efficient when the number of thresholds is low. It goes with O(T*N). \code{2}: an alternative pure-\R algorithm that goes in O(N). Typically faster than \code{1} when the number of thresholds of the ROC curve is above 1000. Less tested than \code{1}. \code{3}: a C++ implementation of \code{1}, about 3-5x faster. Typically the fastest with ROC curves with less than 50-100 thresholds, but has a very bad worst-case when that number increases. \code{4} (debug only, slow): runs algorithms 1 to 3 and makes sure they return the same values. \code{5}: select \code{2} or \code{3} based on the number of thresholds. \code{6} (default): quickly select the algorithm on the class of the data: \code{2} for \code{\link{numeric}} and \code{3} for \code{\link{ordered}}. \code{0}: use \pkg{microbenchmark} to choose between \code{2} and \code{3}. } \item{ret}{for \code{roc.data.frame} only, whether to return the threshold sensitivity and specificity at all thresholds (\dQuote{coords}), all the coordinates at all thresholds (\dQuote{all_coords}) or the \code{roc} object (\dQuote{roc}).} \item{quiet}{set to \code{TRUE} to turn off \code{\link{message}}s when \code{direction} and \code{levels} are auto-detected. } \item{smooth}{if TRUE, the ROC curve is passed to \code{\link{smooth}} to be smoothed. } \item{auc}{compute the area under the curve (AUC)? If \code{TRUE} (default), additional arguments can be passed to \code{\link{auc}}. } \item{ci}{compute the confidence interval (CI)? If set to \code{TRUE}, additional arguments can be passed to \code{\link{ci}}. } \item{plot}{plot the ROC curve? If \code{TRUE}, additional arguments can be passed to \code{\link{plot.roc}}. } \item{smooth.method, smooth.n, ci.method}{in \code{roc.formula} and \code{roc.default}, the \code{method} and \code{n} arguments to \code{\link[=smooth.roc]{smooth}} (if \code{smooth=TRUE}) and \code{of="auc"}) must be passed as \code{smooth.method}, \code{smooth.n} and \code{ci.method} to avoid confusions. } \item{density}{\code{density} argument passed to \code{\link[=smooth.roc]{smooth}}.} \item{\dots}{further arguments passed to or from other methods, and especially: \itemize{ \item \code{\link{auc}}: \code{partial.auc}, \code{partial.auc.focus}, \code{partial.auc.correct}. \item \code{\link{ci}}: \code{of}, \code{conf.level}, \code{boot.n}, \code{boot.stratified}, \code{progress} \item \code{\link{ci.auc}}:, \code{reuse.auc}, \code{method} \item \code{\link{ci.thresholds}}: \code{thresholds} \item \code{\link{ci.se}}: \code{sensitivities} \item \code{\link{ci.sp}}: \code{specificities} \item \code{\link{plot.roc}}: \code{add}, \code{col} and most other arguments to the \code{\link{plot.roc}} function. See \code{\link{plot.roc}} directly for more details. \item \code{\link{smooth}}: \code{method}, \code{n}, and all other arguments. See \code{\link{smooth}} for more details. } } } \details{ This function's main job is to build a ROC object. See the \dQuote{Value} section to this page for more details. Before returning, it will call (in this order) the \code{\link[=smooth.roc]{smooth}}, \code{\link{auc}}, \code{\link{ci}} and \code{\link{plot.roc}} functions if \code{smooth} \code{auc}, \code{ci} and \code{plot.roc} (respectively) arguments are set to TRUE. By default, only \code{auc} is called. Data can be provided as \code{response, predictor}, where the predictor is the numeric (or ordered) level of the evaluated signal, and the response encodes the observation class (control or case). The \code{level} argument specifies which response level must be taken as controls (first value of \code{level}) or cases (second). It can safely be ignored when the response is encoded as \code{0} and \code{1}, but it will frequently fail otherwise. By default, the first two values of \code{levels(as.factor(response))} are taken, and the remaining levels are ignored. This means that if your response is coded \dQuote{control} and \dQuote{case}, the levels will be inverted. In some cases, it is more convenient to pass the data as \code{controls, cases}, but both arguments are ignored if \code{response, predictor} was specified to non-\code{NULL} values. It is also possible to pass density data with \code{density.controls, density.cases}, which will result in a smoothed ROC curve even if \code{smooth=FALSE}, but are ignored if \code{response, predictor} or \code{controls, cases} are provided. Specifications for \code{\link{auc}}, \code{\link{ci}} and \code{\link{plot.roc}} are not kept if \code{auc}, \code{ci} or \code{plot} are set to \code{FALSE}. Especially, in the following case: \preformatted{ myRoc <- roc(..., auc.polygon=TRUE, grid=TRUE, plot=FALSE) plot(myRoc) } the plot will not have the AUC polygon nor the grid. Similarly, when comparing \dQuote{roc} objects, the following is not possible: \preformatted{ roc1 <- roc(..., partial.auc=c(1, 0.8), auc=FALSE) roc2 <- roc(..., partial.auc=c(1, 0.8), auc=FALSE) roc.test(roc1, roc2) } This will produce a test on the full AUC, not the partial AUC. To make a comparison on the partial AUC, you must repeat the specifications when calling \code{\link{roc.test}}: \preformatted{ roc.test(roc1, roc2, partial.auc=c(1, 0.8)) } Note that if \code{roc} was called with \code{auc=TRUE}, the latter syntax will not allow redefining the AUC specifications. You must use \code{reuse.auc=FALSE} for that. } \value{ If the data contained any \code{NA} value and \code{na.rm=FALSE}, \code{NA} is returned. Otherwise, if \code{smooth=FALSE}, a list of class \dQuote{roc} with the following fields: \item{auc}{if called with \code{auc=TRUE}, a numeric of class \dQuote{auc} as defined in \code{\link{auc}}. } \item{ci}{if called with \code{ci=TRUE}, a numeric of class \dQuote{ci} as defined in \code{\link{ci}}. } \item{response}{the response vector. Patients whose response is not \code{\link{\%in\%}} \code{levels} are discarded. If \code{NA} values were removed, a \code{na.action} attribute similar to \code{\link{na.omit}} stores the row numbers. } \item{predictor}{the predictor vector converted to numeric as used to build the ROC curve. Patients whose response is not \code{\link{\%in\%}} \code{levels} are discarded. If \code{NA} values were removed, a \code{na.action} attribute similar to \code{\link{na.omit}} stores the row numbers. } \item{original.predictor, original.response}{the response and predictor vectors as passed in argument.} \item{levels}{the levels of the response as defined in argument.} \item{controls}{the predictor values for the control observations.} \item{cases}{the predictor values for the cases.} \item{percent}{if the sensitivities, specificities and AUC are reported in percent, as defined in argument. } \item{direction}{the direction of the comparison, as defined in argument.} \item{fun.sesp}{the function used to compute sensitivities and specificities. Will be re-used in bootstrap operations.} \item{sensitivities}{the sensitivities defining the ROC curve.} \item{specificities}{the specificities defining the ROC curve.} \item{thresholds}{the thresholds at which the sensitivities and specificities were computed. See below for details. } \item{call}{how the function was called. See \code{\link{match.call}} for more details. } If \code{smooth=TRUE} a list of class \dQuote{smooth.roc} as returned by \code{\link{smooth}}, with or without additional elements \code{auc} and \code{ci} (according to the call). } \section{Thresholds}{ Thresholds are selected as the means between any two consecutive values observed in the data. This choice is aimed to facilitate their interpretation, as any data point will be unambiguously positive or negative regardless of whether the comparison operator includes equality or not. In rare cases it might not be possible to represent the mean between two consecutive values, or one might want to use a custom threshold. In those cases, the semantic of the comparison is as follows: with \code{direction = '>'}, observations are positive when they are smaller than or equal (\code{<=}) to the threshold. With \code{direction = '<'}, observations are positive when they are greater than or equal (\code{>=}) to the threshold. As a corollary, thresholds do not correspond to actual values in the data. } \section{Experimental: pipelines}{ Since version 1.15.0, the \code{roc} function can be used in pipelines, for instance with \pkg{dplyr} or \pkg{magrittr}. This is still a highly experimental feature and will change significantly in future versions (see \href{https://github.com/xrobin/pROC/issues/54}{issue 54}). The \code{roc.data.frame} method supports both standard and non-standard evaluation (NSE): \preformatted{ library(dplyr) # Standard evaluation: aSAH \%>\% filter(gender == "Female") \%>\% roc("outcome", "s100b") # Non-Standard Evaluation: aSAH \%>\% filter(gender == "Female") \%>\% roc(outcome, s100b) } For tasks involving programming and variable column names, the \code{roc_} function provides standard evaluation: \preformatted{ # Standard evaluation: aSAH \%>\% filter(gender == "Female") \%>\% roc_("outcome", "s100b") } By default it returns the \code{\link{roc}} object, which can then be piped to the \code{\link{coords}} function to extract coordinates that can be used in further pipelines. \preformatted{ # Returns thresholds, sensitivities and specificities: aSAH \%>\% roc(outcome, s100b) \%>\% coords(transpose = FALSE) \%>\% filter(sensitivity > 0.6, specificity > 0.6) # Returns all existing coordinates, then select precision and recall: aSAH \%>\% roc(outcome, s100b) \%>\% coords(ret = "all", transpose = FALSE) \%>\% select(precision, recall) } } \section{Errors}{ If no control or case observation exist for the given levels of response, no ROC curve can be built and an error is triggered with message \dQuote{No control observation} or \dQuote{No case observation}. If the predictor is not a numeric or ordered, as defined by \code{\link{as.numeric}} or \code{\link{as.ordered}}, the message \dQuote{Predictor must be numeric or ordered} is returned. The message \dQuote{No valid data provided} is issued when the data wasn't properly passed. Remember you need both \code{response} and \code{predictor} of the same (not null) length, or both \code{controls} and \code{cases}. Combinations such as \code{predictor} and \code{cases} are not valid and will trigger this error. Infinite values of the predictor cannot always be thresholded by infinity and can cause ROC curves to not reach 0 or 100\% specificity or sensitivity. Since version 1.13.0, pROC returns \code{NaN} with a warning message \dQuote{Infinite value(s) in predictor} if \code{predictor} contains any \link[=is.infinite]{infinite} values. } \references{ Tom Fawcett (2006) ``An introduction to ROC analysis''. \emph{Pattern Recognition Letters} \bold{27}, 861--874. DOI: \doi{10.1016/j.patrec.2005.10.010}. Xavier Robin, Natacha Turck, Alexandre Hainard, \emph{et al.} (2011) ``pROC: an open-source package for R and S+ to analyze and compare ROC curves''. \emph{BMC Bioinformatics}, \bold{7}, 77. DOI: \doi{10.1186/1471-2105-12-77}. } \seealso{ \code{\link{auc}}, \code{\link{ci}}, \code{\link{plot.roc}}, \code{\link{print.roc}}, \code{\link{roc.test}} } \examples{ data(aSAH) # Basic example roc(aSAH$outcome, aSAH$s100b, levels=c("Good", "Poor")) # As levels aSAH$outcome == c("Good", "Poor"), # this is equivalent to: roc(aSAH$outcome, aSAH$s100b) # In some cases, ignoring levels could lead to unexpected results # Equivalent syntaxes: roc(outcome ~ s100b, aSAH) roc(aSAH$outcome ~ aSAH$s100b) with(aSAH, roc(outcome, s100b)) with(aSAH, roc(outcome ~ s100b)) # With a formula: roc(outcome ~ s100b, data=aSAH) \dontrun{ library(dplyr) aSAH \%>\% filter(gender == "Female") \%>\% roc(outcome, s100b) } # Using subset (only with formula) roc(outcome ~ s100b, data=aSAH, subset=(gender == "Male")) roc(outcome ~ s100b, data=aSAH, subset=(gender == "Female")) # With numeric controls/cases roc(controls=aSAH$s100b[aSAH$outcome=="Good"], cases=aSAH$s100b[aSAH$outcome=="Poor"]) # With ordered controls/cases roc(controls=aSAH$wfns[aSAH$outcome=="Good"], cases=aSAH$wfns[aSAH$outcome=="Poor"]) # Inverted the levels: "Poor" are now controls and "Good" cases: roc(aSAH$outcome, aSAH$s100b, levels=c("Poor", "Good")) # The result was exactly the same because of direction="auto". # The following will give an AUC < 0.5: roc(aSAH$outcome, aSAH$s100b, levels=c("Poor", "Good"), direction="<") # If we are sure about levels and direction auto-detection, # we can turn off the messages: roc(aSAH$outcome, aSAH$s100b, quiet = TRUE) # If we prefer counting in percent: roc(aSAH$outcome, aSAH$s100b, percent=TRUE) # Plot and CI (see plot.roc and ci for more options): roc(aSAH$outcome, aSAH$s100b, percent=TRUE, plot=TRUE, ci=TRUE) # Smoothed ROC curve roc(aSAH$outcome, aSAH$s100b, smooth=TRUE) # this is not identical to smooth(roc(aSAH$outcome, aSAH$s100b)) # because in the latter case, the returned object contains no AUC } \keyword{univar} \keyword{nonparametric} \keyword{utilities} \keyword{roc} pROC/man/ci.se.Rd0000644000176200001440000001531314114130125013113 0ustar liggesusers\encoding{UTF-8} \name{ci.se} \alias{ci.se} \alias{ci.se.default} \alias{ci.se.formula} \alias{ci.se.roc} \alias{ci.se.smooth.roc} \title{ Compute the confidence interval of sensitivities at given specificities } \description{ This function computes the confidence interval (CI) of the sensitivity at the given specificity points. By default, the 95\% CI are computed with 2000 stratified bootstrap replicates. } \usage{ # ci.se(...) \S3method{ci.se}{roc}(roc, specificities = seq(0, 1, .1) * ifelse(roc$percent, 100, 1), conf.level=0.95, boot.n=2000, boot.stratified=TRUE, progress=getOption("pROCProgress")$name, parallel=FALSE, ...) \S3method{ci.se}{smooth.roc}(smooth.roc, specificities = seq(0, 1, .1) * ifelse(smooth.roc$percent, 100, 1), conf.level=0.95, boot.n=2000, boot.stratified=TRUE, progress=getOption("pROCProgress")$name, parallel=FALSE, ...) \S3method{ci.se}{formula}(formula, data, ...) \S3method{ci.se}{default}(response, predictor, ...) } \arguments{ \item{roc, smooth.roc}{a \dQuote{roc} object from the \code{\link{roc}} function, or a \dQuote{smooth.roc} object from the \code{\link[=smooth.roc]{smooth}} function. } \item{response, predictor}{arguments for the \code{\link{roc}} function.} \item{formula, data}{a formula (and possibly a data object) of type response~predictor for the \code{\link{roc}} function. } \item{specificities}{on which specificities to evaluate the CI. } \item{conf.level}{the width of the confidence interval as [0,1], never in percent. Default: 0.95, resulting in a 95\% CI. } \item{boot.n}{the number of bootstrap replicates. Default: 2000.} \item{boot.stratified}{should the bootstrap be stratified (default, same number of cases/controls in each replicate than in the original sample) or not. } \item{progress}{the name of progress bar to display. Typically \dQuote{none}, \dQuote{win}, \dQuote{tk} or \dQuote{text} (see the \code{name} argument to \code{\link[plyr]{create_progress_bar}} for more information), but a list as returned by \code{\link[plyr]{create_progress_bar}} is also accepted. See also the \dQuote{Progress bars} section of \link[=pROC-package]{this package's documentation}. } \item{parallel}{if TRUE, the bootstrap is processed in parallel, using parallel backend provided by plyr (foreach). } \item{\dots}{further arguments passed to or from other methods, especially arguments for \code{\link{roc}} and \code{ci.se.roc} when calling \code{ci.se.default} or \code{ci.se.formula}. Arguments for \code{\link{txtProgressBar}} (only \code{char} and \code{style}) if applicable. } } \details{ \code{ci.se.formula} and \code{ci.se.default} are convenience methods that build the ROC curve (with the \code{\link{roc}} function) before calling \code{ci.se.roc}. You can pass them arguments for both \code{\link{roc}} and \code{ci.se.roc}. Simply use \code{ci.se} that will dispatch to the correct method. The \code{ci.se.roc} function creates \code{boot.n} bootstrap replicate of the ROC curve, and evaluates the sensitivity at specificities given by the \code{specificities} argument. Then it computes the confidence interval as the percentiles given by \code{conf.level}. For more details about the bootstrap, see the Bootstrap section in \link[=pROC-package]{this package's documentation}. For \link[=smooth.roc]{smoothed ROC curves}, smoothing is performed again at each bootstrap replicate with the parameters originally provided. If a density smoothing was performed with user-provided \code{density.cases} or \code{density.controls} the bootstrap cannot be performed and an error is issued. } \section{Warnings}{ If \code{boot.stratified=FALSE} and the sample has a large imbalance between cases and controls, it could happen that one or more of the replicates contains no case or control observation, or that there are not enough points for smoothing, producing a \code{NA} area. The warning \dQuote{NA value(s) produced during bootstrap were ignored.} will be issued and the observation will be ignored. If you have a large imbalance in your sample, it could be safer to keep \code{boot.stratified=TRUE}. } \section{Errors}{ If \code{density.cases} and \code{density.controls} were provided for smoothing, the error \dQuote{Cannot compute the statistic on ROC curves smoothed with density.controls and density.cases.} is issued. } \value{ A matrix of class \dQuote{ci.se}, \dQuote{ci} and \dQuote{matrix} (in this order) containing the given sensitivities. Row (names) are the specificities, the first column the lower bound, the 2nd column the median and the 3rd column the upper bound. Additionally, the list has the following attributes: \item{conf.level}{the width of the CI, in fraction.} \item{boot.n}{the number of bootstrap replicates.} \item{boot.stratified}{whether or not the bootstrapping was stratified.} \item{specificities}{the specificities as given in argument.} \item{roc}{the object of class \dQuote{\link{roc}} that was used to compute the CI. } } \references{ James Carpenter and John Bithell (2000) ``Bootstrap condence intervals: when, which, what? A practical guide for medical statisticians''. \emph{Statistics in Medicine} \bold{19}, 1141--1164. DOI: \doi{10.1002/(SICI)1097-0258(20000515)19:9<1141::AID-SIM479>3.0.CO;2-F}. Tom Fawcett (2006) ``An introduction to ROC analysis''. \emph{Pattern Recognition Letters} \bold{27}, 861--874. DOI: \doi{10.1016/j.patrec.2005.10.010}. Xavier Robin, Natacha Turck, Alexandre Hainard, \emph{et al.} (2011) ``pROC: an open-source package for R and S+ to analyze and compare ROC curves''. \emph{BMC Bioinformatics}, \bold{7}, 77. DOI: \doi{10.1186/1471-2105-12-77}. Hadley Wickham (2011) ``The Split-Apply-Combine Strategy for Data Analysis''. \emph{Journal of Statistical Software}, \bold{40}, 1--29. URL: \href{https://www.jstatsoft.org/v40/i01}{www.jstatsoft.org/v40/i01}. } \seealso{ \code{\link{roc}}, \code{\link{ci}}, \code{\link{ci.sp}}, \code{\link{plot.ci}} } \examples{ # Create a ROC curve: data(aSAH) roc1 <- roc(aSAH$outcome, aSAH$s100b) ## Basic example ## \dontrun{ ci.se(roc1)}\dontshow{ci.se(roc1, boot.n = 10)} ## More options ## # Customized bootstrap and specificities: \dontrun{ ci.se(roc1, c(.95, .9, .85), boot.n=10000, conf.level=0.9, stratified=FALSE)}\dontshow{ ci.se(roc1, c(.95, .9, .85), boot.n=10, conf.level=0.9, stratified=FALSE)} ## Plotting the CI ## ci1 <- ci.se(roc1, boot.n = 10) plot(roc1) plot(ci1) ## On smoothed ROC curves with bootstrap ## \dontrun{ ci.se(smooth(roc1, method="density"))}\dontshow{ ci.se(smooth(roc1, method="density"), boot.n = 10)} } \keyword{univar} \keyword{nonparametric} \keyword{utilities} \keyword{roc} pROC/man/auc.Rd0000644000176200001440000001725514114130125012671 0ustar liggesusers\encoding{UTF-8} \name{auc} \alias{auc} \alias{auc.default} \alias{auc.formula} \alias{auc.roc} \alias{auc.smooth.roc} \alias{auc.multiclass.roc} \title{ Compute the area under the ROC curve } \description{ This function computes the numeric value of area under the ROC curve (AUC) with the trapezoidal rule. Two syntaxes are possible: one object of class \dQuote{\link{roc}}, or either two vectors (response, predictor) or a formula (response~predictor) as in the \code{\link{roc}} function. By default, the total AUC is computed, but a portion of the ROC curve can be specified with \code{partial.auc}. } \usage{ auc(...) \S3method{auc}{roc}(roc, partial.auc=FALSE, partial.auc.focus=c("specificity", "sensitivity"), partial.auc.correct=FALSE, allow.invalid.partial.auc.correct = FALSE, ...) \S3method{auc}{smooth.roc}(smooth.roc, ...) \S3method{auc}{multiclass.roc}(multiclass.roc, ...) \S3method{auc}{formula}(formula, data, ...) \S3method{auc}{default}(response, predictor, ...) } \arguments{ \item{roc, smooth.roc, multiclass.roc}{a \dQuote{roc} object from the \code{\link{roc}} function, a \dQuote{smooth.roc} object from the \code{\link[=smooth.roc]{smooth}} function, or a \dQuote{multiclass.roc} or \dQuote{mv.multiclass.roc} from the \code{\link{multiclass.roc}} function. } \item{response, predictor}{arguments for the \code{\link{roc}} function.} \item{formula, data}{a formula (and possibly a data object) of type response~predictor for the \code{\link{roc}} function.} \item{partial.auc}{either \code{FALSE} (default: consider total area) or a numeric vector of length 2: boundaries of the AUC to consider in [0,1] (or [0,100] if percent is \code{TRUE}). } \item{partial.auc.focus}{if \code{partial.auc} is not \code{FALSE} and a partial AUC is computed, specifies if \code{partial.auc} specifies the bounds in terms of specificity (default) or sensitivity. Can be shortened to spec/sens or even sp/se. Ignored if \code{partial.auc=FALSE}. } \item{partial.auc.correct}{logical indicating if the correction of AUC must be applied in order to have a maximal AUC of 1.0 and a non-discriminant AUC of 0.5 whatever the \code{partial.auc} defined. Ignored if \code{partial.auc=FALSE}. Default: \code{FALSE}. } \item{allow.invalid.partial.auc.correct}{logical indicating if the correction must return \code{NA} (with a \code{\link{warning}}) when attempting to correct a pAUC below the diagonal. Set to \code{TRUE} to return a (probably invalid) corrected AUC. This is useful especially to avoid introducing a bias against low pAUCs in bootstrap operations.} \item{\dots}{further arguments passed to or from other methods, especially arguments for \code{\link{roc}} when calling \code{auc.default}, \code{auc.formula}, \code{auc.smooth.roc}. Note that the \code{auc} argument of \code{\link{roc}} is not allowed. Unused in \code{auc.roc}. } } \details{ This function is typically called from \code{\link{roc}} when \code{auc=TRUE} (default). It is also used by \code{\link{ci}}. When it is called with two vectors (response, predictor) or a formula (response~predictor) arguments, the \code{\link{roc}} function is called and only the AUC is returned. By default the total area under the curve is computed, but a partial AUC (pAUC) can be specified with the \code{partial.auc} argument. It specifies the bounds of specificity or sensitivity (depending on \code{partial.auc.focus}) between which the AUC will be computed. As it specifies specificities or sensitivities, you must adapt it in relation to the 'percent' specification (see details in \code{\link{roc}}). \code{partial.auc.focus} is ignored if \code{partial.auc=FALSE} (default). If a partial AUC is computed, \code{partial.auc.focus} specifies if the bounds specified in \code{partial.auc} must be interpreted as sensitivity or specificity. Any other value will produce an error. It is recommended to \code{\link[=plot.roc]{plot}} the ROC curve with \code{auc.polygon=TRUE} in order to make sure the specification is correct. If a pAUC is defined, it can be standardized (corrected). This correction is controled by the \code{partial.auc.correct} argument. If \code{partial.auc.correct=TRUE}, the correction by McClish will be applied: \deqn{\frac{1+\frac{auc-min}{max-min}}{2}}{(1+(auc-min)/(max-min))/2} where auc is the uncorrected pAUC computed in the region defined by \code{partial.auc}, min is the value of the non-discriminant AUC (with an AUC of 0.5 or 50%) in the region and max is the maximum possible AUC in the region. With this correction, the AUC will be 0.5 if non discriminant and 1.0 if maximal, whatever the region defined. This correction is fully compatible with \code{percent}. Note that this correction is undefined for curves below the diagonal (auc < min). Attempting to correct such an AUC will return \code{NA} with a warning. } \section{Smoothed ROC curves}{ There is no difference in the computation of the area under a smoothed ROC curve, except for curves smoothed with \code{method="binomial"}. In this case and only if a full AUC is requested, the classical binormal AUC formula is applied: \deqn{auc=\phi\frac{a}{\sqrt{1 + b^2}}.}{pnorm(a/sqrt(1+b^2).} If the ROC curve is smoothed with any other \code{method} or if a partial AUC is requested, the empirical AUC described in the previous section is applied. } \section{Multi-class AUCs}{ With an object of class \dQuote{multiclass.roc}, a multi-class AUC is computed as an average AUC as defined by Hand and Till (equation 7). \deqn{auc=\frac{2}{c(c-1)}\sum{aucs}}{2/(count * (count - 1))*sum(aucs)} with aucs all the pairwise roc curves. } \value{ The numeric AUC value, of class \code{c("auc", "numeric")} (or \code{c("multiclass.auc", "numeric")} or \code{c("mv.multiclass.auc", "numeric")} if a \dQuote{multiclass.roc} was supplied), in fraction of the area or in percent if \code{percent=TRUE}, with the following attributes: \item{partial.auc}{if the AUC is full (FALSE) or partial (and in this case the bounds), as defined in argument.} \item{partial.auc.focus}{only for a partial AUC, if the bound specifies the sensitivity or specificity, as defined in argument.} \item{partial.auc.correct}{only for a partial AUC, was it corrected? As defined in argument.} \item{percent}{whether the AUC is given in percent or fraction.} \item{roc}{the original ROC curve, as a \dQuote{\link{roc}}, \dQuote{\link{smooth.roc}} or \dQuote{\link{multiclass.roc}} object.} } \references{ Tom Fawcett (2006) ``An introduction to ROC analysis''. \emph{Pattern Recognition Letters} \bold{27}, 861--874. DOI: \doi{10.1016/j.patrec.2005.10.010}. David J. Hand and Robert J. Till (2001). A Simple Generalisation of the Area Under the ROC Curve for Multiple Class Classification Problems. \emph{Machine Learning} \bold{45}(2), p. 171--186. DOI: \doi{10.1023/A:1010920819831}. Donna Katzman McClish (1989) ``Analyzing a Portion of the ROC Curve''. \emph{Medical Decision Making} \bold{9}(3), 190--195. DOI: \doi{10.1177/0272989X8900900307}. Xavier Robin, Natacha Turck, Alexandre Hainard, \emph{et al.} (2011) ``pROC: an open-source package for R and S+ to analyze and compare ROC curves''. \emph{BMC Bioinformatics}, \bold{7}, 77. DOI: \doi{10.1186/1471-2105-12-77}. } \seealso{ \code{\link{roc}}, \code{\link{ci.auc}} } \examples{ # Create a ROC curve: data(aSAH) roc.s100b <- roc(aSAH$outcome, aSAH$s100b) # Get the full AUC auc(roc.s100b) # Get the partial AUC: auc(roc.s100b, partial.auc=c(1, .8), partial.auc.focus="se", partial.auc.correct=TRUE) } \keyword{univar} \keyword{nonparametric} \keyword{utilities} \keyword{roc} pROC/man/ggroc.Rd0000644000176200001440000000600714114130125013213 0ustar liggesusers\encoding{UTF-8} \name{ggroc.roc} \alias{ggroc.roc} \alias{ggroc.smooth.roc} \alias{ggroc.list} \alias{ggroc} \title{ Plot a ROC curve with ggplot2 } \description{ This function plots a ROC curve with ggplot2. } \usage{ \S3method{ggroc}{roc}(data, legacy.axes = FALSE, ...) \S3method{ggroc}{smooth.roc}(data, legacy.axes = FALSE, ...) \S3method{ggroc}{list}(data, aes = c("colour", "alpha", "linetype", "size", "group"), legacy.axes = FALSE, ...) } \arguments{ \item{data}{a roc object from the \link{roc} function, or a list of roc objects. } \item{aes}{the name(s) of the aesthetics for \code{\link[ggplot2:geom_path]{geom_line}} to map to the different ROC curves supplied. Use \dQuote{group} if you want the curves to appear with the same aestetic, for instance if you are faceting instead. } \item{legacy.axes}{a logical indicating if the specificity axis (x axis) must be plotted as as decreasing \dQuote{specificity} (\code{FALSE}, the default) or increasing \dQuote{1 - specificity} (\code{TRUE}) as in most legacy software. } \item{...}{additional aesthetics for \code{\link[ggplot2:geom_path]{geom_line}} to set: \code{alpha}, \code{colour}, \code{linetype} and \code{size}. } } \details{ This function initializes a ggplot object from a ROC curve (or multiple if a list is passed). It returns the ggplot with a line layer on it. You can print it directly or add your own layers and theme elements. } \seealso{ \code{\link{roc}}, \code{\link{plot.roc}}, \pkg{\link[ggplot2:ggplot2-package]{ggplot2}} } \examples{ # Create a basic roc object data(aSAH) rocobj <- roc(aSAH$outcome, aSAH$s100b) rocobj2 <- roc(aSAH$outcome, aSAH$wfns) if (require(ggplot2)) { g <- ggroc(rocobj) g # with additional aesthetics: ggroc(rocobj, alpha = 0.5, colour = "red", linetype = 2, size = 2) # You can then your own theme, etc. g + theme_minimal() + ggtitle("My ROC curve") + geom_segment(aes(x = 1, xend = 0, y = 0, yend = 1), color="grey", linetype="dashed") # And change axis labels to FPR/FPR gl <- ggroc(rocobj, legacy.axes = TRUE) gl gl + xlab("FPR") + ylab("TPR") + geom_segment(aes(x = 0, xend = 1, y = 0, yend = 1), color="darkgrey", linetype="dashed") # Multiple curves: g2 <- ggroc(list(s100b=rocobj, wfns=rocobj2, ndka=roc(aSAH$outcome, aSAH$ndka))) g2 # This is equivalent to using roc.formula: roc.list <- roc(outcome ~ s100b + ndka + wfns, data = aSAH) g.list <- ggroc(roc.list) g.list # You can change the aesthetics as you normally would with ggplot2: g.list + scale_colour_brewer(palette="RdGy") g.list + scale_colour_manual(values = c("red", "blue", "black")) # with additional aesthetics: g3 <- ggroc(roc.list, linetype=2) g3 g4 <- ggroc(roc.list, aes="linetype", color="red") g4 # changing multiple aesthetics: g5 <- ggroc(roc.list, aes=c("linetype", "color")) g5 # OR faceting g.list + facet_grid(.~name) + theme(legend.position="none") # To have all the curves of the same color, use aes="group": g.group <- ggroc(roc.list, aes="group") g.group g.group + facet_grid(.~name) } } pROC/man/ci.auc.Rd0000644000176200001440000002431414114130125013255 0ustar liggesusers\encoding{UTF-8} \name{ci.auc} \alias{ci.auc} \alias{ci.auc.auc} \alias{ci.auc.default} \alias{ci.auc.formula} \alias{ci.auc.roc} \alias{ci.auc.smooth.roc} \alias{ci.auc.multiclass.roc} \alias{ci.auc.multiclass.auc} \title{ Compute the confidence interval of the AUC } \description{ This function computes the confidence interval (CI) of an area under the curve (AUC). By default, the 95\% CI is computed with 2000 stratified bootstrap replicates. } \usage{ # ci.auc(...) \S3method{ci.auc}{roc}(roc, conf.level=0.95, method=c("delong", "bootstrap"), boot.n = 2000, boot.stratified = TRUE, reuse.auc=TRUE, progress = getOption("pROCProgress")$name, parallel=FALSE, ...) \S3method{ci.auc}{smooth.roc}(smooth.roc, conf.level=0.95, boot.n=2000, boot.stratified=TRUE, reuse.auc=TRUE, progress=getOption("pROCProgress")$name, parallel=FALSE, ...) \S3method{ci.auc}{auc}(auc, ...) \S3method{ci.auc}{multiclass.roc}(multiclass.roc, ...) \S3method{ci.auc}{multiclass.auc}(multiclass.auc, ...) \S3method{ci.auc}{auc}(auc, ...) \S3method{ci.auc}{formula}(formula, data, ...) \S3method{ci.auc}{default}(response, predictor, ...) } \arguments{ \item{roc, smooth.roc}{a \dQuote{roc} object from the \code{\link{roc}} function, or a \dQuote{smooth.roc} object from the \code{\link[=smooth.roc]{smooth}} function. } \item{auc}{an \dQuote{auc} object from the \code{\link{auc}} function.} \item{multiclass.roc, multiclass.auc}{not implemented.} \item{response, predictor}{arguments for the \code{\link{roc}} function.} \item{formula, data}{a formula (and possibly a data object) of type response~predictor for the \code{\link{roc}} function. } \item{conf.level}{the width of the confidence interval as [0,1], never in percent. Default: 0.95, resulting in a 95\% CI. } \item{method}{the method to use, either \dQuote{delong} or \dQuote{bootstrap}. The first letter is sufficient. If omitted, the appropriate method is selected as explained in details. } \item{boot.n}{the number of bootstrap replicates. Default: 2000.} \item{boot.stratified}{should the bootstrap be stratified (default, same number of cases/controls in each replicate than in the original sample) or not. } \item{reuse.auc}{if \code{TRUE} (default) and the \dQuote{roc} object contains an \dQuote{auc} field, re-use these specifications for the test. If false, use optional \code{\dots} arguments to \code{\link{auc}}. See details. } \item{progress}{the name of progress bar to display. Typically \dQuote{none}, \dQuote{win}, \dQuote{tk} or \dQuote{text} (see the \code{name} argument to \code{\link[plyr]{create_progress_bar}} for more information), but a list as returned by \code{\link[plyr]{create_progress_bar}} is also accepted. See also the \dQuote{Progress bars} section of \link[=pROC-package]{this package's documentation}. } \item{parallel}{if TRUE, the bootstrap is processed in parallel, using parallel backend provided by plyr (foreach). } \item{\dots}{further arguments passed to or from other methods, especially arguments for \code{\link{roc}} and \code{roc.test.roc} when calling \code{roc.test.default} or \code{roc.test.formula}. Arguments for \code{\link{auc}} and \code{\link{txtProgressBar}} (only \code{char} and \code{style}) if applicable. } } \details{ This function computes the CI of an AUC. Two methods are available: \dQuote{delong} and \dQuote{bootstrap} with the parameters defined in \dQuote{roc$auc} to compute a CI. When it is called with two vectors (response, predictor) or a formula (response~predictor) arguments, the \code{\link{roc}} function is called to build the ROC curve first. The default is to use \dQuote{delong} method except for comparison of partial AUC and smoothed curves, where \code{bootstrap} is used. Using \dQuote{delong} for partial AUC and smoothed ROCs is not supported. With \code{method="bootstrap"}, the function calls \code{\link{auc}} \code{boot.n} times. For more details about the bootstrap, see the Bootstrap section in \link[=pROC-package]{this package's documentation}. For \link[=smooth.roc]{smoothed ROC curves}, smoothing is performed again at each bootstrap replicate with the parameters originally provided. If a density smoothing was performed with user-provided \code{density.cases} or \code{density.controls} the bootstrap cannot be performed and an error is issued. With \code{method="delong"}, the variance of the AUC is computed as defined by DeLong \emph{et al.} (1988) using the algorithm by Sun and Xu (2014) and the CI is deduced with \code{\link{qnorm}}. CI of multiclass ROC curves and AUC is not implemented yet. Attempting to call these methods returns an error. } \section{AUC specification}{ The comparison of the CI needs a specification of the AUC. This allows to compute the CI for full or partial AUCs. The specification is defined by: \enumerate{ \item the \dQuote{auc} field in the \dQuote{\link{roc}} object if \code{reuse.auc} is set to \code{TRUE} (default). It is naturally inherited from any call to \code{\link{roc}} and fits most cases. \item passing the specification to \code{\link{auc}} with \dots (arguments \code{partial.auc}, \code{partial.auc.correct} and \code{partial.auc.focus}). In this case, you must ensure either that the \code{\link{roc}} object do not contain an \code{auc} field (if you called \code{\link{roc}} with \code{auc=FALSE}), or set \code{reuse.auc=FALSE}. } If \code{reuse.auc=FALSE} the \code{\link{auc}} function will always be called with \code{\dots} to determine the specification, even if the \dQuote{\link{roc}} object do contain an \code{auc} field. As well if the \dQuote{\link{roc}} object do not contain an \code{auc} field, the \code{\link{auc}} function will always be called with \code{\dots} to determine the specification. Warning: if the roc object passed to ci contains an \code{auc} field and \code{reuse.auc=TRUE}, \link{auc} is not called and arguments such as \code{partial.auc} are silently ignored. } \section{Warnings}{ If \code{method="delong"} and the AUC specification specifies a partial AUC, the warning \dQuote{Using DeLong's test for partial AUC is not supported. Using bootstrap test instead.} is issued. The \code{method} argument is ignored and \dQuote{bootstrap} is used instead. If \code{boot.stratified=FALSE} and the sample has a large imbalance between cases and controls, it could happen that one or more of the replicates contains no case or control observation, or that there are not enough points for smoothing, producing a \code{NA} area. The warning \dQuote{NA value(s) produced during bootstrap were ignored.} will be issued and the observation will be ignored. If you have a large imbalance in your sample, it could be safer to keep \code{boot.stratified=TRUE}. } \section{Errors}{ If \code{density.cases} and \code{density.controls} were provided for smoothing, the error \dQuote{Cannot compute the statistic on ROC curves smoothed with density.controls and density.cases.} is issued. } \value{ A numeric vector of length 3 and class \dQuote{ci.auc}, \dQuote{ci} and \dQuote{numeric} (in this order), with the lower bound, the median and the upper bound of the CI, and the following attributes: \item{conf.level}{the width of the CI, in fraction.} \item{method}{the method employed.} \item{boot.n}{the number of bootstrap replicates.} \item{boot.stratified}{whether or not the bootstrapping was stratified.} \item{auc}{an object of class \dQuote{\link{auc}} stored for reference about the compued AUC details (partial, percent, ...)} The \code{aucs} item is not included in this list since version 1.2 for consistency reasons. } \references{ James Carpenter and John Bithell (2000) ``Bootstrap condence intervals: when, which, what? A practical guide for medical statisticians''. \emph{Statistics in Medicine} \bold{19}, 1141--1164. DOI: \doi{10.1002/(SICI)1097-0258(20000515)19:9<1141::AID-SIM479>3.0.CO;2-F}. Elisabeth R. DeLong, David M. DeLong and Daniel L. Clarke-Pearson (1988) ``Comparing the areas under two or more correlated receiver operating characteristic curves: a nonparametric approach''. \emph{Biometrics} \bold{44}, 837--845. Xu Sun and Weichao Xu (2014) ``Fast Implementation of DeLongs Algorithm for Comparing the Areas Under Correlated Receiver Operating Characteristic Curves''. \emph{IEEE Signal Processing Letters}, \bold{21}, 1389--1393. DOI: \doi{10.1109/LSP.2014.2337313}. Xavier Robin, Natacha Turck, Alexandre Hainard, \emph{et al.} (2011) ``pROC: an open-source package for R and S+ to analyze and compare ROC curves''. \emph{BMC Bioinformatics}, \bold{7}, 77. DOI: \doi{10.1186/1471-2105-12-77}. Hadley Wickham (2011) ``The Split-Apply-Combine Strategy for Data Analysis''. \emph{Journal of Statistical Software}, \bold{40}, 1--29. URL: \href{https://www.jstatsoft.org/v40/i01}{www.jstatsoft.org/v40/i01}. } \seealso{ \code{\link{roc}}, \code{\link{auc}}, \code{\link{ci}} } \examples{ # Create a ROC curve: data(aSAH) roc1 <- roc(aSAH$outcome, aSAH$s100b) ## Basic example ## ci.auc(roc1) # You can also write: ci(roc1) ci(auc(roc1)) ## More options ## # Partial AUC and customized bootstrap: \dontrun{ ci.auc(roc1, conf.level=0.9, partial.auc=c(1, .8), partial.auc.focus="se", partial.auc.correct=TRUE, boot.n=10000, stratified=FALSE)}\dontshow{ ci.auc(roc1, conf.level=0.9, partial.auc=c(1, .8), partial.auc.focus="se", partial.auc.correct=TRUE, boot.n=10, stratified=FALSE)} # Note that the following will NOT give a CI of the partial AUC: \dontrun{ ci.auc(roc1, partial.auc=c(1, .8), partial.auc.focus="se", partial.auc.correct=FALSE)} # This is because rocobj$auc is not a partial AUC and reuse.auc = TRUE by default. # You can overcome this problem by passing an AUC instead: auc1 <- auc(roc1, partial.auc=c(1, .8), partial.auc.focus="se", partial.auc.correct=FALSE) \dontrun{ ci.auc(auc1)}\dontshow{ci.auc(auc1, boot.n = 10)} ## On smoothed ROC curves with bootstrap ## \dontrun{ ci.auc(smooth(roc1, method="density"))}\dontshow{ ci.auc(smooth(roc1, method="density"), boot.n = 10)} } \keyword{univar} \keyword{nonparametric} \keyword{utilities} \keyword{roc} pROC/man/are.paired.Rd0000644000176200001440000000573313607143106014142 0ustar liggesusers\encoding{UTF-8} \name{are.paired} \alias{are.paired} \alias{are.paired.smooth.roc} \alias{are.paired.auc} \alias{are.paired.roc} \title{ Are two ROC curves paired? } \description{ This function determines if two ROC curves can be paired. } \usage{ are.paired(...) \S3method{are.paired}{auc}(roc1, roc2, ...) \S3method{are.paired}{smooth.roc}(roc1, roc2, ...) \S3method{are.paired}{roc}(roc1, roc2, return.paired.rocs=FALSE, reuse.auc = TRUE, reuse.ci = FALSE, reuse.smooth=TRUE, ...) } \arguments{ \item{roc1, roc2}{the two ROC curves to compare. Either \dQuote{\link{roc}}, \dQuote{\link{auc}} or \dQuote{\link{smooth.roc}} objects (types can be mixed). } \item{return.paired.rocs}{if \code{TRUE} and the ROC curves can be paired, the two paired ROC curves with \code{NA}s removed will be returned. } \item{reuse.auc, reuse.ci, reuse.smooth}{ if \code{return.paired.rocs=TRUE}, determines if \code{\link{auc}}, \code{\link{ci}} and \code{\link[=smooth.roc]{smooth}} should be re-computed (with the same parameters than the original ROC curves) } \item{\dots}{additionnal arguments for \code{are.paired.roc}. Ignored in \code{are.paired.roc} } } \details{ Two ROC curves are paired if they are built on two variables observed on the same sample. In practice, the paired status is granted if the \code{response} and \code{levels} vector of both ROC curves are \link{identical}. If the \code{response}s are different, this can be due to missing values differing between the curves. In this case, the function will strip all \code{NA}s in both curves and check for identity again. It can raise false positives if the responses are identical but correspond to different patients. } \value{ \code{TRUE} if \code{roc1} and \code{roc2} are paired, \code{FALSE} otherwise. In addition, if \code{TRUE} and \code{return.paired.rocs=TRUE}, the following atributes are defined: \item{roc1, roc2}{the two ROC curve with all \code{NA}s values removed in both curves. } } \seealso{ \code{\link{roc}}, \code{\link{roc.test}} } \examples{ data(aSAH) aSAH.copy <- aSAH # artificially insert NAs for demonstration purposes aSAH.copy$outcome[42] <- NA aSAH.copy$s100b[24] <- NA aSAH.copy$ndka[1:10] <- NA # Call roc() on the whole data roc1 <- roc(aSAH.copy$outcome, aSAH.copy$s100b) roc2 <- roc(aSAH.copy$outcome, aSAH.copy$ndka) # are.paired can still find that the curves were paired are.paired(roc1, roc2) # TRUE # Removing the NAs manually before passing to roc() un-pairs the ROC curves nas <- is.na(aSAH.copy$outcome) | is.na(aSAH.copy$ndka) roc2b <- roc(aSAH.copy$outcome[!nas], aSAH.copy$ndka[!nas]) are.paired(roc1, roc2b) # FALSE # Getting the two paired ROC curves with additional smoothing and ci options roc2$ci <- ci(roc2) paired <- are.paired(smooth(roc1), roc2, return.paired.rocs=TRUE, reuse.ci=TRUE) paired.roc1 <- attr(paired, "roc1") paired.roc2 <- attr(paired, "roc2") } \keyword{programming} \keyword{logic} \keyword{roc} pROC/man/has.partial.auc.Rd0000644000176200001440000000214113607143106015073 0ustar liggesusers\encoding{UTF-8} \name{has.partial.auc} \alias{has.partial.auc} \alias{has.partial.auc.smooth.roc} \alias{has.partial.auc.auc} \alias{has.partial.auc.roc} \title{ Does the ROC curve have a partial AUC? } \description{ This function determines if the ROC curve has a partial AUC. } \usage{ has.partial.auc(roc) \S3method{has.partial.auc}{auc}(roc) \S3method{has.partial.auc}{smooth.roc}(roc) \S3method{has.partial.auc}{roc}(roc) } \arguments{ \item{roc}{the ROC curve to check.} } \value{ \code{TRUE} if the AUC is a partial AUC, \code{FALSE} otherwise. If the AUC is not defined (i. e. if roc was called with \code{AUC=FALSE}), returns \code{NULL}. } \seealso{ \code{\link{auc}} } \examples{ data(aSAH) # Full AUC roc1 <- roc(aSAH$outcome, aSAH$s100b) has.partial.auc(roc1) has.partial.auc(auc(roc1)) has.partial.auc(smooth(roc1)) # Partial AUC roc2 <- roc(aSAH$outcome, aSAH$s100b, partial.auc = c(1, 0.9)) has.partial.auc(roc2) has.partial.auc(smooth(roc2)) # No AUC roc3 <- roc(aSAH$outcome, aSAH$s100b, auc = FALSE) has.partial.auc(roc3) } \keyword{programming} \keyword{logic} \keyword{roc} pROC/man/cov.Rd0000644000176200001440000003260114114130125012700 0ustar liggesusers\encoding{UTF-8} \name{cov.roc} \alias{cov} \alias{cov.default} \alias{cov.auc} \alias{cov.smooth.roc} \alias{cov.roc} \title{ Covariance of two paired ROC curves } \description{ This function computes the covariance between the AUC of two correlated (or paired) ROC curves. } \usage{ cov(...) \S3method{cov}{default}(...) \S3method{cov}{auc}(roc1, roc2, ...) \S3method{cov}{smooth.roc}(roc1, roc2, ...) \S3method{cov}{roc}(roc1, roc2, method=c("delong", "bootstrap", "obuchowski"), reuse.auc=TRUE, boot.n=2000, boot.stratified=TRUE, boot.return=FALSE, progress=getOption("pROCProgress")$name, parallel=FALSE, ...) } \arguments{ \item{roc1, roc2}{the two ROC curves on which to compute the covariance. Either \dQuote{\link{roc}}, \dQuote{\link{auc}} or \dQuote{\link{smooth.roc}} objects (types can be mixed as long as the original ROC curve are paired). } \item{method}{the method to use, either \dQuote{delong} or \dQuote{bootstrap}. The first letter is sufficient. If omitted, the appropriate method is selected as explained in details. } \item{reuse.auc}{if \code{TRUE} (default) and the \dQuote{roc} objects contain an \dQuote{auc} field, re-use these specifications for the test. See details. } \item{boot.n}{for \code{method="bootstrap"} only: the number of bootstrap replicates or permutations. Default: \var{2000}. } \item{boot.stratified}{for \code{method="bootstrap"} only: should the bootstrap be stratified (same number of cases/controls in each replicate than in the original sample) or not. Default: \var{TRUE}. } \item{boot.return}{ if \var{TRUE} and \code{method="bootstrap"}, also return the bootstrapped values. See the \dQuote{Value} section for more details. } \item{progress}{the name of progress bar to display. Typically \dQuote{none}, \dQuote{win}, \dQuote{tk} or \dQuote{text} (see the \code{name} argument to \code{\link[plyr]{create_progress_bar}} for more information), but a list as returned by \code{\link[plyr]{create_progress_bar}} is also accepted. See also the \dQuote{Progress bars} section of \link[=pROC-package]{this package's documentation}. } \item{parallel}{if TRUE, the bootstrap is processed in parallel, using parallel backend provided by plyr (foreach). } \item{\dots}{further arguments passed to or from other methods, especially arguments for \code{cov.roc} when calling \code{cov}, \code{cov.auc} or \code{cov.smooth.roc}. Arguments for \code{\link{auc}} (if \code{reuse.auc=FALSE}) and \code{\link{txtProgressBar}} (only \code{char} and \code{style}) if applicable. } } \details{ This function computes the covariance between the AUC of two correlated (or paired, according to the detection of \code{\link{are.paired}}) ROC curves. It is typically called with the two \link{roc} objects of interest. Two methods are available: \dQuote{delong} and \dQuote{bootstrap} (see \dQuote{Computational details} section below). The default is to use \dQuote{delong} method except with partial AUC and smoothed curves where \dQuote{bootstrap} is employed. Using \dQuote{delong} for partial AUC and smoothed ROCs is not supported. For \link[=smooth.roc]{smoothed ROC curves}, smoothing is performed again at each bootstrap replicate with the parameters originally provided. If a density smoothing was performed with user-provided \code{density.cases} or \code{density.controls} the bootstrap cannot be performed and an error is issued. \code{cov.default} forces the usage of the \code{\link[stats:cor]{cov}} function in the \pkg{stats} package, so that other code relying on \code{cov} should continue to function normally. } \section{AUC specification}{ To compute the covariance of the AUC of the ROC curves, \code{cov} needs a specification of the AUC. The specification is defined by: \enumerate{ \item the \dQuote{auc} field in the \dQuote{\link{roc}} objects if \code{reuse.auc} is set to \code{TRUE} (default) \item passing the specification to \code{\link{auc}} with \dots (arguments \code{partial.auc}, \code{partial.auc.correct} and \code{partial.auc.focus}). In this case, you must ensure either that the \code{\link{roc}} object do not contain an \code{auc} field (if you called \code{\link{roc}} with \code{auc=FALSE}), or set \code{reuse.auc=FALSE}. } If \code{reuse.auc=FALSE} the \code{\link{auc}} function will always be called with \code{\dots} to determine the specification, even if the \dQuote{\link{roc}} objects do contain an \code{auc} field. As well if the \dQuote{\link{roc}} objects do not contain an \code{auc} field, the \code{\link{auc}} function will always be called with \code{\dots} to determine the specification. Warning: if the roc object passed to roc.test contains an \code{auc} field and \code{reuse.auc=TRUE}, \link{auc} is not called and arguments such as \code{partial.auc} are silently ignored. } \section{Computation details}{ With \code{method="bootstrap"}, the processing is done as follow: \enumerate{ \item \code{boot.n} bootstrap replicates are drawn from the data. If \code{boot.stratified} is \var{TRUE}, each replicate contains exactly the same number of controls and cases than the original sample, otherwise if \var{FALSE} the numbers can vary. \item for each bootstrap replicate, the AUC of the two ROC curves are computed and stored. \item the variance (as per \code{\link{var.roc}}) of the resampled AUCs and their covariance are assessed in a single bootstrap pass. \item The following formula is used to compute the final covariance: \eqn{Var[AUC1] + Var[AUC2] - 2cov[AUC1,AUC2]} } With \code{method="delong"}, the processing is done as described in Hanley and Hajian-Tilaki (1997) using the algorithm by Sun and Xu (2014). With \code{method="obuchowski"}, the processing is done as described in Obuchowski and McClish (1997), Table 1 and Equation 5, p. 1531. The computation of \eqn{g} for partial area under the ROC curve is modified as: \deqn{expr1 * (2 * pi * expr2) ^ {(-1)} * (-expr4) - A * B * expr1 * (2 * pi * expr2^3) ^ {(-1/2)} * expr3}. } \section{Binormality assumption}{ The \dQuote{obuchowski} method makes the assumption that the data is binormal. If the data shows a deviation from this assumption, it might help to normalize the data first (that is, before calling \code{\link{roc}}), for example with quantile normalization: \preformatted{ norm.x <- qnorm(rank(x)/(length(x)+1)) cov(roc(response, norm.x, ...), ...) } \dQuote{delong} and \dQuote{bootstrap} methods make no such assumption. } \value{ The numeric value of the covariance. If \code{boot.return=TRUE} and \code{method="bootstrap"}, an attribute \code{resampled.values} is set with the resampled (bootstrapped) values. It contains a matrix with the columns representing the two ROC curves, and the rows the \code{boot.n} bootstrap replicates. } \section{Errors}{ If \code{density.cases} and \code{density.controls} were provided for smoothing, the error \dQuote{Cannot compute the covariance on ROC curves smoothed with density.controls and density.cases.} is issued. } \section{Warnings}{ If \dQuote{auc} specifications are different in both roc objects, the warning \dQuote{Different AUC specifications in the ROC curves. Enforcing the inconsistency, but unexpected results may be produced.} is issued. Unexpected results may be produced. If one or both ROC curves are \dQuote{smooth.roc} objects with different smoothing specifications, the warning \dQuote{Different smoothing parameters in the ROC curves. Enforcing the inconsistency, but unexpected results may be produced.} is issued. This warning can be benign, especially if ROC curves were generated with \code{roc(\ldots, smooth=TRUE)} with different arguments to other functions (such as plot), or if you really want to compare two ROC curves smoothed differently. If \code{method="delong"} and the AUC specification specifies a partial AUC, the warning \dQuote{Using DeLong for partial AUC is not supported. Using bootstrap test instead.} is issued. The \code{method} argument is ignored and \dQuote{bootstrap} is used instead. If \code{method="delong"} and the ROC curve is smoothed, the warning \dQuote{Using DeLong for smoothed ROCs is not supported. Using bootstrap instead.} is issued. The \code{method} argument is ignored and \dQuote{bootstrap} is used instead. DeLong ignores the direction of the ROC curve so that if two ROC curves have a different \code{direction}, the warning \dQuote{"DeLong should not be applied to ROC curves with a different direction."} is printed. However, the spurious computation is enforced. If \code{boot.stratified=FALSE} and the sample has a large imbalance between cases and controls, it could happen that one or more of the replicates contains no case or control observation, or that there are not enough points for smoothing, producing a \code{NA} area. The warning \dQuote{NA value(s) produced during bootstrap were ignored.} will be issued and the observation will be ignored. If you have a large imbalance in your sample, it could be safer to keep \code{boot.stratified=TRUE}. When both ROC curves have an \code{\link{auc}} of 1 (or 100\%), their covariance will always be null. This is true for both \dQuote{delong} and \dQuote{bootstrap} and methods. This result is misleading, as the covariance is of course not null. A \code{\link{warning}} will be displayed to inform of this condition, and of the misleading output. } \section{Messages}{ The covariance can only be computed on paired data. This assumption is enforced by \code{\link{are.paired}}. If the ROC curves are not paired, the covariance is \code{0} and the message \dQuote{ROC curves are unpaired.} is printed. If your ROC curves are paired, make sure they fit \code{\link{are.paired}} criteria. } \references{ Elisabeth R. DeLong, David M. DeLong and Daniel L. Clarke-Pearson (1988) ``Comparing the areas under two or more correlated receiver operating characteristic curves: a nonparametric approach''. \emph{Biometrics} \bold{44}, 837--845. James A. Hanley and Karim O. Hajian-Tilaki (1997) ``Sampling variability of nonparametric estimates of the areas under receiver operating characteristic curves: An update''. \emph{Academic Radiology} \bold{4}, 49--58. DOI: \doi{10.1016/S1076-6332(97)80161-4}. Nancy A. Obuchowski, Donna K. McClish (1997). ``Sample size determination for diagnostic accurary studies involving binormal ROC curve indices''. \emph{Statistics in Medicine}, \bold{16}(13), 1529--1542. DOI: \doi{10.1002/(SICI)1097-0258(19970715)16:13<1529::AID-SIM565>3.0.CO;2-H}. Xu Sun and Weichao Xu (2014) ``Fast Implementation of DeLongs Algorithm for Comparing the Areas Under Correlated Receiver Operating Characteristic Curves''. \emph{IEEE Signal Processing Letters}, \bold{21}, 1389--1393. DOI: \doi{10.1109/LSP.2014.2337313}. Hadley Wickham (2011) ``The Split-Apply-Combine Strategy for Data Analysis''. \emph{Journal of Statistical Software}, \bold{40}, 1--29. URL: \href{https://www.jstatsoft.org/v40/i01}{www.jstatsoft.org/v40/i01}. } \seealso{ \code{\link{roc}}, \code{\link{var.roc}} CRAN package \pkg{plyr}, employed in this function. } \examples{ data(aSAH) # Basic example with 2 roc objects roc1 <- roc(aSAH$outcome, aSAH$s100b) roc2 <- roc(aSAH$outcome, aSAH$wfns) cov(roc1, roc2) \dontrun{ # The latter used Delong. To use bootstrap: cov(roc1, roc2, method="bootstrap") # Decrease boot.n for a faster execution: cov(roc1, roc2, method="bootstrap", boot.n=1000) } # To use Obuchowski: cov(roc1, roc2, method="obuchowski") \dontrun{ # Comparison can be done on smoothed ROCs # Smoothing is re-done at each iteration, and execution is slow cov(smooth(roc1), smooth(roc2)) } # or from an AUC (no smoothing) cov(auc(roc1), roc2) \dontrun{ # With bootstrap and return.values, one can compute the variances of the # ROC curves in one single bootstrap run: cov.rocs <- cov(roc1, roc2, method="bootstrap", boot.return=TRUE) # var(roc1): var(attr(cov.rocs, "resampled.values")[,1]) # var(roc2): var(attr(cov.rocs, "resampled.values")[,2]) } \dontrun{ # Covariance of partial AUC: roc3 <- roc(aSAH$outcome, aSAH$s100b, partial.auc=c(1, 0.8), partial.auc.focus="se") roc4 <- roc(aSAH$outcome, aSAH$wfns, partial.auc=c(1, 0.8), partial.auc.focus="se") cov(roc3, roc4) # This is strictly equivalent to: cov(roc3, roc4, method="bootstrap") # Alternatively, we could re-use roc1 and roc2 to get the same result: cov(roc1, roc2, reuse.auc=FALSE, partial.auc=c(1, 0.8), partial.auc.focus="se") } # Spurious use of DeLong's test with different direction: roc5 <- roc(aSAH$outcome, aSAH$s100b, direction="<") roc6 <- roc(aSAH$outcome, aSAH$s100b, direction=">") cov(roc5, roc6, method="delong") ## Test data from Hanley and Hajian-Tilaki, 1997 disease.present <- c("Yes", "No", "Yes", "No", "No", "Yes", "Yes", "No", "No", "Yes", "No", "No", "Yes", "No", "No") field.strength.1 <- c(1, 2, 5, 1, 1, 1, 2, 1, 2, 2, 1, 1, 5, 1, 1) field.strength.2 <- c(1, 1, 5, 1, 1, 1, 4, 1, 2, 2, 1, 1, 5, 1, 1) roc7 <- roc(disease.present, field.strength.1) roc8 <- roc(disease.present, field.strength.2) # Assess the covariance: cov(roc7, roc8) \dontrun{ # With bootstrap: cov(roc7, roc8, method="bootstrap") } } \keyword{multivariate} \keyword{nonparametric} \keyword{utilities} \keyword{roc} pROC/man/roc.test.Rd0000644000176200001440000005037014114130125013655 0ustar liggesusers\encoding{UTF-8} \name{roc.test} \alias{roc.test} \alias{roc.test.default} \alias{roc.test.roc} \alias{roc.test.formula} \alias{roc.test.auc} \alias{roc.test.smooth.roc} \title{ Compare two ROC curves } \description{ This function compares two correlated (or paired) or uncorrelated (unpaired) ROC curves. Delong and bootstrap methods test for a difference in the (partial) AUC of the ROC curves. The Venkatraman method tests if the two curves are perfectly superposed. The sensitivity and specificity methods test if the sensitivity (respectively specificity) of the ROC curves are different at the given level of specificity (respectively sensitivity). Several syntaxes are available: two object of class roc (which can be AUC or smoothed ROC), or either three vectors (response, predictor1, predictor2) or a response vector and a matrix or data.frame with two columns (predictors). } \usage{ # roc.test(...) \S3method{roc.test}{roc}(roc1, roc2, method=c("delong", "bootstrap", "venkatraman", "sensitivity", "specificity"), sensitivity = NULL, specificity = NULL, alternative = c("two.sided", "less", "greater"), paired=NULL, reuse.auc=TRUE, boot.n=2000, boot.stratified=TRUE, ties.method="first", progress=getOption("pROCProgress")$name, parallel=FALSE, conf.level=0.95, ...) \S3method{roc.test}{auc}(roc1, roc2, ...) \S3method{roc.test}{smooth.roc}(roc1, roc2, ...) \S3method{roc.test}{formula}(formula, data, ...) \S3method{roc.test}{default}(response, predictor1, predictor2=NULL, na.rm=TRUE, method=NULL, ...) } \arguments{ \item{roc1, roc2}{the two ROC curves to compare. Either \dQuote{\link{roc}}, \dQuote{\link{auc}} or \dQuote{\link{smooth.roc}} objects (types can be mixed). } \item{response}{a vector or factor, as for the \link{roc} function.} \item{predictor1}{a numeric or ordered vector as for the \link{roc} function, or a matrix or data.frame with predictors two colums.} \item{predictor2}{only if predictor1 was a vector, the second predictor as a numeric vector. } \item{formula}{a formula of the type response~predictor1+predictor2. Additional arguments \code{data}, \code{subset} and \code{na.action} are supported, see \code{\link{model.frame}} for more details. } \item{data}{a matrix or data.frame containing the variables in the formula. See \code{\link{model.frame}} for more details.} \item{na.rm}{if \code{TRUE}, the observations with \code{NA} values will be removed. } \item{method}{the method to use, either \dQuote{delong}, \dQuote{bootstrap} or \dQuote{venkatraman}. The first letter is sufficient. If omitted, the appropriate method is selected as explained in details. } \item{sensitivity, specificity}{if \code{method="sensitivity"} or \code{method="specificity"}, the respective level where the test must be assessed as a numeric of length 1. } \item{alternative}{specifies the alternative hypothesis. Either of \dQuote{two.sided}, \dQuote{less} or \dQuote{greater}. The first letter is sufficient. Default: \dQuote{two.sided}. Only \dQuote{two.sided} is available with \code{method="venkatraman"}. } \item{paired}{a logical indicating whether you want a paired roc.test. If \code{NULL}, the paired status will be auto-detected by \code{\link{are.paired}}. If \code{TRUE} but the paired status cannot be assessed by \code{\link{are.paired}} will produce an error. } \item{reuse.auc}{if \code{TRUE} (default) and the \dQuote{roc} objects contain an \dQuote{auc} field, re-use these specifications for the test. See the \emph{AUC specification} section for more details. } \item{boot.n}{for \code{method="bootstrap"} and \code{method="venkatraman"} only: the number of bootstrap replicates or permutations. Default: \var{2000}. } \item{boot.stratified}{for \code{method="bootstrap"} only: should the bootstrap be stratified (same number of cases/controls in each replicate than in the original sample) or not. Ignored with \code{method="venkatraman"}. Default: \var{TRUE}. } \item{ties.method}{for \code{method="venkatraman"} only: argument for \code{\link{rank}} specifying how ties are handled. Defaults to \dQuote{first} as described in the paper. } \item{progress}{the name of progress bar to display. Typically \dQuote{none}, \dQuote{win}, \dQuote{tk} or \dQuote{text} (see the \code{name} argument to \code{\link[plyr]{create_progress_bar}} for more information), but a list as returned by \code{\link[plyr]{create_progress_bar}} is also accepted. See also the \dQuote{Progress bars} section of \link[=pROC-package]{this package's documentation}. } \item{parallel}{if TRUE, the bootstrap is processed in parallel, using parallel backend provided by plyr (foreach). } \item{conf.level}{a numeric scalar between 0 and 1 (non-inclusive) which species the confidence level to use for any calculated CI's.} \item{\dots}{further arguments passed to or from other methods, especially arguments for \code{\link{roc}} and \code{roc.test.roc} when calling \code{roc.test.default} or \code{roc.test.formula}. Arguments for \code{\link{auc}}, and \code{\link{txtProgressBar}} (only \code{char} and \code{style}) if applicable. } } \details{ This function compares two ROC curves. It is typically called with the two \link{roc} objects to compare. \code{roc.test.default} is provided as a convenience method and creates two \link{roc} objects before calling \code{roc.test.roc}. Three methods are available: \dQuote{delong}, \dQuote{bootstrap} and \dQuote{venkatraman} (see \dQuote{Computational details} section below). \dQuote{delong} and \dQuote{bootstrap} are tests over the AUC whereas \dQuote{venkatraman} compares the the ROC curves themselves. Default is to use \dQuote{delong} method except for comparison of partial AUC, smoothed curves and curves with different \code{direction}, where \code{bootstrap} is used. Using \dQuote{delong} for partial AUC and smoothed ROCs is not supported in pROC and result in an error. It is spurious to use \dQuote{delong} for \code{\link{roc}} with different \code{direction} (a warning is issued but the spurious comparison is enforced). \dQuote{venkatraman}'s test cannot be employed to compare smoothed ROC curves, or curves with partial AUC specifications. In addition, and comparison of ROC curves with different \code{direction} should be used with care (a warning is produced as well). If \code{alternative="two.sided"}, a two-sided test for difference in AUC is performed. If \code{alternative="less"}, the alternative is that the AUC of roc1 is smaller than the AUC of roc2. For \code{method="venkatraman"}, only \dQuote{two.sided} test is available. If the \code{paired} argument is not provided, the \code{\link{are.paired}} function is employed to detect the paired status of the ROC curves. It will test if the original \code{response} is identical between the two ROC curves (this is always the case if the call is made with \code{roc.test.default}). This detection is unlikely to raise false positives, but this possibility cannot be excluded entierly. It would require equal sample sizes and \code{response} values and order in both ROC curves. If it happens to you, use \code{paired=FALSE}. If you know the ROC curves are paired you can pass \code{paired=TRUE}. However this is useless as it will be tested anyway. For \link[=smooth.roc]{smoothed ROC curves}, smoothing is performed again at each bootstrap replicate with the parameters originally provided. If a density smoothing was performed with user-provided \code{density.cases} or \code{density.controls} the bootstrap cannot be performed and an error is issued. } \section{AUC specification}{ The comparison of the AUC of the ROC curves needs a specification of the AUC. The specification is defined by: \enumerate{ \item the \dQuote{auc} field in the \dQuote{\link{roc}} objects if \code{reuse.auc} is set to \code{TRUE} (default) \item passing the specification to \code{\link{auc}} with \dots (arguments \code{partial.auc}, \code{partial.auc.correct} and \code{partial.auc.focus}). In this case, you must ensure either that the \code{\link{roc}} object do not contain an \code{auc} field (if you called \code{\link{roc}} with \code{auc=FALSE}), or set \code{reuse.auc=FALSE}. } If \code{reuse.auc=FALSE} the \code{\link{auc}} function will always be called with \code{\dots} to determine the specification, even if the \dQuote{\link{roc}} objects do contain an \code{auc} field. As well if the \dQuote{\link{roc}} objects do not contain an \code{auc} field, the \code{\link{auc}} function will always be called with \code{\dots} to determine the specification. The AUC specification is ignored in the Venkatraman test. Warning: if the roc object passed to roc.test contains an \code{auc} field and \code{reuse.auc=TRUE}, \link{auc} is not called and arguments such as \code{partial.auc} are silently ignored. } \section{Computation details}{ With \code{method="bootstrap"}, the processing is done as follow: \enumerate{ \item \code{boot.n} bootstrap replicates are drawn from the data. If \code{boot.stratified} is \var{TRUE}, each replicate contains exactly the same number of controls and cases than the original sample, otherwise if \var{FALSE} the numbers can vary. \item for each bootstrap replicate, the AUC of the two ROC curves are computed and the difference is stored. \item The following formula is used: \deqn{D=\frac{AUC1-AUC2}{s}}{D=(AUC1-AUC2)/s} where s is the standard deviation of the bootstrap differences and AUC1 and AUC2 the AUC of the two (original) ROC curves. \item \var{D} is then compared to the normal distribution, according to the value of \code{alternative}. } See also the Bootstrap section in \link[=pROC-package]{this package's documentation}. With \code{method="delong"}, the processing is done as described in DeLong \emph{et al.} (1988) for paired ROC curves, using the algorithm of Sun and Xu (2014). Only comparison of two ROC curves is implemented. The method has been extended for unpaired ROC curves where the p-value is computed with an unpaired t-test with unequal sample size and unequal variance, with \deqn{ D=\frac{V^r(\theta^r) - V^s(\theta^s) }{ \sqrt{S^r + S^s}} }{ D=(V^r(\theta^r) - V^s(\theta^s)) / sqrt(S^r + S^s) } With \code{method="venkatraman"}, the processing is done as described in Venkatraman and Begg (1996) (for paired ROC curves) and Venkatraman (2000) (for unpaired ROC curves) with \code{boot.n} permutation of sample ranks (with ties breaking). For consistency reasons, the same argument \code{boot.n} as in bootstrap defines the number of permutations to execute, even though no bootstrap is performed. For \code{method="specificity"}, the test assesses if the sensitivity of the ROC curves are different at the level of specificity given by the \code{specificity} argument, which must be a numeric of length 1. Bootstrap is employed as with \code{method="bootstrap"} and \code{boot.n} and \code{boot.stratified} are available. This is identical to the test proposed by Pepe \emph{et al.} (2009). The \code{method="sensitivity"} is very similar, but assesses if the specificity of the ROC curves are different at the level of sensitivity given by the \code{sensitivity} argument. } \section{Warnings}{ If \dQuote{auc} specifications are different in both roc objects, the warning \dQuote{Different AUC specifications in the ROC curves. Enforcing the inconsistency, but unexpected results may be produced.} is issued. Unexpected results may be produced. If one or both ROC curves are \dQuote{smooth.roc} objects with different smoothing specifications, the warning \dQuote{Different smoothing parameters in the ROC curves. Enforcing the inconsistency, but unexpected results may be produced.} is issued. This warning can be benign, especially if ROC curves were generated with \code{roc(\ldots, smooth=TRUE)} with different arguments to other functions (such as plot), or if you really want to compare two ROC curves smoothed differently. If \code{method="venkatraman"}, and \code{alternative} is \dQuote{less} or \dQuote{greater}, the warning \dQuote{Only two-sided tests are available for Venkatraman. Performing two-sided test instead.} is produced and a two tailed test is performed. Both DeLong and Venkatraman's test ignores the direction of the ROC curve so that if two ROC curves have a different differ in the value of \code{direction}, the warning \dQuote{(DeLong|Venkatraman)'s test should not be applied to ROC curves with different directions.} is printed. However, the spurious test is enforced. If \code{boot.stratified=FALSE} and the sample has a large imbalance between cases and controls, it could happen that one or more of the replicates contains no case or control observation, or that there are not enough points for smoothing, producing a \code{NA} area. The warning \dQuote{NA value(s) produced during bootstrap were ignored.} will be issued and the observation will be ignored. If you have a large imbalance in your sample, it could be safer to keep \code{boot.stratified=TRUE}. When both ROC curves have an \code{\link{auc}} of 1 (or 100\%), their variances and covariance will always be null, and therefore the p-value will always be 1. This is true for both \dQuote{delong}, \dQuote{bootstrap} and \dQuote{venkatraman} methods. This result is misleading, as the variances and covariance are of course not null. A \code{\link{warning}} will be displayed to inform of this condition, and of the misleading output. } \section{Errors}{ An error will also occur if you give a \code{predictor2} when \code{predictor1} is a \code{\link{matrix}} or a \code{\link{data.frame}}, if \code{predictor1} has more than two columns, or if you do not give a \code{predictor2} when \code{predictor1} is a vector. If \code{density.cases} and \code{density.controls} were provided for smoothing, the error \dQuote{Cannot compute the statistic on ROC curves smoothed with density.controls and density.cases.} is issued. If \code{method="venkatraman"} and one of the ROC curves is smoothed, the error \dQuote{Using Venkatraman's test for smoothed ROCs is not supported.} is produced. With \code{method="specificity"}, the error \dQuote{Argument 'specificity' must be numeric of length 1 for a specificity test.} is given unless the specificity argument is specified as a numeric of length 1. The \dQuote{Argument 'sensitivity' must be numeric of length 1 for a sensitivity test.} message is given for \code{method="sensitivity"} under similar conditions. } \value{ A list of class "htest" with following content: \item{p.value}{the p-value of the test.} \item{statistic}{the value of the Z (\code{method="delong"}) or D (\code{method="bootstrap"}) statistics. } \item{conf.int}{the confidence interval of the test (currently only returned for the paired DeLong's test). Has an attribute \code{conf.level} specifiying the level of the test.} \item{alternative}{the alternative hypothesis.} \item{method}{the character string \dQuote{DeLong's test for two correlated ROC curves} (if \code{method="delong"}) or \dQuote{Bootstrap test for two correlated ROC curves} (if \code{method="bootstrap"}). } \item{null.value}{the expected value of the statistic under the null hypothesis, that is 0.} \item{estimate}{the AUC in the two ROC curves.} \item{data.name}{the names of the data that was used.} \item{parameter}{for \code{method="bootstrap"} only: the values of the \code{boot.n} and \code{boot.stratified} arguments. } } \section{Acknowledgements}{ We would like to thank E. S. Venkatraman and Colin B. Begg for their support in the implementation of their test. } \references{ Elisabeth R. DeLong, David M. DeLong and Daniel L. Clarke-Pearson (1988) ``Comparing the areas under two or more correlated receiver operating characteristic curves: a nonparametric approach''. \emph{Biometrics} \bold{44}, 837--845. James A. Hanley and Barbara J. McNeil (1982) ``The meaning and use of the area under a receiver operating characteristic (ROC) curve''. \emph{Radiology} \bold{143}, 29--36. Margaret Pepe, Gary Longton and Holly Janes (2009) ``Estimation and Comparison of Receiver Operating Characteristic Curves''. \emph{The Stata journal} \bold{9}, 1. Xavier Robin, Natacha Turck, Jean-Charles Sanchez and Markus Müller (2009) ``Combination of protein biomarkers''. \emph{useR! 2009}, Rennes. \url{https://www.r-project.org/nosvn/conferences/useR-2009/abstracts/user_author.html} Xavier Robin, Natacha Turck, Alexandre Hainard, \emph{et al.} (2011) ``pROC: an open-source package for R and S+ to analyze and compare ROC curves''. \emph{BMC Bioinformatics}, \bold{7}, 77. DOI: \doi{10.1186/1471-2105-12-77}. Xu Sun and Weichao Xu (2014) ``Fast Implementation of DeLongs Algorithm for Comparing the Areas Under Correlated Receiver Operating Characteristic Curves''. \emph{IEEE Signal Processing Letters}, \bold{21}, 1389--1393. DOI: \doi{10.1109/LSP.2014.2337313}. E. S. Venkatraman and Colin B. Begg (1996) ``A distribution-free procedure for comparing receiver operating characteristic curves from a paired experiment''. \emph{Biometrika} \bold{83}, 835--848. DOI: \doi{10.1093/biomet/83.4.835}. E. S. Venkatraman (2000) ``A Permutation Test to Compare Receiver Operating Characteristic Curves''. \emph{Biometrics} \bold{56}, 1134--1138. DOI: \doi{10.1111/j.0006-341X.2000.01134.x}. Hadley Wickham (2011) ``The Split-Apply-Combine Strategy for Data Analysis''. \emph{Journal of Statistical Software}, \bold{40}, 1--29. URL: \href{https://www.jstatsoft.org/v40/i01}{www.jstatsoft.org/v40/i01}. } \seealso{ \code{\link{roc}}, \code{\link{power.roc.test}} CRAN package \pkg{plyr}, employed in this function. } \examples{ data(aSAH) # Basic example with 2 roc objects roc1 <- roc(aSAH$outcome, aSAH$s100b) roc2 <- roc(aSAH$outcome, aSAH$wfns) roc.test(roc1, roc2) \dontrun{ # The latter used Delong's test. To use bootstrap test: roc.test(roc1, roc2, method="bootstrap") # Increase boot.n for a more precise p-value: roc.test(roc1, roc2, method="bootstrap", boot.n=10000) } # Alternative syntaxes roc.test(aSAH$outcome, aSAH$s100b, aSAH$wfns) roc.test(aSAH$outcome, data.frame(aSAH$s100b, aSAH$wfns)) # If we had a good a priori reason to think that wfns gives a # better classification than s100b (in other words, AUC of roc1 # should be lower than AUC of roc2): roc.test(roc1, roc2, alternative="less") \dontrun{ # Comparison can be done on smoothed ROCs # Smoothing is re-done at each iteration, and execution is slow roc.test(smooth(roc1), smooth(roc2)) # or: roc.test(aSAH$outcome, aSAH$s100b, aSAH$wfns, smooth=TRUE, boot.n=100) } # or from an AUC (no smoothing) roc.test(auc(roc1), roc2) \dontrun{ # Comparison of partial AUC: roc3 <- roc(aSAH$outcome, aSAH$s100b, partial.auc=c(1, 0.8), partial.auc.focus="se") roc4 <- roc(aSAH$outcome, aSAH$wfns, partial.auc=c(1, 0.8), partial.auc.focus="se") roc.test(roc3, roc4) # This is strictly equivalent to: roc.test(roc3, roc4, method="bootstrap") # Alternatively, we could re-use roc1 and roc2 to get the same result: roc.test(roc1, roc2, reuse.auc=FALSE, partial.auc=c(1, 0.8), partial.auc.focus="se") # Comparison on specificity and sensitivity roc.test(roc1, roc2, method="specificity", specificity=0.9) roc.test(roc1, roc2, method="sensitivity", sensitivity=0.9) } # Spurious use of DeLong's test with different direction: roc5 <- roc(aSAH$outcome, aSAH$s100b, direction="<") roc6 <- roc(aSAH$outcome, aSAH$s100b, direction=">") roc.test(roc5, roc6, method="delong") \dontrun{ # Comparisons of the ROC curves roc.test(roc1, roc2, method="venkatraman") } # Unpaired tests roc7 <- roc(aSAH$outcome, aSAH$s100b) # artificially create an roc8 unpaired with roc7 roc8 <- roc(aSAH$outcome[1:100], aSAH$s100b[1:100]) \dontrun{ roc.test(roc7, roc8, paired=FALSE, method="delong") roc.test(roc7, roc8, paired=FALSE, method="bootstrap") roc.test(roc7, roc8, paired=FALSE, method="venkatraman") roc.test(roc7, roc8, paired=FALSE, method="specificity", specificity=0.9) } } \keyword{multivariate} \keyword{nonparametric} \keyword{utilities} \keyword{htest} \keyword{roc} pROC/man/coords_transpose.Rd0000644000176200001440000000613314114130125015501 0ustar liggesusers\encoding{UTF-8} \name{coords_transpose} \alias{coords_transpose} \title{Transposing the output of \code{coords}} \description{This help page desribes recent and upcoming changes in the return values of the \code{\link{coords}} function.} \section{Background information}{ Until the release of pROC 1.16, the \code{coords} function was returning a matrix with thresholds in columns, and the coordinate variables in rows. \preformatted{ data(aSAH) rocobj <- roc(aSAH$outcome, aSAH$s100b) coords(rocobj, c(0.05, 0.2, 0.5)) # 0.05 0.2 0.5 # threshold 0.05000000 0.2000000 0.5000000 # specificity 0.06944444 0.8055556 0.9722222 # sensitivity 0.97560976 0.6341463 0.2926829 } This format didn't conform to the grammar of the \href{https://www.tidyverse.org/}{tidyverse} which has become prevalent in modern R language. In addition, the dropping of dimensions by default makes it difficult to guess what type of data \code{coords} is going to return. \preformatted{ coords(rocobj, "best") # threshold specificity sensitivity # 0.2050000 0.8055556 0.6341463 # A numeric vector } Although it is possible to pass \code{drop = FALSE}, the fact that it is not the default makes the behaviour unintuitive. In pROC version 1.16, this was changed and \code{coords} now returns a \code{\link{data.frame}} with the thresholds in rows and measurement in colums by default. \preformatted{ coords(rocobj, c(0.05, 0.2, 0.5), transpose = FALSE) # threshold specificity sensitivity # 0.05 0.05 0.06944444 0.9756098 # 0.2 0.20 0.80555556 0.6341463 # 0.5 0.50 0.97222222 0.2926829 } } \section{Changes in 1.15}{ \enumerate{ \item{Addition of the \code{transpose} argument.} \item{Display a warning if \code{transpose} is missing. Pass \code{transpose} explicitly to silence the warning.} \item{Deprecation of \code{as.list}.} } } \section{Changes in 1.16}{ \enumerate{ \item{Change of the default \code{transpose} to \code{TRUE}.} } THIS CHANGE IS BACKWARDS INCOMPATIBLE AND IS EXPECTED TO BREAK LEGACY CODE. } \section{Changes in 1.17}{ \enumerate{ \item{Dropped the warning if \code{transpose} is missing.} } } \section{Changes in future versions}{ \enumerate{ \item{Support for the \code{as.list} argument might be dropped in the future. This is still under consideration.} \item{ The \code{transpose} and \code{drop} arguments might be deprecated in the future, but will remain available for a few additional major versions. } } } \section{Related changes in ci.coords}{ In version 1.16, the format of the \code{\link{ci.coords}} return value was changed from a matrix-like object with mixed \code{x} and \code{ret} in rows and 3 columns, into a list-like object which should be easier to use programatically. } \section{Recommendations}{ If you are writing a new script calling the \code{coords} function, set \code{transpose = FALSE} to silence the warning and benefit from the latest improvements in pROC and obtain a tidy data. } \section{See also}{ \href{https://github.com/xrobin/pROC/issues/54}{The GitHub issue tracking the changes described in this manual page}. } pROC/man/groupGeneric.Rd0000644000176200001440000000273613607143106014561 0ustar liggesusers\encoding{UTF-8} \name{groupGeneric} \alias{groupGeneric} \alias{groupGeneric.pROC} \alias{groupGeneric.auc} \alias{groupGeneric.ci.coords} \alias{groupGeneric.ci.se} \alias{groupGeneric.ci.sp} \alias{Ops} \alias{Math} \alias{Ops.auc} \alias{Math.auc} \alias{Ops.ci.coords} \alias{Math.ci.coords} \alias{Ops.ci.se} \alias{Math.ci.se} \alias{Ops.ci.sp} \alias{Math.ci.sp} \alias{Ops.ci.auc} \alias{Math.ci.auc} \alias{Ops.ci} \alias{Math.ci} \title{ pROC Group Generic Functions } \description{ Redefine \pkg{base} groupGeneric functions to handle \code{\link{auc}} and \code{\link{ci}} objects properly on operations and mathematical operations. Attributes are dropped so that the AUC/CI behaves as a numeric value/matrix, respectively. In the case of AUC, all attributes are dropped, while in CI only the CI-specific attributes are, keeping those necessary for the matrices. } \usage{ \special{Math(x, \dots)} \special{Ops(e1, e2)} } \arguments{ \item{x, e1, e2}{\code{\link{auc}} objects, or mixed numerics and \code{auc} objects. } \item{\dots}{further arguments passed to other Math methods. } } \seealso{ \code{\link{groupGeneric}}, \code{\link{auc}} } \examples{ data(aSAH) # Create a roc object: aucobj1 <- auc(roc(aSAH$outcome, aSAH$s100b)) aucobj2 <- auc(roc(aSAH$outcome, aSAH$wfns)) # Math sqrt(aucobj1) round(aucobj2, digits=1) # Ops aucobj1 * 2 2 * aucobj2 aucobj1 + aucobj2 # With CI ciaucobj <- ci(aucobj1) ciaucobj * 2 sqrt(ciaucobj) } \keyword{methods} pROC/man/print.Rd0000644000176200001440000000463313607143106013262 0ustar liggesusers\encoding{UTF-8} \name{print} \alias{print.roc} \alias{print.smooth.roc} \alias{print.multiclass.roc} \alias{print.mv.multiclass.roc} \alias{print.ci.auc} \alias{print.ci.thresholds} \alias{print.ci.coords} \alias{print.ci.se} \alias{print.ci.sp} \alias{print.auc} \alias{print.multiclass.auc} \title{ Print a ROC curve object } \description{ This function prints a ROC curve, AUC or CI object and return it invisibly. } \usage{ \S3method{print}{roc}(x, digits=max(3, getOption("digits") - 3), call=TRUE, ...) \S3method{print}{multiclass.roc}(x, digits=max(3, getOption("digits") - 3), call=TRUE, ...) \S3method{print}{mv.multiclass.roc}(x, digits=max(3, getOption("digits") - 3), call=TRUE, ...) \S3method{print}{smooth.roc}(x, digits=max(3, getOption("digits") - 3), call=TRUE, ...) \S3method{print}{auc}(x, digits=max(3, getOption("digits") - 3), ...) \S3method{print}{multiclass.auc}(x, digits=max(3, getOption("digits") - 3), ...) \S3method{print}{ci.auc}(x, digits=max(3, getOption("digits") - 3), ...) \S3method{print}{ci.thresholds}(x, digits=max(3, getOption("digits") - 3), ...) \S3method{print}{ci.se}(x, digits=max(3, getOption("digits") - 3), ...) \S3method{print}{ci.sp}(x, digits=max(3, getOption("digits") - 3), ...) \S3method{print}{ci.coords}(x, digits=max(3, getOption("digits") - 3), ...) } \arguments{ \item{x}{a roc, auc or ci object, from the \link{roc}, \link{auc} or \link{ci} functions respectively. } \item{call}{if the call is printed.} \item{digits}{the number of significant figures to print. See \link{signif} for more details. } \item{\dots}{further arguments passed to or from other methods. In particular, \code{print.roc} calls \code{print.auc} and the \code{print.ci} variants internally, and a \code{digits} argument is propagated. Not used in print.auc and print.ci variants. } } \value{ These functions return the object they were passed invisibly. } \seealso{ \code{\link{roc}}, \code{\link{auc}}, \code{\link{ci}}, \code{\link{coords}} } \examples{ data(aSAH) # Print a roc object: rocobj <- roc(aSAH$outcome, aSAH$s100b) print(rocobj) # Print a smoothed roc object print(smooth(rocobj)) # implicit printing roc(aSAH$outcome, aSAH$s100b) # Print an auc and a ci object, from the ROC object or calling # the dedicated function: print(rocobj$auc) print(ci(rocobj)) } \keyword{univar} \keyword{nonparametric} \keyword{utilities} \keyword{print} \keyword{roc} pROC/man/lines.roc.Rd0000644000176200001440000000373213607143106014021 0ustar liggesusers\encoding{UTF-8} \name{lines.roc} \alias{lines.roc} \alias{lines.roc.roc} \alias{lines.smooth.roc} \alias{lines.roc.smooth.roc} \alias{lines.roc.default} \alias{lines.roc.formula} \title{ Add a ROC line to a ROC plot } \description{ This convenience function adds a ROC line to a ROC curve. } \usage{ \S3method{lines}{roc}(x, ...) \S3method{lines}{smooth.roc}(x, ...) \S3method{lines.roc}{roc}(x, lwd=2, ...) \S3method{lines.roc}{formula}(x, data, subset, na.action, ...) \S3method{lines.roc}{default}(x, predictor, ...) \S3method{lines.roc}{smooth.roc}(x, ...) } \arguments{ \item{x}{a roc object from the \link{roc} function (for plot.roc.roc), a formula (for plot.roc.formula) or a response vector (for plot.roc.default). } \item{predictor, data}{arguments for the \link{roc} function.} \item{subset,na.action}{arguments for \code{\link{model.frame}}} \item{lwd}{line width (see \code{\link{par}}).} \item{\dots}{graphical parameters for \code{\link{lines}}, and especially \code{type} (see \code{\link{plot.default}}) and arguments for \code{\link{par}} such as \code{col} (color), \code{lty} (line type) or line characteristics \code{lend}, \code{ljoin} and \code{lmitre}. } } \value{ This function returns a list of class \dQuote{roc} invisibly. See \code{\link{roc}} for more details. } \seealso{ \code{\link{roc}}, \code{\link{plot.roc}} } \examples{ # Create a few ROC curves: data(aSAH) roc.s100b <- roc(aSAH$outcome, aSAH$s100b) roc.wfns <- roc(aSAH$outcome, aSAH$wfns) # We need a plot to be ready plot(roc.s100b, type = "n") # but don't actually plot the curve # Add the line lines(roc.s100b, type="b", pch=21, col="blue", bg="grey") # Add the line of an other ROC curve lines(roc.wfns, type="o", pch=19, col="red") # Without using 'lines': rocobj <- plot.roc(aSAH$outcome, aSAH$s100b, type="b", pch=21, col="blue", bg="grey") } \keyword{univar} \keyword{nonparametric} \keyword{utilities} \keyword{aplot} \keyword{hplot} \keyword{roc} pROC/man/pROC-package.Rd0000644000176200001440000004311714114130125014311 0ustar liggesusers\encoding{UTF-8} \name{pROC-package} \alias{pROC-package} \alias{pROC} \docType{package} \title{pROC} \description{ Tools for visualizing, smoothing and comparing receiver operating characteristic (ROC curves). (Partial) area under the curve (AUC) can be compared with statistical tests based on U-statistics or bootstrap. Confidence intervals can be computed for (p)AUC or ROC curves. Sample size / power computation for one or two ROC curves are available. } \details{ The basic unit of the pROC package is the \code{\link{roc}} function. It will build a ROC curve, smooth it if requested (if \code{smooth=TRUE}), compute the AUC (if \code{auc=TRUE}), the confidence interval (CI) if requested (if \code{ci=TRUE}) and plot the curve if requested (if \code{plot=TRUE}). The \code{\link{roc}} function will call \code{\link[=smooth.roc]{smooth}}, \code{\link{auc}}, \code{\link{ci}} and \code{\link{plot}} as necessary. See these individual functions for the arguments that can be passed to them through \code{\link{roc}}. These function can be called separately. Two paired (that is \code{\link{roc}} objects with the same \code{response}) or unpaired (with different \code{response}) ROC curves can be compared with the \code{\link{roc.test}} function. } \section{Citation}{ If you use pROC in published research, please cite the following paper: Xavier Robin, Natacha Turck, Alexandre Hainard, Natalia Tiberti, Frédérique Lisacek, Jean-Charles Sanchez and Markus Müller (2011). ``pROC: an open-source package for R and S+ to analyze and compare ROC curves''. \emph{BMC Bioinformatics}, \bold{12}, p. 77. DOI: \doi{10.1186/1471-2105-12-77} Type \code{citation("pROC")} for a BibTeX entry. The authors would be glad to hear how pROC is employed. You are kindly encouraged to notify Xavier Robin about any work you publish. } \section{Abbreviations}{ The following abbreviations are employed extensively in this package: \itemize{ \item ROC: receiver operating characteristic \item AUC: area under the ROC curve \item pAUC: partial area under the ROC curve \item CI: confidence interval \item SP: specificity \item SE: sensitivity } } \section{Functions}{ \tabular{ll}{ \code{\link{roc}} \tab Build a ROC curve\cr \code{\link{are.paired}} \tab Dertermine if two ROC curves are paired \cr \code{\link{auc}} \tab Compute the area under the ROC curve \cr \code{\link{ci}} \tab Compute confidence intervals of a ROC curve \cr \code{\link{ci.auc}} \tab Compute the CI of the AUC \cr \code{\link{ci.coords}} \tab Compute the CI of arbitrary coordinates \cr \code{\link{ci.se}} \tab Compute the CI of sensitivities at given specificities \cr \code{\link{ci.sp}} \tab Compute the CI of specificities at given sensitivities \cr \code{\link{ci.thresholds}} \tab Compute the CI of specificity and sensitivity of thresholds \cr \code{\link{ci.coords}} \tab Compute the CI of arbitrary coordinates \cr \code{\link{coords}} \tab Coordinates of the ROC curve \cr \code{\link[=cov.roc]{cov}} \tab Covariance between two AUCs\cr \code{\link{ggroc}} \tab Plot a ROC curve with \pkg{ggplot2}\cr \code{\link{has.partial.auc}} \tab Determine if the ROC curve have a partial AUC\cr \code{\link{lines.roc}} \tab Add a ROC line to a ROC plot \cr \code{\link{plot.ci}} \tab Plot CIs \cr \code{\link[=plot.roc]{plot}} \tab Plot a ROC curve \cr \code{\link{power.roc.test}} \tab Sample size and power computation \cr \code{\link[=print.roc]{print}} \tab Print a ROC curve object \cr \code{\link{roc.test}} \tab Compare two ROC curves \cr \code{\link[=smooth.roc]{smooth}} \tab Smooth a ROC curve \cr \code{\link[=var.roc]{var}} \tab Variance of the AUC } } \section{Dataset}{ This package comes with a dataset of 141 patients with aneurysmal subarachnoid hemorrhage: \code{\link{aSAH}}. } \section{Installing and using}{ To install this package, make sure you are connected to the internet and issue the following command in the R prompt: \preformatted{ install.packages("pROC") } To load the package in R: \preformatted{ library(pROC) } } \section{Experimental: pipelines}{ Since version 1.15.0, the \code{\link{roc}} function can be used in pipelines, for instance with \pkg{dplyr} or \pkg{magrittr}. This is still a highly experimental feature and will change significantly in future versions (see \href{https://github.com/xrobin/pROC/issues/54}{issue 54}). The \code{\link{roc.data.frame}} method supports both standard and non-standard evaluation (NSE), and the \code{\link{roc_}} function supports standard evaluation only. \preformatted{ library(dplyr) aSAH \%>\% filter(gender == "Female") \%>\% roc(outcome, s100b) } By default it returns the \code{\link{roc}} object, which can then be piped to the \code{\link{coords}} function to extract coordinates that can be used in further pipelines. \preformatted{ aSAH \%>\% filter(gender == "Female") \%>\% roc(outcome, s100b) \%>\% coords(transpose=FALSE) \%>\% filter(sensitivity > 0.6, specificity > 0.6) } More details and use cases are available in the \code{\link{roc}} help page. } \section{Bootstrap}{ All the bootstrap operations for \link[=roc.test]{significance testing}, \link[=ci]{confidence interval}, \link[=var]{variance} and \link[=cov]{covariance} computation are performed with non-parametric stratified or non-stratified resampling (according to the \code{stratified} argument) and with the percentile method, as described in Carpenter and Bithell (2000) sections 2.1 and 3.3. Stratification of bootstrap can be controlled with \code{boot.stratified}. In stratified bootstrap (the default), each replicate contains the same number of cases and controls than the original sample. Stratification is especially useful if one group has only little observations, or if groups are not balanced. The number of bootstrap replicates is controlled by \code{boot.n}. Higher numbers will give a more precise estimate of the significance tests and confidence intervals but take more time to compute. 2000 is recommanded by Carpenter and Bithell (2000) for confidence intervals. In our experience this is sufficient for a good estimation of the first significant digit only, so we recommend the use of 10000 bootstrap replicates to obtain a good estimate of the second significant digit whenever possible. \subsection{Progress bars}{ A progressbar shows the progress of bootstrap operations. It is handled by the \pkg{plyr} package (Wickham, 2011), and is created by the \code{progress_*} family of functions. Sensible defaults are guessed during the package loading: \itemize{ \item In non-\link{interactive} mode, no progressbar is displayed. \item In embedded GNU Emacs \dQuote{ESS}, a \code{\link{txtProgressBar}} #ifdef windows \item In Windows, a \code{\link{winProgressBar}} bar. #endif #ifdef unix \item In Windows, a \code{winProgressBar} bar. #endif \item In other systems with or without a graphical display, a \code{\link{txtProgressBar}}. } The default can be changed with the option \dQuote{pROCProgress}. The option must be a list with a \code{name} item setting the type of progress bar (\dQuote{none}, \dQuote{win}, \dQuote{tk} or \dQuote{text}). Optional items of the list are \dQuote{width}, \dQuote{char} and \dQuote{style}, corresponding to the arguments to the underlying progressbar functions. For example, to force a text progress bar: \preformatted{options(pROCProgress = list(name = "text", width = NA, char = "=", style = 3)} To inhibit the progress bars completely: \preformatted{options(pROCProgress = list(name = "none"))} } } \section{Handling large datasets}{ \subsection{Algorithms}{ Over the years, a significant amount of time has been invested in making pROC run faster and faster. From the naive algorithm iterating over all thresholds implemented in the first version (\code{algorithm = 1}), we went to a C++ implementation (with \pkg{Rcpp}, \code{algorithm = 3}), and a different algorithm using cummulative sum of responses sorted by the predictor, which scales only with the number of data points, independently on the number of thresholds (\code{algorithm = 2}). The curves themselves are identical, but computation time has been decreased massively. Since version 1.12, pROC was able to automatically select the fastest algorithm for your dataset based on the number of thresholds of the ROC curve. Initially this number was around 1500 thresholds, above which algorithm 3 was selected. But with pROC 1.15 additional code profiling enabled us implement additional speedups that brought this number down to less than 100 thresholds. As the detection of the number of thresholds itself can have a large impact comparatively (up to 10\% now), a new \code{algorithm = 6} was implemented, which assumes that \code{\link{ordered}} datasets should have relatively few levels, and hence thresholds. These predictors are processed with \code{algorithm = 3}. Any numeric dataset is now assumed to have a sufficient number of thresholds to be processed with \code{algorithm = 2} efficiently. In the off-chance that you have a very large numeric dataset with very few thresholds, \code{algorithm = 3} can be selected manually (in the call to \code{\link{roc}}). For instance with 5 thresholds you can expect a speedup of around to 3 times. This effect disappears altogether as soon as the curve gets to 50-100 thresholds. This simple selection should work in most cases. However if you are unsure or want to test it for yourself, use \code{algorithm=0} to run a quick benchmark between 2 and 3. Make sure \pkg{microbenchmark} is installed. Beware, this is very slow as it will repeat the computation 10 times to obtain a decent estimate of each algorithm speed. \preformatted{ if (!requireNamespace("microbenchmark")) install.packages("microbenchmark") # First a ROC curve with many thresholds. Algorithm 2 is much faster. response <- rbinom(5E3, 1, .5) predictor <- rnorm(5E3) rocobj <- roc(response, predictor, algorithm = 0) # Next a ROC curve with few thresholds but more data points response <- rbinom(1E6, 1, .5) predictor <- rpois(1E6, 1) rocobj <- roc(response, predictor, algorithm = 0) } } Other functions have been optimized too, and bottlenecks removed. In particular, the \code{coords} function is orders of magnitude faster in pROC 1.15. The DeLong algorithm has been improved in versions 1.6, 1.7 and 1.9.1, and currently uses a much more efficient algorithm, both in computation time and memory footprint. We will keep working on improvements to make pROC more suited to large datasets in the future. \subsection{Boostrap}{ Bootstrap is typically slow because it involves repeatedly computing the ROC curve (or a part of it). Some bootstrap functions are faster than others. Typically, \code{\link{ci.thresholds}} is the fastest, and \code{\link{ci.coords}} the slowest. Use \code{\link{ci.coords}} only if the CI you need cannot be computed by the specialized CI functions \code{\link{ci.thresholds}}, \code{\link{ci.se}} and \code{\link{ci.sp}}. Note that \code{\link{ci.auc}} cannot be replaced anyway. A naive way to speed-up the boostrap is by removing the progress bar: \preformatted{ rocobj <- roc(response, round(predictor)) system.time(ci(rocobj)) system.time(ci(rocobj, progress = "none")) } It is of course possible to reduce the number of boostrap iterations. See the \code{boot.n} argument to \code{\link{ci}}. This will reduce the precision of the bootstrap estimate. \subsection{Parallel processing}{ Bootstrap operations can be performed in parallel. The backend provided by the \pkg{plyr} package is used, which in turn relies on the \pkg{foreach} package. To enable parallell processing, you first need to load an adaptor for the \pkg{foreach} package (\pkg{doMC}, \pkg{doMPI}, \pkg{doParallel}, \pkg{doRedis}, \pkg{doRNG} or \pkg{doSNOW})), register the backend, and set \code{parallel=TRUE}. \preformatted{ library(doParallel) registerDoParallel(cl <- makeCluster(getOption("mc.cores", 2))) ci(rocobj, method="bootstrap", parallel=TRUE) stopCluster(cl) } Progress bars are not available when parallel processing is enabled. } } \subsection{Using DeLong instead of boostrap}{ DeLong is an asymptotically exact method to evaluate the uncertainty of an AUC (DeLong \emph{et al.} (1988)). Since version 1.9, pROC uses the algorithm proposed by Sun and Xu (2014) which has an O(N log N) complexity and is always faster than bootstrapping. By default, pROC will choose the DeLong method whenever possible. \preformatted{ rocobj <- roc(response, round(predictor), algorithm=3) system.time(ci(rocobj, method="delong")) system.time(ci(rocobj, method="bootstrap", parallel = TRUE)) } } } \author{ Xavier Robin, Natacha Turck, Jean-Charles Sanchez and Markus Müller Maintainer: Xavier Robin } \references{ James Carpenter and John Bithell (2000) ``Bootstrap condence intervals: when, which, what? A practical guide for medical statisticians''. \emph{Statistics in Medicine} \bold{19}, 1141--1164. DOI: \doi{10.1002/(SICI)1097-0258(20000515)19:9<1141::AID-SIM479>3.0.CO;2-F}. Elisabeth R. DeLong, David M. DeLong and Daniel L. Clarke-Pearson (1988) ``Comparing the areas under two or more correlated receiver operating characteristic curves: a nonparametric approach''. \emph{Biometrics} \bold{44}, 837--845. Tom Fawcett (2006) ``An introduction to ROC analysis''. \emph{Pattern Recognition Letters} \bold{27}, 861--874. DOI: \doi{10.1016/j.patrec.2005.10.010}. Xavier Robin, Natacha Turck, Alexandre Hainard, \emph{et al.} (2011) ``pROC: an open-source package for R and S+ to analyze and compare ROC curves''. \emph{BMC Bioinformatics}, \bold{7}, 77. DOI: \doi{10.1186/1471-2105-12-77}. Xu Sun and Weichao Xu (2014) ``Fast Implementation of DeLongs Algorithm for Comparing the Areas Under Correlated Receiver Operating Characteristic Curves''. \emph{IEEE Signal Processing Letters}, \bold{21}, 1389--1393. DOI: \doi{10.1109/LSP.2014.2337313}. Hadley Wickham (2011) ``The Split-Apply-Combine Strategy for Data Analysis''. \emph{Journal of Statistical Software}, \bold{40}, 1--29. URL: \href{https://www.jstatsoft.org/v40/i01}{www.jstatsoft.org/v40/i01}. } \seealso{ CRAN packages \pkg{ROCR}, \pkg{verification} or Bioconductor's \pkg{roc} for ROC curves. CRAN packages \pkg{plyr}, \pkg{MASS} and \pkg{logcondens} employed in this package. } \examples{ data(aSAH) ## Build a ROC object and compute the AUC ## roc1 <- roc(aSAH$outcome, aSAH$s100b) print(roc1) # With a formula roc(outcome ~ s100b, aSAH) # With pipes, dplyr-style: \dontrun{ library(dplyr) aSAH \%>\% roc(outcome, s100b)} # Create a few more curves for the next examples roc2 <- roc(aSAH$outcome, aSAH$wfns) roc3 <- roc(aSAH$outcome, aSAH$ndka) ## AUC ## auc(roc1, partial.auc = c(1, .9)) ## Smooth ROC curve ## smooth(roc1) ## Summary statistics var(roc1) cov(roc1, roc3) ## Plot the curve ## plot(roc1) # More plotting options, CI and plotting # with all-in-one syntax: roc4 <- roc(aSAH$outcome, aSAH$s100b, percent=TRUE, # arguments for auc partial.auc=c(100, 90), partial.auc.correct=TRUE, partial.auc.focus="sens", # arguments for ci ci=TRUE, boot.n=100, ci.alpha=0.9, stratified=FALSE, # arguments for plot plot=TRUE, auc.polygon=TRUE, max.auc.polygon=TRUE, grid=TRUE, print.auc=TRUE, show.thres=TRUE) # Add to an existing plot. Beware of 'percent' specification! roc5 <- roc(aSAH$outcome, aSAH$wfns, plot=TRUE, add=TRUE, percent=roc4$percent) ## With ggplot2 ## if (require(ggplot2)) { # Create multiple curves to plot rocs <- roc(outcome ~ wfns + s100b + ndka, data = aSAH) ggroc(rocs) } ## Coordinates of the curve ## coords(roc1, "best", ret=c("threshold", "specificity", "1-npv")) coords(roc2, "local maximas", ret=c("threshold", "sens", "spec", "ppv", "npv")) ## Confidence intervals ## # CI of the AUC ci(roc2) \dontrun{ # CI of the curve sens.ci <- ci.se(roc1, specificities=seq(0, 100, 5)) plot(sens.ci, type="shape", col="lightblue") plot(sens.ci, type="bars")} # need to re-add roc2 over the shape plot(roc2, add=TRUE) \dontrun{ # CI of thresholds plot(ci.thresholds(roc2))} # In parallel if (require(doParallel)) { registerDoParallel(cl <- makeCluster(getOption("mc.cores", 2L))) \dontrun{ci(roc2, method="bootstrap", parallel=TRUE)} \dontshow{ci(roc2, method="bootstrap", parallel=TRUE, boot.n=20)} stopCluster(cl) } ## Comparisons ## # Test on the whole AUC roc.test(roc1, roc2, reuse.auc=FALSE) \dontrun{ # Test on a portion of the whole AUC roc.test(roc1, roc2, reuse.auc=FALSE, partial.auc=c(100, 90), partial.auc.focus="se", partial.auc.correct=TRUE) # With modified bootstrap parameters roc.test(roc1, roc2, reuse.auc=FALSE, partial.auc=c(100, 90), partial.auc.correct=TRUE, boot.n=1000, boot.stratified=FALSE)} ## Power & sample size ## # Power # 1 curve power.roc.test(roc1) # 2 curves power.roc.test(roc3, roc2) # Sample size # 1 curve power.roc.test(roc3, power = 0.9) # 2 curves power.roc.test(roc1, roc2, power = 0.9) # Also without ROC objects. # For instance what AUC would be significantly different from 0.5? power.roc.test(ncases=41, ncontrols=72, sig.level=0.05, power=0.95) } \keyword{package} \keyword{univar} \keyword{nonparametric} \keyword{utilities} \keyword{print} \keyword{htest} \keyword{aplot} \keyword{hplot} \keyword{roc} pROC/DESCRIPTION0000644000176200001440000000417214114354132012565 0ustar liggesusersPackage: pROC Type: Package Title: Display and Analyze ROC Curves Version: 1.18.0 Date: 2021-09-02 Encoding: UTF-8 Depends: R (>= 2.14) Imports: methods, plyr, Rcpp (>= 0.11.1) Suggests: microbenchmark, tcltk, MASS, logcondens, doParallel, testthat, vdiffr, ggplot2 LinkingTo: Rcpp Authors@R: c(person("Xavier", "Robin", role = c("cre", "aut"), email = "pROC-cran@xavier.robin.name", comment = c(ORCID = "0000-0002-6813-3200")), person("Natacha", "Turck", role = "aut"), person("Alexandre", "Hainard", role = "aut"), person("Natalia", "Tiberti", role = "aut"), person("Frédérique", "Lisacek", role = "aut"), person("Jean-Charles", "Sanchez", role = "aut"), person("Markus", "Müller", role = "aut"), person("Stefan", "Siegert", role = "ctb", comment = "Fast DeLong code", email = "stefan_siegert@gmx.de"), person("Matthias", "Doering", role = "ctb", comment = "Hand & Till Multiclass"), person("Zane", "Billings", role = "ctb", comment = "DeLong paired test CI")) Description: Tools for visualizing, smoothing and comparing receiver operating characteristic (ROC curves). (Partial) area under the curve (AUC) can be compared with statistical tests based on U-statistics or bootstrap. Confidence intervals can be computed for (p)AUC or ROC curves. License: GPL (>= 3) URL: http://expasy.org/tools/pROC/ BugReports: https://github.com/xrobin/pROC/issues LazyData: yes NeedsCompilation: yes Packaged: 2021-09-02 11:27:22 UTC; xavier Author: Xavier Robin [cre, aut] (), Natacha Turck [aut], Alexandre Hainard [aut], Natalia Tiberti [aut], Frédérique Lisacek [aut], Jean-Charles Sanchez [aut], Markus Müller [aut], Stefan Siegert [ctb] (Fast DeLong code), Matthias Doering [ctb] (Hand & Till Multiclass), Zane Billings [ctb] (DeLong paired test CI) Maintainer: Xavier Robin Repository: CRAN Date/Publication: 2021-09-03 08:10:02 UTC pROC/build/0000755000176200001440000000000014114132432012147 5ustar liggesuserspROC/build/partial.rdb0000644000176200001440000076250614114132432014314 0ustar liggesusers |i%qH>I&x$H Q,ntW2@4Y$5sIFI[3k$ht{̮Vkk}=kx $2duw:H}'bXGkϞXG'8O'y]~lqF,˽lmÑv=ɳ7r;JO~䁺u/yW:suRՋ93o6|9nk[%GA?`{u/v eWv>YY$gv]ωmuZ(צ'٫Zfzda|K+k+s*_[o[=>Q^Z;Կ_ل^~{{{][;xϾ.Ec0xh4T]d0F_oyZW=lvЯ?@zkY:ݰx$K,[ie-Y4<ԷrySa^~'< B Ш wCWOlG퉏x=SyHH{=4,?,fVekK+-f/V`Q4r,ꬠe6Vy?& '13Y6;JmEb {!_-3U$ 6ʪǁռnF6b;{ m$cGs Oo@J@5 ]r%D/v6t/ >1n̹+^vs3[5K/ԨXWÔ q]wRYH]cs碷" i |sY: >,Y>p|:grE=ҬLQŶ^bO5Կ3T/j)˼B-kF1 k'_(S3r>S%,:{Emb /JZ5CH|M{{ko_T, z9=2,-̊J=l?)a;Ap{kűMDA߃Xb"$ٷ5Ƕ*(iOm$PEy3'J1b-D0!*Jx^`,%<hQZU:q ; K-mh/uR:1S1HƁÐ5ݫVi3Dm'Af픈"uL^&!'Zc,CԎ/C,mÉl2Ųcc4di.+ېlug^XmezuE]*[N4fVײ7i| 4 r3zﳼi$FF#/ Nd3l&s}dScXTvl;W/?[X~skCWG㶴\٬/U;;1kؙ׶F0" ӈ -sxhmvɚw^Nmf]b\5 Esk/R~e1~ek]uIG$ߺ\:=NYUЬ:So)t[ө?2;c.?;c= [t_jq{QF9s[+[C=ƺ^M}X]cbrfC~g-="=Qȣ 2+\^ŎvvQ2rw?A9qO=ˎmZxi7(7!7)Kd[#RbkmD&9tnVyfV(0 7s-hsάmijiXr Ix}O9V4X[?fzT4j ;fNpv`_ )T3%d!%G QZEF!N/@;^|Mp P9CU5עquף$ "3mhz>bڬ9#0íLR,UwAԮ>zaB!J#lpӸoQn zl7@1Q6zxp(Iğom;mUåؖ7vSJw SnWA0_F[|":,wzbr]HgY+%F FrsC~,9,5祘w O4ks@y t?XaV,i >iNsb5|kv"F҈cScWG2~ @&t(lji)!9ԽS_R6e(2]#HwyWn8]F^ۯrQC7 ?@]rW.r.'F (Us[%4g'=.ipn_~ qETq+en4JUسgNk,} ܉}f]<YU|573_D;<ⷝ\ 1m/(sݍfX$>\Ej\d#~ױ$kU'%mЍA ?ƂTX6D7VckVi݀_>Kż*J. 2+ b[-广ғԔ@^] /pT"¿~_L yUI<Ė6- p+ A~$m!ޏ5t"/|J!#!GʺQ}So;8MW;Ti;o1^w TfCwdQU]G#󞪮$_Wrfق m?kۮ0 wJ Cjnvp}ћ`A{ KCYz@(~gy}]spNtC"KlA`xTv!G]hfR8 [tGlnآv-|TkK=Clv M iZ6ً|ģ&d CG 4hCQ E"816uc <'jr$ 6DeR*xG GK:dH%̭RlN7Zcjz/@Yиo >&\$9qF&S xD(8㭯xxdugi[mKzj}'94o3>ƴ6i}o4[N+equoh6ل ?:mػ]nyd\ aفVhrifF}$dk!T>ː/K}Ru9& cmMI}G꓁!]S;tq`(GA k|M4OXcBM1G8yHYu nzPPSNX sVXZao p u 'ҟeKb݀0e,TO*ar]'QOF{z^;0Rpv(Q+ A'b. b':9'&@>#|Vڑ&v3aTz#l4tK MH,4Ee߁Cҋ$P)=A'"NǁXUniaKR;8Nt+N@PV8= ~(%1Qn,|_{Źa5R/A3TYH!^^|E X֩؎Z[7#F S됯K?c^6hp[凴9i(~ OMP#ڸelv[m/NbjVyCdQqGrH-u/* 'ƼW7$)i0?@Bt&Mv?>zF`XQ 8T+Kjgi:;f=)c8,~s/:ꑺ ل^NJ@sWP=I`#N75'x).ż(4.GFWN&=ۺopQjp[nBHñQHa7ԋ_x;; w(w`Þh'v֞C; ȭp%Q M5 ,ӤCsKiH%^gcՈ# v-N-BAí@BVD>dV;ʑGy kja1)@1<Yhg03vmH\1*t.ot{h\9 kB\$BE` rqm?,A/.5`rqxXc◐>.Oq1x[[oF0<Yh%{x{DJ(_sZK] ak(d!aԝdIGX3rN3d;Qݭ75[^ci:Zw5aofVyl薿/vfÌU{!ߗ)_Ϥ` +HduV9oD{8WUgϹk n}M!uǥm֙!6=; 'Զqw]?Sm[ a"@3<X1뫯EN /M= & ]JFꆁi6h"o@Z60E#.w 14{҆p X@^&5B̮vgW1.@y'91J'!OޛH(p ގOOD)4[1Ѻ | Y>[nY]4[^MlE=O)?qzp=!/8KE'ԋ7Y-mͲÖYZ]Vy+L-t₇0nx 5D;'c,"pftBm~RvY|V ͧ}v O#(FN+06 ]<^3۳hVŲqJb8^:?`[kc G8mV66/sރ,=ffq,oЙ"[FQ+>L*{N$44 و6ۭoH]xc@<4+ye BX#%:SwH `&V=eBh?/`,&my"hls d5SKy IUϠ.FZvBmSKRvPd4S'#y^qN Nq:q`> H]LWbNfY-owԕzi</,ԧ,8vT8 3I'B)IydbFԝ!=KnK\Ɓ ߒqN>ʟ|- MQ/p(qB:x3c;RL0lUoqdSÜR_S0Q )Wb1$4rE70ow{aSdY6`"V6 }x7u-p-2Az3*s&GzT%B{HDrR}ԟ ๘nI_iR]ad^<.ʈ4jy]]$Oh ~ /s_TΡдbrב.EO:i6i|åʡQɊ1W: JzY,ڙQU)a*0Ks#c S'j8/L(3;`Oa|y[sk8y>GRXI;K:~ܣ1dyZFnڐ2 ږ4( Վ硕y?)|i6(_wYF8Rl۬x VݎDI jGZ0F| Ǣ].*z~z4;w&'@;@fNƀ[K Lc ;BJ;qD`8yJVZ3vBWVz݄;ޡƏxŁ'bg93$djԱ0y}Ȝ&!'3'[3b̟OG3'ϕCu=`GםÅAV۝> }rw A>֝> }ԝ.nRM/ jHZLv-.b1[ ?,oIAo8]!軗7tA32\+۱VT/$Cx,eiw~~yԪ+890 Y,n{u$2W3\kI8&dEGh,ը[ZD)Ԟ6ncHm`^ᶵdD4 -:rw,8\Ő J*w lMJ6,ۻļ ' h I۝dޘ־M%& 833j\jÊi70 Y~[߱]ӻ R'c\ȴzYc4+8yhb‰^7:Wp9OQPcMغ.Yv7&"ȍe_Z-ZbT!qEnG}cb<3+E]fBۄax tG6XINZ߁ !D Cr߁}5/P>ItjFai 1n/ ,&{ΦT} > w.\*wR4~%xiP=2^Hʈ;-L(%p򈲤P.1T瑰!tP%7! H(d%7MYda2')ٮT@Imd( ^,WB$W ;YeZ&˱.Q,\}E$`r).@Q:r#!?@>M^Yg-tMo$68 hQxע/2,($d'2:bB8pr. JpvOUu("r yQqǡLǽ@ضZ-| nBl~&f@HFMhpWi$ܳC9 *^KwhֻNqn`\ס[Iw/+|:6 Yl68S$ԏOUgQ?ҪN5I:հK3ةgBՎ5> |Y~M); 8aVW՟E$[ /5 ȫϡUІfDSO)*+@^C߳ O+z:^X`,_=9=R{jzHO_K65#@{26uw ^ 0^}pjy;8_ ?R8&Є!v:BgȩͲaV Z"RːNjvȠ`NoBV˅N& r 6$Wdo ;5<(d=Gr rr&^! |Jg G2ZN g!ˏ̃a!7AܲېoGWw U_ޅ|W;z7A#s4 Py)? E_w]@Z6-_"#eB >,ƞ[lQ{m%&2kIoQvo Qsrm˰.]J3N$,4;kSͶ2)J)OYsFpNxdæ}R&78dy=COD|c<Bk|ړbYJ)vZvl4d{'!Ow4?zAY,Jtun9ٛ5[Χ,[g*F!/l,X333͎$/8ͤoK]si'^u*fB>1|㹅'! <,9XmE=ҽ8@"u}QȣX6GU>W)*/ "ucVDzML$Sfٱkb[D* 49?Y< os'LOdndoLfC}Z'pHreLuh~mdkw!76xS>,eZ1`" ^zZЮ"k251N9PWݻ?xKi:kQUЦ3uA5!ⶏ]Bj՟*DՌ]eS{_W&5-g qf9xv{$ޅ|W+3oxJ`m՟ v 4 =aQ=^!`|>0 9)"&@u#"jc>v4zTuhbau̧q97ixG~U(cԊej$w+BJ-|NW?z{ijCϏB@?A8ⶏl-grEZ1_(jN'qep%<ޫL+8MoC0IwM=H${e4vXZ~0"TҋcS{ARew$nN%"Y~qmNd#B5y6oFl#g f gZ_ H `8Zy"NBTf=y ј e^$uSݛbׯspnǟܹSȲ7gg&cىоq!E^yIb{!Zf2l=F9:ylʽWQ ˈ/ Gd㳉pr, )TrFd݁{0|D;w%Bט{i`M<(0 9}$(xVJ\ !)Řl*R@jz!_y-|Ӫb a՘([(뚭36i>ܯЯPfk meAѯůdziWV6YcƘy3B s~, @Y~}ThF{nr{+_B4s eLTo&`>۱wGFR\`ۥX\"b8;b#;w~ 6߂n}Zmǝ>wP>~wR+sr1K8Y(P/WfbbF!ģ(}EDmKo_G! %Pܶ{mRlA. ?@<"0N`;?۾-BGc1ި맿~jLgj\~׮ٍq{4g=~^^̯gjqZC>) > oW Q.2 ϟ-s^+yc]2toV~Q߼WўOV>پKk2U9ZSm*EFAo[gŜts鬈  `]A'd2`/^>RE'c Q=~_"F'Љb-ZjCkԽ ls`p9H`h99,kBt*-Y` !Cћ fJin;bt5K7LZЬfCI }"0ߴC$ "9&y!Aaȇ#L`;'c>*ːģ2ez5luzaODoR2xZc&k5BH"N 3nuⰈ֑HL9A'鐥#R2`n* ⺑ut^~r^ځKL܍{b;6ZKm؅F=>XXJ9V5>P{X{s=O1,g YwG/u=kI{L3Qҋ69]6 g%hafWt՚_{:sx=if Ḩ^ tOaooL&,ƺ嚓~K[()R- t^zM XVl(>̻EnoߖNht9#NlނxpSQn?":%"خ%)2ۛf ģ aNKmZx>r4b#fY6Bޢ?Y%k$geo)&hGa §v u%:Mx CV)mo, v X>.8q88ZۍO5s xIs,PF;w+"xxwNNܯwA/ޯU~唇:_:IɖU,4P'DLҡ$P)Fv}o@)ͩFC7Щ̢XLfYГN{UW,mHai`F N}-xhBSX: W4. ɢFQ Tź7i8c"$c6vh"vx )BS0BD/B,?v@C O/A$ƃ\zܢ!gEtoǿ8' $uB ո9 ;OQ?u0:8CRfAļ TDćʈT;2#5%px57q\\Ԭ<>\Ēp;J, 1|:gi(]HŹsH&"ʎ9)S"2 y5z IHL2 a[!YHgv${a+x"(J~T Mg뇪\GQ/BJr=X4mf1 u]wվZ!PsIE󞏻>rQD.xUE7#"b;k X^+e?qE7]LK;yL!/Jto6[m5DEXПX}3Ji"q?bX-/Lżd3;NND/؍P3%.' #Q6H}WKVh>y8PjOgOY`E=#iLup Xeok;Ddx0) xCIT-凃o-\"?Ha?wn%Q'Gb)S[)0Y%>@[VZ r Hgc 2 ^Vh]O H2tRFUit@DؘVfޒwN7wc^l/*L1af9fhm|γ<Ϥ7ܟ]u˞]-9]@ ~MBߝm;iB{m;KDӗ{z>p}"tvzT2Mڔ4rmR.17wGi C( 0UsV(l9 @j<iYgƀ1LRw8 Y1 Q2Ƌ 2kC߀Ī+gT6f!K&=U(a8 Yh$}y< tb0"4\,?)=39UoD BDznTau1AisԦ>,&`@ lyiH׭!^HhLpkՆh,ӆ_RXgGtᖼODVqhbH1c"ڕ  GIލy͈и\񼨊Y>eIZ?(KR o6LLE_yn7(#@@͔+Ҟ6RE0!r4&Q>57ePh@8?寞WQWc*FLwļ)bnroU&u@c`:(,VrՖ "GNҦ93P/kbF] c2Izw{Ӕ;V,c VU<p1&\q(0dJ&eu*BSER^,ϡIE`@PXN^N\@_ͰVp,ᢄr5̅{jh$2gH~`NI\JO͊c;H1e fڛD$oC݆$PM(`LŁV܊(ϭC UO,' e mf;A!*'G`Lg G0D&7!&qwVI⑤bKU&](/b`i$N#f8TGKF]OCN7A_E o)5 *Ii)I]8 y]@?a/{sսxPQ,ϖ =cȏ1H&Hwm7'!,M I=iZ-0p3g +K1B琺/JxZ$E.Ūbr;zjB5=|?"FxJb9< Yhhu4v<:$7 ugIBk^,nG^%ESR얭<*އ,~1&q1{W)"KЖE5mRDi[ sLR1I]'d#? <Yl\NtAF#hs-M.fbpVq%64,%uW GܗԍC_McbDe yY8ϭ\T7xiHh纂Mb8]"SB`[J@ Q` P~WH1iGs,Dl&s! X mnB.V ^_'i /?!X64X^4io,:sy 䌔x+imB: 69πfw ߑ6T<dƬq^[csϣ2}G?6͐lΛiEZO|>nBޔe1R,e:Ӳto { ͋]Ο,[M1a˰ F)C;*Rc6(q[hAdl,@;adc5=reDjx rݐnI]7N<;2ͷmHSoz`w)[@E`f.UlnGo9 ܀юd|P]21c KTZ '۸E9|>v\u;l[*TIBnq޼"S|Y+Ee`E(Shw5ۚQh%f iK  i<@ (%,+ R9Gz.4܅3q|"<|R`$I ⑺ex)J^!"WWc2g#CZ!*B\}T Ð$IQ'((p<&qIǀ٘] c8 Y"SD.Pj!f!*oSŘÙ=b[O O!C<~ עq%!]!D*3ȟ)w AUڐhbX\-| [J|VޤȿG]oy+-,ԋ3#qqy+ < YZn_2K8&۩3M;'j|b藥CX_Hch/ ̖5bhسJ9" k/fr;=y#<,mWfIwwlR7x$ic,1f[*-?YAVi,% mÛ^vWpV oxCa``\K33J6~Rп)@Fݡ l0 6rif gZ_ H `r;:Ҥ#|ku:3N8kf!v x6ݽ)v:wCn Isaޓ^Xba2T7Io: e;Qq=$_ئYfff{M#12I~_p,Ig7gg&cىarO̽iؿPW;%%]: f`}A4bC|2K<_~46md͌;xɶX.hNᷕbg7PٷQ(>Z4ʺr/}tyk]5+vˋ#.e-hWmHSNֻj4kλvh#yұ:l?;cďX#Yk5BzwK-nM;SH7Wn_~zҜ}T_kgX bz@nbQw-X=/*+;z6Z5ZītkLx76(ar@xДdG.ݒZM ]砤.< Y֪P%u3ϴ!daCh]7QJ338E`B~` mrI8n4Gp8 \C\Yt"9%GoBf4NϢqoASpwI@-ő(ݚRGGݳ7fkJQ84/+Kmf!N' w啢fوVɍ>G p(33&]$yiεD0 >+m(1ġEM C8yH8Wz9}:q_hg8^JJA+Cpp NL 4ΐNBuL 33Ҭߚu&}5<6Ap4ѷl,h@AWܹng5U ?AK/B > ɽlS^6B?j]mJN-eKɈDzj$=m% Y켤Oӏ0F <4`Cxa5e+xkkQMm;hww]/=}#o9SCvmJo~nkSU-3=Noiq'>oWp7nt?8v90 @swޕYm~o=J\?铕OrZ)\-eߖxzxQЛIt1g\2oJD!ÍUK8hdR"<=բl`]oEh1o/P4ԺwU+Zf'Љr#\R&!ģ$SBf) EoR(xfZ`s <H9B>iHQl:R8Mi XGq I, vC8uW c Vb롷4 c~=KKm؅Ftł5r~%K JGaOcepZ0։$VdZYX˼/|Oc25a %l~ݧ>}]!^~i2M6dx"&QkX7rջYY/->:)0hmd@9׭\(x.s3)D(+GߖN:)PM?ʰI"N̞KK6;|O\ c 9 Lǯ::S9_]%Q \.j K0qz4fs^0#:q8]w dʍ"u1gٳSN@X:9go t׃7R6Q-ZOܨyHj|%UZ佳U7gaBuSCLA>x0e%vM2,' d{M'"5;O >ZObCQx|b!9й@v0-8Hh޹m2y2&O@>cSI9@A$Gp;GV5!|GGv~t*JfѢZY9, z(<* gj6M51A|؎"ZKH(˱wD+kŘwecI3r[Kzn#Z7Ͽ_?f0+ĶO{41qL 1шq{aJKS҄˨/cIn= [ B:D #]ZiWC` ~Ew*T?`0UUBNOApxJ9 -!W}ނ,C%n 8 y KoC-j @>,!u%Kѷ3aDΤbڙR5Yh!׃Efm=* Yh8ϯSei5 :W~}8dlKvZyB~lu,zq[o) Y=kI5wZz .ml!d/ʍy>ߏ>ʑGyK{UEk(ƁG -i_ȱV̳iYZai.Wt]Mv{8H.B^l|jqX_-Nux&BI %؎+A[ǽwrǙl}x&ughNQ~Nb4q^KHY(5S*$P|}z'Զq4w]Y|V Mۉ}2!CʒW_y{?frb_ϤHȉdq)d%sr4:aV$~tq^Ұ;TL!\ NB򅊬16 Rv) SCuNRdx1de2^|Y*)X$duRMf%niS]`&Vpwe:&¬[D+{#Ww nD!ꉖHgN^7ʖ 4t؊UY_7r۠.3sp~O,w!ǀ oEJeT6f%lE]*hFu[3 DZ\ނ,ٹ݄6 :? `(Vh{[Ł= j5'F8Go;bJ[7Մ pR/x"ixtK=|@q:r֦Y)ݎpQ_AeW ^e6wgNtk,F[5gIqBo#?7^t܄M迉?׆Hlɛ:M-fU]M,J~V MZz8pp(0E0(dFrꢓv<:l#Q9dŠ2gAvzv$ iXmqHLt2E\lSIU]wMԋiQސG, vRoZr/k1=xAu `I Ps2BfƜ6*_Tɵ X]\Q dy:Gtؼu@#DtOsANwV E${,4`睤h* "B@z?=URڳ:f+.t]Lsr89B;N?*E&btwQt/|bm + Pd+P- !q`d.cu3^) k 6JlsM oz`<> d)Fr/ͯ& ux sC| ;Î$Pj i~YSL! #禎{ȶ$!s2y.AR/%BsꝨ H ֻ);UoY!GF{ H Woۯmp}{@V/!nJMI]xY,pd +V>5^ё uFLƪgREadh^Q YlgC#t[v{ q.Br d<#ff&y\$;NОΝ}YEX[pq[n #dPF:+ƒ [[5}߀$U+0 GJGXe<'d,2aY*U;qD,"{f^,:^jFB |$\,?j>c*FG~U 6YB ;7Y-DaxQev>ю /AV7& k1ʰ7݊NN1pœ>,zf< 7OW,1`>læ9~v\s/xөkt;wB ϙdU vD$~ xMy 3QR7\,4$uS{E^jZd2/8ګMݬ}nKC107/߄s2LPġ|= s Lqކ|;8@ ;( l[# w '#,4Po3ŔVT2˴׆g8y"$[P$IF=ؐ̎ToD$baDDR dx}Z"&; Y-<+d>kEфԿ@5K5χ\lAAdĉ|A:m>-:I8ikf޹k%pnd<E^'[{_68YkH '! 81C-!oNA!,_^|-& E~㡢ju(ƣ.@$05;R =.>E.]kiCm ^O'i3Ϥai8;~Qخw ߑF3kNC^ {;P`_U70pG-&toPivl8ŁmgxA OB>85"9$s Ѻ]9X4/$ N .1 )0\6 ˪Ps /AZ"y}}l  T?6yc#5XOC:TƑ^g-^jeC{q6 6Ӭ.u(yY~$0.kZfG& JExae޵WVH p:dBҷJ!jA>'m N߸Q OZaI8-2JFO*,1N%O !#+ҼϰD KNJY&'-xVt^tZ#jitw=wCO <:w) ;!aV`fY bQJn\aDvmvٶl7^wǙ pɏ;ͪ#Bj%"< Y]лC19wI;'jeTArbqt !< Y-5q&x$-۹ pQiB ioߋ1WY .A^' bXTd'9Xay: ܛr*'ȷxZ/eLŰR? 7 Av-(CDZ&KH$daO[+ 0Yl}D:pt{0. ,4_ IMDž>.B=rQ>Z CG ~!BzxNOq2KCVfE`r20eȗtMkْѥ9]T+"dZ=hQusA6:ÐJQDR4ն[` 䌴u b[e3wʚ{8e:}J؆Lveg݃~=WL/AUrMAL됯>d+ ͝i~"sId-+H⑤1@Q,Q;^rqtn?Dnbt כ/"9S(d..W &3e(b[]@灳g 䞆[m<%?E 6x ,v_fc38:3e۬ER֙n$؛b7zyI{%-+9#BG /;d C:=ϏI]x i8MwK"^'1ނADꦀOo_uN z8Ɔw=#&TUiYg[UHQ0;w"!E$!_TAN]{=L|ƀW!GpR5YhbG1Khsg%:.mt33݁j>w!u'DSӐm*߃cv@Pf}zs/x\P?|'R4~5BN*? ? w$r0_,1_;DNd>+8 Bcq I%`r&8BVz+P`Zᕶͽ8MtwS8yPsc ǁ!G @_BϦUT`;M^NKmD*D1G6Rw8 Yh:7!yC v[1|PH#/$>EY~gX C"txʄ;$3n>%u&Gvúad_? o%}ǐǁ}*ÐN`?~i+{Cǐ;#zqbu܁?|T]cc\43~&L~M~[Hr߆[ρ/5bUqb2 N]]ލ'%R?@<48+@>Ck"! Z,xr;y LAnIԞA!3LPx]ibY4fUrL^>+ب.A0)>,eNEH#I!uV@pQB7$~ϟi%zfH,ht^z//lz_nB9-QOC`,%? <ͣWb*.aW>v?5({(6͜@r vy,E+wM#q:<9f\O@>:czD$,ʬ#}O#Ѻ,hxyu繸轫D{ҤN,%.:^k.Tl#ǜwo taM;o/ g Gr>i( Yh7[ O,I(_5IUTMI_D (x#Y*{6x^:~JsS'q[*7NE(wm6g4Y׌SxR^νn_ހ,vsٜ!g8y>*L / eDdF6A !cB(f O s% jz9ʻ b)p4'kf[zЊJxMΝ$qO ?yIsRtA8z;f~ιKߌvfoBPD8 YӐ^ȍNANVHQLDq+p5tثċ[?D#GZ;B8 Yl_ģw"'߀FK|g|it7 TVBo}lo}' ODJ~2x@'ɿ ?"<2ʼ坮 :UD9+b5F߃p*Bukb/bHqqa#tM%܉SB#D,dz%7Evz#TؤE YR4$FuZ9}7V4b7,ǘ7 $y֌UbN+KING -㋌-6 9}d>>V#9%ࣚ!gMh'%vhu$QܯCC$I]7pMUQ*y7_;Y0,Yz٢ud'^xdH,ZG'Ln;S?rO-BdC{WE %Jkwe'#XŮ;1HCj[riԞE6OH ,1d[ߚv!2DVRG.,Kn=Ɯ.J1mh6J[N+DEoV.]' A_bC߇]1yt/&c*< pBJC }8 yX>X" ud\& \ ƚYȇ=LBNJ[?Ų٩X6{m됅.ʭd=YY=d:fuE]*[m͖)'mki:q|ff9Y4#ّsL:L'VnNL"+-zäϗͰM.Y3/Mq۹U_X]bg=Ũ1,Es9JZN0r_o%ZW͊"חvnE=w{WfmajN٦cu*U靱@]i m[m~Rݎ?$O絬_ zj4VLoY,z_n|.T+B~*uyiCTQͼ= K[MƩ)vO{ic/i{Z Q- }쩮- Սg,qJ̭BKUy:Y=(g:FYYK&އ|_S&3Kt0}AnSm)0͢ږn/ d '! 1T*Znҥ4oa?~eI޾yʊw=9< "dք !QzOM pքԝ59b7&ݘ.巃 ]]:}OV*Ιu &f(/j͖:F;O\Ge†Y6-w$~ݿ/">%9iz6M h{Rmv6 n3 d]|%.N^>[16ZS!]3lt=n;E#aȇ[PA<#VI5%G ]ܸ 9 >( uǁ 26@e'oLe''ܱȜC&%8qnCi!4MGzbrdv2·ӷ/@[ވt>^ (:tqu>Q)7nzퟦ|Z-EbZZCIG$޶XXS^&:)UwO۴B!TPZoM 5Td㫭hK+.A;x*S  pM0l\3)fkM=s/Rl֊hFQs='{uiimȷƀR7  'H⑤qY--?Yk͒^LǗt/;쎧\ʵV.r/"T7wKwl8߁.QF! /y4Nni6f gZ_ H `pE?,~Gy.$3ģ!n xq{Su8A"8zFuG<7gg&cىat>x2HFÈB֡݌kÈ (yADU "*cԊADeFyIG\zZЮ" |Lt ];׼SV_e?;cďX#Yk5Bzw!j[s?NB}T_kDW[1W`P2D pG^pQ Sh>6r/605R*\T[0֌wtxUleS| SOJ!Gk39\1WZl&"10t /!oI+kȯLS>?)4GȘ0䟐6G<Ųcch$ 4e2ߖNI̻,G8/8<:51FQnj3!< 4>vxʾ6>1>5+,Gw: {U6l!Bu!*384~OՑI@r< >+g)q Dd+DWH߀ !}]({^E_lsa_H,~.dƂ|T3.)^J{ ~y]=IOs?1bG80ýoTpD67^7'Ԏwٳϖ#>1g "ۻv6KGcW}.=Z?B0O7vR (Kq8B<&'?G 0/zU7K|ݷL`G8 yTY͍54_TT,ʒ 9 G5(ufojEf`r/y6 glxI+ K)r,T sCrT꿊y铏@*C OG='!O ?$B~چ L? I+]VMiK=sWj*vʺ&Y2j6Z`iJpݬ /2 SzZA"%;py(Zo5M{du[q kX!|v!1/)8|7hP( $hrmPd2I!auQ6Ý L4 *f!gЮSM|lנRQȬ-Y7!NloEFC?Ij_ oc^QM J!-4#yhH7DQ\ю-^ND<&&LG(uKJ@6-5x OP],`*ADMQnL}⳷R4^jeNN*` c }YnO_U߸QH`(2Jߎ+n8k؃(dyynk؃P8m EWl`؆ޚa !Cmn{G]S1\<̆Zոf_C+ƛwyoP|:-?ww]/=}#o9SCvm6noƗ,ܴǗزצ'٫ZfzҊ^ƛ>loW {v5~t?8vR= yi{WvP{HIs(uoޫs0OV>پWk%2[9өV7Tǡ׍䕷Υ93o7B,?k[UD._ѰMN)}p}բ…lQ:`&^ABPU`hUHP(`-av:]q#N,BxCOz ˕inX;bt"N7,ZլӤbaȇ#|$zs4xYp2ްz`SOE`>=Fm R&xыnO:dAG`۬8I+L~fnKϯtccӶUO N9O+Nf1Ý>2l²V̛["t+H3>soU,($OYgIu962m !HnT67*gn7?JdSHIa6L m̆I}Wە gQYY+4m'S]R7s~_}nBGUSd:LY3)I"dvB'Ĥ1Sȟ>_5IׁWyܦWtwgYws-*ۚQ왓AE'@7"ń.ކ,j{^6lx V\,d~ל4rt;TƝN [8LIg(rNP F tqv E{ښYn+͜]k!Psr895=ģT 膿y8y>=\,?M;RxC[`|]1CX]tlf+M+qwG~w@E~ ǐ?n}U X;RiHu,,i^|ݢET&Qȣހ&()<<-mҽu^w"&32J'G'mb^h%͜i^,0?c 7wA&EIu Gx?v@P!!xvBmI}W5H_®AzXu4.:q`d$\i79@IwŽz -jS B}P[`ty'Ň03gg@<ۯ%ucZ+4䴴t3eDa8 yR]Z@>'B 0Ea){! R x$i R8q7#-gf!Mu5r4:#iq`rĒ!`rRAG?1B1Mj~m[SMAZto4>dNA.CTdR}Xk#nRw"V; hXRw,%{rq5}XNL6C24H]7p jjN(|C>(ݖ]0%.Ð $3֙Vrגt蜋N; Ͼ.v@PhwBmH}WjݷZh;~u<}u9OQ>Ekt>$OsES1*@1:ն t7DPYkQx]^,)[C4x=)g_EݠaMnB~*MM%6[ƪ:쑺8p(&qN NOòCHEC[9j 6r4 ` 64[1JmV2w#u;{VI{}*>ZI @ܣ[{_ώPU<H}B>*mk)= <ݲ /v)[cGϨ[aNi|;W4\O}nI0,h ixW]ZN%rKt$lkw' P| º2An?a8\UW Dޙ L 3i[NpCWv:7zYNm)DلӒk:Ӊ2:er2Aj3XwW/wTwb8WQN+|#݄?Tn'ǁ1ݠO|#1;tNdEx-VPezWQ)hT!\h|[LѰV.:oj:BZ:.[XDpHڬ%v"ܭ,;@}vq}N$q;dY3|NJiw3pئfcZyrmi:_kJ׹v:|4%ROkOytV*Eo{ 2tkw/~$\HEMӈ2>k{rl+9kU L|+NzDDn@zDnB+mZfq Dbd%=:: 8\L~0hpgۘim6ki8\,TMjmr)>,d='$vͱeUhp-G B^(6+NL~ ؎p$ oFXD[ݳ_z^,!P}p}bl9w^EӐkH]' d]G8 yXD 0c*'&1 7J]tSpS /\6Mu%%(|trm6F^'j3ǐ#XDꦀ@ ? I-nv7mEԥd9\AfܨHQ(}7OBC  ID`Ћ4yh%:ǂY; K g*Ä{bGL5ڻ!7ipwO4lrt*1oEx"O_(^Z"vJq`_LHѐr A!j;N:YVܠ$^eKtw !^d#dSWpW10csm F8 Y,V\& Gp!c$dn/'/hՍJ6.pqy{z[<}H Ͷg\{!9A$0< |Md69COx rxЎn D!@ΨR,hy0 "o%{ ^Nr'q6 'HYEuIc!s:Z0ȶ4lB_/k*$ ceȿ x V'9nxOnt&G*T6`L_-,k=\$M{ЊlZT͙;| '#,?r'] 4Ejje{͂c}o 4k_l1ubOi1tv@dĶ5$BR,cj_? !/DƔLrŸE le >gᙄ򁰻aoɷ_:Ed1|N*(, pšr n|+)NA±Z5#*p48=8Y~J?tJ 'w߻w VPҿئٿFCr4~JGòt~>GT2Prz ZZwYdE d2Ioəź3QQ#O95r}ͱ;%tF24Mcѱ7N&ghE%{mݿS'GWb; (C1e!]*mC)"bģBi> *~h uIIikX6;fMqWbr(;=Y?YEKTzY*ۚ-SNgmNYF}7hv$%~\6f2㉕d63}},3q@df&3ӷ 33sKVO]=Τܜ[ )ˏF/W:*E+Lm5`}`Du8g9Xi%kf|i1.{m/f즁{މ;=.F բVֵVI_ `v}tyk]5IG|pϋ׷Yw{WfmajN٦cu*U靱@]i m[m~Rݎ?$O絬_ zj4VLoY,zg-X]W<{yUjf{fnEUNmwM6Ѫ#==6#Vض g08@ZH(|>l[/sJLl o=Ɯ-9sKctb{/AV33d&,? =\OOoG<dU%!'u'#G1b7en\J'!*nr0eݤ&{mf\ډWJgOl:O <H[8<`}Auh6R͆C OT>zseZ1zW^m%S^pQ0O{ 6ȽԶh4( AfT0챹R=`nEhü.輧 c§*krѻ2㊹nʼ+) 24C>R}#| 2[uLe8{!c3nBˎMLs(stzs;ќdgX}Kd̫WߦSݔTfd9LCN+^NplRY֧.|YhzCWw2m(yx }F~=I'PU|#in\! S1o;xd{O(tLvZT"4<0K%uqPL‾!I]'00*D%? <HR mx{/)v_7| ICnF_7rK=X_'2^DA*tW2!m3)o wc{z?D$k ~2͐DdOk2`z)%\/ =uǼu|#Y,GGBYb. %P@G!˧&%InF ڣ.:,5t7+vܢ4OV6Y'A"d~Kc#@( Y)ãl^_wQnj:! u9ܰ0Q*d@cހj/29#u)zvnIY6Rk5! 09#zUW\b*9crTzI`Fu4o&J!4*T6:_꿦!>6:3K:YMg2HUtvׇLz:P,hs4m IƇM| ᇐ?vV.I;B&}3lH7%I6𛐿};Psz-{G/{uӊC]"< Yp 5ǢeUnwsy-vw\t3>PIJ5;V_X3cEov!\"a78)d$'ƄRwP ͢]CP_4iᬸWA<I)]3!d#WRoW!J*7MBTV Ro W5 FlC750茼_=emcmBY1oI≜ǿ]RQȬ-U7|mTݻ8ps))AZsW)/2'(y }B4|0zQdY,iemKJ {,4 m {JF#gR_^2%8ǫ9r/R0מ;]-RG{<ύ* N) zc]3toV~Q߼W K=O,}}ph ;^*oa[z7Ԏǟ׍䕷N93ou $ҥ  `]A_&S6yݪբ<@!}N:^B%PU`hz,BXKZϋjy}]lNt!2]G ?@)kĎчTNtQb٫M#Yh6R+T4_XiD8p|l|vmMKv]noMcjִ}Bخ+%W2%іb_ϤH"kj~yIS.zʬ4Oar,'asDLj;/iX* #w1uRPqWmC `BE%BP[I(-݈ .ji"C)N4Rwxx! 5|W.@^I-u$@MRȻmaDuߗmD$pǝ,٦fPלLZYӊ5:3ƆQtZy=2d*!ˏ7咅,,H*M@lU hMP&{«YUlW=BӀ/`|P8jum PNH5La v=.91P< sMEgs2ah{qfw-61,d؆Z!Aȃ.%b!!ȇFeam|NE:|g^0SSU~E0@Ψ[`4 YhQYȳF,#A~-[`ة%[ķ߷BT! 5!Sv8y@&}_qCiqOC4l2Pν3?lx"8,̮Ra[n,Qv:{(K"ք,z@U Ň wRxIi\JO͊c;GFaeniʹ7y}Hig;KB5َGBbg.b-শD2,pxuj ^&9L@:Rygf+V*wBTvEjzCPSޅ|7\ŪKͣJ⑤B(]՚ۤ%aJ2.e܃aÃGI2}(OpS1,Xö><9n?, \(Dt ,Ijjqd]&6JڂOYscܜ6o%'v׀!?fyyg7Zӵ;Nze[$0\D-2V@PV к@G .| G!m7Y^ڔ"3l*UjD ˯`a+o(CP:''p2 ͧXzCJM ۑ= Y~w .ᣚ-eoo^5`1mͬ;4c`vgy?C0V;sLDfrr;1<,p5j8Pz>moNAJ% Y~,;:}}Tzс3kE/w-MHM&b')ȭY巫6IjFl ZJ8Yh΁}^X$gr$w mhtmD2 Ȓd4U':iܖ$}VvuwxjAx鏘alincqfہ8Fނ ݄[>d=7m&Nq`kIH]'(dA%=$dF9X59`r&f!˯-shxZ4ec AB.A"GfnIe"ܭ,<;(~vq}MdsI[)F>w=m:Y ZyCg֚VhlqM_: q>DNw-m7RI/zӨfNƒ0Qcs$\$9Q\'-V4O#0fY4[,ڦ5Ei&0Lk3V2 T5ۧq|%G?yB;[5o "W)*;!!]AiܩH v{sQ ܯQ&?c4ߨ'$21jE'p Y(4:R8|Y<TԿ@<42o9{y} +0/fiN^~=PX}#=Xi6IJ; 3ں^BKdQdtv@R4ԇsB:== jqiB6xy q7,p^/fB.X[{ym([{Ix yEEp(x݀yƋqBFO@>:+IYgYGzh]NA`"^,q˝E'5XtIRX}OGo.,ԼAZaF9 NbzdXuܝ n}xSJPjN?EvoB)]p$&-{LɝkkmTMI rIiY:2^Haؖf4+.JNf[(ÐlS3Jg Rx8yD}p$6g!28dD!,6۰bNXDhr^$iApo76hU^/'y,ѹ|Y~LuF)t%b6+N _(zᢺUl/^7eʖwttlͬso1p1 X[,YJwVM1?ܹPD+%3{&v={ǖbA A_@& HG-U@"@D1/3 ZKյz߻5{f3ˋl${4/n#3.ɪ~Us=ܭ@0uvLJo:1܎.|vfY[ӌ_giАqtٝ{bcb!h!S6y^MzPIHYvDJBIݩ=:RnM q;eYᆜNעז+ xɝ5 .э涯H4ԏǐO.]ZҽHf(+mhHndy n)UFkEeg)϶ktn[۰ߎJ˛Q-4v&Hau8¦h+k޻ӣ)_O߻F zagc`7neZ 7}f`l;8e%džω15+8;K4u0:>;S);3)̙YtɋIY4M u'7Ɛ$X@o%EbHGءj|=_b D78Kpx|4K-!B~[ؕsp,[ŢH FFF?zZHT\{tNuR}"[{+,/lﺘ G i͝w):7]9#h~쁷(믞o426>. -[xQ T^LPI,1: qр ֘+'RԶ0:44:zt%KuvROZ7͔7+O9/ʕTjU*Y{L|K^㓓?}n2HntddlxĥA12>:>8:19qV5hKFr3 I({n?;=~Bal!ޣ|O0睱c_X=照`1UX']~'>)!{ΤXrurxRl{a53gW V= lIbiϪe;|I޿f+5TZ^$ Үm#d3_r-On]6O[p^;ku?1kc `0n] ~c}Xmu˿$kٸ{]p F ݊m뿱jT,;%VĮtn*(?ouei|-:u43=4)Ғc/ &.ba+HଘlJE^HAr-o|oy`{S> lvI:b>\〝꡿b|JQWv?eiht=!S1ߘ0<8esPwO_;ѡ˗.$l֔hNU `eƒfre۫8߲ʍ$b<<ޯxF|#<<؞>:1r|o5PR D6{ngR4=7ƨscf$i, *nL_+OSMX2j+ z1RJfyX}zl>[qA8Mvp _ EJ u*ai-f=۳x\etya+xv?$:(79 9Nklr,PwxumJ'F hҸ%HE"M⊒R)UK/9E~:Gb ҋ_t7![o_?LFRj<q-E ccc#Pw8JyThCAT޵F浲){bcXFrjk$f{sD'cɱ5Td[1[uG*Bih/qyrLii-ӕ U}l1G&뇏UU|r86~Z҂lWdϊ55MGBJ%>\N C2b # |~U_5h0ԭFkd؄t?H?MgA2OCn—pZNկA Ȱ;8VN\@w;1G9g,p9 MIg)϶>t-ķ($Cw(cq*8D@ӛ7z65(cU}iMSzǓq+2B>^+,o2`:yz;)4ؚ$ ubq'AڄkdwPV:X-IWfKRoj&= Õ!+IO&+CjeoV|RM+EOVK20@R"ߢ3~ɨZF1EglvLKGYic~:roMcK5Mw6 ծmF\B:1cq cnU?a?PoqU$^SVx@|4e 1Sqlʉ~KYʮ!=o{h Y j:F!c@dKKNV?UGGF, OS֟ [$yyezIj~(]~swTqD JkZa u:jU~љ]IkؒD~$g)m_kV$Ghy~'rYQ45#ݲbש|g&;<-۾: es%_iKnMja hvln )pl:UE-6-chEya:ߤ4c1=(F{ ƊF+~%V*v|u|Ҧ',-g6Պs"OR5=sVKFkj%C(P3| X*jWv֟M6͟@#lc<6TsG/9m4 !CvQXpeiVoC>jxcK:]e)tgvncGw|8[qM6{K^ ? xab=21㿆p,}p_׋Ws9zteI`!^ʱn>*i߄z))?}'w:/^jAg \/}_^p Nr]̗EώUu  #tDݔU(5R=)[ i{bȧʼ-mJMOk7iƶ6Ӳo~X"=a6,ص'ip7)Xf#CyO1c28xV%-Ektl.Z5"4kLh&cl%6[,NW*QO i[O_ ʎ*aW8i>R0Nlsl2!ila D.)#t2!RyKR98v25k퉧s(,<[5K/sB6C]рQݬZV'mހoԥC3ݪXÛW}~`fvWEuDg_@pEK;TO"%9 '+>0?U78lF"RآS.y7kR~hdީ+n5Y64P64},Z+[bh?9,*r9H}f(Zݎ.RRC_L+3Ok$prkDk*1HVfEntPtɲS;E/qr^}_+}ח+Ãb?|;e(OirTSO~в#UK{!R֏AoZe^oī5/rIE#`Qg5waT\\N@nBU 1_(q<$|X;ר3hNQBleʗۿ$u먗`_@h;Gh`PL*sB`PADx/ ;S!YQFlv4ֈ1˘vֵ%Px8n'@\m[:w0Ov7?4r[Ӗl F! *ۜ|u,1rA#xLKy nvnuj-ʚsS q8d5Zifc{tRm( 7ƐOV8ɒ?kC] F D3C7ٕ%Ur0(qVU5ZVBEu[BjjsPķ([ ʝ }<)] ҭԿC>rS ZIu+PPVzu6l 8\VݹŠ?BWʰt8w(ѶLm|k6ϧiu`V[fyA"Fx#֚.Z<?@.(A 3!"Dà|jD #")1R7BOSQa;0oakVB(PuΕby/[ᕄ.l.i x6xvL v vEخ;I5mB~bWqԡew[7ZoWgF͊YS,YmS_>A%Q9q+\0)uP~S(/\/TC)IcT =&PƦ7ư]MK~H MM>nvە2kKsNDÝ#5eནxR,Cj =oŐOWZ*X7,d,7MTK|95PpU!ks`AKq3~U:頥B=ct/gkd>uqy58q U)g6erG*RnUkMT.{4YulW=ƒӵBmK]]Tki򛄈+Dϻr^ɉ+eM(wގQ-p򴶉7 !m4y:egkd܍RQ`CAYɰ 6Y%]ĝw׻I(2feW6>ģec"xqc)a?^ 1وU~ E0DF|m. [W߷*픕r m”u{)jۤGD+n)g0eݪ&swk\?p>Ӕ5Y\XQ;HRVjěoG3L]X ۴-⛔Ԧ2m WE,1 7jEzE8^R3+U-~_62O׷54e᥿djP7F-OŐ&fnUwaNssRXt [ m(yKz>)ʧ-2 V}Y4?qFՍ#əЦ9K0ЯŞ뫨ɣyZ':>}Á /[ޔc,";@Bdu91P*߂Ű2RIޠw[0o_L6 TۭkWo{ݔw3JW[)$%{ZcXeQP۠p]tG)#37AImL@*'|jhK&OEpCh̰"T/ ֣aIzFLn[&2f!jmkСtxpFOQVWs8LyX:xWSt=Lk!IYQ)fF&ޟZ#;֫ ]"qJ a#^|>)\PwxH~Πs0m(s&e}O*T3oE 9 jI<@@꺉)6ϙT曨̑YYZ74We} $)oqvޤD;<%^k.C4D]$r-⦶5T",PMOYi #l&9@t@3'KŠUP$SV;:a AMsxts8MYBѤe j/bFxRè\:6Z>@;ljz,iM4ZbMo !) n3q/ea_&`GLUL՚Ffj~HRS c[Ұ Q/*e+9]$G=mE8aNtvcuo}I $زnM7ϭ*rJJw&pKp_hm]F{9)Ez~Td Ng(믪I+·x[)םN=:p1S, &7)+_ru3(ooS߾%ߧKDhfnwJpn*R[/ެ[ц8(*Hf6(̻ aƙ)+-dp!jϧ;(+/RϥKi6$Gj(oWx-3:!%7[ڤqQ6q3qõ^$*b$8 tS~MzY}?,wIY-)_~I!fpK0X/jU2,z>u=,\p(l NbkI~RIe#6_8;Y*9N<}G)믒ܻnr.Kl1N;#ps/N1jM tc7ߖ'5|>L[1wĐO4>Po#^ؕߕzµV;u 4vǐͺ_gh+`.cuOݙ~m6ܶe6317ViI!%7Z%Uq?niG/}y$e7-9bzBuCěGt9ɮrر:픷s ُk0] sQ5ݧEə)>,e&'Aa/-H"Pv hxKi?^q] MeTN%ʾ鄟,z|"5Euc^p9NYM9vPVR4ԻDŽ8=K? 0es$|DB]%|ਗz CCj7O׌My@n$` ܫ<hŐO;Ƽ W/_Һpm!(0`cG)5f1"^ Dcq+{Yu"e3#YaXoL A}]~ɎY@9A 0_|EiLMUL)9,xjkum ҾP/H;KC>[id{ҮvQJ2+p)<\َfSV6'PO_'} l0w ssiqp{"TP!^m8 k)M~i:v'P_S Xi5Te[YйE|LYd}h{:}0..RXZ:L)_X =#@sk{tzTjK҅?,sZq>X0}..Eޡ|G]Xr]X-YZtV"MeXL . C7|-r'B@0uvLJo:vt+ 젬6}ޚf2>K4à?|l ;@@sqjNփNE#U/ŐON]#W[ͷ6!n4+ܐӉZҜߺ`ŶtDwS6&tc+. 1䓺K{tc.ݻnQdFFR%Xhf=o9ZĿJ^ qlݣs#(ڰߎ^sZ说 QkBCjgTyPc)l +Of/ghw딯P#|R-nΞӏݔ}k}6\Ֆ>'Fc ֬s,~ӓ`)nX+6M7v_YM7nf%[oRvpN}X7])ȠWO ɗkΩNʾH o)uۻ.E9ȑxZs`a M}kgH7_&{`P|e"^[l}S][=B2ģl؝bN1 1d >gL\08q5gѡы+1%^,ĭ~uLy2~:\Lũ ^u2Tp+gJ~;>9psK@/LFGFƆL\t#ャWa[Cf^4q|n$7sНrȼû3'=d ~~;Fs^x &c}_ub}BbཇLE+W'?+UkV3svlߠmع`v1jؙ>)*ZΗDo\cOJ5Eґ?/*܆;B6u^+wZ0Uzld/U7鵱SVӼ6ِ K-w;ևALVKkWOPm4ݭضۮKbsZ_x8o5HJoVWWêSG3CB<.-;r`"& Ί Jv.T]$3Po)~{I_`3Me?LjɗdW )ůGY\P |L|c8mKLCAb?~mk̊G._ tNSVZS9WX/;yKы_ȕms~:*72:MxNI;T`{* <|BI7K'W4=7KDVdύܛ-dV*f2}Ƭi +۔.Ip8MyZk xBG/\mMӋx-ē_"؞6;x^lPM2 -T4bƓf)H*cԊ1rREM8󊵠]E'Z9j>ݻh׼VV_=eTOأctk>HZm]Bloab$q!9^jL4|w+7:pJhnogE|-Kij\\pr24SZspFt%HU߲=[L/ cojͪ-ٳ"@br`ӑw)?便SпL|Aˆ ~W #!' u+įQ92Y1:446!@c&B^+Y?NըQ8yz;)4ؚ$ ubq'AڄkdwPV:X-AWFKRoj= Õ!+AO+CjeoV|RM+IOfK20NvM:7Y}5۪6}~e OYm;B +fIYIց:I"ԛXT+$?K`YY.U=@1dbX+ߪU\ZJ{R676J{\ֳ |kCdj[Ph `Tg\O.P;| Ea] m-0ZۓE~{ @U/|mRˣq>^/mLܹQ~\3zq{db / EYM(8!f*i߄z))?}'w:/^jAgk-hoyaZ/я!}^p Nr8]̗+FώUu!!Io&KZ!֓%@l -@y {[)+PCn4m crhYƐ!Y; vIZh#h B8V%-Etl.ZU"4kk-d `Mp?)X'ꑁ(H:xƐ!_k0c`4 c))1LcZF16-,%B%}CNT"Y*#B̔5 &ұ&ĝVc\)TGT:,llJof+{Whf+NOhݡ'mլ\y.)ʬݪX{cW={`fv0to'lpEuDg_3}^((ڒS.%a%ʗɿ+??u:8 2S.y7kR~hdީ+n.66>P6>},ZmS+[bh'sB rJX^F3윚WK$(Sؐ¼ $lnęy|#A5MdpyL//E_9ѳ@(q6 ߻wQSPfK wɮS˒^|ArԧYzx|Y}IdRsㅂo`]tVf')j:W꼿%U{$:HE:;vK0 ``Ad$NOHNBZN[?>҄A 'X+8{tQEX- EwSċ_3w:H:w1MHERmZCyʥb_řw^T`OJV6DYmbMkS&#O=b8l&&w+bGh9ʢ8JlP6QfOaPBb7nbevb/^2T@Qx4P'J^( m6Kn+7*C L1FwRmavEgXgt<۳>H_gf{hWyo1Zh]Ɏ~6+HA}q~bZڲSc)Opߍ?9,Vb<'A]'k*΄mcScخ"vl MAnvە2kKsNDU߫5keMནx{Yz5pLb'u?G>R]UdҢd&Za> W|ΉzoKQŐ9$>P3~U:YB=cW+rv/YO]\o\ ]ү;ҺMY̿)S,!kuL;r9V% ImsaͪcaG$+Cԏ{:_*E7窯Jm~X,n$Yd {oP֟mSqL˻~P_(= .biMݼk7Ӕ ,Hv_wRǺjQB.3u'14ʊ*mg'9L.;s1NOΘ:l` dp M~[U"XQ \#b|Hi.hm-I>cmߙ\b,r;nMAl˓`MX8Te%~"湏Y"e_b I1 /< 7ժ:]rڞ|=Y!޳”{ڼ?Ty­ϳvEZ9f ER"u9U. P"[@g:7ŌRǸJI:S=p}0bMs܊j8n1l׸56qhW qʣX f$Q_Pٕq傽WOZ4e"!m4E:egkKEGQqe%F"PEIY).C@q]Fuˮ&껆ұn1dA+jUƐUEYEG>Y=! ySt('5꾦r cml(~c P\g_׵K Jμ_+d=H4+ Jt|]"řiiCM7zyE|I7hfj o>hr~@I!jPwtViQPhk5I|c+Xmm8߉c+vIY^tKHҊ֢wRVo4R<&:'f)lQCZP0G)xMJߡF#ޥ|W?ǡ>u{-SJ1 My1tU* p9d iXeQP-p]6Nt 1cڼy$9 vJtc L.~ƫ;-ZV;e}Qҷ#SĿ-Ͳ>]RCrZ0m#MsZ]p21QaL`O8Q( f)+>1E|@A.!< `fH_my~C<C[3 tG;D>i>UУK B@8KƐOsE1kjM2#9 r-9uZ7tZ\C/P8FPMܯm39R7U1X2ei2(S ymmޡDA>%4*A]gi&PI>=kԩD\רucaXq򈶅zr⑻T.HKES,JWM7-JJ׈R~7!7?!MY; nץxF|Oh]:iv7cGǦ]p:B3B ֮.g/vZ<=֤5_W?z$kF|Q>Z.Z 8r~C~\ɺ'ޠ|CHKA܂OqÀcym 4AIf ꢳf( ?lmMS^N줬?u@Ն뻵-뿏I xcgo:/iʧ[Pwxm[uG'˯esK~}&ӔӱyMJmښb݈B /cp9ߝ6 =C\2J =!|psI~ 1/sʋ j;(#΅9c࢕vXGg](i,ڸpsJK@DcЌ iS@ymԽK|JnZ=\C0,R"")6ALZ *8ilDsvyV~ZW}.XN0֗Jb{ nEy8eY6/RVhnh~p{}`CdPSNK$#CsG(38td&!?䭶t4tg D7t(-I|LUN`VԷ.im-"/jsU+gfBP(-ctIYOC pp"EG ET !c#l%۫/`b߼фdoN<,-\䏍iSa% %ޥ|W73px[bT-NR8~c,E˾Kޤkfy.kJKH_ K`^QVqT)pNm)ºWGS*4P`t1t~s*o8%lDW.}Ym:C1I?w a[ {5=ǚâI镻Ktz`z+b-Լ ؟ڐqtٝczhEsKWdN8e' $T"!"eFc ֬'Pwxt/Pẋ;d8Pkg92yVC/ p'e37=u6<~c s nzkaI׈mZ8R#P5, Y{#Y*o Č]); R*-MoE 106222(>aRq!/X@so7eE]ӢvAi*c=ӔOk7 8}5vR_(=&ćsש9l/q]8M-HH(79 9Nklr,PwxumJ'F hҸ%HE"L (Je8T-D7KC1H/~odO@sˀ"AT8H%WhfԾwgM]HX1;@£/^4:46:2>4:6t)ۚj[')E=cmvv=ؠd|[6hŌ'R4T4ƨIEc2>f$)pkA,yOr2|wwy">{㵱G'x}ܭ ޴\'ICrlk 6hVou#mka !޴ Ί?[VԸQzCraeh4x@Je{V_&뇏UU|r86~Z҂lWdϊ55MGBJ%>\N C2b # |~U_5h0ԭFkd؄t?H?MgA2O P/-,|9/˹/ജ_@aw$qvbrXr@f%Rm}u[oQ?I+P~w?TpTez=F¦#=cì*Ѵ4wPxͺtn!]^,e2t&wRi5I8y2>K pB]'16Dɺ%& nu[}u~7V{_ge ^uzY:U+^[uVwVZq5cVcnU?ZaпP =toLq+<:B>=o{hAiF`|l6a$_2ߤbn2/K܇H[$Kyo[mQQquH;YyҒOё9y?AӔS~>aD?E?e'M^*q4&nʻejcgf; Q(!sdpҔ4-jw5tJrR?kC vQ{tPϱl -$W$ҬTBbrdExɛm 4Qf2AAdT!^| -߈!y<%vؿ@ݿ`.ž[8T[UEj~]z%|ʶިRD3(u_9B3m ,_aG3p*?0  xSb†|jteꝝS#lf;<-'*i(O'rL5J\MH1C>)VDjנ.$uua22ׄ j%S_!ymz~(~P<\bd ~ Ç̈́n6xTzߊi>DP 8q:|t#DK F%Ԋeatw0|4yt6(JҌ~˾n ~$OHR%(6ZTV*ULwĐO4%ބTצZ}nW$9!K`YY.UCܳQ~g 2JOT,{*욑?={)+E1Ҷ#um~ Msi1mܗ]KIwǐ!(ZT,'0ZgؓE~{ @/|mR4[rML {K^ ? xab=21C@.*wh uX}yC դw.K {)Ǻĭ 3tS7CkJG!:df?{s?zY\zZ[WkSE6N&_yx/ͻŧ 拞Rjmvg L4͒8%0o&nMSՓ%@leu[,[=MOk7t녍rYh{cǐIak+%e#MIYJe#MܗY~W ׭4NT*y E)O:][ƐO4Nn]$t6"Y*GEsʻuG(1跞Ѿnj, \G>02i:nz8ݪXK*WD]~+Wug_ȾE,{,2[Zvt(ܢ'7ra4}ۓy2lXQoӞ oFr[ءr9^ZwϨw# w<Lt`X;rRXN[ب\x3ZTiZ H{%Rզ|s]k$ޤ|SE7hī7oՂ5{Gb(6ì&kUic.DhS 1T|R?n%.hum1Y47Ė&6:P4e(S!i5u*v $NOS>mdZk@agx(}{bRZRɯ2_FaV m'{T+T0tBĨ29x: u1gvԳYQF$io4ֈsŘ%Px8?g5PՖE"F0w7$6:ja[)tn |lswRvtNDF*r4]t ۹A]&Z5%\og@q k6GY_ZAn=\YJB:sI{c'u+cӵBӡۖDGqpGZ-f72S^IJg8~;'Ֆ'݊Xr"+$}7(3yg-p`"VqRF{& ͘J$e?1og[Y@]1i[h+O}_*zKES V:JD .]!"C4Bb((v2J1'hxƜHÃN6aU>Dh;aa,ݱ5ٞDh +d=9ԝ'aF'0KP;GơLQXrUĤdhz{ǀJzшVy ۳mܸuvDyALlc{oaMI &oB{A`%Iޠ6fo~c ە9͒?kٛCf2J۱Jt-vߋv$2C9]Z\[bw&R*%Af"R\ޮiaVE1̜)3-cxq,&^ J KDGgj=bݾ=^)Šbf4`;`̫2 \"2IkcC"j=rsi7 [`fn[7@l7Ҳ bશ8iFRѦWgI"V}Pm/Y]Ǫ@lqf蕖Uz n$F˔@)KY1^.9Gŕ(+T*<~n{H0!hݾ_!90r>60_w^ĉ Bu mjKEQ+;pDaҞȟs /߲ž~Z1Gv~.B;DLkL(QVs0ZpIWs<@18sDfM.DJ^@clz;'n$`X$u+ȓNC5L?m9q'[A-۬ز!ůޢɺJiJ:;h^*5/"52Ǵ+<UZv¨UM>OxIl~=a)nk~I f[k.VV^b{<Zv;6p'iT]iyёv!gO Ǚf5y81ߨL%XEb=" q}M?N0+tRm'_~c 52ֵ̒Bɗ&w3bb7eЖu=~yjx2ON<_9ۉYJ-L놼6Nlm@-}tcGX Ovs+' ~[}V,+.Ԥ]k8F1RX"W:߰'d +~qM ҨԛY0HLSYiѕG@@AY׉bߏIm~c gɟ׵BӾ3Q !RUןxoL?}+XV:~#mK̯Зk GEYm | VqJ-j>{q*U uh`l>uq]k·>mccخ"K q qeMl: 0:y`l#fJr|'ln;1u}>\)Z!HLKN%Fj&e*G#i7!Z+UCyw p]eyKV=<a| ,e=N~.mN\R&'r۔O wrt`tfcn#~JZۉG9 nn (eۂL-tchҚBcs`2JjnVNY)X_ҝ(x RmC=E؉&uRm;QvuXtд?.\av x#g(R(O` {Qzv7 r7(+QNjxz Q!ڍƺעvv7!Qؾj؍BfOZi7'e;)+%NZ=뻬EXYn!j?h9Q6vh-vU1 & fզBM80q Jk|$"_i*e5\ aB~PmZLbTlsK0cDDm:Ϻw`܏b^F/Uϩv`]7) n ~mWReuthʯcDdNZ&V4tVT07ư]a]+4W)}.MKyfc3]#!Qkj)+MT4Ab3ij-bQWe8Ny<#^(kewVpT7.ߢkwS9M7i9L#٤.~&/K_x+m&|@_(;hC?erxR*o#3lTD$99uٹ$;+[WqmJ !]cx7?4Г6o`6G಍;Ǜ1IY9b_6̉i`> jrSNa3ԝ$^Fۃ4ET|](Ɖ1Y B,΋"ㇰ^ 20.eǙeh)dl*ƒrRu<Dx8%:,GH xs[tG`tWB 6(q5R6+](FsM Z Z&w*Nٱ=g"R|vf2vP0; )EATƔ"oaRwYwuRJh%Zg{Ncޜ_UH WEٮ.RYYf9AE#җQ\뻬b1[-@A="+BUJ}@ꥱ++zt|1Y*x*ꢅg?siwY@m-锿 DOPV5$(<@{wVOwcM0)[>E)g-JM:*(J|CJ58KyVt`cS(X_KNP&/ N~jJP8@9; ;J*8 xe(h@]' esNPŒ?^~U]֓@:eM'-{ZISV`!j];Ry1Am'Lyɰ3Cj(y ohTR!Cv' EsXMc9q+ݪ#L_M[ g\r?:aSt*n4G7'?#{-J^ʏV̇$ N? hu7~_~jlz5uUXnckT(U~an-ĝwkB6>)?{GC.{)5f-IgΡa 4>I2ѰK6*oSkCuZ:8/Rb7eY_QO,yNxl6ir2e7P{S8N/S?G8/ [Aexr2B QoF>y}N m_ *F^ dwS>F~J=k@yƩtٗzص#եb}@ (l28Ky %/ Ne"b-ꢖ J_˾W _1:tPΘei}­]rS`ҶmUACĐO:Om k0Q.m꯬C3*yʒvP0f_~=רK\P'Uw>i["ܨz4 ?B3=%{~֬Xv68.7傋Ă]bNx~%"ƿ)Dyjg\,nj磚.8EoRآX[c?ἎSɾ Ȉh<*IIh~-X@IjX.0mF~O-ZA v3ժupj)f;־ޤ vm ~QZ*|kŠUX\kGi5ja.}b UA0X\!*r@+V⛔zf#ہ' ;+˾|n#BGQVņs_ s _M؍O]mBϖ$ iC?5m}0β8l1lӰX6OJBc4|РA[8g.%Q~ѭb]NZM>mpus3HA'[D 7,1C3TBa7񀥻Kk@p ,"U&}V+gN7ZTgV#sq(\cOu?Gs*Bb6?OwPoǐOo)&aoYmMkI,o!eT 2*^ 4N2*^'4?ao6d0^8MyX6عz[/Sr8L 寤߶BĐO֟duǡU6q?5S,yָ֦?nښ)_m4 ?B3ٙ"%3$LyseT2$?G?[IيaėGJ  :`>/?:6eC\ M[ossZ|FrAj8p QQ-t%-"@@smaGkYNʿH:=o_͘zB.ȩ:ϝJ|J~!&مJ4 ]L ƚ'\ S5P^_1Zv&Ib D^=m`\p)IWp4 6w}qvVT] _x 7g0IXuwkA~>42 W"ցmE:$ߤԦѬG ҷR7F۫ڃn^KqZ}1v& R4]5ߕ&hѨ`g=V+k  ` T ʀxnm wJZV)VxRfF0Zᄿ[ţbTU)sD0jiq.rw pc "taaj'4+'J;DU #\ ;2oYa 제1+f xB"pC"uZ{l ]1HEGݴzT(EZ&NjQg)4{߶^hG]o,4V'vPI8]U+m1Q?I/!ƈFGMmdDԕ6}x {Jt m}y])߈I++>J˲]L+NbRtRh!Fs TߡMwz֮Ju8b+Qb]~j{W;`])NؕB+]+>-JG0Ů:mJ~[ JJ;NRKFWC_!!;TD@ڄzdj1z_oW1ѫݰҜ;]zZ&Nߥѭ!vZ})^#X߉IP?sQ߳؊,ۗ^H R$/m1L/"o/L/3Ķ p~_ 9b[R#ߗ=GޗB5",ЦcخKcv2 =ةB]'p~ߩBT/Pi,u/я(BjinVAz4$[TKd좥 pM^{ A2o"T*Q[4D$PAZZXӊW﷧o*$kLZ}JKowc9K9;?o]NoI)PIlc {bn {(vOB$b.qqNᕃ8(o9"VX[*\#*N.~HrQ6X wS3з(.\ѿc}3? P> ?~hb󵊝`0 :X\ uĝ|B}_ G]Dtؼ{/>"J+rq"BaKuW^rS)SDBNfe2N4 UH 12zh.(I_< 70B@-??GV؋sBbwPIļ&:SS;S!Kb?6ZQA?8$E6I_T: H>E:DL-z].Jfx {4}K5TwDqآÛD,~ŠSm]"ڭϦջB"zVގ{8жL*߻eCػB]'+0ZMeK+]u8b]caIW%ް]uhwYyp& ZWKx@ft/J/ uZNZ,~HD?~/ >b=+|/پOBxubJкhTntj '' f^GR-DhF6To3ċVj\"b)5v ?*W)+DjnV nk):@N Ꞔq ?LWc)D&AWS+I{M.OCb(]~Y.:VإIKS~/£fO@t~(c`=0C@Tg,O3`s8bj#h2%bM2]縢 |ƉC6Z*oѫ`OWQZ o[aϒZfJѭ)3 bخYa 4߻vDkA)f000n' O[ڞtJX[AaK,؜%NXᢢ7R-IYS?ݳ(dt6ӐO`1vC>ߞ> "37|QJ~ P.O=[a lAO y {Z$BvvjAN)ˁ3DsrvΖW9GD63 ҲgѡNy"NfEr]1h>מNR:Y(q4zx1ҝ,:`N/cҝ_ LNb;Ya,n'`GL8 FZJYbYh$T0V-eZ oӢwyҞK1YBc"w {X +|wW]an {X$BvaV J}zht[9bXhB4";ߧx>"MlG֫DtlfW Auy7<,(ziJd`dHwP0L\v@릕Rm)/$ C]'jۂExJsA-(.>x-;/TJd,+IDN1v6MC6ȓ3qVT˲]+l3]'}ufʁw#к OUjt-D܃jj1tp KX5btxU1tj61I=:BTW*O6C6㣴)U.؀N"=~bx%$փ#(:agJ[|CKS]Q"~6R{@4w|@M\zUclbP  aRTL?H֍Ķ) ~)`KL=H]6)P7f 5?!CQb`7oZaT3jteey, vgs#vS3fŊS],h&b0JXC̿[+yW(FDÍnUK Ҳ3/\\@(q -kdR2_UJ%o1W)eQ'@$Y 4nu|XIx_bd+612q| l&8ܯ*vQ9¯):y1P煽O1 %GYʣܺo'"iM.~jj[Hj,`];x֨Sp"Fo5SA! +ܲz# 1 jVkOsA\!b:eb:yaxKzϝʜe,cxVyG3d=~es J)zSw[ֱaH%@&2"wzX%Nz:"Ÿ6O2DGr1/<:2ҤiF,sc&3kPGu{U_;eQh@i#1}I$@s9 '!IS=6c|x3NۉzJcd~v2 ĸcra.~}Jݢ av]Avbq.zGkn ڱ̵"PZ@m;|nY[DeTwO:$9TЫV&R mH "AG9qS:'"8i%?Dh6{wQ߷"V2cXaw\T*=Wz,_BjklP?A KP.~gt2~ޑ_Oh>8҇AB'1s~d a7~AsJsDtK'ȶ2Px"ϻ4Ѿh]h gkla""0$!G2NpdbC-DsGP+iPkjm vJK*;bPly®|l*ڽĚ7Zܿ{$Fn{o!iOCtNfGGYSv@NS$)XJYSw6 `d :Sgrgpx]/jVK%^l.i.爗)̺WԲUD&3goih?ҙ:GB/ z] tBۈ)oW!83|tW6h:j+I{IK&bܞucμ?= bjJb%;I+xN,sA)"a[pX& +2,wgGei1yʓ UGؚ:pv7Zao8 bhf$D/Xe2QS?a6h(pWi?}$r1?oQާ*C>)zx2u&t}#1Ijh>zV`h/9^:JYmbj_ DfZAsX?! b=K3zDox`X ]EXu|l^9\rҭFUxj$':NXk *e臒Ήv~Q8AjhKk-^?f So~~ % gW4@Z M^_ioCʘG@ch e+8uY{[]_ZT> )@!Q:bG?)֖ϝW#_;fS=2W0{ %\I[PxC:pEm}mXmIH@c"){?Y&ΑCG r1hv9tRsꓶ!~c hPX_keh}"8PyT| `>c.XySe10;@PIܫm~ǸU?/ro k3o=.pꏇf1֝s 倞;=[d\[8K(su0'z+UGhf%_1-uۖTM-7d)-emFkΠfڅjt9wE?UD ih'>)^._1w&Ţ畫rᗿ8iV]/R\(v1j|bi(=/'{Û$XRkyt$OWvVk}^+Z+i053ʦ5vI/XQq@[= ^գUkvw)T c|X OcW:[ i[LR?QEa / [B?&ćsש9l/q]8M-RH(i79 9Nk m@B _]Q 6~{ZEo ?#,O͵.*Cu.;+V=R[6k \D#_5| 5ĵ6y0jIv>{OqBȼ$=x%$/ggv1>txI;r:ė8͗8mԓψ` c%X?(NNVljc%FE/TR,xN>H@J+$P0BC-ݑGAڜ-;392 q;|QؤAȆeO0bɍ {/6 09 \{eSZͽ4F[\8!/Ue?݂=WpSPrψZ1XM%D(/<:W;\Ê+.c|қ4hl<FN9^q 0v-_pQU}Ihn\A^~`M.!.3jj;doi. }A#Zb×P0BCH,MmԀьnmjM7(jl<2`88pDڅO?}qɱU9kUEaiuU{Dϫ9yC`oz^~|A~Gs==QJq>@F֐6C^]8~(tP@[)[?JO_+0N@Nt5 Vksՠqz@  d==4y '4Dà 'उ$Q`?k=Tz W0Pp]jݦ:K64 e3η.]:^SA_)KVQhnVF1ދPyBL*v+ӽ4<6p}>VnK1А5!RPkɣj fg׀~G^EOl2lBhzt' c4=cY= x{vcv{~ Dω@1K9:8:Ξ8\m@d1&>h {-??JŧXb6WW4W/~%fk›BTZA38 +9Wx]pW*~p#Ē\V) +=8Sǻ 1Ѣq%^n.Ob>Tn~Fwꚶ6 2>JBnݓ R+;Q*E7YLЬmMEx=ćׄ$ؖ65aCB"_?VBǤu[xƆj7?V5ЇYcW\ =6<п>BNt)"ιtg ?C#Qv$TY"v[Zk|H:Q[Tv{4hBV"XpP( F=s[ WR H9b} *0TQ։X %-R6SD-څA'%~oX]F[N6r9oo@d? TRէU!:8 L8M>2߇ 40_*K5/BrV6NZ84mMEX?hxUcεI^ NQuHxRb.2KD6P17ySH7{׭oT VӖK1k8_ҁAb4#-($So} uG)_va*[@q~;dKB=Y=qW@^ԇXh {҂U:1}T"/'A hnrަ+ʡ0( M$1=DY)G @.bﰶ}C?BشIq-oZm q'e 's7 Gk75>1+!(ZB>0a$+B$–E%>#iڼ@5E)L+Lr:.?tNRnQ6HMx8LYߕzD ;YsW)+%^+To.UzwS(#6J3C'Im~c ]d_ԵBXoKiU]@:Vd;7F| %-؊έ~LAvmx꺈VdA]yZ[r" vkvߵ=sQ 9ۢiJZV7~.V.$fr5/ěoG3V}۫v AMf[I-{b [ܪaʙs+Um"2_U`ߧ[@qr_LjP7F-OŐ&I5LS0J!:13`<%d#%F]A*{r$q4'cUlC@z>4p w?:gb3{xh)MUjL̺!n>J.EH~A_"^T5W=$!I6&~c ەbOZc<0R]Mwcu]ᡜk~gEJ/~[ 9y·Q>"R1Pkt^ԯש5SjP@k hyV&{(( Z%8\'O!, dB$J7%2S|M7z$8")y43es ?F (؜$tQV3YSSFϢ`,qPL_Msxsջ0$q~CRC-m) \ޘ`MIYi\=GπYT0EKy1Msxr -+#߲ȉx'[&KBJ[LhTeCnN.J M%W&귽Mt릑^AjǑ5عzEpl3VljÔӱ!ml Tmv꺉(kB]QPھY `?{'|XK1 䈣Nf Q3м+lK/3JW[)$M45M) C*•{̭؁6. tvhwPޡJ>=x; GB&fXmMB*'ijk;: " >UУ;@4v^Х3k7RDGT]-o)_~KY)UU5W_!$ɿMfVB nRQ.Sobp;8< G=m.g=L%{& -5IЃ99c9 2NDYzɹ/ c5m~"10 FKPoi3:#[Jpc_8\c?FCru3W % 2BlnXP8@HY?Yӥ7ZJ=GjEfn"W1pn"PIMY)弶[ a eoLLJK>킬 rʈDI: LZrRw0 3I2qZM~ܨÛ+(K~KFm84i82 (?. "u"0 ^UK*=.e$ot?n=ˋ~8&TH5˷CQ4 'Y*J+μt|~wUv=Pf\vRޛ@auXB8,LTPŒ'J๟8MyZone+KOӇ=QufMBܑ_>ϟ7h;;ө[\;wO)_>=}V/o&Qv3YyT> G򂣔e=$sǔkj՜"6Sy.wHZSWJ~^JxodHf*n`cMM 2Tݓ)CCͪSPIKY)^ )[Nnͮb#q:5w^]Tie#kxSp9jM t%JG^D^Mo 9 يF.KouDs$VGQ*Z{CMO͈$t|zW̗* {(?ˊ4zъ )I V{z\^,Z_o\~xqm+_O3̮ar:0;KJM_M t8EyJ@JAqv\\{B)_^^D-[ru]Ô.׊:4HTc ,ŮRM,ժpZLbU֧@q6-)3 CCGYyǫsPKOYiWC]xRoMd^E̗;$>VKOAy5?MbL&W)9AeΩ\#IY7XtY 4tjU@0eVQ>zg-@AYilj-ʧq "e\WPuDAF["ݥмtu nJ@] eI9K0ex[~FHvP0fObmɩ 0mIm<˱FzEҏ`$2՗YA6`xRk91*3#xq(e[BA؅e{*ۚ܆> ,wj{hyO+\1S+Knyyf2+NQaEh%ޡ|GɫY*YCaCL1uD& p3e۾¥Fv G( \Tk`r8a_ז@(Qk]ۺx]M7ӏMh&Xv]PiM"^|!IY)i.׼A ,+|4i􈰙ͪ4&аPy tM/M ܑ3Ki9Nv۵pcґ).?"4]RtO'P_`Bt5[:܌1 V$h;Hr7j74.,q@3aNSVڷ-B ^|AMv F N z 'AY Td= $[׌VD񥁡/! ?L/5gw>c?oKaqX\07PI\ox %%clW(?ekO#P|-?5 Ht;$]o RYzœ1 p-:!M nArRt?˟7h(ߺ+%z*n&L rYd?޺aE9ztR~WkuUXT\3_}p=>]ĢS( O㟣?Mf\u謾ӂ[zb [͊9Ǐ.yI2y^6e &XLs+[=rr'ަtmfe=XC$+5/3X]\ǃ *?z-0KYif ԏ7rם|,sr/!ā]|6bpxzxnt0¿2|[ C|o*N\*J" ˤY^36hoRufZC@GvwUV)*Zۈ(p+߉a$(upxluvqD:&'NR?i73@Q_ fA+CO9;ڠx~ltyY] ԫUٙT<g(럐8+@/jK'Vn!m:o[&ܵ  gIQViy'ln\XW0qd_}aH SnL6= GB ]a"5sʛnW*9Do^ʽ*N[u 4bȧR@ϼSJ.k.ց6~)hR>j.p[eRy#SVqm/Jb;/4d.oQ?P8KX]E? W;he}CP?XGԌ] oXA2Y*z&e׫W$`[ׇʮiroG,h 6I#S)ۨ" )*|*՚?[)+PkS۟Xm$ulS,[/nQ;;)+͐h!vDN[G Nv;hc<;)Ϣ^Z{7saΜeŮfU>⛔VY^+[]/,f9pun ܬ+?{G6I$@`%  4 A!8L ; @ z bFI]he%+˲WAe9rd[Nr{g9}un]0o{C{=ls'Hl_N@Vv~f6''zf1b e\At<;WQ3D.K'7 vُ/oCF`S_ GKWR8Q9Է(\$W#)k.DxZtM)d4Lߴn.d7P[dt~(~gSlbpxee&,1z߄)!-jԈ.~ xzԖ3./~K:S#:됥&D6)< Y}f^8#"/EE/07+s\[P2 ҠErl OWu:7kfzE [ Nxz>̢TˆOӈ̳ rExa}RќA4'uGiivM)FexԞq lܪ-םGtr>ߵK<]׋V) d-;*QQ†l:hnr\'*9Vn+c [*;]vA$v-RWϨYV  rZ(FFx GFߦ+s~_3y?7UX0ӂ魘,ĵx=e3 Oqĉ_x%}eYkT+oE3gsUo+(ڼhDck:2[۩\Qwcބqc%ۢ;hv v ZN"r,u/X uǁJYlpE$3vdIjPݩ;X8r~Rfʐ̇!,aD)Rlb*B_ >4n|`Ek+0/ #U%wᄿjmRXkҩ1_O_hl4K| ÷ ݄÷zP:7 <6!ȇ-$#(hcg 㟠2ZT$rWSGuPKnOZ~D(LCCkI 07Rǀ#G}<22,羙ck__1V]r^ ".C^V&g{N zI+XE{x=z]+ƒ[ߨj8f:M ~фb{R7,uXC@Vޙ%N z21: YRLBxGF' /Ŵ4nx >v%Rw0]oe^02NBI.@Q,z]Nb˿NKP)̚+ⅳj0I${7!Ge_-ፀA>xo)I _Տtcyk ͈ p \c]C3R& =j DYU:!V Z &i;Ůw׌e4#si8-?2 A\%3. 7ߜw7fssbWvWem1FpTִ_>EKtFip,׳'gE\XYQ7#.b6'O ݐe[ZvPW g0;&PZQ<z >z$d: v>(p5؅CCΜ)Yo1KXC˦Q6uA/Q޲+o<(?G[$~g' .O\,Xy[51~D/жp^?SvIg蒦\呈L G HGSY#gĻIsx_t16k,;o/ P7]Q3P E~{ssy]AuwAޥl;3>4tߛm)Df7dio^W4 VVv|~|Rr^]N.zƒ9Pl;NLLޠqd@=2#H\fsccI˺(3wޙS6qwX7y~6CZsU3x9a}BueEq=W|lêfɇ'ز܉a/mgixÿ3Bnd>i*ŧn%;4Q]=rKF|8r>{jk^ݫ5B*S߼fP}\m˼7?v>m,C }M3a:[e:5-ԥ_~WSyk̻օ?7ƶYX /+Dqt'!"oAK5UP.+#+ŮkNv:o˘N3&swww&r^b,G/bpN,chY]#-;\c;S02(^6ZYYӕ Cv[P{nߡ/31}Vє8 yXc %u;#Gm֚1Q8 yT_*<$ L%uc!"ߔ̌ "St43|oW6|d#ɹѳxG1r>sv0sn"3v?115smhnsg/G^SNOZ &S4tGX˰͎TuX(+âK^:1Ǵ6rBz$n\=4vy:kM>W(;7n:sey/$ڰPύzօ/1MKlXoc `ctv:Rot5n8Uh)^rܕ{^e2+fWL+lH mazNyl*d;\cT(᫐_U. ^M#\/UOݧ>K, pJ ٜT4M_GdcgM?-v*=4wBֹ7:f*.{ŗ*_ Y|4wTt kG Ƙ#f^ ԇ )@cciKQ0aeR:67C,MF:^m4uѱcm@_<ߪN;a-&;ՇZB/uhcTm䄦1VIܨ9͠YuV6seguz[HlAHM} 3}~+nW݊Op0Q}n9 +h( ls MJաi`C)*Ѻfx*Uג jaQz#㓣~Qsb8E9W@& W@&l ׿|ȉ'lzfDG d:Opu29:S,344:.8O* '_YLk`Xj/%0Gfee%7loan8K]-[3ᮘx; 5kȜ ou_xvJ{ololǿFňZؤ[QC*5Ti[UtHGkEOiلjߟm  dbI[iN`_ jS[VZ [mxEwwzF\ dWn,wK dFMR׫0q7alzv.+Gٷl)6h]hMj/=ZѺgq?VU ^HZ,̊p~Fk5=ۦw혾3z(d#TYVVڠ&sY=B*vU1(VK4n 3چږPQf0 Q Kס> ȯX2e~>셷̬:M,n0%e'|JvqqS^.)fFF͋~ =LOrt+EWp%<$Un؎_}-bY3֘"LC4L  denMfwUaS@g:8_xzj,p j1aEå62;5|1l|Շ 2GjڄhrvsŘC뜥Zzi<>i]aШ^۱!mۮP\+.Tܞx1Dž]:*ʏ8E'=kMz-iܛ1aTxzeqV?=327{RA)WKA/6&g0ŪXBF. ʍD*j=ߛi,0Ɑկj}QΆ$7F8>BܔHCT[T.uA[) Wh_IyrLӏ|tSdOw/oh3HYJȩ|d"_B}UЂKϜ|0pNWQ>@{%pjC_'q;rRׅ+QZxN7G+Qd-C& M1Qib?0*?,#OpkA"$To`c7o Lk25?N/ٲ;eE{\~μ,wK6>@(,aVc`5V)~ǚ4ܤ7*3.[~6la?>*<SB}3ah52/ g:tc3b+Bn9OY/’g%)k'!w)c%P*( <9Ļ~ZŦ  11JeDz.ܠrezvZ;t=_r?3/a!& pog?#(1} <5PK q$}'r?tsn)P%x^Ophe𸬵e| &*#y81aWPi}qWri 7]E4 ?wm?Q7ByMZ{߂T~$WQBIӋϥ,.yL`Qf ߊd%!L$d֖䌾\CIi-ɰ χ|]Ig} iX_xV7V,uM{2o! Yij Z7+9zCTk-"@"wYn?>2WWliNwNv74~OÏ&l/Œ~Xu,C{,jhl fEHWmH*M,{V0~=39؅vꊅ2?%mRG]$N>># H6؟vvhItKv5S9+َv5ɝΛͼ;`D bYa>8u0qtJ2>[2Yݫl6eoH?(|ƦVx,*Z"ϗ]cV>NTի'0J4"zAvܧJ沶EZ94\dM}ܖ0ICw۴ ]4#9+ ce邈l*{l/(j=PH"v!鲤M?Bz%z= ?2FX2K{;b~?AŠE "qQhT4A&02)-1~+ٜP//\uwBֹvRf ډ[@7 R@1噅mO{YRA|n\;Ʊ~Zge, A YjfvCI(ZГU붂ge~n55q .jb ,=N(]Ff3ŀ^$H4PsٍmSapѶ3Y*[Ed#JlZC9E5Rl [C9bF>ab}5(m7p XS6&~kK.,U V/C_}s$q.JHTv~_|@Uغ-Ьov ϟ!/ҋ'l'„J XLIL6qԷGYzΟbN`OBut:Rg [v͢k)(O!(!,#Oi 3U>ї1z%?i.҄ %1!֟2Q9dYRxԾݵ3 4khU✌cr.TM/A 2&ږb=(܏bAː_nB L˱(E6mb?J#ج~p_?Y1.Aw~[Yˑ~Z02|ﲨ}N%Ӌ2ï1: iwhks(^`L ;FgIc>oY.E 5ڠc)r2W88*`ɱ%SF5d"܋A2yG& C;rISB ;ݐK6pB {G#дi&Xq9G:4#hFa S~#xF6|鑯@vCUpUx<:J"{DV@d:],х\E B\trtd$3fS3XC?'tǦ㧋#/9]QP$dM`b] KlEꆁ!_VvLD kT.ebѦqV۞g^1J"Wr|lx jihLz*zt7O< 'Ǒ܃R&G<,iݍlb 7eF: ~' h|1ƎaNj.C]'R]@ĢKTPεjNcoiyy+6?'J(kz =SN%|%9:D K`.-;8at&'|kb!F H]?09l$+"&3 ~l a9ح{%"#Q7a NESd~`qu}C$ɿhk7%%C^!KbCVi\Gcնg 4/& j_ Y}_pHoGE+}M0RvRq{ox; |HBCirmI9D0d&61% rOXs&z,c"u=C՝J|M#xz3k`P`EeY?BдPo%z`lf Rs#(5=M!>ۀ;!rwApH9X /4X "d $a@Cqo&73 Z#UTX:8(1lc>mN[xVuxlQ!/SdtkG)6!%_Yp efv>oh29wBaȇ59Q߾ ݄和 7/N&)H <YjV{(֤̩`3 oґK'u! ٕO- + %3 ֤p xz [}Оp#}rܣ(NT.֦cInGJዄ 2S4{MN j^xh@Vf'W^({յ:yN8y IP) qڠqI}{ua5?j S֬%XΧSo&H@V[f~ks֒JM?0r7J7;LTKxAt x)Q&A%MRGD@Rx8Y˒-wXV+h/& AwDS9"Y L:!mvoxtȝ c3'XuC>JE#mlty؆J@,n~X tk!|=: YBԮfțv} 'An'p?nRW1%u[!˭D~GW+4h\0sD,d$p /%l`Gp61#lV!TPbV'7zcox-B?"xզ$~_~I9IH>>OI*#BMO^ LKN`x-0#ZL᥄ Ln&&~=J^GͿj:G: ՗s h'xT'ë !8pR-4? p]=\Qí {yF`b|8= o`z@5oZaiNs]H?{jk^ݫ5N>c+hV \9?s?vm3zM H-/Y[Gh5U?z҂TyZ4nYom뿱b.IK1Jl.Qc!<-ф™Z=PAm}c;}c;M5*Fx2(F)Qc*߈|0D=OO Oxj%nkD7fc ,6fAC 6B_ >JO!w@WVC (ClRzQUfN2J"8">1OoOO Zqqڅ}/gf-V_aƫ`Ix5r婤17usPѻ`.EoBwz"Ўvp,3W Z'^|MwlvϥȂ-?' P&{}r,?bΖ[٠`fk/zh3{r7Zo-G0HMc`sf-pPu(vU'p2gqHOfc)v&'pxe`/Yd_,A>̳=f$,up\̟Y.94K^ZZydumj岤^Jђc/ V W7R_ _fŽ;DŎgLu"Q$ȅ7 eY^{?ϳE.bь qH>]vA{dP ܒ~<ǰx7f vx1 o-ǼkL:mqAާiB+LAP߀qI^bLdΎS"/Ck֯e&Ο}=(oA“O*MdMzUoC$dמ/~ J&&ˆ-~N]phz8CԓL n,<Z2')觫kڭVp&<7,ِK?&HBAkةh[dw{M#\_arB{ i~;T[6k2]ʬĭ"[;WC;@pAY !B!:X;PiLVS]r1&%mߥ9o > ݨUhnIϖM~ϴpcc$$(!W6I g1. g.,8&5be^L>(1q(axz`Y<~jpcs'|9k>6s2;D=mC(brG C|b#3s~%<|zpӁՓҋ?M 3#~B*[?jmlҏ_[)48v3 OxU_K@p7&T`AyDM8 yR s%Z.ڎ_"#nҕ+&+t&4_/V^sKWM1U#nAi ) K9r$9=rPS)~ @\1N>^͜~ŨXl? 7AwqyL:u?ZmO-o`hj Dut6V9b"Xz'ܣ9?2WWl16 >hc%؃p7d>U6{6b f A|4٦a%P/}b_-Q$Cjv!;#(`C~',HW`m۳E~V moEH}w񑫀$ϡ؉DwFX~M?k?CUN {ח߶Y~Kܙűb12>\7=\0ÑT3SsW?ԩߩ2F:>1tAIz]K=#}}X݉? ~TQi_n&HSs;~s+7lonլzWZ. 6 C%#X2+u|}Zf߯W9.f\⯧~vT14'pHmoץM4j$~3r ڣŨmeR3&څ(ĭrTSy#oƠm0F[=2 A|4=OBi w5 0aeR=h2i$1V;لAejůфh`oUH}_iD3a McSgyZ {Mm&4Bo&J4"oHFS IؤJ;[rt7$?+r~}l[{dBpO5Ǧ#ђt2~הKrU+,$] 4K /:p^#̿SiaZ4[Q›o*ͺA`)ꦒy~e 测P.&r$q %9F)ͦ⢕<W6%S9ya4Ho?ђD–Fߚc4 m;&f%{qT$\+6 3VXț=Efzj) suR[; 54Fj D!J55JJ(-/ 7_%/)۲-~F 2,L\)Ek"3w1)zrpcwRxqeKL9(KN R)bx8yF"Ӎs53%w‘$֜3^aȇMtbKyۋwDAVO9U} EZr! ,5Y(B>}fiL bpw_4z47 A.}Bѹ#lZ{AwCr6B6#K쌼M;=w- {! \u-R9۟[? <*䫲G/C;o xmem;688G=+P &N`d@-I]0Rݒ,@--[; ͆%tf|<%Q/#fhcO6%qAȃ.Nͬ麆fs&cs&ZW!K+W6bzlF^cg\0-^Y2\ZlNA$oes+ex#k|=0:#u׿.`DVtifu 0߇]yf~Ux!Hހ,6q.y݌=XnѮ$o+ڴ%MM CkZ"UwӊT|OB#_{g!2~\wQ؈Tx &$ោz跶'l7]Lt:; 憎ːDu-cKANT.a;NZ/y2C~>,v8 Yj3F M2׈e5)^y-ۮPbΑ!kS0sH <_R7tU:1NCV[sgXZJ(4o-ւx4x&Z $1Mn8_QzlۖkdML84l8͜Q.I;;+0aёLfP8D@ # ו2؛oO[Kfqȵ}4=61w_}nj01eҦMG|'VKBNmatd 2<ՠxVzg]lH{tC c&?mY(-Ǩ<Y}s_kJ<''! k."eF%Ð5c׺M#TQ=~ofϧٵ{3ۜDxeu ,˱|>1>?g>)9ṓ~z~h_ףx7{ol+?|/=ʌ3 3ggF3#g2Cǔ;SӳbؖZ+"}Jo^?T=زk&Új1z'>b*%ޞ`˞Wr'mgi8ۃM/FUߑ7o*Ŷ@u,F5Cy|^pLS\w\mv٫{ N>c+hVqҝHoɶ̻y]c]kM药HW:zc'P/R9Ť1I]p'dsM1jcH]pd" #ܬ}3b0djm>(Cn|wLG"O"T"RX[ LHZE꺀Jڈ.R<`?A|HaQG+a]3t Vߖ]uo!QY[κJ3R2;gniB<ba30CP/60#u&f`~wb} 6y#ne@$*Zc)NCV9.Hӄ(9_(&~,A#u] 댝1AuwBjA; FZwAާ\ C Vc̥ XFTo@ѨXFJ_@i|,#"ObٵD6exRFz!Kbu@VIITar7ID/R:TzR-zħ z"X^~ڶ]8#Z}ڒX#u]p4~ٴp##Oi=dr% ``y2VLˤQ d|H"Q#!#Hӄpv#0?^`^-#u]ݐu1u@VL8ħAKTߗбqF(%hcKchG6b}FE6R WHħ DJz l F:Ml~oH>`#ۚVlkD6<҇&F6Rj"gٶ[vLw CZ/dIG꺀!#u#4>‘zA|HQ1ǔ+arʯj B@Ѩ0GJ9ȹƇ9RoF&DÙ6 lL6pu8FF3m%ZgH-`gH6o-E&XFz [$u].{`=IӠXFZ-{cY5^aSzq; |D# _j|##Oˉ hq'm~,A 6:[&}iWDT/w8&u# I= > (PSeЖ[1"?0pZ'fǁW _iTD %6qW/꽝(a(Q6puDA:M\ {#% Һob5w3Us8YFZMdRg9*AjxTncңgW _iT 'S&pR-͋wwX޳li\%@Ģ92ȬќuBV?/*I}iP4'O(WB]3gf׌ ?F:?=LJL_`&hFX?vh%B꺀 \!u&l i=d ]/T.D9L ^,7m(HDHӄv/-Ű(ióD变F꺀{!K=>{#u}Z##O"i=< Yjvvm:{zFxx&!],H 4ӍV>A|'EXhNJAGZbUħ l6D0:(Ĉ!QRI<1: KdD|SrTn$\I]p@+?A|\Iq`D}5$^6*iuSIӄ:(abܐX>{nH꺀 K=|~b /R 4(|փ# )5.ˌo,Q7 xF/Rz8yԿA|$EXdz$ne nrk2`,^?/wAJb*>DiPLl"I|Jv9f*Ӆ4-&.ħ a"ulޏ*Fq8qej⏳}0Vȭs #۠it<'G[Ŀx FW+|FU@ Qs53\StfC5['IuՇɮ1`rY>2N?^ "^LgE/u,;nA/ AV?q1`8Fvh[9llY 5 R On1nJ0KOCڈYSj)RRw8yHL:,O!7o>ԷFI먁])_.$É <Yj4nS8"}ͬڍXxd1٪]Oebs3G)o*rrpТ+T~_T+wXɱ %oBoU@~\6D mճ_߀n#vWcFj9D+p4MfMR\@--RY-# YUԺ}v ϝ>e6oԷGPzڠs0A.Aq5o9±+ƒՏʷ "t/:b[%eZB荠G/o-е|I xnUC ΂nK\rn)1WxG#ظJ4ubP!gX.dL~Xl> ;d&=P|TI9K3H 0(a8/mؕ5e*"hks>3oDoϱr95lG&YVWy:UY9v@ަ=W-^txĭx$>QTG e%AqB?W?qLo1\*َG)Jpr<Pc#_%]LHdT~ w(s{XaoH0{|7dh_9/M5Ư/6WP!qa?⇉L%+A.ߣ%H+ApÚŪX& Ou ,BԿ| 8YhM-ː.w7/d⢕3kIF^+@ i~CX@~an߂V09a/JZ~ %McmnR~ǕݤX$ Jl ݍԉ7hO?3ʾb蜆~bC~37\%6yex~nO{^8KwA餑ylDE[62.{׮&ֲ; =T%u{E}LTЃ훜4S+ob_.˙nֱc ӆS2)M7M?MN 23]6ߏDŽTֽOr/aWTA=ÊY)[ 0JdckU_ #GYofRP7Cެ5P4,u"YI-C)[BqSIj2b]c}4EX JTa?͸Ɋ‚fX?a5` v%(~ !O+c34뛹2B*+/]4ْcKlT$_n:G=/OW4(=EϚ3&ŋ<%y9XKxostYԏmqjg L77*Wa}-<Ec+^|ԝNCVoԋivZm)ؒ.КQ[k2u+f |jNO>h? Gӌ-=ѭId~yk%E vü&KkwZv =K/Lm Dso pL/@?w#uGl򯩇l(X >aM4J"XgۤJs{vaʾ|ʕ>|nc&|ڷ'Fm‡ ënR >)q,;Q' B6zkb b Q]>|i ]|bwD8.rX'f{HJ ם)8hMJwn9-U9bxHHҽ洨B+洨ZYX0s4~Cv`d.40£h`rE܄z}nN) 퐕:VSʶW+ @:FI?f4Oox8v HhlwU\NGRR7  KmRRH>LXv A}g/ckƻZ.{e+kÁDC#]@Zv9n} MV\{ z7sRw F"J]+&H/+󐘜sMNԺ7lZvhnGCj@wDp[B4~uEtg#')m/lK| O4d>VXFqMyx6`f)S-=V e#+,oQۈ5 R|%#C ]Z>76ǞD0 }E\}{QfyʚZiJ,)a^ MSfE)fBԠh'@3vI)8R"$mN}l"-?(Ҏ{ [)yLګ2"# >RKoI2 D0Xj|E.'tݛ~Op v}3,'&=@} w@*LwO(0[|=&1cPN?r}̚t9@f|ڟb|w*Esdj97sy!HyY`Z7jκI\J4%3L:VqZ2H ?G7=3*,,X _.,~<`PN?X~`ASS1R'5BOp4nRO{ÉSPtTk-/_I'Z3єmI}[ou@?iWFOi j &B*鞛t(F#yb2zn5=ѥ_ YB>պ#ħQ`c­S%۱储ՈW7(Ç6j5?G^ySJj(`7 v;:,cۯ #>`!攋lp+QxpE~I . ~OE4KǡRTO|ee4O^a{х_@-C^-$P] GO[GM^0l)ab.lf:"IGկ]9}tի"ebEPsf{6[*I0b@XhoqI O8(@O$P}hŀ DmJ/ '攲indEӡ^K<[.y2\N,\ۡp./?ӾR4N\sVֳ97k VYm=綊9D/ =:_\H&_RKW֣nK 鯪[_jeGx|HCU딉|?|-;[qf5 ]XѶ+zk$1gm tgCp]J<p7A~S= ?+M Y}[;,+L$3h*ȤWZPRl+IMafid_Gׂanv,Y.QdFB9++Le%t!Shw.>.b! ы꽐$ ~}QqGd ^\Sp1ǔrͶQ ܦe^sW:H*H;/;! ԇ(*t_9 ch臞n0Y]Ո'andT |*Ep[KF.' s2RK4tلtݐtTqN^B D0z<=#WoE]J3A҈rvwTx!zNƵpHw,ѐI ]zD) Vl_C]/x%n+zk;[vL~,ei?˫$H_/X@i =R뽵t?#1zIRbQԕ)eW8KF{leP1\0.`=4 .aO/kew:v_-K5Iۯ o)+iz&ͮ+~+MU٩+jik0m]2Ɍxͳ9[.qv-rԹ3W/K\`נ0ܸ.jy3f8x!(Vm7IuL?8]w5kt`i\>uT*mW߀l]1n`Fu-HټVD?QP[퐋)F GCYv!yXeR,}V bG Q&2Ymfp/FAfga[;Ca޿Gߚ6TX14T4.t6vʉ/E6∖5E귲jʙd)X۔sAR)ۚy4(?vB4=}FNwT?u'1?\(hNJ lܪs研am߆'.둊{~;[t*`=>V X;)݉Ivv8`óE3,؏i9Sd%l9o8)~! ץ? 6emŝ݀DžDpcg~H+l"8U,LI?ߏsfx`W6 D ~m ]|5]\ttc@CHܱS>6Og('؛\OW >UVJR·V#0!r5|U_R ~KHJ+f04K|z*TU库Mq{p˖ï=jX9pTʎ: *HO:D=Yx{MԫnxpUlJ[g5j4/(-JMV"CZ w6Ӕ邙5h蔡ͷsfN {Jó$zC '!߂&GBTl?tUf΄2ahP @[ᐵ!;%C4bIK/,uXCꦀA~M٭vF\= (KK} Sҍ$dk S"m!ZO;I=_&>_|97I1NNr;8h'>gYXA P}d-Y7]~ !箿 w2a\ ;[2Sq?P'[ԯ?Mr\&ct^YJNOr:Ѳ C3kI&,-CL m~_(IPȄ @nw}݆>1 -mKgJ"&ׁPkl](&N 0-@n)H.☥bo'f&cL،I8G}n\k8!:"*SA~B6{%@x RUPZVfۿvBn7 ԳTܲ=, /kT)R-MiZVHfd@_ݿ#B}[Nd6ꅷ-H~o??Pm54&`ӌ`2g ?j/,?8JZj e~1zD ؜i,{pRr[4.Iq DCCp3R7|6^yWB(Qy,F{k֒ |ԝ#by;sB~1Q~)/Uv8F..'0zb Bzeꉧ͚K/7:oGD{GZh >c o~-<#`kO 1`dc+W,' ,k]Zʯ:>GK=W[k5H33o&$7):ezg'*;E7KN%M6G$H}#'CWѓ 0P6|%!= ߁e9ϰo"K͂*)S|0Ҧ:۠):f7c~P»m{"HIL|5I=kT{;j<-Nri FoЗodENP.cW\3%% 4=mqF 3t]Զa8@$tlI3{@ ɋkdkSo ^_Z M=V(AM[_g͜%˄|+'iI|~I&I_5{% J?LlC @z . LOf0$r{HpY/&;g!6 ]N׼eᒅߕA~ݓ_ҩyYl{O>}x=Zl7q}`_,;Ij~`eCn{amv /`ԉ00-G}Cv" 2NNvJ&eqB$tߙYMVs5?BSٕ0\0Kf~Oe]rWl:_w/`NxR#[s隠%O42g ΊZ>z6& j}Wv@=aoQ" #rtr +ϧWEdj&"@kU z͚ZjcV#BpkBoO?a+F&jp\!N/6 EUbånG4\@F.[Iu0 Y*l;Uhd"1_#2gkOՠ {#/^Q\̚];l4K,gY0n9 HKpZ.AZԉry2d5U/X23~`emHȲջMdd9cYrt$sfkto{ɻ,o/Hb|bA\+bkNW%U3r |}Ie3RN+ g0TV-3ܢ%% - d90 ytCTOA|+n\h7)|&Uyye1;Av E|y qAeC֜d|V@H08N:[[В96a =NǨ [jB/>2 ʛ72iH%2*[+೨pCϾ[ bi4MMʵB`A5:AZI|~{UgULgd d-(M/==g;'@N$5ZcquGa۝b̙P&sp#d vofBOzrDL(I3-=wɥзdN.|w=l 9Jd?0IgFFFs33C#g/bl`f|b"Yabbj̝3/G^SޙS[wP2]OU_mԠ(*lO< ދ'úz'9X y%wbxGӶ4662gG Tm=,F5;#.׻ő{FyսJZcK*fr-npa[\٦u~菱UnԿhN=Mܘ%1bƭKuw[ק7ƶYX [/+D]ṩh)գ(~i\czr[fil2Kkc++}sϊgl:o8̡vQ$_g|s. '6.+snŦ8&FcfM+L1Trl#|d r Nԭ-zղ<F@nƪ gUԽjr@}&R gxLN2a=h@McadM(Oi۱s M揾E#ZD'B%_;sv6(:}$ dBZC8gͬMoR6h@܇*# .'Y, R]5g-I**Lk dB1^Cׇ2cg4Vׇcjzߘ2"j_KQǪ6FXF֘IgU?)Ьzf4wvJ1UT^]?&ZbظϗIP >7@- r?r helóTSyQ9&iXE1ApGRw/p.K1̱1@&Tc$RG5/nD"kYrmߗmt>ey͝)F>I?-!Ů1AW]g($1y՞}WLmK/p$ H>`&56#|0?  dɬZii$U ?ڬ3H_ dBEklJZp8Ȅ\$A%|T8sphfPft|m8HE<ȟӋxޡ˕boN*/IEuL*jcTIEmf|VIlglͪ >d?߽k6*ֿA xnњ5kwkF.fYooڪcICplk5nh)&Q ǫ~Ŵˆf7ofRazȞLWN3\6Uf+DKw#|{Ut3˜0SՓ8yUNd?+6ؔ^o]?bE/TogV h)N'CMp7uF.oWeP݇`ds MJաi`y~.kg)3'P*(}m[vь\nsb8W@& q 6| r6[QS0n@&T4GgeFDžP}ɜ Qmehߢg \ATak$v2/&s!t +<>an8rb ^IہL]wL^pk(N«.Solo_> Jzf54RC߫J.ZEM/OwON OLiTa7[[>{ozVN@xaL|R@p_xFC2&{l{l:֢pVߞbƀ `T *eHezT^do Y Bׁ/2asx35=%ZILÏ"l_̜pz ,1>FWho48~_u$6!m=f;P~gjnN{ bcam߬%Qǁ,yd+NR63 Ȅ 0)x *3 j7c]%S97 Zvj;4Tgm#pSlz&<„&T$9|~*EEx"> 9H&j%xEWPɚEod?fG\32i|Y+I@)ӼI'd~d$GפidVq5G 宆w(E;[v']~Hc10/K#`yDTe  =]䞑FlLS~6H7`,Zfn9 x GS8QmS!s< Qeָ 5N^\Kv?)OOtɱrmu0.^ZS Z)a%`.+io1]LoMj+9q/FUI1(G:?b/q nVV/ `qil9*33Y1.[A0E#T{ ۣB9Y|e!ERx,/ CKu9" ;2H)Fcؤ2b[noڍKKD !N%B}'Z&Hkb#x5ȃG^+#~,m'gvR4MUKB,Qt1ٿ`^9#ylsTV鏙bqĊQ 7Z_-Ǩ.oYh? W > FXdl>u \RVx*.Z9:Hc#4( m)<\5cfStN @˫KYQVNlcesQv|6YM[ioZ_{x% ԧ,t֢2k]WsLw5N:㨯:!vN!O1odNF{[KBl S~ ͪEypAA~ҲBMm\hnf'~KQ@MV4M>CF.;X\{JohW2;Z&>nVQ=lX"莀ح+q>z"7-Uh} hַ+Ȥ@Oy|˔TlH+F>o^KAGSI͜}5? LgӴc.Y?лVa),|~\2{|I׺M܏ e! 7^W.K;EʧATڥ{:J1K-9?mVK=`@t/k(x k8+HHDU}E]ܳ{Qe#HCmX@{ԺNQx.]ߨbQ䱓\RKyp1B7kB}x| ;"cyد=B} t^=Gi| &d O&mJQ7%Q1PӨx Vg8ߌ#7rY-U e 2\R.ËoTm+<-(!y֫VVVmNY%[乢Cη} ߮mot5#GE߁@Y2U7E4㼣]Yp߉NXwwi屟+N02\ 6 ͜ x|FkEmA= Ct(:2/,"wsWj'& nQfPYOX=!a3Wh<_k`s$z~~PkPl@D~Xk[Lֈ\aT?&40kvً4?s,? AQ}wa;*AW (bbR*zU揧3[toKc( !n!T,ɵu>ZNTλ} ΛHz,*? V5T@7*6GmrmZ~ڌvID" |kF۩O:{Q bdMp9$BHe;FI'+GԌ/~4e{.bͱD߅)؆p7l!)؆PߵU¶!{~4٦YyYO.}T;O. ۅbd~^&ݰIwCl3 al"Al3B ?lLY M~6YgkM~>61h/ &mM> |6,l: ls &?\lsuċ\?nEN [a[ 1USiPDb:_ŤuڃtPk?/{ח߶z#sXn1s.ޛ.E. ބjkjQyEn ]sSøH+5I["XoClZ7y˨1kII">lƶ:A$ ky",j#iyH;OhyytY:` >}7 !h7KI,`M 6KnjY6!ʛEf@VUΖZ9Ȃ[۳5.e؉J.ֳ|( 7V >cЀ;钵2zPu\3F.~j)fZ޲0Cع"[k,Qz9p}k2DNԺQ lϙnֱcT̖НR[¶g'["(:v].`3h3P|H'wύ'cT!Vv')7Kdz$sZ44<#T#mË$wl`x=2 S 'ٿ1N Z32 yh }p4 (wA՘&Ik=$] ò0s{6m=;(ܰe2/dXjs.CdEbzѿdXEwvlM0ókR-:r_-ޢw_hmōnё#(-zZEGa iVv>&f&H}kGk~X쑟8.P ٱR\0V54-(VMk%Fq<"Gj뢩ϡjiuFs<Ω<趇pfDx J"UqL"wȈ+NZ/Pc>oŨ,52Qs"3|DݧdB5C*#Ji(8D8y1<Xa;2.qxDIu d)cq Vc\b2c 8 Y}  ܈Rc3 1xԶU?NI}{i"ӷui( T.\Ǩ`AR+5i; %&!'eԺy> kĄS!Cڌ'm$(N@hU!U:l(N6k)w.ێgi 1cKa:#O@m"Q($#Oc,€գjkZ!nnL%*g K hdlCWf.WذBޤWE#,އ|_Cb9ꙜZ2=.`O.;bN*@5V g"r#;Q$Y[iiɣ+c~ib3nhQ%ȗc2?ѨJ OUFΕPM+!l\I?j_ Εl 6HpvCX-Xp Vl R_0YGnsQK^M7-kQ01a䬁y!R4*Ȅ{!a&I྄!1ŨL@Vǃcp FejmPĨL#جQ97$TMF4z#Os ؊PxD ؉r_+|c)% U4i!xoU bxye{\:5%\$܈?2G#~(Rvv: f*OQ.虹4Y*ڎu)x xrrYG HO"#(4l 'QMLH}{B͟R†)_[KvA!VD\loJF"K|Tėǧjǧủ1a":9۫uix,vۥw݋e'8[, fse&O{![\sS`7 E̻3QM7X& yuE],܌P醈ڃ@a!EQȣ)~q9x94Öc/9FiE~}[-';H+X)y' YjŲv޶WϢU@O`1A:ZSH :j3avM ng 痘O-Sl>6x*,s62-=8^|I /dAV.p"13{a$ZI%/)X)V/~e+Z0h% `c)'d?[,cpj P,CدX.,|oEL)>yr O\rLR{-|o]?>NI82#A܈ރW7{ioAm7>$ >~\b?J45/ؤ*j D_t"HB ɕ镝L_h[_^CE^K]{ӼO\+upڑNVkwҡe{QQ^5[~?k/XkxFv`NQM sLvӰ,&pweXq%RIn,cԎ/'*KCvlR%(ҸXrt$doIτN;Kfqȵ}_2{i,Nâ_}ǤdD %vDƕ%Icn8}WLmtʊΊ##on09>*L8YnQeK%LDmXyRw"d]Ryἇ8\NAR沙kf&DE+s擒cNQq?m݉7r`Of$\879s>349;:mޙS-cTăiX{ē02+`1̒goOe+WӶ4ؑ} Qw Jm7P7Q(3_xً{qbju.{u9YUV \9ٖy7ok6*CA xnњ5kwkFnνiMd=iTy>xo N1}col` R̿:KM³.R|B[u1Z!2ܕq(BN؎aS&'JGqe QmjHD}2DF@@{*$n' YjgeL M6wAn{pݐw'73p/d髜7x, GGc57r3@&9kD*q KHwsos-R(| kq!7!^'7GSii];&~B5RRA$B҉=rAA|+gxFҘ),3 6-Ҍ>bfA/ 9pB{ ߨo%3k-ZY_՗ɗTQU!bL\1a?~e'yA:ɳ##¦Aتru&9ea0soZpX>{q5M$UДrCL Φ:D=Yv.0sFx:3 .fB>LqodwHc setL-$^edBl "8zTA`,5Ex’Kv3ge=?Cv ;PI@p{,_N5·@-U1)99b̸=x5hy;ߘ*Rʣ!J׀j Du˧}c;.!ܣy<2WWl1"jX;ͷ6(ۋvd8FKtֆ=wCZ { A|4٦YyM *}blAoFS.~gdAJoݐbaRT&o{!&6q`6q`6qڤM|3 +nٍ, -CuI5j DL6ȧt+C_BF'}cBY7=Gw|iU6CFz~+gܸ csgr0.a>nZBgZ.aB}UDqC=kar$ugݨMr3iE۩]? ҒX4 4-*hv=E{#7rm71_B c!"&pø%l ywl5fe3EۼPi4 ָInWonIyQ!#&'g.h;Y'4dK`22 >ڍCq:A:kN$Dy(؊q̍҉$nw-}LX$R쭞k 9p~J>JvHI*Z^E875i6㱬QdF6kv$*+cU>l,:WOԴtA 50;<6A _|\AR#|~lF550gW!L|1MU05\f/ҍ89'%;<:Bԍ!kTsԝN@Pm)- 1yx#QyFSElϙnֱJ1o*t'*9S3BygDP>誤 cjfݐR$ s~n`zv]p] ')NFf)49u?M^~6tpB}3uC<A7~Qz=p>RkZw8Su<&oLݞbYvʹQ[=8On<,ӰG&撑]MIF/qaeKftld(NQXdГUOL'S|7̌{??~$qQj-t(#D/<\c_z)׏3~ gccEqT!|e;'ȩ'2GA02SMMkT@u-uqcH/5]LK3jw޾-N =ErŴ=w2|I˄GIdU]4EM=V΁9.&MZJL0GD Jܒs DodޓHI8ָGN`8*۠Ie$Ef4NP%G=<36rf$HFU%NJ}:%0 7߶syAP4QJ?|ZLZn:o/YY#' e^9˕W@0+>_~zH:3Nc _. '~ #] 2Navɰ ^6rT]ZG)>H4KysYqrhm|˙d͂)Oǖ*y>}b.Hx].a$V,vZC,%|?[ux%Fߏa~!郠A4޿|h>+/nZOP)<}~3mi:<6"t>Yk( kI42R~z,d _xіi'e.D)bpҞ YسfMLowbl@jd"5nx XP_VO is XH"xx ƭބ+Yz{p6 `zVInU9--HoyG <7dy8I:CxT)K#ʾ$x0`rR!Eh2ɦk,:NeU&GƦ Fq\oom,73JêU[bմ2&cUHhPDVg񑌱c~x /Yt}0QGn}I2>Ly^x_|ZٕW/{J򃛑[T_UM 8yFe~4Ŭ቟W۰&\ÿ+Zr!_V.*Ӣ零ht*F`yf!ڠitK#Oíj-U+lحD4 ܓw)ɴ#׷DCOC :"2 <YjKXCR*;MpxT 1oN +1~*4<Ą]M'XenLe'pordi]Ǯ{mv,7JB3ERːu6xCꆁW K51ӑAd%VH]*䫍+~:4<Ȇ/'N`dSjf+gEse+V>L1fFO,w511NAV9&*6 1+蕲9!N@9p-BwQEE>pCRf qlԼj Eg0 z^Ƚw}Å;[ j^H+Σ! ѓ=&}5N"<YȀ'^/NlRxxemh#So*Ag.zuAVw@ޡ[C<YbB {!/آestP6%Q"7!{Te*%+4UQzD6\Gk.a ']OEd̒BfFPÌ' K%9|{gpxe*Ԟ8m9CKk2,)Ī { zn43M3< lgET.#[ʫڠ#[M&fl=Լj/i%uA5S69bxvx/2ʮGH9X^;"==x54dUa'"O= .û"0KYTEe'f&ֻ!#?w+MgM&9fv]* 풺RHJ;p!_n| W"r/)He~A~hft tlJ{!K-==U&1mǏN-Ӑ!t|&R!KGVM 7 h|&/Ef'u9oRDerOC(g e sEopt𪫱hf=_/3I{ gabE۫䬢᙮h #TK,4 jAVTՓħ;y%u[hHn) g$A8yHzXu|R'$Z$@Q6uWg̓f ;w 0H'h6Rj(&m#uۀ4t,Q{4H)]WV"AH9M=$^ކ Sf6xfJI)g:;ˮ?~M9vBޡy:+&o_/F)P VҿHmhB%}{p B>^,Ӣ j@#ج?j 3mtiv[MS] ;;!K :1Kl2 ?X9o9UWm_402amQd8vB:~!֕_$yq^x+"jBdK61>6+>5qU+lKOY'P}wa=<ۋ.sT${!Mhlt~JfpIFg!K {.<\_RwxU-{BwLx!7> q_La(mqmleJk+'Kmܬch.۲Hރ|O㔀"O7V\] 'X9% }|k^Ij~9tEO61"lV&I'UaHFM? bu'ptTٴZXQC1K՗|obxzMK4CXVrE)8 2? FѻZbMD!oI:ݐ-aMzG!o_ l`/C j|Ge5VxiAS @m;3l9f0̛Yڸ#mG>&3ʦѹVˢ**yMnW8*- I]/V;iVVji6HE1j7k29u4}2& DV3 [s@XL4h5)LiI⣵7M0_rE+?W"E^:#C|AF_cToW8RCk,R[lĚ1N˙Ҍ^ ,\z67% RH==R!}MjK^>=5J\}+1\S2p4-D gR|P l`E]r6164r};jU kR.;NR׸3]v)~aK;{0w$7Ƌ{I]rUoG7X8~jU |upԄ+}p 2Ars4pG1pE}RW<}t6MhH}{|7jUaGFG#1L&#Hw6Q~JK6r?.fkĚRjx!̚9J "'X?DOAzU(NBV-AM jI}{5=V0xgVkc/VL :OD;ǥzc-ڗ\^|)U7QA_ĀduBy3R)R<YnZ "G!ԲЎd$Zrh`̨nimy. .+*{}=oBV6V9y@ފiidŶ/}߼4TJ^-σ=5הKrJR'n}|Fa4 M;e۱ޱ_TJ G-/>uTnv+j;٣Y~ZTq`eE'G_LkL/p̹__j^Nj7)٪]F#ZE3O/skEH1}hQ~YkQ(RK3QNݐ{9&l`CI61!lVQ^ 0aS ZNnȻuFY0yvN?02z&d]aZcR,f~52c|B^-_ g (OĄedbB I,kAmcگ͊i 5TaL;c#Vrgi'cn: {My0} #sIՈI}-OKF.b-O?𚖙d5xaI6"rxS1lnx)ވQNBV?XorZuuBI(ugL^ً'u/ç4ۄᏹH8sTǒHXTS t6KMRI}{եj7T{$|ǟ_];TnbzuUnMMpLCj Y}/>_ נX &RfV|ϵ?hVBt/C\Ҝ(=72^) 7 Aضe=L;th*ubZzNPוp'\D^AfoBoxfH@yP.fB꺀{!KQs>uAާa$q(|XWH aixq`P^#!+{)Dhxz OVUQwMLH}{jTᘭ`5n'qw"Qb:I~1Rԓ)p8yP)~-[6phclr 8Y\ڦSA֕EdBVOeZ:in` }wPi᎔Huw] ɳbY7$=\MZA0=;|ۜ1, ;R㡡@rVg&əF9 !uy |[yC>'g!m}sٱ.VMlo@n"? lQn']O!u=!{ ?Y:l`F@}Y[/]rM^8Ot!_VGQdJeO׊AB>Z%uﵤ@28Vt}(-SbMh^>&s(a6"mnĬ;,K:!V֔?,$FX ܎OAzY#OCz K#S 1LCKUH,uUK^|1.1 <%D/ xeP2׿\cM%* ?/Mz {ːu!{P<\}6Nh&u f' 7"uG!7"u)ݗl?Qf kA.A nxb4)(Z(p!o Ok8ɚrC7a+VW۠{H}{*Ժu]CW@iJU`[e@ƿF ?7`K{( c-2Dsj|[5[ A::YBNԍ!׿#uS1`uUQ&V/g!*ӢnpUB겚K^CSR 5Q8LBN@!0K1 2ǟXf;aSO+W!L8 6,->{oec%'SD^8CEFg ERԝ|Nc*y [/qz29 Y,ܧ&.J\V}7!Q܀ xYi~d)`{·6kf`C4ProA6 .0#gc{8,-0vZd˖lyӵESղ%[%YRW̐T^FTEM4@4 4;4@0 2, [CoU^?2CrFwtuw}?Ru{jXR dU Yi2{w4{ln'ddt04ːfZ 4 YfUzߏ M)J0J"g[(瘂^"]p? !~afh㱬C}\QާY D G 4M߃/ڒhtDf, P>(,+V`rR NyEZ>ŹR<զv*u!I+]lI!>Wk߇ d? Yiح]~ugQg~6a>ߎq |Y>}~q{l!2W!ac @3{.^7KeUr8 y>fކ4Z7"3|aC؀ƍԶ5nyĥ:mQ<LCNT$嫊U]އ4bny! 6dLi~(DmU6'4Z쉷J-0oڲu: -]6VdGl7SuHy ](W~.&Ċ]fӯb@/Ig HxJQQBuH _:[(OσyQ<<ςFI-Z,ü0xcCa5Q; tD7&Z[ ˵r2p`Y&9s I_CZcjP{f&Y8J;'D } Ն/az=T%8Rǀ1M':S:u+(jz#ik}pX RªUj@L `<80=Q@ ?EAcxSibP6cҴQXҴ(-:|Ƙy~QPP?W i i 3D] |>O!6ts 1Y)H&.4_K >As 0*Dmh.j9;C[vm m^%0 c-{qbiV#F7 j֑q"d5-`+.d<~R(ojۤ_\ܴ NF#*πB!ݿ؀Զ5w'JӥAQo݈! Eآu  \;G)gPg 73á6obۿfn`RA!z4=J?D3[/1v␲TOJrGx %L{V!e3a`-V`bF LE_: \?uaD"4J DIYzJ( 杵S햤I;<Y)wM{g#Gx[Np 7%Kd\\`?48I0+BV;ݫ=m)\Yl_m{{<%H<ۧ ,  ~U@NpH:"dC3lu[~@ek51 \ZǓ7镭HPPi;Ni! G#fQx󨶯5ئx';9ܠ >m񤐔Dm*_!e!k54 B)!%eϤ. .deL7\oק*k4xT5Y\pQvRIWe MԊ sJJűSȊWv'&Tn}ն՛"G絭$Bl0ٱaȿb+[BJpV ln3T;.AlGG޲f{h96i!WH]+Ւx*a. ڔX(A'ixSY"g+B6 Œa/ag\xh&j H]'ֻ%BVsYgC˸yrp`S !+ؕcb2%ztNn8+dSf'vm}!H̃~߸(I Wq4tjU9!ֺU!u=>!M9aE 5hH/ 6$mWI  puSB6p̡5l騄x\2a"va^#{lp9][l`Yz3xFm*p&8I13T=J4CwRp-e z@bhي}G@*>oHA_: <%d*,ri! w5Z8 GltE.&*/] YmEN#DŽl`aO^~۶vwƁlwTGj|Db9HI!: xV c&zme2Wv^a<\Jk]p.sBT0qzuOUِG {l`'2>FNGl1򘆆ԍkcb12al4DCv%{lzjgMe;ZD-b~!. G{e Mѕ$腇b!(O#"RǀLpJځܐ h~éBtEDSBVS."uB&Դ1~FJ"QmJ;B6<3y7B&_M4ՒWiR $d,OO\q laz-_I]&L%GkfLi !r\WzggIyF+|&a2֒I}SmYY8&[,chʥwhviYb\s+l6-mؚ[`A/ĐR3"B Y-}uE_rJz%2688]TM:tУY*㌽or{:{dVfb )6?[N*dP(FqZXo,8Mo'448F ؤNG]GƆ M[v~s_ٖyiۼy|'J]Y6+ovl.·Od,nnѸn` l崬#1 GLڵp-8 tdjΫ8*d{bj D>醉'l|־ tf>Ƭ1j'7l ~]:!B6{cwȺF.PL>~xs7tE'W|y333O>̺`XW؍cc׆Ƈy[>yŃ BAh{P_T;h&bj+8}5\š?a1?}06|˛ v #1jU+֜~C)6*F1|E]-K/^|5ܻKOjInѯy4OY Udtro_o|,o㗝wF^FY/g{P{1hk9ֈjmR{Ӧ!$^Ғc_VQΚ*-[|s+o÷2n>/oDIz%Ֆk+jm{|.Lxk4rY`a;}#BHO26jj%4SB.d "aN^"QИژTWzGɢO.1!` sOH;4;^0W.ДqxM'l6*0 [,Rw80(K >ޞ2Vsc:)j&tL MeԈ  ~Z:ix[çVc6jl`[,foGc/eCB5-k֠l40 J{c0.E?n)3c°"^f `ou ;KahKs f0R,fWsE_޲7@=HHOu;_u},8~f6roR\2LJ63ez vvv\g@0QQ"F+R{Ү*28r)#Ԯb߽swbQ"w`7u4=bqūy&K _/vR"No>o=!7.}v7 ǩ׳9P'D6x֬gwzv#VY~۶Y9C3|!~y}~n"[̫-^~"rDNՓ77E gE}`f={5z7B#mұ^F 7&EzeܙJ~ a=+\9Bs|s6-DCHi|ag|6n.+ Zٳ/PJ℘B1p&wd`uڞ;Kӯқfgwb6 !ޅZ*]H]29ף}w+g_~Gx)BȄ2zm7L]u˶MKFU %_sP08&O&g uxtFE ($LR J\4*.WVAӻ S|v N>xoj:_1| =i-Gv{ al4{ aQ)վmH2!$s|'l>5a.إ.vyv! mҲ ?^1dV.IJ&IG]llB (z6@|/1e |6lmY䳍ga& t?ErJ[saMpç4^4`o {uyKoOߵ?zGN{̵zdǍski奍\)06596]fNPM+?fN%~NogJEY,ߐs^FNȑ&,,ωߵQ}xW[RK+{!̝qg+g/~{ܖ+kw.i!,C{PK~*_#|:3ϑ2f48\HШzU>G!WVyZE>}Ũ5^!=FXrvCV*ZrUa(xZLCOD!is1&jYB>[, H}_2QU c ByZaSO±"7eN4,dsgboMprxޟ8oZӢEek{n9>mȷi,{{immYoAx`m79Y;K{ݼDO%5z,2-ńs|u}/X[5V w{Бv*/ۗuAvM7M[̑Xi4<ƾĮoDDEm@MӁO+B4m;GG=* #-cYȳ$oI@ZMPdҕojkb&^ib=׈>0z8Qo*_5Q#GT/W.7*%];Y"\1xN +9"1f&2HBGk &EV5褀 4*Uz>sB:GJ{Øԁ\A Mt&#SruMҳD$ j.h''4;{8S;;* -Sw+uPO7 %mTUI^D#f$VY;ad0Eӏ.@]?¶\mk3o`jEE]+TvIGt.Gh^Y].F|% aGk9l2HHIJAEff~ ce=C6y2{ee{γ0Mbd1˼}{ ېQ[$D2&"b fhtFfJhPC T\4?Y):ªsl\wob*'!O>^"u _v&i&S?R[^++5c>}~|>}~|>}~b#}:v`ciGu㫍ӑ 5me=$?NاiGu8XNClOÏkӅvyq ;'Ǭ'i_0[.N"Gʔ(PkJ$NViVn-?ģIg]ykTq\ݦ0l֡nE64If 6$5㺞ś]3iH9]^e1ٙ>4߫L< n1.%`0 v!@}.CV :Rwx~X.~4'ٓqja/('ٓIxdc|b#WTr:5xx|[.[M#SkS{Ljm ˧S)xvf\ejCaBufW\̱ rSkmmn9 Q[QӺV-D3tWf؛8c88A3inP{/n}QٔnSf:zv_~rr!}`v] {tlp lH}KDNװHN+KBV i JwPwl"kg"~"~=*t #y[RF9x>jI`;vcuz\#Tiœq_/]=eȍw`eFy~ Lz2XorAt\IAV:*Ɯ$u㐏kt{!+TFU0EcSK/wUC<'tGL%#"9s T%atwM ːmss KTۀ]⠊Odb'^!W#uf ƀS1 C됯wU+i iR r\;ZnR 쁬62t%' ݀^/_8ktmiN!k'ޡNY)ߔ#=DD)[&9^qNy?E`ϭhe" }O8A֏TZ'NhU8; ĎA63 &=4k3 Fm<:kvCVj7$)zaEIbCMXU+BT#NBֿeLq3h"4_&ۂ.dZ`]uzq>#cd IMɠLѨj8uG["بg(gVxm0k&\{NcgOL bFaW Rd "|$T$9+|HH~:#2SiuR < YGStBB>k&4Ϋp9*69YRNG Yh]w[LBVf(p &fD`x~zו[bamwC ?K2}OXJ!R.p3f&<^{"u']i!kzAɠbij8%H["<%XQ8s(x]!6:ϢBT/j#L%I -Cq5x4M9Hk 5g`Gfs%پ_$v]@j_ඥ]ai,/;x r&HpdH)bryE]Ww2y^d| NM># YaPtjjҠXw'.If`dـ]&NGU5 `(AffQG /@67vzV$WÐvɛ"0 9mC)ɪ+EXV7c㼱H4ڵ0ݐJ7P5issO@>֝Ȝ@6!u'u' O/PÍíYu ЗvSZE}a`b7dv,Q욱.F\F\ '!Oj͆gTHqA| 4y1F˒tԛ܆A&2[4YY$a-yq t<@ù'W!Ϟ`NN:=pi*ZY2DLZց1%D3C  7a%@"@V圙5O@VYE? z|{$Ic߯w?A[yRѤqSl(f-dr,- 44)Rb6ٗpDn,8ɂwN0k0_I'9H"XA-0ٕKo zD X]d)Ɩ&j8$;G!t˒hLDIn2>2v&Dj8 ^t Y"27ː' 'oHYqX%.܆,dsg:Jy?x KDp j/sqfS:kE&!j8q \P.B֟lQHF #h2Yd喆a%t%.RY[ vf9'~ &cV&N~w1gB<,o#Ʀ˾҄5_`޶qmbtx8ؐ/\Du|  $"Bn5alCT;!w־)F#:q+| ]`CQ4Q0dsӟdqcMCV䍕ހ7'"[4p~L*Jcetm{f`;d$J`ˠ<4 =oG;GJOl[B|} BoV?"sXǭ~$VՏQ\0fvAf^J{eUJ|ԝ +%6Ǐ oCViH{#}Qڗ<_#)u_^\}l_|{^}uS|Ln@\L}/I&4nR e`0FO@6ZMs~Id{؈=r1/y $;ڕo)r ϰɾWAp ~R+[LCi($l>D.J-\S@ꚁ UjqIJZL%B!+R> d#I Jh\M8!l+FC?\»__+v9ܳ/ѱ!Ү3~Z1}o.r?/TfVܲ cWlWX.6P%\sVs6 q0ݖte^ "qAۍ|wMh~pLl~X%!+ekH]3 3DIY9jFf"A{B>Ӄްm^[M˼\5ߖ2~7#o@x~3~1䬠ld1IXGxZ#R)4MRw 8Y)hK)nMd)g n&4ipfqOA6wbr~wP)ZMBWb OCfž~m|-PDlxw :;r1-aM)g.x9e1~ mڳFu`J8 ywCuf:;=y-%{8JJs;Ό{I}Sԛo@ ^Ό-GbLn C7!NOqz)R#g#GxoWjz * f\akkPm;w+'B YΧA>nN9pYݙe`H'&WthtDf\_( -'$vADM$sV#t 5)6Ԉ~;:!.l:2Nu>ԍ_ 1 Ya"V1 1YҘFR襋3%nAVZ!u㐏k³}8" g>-<}bK!C1 ^X[iߐl%&"W 3RHc"BE!4_Cː.62IT|ΘԥZiv*1ހei0 v jMvY-Vz\GF& ~]I-;zm j_o~Hxym+_BRV\&q tZC@W z)Rw8 yV@*8D6p!q];..Fe:6iuAZg oJOg؎[dEgv+"[,_֧Y mɧfV~ | 9" <Yi׽\0G:'!ˑǤ. 셬4۷gR5f]H,v")dsɅT"&3[9I,dΩ _D6>dP}w d֠!"q8$ IOa5JSO 4W 񽕞-;4$¼Git5w!Vm^JV)rIi6UK;ɏ1 73ávik`?<\~4@zGP?BlQ'Z4~J?D3۴ZyVI*? ?E*ݖXTZiJs=D AfB"4 .C֟d(R/x4iFW+CVJ^9Iy^:dY흅ԵCnĖS4T!""W)Ji<+Rw8 yX| j4;Ď3V>3dUxi.ȉiEJ4^|IT'D*\'*Ü[PA.g!+RZ֎oG_$MSo%ziP9K&&hJ7c0ܤD dJ*h}Y6TR3K*\Bz!~z lݡ5YO"V9s }a ^9,ǯbNV:%uLIꚁn EDsd?{e劶|xyq N+!&WDC{ɟ@ AA KKTG3}4m\?G {! ӥOxHM/R[YE-xl-,缴ŵtAVZߌͭ>}͠UXJA&)YusCq8nL\1yM:N &W ?+a n3gv|:9|bodNE'6pwySne*0/f~5+7U'6=/_A_;Y'c{ 2h /Ԓ

a͌5GPËA[i\qC)ll!6Qõ/j0mY+_#ӅZ[k^$M1|iTKyx7r*;eÿrj]C1ikmR;ަ)ꖿ\bW/U gyv|s+o÷2n>/oD*[|]YZԝYYx -_ثv!Ŗ ~Xyl6-(NC֦[4#?:ɗK讹Eg9'/^^ܰ7/̰yE.(L3Ohny$f{۟"zğ#“ҊT ^/R~}Qȣ[ߘR 3bA& ~z,n _kC~'һ;a]My[8CLd& MMoztbD+V]ek^,QUb{1 ؐyi!ٕh|e,E+be9i E7JNTF[E7;oX2Sk+M5&ef\%uL܊>}K/i7͌E Y_dϊy~=f\$XEl/EX_Ra?,M|U**^.;eՌOxhbZLx#'5aHF4'oNv}W#mjm!)޺w4+? ~z<7OpE2dqc|*()QoNh__`JiySz)i *D<$iEDzON"<7&;< A1Y"a.mo;#ǀ!+MVuab|v灃M/C+Կ$W#SJ5ynLIm 7EPΧ/%%!,[ֳCҌ2fF%W;D3sr {) ЯUP"3WL+thzp3+rJXr { h (حa"[3b'olttU7P$%iCwflza-] S2ӊ Gx>"ctYdm왵i3˓/,͵ {+<ۛK<]WTpsv3)9?^/ڿ _dl`1:9<]}n:og +dC/8_ƉE'QzRAAf4ؙ) VD3Ӂڲfmwː_N8{ @>uR {#Bs#."jGGcwr j18Bm@9L9uP1b.GS";I] jXl>Ғx/B_'Un=y QNϡ;D3N9G9տNȝڬ\j*8V>cfs%|^'01ɓi$6(rRRJ3W`Exim7?Mqئo~"e&d,g;Dc} {Ш I,K3ZOǺ<ß7ZQLV__0pJU6RGP!ZG5'HE"4ap7FԧNt-NAzgRj[ !Gh$D\4K@qC.ZN|X00}`[?6-&?ah0 NJj?!#}`#FC# h6W]e{zȕo}:TFC9+e'xs>iƲq\[PtZCيZp1SJը׾Va mI6ۏ"`u2ÉZ ;`~_)|MCJж6P 5P1[(FkݓfTt^Y9;.#wp<9.V|gmy%x.EPw8.Eҕa'־0LjTWFveGPRGV YHu GA{.ff2kNwp47U~ p8:q kO95&vCsɩQ !.p'oD}Q< +a[֝Wv^-l2*J޽yy-MEl8 -m-)FWĞ%}lA|\=w5ԣǀ?8?6;J #^ 'OfGc/}xBsK86NԸeOG'匑apn@>ڞ:͹^k%V7Fa yǼ{={{H?^p/]6-s\ /:W7Ay!a`Qb b8IN4+)du*d܇GPGoRc(y7H&w!mҶA)iېe CI}'Nr}jZ aU/GaBꏗ1| E>˾!X0,r.E1MXo2ZT[ZN$3DP]G~-g\~7FY^GcSkٵkNj#V~dwlogJhnbIwo9 /hw'H9ߵeF_io=Hu/}q0'C?O2!UTa1? r p5'gWʧ7cl>G{pG#'b!xp0 9BE>bb::^/sISs֛Cʥ/cUlFnب^ #ǐ=Z{|(isP`$ _WA$ B#ǐAڨYs Ŝ%iV؂ rW#0]HEhڥBkRM ]ӄ+aUzc`u].`u2K;YeWethʱRvRYbI(k7?W)$ w~zɡD9*m*?nrZ39X*O. ۴<[+3mgK-+Zlg|x ג}HSiaJ5z=Bv<z7 %U&|X <"W'ԋ,4OY'DojӓNB6a D;d(]aHas2AִHwZNmĀ e <`H['k#.WiicvMQM.G h[J'.' ƌҲsl2<[LoCm>-ȶb yY)gg" 1o Śi6bWFjOr1iK8f1 9\>MW*LevÇ2+: :쁬BPQkų q2F>`3(eSr"tzS':;#БɡPU?,liΠE?=3(ܧ`{[n޳Sl+e_rjS)lͲ`G)/I$iH Dd×''kR|*܎Fn3؎^,v#|U3P']W^$yJ+ջx.Sj@jfF0hy5TCAݲ ;V9KiKv)g&*.ǹ/abs^rt v@1xzb(++W Er08V!xY-ʾJb(a1zksY/ŀo`&\Jn[Z'ZNȜA3 Nn@iiy[vYaNf6_9FQyyE#A3=V(U `ذ9 z%}m)쌎\^]S;ӈ0p ҌQLmYaC^J8O&~%Og k?)Ɗm<>dUnW 5ҁ8+x4i Rmk d\q3O$!axFƐ P">De8y3y&ʨi#aRD,&֐D4AǬ))HSSxt@}H) u6w+/y[ȗ$\FrOwh:ցT0xSk"u^jU)̻a*dMQ%NأgKn[69k48M jijOÌN-UH %Ks Eyzɽ%=#ǁݐR2TDy$ןP Fq pP\RYm殲eQ1 LCNw >=hgCVpB}bY?>8L,߆6S,6z4uCL0KK 7h4RS :灑Z; Ԏ"g3YYw"b8]@1 ST`g^ S:F5)3Boէc0ӱ2ӱ<ӱh~:CW +Mʛ&-%RvhҨ|ldқ2KTF㉺ǒ!3Kl&cO7EOȎgGdJD<dQ9!u!_vLNKJc 7!Kڀu%u7zB6rBvCɠb&d)mNNب ȭY5sBdx!N}6'hL)2 s81ɏ^]-7|dE\nBVP7p NM|?x~  "pW9|"+tJcdˮ e"5Il YiDyIE4iA:1&4jᒄfo @aj9$um:Fh.3/&d#!ir^lk#s@\0tTy 8Pnj8P!-l@e%?kO8j@: 0 NB Y3+%A5g˻mW!lRq/oL9cyƁ30 @Rgy_Ikjn_TٶtONn@~ҐFv^Xc6c@_B!um3r,k_๐o99"t.Q }N`݇ Q:)nI}K5_D/Z@zzjܒJ1Գw١nt+IDh|>MOY+(kP;iÐ99CkXĔϵw@8y!Z$ [  a"dVԵ/AmqK;/6{ U{Ql;z>莲 |ڼ!7"ߘ1K DNUnA߉P $ic`T ]uQC -bW1Jj RH}KD+kt$hB7!{ZWď6۴^ژtܲ dKoC_QT쾐YQ;#j~DR < Yɛvp8è86-aw7[/-Dĸ hnhi:V6u27U\1L-dznGy#<ݐ.[ڰ}UxOC*zh~BU ĸyA2*<5蕲RFAt-|v{)^jdw񿏽hGE+'U?nrAbז5ͷHo[ 3r{6VP폷r̳CQ$ςEj*# HGO+)v~%Dl~H~;퍠`{a6O~S"ZwrmqK|N9s/q_UMiӂEiUȖtZͯtt #>y&Ԛzy36pԷDQ@_@A 'ܺ[p ٥*O;inVY4S@v d'%\h[{籠-4 A Ƃ߶mE> @6#x\ cDl= Y\.u*oB 8 yԜET,r=xa1 m=I4Pڦ]_X!lA*aC!Ҕi!yi^~ߏGUTiw~狛s7 uN uGAx+g),T>)S iVM¸l@<"X&Ե5 =3kY9.-:Rv`?:5sxa=YJhxK.$\ojºܚKl3V 2k`K<.GO;Ժ4wOR@*-)ãtg 4{`{AeZfc:xjfn8Y?ږIM`ZmRm8a Y mSOZ$EWJD Y)z@p5x a6%FO= 9M4f賉k#F<CֱHoGڬc.~rˢpЋE:^e_~.U+˶݂ʮK C~l&CD |OhY3BЉviShh'A?)[G[擺V6יF^<Y=¬#,"ń b *WEGXzq/#/em㿄X' gi`dzsvF:K88^cfx zXxRӅ⩇AC r!vhi؍naC9֠^]$mS KZZɀNe0"@KT7sOI۔fT| Y-66w#||{Cߏ MyKnbSXA|bfkT74:$='u3;$,dAi Q8x EO=,2YU^@1_Ow&R SOҢ{(.d y!c^h`FR 40m*&ivA2fM'SpW|fc*Tvx\-/^h=uHq{- $ё'\aLM !pjx8ԷDQSP[Vz8{^5bI`d) xZnA%\ 6jD$|ۨ.%aYno ((/4vY3tsLEw&$H8 j=y%۟qQ}, 8{l۪%7+ K<6f i7g&.L gd<S>dm*o!Cɷo! hD$>F[[ym%%ixpr[A`P|XϕH]0 >lKW_qHZtfeRY`_BuPe-)XPPڋ;lJ+y`B4&c/[ 1`!Х/LՄ_x3 ^Z?*:'t@]Y u3acRhru}ԝO}l)&rLCNkԦyzy5)Rw Y)L"d!c.p ~NI[LQx;56) Q@i_GHA Ӷ;Q8 "2sE_],@$f9 'f9s^Q~pp@8^ A+acZA\JmX36pޝԷDQ(m]+Tt]C[ؑнu H1-C(G'N9\):{ȵ>d|՜ԯDv7@]~O0wncXC>ހh Ao`/俬k˯VQv%˯{{ Ŋ4ͼ784G^+ހl^92\\Q,.BJW5R7x4i<)fe\^_aWP# V +jWI_Ay.\LAn +G92.CV4wN{cNW uSnvݤ%꺿vMGWx!c=hθ5'k36O[x+V[ [뾉"p\LGf hϬLJ6h3+עTF+I\ހuڤn 8 yKg 7" 4WLVx"a;mPNԷDQM U;햭+a%!+wm F'\UDx.cs3QIG Ծy#uG=:cDe .0jSۅ9A39$wOkv8w"|!äAVވ~*E)uJhv$cm -G]4o`_պVE&t>2~; Yi;ns7adh xڷwn8ЙXF 3O7ԯn.)zY!F] iEH]^|J.^s0c_jK.ўa3UW,4NWxu5'wD+۪I`KV;]KߪۍDNM^fQ|,,qNWۧ|H 3uHIꚀdlБ! @j(vMgUvS0H4FmԘR|G?R 0xu̓z-گ-86o3Bt;AH]`6!Y%}`wj+IwEB4.>]Y0c|3,gWRL4=@:Bg%Ι4U/ðPGiXV@Ê'jU80ɿ*I)łezhz:Yw9n^>8qLBl9,?S넡96An2hjjW6jQ߭k<Ў$r 9N%urm : <Y3k[H]r~VP_%F 8Yi3!)Ub{dk gqI;o} !B}a":Yb$ ݤ'b,OZ &s7DT\~=G Ymyf@Pu}Tғh'lwVEA<_u([4ߋ^Ob$dGR{Yn1("BӉҢj "\ PH];,}}IZ]q}a*Aw1Mh7 A7T N@lDu4b)Jg!^3 +r Y?yB~h<ǢɸJbwkcGu$@Ӡ96  v6TC#k3"s 8HpB3RA< ~@c3R{`m;+_@xRz^^Jh,WSI];2dLXyO8AkHf4AaX hAI`[PR8iA[ԳBVZ,k9I19&!15Ե 5$ xyc-g{^Vǖn< prr~59yOR?A< i<-4'?6[ zul1; vZ6@m([୿%ѐ=lP`v('Nsj!uǀ}j!u@0E~ A! h 2C4d^&# KQd3vl"x܈ zc8(4~Ye;5b3\D8($x(9?,d~wt8y;;Y)󒺓 S eD( 61\ Jփ<s\8n[ˏn4&kߺ7҆>a&U$&&%P\~mC/J-zQڿ-;*Çؤ6]:?GTf{gJ0=i9y%w9|nȀ2~)N8d_ØgP ,Y+/k劲JrvE3EׯfGm2JG dYDI%:Q o:6d9yAV*;ѤJ$WqilQ=䋝&2=ӐJwዄg ^#g#ǐIUqx 2F"#wzU{֛q88߽ uj8tU sYy'geHѤ1`Wvng(y*̳}ɡ+la sYq M.pm\?;6bKi"#GF; d=qnA%{:D3+kVP6y~5\}dp5)jwWIǨE"^;pNw 5N@6K6fIJdwް Jk;ڌfe vd`+>]mgϢ5 +Z~rrJ*>ې*eayΓŋ]xeeL<6q~]˳y~' Ytn&MjsR"M'4C$3p2 'Qv8QQk;}륝WxwCRO3\)&T% AiJF\ aL/C V-N+>D3GM2YkAOnQPhU?"Wܴ9*bf3ȹY-.u*6QC֟ 0|goL3G2xjx[-- kbmdzw^E֧|pK BmWpB(}?]7hy5=bx8S(pَ #8M %b4\?v6'.<1/-vmVO+=;n e͍-R H=$ƒ*: <Yi{~EU$$fze&4T4L . *ZGvAPy*,9s3__a ks< YbӦ, hN)z&c+y湛HMDҠye.6[8K3?҄7!맖8tHA ;郔(P@ r OWkcR < Y ޳5Y7"[znSpX)iu~Sp3m+)ۋn~XhgAXix ?[i8 Ym8icI^h.C2 3+yj.ufYtGthNHIυpޅ܈?cD-âf<[)|>Eꚁݐ6G?q@IX=+nGe"@]mvx~mjatNbYy007oHD:H]3ܐpCtDdz!믤J$!ٵ3$PA:*IOa7dGN~&V!ug!+&=x %MzDE!۞?H&HwAϣX/@_Э/j1Ջfo`C["ؠ/!iDW7[7[bX|D;)HGeMf@yEuY@q+DL8`]lKkiU].C^~N&R/a'NJ);\xu昩/^I:$!7`_;بxB7~<ج4D%1atG!6 XktU\}R+ 􈏂qyt$"fz跪LcĮtIJ r_ {!/S("҉s xMIq#o@Mk*p򴶑 *5c}l-'j3w!M >k|8;NOXI߈7pYmUō;.Qz>d-uF#mͪlKo%"@@R!Zꬨ ISAB0ٙJ餾)xˊ.I$BģY*g[Y+SyD'lExaϊ;˶)DdxrF,"do) "G-o j>1`#o11Bҿ Y6:W#uK($"m&«(0XJaL9OAu( j;4pźRb9VD[YO">i96Fz6AVc lf "mv;V@ ;Gb{#ÚcތtM:W!,48 CPM'; d "<\}oJH 3nQzrCo@ 38SEk~%fwQW U$' <Y)u-b$"< M2RDl2ȵk pЛ"+ېoSއG6B"s+ [g4#'˱v=T'³>@"u=sMe1  +eg7ku f6Cm$RFH%uP5@:fS`|D9Ljr׭>lʉfO,y7\o? Q>t.C^651iKX){\^墓(rOR<kH]+$dz}1< D/BC3Rw x %m8 ;vq(2p_~CfR7\m~-ۦE[fsmK`o, %C>n_y+meh&ĸ ^hoZmsD.C?y`<088dS6Sxrb ug pyAd+ 6M</-M O5`঄u;/DCǎ%;c?ֵBձcWtvq-4.F &_x]ˣWE'KdN/r.w~z ~'}e'@;)$dO 8>dKGT7$RǁuqST:8IAgo܈SmY5I~ॄupR p6jQ\ U݂\4KW2r8 yXy0L:~wd(nQ;H] 1 ܀Qzd)x^|_ԴTQUv@0+]q(^t &\X'w#/~0N]x$-Go1N[C>gPfg^!c,~My>N#>럮Vñ$=qEEJzO{k? /&e2AϮ@. ܩ{H:"EΫ౽T)92*H%]yJov-/YQ6L1c ̟L_ Oj8~'-lgQ?k Y`W4F/ _0KR G/бuN-߆lrE+MSwW9 \R`I`-R煣[F]NR9 |S3GI(WiaU=`m17+Ն_? LA6'j%4WCI}:x^C% 5]b YnԆ^WٮO/b_;޿>M8Y?DoRA73/&Zy圇 < YiTEQ< YiAZ2a_UBVX&vFSldBO| I4{6o RU5ʆ\}S5nҢ) Ҩ:!>DŽL(Ϗ3E4z>Vn_3Q%LSߦ[fsiتov_o6ggwʾN+s|/g }aϷ؈^Xfu2o}b4 kmRX k(%=7nfTRk7pS+:˒,Pz!Ww%pnl/ڔzƠx6ir;#; AI" B״Wߚo"r&:Ppu-B60Cq|([VYW!F@&dm ,#onoIEtrC_:<+d;N~6I֛;瀋B6p&, v0266IGcGQbt[I""\ \9%$!&]pBs;{ ;'"K2>R}pSwwߢҐ%u$(^pinֵqE_xsmpР`RTFM@i.jS'>޲ -Yl9'/ ~-2!M%ݲ#e MN>seQ4CuI0.iX[NW0HP.\RwxN7f Ͼ<ŷg;yϷȦ*U9~.!ƫƌؚ(Yy~1+zF|Mm#PH@lt3঵^p|_*[m.N~dhtdw.İGH[|i9-*Lic7 "YzC'pH 6;)aV<ɲJD i>fY+XqI!cS ^R9"HyئoY(V 0 !k9˻/l#6ЌWgߣ))Q(G }ttjd8BlCHm'WlcGw  dIac'ʨSԉuǎwr@0oOZﳋ/> pkNη v>k,_7?B(EUC Ϗfݢ,v{cnw QM d>=mj] qڵF\ott׻y)NI3phR%HV%iZIzh5R\F>էKJ>` k\N X$) Wn*AlI2cN+nY>=A؊'l@?((pN{$zR7tꩶ=g#rED ,4$+!GCppD,_q5Ǝ ah+у@-A\t҇&"PIn2(VH*^+ԷzGM1|PɅJLfs>m+'=h ͬJV#6nj֘cHL=x1RwH`'sWdg}O[z41>IËi3mM*|<}-H#N]@i\wBG }'"Hojfxy0/XڙZ>+[d &A'|sv@HM½'pQɅ4kA6:tShhq}=-'\GYB&$FT|d]SN(Ua8 Ӣ.u  \ۢSily%%8̈́<"㺲/l4=C&HRG9V_z'83t33 Ѥ\nf\.]ϧH8O/eI:.x:s3ƶ:wQ':1hos7̓4![x`SpEڽ F VefL0eCK+7pfq7OTZ 8Ml` 7Q!PKڥQmsB-Ȏ8ƅlEE4>[ BnR=/)Ϋ.]r+`rB42,E)z }<~h_p킝d_>^0` CQ. ϳ֥Vg%R-yVU1 RҊZ㓃rm!!jwఐ/:B{O8)LlBNjO'(ނ,;Jm uäHQ` ҝ҄h(j;ݷ2 Xi(?N!]7Jw АPפa"a(iDiB60?^eZ<ꩽioYަԕ4uH\S .2[.KB60#>m$hB:z9!u.!yX=kf4s!=GIdҭ!ޙ3mk)Un/BM'ޢLEviu7c _6pӛl+hG)t(m~8yݻriZ JCH9J'o$_}!J)GxHU"&o Y-kHm!F:$>("ϡŶB6W*N}w!셻ssAogn~ NRT #wl`9i>]F |nCh>QOXY R Jp,'/nR01 Khds<~9nk[BV&@eŏYKkо yଐ I}ґ1Ѹ \ڴzEն. /9S7Q[e_4^hޓt>sD,q7ٲ} N /~q>OltD"b+ov<ǻ|9$ICLM{' }jMxO팻A6!P+HLKmonmĔM=)dd1| M0y!%Ij0Q{ /dO؍'dIDg80@> "^|Kg[lB6nvg?us3?0?U3cѱ/,`gAz-Uztl4ϟ-=}8q{6/Y'}}7_̷?s1 kTb< >ê4| sOjdX9+0CC)6 BUE]-Ko_j{U-5/ITF[E7;omse\VbG0{${j~7{VT/5;?%qx7ʸѺWfsѷ|*,Y[^p4d=+.t O=|+aw[lf-'oC"&{ {X_ߦim!mfc!u9!-M*;e MwM$D"-pw{nK6 RJ'ܟmϮHiz˶ʦ |.|KY$Qܢm0 Y#K_.u"i$^}Q!ֺ^ dinH8pBȊY̳Ovh̔1|Y#fMo PSu龖8 YqMuʺKwq<}jlc7F& ^mU/`z^6;x4X,V줢3>hIEcj1hԌ"M)kANVO HQN:]׼QViz1To=o5⻵Z[#ft3l7m2+ICrlK*ͭ[hpT"]\k\ieM`a;}a&?TFH^G P2a=b )υLxo>PmOvXe/xY0'dzM!;&2ܘȚB/ i 7QÞ(ڥAUƧ{jB[GX( u{Q,Mfe%Q=2,0cks+9 Zn(vg֠;^Jm`)i[ Ix$铤`=EO\?$hGFI y/&Ztk勶ք#`=ͺw@俢XWVwcRzkA7jgٚ[K1g=(!sfżm~"^p/"'R o}\XvP.v#o wwm0$ /?Ͱo4uc$>m<t<$dɴiL3/'yT:a|<"E9K*#.}Xo)RU_ͯ7y;~ x|)oCoM ΜZ ;٭NAoCv:I%u ׾~;d Dn^Y@A_J~^ыDO\+WQY,e(/c4:WISk=;Qi<sW>t*|kpLqv1YsI f!o]xBolɬ-;:,a~Fb>.&Ap=2xl<>\t0;+f >c*3 w"kjA%-] FMulOaJ_S54+.4 S!3CVEy_A8<u=SS(N^AѨg ]E?pJw"?ƲNAl\!1-~oA8~Akn.nSo5{EvWtv-olCUTnת΄<܀ZFkխy-W c.-{դ[ p!΄E/^U~4 h2mU}Tt!,{%y'mLe"5GG:I6nZx}v!c}y+vP%?`;fkxV`Ort+M,A ݍmtVW| w<OiIBs%(. 1(參,%񻍺e{A-g{ܺ]xU/^ڌO.нMN6pE'cJ3}`Hhn9({7ZIJG\`\\@/[ZK xȂʋTT|ViһI}S94viTiW;$?BV[8ζ[B4pߘi'mRc(y7eM/8!mzbm, ?Y1ddwrG.]KW]G`BaBꏗ1| ٥YO"auO"9[w1| :xDB;o=Mߵ?zGr̵zĈ54G?^Ȯ]FG(Ȧ3=aa߀L45<ݘr5܆ 9ɇ9Bˈ><@Z+o=>&4<3~G\ɽZnH3*oOg^srv|8:qN~=ƀs> W{4{b% J*`VU/Av\mRxD5LڄGvBV*ZrUaMqȊҌيrԼe55N Bx:!^!c8KƩ <X c|!c`oq \kŽwck~ԔkUkΉ1@kM$w#kԔ֚c%ÈYvV`9Uƚ lBXa^!g"4(L>KI.C(hJ/cv#pҋZtVg}UTVҲaaQt6]:3X*{V6׊y[ ׷xw2n`S,t lr vvbg<>}1/uE>977cͷ-in6x͠Y4,u֐n˒oӉ7 ۼ``߱rC|+E_vgk_ZmZy99Ae_^mox!o۲ k6yx!{rn--D<>A3.->I1g r W9n f/M$F5'i[2B\DJ<#%_zK/ \yU9X%X.,L4e?x "gP _d)(9Cޢp|\A͓rl#\/I%?_\o;b 7+^`=&"Ϛ(R~?_~sNx׸MҨkN)qu;~Z~]%Nqېok%/ٹh_K{v4=}-Ŕ  _zc ?֠NHωtWu] %"B+1.鯉 * '{#U=17Ɠ=5ZTw|1zQ$N4tABI,p I=jI )1QoO[5I856p" 6sy+]Dl`UJ5 K"JAȩK!7(gtPBģY*MIBQ 2Sy>TH%]C{rX{.nΚfK|^ֶĵ8yF㓒4!y0 ٔoĸ @C@zZg4g_!Ax>GZHk*5cy"tH3eH!S5R/8FQmhatSu% 'D>Y* MU|cwPRwHKHb& @nчE| ;[AWMc;+K|BH*9ތ2;&-Sw+ u *K@>6XV#ERY:Gcrp,3ec `$"73jԍ'JWJrk*L+-dEfXxeohH{C>ͱv ͡<$PܲeT77"sL!ժ&,BVYkrH-V&'0F .gisdU wwz '$dэ\I _I" (J $PZdყCg|Vĸxm [lJlPm f'pG\qu]QA~6pF["بJ~B Ue|"vBTn !5U-]$^e{?G\:4BY U;=;vVNw-_7XZn#GjRkQȣmIXԽ]D֮mLT |L=(Z&ThfǍ-ʽ9^!pwY3d߅q k0/T8͍MV\il /@P//BV ]wWbp 8yȘQ 5q u$WӐ'5{*N6icmnF'h$l3ޫwŎV@Vu%Rx fP$Ka=R C3sy^ƙޅ?,9E{)<-&XJo, 1 9ieJhNxy_$tNNnL/@VvSғɤ"K X݃wj 䆷`4Cm'I}K5 "$P}rrgi/G;nm[t.}+]R"]Q .Zؘ0ruepmW`ްl:{cRwK,b>_J{gm_Jc+pe9sZƫxȟr*UXsLNꖁB~>tС@QKʺZ/*J ;4ؾբ_X{!B}!ǀobBؾe`Rwh}TIģItiV3]((=ioP:re=4V6Cm4% .()~$Ic&RGDfsℊZLk;h(LmDŽg:PԷDQSS]+T_q*pKW{56(8Zޮp=|ClNNSSI]7p7+%# i8qc&2MԦ !>PH݌8&_\UwJW!jSHTq+G-YEaU ^skZ^ 1Z'g3Ak@| ՟fm`pC["ب9J7<6Ƨ(D. <YVwN@CLNB>&E9Dd4:r(;<D*[Lju,dIsbn{ڬlУenbWVM2g{#4cWps[9{Ht{x-ͷ顷ɻt~=Ҳ#0Q; VQJf<Yi$SyܶW txzY8r_,€!mŭd&_6'WWWB; 1B5nDzq%1_wg!/b؝)۹{wtn_X-~a0ŒV`'NmZH8Gg Xn0>\ 'ݥ!+k87VnG0nQykyy>{Y)Ξu ӃD.>d1vV;yݍJ9Oc y ոY(Sw!V5y8Yex/Y鰭\U#uzlg@HģIcy.2{˧yV:pepRIdAv~(7WZˆpo%&3%ȍIꚁH{oYֺ}cY7Ã33Ld;̪[O/=xO@VLX/ Oi{ x]Y/a&3IOSPIzRFM(y[ 0Io\)K$t'1֕ڳSig< ɧXѣVY[OIc"=|楝W|H`0"C ܁P/su^uQ6 -lTCеBՆPͯ .]ME^w`x+gتov3vcl0懝|&!d6dM仁oC~[wt/kF" #7BV~o),그rYoAxW TRR;YQT’{JK+,a":٠'t>x&֊4Pq zn2C{%orh#@Žї03Yz e!BW)&OUl#uÐ #uiimOQ:MF=\J"+YDi5"oI2^h8na m+$2ǣT#%A1Y!Z'!_ϐ. Amcl[ C@ŹO-#}& Hy !OR bj^'.YilT=.ϥF!+m H]/rݔ@V[ґ,6 !JIxAa ĭ٤)@Vr9?%uIt.mI BVAF3rDex r'p Ұ(\ބ|ӘQZ=''3,!+VY?omI}Jt=&c|x՜-am Hz>l 7YI.j.#*/#TzEiުAG@<.`T@F%zi ԣ%m!,CI֊y&nnYZvNj,S,4[iOB0Y }[zgR%|Ia|I#{o8W8XLLf gн//= s.<8&!u;J6V ,Z|eZu%66^! ɞJ D ma~u’Ss'KmЪM[nY'"V7!cǦB2 QJC>^&5!+eМ%=Ei)B4BQVpM')],m Y;8 ![2`rZ߁(QcFIvM*КC6w(2\mY4Ymꨒi"=~geAqȲM.qx [ ,l|lнʅW(PlAVje6dmBA=$=$:cKRGH\fseqw4U( Wr4_d<Yi^EHa38d1Ʈr`/H2!<Y=0~d8Yz8iL2I2 B L1oӥ=.,dޓ|V|(묭{ޗuo}k'Y BZo p1~V؊pھSU1$&dsM>1^j[vmĤR x_oF6͞{ [ؿM-jq9W΃vdf 4"Av8#(JȈyח)yd)Ƽ֖[q8v)4կ.ű r$(d^YH]3 rYAm[<:^w}>Pj#3Ǔ(| x&vlJ8sEݘsi̦ =yJvg9PA@Fڛ[9wG@~MzERtN2:ȏPCr٬C?IN!2ewISQ'W"z}ůO4tn7 >I` R 4W o *1dD n,\N>?|Y?cupQ5Yn'ljOX9.f=oi;; OhlݕdIh0/ э`+l-3wvNӼъtO}yȟo@3XѮ]N=OڿXx k|Z>"_TՆ֊:D)D >d ,LA\üx-OF|{}+9&Umȷkv"p ME$!뇧mo +} ڀuݽB v7dKqĨ8Y?oM3΀pEI$8 IIc F+q}}0ԑD]'%u={MWE,~T vx RƅaUU|ҊlbfI-J+.3|Yl^>,,lGBg5W};~T_(ڽ;kvr94s;Z_*  =D @]{#u iE:K䳌Qn^× '#~ɶľgFG"M+k"R3RnB!m.WH]3run E؉֘9祝ۡV`9*r=lJֿ)sϵ=&9NwkgrELfr;泪bЬYAo3-2Fx);~J~?ރCùbRw Y\-dMLA+(Xc6-;wŔʶb|YTv}yCr~%15> ̻{"RJN+pYoV.\)bt YiKΧHd]]ivݶŁ$ڼ.3jhQV _V *ZJqt$ː7I/$Bb#+̷0p=>\4 OSkom&f*Jnl6Ð+\x&\0nіdMN$w Ǟs,rAV }. 4 I?V㷢ZA~ލZ&Ѱ\V[aa8|Y?΄3g0tmMh~܎LӼC\#۫$r&I]3J2bpx Zzyqܼ_pc:Ty(4p }z'fd5qރWfE|t%X Q"Zؕ+df~{d%7C ^vJ Gx RkuKh MM=q#{hMYv+'B'|AFvskN:#w!aY| ]$ģ<_Q-[ &KǤ5'$vAl lR 6DrN$R <Y-~;*Z4pZCb#-*kDpP}LÀW jc }  Ymh6J{i96 "("s|)("|zD/CV[ˇLDh8y1KC^JL7 {8<|H `B`DK]rt:^h4>ggN'd[(|eٲeKrd+K9眃߾gf{:4=x_{U*v=bZ!_Cy.C^֮ yA|4iR/6Ry[wűrQ רUbtǶ Bֿ!/S!Kw(bT泊.An@>RwyA@J~u䥦%OؘE_[LIzxuOBV[)+x )md J&͒_dv/`'i m\_"ù ++Dd/̑^q 8M:VvT ˯O&%)Xp Z*OX?!&k08id #_D:d<@KKPBN@>S^B~H &MYFꫣAvԜg +-=ɛ"pZ˧<ϕoKG% &Mt0/Gnoy]]Up@-.xx ~-p Vȭ̰/mڞUu۠ѬզF]h~fi)%^D=k$=HQ8dP~!?*$u'gbd^w~ąrބ8M͝gcK>g i{n"r18dWaH]?4dSa6 oL&+!gw 10Q--Ca"t5R 4V) v|p)j 5br80-!uiֹ]k|uMzC,^.A^j|Mh&E7"I@ܘhk#B 8y];+۵~9dk< b7: 0MuodEs@^i|B_ >4fr!aXݐ_!:<dәӐBn9%u=3GvTS]S2Y'&egW"0rk㧆 Y9 k@ѶL #9 <!䮉]~gݼWɞ3HW55JzP|_<1A#"g/ |菀ѮHS11Yކ|=[ށZ#QnѤq1Jʽ? <1f\\!R 2nY8K*D0 >ɖS{8yLt&3V92Lxڵ8IyߦIMu'4\`vI;D"pqZ==|'L8"o >#T? ?MVCfTA9/M^)JMz#G|{x]a3Op{!5/D vD8Y:bR 3m#끅`d;S عrt^bxx E;? !l9'me">բrQMEMj; S[Tja1&\L(\H]dΐT'*rYg=k+h&y qT߻p)jp ժ{o-ٍ. 7jgM#8ħA` %ېk?ڜ4q,k)WgѬ@>c̹\=rՈy8d8ǬA m i$dY~)[!3C|M7@#ؤ|{d#Y*B~q^_;s}}/B_ݪ)Nybik7HC  +ej<ؽP1Cw'HBrpta?$8) @OCVs>]I3Ato9:<0+[j.WFZUO `K)p:<YsHfa#F~QG-3FsWeyc'e7:M&tꇿ^:Yv':GznвHeާǁOyl)??ʾy+~ѧ o@QOumlƶD#hVUaۑfe㌬:Rjc<1**dEw5&٘&.6iClprKZzEzg!A6Ӆvɺqރ|%weu fGH՘/ W #" Ю*e2`H$3Df8 YiKѐQ d; =¾^ߒYmNY'>St̪g[OL&qӰ6 ~)dHkxU|mo7ǐHǀIm O-ȖyfGΒȁUZˈogv&*R~Nz_}imUiOv»3e<5[Yٹ nݍhd.(ܣ]ȲqvԖm/:dKR! t謐>p,C3Bn1%NBlϓ³)JvTDO/Gy4p6)Q9,=p8%Q b2' '\U gm[;ёLF];VJdFV!+uвm* o@]y"㙬9Mw0r6[Jck;0oV}Co<2/}”b52}gwG6(v퉨 ͔j%8+'N?x3R)ǁ!7u RxY-?kRtEOFE/W hol$|rsI ,na-9U$(E7Lc^@-F3$4wn0$ a\9ĝ!6~Auf&JK] /uB!+Md$UNI :4ө +1EUNC95;O0,GIniپ.D6`/^!H{&AjFٻ AU u 8yQv9 @E 8LCN+[hA/O4DTcsџރ_@Oӗbo |a>,8mI |Yx17 +MU\oCfѤ1a<=V2Imׂ8%3?-#Ю} Gw ˷x*8(d{mLbAATF@M"O>+:?d_BBfpBI`Jjwcsj/Dž܀'}:'}n,#MoyɣIKo1X-kR~|)Mŋ>2fQnp vroE$h6n#8 |(dA٘>2nT1;wLh(Y֧kB&l] 9m=6}2aÃ4X%j6H2S <"du?xT$ናn:~ζ|3Xb5,'xXBqG:BNElglQMHh8ڋe r}cBV;-W+_H]p@ȄNVyzuB;jml]H>눕Rx,VZsKBI:/ ຐzZke]p#pj3{32MʺrqT6je]s\OLd ^!M&u EB ? <~)27̈ûG~8,K8 ˎ<;d7ם- 6zQRw 8/dW;Mһx5M!6< $cV|$-#D/zڀ6 zCt%GZ؞`Ly(kB&$E 8(d͵> DIN$L-⧊6W9>Me!j7&˨ܞͺ|ID-=)㰐od%>&QpZa8/dApt >BJػ@Ե="}jSUH/B6pRaO4%7t: ?۝aSpBnjjJ}N2!,[nU t8-sKbN ZzT]D-[y>8~NOEzS&3=+dUrYVҔ;o;zd \)@U5v*NA 5N&1\|yb0 ^Zo@~`JL*é&T @R[}1byxO.`C.vp9~BCC*+CxNk0:(>#dYzhKGN{1P%tCq i&CϋqV\DCY&:W7zMň\,>YIމ[;]vTwP|'a5鮉߭`Ѥq#mʯSH#~.^4*[QXփ,kd-R t؊SylFۑT=\+Ч[qQ-V|5LSq^SA!+.E{mMƢa+ Ini8-d0[I'և8N`/6|'.7k{S|t*\\)1gU534c !8&|5fM6RڵqHUU0h$]9ErV4 mh0$_\9|1eyO 'QMN/TPH{ :B8ԼBoĮ8*d1=S7cԶ/ \pGF#X?G,o)%4< # {hB&4+ nOņEn dS{G-٦F$o m~d8߈|9W_i!T$gA-9A`Rj'5{i V-7NRkiڶʧ$o`iBc}A\rEvBV[ O`I##1sH^TKhF2%O\JŒ|}`7bh0ϬbsV\Bzc]~ntlWJ kLXﮔ}L`UX^':?V ڌpp?$dFk+~ޯ X~%^ExHjnj;I!6 twO !Y3!涊fh3`i?_?_?N`\Gٕtgev\rq>y!=Xu_D򷊈[ ,dN27br gЖ$ABsUˢŧ k;"G(Mz,ଐղdfnxEj-6"pxMIk&$dEmWSK>H;'B6V do'v.G~x]jKkǀI!8t|K1^[~\B+&7増 ,%C+SUǑunP/ƛtcY;f]ڸ]b'yw+ggmf%Y!ĪzL҈Ʃ Z6/'6F@-)(4e7R-I6Gz<.<@)nc"\p1A2xQ`'gɒQhZ7p%ۤ{>VP+Fҡ1+~4kcsoZ_ Dɲ7Fy;vO=޶-w% f{I]:>ew3Q'&^?\r/\G=;c;Om>Ba&cnXn'ބX#n%&r\=YZSL[DN=ƦWԕM|YDL,ko6bl CViVs8"ĈAklڳQ!+>$:uelt@L.gl WBhrcuHw9{BKz{3x?I>ٴ-:} PFi%By"DVyЉG>X-PB ,@2{*A mZB6ӭB6bSԘU3J[zzJ0N@4 5ͱ?&Ʀf{uq8!dҳGh@CS;iyA/Xdo;Z6F3{n.8Ȗ+]c _Lrw;_汻B.J@w2 i/csY學qC5zߣS,@A!m褾PN`wNB6@rpx&@ h& :O읒yd+d3x OJ>{,_r! t{ Vmn=(Oy)EɳUݤe/O8XNƹ?<<˨ o ]&Kl"u}2A T !j6 a+ܤ՘Q,񭭭78gL1zyKGqr1qk63E3VzfK1|_Ȅqhm~ dFGԤ ? >Dr FŜ,=ݳ&ec&IcmcO0%r)NsBV%}) !6ڥI MPNP\x`yҔ;? %4< -G.ӆ?gL? "4%uG{nxB)#jt3Ko.%uA,[zx 'l~L+ u oH$pJȊ{iU'^WW0{Eꦁ $rE:#׀B6^eփyY4Z/ޫVv#Yg\_T %'狮f?MtuFC_8HWgWc鉙ؕ8o|o..?|S}sB&+"}. .~߆MUOagEÜ>º|j77,Ȼϳ0ʣo6`PȾ2oSoTbT㼻?^Ard\-^%1s%[A՘ J9پ~7~ym5UZb5㕱Gkzxu?1 :CH+7/?nҒsT_vcgծO}7Ɓk77>ևDIz%Z (.Ra3Ip4cأ8d6,~DӴZ}l幻@ s76ul,VE~W]~Bu9~gVQgEyz쑳92fEfm>b] Pv=:#<:;lcYpxjP7^p'GDŽl0Dx 1+8 @^$KO]KOM^"s8.dۋ&޳h'qM̍vԕtܑkT}B?7Mh;a}AulfeJ-Z|uwE3nwcnԊ*ߎl3hVUu`JyGݽ=nSo -9ݓ孯6]6J6u/pEKqP{r4[ch!Mrfike_TؚgK_"[CAÔUFΖG):BZkbU"_2K"1FX2FNjlbxUIwT[ HRNQ^Ubvf\oȭ=ZM)~7$cٯT_G[1}+R`M9ϊ[V)ʄX?|6K8&[tq*.8-JrK$Y@5$LnF%>Ita1 r9gfUT0J̬BVKc9RwxSZ/Xqtzjzl,߫)%M^BXP%9q)l*ggǦMMPSq,5樌sBе9b;a=:6^dYڮuԬ6_3Kj1FX3FNjnJ͡Yul+mCu7[>]o~%Y[r#bi5r՞!j}UXRh+o4u-/ZP h _mp4wmYYz}'dڬdiWrNqlPm=W{}»Ey)E,((EyK)^GZqlKB&4uĬ P{FV[gBN<3TMO(zLh1hn B&4Gg&;(o2&5I2aXzGj4g? 4mNO;ӸSB&4 HӬQiJB9wЅ.dBGIB&4Tw&«6n=U*FzCTBl˪jөr߯K$",Ӣl*>s3 z}BV{Y&79'1j;B&46fFH]0 bZSpl/8E^V8kz)&Gi!H8._ O4KŸ8h2prIROAz=ڃ8h=3mI=seN7|E:L#j'BV;QU+to[9ߍIVK&lV< L6\zY:ܺ]͓*~4+k'uc}5z5yQfKd̢ul)nI]7|i_ `:B@)ͮ5nsnq7$^ d$'kZ\\ F{$ GDyR׃pO'L_n&N1F&W-, Hg-;/,b U- nyY߈$ʼ~%٦]p CeCϟ%K8 tSl%䘢>SyaM׳Y3NS+W3a VwpUDsbB^y1Q\R>]onz o`øXˍDZa z|zfGZ qh F[| iPSkiT/_oAQ4}Wǯ4׃nyml<F[%45$_ȨٺCI^,B*: q]7*O295'#. &nq#Ζe$[|wg.ƯF1o7ao\6( Ѫ(@h׀+pzaUG,_ iC/ߚ!0P|i8LN =8[zA`K-&KooƎVq|=O?=PqVtj %l0/$ϼe?3<}l)~J6rUhU5?PQ=.I;WM.we"6yh.]!mHx[zbBZAC9# [~.Bb4OT [oA x ۵ݡw$441S +G&ݡNiimn4dH<Bf$&RWGw8fJo/.]]iK.FA.َ)LKS[ ҡ`.sp>/D; V:,V Kh|k[[<҃$hhʢOm¸__B2TfypL>4 LxҺKn??_z~N[+شP?d>ٻy@$E^}F:+%4yM( r\mZM _ey@G0 imӜ^JDz>OF??Ӡ>}B-*],B{"oE(>`7duc+XUVFD\Z&!ǐIc&Ř 샬x%SCoYHc,}0u:`㐏7:[ԟ >d5ŘfAx&q [549]ViեZ9X̪Ge6"< A?):\P$̓ڙ(6O:uˈL#oW8& Qǡ-Ҧ9u2EKm(88BVMW(|P[UN{_> u8Y)ŒY6y4%vcTkU&*5!' 2{E_Ǒ_D@6st`ؽNľs4DSdq&32CI6Q5uGr]ϸy|"N+jCI_IO[`Cy/;Gz}y8Z3EiJed2TʏyG_V;{/Z^QT%rr4H `[;*?_''gpR9P-AES{uZGL_b%CS:58LDXʻkTBя8q%ZxЋJ4>Т 5kQ DZ~7`+dia\'[rB:03N]iJ|R D ƺ+j}̩b5ݸIE"^۵tJ҈ CsBz# HWHseŽյiE_VZQ+I+ <4ȨND=#>t}f2U%pH/%v$hV_BtfwBy}a2֧/Q@wV^؝|]$*9ug?GZdZ{Dc Ѣ h/ 7NތBڠi̇ԷG[普jDu{ +m)gո d #rdRnj|Vud_+*Ð]_U NBlU O5*3Ƭ/ܨP`uxFexfI]='0 r55ũl)("x ځ.bj3j9Te OpRbj} IΤx}MxHؗcC&M I}{:GӫcܒWA|fsD@쩬GUۣ%/X; /lkl6|Brr9*t&\]T˔raN8$.@&!1oAm; YEE]+ZWxuCޯ‹k.A|4͵&k؉0`XwK9kaq%V0Oea,}:xj ![8. 5@r6gTTfأϰwY<&sDڥq]wO,]Q2l?F4$p :iB=nӫEWE䥦K¶ʹhKDx r΍.`kuԚN1Ldm:y1_\ Ơ-'[@lY%'\?9q7,ZXf ]JOو$HvP7NwM k,64d#B5f|aK "FY p 8 C jxy.f[)TP7ro#|vB>؄JYdU"'!"g 8B  20"7$1c& 6])IA֏Tz1a]{}V1Q3'$p0˻mosީ0.๿ᎄ\'_|y>wPs ;{N8:p?ZT ^ Yu3'A橕+S/>IHVwrΔ.q ځ:9;ԥszN<.Ƭ9i=ϟКRĎ/t6o\#>HsrT5b44PsVџ//")0AVت4"}8Eg<5B ՠsƜս6mY Rf$Y`wW *Y΀Y5+@o*IsevR}huO@VJ%ɐIj䣿M~i$ܥqR"OoA_q!w9>ϳ%/O'V_l,H^Yih6 N$Thr ܼF /3)"}(L[L$^K\Vj?BVua|*bp8YhUls_۫iE] 7gQ+_ >4xh7:"KW wչDe3\B,GMz_<LB6vH]?p ěǵy,RYOۋYY[5aO,=(O̢.BV:E"GH26pC:8JgƉ) ̌H 0q܀s.>9(%A3(Yȹ۶q3 Y~Z]_l3o IrDm5 Ob؜|DCVK> $/Xt BV1\?@H禚ϫ2:}@rބS}H]+\<؜с( Sm@uFX 'LUI$p I~w"{DTmP="RfM 5vft/E2+^|I7ۣ;DDƀǛ2u3^KcꤿI'!+Mb_R<YAb[9C6Vۙ7.%0(p:Q^DMk>_Iʂ0Ð󕞝 H?JG!6iHIcw:0!Gz%Ĩ8y^B:' ?5ά\g qֶ#+|`tVK|O]G+"\M8OŃF^^27WWPބnN!(k&N!H}{5lq qR%ONp9J͝D9E%J\'M/CVKUY6w&yUQѮ3»D]7f'I mN }"h|hA'wxi_qYsx#c OpR <Y?ZP4K  -T4+=  /4$!뿢t9v.=twg0P. Rԝ8Agy۳Cg!+Ԓ|;'B) #x̩e0 9] '!O6s!SYȳBY|n%42{6dsYkw?7#w#&ԉ)>X.-n߹ЂtM1jBږmh'4핝).`/;8LJ s1)G\&DA Xփd d*t^s.0Ln`oYiu <0ds{#%8 <LLr8xn5A_ AӹmU}g5g+$,QθIZgg5R(Ipݐ_hF^wuM.p!9I]Lڡg(@D80L'C|&i&I5p<K [e8MU3c3mv\C4Z{EUrp`[2L ^? gCC B5s[?I]6qԷGPy3*Oitd .w}b< >f?IGٵ)[GC%Ke;XyΊF`aW;K8 yX{j˶A|~Hu׵M wѸ Y.cf!g3P\+,ZFzOؖ)Ѧ+;} laޅ[qDF0slڦRRf3o>=㻛AGK8k?6l$=whɖ=0j(}L̴fBk#NOz!7,<Yis&ro8 A>e![5D* |V Yiu^- 5!G$F0c$ .{Ni&Ve\8)'nU~/RNlm5nI$_ _tBVV]cʥ8u{ lgnĨmB6A 7殌&Y)>|ş!6Q9Q^>'c mg '!OzI' O48giJw`C&.ohs:ʇ{}R\;D0ln[S;p߅^|A+'X-E AzUfDjZOnAF< @ֿïr-Y7&.W!灿vFώe6,fJ_g#d? %YD]H  T5n4iSB6^D "FY p ȶhҿ J91'GR.`7ds粞A ۀ=͚mB>h"Jl. ,<Y?D]SQ/A6&9 4쯗1+֦t)"CnƳ-G}M2V@Yw_Aw*QZ;G!U%_n|VaND-s<,A5| k-5e"r xF7.d]vH${ M&Bvv4"Qbd-:* q6{ Bh1:b0f{*K96)/oʖ&d;Tk2ü 7AL΂$e"c삝Ҵ<`D'g}ȗغfhea:"diȺ݄GVK6g;hY ؛0֣GxK'=0 YiD='!OG-m3d^젿: fuT[%w,8t!7""mCqI NbRPg!Lt.Xy;w p]i8 YmvGnŤ *dw[0,G󭸋6z)gy ĺG +z)l4S\$ǀ!fC0g 7d/C֟& 9 !~F"c E`~GCF&sI!+m-˛ &Oi\/+x@^szݭߦs7}lDph -Jʉ(.de[hӲ"7_\e4;4uhL'ʖjφmH{sK${'+2_jg!_“|C4YW'du,Ӑ.R6Pp8 YmEY!@,Ksp.ߌ >4G"tFC>lntB#_u Oc{9Y3Ou{ܠ;|B$RDtY>wEq$KI 3U~ lKxҺ\DCT&o fm^ԩd]ށ?Vȭ|WN`wB]9!um=&Jwq:,Eu @'?^h>@N;]-d򫄹9CV;^5Vaxj]5fÔuC_G(o|e3~yy7#[ObA,੝e9{fY8KI3f_-Я#Y? (4+P"<`t>XVNCKܜ\Y4Og +]ܹ8Z(DdxƇR~A7a+VcGt) ST'hBQSH]do(Ny_Wi  Mpo|1שPP=cTc ExAV˝Sp[nOC?y6=43dE@J^!cq9mt1vϷyt*2qyAG5$)zat!y|W;JsQ˷_Cx R]7R.g/N^6zY"jw!u9&mKGNCtoDw{N˔AℲpsf[N 9>&U߄&XňoF. z\y; `NxM%zκCx%  e}s^{dKo^8q劌ؿi3) 9昭R7 Yi:Fm)ޅա"(އSDIbT:N^!7}MM yH}{~׵BqO ?qMhqwq;oWi\Ldydj:\mޥ#xT}ڗcoGiт hmr|\p v9NP9V~ѳ -EA"ݙp"<Y~^3nnf$י{Am;ͪ̾5=VٙY%" 사tPkX)c#bYyZ/$I`ZWR5Fރ rhHS^p`tQS"\m;Rfu ߏ~]+Z3N~ s/'woCn(P:4-c1cIȓI )mVGZ1~Ƙjq6ꬓX| Ђliџu1a{g"9< 1{C!CV *fl.r2sxͺL>QWJg +/PFD!럭p: |sm&= |5#VvlK Nh<])5Gxac]ny~`(uxQ0 Y #aNCfs" Ƕ<=Z<^*G]Zmm*l򕋘5ZRw8 y>h '+Yv|ue"wYM~1)ajjmPıԷGYc@ ]+^Z,=gTn'^㐕6y8}f#'#v oN<+$IOŽ iPh@.!4 u 8yBWIEףcc>dHw!FPdqx(MfM/%"^Ƚܥ~)|P&vұ1&B~ X_ZW۠O}1Tպ1߉I >> [&hm~ Uzu <ד ~:!.BV8UE4#z[TKrrvp#fqblfɧTŒ[Jdd(.C^֮4d? :?8wQ)I?%<YiAvx>)v(g:~!gmSEM70s Ӿ&6ބF@ԵB>mJ:Y$cFRP*ݙ?>m=C?_zίV\'/3 wN15ۓ}p R#.CڥlR+hҸbO<~t[\z{ _k|EiL̼vq"W3V WVz.[?ꄋ踥:6ijo{rr6LY)jǥEy=Jj^R,\pp%EXG'[ZG8 y!4|NPLHytgQ!L.39(S$?$ $ Yi3 ǁ 2c&uL v*:[tJ7\Ms)"sM,%MK׫UWl9Kqpx:o1[nݵrM VJ0.dَ!ϻ,o^ V'egTC'8 YF*j-Ǘ?Gƀ!OCg=w>τE<UJ:dh 'uz)A(!̌Eޤ \egki= 8+\4Ąfa#FYu۩nDC&j@N1fU7Q{h.$K]=#ȏߍsa2`~9vdo${ ֜U+F&'iF+y_\vRxe_o@A{dݼﮏ-'A_t69{_+$Ivں+}-y4 GTՠg\"7|vg쑻Vܲ<[ϿBE2\Nş.JTinjAO՜BSs |@V:M#׹Qj :kb>?bc@.#m~||kk+`[􃆔rSsxn?\}xR|TP^TUy`rVKA^&8_ sl XO;`*doY `;%/$s3+`B-/+kp%iwȬ'q^4YHdAA(A|4ib(Ls!`(S^k<+.a@is "Yq ##㐕.1T7ْ:5Z L,k8y Ӑnhs8YnsS+ t#O9R7 | )=IvXK!oeփ r y2Vv#Y/j %'狮f?MtuFC_T:}uv<=}%=6KO]w~1E<Y:jot=WmgEÜ>:6f~# >b*I8 o6`{5=vf1ڋ>λm=$wU-^%q/ Uet$_)'Y/:ڡ敲J_U{2hMO~5⇵z[#fvjv4mBX~N;!I+תYs~rmqZٸ1a6ab#Z ewAшUb=d|ZqؒVUarGp$}r[m/o|LĒUk JLzf<=3selz\*=u%j]'A3Ϩ ]&փ*cǕu\c/ˮ\/kM\cTkcff$nnxAjspp||Lu\;ӼRV_JG o"jbh5B^8._R=dm s)fy8OG s&L-hzwgS?Xx:=1J_*nOd;!+U^U/U./'!Oֿ' um@kYKhfa}'sMVg)dKc٭{ ɉgtgHV8 [=IGɯ۞tWЁ4#oMX$IIЏ?9;dLgQz,٫N4icʁ,L p R;R\܄ކM_wTK;7{ٽd2!*nYO,%Qxaϥ, sWhKlxɖ9M7Kq+Xi)gglѵ23E=!y`y4Lݸz%`?&/ #o-QBk=rE/_FxYYLddq}p򲗁pLLGꆀ!_o|@oDA?>N~&6`d+⇓l2==566U$F(`ȣܕə|JOgFӳkdŕ[cVޜ>H-?xmrl*"j됥7{Hl߈~CulC={iãM.㻒f)ؕ4ƨUQaJ&7fn՛0#B+oe&iM&L"΀$h0_> D29B&^.$h%1̂PafOajIHوA̯D*װ<+?["s@.1T`"^B.d!|>5H*k|SS6=D<7sd,Mȓcڼ?xiSB, HzӁs((Mh67,ڦ0ǎ}:bymnQ𹺕{ xGW'oƋIvL>Ht$[ͅM'|qbX{XЩ.lZϪ2!(۴Hc|߱T6(u2%\? e v+jU?8=b[$JCxW̲ssU?VXƂbl0g[Zߠ Hκyn3)p&g/'5(`<Q-oξ&y-zQ8 Eg84:,Q,/q4T*]_S1moY0ϦJ`6F$'&&l,dS8`IbcI9J9B|y썓I4 NدS<0" W4߯U3̊[.9p3j;XSڼ/"+&;A {qeGY,w2W+c(/Wn,KS Ѧ b]z "aEFQ?ݭ]BhtV0 ( WkS1+g9x_]Q;vC:ʣ+˖sL\7Q.Bskgq<[lE*뚲ZBP uE{gfd՝H$( diʈ'+X:ѫ씉aaK imhnad 'G$d38̲S?eI"8j"/sP c)Gs\ f:\ 5ѯwȶBVe8}ͯ78?|igi,kY\Q4B =M۠^&vn9=4̖]Nv K q{5]k{S48PFÁ]Aܼ/: )B΄׼eg[/v:RFa B2'ST>ׄ fITg*y"7f'[;a*Afא _wPBs<-قk&YyVyDxҤ Mc%jTzÏ&,gy98q _"Ϲ";V̼.O̽>B["ynk@s~^@qo|qyRi`#Һ{[y$7d#Txڌy"7نt>bPO<2?|j|~ "474JXi_igP&:N#jn e#l4b<?ӈ Bh.d|g@&Jq8Qۨ9엞AD4b E%DJQj8KQp)_EsYuiX<<6PFcnMaLzpIk| Sȳ$ˋ3IVt) Ox'Y*RY^50p.8?'C >g׃oB^'Ime|%8<=,6g (| gA~V!C <ӭ=ۨmڨvO0v<f||>74j"Qͫj 1/j/r  QjסeRA| />~cc+X) ߛ Q "OsH;_ݧ꫒6 DyiM1i$kء6#h|/D6! Ғo.{`#44Kxƛ>"!tipR.{a]}K!u ޣXe!Qv!#k!D.tUh{J ܵ&,NQsVĎβ_4Y("%#ZYdlؾ]GY,64Hww3PEȋƜg<@eD,5ӵɖkrFO;}F踗4HTԛ^'kMb w>tJ(ΔAsTGSxNpEƓQqiȧ_郧kj̜j:l. 1/s`HP l3ϼ nW鯏?qFM?\ߨ!Pιu~?<2Qxs> 6[`''1v68%ߦ DM6]l)ësNI}@>&vVq՜Ե)FW EРKc 8^0փqcNJlGB p2WsH&'vnTGWGXD(~ȂCzuK>eeG'=@ Ď$vdc_7zurH&/j{r'\Ta 5K fmh)`)#sw:8R8=mmtG;8΍R^;)ut֟$<<1ᇬH}{iΠZŞ:N`nS.N'OXe%N2 ~auu %c##i xrCf2p=d1.@_h$ULѰ#lj 9HgyLV700wDQG-s4E'ؚEŠ%;/ըc$d%FoYb1w 8f\U(xnsbSr|۹ ̒..A^. *|@ɳ]/'BsLt60 N j6+ FZfYމW 샬tgڿ{嬩aQj=hzjs q1KTNdV;< b#8 8ʬ|)̿Ѭ!O3Yހ|=)ބ|SDX"p6^4yUs{!.4>z9|$d5 B;Xc@ :_`g}qK_s= bz x]mȡl[9Ί`| gQ#o&Y=͊./Zr8ܳwwLC[Q0<~Ymw-)7+]ec."vh0\lE i{s j0}wdQJ O{/B ۧ-mbI["lF)S"z:hx 5c|N9v&Y)ZG 7AmMRfPtPsu@d'dP~JLNOCVJg %un,Ym+P6F$ 3|{-Ie\ ]K2#Ye_FS 󵨚o{D]9ôm[+?򹞳ynQ $J@X^SiA a?~sIZf掐ą&TBfhBO@>ӄA1_ l`hBT614!lVh2׵Bd_xYP]' 1.V|HH]3Z:~!gm;z,j 򇀋Mr`=AОwnAJ0)AVڋ*&JE2Iۖ#~FDN@VT,r8yIaնYD%e BF IgX IƀTUͯj(idi`e*V:.d]+--L˱[9˯ .`O؛(ԴI7Ҧ/RX`S&= ̨?p^Nޭ#\L6c&qiV; LBV޺y/ /5wO!/knmvmDd4umg3'O$[-rgŋ쒴'E_6:%|{nS#ׁ{U߯S|>`W@H#&ajfϬ2+ E;+)ŋFO 0ߎ,<Ȯd|? A  imm޺'& S9UiTq#pyb}u3<8*S@6U'^Lac(.12Y[k *dmÑmF.SM\'l",j~V /XG>v E]:kHs:AIOץ7guExR F;%O)"e#vG;+pB_E#%Q jQ6CZṎ0kl*ct!w+ gj E;(S ⨏V}.A^Ҷi~ }CR03iI൥Pbs9%Umxa0Fgzֆg L#9jS;}jk&p W',WPnԤVVUУQ6ҥC]2QP2cnhhXQY.$&^ȽTH^A2]ɟr+Nĸx -m /"~{I|aβ-rp9O5FD&C OnA. Ј+L/LCM"cNh{<7;[n9,fSQ#}6<0'Ȑ1 !l|Sqp8 YeCe(\&wZ,D x.B ۀ!+9J8<(?ۨhN|a zdaJF<鈉'XÙ^OHA褁s[p8y^z=Bݶ=$qy x>N#/!y_"< h#܅vRKm,Py(J8pU]|_*\CݐxoBuf=ݑ? ޡ#aP xl2k}| kjc i;m鶂ѽ_zegy/pN$Sw MF%EXS{h7 GYƱx=;HoY xo,,,0r*nB*ݨOe S'dsCn6QJvbp x_AIN@h}NӐ/,u;,c+4 Y?EFIK#>< /)Sp[pV:z!w|WEg$ЈQ'dpck[`M%ZwLeh%L 7W57lQz_|U <L.iȧ߈E!<U! B=!:( [k\xu8Y?kS8Wc#*B"N3^}V`ۦɍ+\{OCVjLs F6oRwx~ u:\O/ٴmxYw"j#JD(Ix}x jϝ#m$Lƚ!/o >q@z(Zs-`xN$Ć5 J0^ħq'`O$1_Q郉I' rW`R<Y;Qc,otmFw2QAVuvPNZ'QI,KُaB4;k#XJ?'I#K.i Qȣ1 ^kiF2*ۈeL_%L˱ Bh.":sb_. 4p6Q[ԥW +kĤnx~V=@BC^V.COY =#"&^F*i%%IűrQ 'cUbt U|,V!-T=Y1L*z^^dsc49m)ݷ$ ׁK ,qIFؘE_[LIj]R<Yޱ[`A%l-͒_dv/y6uK>ETOW hSG>/Bbhe|9R <YvNdվ~"LWu ե)j$cAnDꦁ .ȯ{o:=#$e #s4tU)qc{Rw8yj㋄ 2k8^Hh\Q::g K+R4*vT$mm騄x\ބ|)0/Gn]]J<YSN)+K' ;p Vȭ̰/mڞUuS q#vvEcc|$4HAO@Vjr=s( 23o18G"pDc<,0 ĥ5-'cVne{4 4wi_ڋfVYg i{n"r18dbOC?e;J[Yw&~jN3;tyO,O͟#.^H^dcKYWcuHN@0+sm1= KεZkғbp R#윰iD-;5mT͍6"ĀCߵaJ])|N?NF6"vxvodEs@^i|B_ >4f*I^c7WajHN{q9!+rJzg +mUdNLː|ɯDVVȭN`wBuf9!um=V8t$Gz!1|AS_yE;ahW?k#Mʉ26w|RYAڣHIr {`8½ŋ C崫C1BV-2LH2V!4$Bqh0v%ނ?L~bC Ys$O:ʶ+!Y-*G? l_RLۢR #fu0lBdG\H]dGEFo6f=k+FxeY7~Z3Zk__ivt77CloDhfVq%pO9$;W"V=Sptj^3jSRY"gwng잕ۼg}6/qr殌R9[&[fJy|Pb#iW)<0Bh[/R .-PRRf8ҭB dVMhg!uRU֣.d3%9~Po}ofsdX9nX{fIVHX%d-/7>@P} X9$_*Fn T݂l}bh >Ʀ㐕nAZU>U+FK! 5X~VRKSpLOϏG@M1s _}j*'J?lTN`rHވI]p3ҟ]cůug 򫌺t U[=_ƯF XC6Gm~iӯIAȃ*\9~ݪ#CGӂ{ă6\~-Lk"^W/7I^@LqئVYH?]gWҽ#>iӔ dQVSGWJdNm:Ea (寃?ޅ?at>gWʴx~pK8~At)nlK-4iVe0Z.CVF<Ĝ@'uoAVmJevVhR֓DL[="K0_*?ZBs coA|42폑Rص1!#2lt|$g׋x9=H ߈:# wO-o$FZhyqЏR淇vw)[ŭIh wJQ&Q8<1,[;>*:`-oA me {dY-]Nݛ>4hҏ h|e+/^s9͌[IW9JGTAOFS(鰻=& }hBwmecTexDP1\H,? 3 t#㉦Ƌ?.o/j DxqFO&;B!Y+s|k)M[V0Ȱ7斕wb9{bm[J/y*d6$W|drZh϶0%[>q=Y\߳3Ԗ>ӠOx~^)h*R 2geE'qaY,BZvs2d Oia*ٸx1$9,x߿丢d'g d 7&7 1j{Ac* |.G +]_ƪƨ= m$Vx&2G ؍V؟E l>ylo? MEk^X-9'?_tݜ???0iާ324D*=2;6;559 YWGALAۀ!Kgot=Wm𗫵` TX7:v3z? >jV5yyQ,?Hxf酬e>k*ŶݞAvh z/đj\uRU?cRmYǩE}/Rﱟ_t>mW,~{G3a^HO:[KuwO;xT wSWt|]U{;kvίAVL8e|^l^+*ph).B? /:D(댽e3۴:]y2nk7RL+6I(Mxu2e,kmocYZϻ|UdJm3XRFP'=_(ʑ{P9T>dl_a/ ^fϗ=Db"ٛv@ O!cVIa m&ULNB4J#pRsĬ)k_6Ǟ{Fp᩠9g&5I-+IX~cK<$y22619sW35*ʭG+o\JM69v/"j.%ZO@JLbb8 +ZeWegM,;cTegc:VIܼӬ묺6=1JG_qW6_IV9]Pzwu_5+cƈƬSkn/[byv~ۯTG[1}R|']eYҖ}%߷̆ҏF&'t@ mEPsᖗs76n@l JDKīer CgԗwS_*@yEgpyd쑳rM~~q=7cv1BKS Dxɳ1[TCg*HQ1Ji{Gx`B#_c9b*Hq IJSsS)龗ȜC&)Su ½*1Oq" ~ ɩ+S驘}U'"TefyZ-SuٝE3S`cS`2*5l3hVUu`JyGݽ=nSo -9ݓE6]6J6u/pEKaحmge)NɆWҴEo<*b[v7W|3z^+ZVnwTV&JB6䷍΃%/ G+r?k-˓=-J$ v1K0cj[^~ oA~fV |E_4h%R ߠm$KMIwPD[eO%-aXz/a4l?h}d{hCCÐvj?q\,"dK@6KBm|I/EO0p$&-?\|kݖm/D{!sZOq(h\x pqN'Y0̹vjZ)V3v8 yXPmnPOcl-ԷFIq?B q\xY:oFȬ">ҕֈhި4Z' ͜5O;D3~?<ؒS>g42 ADfXrR1nI'&VA om5n}yC߀Fr K z*IyB $QBm_Cwfai0c[S`u6 Bd;6Uh,h۪y-Cnyt7Hv!YH3Ytޔ ʻşMw\7+:6@&!=홰'KЅ2šXo 3GZЙiQ)bkOl?3%e(B֟^*W5D}Ϲ[_`NxM Qb~ op!Ԛ JvKk5?Af ]k1[|w5Bi%GJxq,&{`/CwfFj/2Zƌ\coRWc(;ov!< mm|N6xÏ!tƮ\/MB(vGv!+-h"JOJ[(,BxnEH}OÏZThk ;DBa8o.B?롟?zGrµEݩfaa?wno|t9鹵Zzƚ/<|", { expect_equal(cov(r.ndka.percent, r.s100b.percent), -7.56164938056579) }) test_that("cov with delong, percent, direction = > and mixed roc/auc", { r1 <- roc(aSAH$outcome, -aSAH$ndka, percent=TRUE) r2 <- roc(aSAH$outcome, -aSAH$s100b, percent=TRUE) expect_equal(cov(r1, r2), -7.56164938056579) expect_equal(cov(auc(r1), auc(r2)), -7.56164938056579) expect_equal(cov(auc(r1), r2), -7.56164938056579) expect_equal(cov(r1, auc(r2)), -7.56164938056579) }) test_that("cov with bootstrap works", { skip_slow() if (paste0(R.version$major, ".", R.version$minor) >= "3.6.0") { RNGkind(sample.kind="Rounding") } set.seed(42) expect_equal(cov(r.wfns, r.ndka, method = "bootstrap", boot.n = 100), -0.0004581385) expect_equal(cov(r.ndka.percent, r.s100b.percent, method = "bootstrap", boot.n = 100), -6.312029126) expect_equal(cov(r.s100b.partial1, r.wfns.partial1, method = "bootstrap", boot.n = 100), 2.899627e-05) expect_equal(cov(r.wfns, r.ndka, method = "bootstrap", boot.n = 100, boot.stratified = FALSE), -0.000419791) }) test_that("bootstrap cov works with mixed roc, auc and smooth.roc objects", { skip_slow() for (roc1 in list(r.s100b, auc(r.s100b), smooth(r.s100b), r.s100b.partial2, r.s100b.partial2$auc)) { for (roc2 in list(r.wfns, auc(r.wfns), smooth(r.wfns), r.wfns.partial1, r.wfns.partial1$auc)) { n <- round(runif(1, 3, 9)) # keep boot.n small stratified <- sample(c(TRUE, FALSE), 1) obtained <- cov(roc1, roc2, method = "bootstrap", boot.n = n, boot.stratified = stratified) expect_is(obtained, "numeric") expect_false(is.na(obtained)) } } }) test_that("bootstrap cov works with smooth and !reuse.auc", { skip_slow() # First calculate cov by giving full curves roc1 <- smooth(roc(aSAH$outcome, aSAH$wfns, partial.auc = c(0.9, 1), partial.auc.focus = "sensitivity")) roc2 <- smooth(roc(aSAH$outcome, aSAH$s100b, partial.auc = c(0.9, 1), partial.auc.focus = "sensitivity")) if (R.version$minor >= "6.0") { RNGkind(sample.kind="Rounding") } set.seed(42) # For reproducible CI expected_cov <- cov(roc1, roc2, boot.n = 100) expect_equal(expected_cov, 2.485882e-05) # Now with reuse.auc set.seed(42) # For reproducible CI obtained_cov <- cov(smooth(r.wfns), smooth(r.s100b), reuse.auc = FALSE, partial.auc = c(0.9, 1), partial.auc.focus = "sensitivity", boot.n = 100) expect_equal(expected_cov, obtained_cov) }) pROC/tests/testthat/helper-coords-expected.R0000644000176200001440000004453013607143106020556 0ustar liggesusersexpected.coords <- structure(c(-Inf, 0, 1, 0.36283185840708, 0, 41, 0, 72, NaN, 0.36283185840708, 0.63716814159292, 1, 1, 0, 0, 1, 0, 0.63716814159292, NaN, 0.63716814159292, 0.36283185840708, 1, 1, 1, 0.035, 0, 0.975609756097561, 0.353982300884956, 0, 40, 1, 72, 0, 0.357142857142857, 0.642857142857143, 1, 0.975609756097561, 0, 0.024390243902439, 1, 0.024390243902439, 0.646017699115044, 1, 0.642857142857143, 0.357142857142857, 0.975609756097561, 0.975609756097561, 1.00059488399762, 0.045, 0.0694444444444444, 0.975609756097561, 0.398230088495575, 5, 40, 1, 67, 0.833333333333333, 0.373831775700935, 0.626168224299065, 0.930555555555556, 0.975609756097561, 0.0694444444444444, 0.024390243902439, 0.930555555555556, 0.024390243902439, 0.601769911504425, 0.166666666666667, 0.626168224299065, 0.373831775700935, 0.975609756097561, 1.04505420054201, 0.866528525972929, 0.055, 0.111111111111111, 0.975609756097561, 0.424778761061947, 8, 40, 1, 64, 0.888888888888889, 0.384615384615385, 0.615384615384615, 0.888888888888889, 0.975609756097561, 0.111111111111111, 0.024390243902439, 0.888888888888889, 0.024390243902439, 0.575221238938053, 0.111111111111111, 0.615384615384615, 0.384615384615385, 0.975609756097561, 1.08672086720867, 0.790718340787744, 0.065, 0.138888888888889, 0.975609756097561, 0.442477876106195, 10, 40, 1, 62, 0.909090909090909, 0.392156862745098, 0.607843137254902, 0.861111111111111, 0.975609756097561, 0.138888888888889, 0.024390243902439, 0.861111111111111, 0.024390243902439, 0.557522123893805, 0.0909090909090909, 0.607843137254902, 0.392156862745098, 0.975609756097561, 1.11449864498645, 0.742107229676633, 0.075, 0.222222222222222, 0.902439024390244, 0.469026548672566, 16, 37, 4, 56, 0.8, 0.397849462365591, 0.602150537634409, 0.777777777777778, 0.902439024390244, 0.222222222222222, 0.0975609756097561, 0.777777777777778, 0.0975609756097561, 0.530973451327434, 0.2, 0.602150537634409, 0.397849462365591, 0.902439024390244, 1.12466124661247, 0.614456415566866, 0.085, 0.305555555555556, 0.878048780487805, 0.513274336283186, 22, 36, 5, 50, 0.814814814814815, 0.418604651162791, 0.581395348837209, 0.694444444444444, 0.878048780487805, 0.305555555555556, 0.121951219512195, 0.694444444444444, 0.121951219512195, 0.486725663716814, 0.185185185185185, 0.581395348837209, 0.418604651162791, 0.878048780487805, 1.18360433604336, 0.497125186360265, 0.095, 0.388888888888889, 0.829268292682927, 0.548672566371681, 28, 34, 7, 44, 0.8, 0.435897435897436, 0.564102564102564, 0.611111111111111, 0.829268292682927, 0.388888888888889, 0.170731707317073, 0.611111111111111, 0.170731707317073, 0.451327433628319, 0.2, 0.564102564102564, 0.435897435897436, 0.829268292682927, 1.21815718157182, 0.40260610600686, 0.105, 0.486111111111111, 0.780487804878049, 0.592920353982301, 35, 32, 9, 37, 0.795454545454545, 0.463768115942029, 0.536231884057971, 0.513888888888889, 0.780487804878049, 0.486111111111111, 0.219512195121951, 0.513888888888889, 0.219512195121951, 0.407079646017699, 0.204545454545455, 0.536231884057971, 0.463768115942029, 0.780487804878049, 1.26659891598916, 0.312267393930714, 0.115, 0.541666666666667, 0.75609756097561, 0.619469026548673, 39, 31, 10, 33, 0.795918367346939, 0.484375, 0.515625, 0.458333333333333, 0.75609756097561, 0.541666666666667, 0.24390243902439, 0.458333333333333, 0.24390243902439, 0.380530973451327, 0.204081632653061, 0.515625, 0.484375, 0.75609756097561, 1.29776422764228, 0.269557844206491, 0.125, 0.541666666666667, 0.731707317073171, 0.610619469026549, 39, 30, 11, 33, 0.78, 0.476190476190476, 0.523809523809524, 0.458333333333333, 0.731707317073171, 0.541666666666667, 0.268292682926829, 0.458333333333333, 0.268292682926829, 0.389380530973451, 0.22, 0.523809523809524, 0.476190476190476, 0.731707317073171, 1.27337398373984, 0.282050408156521, 0.135, 0.583333333333333, 0.682926829268293, 0.619469026548673, 42, 28, 13, 30, 0.763636363636364, 0.482758620689655, 0.517241379310345, 0.416666666666667, 0.682926829268293, 0.583333333333333, 0.317073170731707, 0.416666666666667, 0.317073170731707, 0.380530973451327, 0.236363636363636, 0.517241379310345, 0.482758620689655, 0.682926829268293, 1.26626016260163, 0.274146506708969, 0.145, 0.638888888888889, 0.658536585365854, 0.646017699115044, 46, 27, 14, 26, 0.766666666666667, 0.509433962264151, 0.490566037735849, 0.361111111111111, 0.658536585365854, 0.638888888888889, 0.341463414634146, 0.361111111111111, 0.341463414634146, 0.353982300884956, 0.233333333333333, 0.490566037735849, 0.509433962264151, 0.658536585365854, 1.29742547425474, 0.246998498101512, 0.155, 0.694444444444444, 0.658536585365854, 0.68141592920354, 50, 27, 14, 22, 0.78125, 0.551020408163265, 0.448979591836735, 0.305555555555556, 0.658536585365854, 0.694444444444444, 0.341463414634146, 0.305555555555556, 0.341463414634146, 0.31858407079646, 0.21875, 0.448979591836735, 0.551020408163265, 0.658536585365854, 1.3529810298103, 0.209961461064475, 0.165, 0.736111111111111, 0.634146341463415, 0.699115044247788, 53, 26, 15, 19, 0.779411764705882, 0.577777777777778, 0.422222222222222, 0.263888888888889, 0.634146341463415, 0.736111111111111, 0.365853658536585, 0.263888888888889, 0.365853658536585, 0.300884955752212, 0.220588235294118, 0.422222222222222, 0.577777777777778, 0.634146341463415, 1.37025745257453, 0.203486245143617, 0.175, 0.763888888888889, 0.634146341463415, 0.716814159292035, 55, 26, 15, 17, 0.785714285714286, 0.604651162790698, 0.395348837209302, 0.236111111111111, 0.634146341463415, 0.763888888888889, 0.365853658536585, 0.236111111111111, 0.365853658536585, 0.283185840707965, 0.214285714285714, 0.395348837209302, 0.604651162790698, 0.634146341463415, 1.3980352303523, 0.189597356254728, 0.185, 0.777777777777778, 0.634146341463415, 0.725663716814159, 56, 26, 15, 16, 0.788732394366197, 0.619047619047619, 0.380952380952381, 0.222222222222222, 0.634146341463415, 0.777777777777778, 0.365853658536585, 0.222222222222222, 0.365853658536585, 0.274336283185841, 0.211267605633803, 0.380952380952381, 0.619047619047619, 0.634146341463415, 1.41192411924119, 0.183231615513987, 0.205, 0.805555555555556, 0.634146341463415, 0.743362831858407, 58, 26, 15, 14, 0.794520547945205, 0.65, 0.35, 0.194444444444444, 0.634146341463415, 0.805555555555556, 0.365853658536585, 0.194444444444444, 0.365853658536585, 0.256637168141593, 0.205479452054795, 0.35, 0.65, 0.634146341463415, 1.43970189701897, 0.171657541439913, 0.225, 0.805555555555556, 0.609756097560976, 0.734513274336283, 58, 25, 16, 14, 0.783783783783784, 0.641025641025641, 0.358974358974359, 0.194444444444444, 0.609756097560976, 0.805555555555556, 0.390243902439024, 0.194444444444444, 0.390243902439024, 0.265486725663717, 0.216216216216216, 0.358974358974359, 0.641025641025641, 0.609756097560976, 1.41531165311653, 0.190098945366147, 0.235, 0.805555555555556, 0.585365853658537, 0.725663716814159, 58, 24, 17, 14, 0.773333333333333, 0.631578947368421, 0.368421052631579, 0.194444444444444, 0.585365853658537, 0.805555555555556, 0.414634146341463, 0.194444444444444, 0.414634146341463, 0.274336283185841, 0.226666666666667, 0.368421052631579, 0.631578947368421, 0.585365853658537, 1.39092140921409, 0.209730117287623, 0.245, 0.819444444444444, 0.585365853658537, 0.734513274336283, 59, 24, 17, 13, 0.776315789473684, 0.648648648648649, 0.351351351351351, 0.180555555555556, 0.585365853658537, 0.819444444444444, 0.414634146341463, 0.180555555555556, 0.414634146341463, 0.265486725663717, 0.223684210526316, 0.351351351351351, 0.648648648648649, 0.585365853658537, 1.40481029810298, 0.204521783954289, 0.255, 0.819444444444444, 0.560975609756098, 0.725663716814159, 59, 23, 18, 13, 0.766233766233766, 0.638888888888889, 0.361111111111111, 0.180555555555556, 0.560975609756098, 0.819444444444444, 0.439024390243902, 0.180555555555556, 0.439024390243902, 0.274336283185841, 0.233766233766234, 0.361111111111111, 0.638888888888889, 0.560975609756098, 1.38042005420054, 0.225342723871006, 0.265, 0.819444444444444, 0.536585365853659, 0.716814159292035, 59, 22, 19, 13, 0.756410256410256, 0.628571428571429, 0.371428571428571, 0.180555555555556, 0.536585365853659, 0.819444444444444, 0.463414634146341, 0.180555555555556, 0.463414634146341, 0.283185840707965, 0.243589743589744, 0.371428571428571, 0.628571428571429, 0.536585365853659, 1.3560298102981, 0.247353431782963, 0.275, 0.819444444444444, 0.51219512195122, 0.707964601769911, 59, 21, 20, 13, 0.746835443037975, 0.617647058823529, 0.382352941176471, 0.180555555555556, 0.51219512195122, 0.819444444444444, 0.48780487804878, 0.180555555555556, 0.48780487804878, 0.292035398230089, 0.253164556962025, 0.382352941176471, 0.617647058823529, 0.51219512195122, 1.33163956639566, 0.270553907690161, 0.29, 0.833333333333333, 0.51219512195122, 0.716814159292035, 60, 21, 20, 12, 0.75, 0.636363636363636, 0.363636363636364, 0.166666666666667, 0.51219512195122, 0.833333333333333, 0.48780487804878, 0.166666666666667, 0.48780487804878, 0.283185840707965, 0.25, 0.363636363636364, 0.636363636363636, 0.51219512195122, 1.34552845528455, 0.265731376825963, 0.31, 0.833333333333333, 0.48780487804878, 0.707964601769911, 60, 20, 21, 12, 0.740740740740741, 0.625, 0.375, 0.166666666666667, 0.48780487804878, 0.833333333333333, 0.51219512195122, 0.166666666666667, 0.51219512195122, 0.292035398230089, 0.259259259259259, 0.375, 0.625, 0.48780487804878, 1.32113821138211, 0.290121620728402, 0.325, 0.847222222222222, 0.463414634146341, 0.707964601769911, 61, 19, 22, 11, 0.734939759036145, 0.633333333333333, 0.366666666666667, 0.152777777777778, 0.463414634146341, 0.847222222222222, 0.536585365853659, 0.152777777777778, 0.536585365853659, 0.292035398230089, 0.265060240963855, 0.366666666666667, 0.633333333333333, 0.463414634146341, 1.31063685636856, 0.311264904231021, 0.335, 0.861111111111111, 0.439024390243902, 0.707964601769911, 62, 18, 23, 10, 0.729411764705882, 0.642857142857143, 0.357142857142857, 0.138888888888889, 0.439024390243902, 0.861111111111111, 0.560975609756098, 0.138888888888889, 0.560975609756098, 0.292035398230089, 0.270588235294118, 0.357142857142857, 0.642857142857143, 0.439024390243902, 1.30013550135501, 0.333983758198016, 0.345, 0.875, 0.439024390243902, 0.716814159292035, 63, 18, 23, 9, 0.732558139534884, 0.666666666666667, 0.333333333333333, 0.125, 0.439024390243902, 0.875, 0.560975609756098, 0.125, 0.560975609756098, 0.283185840707965, 0.267441860465116, 0.333333333333333, 0.666666666666667, 0.439024390243902, 1.3140243902439, 0.330318634741226, 0.365, 0.875, 0.414634146341463, 0.707964601769911, 63, 17, 24, 9, 0.724137931034483, 0.653846153846154, 0.346153846153846, 0.125, 0.414634146341463, 0.875, 0.585365853658537, 0.125, 0.585365853658537, 0.292035398230089, 0.275862068965517, 0.346153846153846, 0.653846153846154, 0.414634146341463, 1.28963414634146, 0.358278182629387, 0.395, 0.888888888888889, 0.414634146341463, 0.716814159292035, 64, 17, 24, 8, 0.727272727272727, 0.68, 0.32, 0.111111111111111, 0.414634146341463, 0.888888888888889, 0.585365853658537, 0.111111111111111, 0.585365853658537, 0.283185840707965, 0.272727272727273, 0.32, 0.68, 0.414634146341463, 1.30352303523035, 0.354998861641733, 0.42, 0.888888888888889, 0.390243902439024, 0.707964601769911, 64, 16, 25, 8, 0.719101123595506, 0.666666666666667, 0.333333333333333, 0.111111111111111, 0.390243902439024, 0.888888888888889, 0.609756097560976, 0.111111111111111, 0.609756097560976, 0.292035398230089, 0.280898876404494, 0.333333333333333, 0.666666666666667, 0.390243902439024, 1.27913279132791, 0.384148177525136, 0.435, 0.902777777777778, 0.390243902439024, 0.716814159292035, 65, 16, 25, 7, 0.722222222222222, 0.695652173913043, 0.304347826086957, 0.0972222222222222, 0.390243902439024, 0.902777777777778, 0.609756097560976, 0.0972222222222222, 0.609756097560976, 0.283185840707965, 0.277777777777778, 0.304347826086957, 0.695652173913043, 0.390243902439024, 1.2930216802168, 0.381254659006617, 0.445, 0.902777777777778, 0.341463414634146, 0.699115044247788, 65, 14, 27, 7, 0.706521739130435, 0.666666666666667, 0.333333333333333, 0.0972222222222222, 0.341463414634146, 0.902777777777778, 0.658536585365854, 0.0972222222222222, 0.658536585365854, 0.300884955752212, 0.293478260869565, 0.333333333333333, 0.666666666666667, 0.341463414634146, 1.24424119241192, 0.443122594759145, 0.455, 0.916666666666667, 0.341463414634146, 0.707964601769911, 66, 14, 27, 6, 0.709677419354839, 0.7, 0.3, 0.0833333333333334, 0.341463414634146, 0.916666666666667, 0.658536585365854, 0.0833333333333334, 0.658536585365854, 0.292035398230089, 0.290322580645161, 0.3, 0.7, 0.341463414634146, 1.25813008130081, 0.440614878709763, 0.465, 0.930555555555556, 0.341463414634146, 0.716814159292035, 67, 14, 27, 5, 0.712765957446808, 0.736842105263158, 0.263157894736842, 0.0694444444444444, 0.341463414634146, 0.930555555555556, 0.658536585365854, 0.0694444444444444, 0.658536585365854, 0.283185840707965, 0.287234042553192, 0.263157894736842, 0.736842105263158, 0.341463414634146, 1.2720189701897, 0.438492965129516, 0.475, 0.958333333333333, 0.341463414634146, 0.734513274336283, 69, 14, 27, 3, 0.71875, 0.823529411764706, 0.176470588235294, 0.0416666666666666, 0.341463414634146, 0.958333333333333, 0.658536585365854, 0.0416666666666666, 0.658536585365854, 0.265486725663717, 0.28125, 0.176470588235294, 0.823529411764706, 0.341463414634146, 1.29979674796748, 0.435406545376429, 0.485, 0.972222222222222, 0.317073170731707, 0.734513274336283, 70, 13, 28, 2, 0.714285714285714, 0.866666666666667, 0.133333333333333, 0.0277777777777778, 0.317073170731707, 0.972222222222222, 0.682926829268293, 0.0277777777777778, 0.682926829268293, 0.265486725663717, 0.285714285714286, 0.133333333333333, 0.866666666666667, 0.317073170731707, 1.28929539295393, 0.467160659072715, 0.495, 0.972222222222222, 0.292682926829268, 0.725663716814159, 70, 12, 29, 2, 0.707070707070707, 0.857142857142857, 0.142857142857143, 0.0277777777777778, 0.292682926829268, 0.972222222222222, 0.707317073170732, 0.0277777777777778, 0.707317073170732, 0.274336283185841, 0.292929292929293, 0.142857142857143, 0.857142857142857, 0.292682926829268, 1.26490514905149, 0.501069046937082, 0.51, 1, 0.292682926829268, 0.743362831858407, 72, 12, 29, 0, 0.712871287128713, 1, 0, 0, 0.292682926829268, 1, 0.707317073170732, 0, 0.707317073170732, 0.256637168141593, 0.287128712871287, 0, 1, 0.292682926829268, 1.29268292682927, 0.50029744199881, 0.54, 1, 0.268292682926829, 0.734513274336283, 72, 11, 30, 0, 0.705882352941177, 1, 0, 0, 0.268292682926829, 1, 0.731707317073171, 0, 0.731707317073171, 0.265486725663717, 0.294117647058823, 0, 1, 0.268292682926829, 1.26829268292683, 0.535395597858418, 0.57, 1, 0.24390243902439, 0.725663716814159, 72, 10, 31, 0, 0.699029126213592, 1, 0, 0, 0.24390243902439, 1, 0.75609756097561, 0, 0.75609756097561, 0.274336283185841, 0.300970873786408, 0, 1, 0.24390243902439, 1.24390243902439, 0.571683521713266, 0.64, 1, 0.219512195121951, 0.716814159292035, 72, 9, 32, 0, 0.692307692307692, 1, 0, 0, 0.219512195121951, 1, 0.780487804878049, 0, 0.780487804878049, 0.283185840707965, 0.307692307692308, 0, 1, 0.219512195121951, 1.21951219512195, 0.609161213563355, 0.705, 1, 0.195121951219512, 0.707964601769911, 72, 8, 33, 0, 0.685714285714286, 1, 0, 0, 0.195121951219512, 1, 0.804878048780488, 0, 0.804878048780488, 0.292035398230089, 0.314285714285714, 0, 1, 0.195121951219512, 1.19512195121951, 0.647828673408685, 0.725, 1, 0.146341463414634, 0.690265486725664, 72, 6, 35, 0, 0.672897196261682, 1, 0, 0, 0.146341463414634, 1, 0.853658536585366, 0, 0.853658536585366, 0.309734513274336, 0.327102803738318, 0, 1, 0.146341463414634, 1.14634146341463, 0.728732897085068, 0.755, 1, 0.121951219512195, 0.68141592920354, 72, 5, 36, 0, 0.666666666666667, 1, 0, 0, 0.121951219512195, 1, 0.878048780487805, 0, 0.878048780487805, 0.31858407079646, 0.333333333333333, 0, 1, 0.121951219512195, 1.1219512195122, 0.770969660916121, 0.795, 1, 0.0975609756097561, 0.672566371681416, 72, 4, 37, 0, 0.660550458715596, 1, 0, 0, 0.0975609756097561, 1, 0.902439024390244, 0, 0.902439024390244, 0.327433628318584, 0.339449541284404, 0, 1, 0.0975609756097561, 1.09756097560976, 0.814396192742415, 0.84, 1, 0.0731707317073171, 0.663716814159292, 72, 3, 38, 0, 0.654545454545455, 1, 0, 0, 0.0731707317073171, 1, 0.926829268292683, 0, 0.926829268292683, 0.336283185840708, 0.345454545454545, 0, 1, 0.0731707317073171, 1.07317073170732, 0.85901249256395, 0.91, 1, 0.0487804878048781, 0.654867256637168, 72, 2, 39, 0, 0.648648648648649, 1, 0, 0, 0.0487804878048781, 1, 0.951219512195122, 0, 0.951219512195122, 0.345132743362832, 0.351351351351351, 0, 1, 0.0487804878048781, 1.04878048780488, 0.904818560380726, 1.515, 1, 0.024390243902439, 0.646017699115044, 72, 1, 40, 0, 0.642857142857143, 1, 0, 0, 0.024390243902439, 1, 0.975609756097561, 0, 0.975609756097561, 0.353982300884956, 0.357142857142857, 0, 1, 0.024390243902439, 1.02439024390244, 0.951814396192742, Inf, 1, 0, 0.63716814159292, 72, 0, 41, 0, 0.63716814159292, NaN, NaN, 0, 0, 1, 1, 0, 1, 0.36283185840708, 0.36283185840708, NaN, NaN, 0, 1, 1), .Dim = c(24L, 51L), .Dimnames = list( c("threshold", "specificity", "sensitivity", "accuracy", "tn", "tp", "fn", "fp", "npv", "ppv", "fdr", "fpr", "tpr", "tnr", "fnr", "1-specificity", "1-sensitivity", "1-accuracy", "1-npv", "1-ppv", "precision", "recall", "youden", "closest.topleft" ), NULL)) r.100b.reversed <- roc(aSAH$outcome, aSAH$s100b, direction=">", quiet=TRUE) expected.coords.reverse <- structure(c(0.05, 0.888888888888889, 0.024390243902439, 0.575221238938053, 64, 1, 40, 8, 0.615384615384615, 0.111111111111111, 0.111111111111111, 0.975609756097561, 0.424778761061947, 0.384615384615385, 0.888888888888889, 0.055, 0.888888888888889, 0.024390243902439, 0.575221238938053, 64, 1, 40, 8, 0.615384615384615, 0.111111111111111, 0.111111111111111, 0.975609756097561, 0.424778761061947, 0.384615384615385, 0.888888888888889, 0.205, 0.194444444444444, 0.365853658536585, 0.256637168141593, 14, 15, 26, 58, 0.35, 0.205479452054795, 0.805555555555556, 0.634146341463415, 0.743362831858407, 0.65, 0.794520547945206, 0.52, 0, 0.731707317073171, 0.265486725663717, 0, 30, 11, 72, 0, 0.294117647058824, 1, 0.268292682926829, 0.734513274336283, 1, 0.705882352941176), .Dim = c(15L, 4L), .Dimnames = list( c("threshold", "specificity", "sensitivity", "accuracy", "tn", "tp", "fn", "fp", "npv", "ppv", "1-specificity", "1-sensitivity", "1-accuracy", "1-npv", "1-ppv"), NULL)) pROC/tests/testthat/test-roc.utils.R0000644000176200001440000000601113772575475017125 0ustar liggesuserslibrary(pROC) data(aSAH) context("roc.utils") test_that("roc.utils.thr.idx finds correc thresholds with direction=<", { obtained <- pROC:::roc.utils.thr.idx(r.s100b, c(-Inf, 0.205, 0.055, Inf)) expect_equal(obtained, c(1, 18, 4, 51)) }) test_that("roc.utils.thr.idx finds correc thresholds with direction=>", { obtained <- pROC:::roc.utils.thr.idx(r.s100b, c(Inf, -Inf, 0.05, 0.055, 0.52, 0.205)) expect_equal(obtained, c(51, 1, 3, 4, 40, 18)) }) test_that("roc.utils.calc.coords works", { obtained <- pROC:::roc.utils.calc.coords(r.s100b, -1:-4, c(1, .5, .1, 0), c(0, .5, .9, 1), c(12, .9)) expect_equal(obtained, expected_roc.utils.calc.coords) }) test_that("roc.utils.calc.coords works with percent", { obtained <- pROC:::roc.utils.calc.coords(r.s100b.percent, -1:-4, c(100, 50, 10, 0), c(0, 50, 90, 100), c(12, .9)) expect_equal(obtained, expected_roc.utils.calc.coords.percent) }) test_that("roc.utils.match.coords.input.args works", { expect_equal(pROC:::roc.utils.match.coords.input.args("t"), "threshold") expect_equal(pROC:::roc.utils.match.coords.input.args("threshold"), "threshold") expect_equal(pROC:::roc.utils.match.coords.input.args("fp"), "fp") expect_equal(pROC:::roc.utils.match.coords.input.args("1-se"), "1-sensitivity") for (coord in names(which(pROC:::coord.is.monotone))) { expect_equal(pROC:::roc.utils.match.coords.input.args(coord), coord) } # Errors # t with threshold=False expect_error(pROC:::roc.utils.match.coords.input.args("t", threshold = FALSE)) # all only for ret expect_error(pROC:::roc.utils.match.coords.input.args("all")) # Only one allowed expect_error(pROC:::roc.utils.match.coords.input.args(c("specificity", "sensitivity")), "length 1") # Invalid arg expect_error(pROC:::roc.utils.match.coords.input.args("blah")) # Not monotone expect_error(pROC:::roc.utils.match.coords.input.args("npe")) expect_error(pROC:::roc.utils.match.coords.input.args("accuracy")) }) test_that("roc.utils.match.coords.ret.args works", { expect_equal(pROC:::roc.utils.match.coords.ret.args("t"), "threshold") expect_equal(pROC:::roc.utils.match.coords.ret.args("threshold"), "threshold") expect_equal(pROC:::roc.utils.match.coords.ret.args("fp"), "fp") expect_equal(pROC:::roc.utils.match.coords.ret.args("1-se"), "1-sensitivity") expect_equal(pROC:::roc.utils.match.coords.ret.args("npe"), "1-npv") for (coord in pROC:::roc.utils.valid.coords) { expect_equal(pROC:::roc.utils.match.coords.ret.args(coord), coord) } expect_equal(pROC:::roc.utils.match.coords.ret.args(pROC:::roc.utils.valid.coords), pROC:::roc.utils.valid.coords) # Errors # t with threshold=False expect_error(pROC:::roc.utils.match.coords.ret.args("t", threshold = FALSE)) # Invalid arg expect_error(pROC:::roc.utils.match.coords.ret.args("blah")) # The following should be invalid but somehow it seems valid to say: # match.arg(c("sensitivity", "blah"), "sensitivity", TRUE) # and the extra 'blah' arg is ignored by match.arg. # Ignoring for now # expect_error(pROC:::roc.utils.match.coords.ret.args(c("sensitivity", "blah"))) }) pROC/tests/testthat/test-large.R0000644000176200001440000000137314114130125016245 0ustar liggesuserslibrary(pROC) context("large data sets") test_that("roc can deal with 1E5 data points and many thresholds", { response <- rbinom(1E5, 1, .5) predictor <- rnorm(1E5) # ~ 0.6s r <- roc(response, predictor) ci(r) expect_is(auc(r, partial.auc = c(0.9, 1)), "auc") }) test_that("roc can deal with 1E6 data points and few thresholds", { response <- rbinom(1E6, 1, .5) predictor <- rpois(1E6, 1) # ~ 0.3s r <- roc(response, predictor) ci(r) expect_is(auc(r, partial.auc = c(0.9, 1)), "auc") }) test_that("roc can deal with 1E7 data points and few thresholds", { skip_slow() response <- rbinom(1E7, 1, .5) predictor <- rpois(1E7, 1) # ~ 3s r <- roc(response, predictor) ci(r) expect_is(auc(r, partial.auc = c(0.9, 1)), "auc") }) pROC/tests/testthat/test-auc.R0000644000176200001440000003100613607143106015730 0ustar liggesuserslibrary(pROC) data(aSAH) context("auc") test_that("full auc works", { expect_equal(as.numeric(auc(r.wfns)), 0.823678861788618) expect_equal(as.numeric(auc(r.wfns.percent)), 82.3678861788618) expect_equal(as.numeric(auc(r.ndka)), 0.611957994579946) expect_equal(as.numeric(auc(r.ndka.percent)), 61.1957994579946) }) test_that("partial auc works on arbitrary intervals", { expect_equal(as.numeric(auc(r.wfns, partial.auc = c(1, .9))), 0.0334417344173442) expect_equal(as.numeric(auc(r.wfns.percent, partial.auc = c(100, 90))), 3.34417344173442) # direction is unspecified expect_equal(as.numeric(auc(r.wfns, partial.auc = c(.9, 1))), 0.0334417344173442) expect_equal(as.numeric(auc(r.wfns.percent, partial.auc = c(90, 100))), 3.34417344173442) # Arbitrary intervals expect_equal(as.numeric(auc(r.wfns, partial.auc = c(.9, .8))), 0.0598373983739837) expect_equal(as.numeric(auc(r.wfns.percent, partial.auc = c(90, 80))), 5.98373983739837) expect_equal(as.numeric(auc(r.wfns, partial.auc = c(.5, 0))), 0.488134475939354) expect_equal(as.numeric(auc(r.wfns.percent, partial.auc = c(50, 0))), 48.8134475939354) # NDKA expect_equal(as.numeric(auc(r.ndka, partial.auc = c(1, .9))), 0.0107046070460705) expect_equal(as.numeric(auc(r.ndka.percent, partial.auc = c(100, 90))), 1.07046070460705) # direction is unspecified expect_equal(as.numeric(auc(r.ndka, partial.auc = c(.9, 1))), 0.0107046070460705) expect_equal(as.numeric(auc(r.ndka.percent, partial.auc = c(90, 100))), 1.07046070460705) # Arbitrary intervals expect_equal(as.numeric(auc(r.ndka, partial.auc = c(.9, .8))), 0.0277777777777778) expect_equal(as.numeric(auc(r.ndka.percent, partial.auc = c(90, 80))), 2.77777777777778) expect_equal(as.numeric(auc(r.ndka, partial.auc = c(.5, 0))), 0.416836043360434) expect_equal(as.numeric(auc(r.ndka.percent, partial.auc = c(50, 0))), 41.6836043360434) # Full interval == full auc expect_equal(as.numeric(auc(r.wfns, partial.auc = c(1, 0))), 0.823678861788618) expect_equal(as.numeric(auc(r.wfns.percent, partial.auc = c(100, 0))), 82.3678861788618) # direction is unspecified expect_equal(as.numeric(auc(r.ndka, partial.auc = c(1, 0))), 0.611957994579946) expect_equal(as.numeric(auc(r.ndka.percent, partial.auc = c(100, 0))), 61.1957994579946) }) test_that("partial auc works with focus on SE", { expect_equal(as.numeric(auc(r.wfns, partial.auc = c(1, .9), partial.auc.focus = "se")), 0.0400999322493225) expect_equal(as.numeric(auc(r.wfns.percent, partial.auc = c(100, 90), partial.auc.focus = "se")), 4.00999322493225) # direction is unspecified expect_equal(as.numeric(auc(r.wfns, partial.auc = c(.9, 1), partial.auc.focus = "se")), 0.0400999322493225) expect_equal(as.numeric(auc(r.wfns.percent, partial.auc = c(90, 100), partial.auc.focus = "se")), 4.00999322493225) # Arbitrary intervals expect_equal(as.numeric(auc(r.wfns, partial.auc = c(.9, .8), partial.auc.focus = "se")), 0.0609953703703703) expect_equal(as.numeric(auc(r.wfns.percent, partial.auc = c(90, 80), partial.auc.focus = "se")), 6.09953703703703) expect_equal(as.numeric(auc(r.wfns, partial.auc = c(.5, 0), partial.auc.focus = "se")), 0.483358739837398) expect_equal(as.numeric(auc(r.wfns.percent, partial.auc = c(50, 0), partial.auc.focus = "se")), 48.3358739837398) # NDKA expect_equal(as.numeric(auc(r.ndka, partial.auc = c(1, .9), partial.auc.focus = "se")), 0.0037940379403794) expect_equal(as.numeric(auc(r.ndka.percent, partial.auc = c(100, 90), partial.auc.focus = "se")), 0.37940379403794) # direction is unspecified expect_equal(as.numeric(auc(r.ndka, partial.auc = c(.9, 1), partial.auc.focus = "se")), 0.0037940379403794) expect_equal(as.numeric(auc(r.ndka.percent, partial.auc = c(90, 100), partial.auc.focus = "se")), 0.37940379403794) # Arbitrary intervals expect_equal(as.numeric(auc(r.ndka, partial.auc = c(.9, .8), partial.auc.focus = "se")), 0.0242547425474255) expect_equal(as.numeric(auc(r.ndka.percent, partial.auc = c(90, 80), partial.auc.focus = "se")), 2.42547425474255) expect_equal(as.numeric(auc(r.ndka, partial.auc = c(.5, 0), partial.auc.focus = "se")), 0.428523035230352) expect_equal(as.numeric(auc(r.ndka.percent, partial.auc = c(50, 0), partial.auc.focus = "se")), 42.8523035230352) # Full interval == full auc expect_equal(as.numeric(auc(r.wfns, partial.auc = c(1, 0), partial.auc.focus = "se")), 0.823678861788618) expect_equal(as.numeric(auc(r.wfns.percent, partial.auc = c(100, 0), partial.auc.focus = "se")), 82.3678861788618) # direction is unspecified expect_equal(as.numeric(auc(r.ndka, partial.auc = c(1, 0), partial.auc.focus = "se")), 0.611957994579946) expect_equal(as.numeric(auc(r.ndka.percent, partial.auc = c(100, 0), partial.auc.focus = "se")), 61.1957994579946) }) test_that("partial auc works with correction enabled", { expect_equal(as.numeric(auc(r.wfns, partial.auc = c(1, .9), partial.auc.correct = TRUE)), 0.649693339038653) expect_equal(as.numeric(auc(r.wfns.percent, partial.auc = c(100, 90), partial.auc.correct = TRUE)), 64.9693339038653) # direction is unspecified expect_equal(as.numeric(auc(r.wfns, partial.auc = c(.9, 1), partial.auc.correct = TRUE)), 0.649693339038653) expect_equal(as.numeric(auc(r.wfns.percent, partial.auc = c(90, 100), partial.auc.correct = TRUE)), 64.9693339038653) # Arbitrary intervals expect_equal(as.numeric(auc(r.wfns, partial.auc = c(.9, .8), partial.auc.correct = TRUE)), 0.763749402199904) expect_equal(as.numeric(auc(r.wfns.percent, partial.auc = c(90, 80), partial.auc.correct = TRUE)), 76.3749402199904) expect_equal(as.numeric(auc(r.wfns, partial.auc = c(.5, 0), partial.auc.correct = TRUE)), 0.952537903757416) expect_equal(as.numeric(auc(r.wfns.percent, partial.auc = c(50, 0), partial.auc.correct = TRUE)), 95.2537903757416) # NDKA expect_equal(as.numeric(auc(r.ndka, partial.auc = c(1, .9), partial.auc.correct = TRUE)), 0.530024247610897) expect_equal(as.numeric(auc(r.ndka.percent, partial.auc = c(100, 90), partial.auc.correct = TRUE)), 53.0024247610897) # direction is unspecified expect_equal(as.numeric(auc(r.ndka, partial.auc = c(.9, 1), partial.auc.correct = TRUE)), 0.530024247610897) expect_equal(as.numeric(auc(r.ndka.percent, partial.auc = c(90, 100), partial.auc.correct = TRUE)), 53.0024247610897) # Arbitrary intervals expect_equal(as.numeric(auc(r.ndka, partial.auc = c(.9, .8), partial.auc.correct = TRUE)), 0.575163398692811) expect_equal(as.numeric(auc(r.ndka.percent, partial.auc = c(90, 80), partial.auc.correct = TRUE)), 57.5163398692811) expect_equal(as.numeric(auc(r.ndka, partial.auc = c(.5, 0), partial.auc.correct = TRUE)), 0.667344173441734) expect_equal(as.numeric(auc(r.ndka.percent, partial.auc = c(50, 0), partial.auc.correct = TRUE)), 66.7344173441734) # Full interval == full auc expect_equal(as.numeric(auc(r.wfns, partial.auc = c(1, 0), partial.auc.correct = TRUE)), 0.823678861788618) expect_equal(as.numeric(auc(r.wfns.percent, partial.auc = c(100, 0), partial.auc.correct = TRUE)), 82.3678861788618) # direction is unspecified expect_equal(as.numeric(auc(r.ndka, partial.auc = c(1, 0), partial.auc.correct = TRUE)), 0.611957994579946) expect_equal(as.numeric(auc(r.ndka.percent, partial.auc = c(100, 0), partial.auc.correct = TRUE)), 61.1957994579946) }) test_that("partial auc works with focus on SE and correction enabled", { expect_equal(as.numeric(auc(r.wfns, partial.auc = c(1, .9), partial.auc.focus = "se", partial.auc.correct = TRUE)), 0.68473648552275) expect_equal(as.numeric(auc(r.wfns.percent, partial.auc = c(100, 90), partial.auc.focus = "se", partial.auc.correct = TRUE)), 68.473648552275) # direction is unspecified expect_equal(as.numeric(auc(r.wfns, partial.auc = c(.9, 1), partial.auc.focus = "se", partial.auc.correct = TRUE)), 0.68473648552275) expect_equal(as.numeric(auc(r.wfns.percent, partial.auc = c(90, 100), partial.auc.focus = "se", partial.auc.correct = TRUE)), 68.473648552275) # Arbitrary intervals expect_equal(as.numeric(auc(r.wfns, partial.auc = c(.9, .8), partial.auc.focus = "se", partial.auc.correct = TRUE)), 0.770561002178649) expect_equal(as.numeric(auc(r.wfns.percent, partial.auc = c(90, 80), partial.auc.focus = "se", partial.auc.correct = TRUE)), 77.0561002178649) expect_equal(as.numeric(auc(r.wfns, partial.auc = c(.5, 0), partial.auc.focus = "se", partial.auc.correct = TRUE)), 0.933434959349593) expect_equal(as.numeric(auc(r.wfns.percent, partial.auc = c(50, 0), partial.auc.focus = "se", partial.auc.correct = TRUE)), 93.3434959349593) # NDKA expect_warning(auc(r.ndka, partial.auc = c(1, .9), partial.auc.focus = "se", partial.auc.correct = TRUE)) expect_warning(auc(r.ndka.percent, partial.auc = c(100, 90), partial.auc.focus = "se", partial.auc.correct = TRUE)) expect_warning(expect_identical(as.numeric(auc(r.ndka, partial.auc = c(1, .9), partial.auc.focus = "se", partial.auc.correct = TRUE)), NA_real_)) expect_warning(expect_identical(as.numeric(auc(r.ndka.percent, partial.auc = c(100, 90), partial.auc.focus = "se", partial.auc.correct = TRUE)), NA_real_)) # direction is unspecified expect_warning(auc(r.ndka, partial.auc = c(.9, 1), partial.auc.focus = "se", partial.auc.correct = TRUE)) expect_warning(auc(r.ndka.percent, partial.auc = c(90, 100), partial.auc.focus = "se", partial.auc.correct = TRUE)) expect_warning(expect_identical(as.numeric(auc(r.ndka, partial.auc = c(.9, 1), partial.auc.focus = "se", partial.auc.correct = TRUE)), NA_real_)) expect_warning(expect_identical(as.numeric(auc(r.ndka.percent, partial.auc = c(90, 100), partial.auc.focus = "se", partial.auc.correct = TRUE)), NA_real_)) # Arbitrary intervals expect_equal(as.numeric(auc(r.ndka, partial.auc = c(.9, .8), partial.auc.focus = "se", partial.auc.correct = TRUE)), 0.554439662043679) expect_equal(as.numeric(auc(r.ndka.percent, partial.auc = c(90, 80), partial.auc.focus = "se", partial.auc.correct = TRUE)), 55.4439662043679) expect_equal(as.numeric(auc(r.ndka, partial.auc = c(.5, 0), partial.auc.focus = "se", partial.auc.correct = TRUE)), 0.714092140921409) expect_equal(as.numeric(auc(r.ndka.percent, partial.auc = c(50, 0), partial.auc.focus = "se", partial.auc.correct = TRUE)), 71.4092140921409) # Full interval == full auc expect_equal(as.numeric(auc(r.wfns, partial.auc = c(1, 0), partial.auc.focus = "se", partial.auc.correct = TRUE)), 0.823678861788618) expect_equal(as.numeric(auc(r.wfns.percent, partial.auc = c(100, 0), partial.auc.focus = "se", partial.auc.correct = TRUE)), 82.3678861788618) # direction is unspecified expect_equal(as.numeric(auc(r.ndka, partial.auc = c(1, 0), partial.auc.focus = "se", partial.auc.correct = TRUE)), 0.611957994579946) expect_equal(as.numeric(auc(r.ndka.percent, partial.auc = c(100, 0), partial.auc.focus = "se", partial.auc.correct = TRUE)), 61.1957994579946) }) test_that("auc can create a roc curve", { expect_equal(as.numeric(auc(aSAH$outcome, aSAH$wfns)), as.numeric(auc(r.wfns))) expect_equal(as.numeric(auc(aSAH$outcome, aSAH$ndka)), as.numeric(auc(r.ndka))) # With formula expect_equal(as.numeric(auc(outcome ~ wfns, aSAH)), as.numeric(auc(r.wfns))) expect_equal(as.numeric(auc(outcome ~ ndka, aSAH)), as.numeric(auc(r.ndka))) }) test_that("auc can create a roc curve with percent", { expect_equal(as.numeric(auc(aSAH$outcome, aSAH$wfns, percent = TRUE)), as.numeric(auc(r.wfns.percent))) expect_equal(as.numeric(auc(aSAH$outcome, aSAH$ndka, percent = TRUE)), as.numeric(auc(r.ndka.percent))) # With formula expect_equal(as.numeric(auc(outcome ~ wfns, aSAH, percent = TRUE)), as.numeric(auc(r.wfns.percent))) expect_equal(as.numeric(auc(outcome ~ ndka, aSAH, percent = TRUE)), as.numeric(auc(r.ndka.percent))) }) test_that("auc.formula behaves", { expect_equal( as.numeric(auc(outcome ~ wfns, data = aSAH)), as.numeric(auc(aSAH$outcome, aSAH$wfns)) ) expect_equal( as.numeric(auc(outcome ~ wfns, data = aSAH, subset = (gender == "Female"))), as.numeric(auc(aSAH$outcome[aSAH$gender == "Female"], aSAH$wfns[aSAH$gender == "Female"])) ) # Generate missing values aSAH.missing <- aSAH aSAH.missing$ndka[1:20] <- NA expect_equal( as.numeric(auc(outcome ~ ndka, data = aSAH.missing, na.action = na.omit)), as.numeric(auc(aSAH[21:113,]$outcome, aSAH[21:113,]$ndka)) ) #na.fail should fail expect_error(auc(outcome ~ ndka, data = aSAH.missing, na.action = na.fail)) #weights should fail too expect_error(auc(outcome ~ ndka, data = aSAH, weights = seq_len(nrow(aSAH))), regexp = "weights are not supported") # Both na.action and subset expect_equal( as.numeric(auc(outcome ~ ndka, data = aSAH.missing, na.action = na.omit, subset = (gender == "Female"))), as.numeric(auc(aSAH[21:113,]$outcome[aSAH[21:113,]$gender == "Female"], aSAH[21:113,]$ndka[aSAH[21:113,]$gender == "Female"])) ) }) pROC/tests/testthat/helper-skip.R0000644000176200001440000000020614114130125016413 0ustar liggesusers# Skip slow tests skip_slow <- function() { skip_if_not(exists("run_slow_tests") && run_slow_tests, message = "Slow test skipped") } pROC/tests/testthat/test-print.R0000644000176200001440000001576714114130125016323 0ustar liggesuserslibrary(pROC) data(aSAH) context("print") test_that("print.auc works", { expect_output(print(auc(r.wfns)), "^Area under the curve: 0.8237$") expect_output(print(auc(r.ndka.percent)), "^Area under the curve: 61.2%$") expect_output(print(r.ndka.partial$auc), "^Partial area under the curve \\(specificity 1-0.9\\): 0.0107$") expect_output(print(r.s100b.percent.partial1$auc), "^Partial area under the curve \\(specificity 99%-90%\\): 2.983%$") expect_output(print(r.s100b.partial2$auc), "^Partial area under the curve \\(sensitivity 0.99-0.9\\): 0.01376$") }) test_that("print.roc works", { expect_known_output(print(r.wfns), "print_output/r.wfns") expect_known_output(print(r.ndka), "print_output/r.ndka") expect_known_output(print(r.s100b), "print_output/r.s100b") expect_known_output(print(r.wfns.percent), "print_output/r.wfns.percent") expect_known_output(print(r.ndka.percent), "print_output/r.ndka.percent") expect_known_output(print(r.s100b.percent), "print_output/r.s100b.percent") expect_known_output(print(r.wfns.partial1), "print_output/r.wfns.partial1") expect_known_output(print(r.ndka.partial1), "print_output/r.ndka.partial1") expect_known_output(print(r.s100b.partial1), "print_output/r.s100b.partial1") expect_known_output(print(r.wfns.percent.partial1), "print_output/r.wfns.percent.partial1") expect_known_output(print(r.ndka.percent.partial1), "print_output/r.ndka.percent.partial1") expect_known_output(print(r.s100b.percent.partial1), "print_output/r.s100b.percent.partial1") expect_known_output(print(r.s100b.partial2), "print_output/r.s100b.partial2") expect_known_output(print(roc(outcome ~ ndka, aSAH)), "print_output/ndka_formula") }) test_that("print.multiclass.roc works", { expect_known_output(print(multiclass.roc(aSAH$gos6, aSAH$ndka)), "print_output/multiclass") expect_known_output(print(multiclass.roc(aSAH$gos6, aSAH$ndka, levels=c(3, 4, 5))), "print_output/multiclass_levels") expect_known_output(print(multiclass.roc(aSAH$gos6, aSAH$ndka, percent=TRUE)), "print_output/multiclass_percent") }) test_that("print.multiclass.roc works", { expect_known_output(print(multiclass.roc(aSAH$gos6, aSAH$ndka)), "print_output/multiclass") expect_known_output(print(multiclass.roc(aSAH$gos6, aSAH$ndka, levels=c(3, 4, 5))), "print_output/multiclass_levels") expect_known_output(print(multiclass.roc(aSAH$gos6, aSAH$ndka, percent=TRUE)), "print_output/multiclass_percent") expect_known_output(print(multiclass.roc(aSAH$gos6, aSAH$ndka, partial.auc=c(1, .9))), "print_output/multiclass_partial") expect_known_output(print(multiclass.roc(aSAH$gos6, aSAH$ndka, partial.auc=c(1, .9), partial.auc.focus="se")), "print_output/multiclass_partial_se") expect_known_output(print(multiclass.roc(aSAH$gos6, aSAH$wfns, partial.auc=c(1, .9), partial.auc.correct=TRUE)), "print_output/multiclass_partial_correct") }) test_that("print.multiclass.roc multivariate works", { n <- c(100, 80, 150) responses <- factor(c(rep("X1", n[1]), rep("X2", n[2]), rep("X3", n[3]))) set.seed(42) preds <- lapply(n, function(x) runif(x, 0.4, 0.6)) predictor <- as.matrix(data.frame( "X1" = c(preds[[1]], runif(n[2] + n[3], 0, 0.7)), "X2" = c(runif(n[1], 0.1, 0.4), preds[[2]], runif(n[3], 0.2, 0.8)), "X3" = c(runif(n[1] + n[2], 0.3, 0.7), preds[[3]]) )) expect_known_output(print(multiclass.roc(responses, predictor)), "print_output/mv_multiclass") expect_known_output(print(multiclass.roc(responses, predictor, levels=c("X2", "X3"))), "print_output/mv_multiclass_levels") expect_known_output(print(multiclass.roc(responses, predictor, percent=TRUE)), "print_output/mv_multiclass_percent") expect_known_output(print(multiclass.roc(responses, predictor, partial.auc=c(1, .9))), "print_output/mv_multiclass_partial") expect_known_output(print(multiclass.roc(responses, predictor, partial.auc=c(1, .9), partial.auc.focus="se")), "print_output/mv_multiclass_partial_se") expect_known_output(print(multiclass.roc(responses, predictor, partial.auc=c(1, .9), partial.auc.correct=TRUE)), "print_output/mv_multiclass_partial_correct") }) test_that("print works with a formula", { expect_known_output(print(roc(outcome ~ ndka, aSAH)), "print_output/r.ndka.formula") expect_known_output(print(multiclass.roc(gos6 ~ ndka, aSAH)), "print_output/mv_multiclass.ndka.formula") }) test_that("print works without the auc", { expect_known_output(print(roc(outcome ~ ndka, aSAH, auc=FALSE)), "print_output/r.ndka.formula.no_auc") }) test_that("print works with the CI", { skip_slow() if (R.version$minor >= "6.0") { RNGkind(sample.kind="Rounding") } set.seed(42) # For reproducible CI expect_known_output(print(roc(outcome ~ ndka, aSAH, ci=TRUE)), "print_output/r.ndka.formula.ci") }) test_that("print.smooth.roc works", { expect_known_output(print(smooth(roc(aSAH$outcome, aSAH$ndka))), "print_output/smooth.ndka") expect_known_output(print(smooth(roc(outcome ~ s100b, aSAH))), "print_output/smooth.s100b.formula") expect_known_output(print(smooth(roc(aSAH$outcome, aSAH$ndka))), "print_output/smooth.wfns") expect_known_output(print(smooth(roc(aSAH$outcome, aSAH$ndka), method="binormal")), "print_output/smooth.s100b.binormal") expect_known_output(print(smooth(roc(outcome ~ s100b, aSAH), method="fitdistr")), "print_output/smooth.s100b.fitdistr") expect_known_output(print(smooth(roc(outcome ~ s100b, aSAH), method="density")), "print_output/smooth.s100b.density") testthat::skip_if_not_installed("logcondens") expect_known_output(print(smooth(roc(outcome ~ s100b, aSAH), method="logcondens")), "print_output/smooth.s100b.logcondens") expect_known_output(print(smooth(roc(outcome ~ s100b, aSAH), method="logcondens.smooth")), "print_output/smooth.s100b.logcondens.smooth") }) test_that("print works with ci.auc", { skip_slow() if (R.version$minor >= "6.0") { RNGkind(sample.kind="Rounding") } set.seed(42) # For reproducible CI expect_known_output(print(ci.auc(r.ndka, method = "bootstrap", boot.n = 3, progress = "none")), "print_output/r.ndka.ci.auc") }) test_that("print works with ci.coords", { skip_slow() if (R.version$minor >= "6.0") { RNGkind(sample.kind="Rounding") } set.seed(42) # For reproducible CI expect_known_output(print(ci.coords(r.ndka, x = c(0.5, 0.2), boot.n = 3, progress = "none")), "print_output/r.ndka.ci.coords") }) test_that("print works with ci.thresholds", { skip_slow() if (R.version$minor >= "6.0") { RNGkind(sample.kind="Rounding") } set.seed(42) # For reproducible CI expect_known_output(print(ci.thresholds(r.ndka, thresholds = c(0.5, 0.2), boot.n = 3, progress = "none")), "print_output/r.ndka.ci.thresholds") }) test_that("print works with ci.se", { skip_slow() if (R.version$minor >= "6.0") { RNGkind(sample.kind="Rounding") } set.seed(42) # For reproducible CI expect_known_output(print(ci.se(r.ndka, boot.n = 3, progress = "none")), "print_output/r.ndka.ci.se") }) test_that("print works with ci.sp", { skip_slow() if (R.version$minor >= "6.0") { RNGkind(sample.kind="Rounding") } set.seed(42) # For reproducible CI expect_known_output(print(ci.sp(r.ndka, boot.n = 3, progress = "none")), "print_output/r.ndka.ci.sp") }) pROC/tests/testthat/print_output/0000755000176200001440000000000014114130125016623 5ustar liggesuserspROC/tests/testthat/print_output/r.s100b.partial20000644000176200001440000000043613607143106021364 0ustar liggesusers Call: roc.default(response = aSAH$outcome, predictor = aSAH$s100b, quiet = TRUE, partial.auc = c(0.9, 0.99), partial.auc.focus = "se") Data: aSAH$s100b in 72 controls (aSAH$outcome Good) < 41 cases (aSAH$outcome Poor). Partial area under the curve (sensitivity 0.99-0.9): 0.01376 pROC/tests/testthat/print_output/smooth.s100b.logcondens0000644000176200001440000000030513607143106023044 0ustar liggesusers Call: smooth.roc(roc = roc(outcome ~ s100b, aSAH), method = "logcondens") Data: s100b in 72 controls (outcome Good) < 41 cases (outcome Poor). Smoothing: logcondens Area under the curve: 0.7542 pROC/tests/testthat/print_output/r.wfns.percent.partial10000644000176200001440000000041513607143106023147 0ustar liggesusers Call: roc.default(response = aSAH$outcome, predictor = aSAH$wfns, percent = TRUE, quiet = TRUE, partial.auc = c(90, 99)) Data: aSAH$wfns in 72 controls (aSAH$outcome Good) < 41 cases (aSAH$outcome Poor). Partial area under the curve (specificity 99%-90%): 3.305% pROC/tests/testthat/print_output/r.ndka.ci.thresholds0000644000176200001440000000034614114130125022476 0ustar liggesusers95% CI (3 stratified bootstrap replicates): thresholds sp.low sp.median sp.high se.low se.median se.high 0.5 0 0 0 1 1 1 0.2 0 0 0 1 1 1 pROC/tests/testthat/print_output/r.s100b.partial10000644000176200001440000000040413607143106021356 0ustar liggesusers Call: roc.default(response = aSAH$outcome, predictor = aSAH$s100b, quiet = TRUE, partial.auc = c(0.9, 0.99)) Data: aSAH$s100b in 72 controls (aSAH$outcome Good) < 41 cases (aSAH$outcome Poor). Partial area under the curve (specificity 0.99-0.9): 0.02983 pROC/tests/testthat/print_output/r.ndka.ci.auc0000644000176200001440000000007214114130125021063 0ustar liggesusers95% CI: 0.5869-0.6329 (3 stratified bootstrap replicates) pROC/tests/testthat/print_output/roc.test-venkatraman.unpaired0000644000176200001440000000032114114130125024416 0ustar liggesusers Venkatraman's test for two unpaired ROC curves data: r.s100b and r.wfns E = 41, boot.n = 12, p-value = 0.5483 alternative hypothesis: true difference in at least one ROC operating point is not equal to 0 pROC/tests/testthat/print_output/r.ndka.ci.coords0000644000176200001440000000106014114130125021602 0ustar liggesusers95% CI (3 stratified bootstrap replicates): threshold threshold.low threshold.median threshold.high specificity.low 0.5 0.5 0.5 0.5 0.5 0 0.2 0.2 0.2 0.2 0.2 0 specificity.median specificity.high sensitivity.low sensitivity.median 0.5 0 0 1 1 0.2 0 0 1 1 sensitivity.high 0.5 1 0.2 1 pROC/tests/testthat/print_output/smooth.ndka0000644000176200001440000000027413607143106021007 0ustar liggesusers Call: smooth.roc(roc = roc(aSAH$outcome, aSAH$ndka)) Data: aSAH$ndka in 72 controls (aSAH$outcome Good) < 41 cases (aSAH$outcome Poor). Smoothing: binormal Area under the curve: 0.6006 pROC/tests/testthat/print_output/r.s100b.percent.partial10000644000176200001440000000041713607143106023021 0ustar liggesusers Call: roc.default(response = aSAH$outcome, predictor = aSAH$s100b, percent = TRUE, quiet = TRUE, partial.auc = c(90, 99)) Data: aSAH$s100b in 72 controls (aSAH$outcome Good) < 41 cases (aSAH$outcome Poor). Partial area under the curve (specificity 99%-90%): 2.983% pROC/tests/testthat/print_output/r.ndka.ci.se0000644000176200001440000000064014114130125020723 0ustar liggesusers95% CI (3 stratified bootstrap replicates): sp se.low se.median se.high 0.0 1.00000 1.00000 1.00000 0.1 0.87930 0.90240 0.90240 0.2 0.85490 0.87800 0.90120 0.3 0.78170 0.80490 0.87440 0.4 0.73170 0.73170 0.77800 0.5 0.70850 0.73170 0.73170 0.6 0.47070 0.60980 0.60980 0.7 0.32930 0.56100 0.58410 0.8 0.24630 0.29270 0.45490 0.9 0.12440 0.17070 0.21710 1.0 0.00122 0.02439 0.07073 pROC/tests/testthat/print_output/multiclass_percent0000644000176200001440000000030113607143106022451 0ustar liggesusers Call: multiclass.roc.default(response = aSAH$gos6, predictor = aSAH$ndka, percent = TRUE) Data: aSAH$ndka with 4 levels of aSAH$gos6: 1, 3, 4, 5. Multi-class area under the curve: 60.87% pROC/tests/testthat/print_output/r.s100b.percent0000644000176200001440000000033013607143106021277 0ustar liggesusers Call: roc.default(response = aSAH$outcome, predictor = aSAH$s100b, percent = TRUE, quiet = TRUE) Data: aSAH$s100b in 72 controls (aSAH$outcome Good) < 41 cases (aSAH$outcome Poor). Area under the curve: 73.14% pROC/tests/testthat/print_output/multiclass_partial_correct0000644000176200001440000000041413607143106024173 0ustar liggesusers Call: multiclass.roc.default(response = aSAH$gos6, predictor = aSAH$wfns, partial.auc = c(1, 0.9), partial.auc.correct = TRUE) Data: aSAH$wfns with 4 levels of aSAH$gos6: 1, 3, 4, 5. Multi-class corrected partial area under the curve (specificity 1-0.9): 0.6013 pROC/tests/testthat/print_output/mv_multiclass_percent0000644000176200001440000000033013607143106023155 0ustar liggesusers Call: multiclass.roc.default(response = responses, predictor = predictor, percent = TRUE) Data: multivariate predictor predictor with 3 levels of responses: X1, X2, X3. Multi-class area under the curve: 66.68% pROC/tests/testthat/print_output/r.s100b0000644000176200001440000000031013607143106017636 0ustar liggesusers Call: roc.default(response = aSAH$outcome, predictor = aSAH$s100b, quiet = TRUE) Data: aSAH$s100b in 72 controls (aSAH$outcome Good) < 41 cases (aSAH$outcome Poor). Area under the curve: 0.7314 pROC/tests/testthat/print_output/r.ndka.percent.partial10000644000176200001440000000041513607143106023107 0ustar liggesusers Call: roc.default(response = aSAH$outcome, predictor = aSAH$ndka, percent = TRUE, quiet = TRUE, partial.auc = c(90, 99)) Data: aSAH$ndka in 72 controls (aSAH$outcome Good) < 41 cases (aSAH$outcome Poor). Partial area under the curve (specificity 99%-90%): 1.046% pROC/tests/testthat/print_output/r.ndka.partial10000644000176200001440000000040213607143106021444 0ustar liggesusers Call: roc.default(response = aSAH$outcome, predictor = aSAH$ndka, quiet = TRUE, partial.auc = c(0.9, 0.99)) Data: aSAH$ndka in 72 controls (aSAH$outcome Good) < 41 cases (aSAH$outcome Poor). Partial area under the curve (specificity 0.99-0.9): 0.01046 pROC/tests/testthat/print_output/r.wfns.partial10000644000176200001440000000040213607143106021504 0ustar liggesusers Call: roc.default(response = aSAH$outcome, predictor = aSAH$wfns, quiet = TRUE, partial.auc = c(0.9, 0.99)) Data: aSAH$wfns in 72 controls (aSAH$outcome Good) < 41 cases (aSAH$outcome Poor). Partial area under the curve (specificity 0.99-0.9): 0.03305 pROC/tests/testthat/print_output/smooth.s100b.binormal0000644000176200001440000000032113607143106022512 0ustar liggesusers Call: smooth.roc(roc = roc(aSAH$outcome, aSAH$ndka), method = "binormal") Data: aSAH$ndka in 72 controls (aSAH$outcome Good) < 41 cases (aSAH$outcome Poor). Smoothing: binormal Area under the curve: 0.6006 pROC/tests/testthat/print_output/r.ndka.formula.ci0000644000176200001440000000030513607143106021770 0ustar liggesusers Call: roc.formula(formula = outcome ~ ndka, data = aSAH, ci = TRUE) Data: ndka in 72 controls (outcome Good) < 41 cases (outcome Poor). Area under the curve: 0.612 95% CI: 0.5012-0.7227 (DeLong) pROC/tests/testthat/print_output/r.ndka.formula0000644000176200001440000000023313607143106021376 0ustar liggesusers Call: roc.formula(formula = outcome ~ ndka, data = aSAH) Data: ndka in 72 controls (outcome Good) < 41 cases (outcome Poor). Area under the curve: 0.612 pROC/tests/testthat/print_output/mv_multiclass_partial0000644000176200001440000000037613607143106023163 0ustar liggesusers Call: multiclass.roc.default(response = responses, predictor = predictor, partial.auc = c(1, 0.9)) Data: multivariate predictor predictor with 3 levels of responses: X1, X2, X3. Multi-class partial area under the curve (specificity 1-0.9): 0.05313 pROC/tests/testthat/print_output/r.wfns0000644000176200001440000000030213607143106017767 0ustar liggesusers Call: roc.default(response = aSAH$outcome, predictor = aSAH$wfns, quiet = TRUE) Data: aSAH$wfns in 72 controls (aSAH$outcome Good) < 41 cases (aSAH$outcome Poor). Area under the curve: 0.8237 pROC/tests/testthat/print_output/mv_multiclass_partial_correct0000644000176200001440000000044313607143106024677 0ustar liggesusers Call: multiclass.roc.default(response = responses, predictor = predictor, partial.auc = c(1, 0.9), partial.auc.correct = TRUE) Data: multivariate predictor predictor with 3 levels of responses: X1, X2, X3. Multi-class corrected partial area under the curve (specificity 1-0.9): 0.7533 pROC/tests/testthat/print_output/smooth.wfns0000644000176200001440000000027413607143106021047 0ustar liggesusers Call: smooth.roc(roc = roc(aSAH$outcome, aSAH$ndka)) Data: aSAH$ndka in 72 controls (aSAH$outcome Good) < 41 cases (aSAH$outcome Poor). Smoothing: binormal Area under the curve: 0.6006 pROC/tests/testthat/print_output/multiclass0000644000176200001440000000025513607143106020741 0ustar liggesusers Call: multiclass.roc.default(response = aSAH$gos6, predictor = aSAH$ndka) Data: aSAH$ndka with 4 levels of aSAH$gos6: 1, 3, 4, 5. Multi-class area under the curve: 0.6087 pROC/tests/testthat/print_output/smooth.s100b.formula0000644000176200001440000000025213607143106022357 0ustar liggesusers Call: smooth.roc(roc = roc(outcome ~ s100b, aSAH)) Data: s100b in 72 controls (outcome Good) < 41 cases (outcome Poor). Smoothing: binormal Area under the curve: 0.74 pROC/tests/testthat/print_output/mv_multiclass_levels0000644000176200001440000000033413607143106023013 0ustar liggesusers Call: multiclass.roc.default(response = responses, predictor = predictor, levels = c("X2", "X3")) Data: multivariate predictor predictor with 2 levels of responses: X2, X3. Multi-class area under the curve: 0.5003 pROC/tests/testthat/print_output/r.wfns.percent0000644000176200001440000000032613607143106021434 0ustar liggesusers Call: roc.default(response = aSAH$outcome, predictor = aSAH$wfns, percent = TRUE, quiet = TRUE) Data: aSAH$wfns in 72 controls (aSAH$outcome Good) < 41 cases (aSAH$outcome Poor). Area under the curve: 82.37% pROC/tests/testthat/print_output/mv_multiclass_partial_se0000644000176200001440000000043013607143106023641 0ustar liggesusers Call: multiclass.roc.default(response = responses, predictor = predictor, partial.auc = c(1, 0.9), partial.auc.focus = "se") Data: multivariate predictor predictor with 3 levels of responses: X1, X2, X3. Multi-class partial area under the curve (sensitivity 1-0.9): 0.01667 pROC/tests/testthat/print_output/multiclass_levels0000644000176200001440000000030313607143106022305 0ustar liggesusers Call: multiclass.roc.default(response = aSAH$gos6, predictor = aSAH$ndka, levels = c(3, 4, 5)) Data: aSAH$ndka with 3 levels of aSAH$gos6: 3, 4, 5. Multi-class area under the curve: 0.6182 pROC/tests/testthat/print_output/roc.test-venkatraman.paired0000644000176200001440000000032014114130125024052 0ustar liggesusers Venkatraman's test for two paired ROC curves data: r.s100b and r.wfns E = 42, boot.n = 12, p-value < 2.2e-16 alternative hypothesis: true difference in at least one ROC operating point is not equal to 0 pROC/tests/testthat/print_output/roc.test-venkatraman.unpaired.unstratified0000644000176200001440000000031714114130125027123 0ustar liggesusers Venkatraman's test for two unpaired ROC curves data: r.s100b and r.wfns E = 43, boot.n = 12, p-value = 0.05 alternative hypothesis: true difference in at least one ROC operating point is not equal to 0 pROC/tests/testthat/print_output/r.ndka.formula.no_auc0000644000176200001440000000025713607143106022647 0ustar liggesusers Call: roc.formula(formula = outcome ~ ndka, data = aSAH, auc = FALSE) Data: ndka in 72 controls (outcome Good) < 41 cases (outcome Poor). Area under the curve not computed. pROC/tests/testthat/print_output/smooth.s100b.density0000644000176200001440000000033313607143106022371 0ustar liggesusers Call: smooth.roc(roc = roc(outcome ~ s100b, aSAH), method = "density") Data: s100b in 72 controls (outcome Good) < 41 cases (outcome Poor). Smoothing: density (bandwidth: nrd0; adjust: 1) Area under the curve: 0.7244 pROC/tests/testthat/print_output/r.ndka0000644000176200001440000000030113607143106017726 0ustar liggesusers Call: roc.default(response = aSAH$outcome, predictor = aSAH$ndka, quiet = TRUE) Data: aSAH$ndka in 72 controls (aSAH$outcome Good) < 41 cases (aSAH$outcome Poor). Area under the curve: 0.612 pROC/tests/testthat/print_output/multiclass_partial_se0000644000176200001440000000040113607143106023135 0ustar liggesusers Call: multiclass.roc.default(response = aSAH$gos6, predictor = aSAH$ndka, partial.auc = c(1, 0.9), partial.auc.focus = "se") Data: aSAH$ndka with 4 levels of aSAH$gos6: 1, 3, 4, 5. Multi-class partial area under the curve (sensitivity 1-0.9): 0.02205 pROC/tests/testthat/print_output/r.ndka.percent0000644000176200001440000000032513607143106021373 0ustar liggesusers Call: roc.default(response = aSAH$outcome, predictor = aSAH$ndka, percent = TRUE, quiet = TRUE) Data: aSAH$ndka in 72 controls (aSAH$outcome Good) < 41 cases (aSAH$outcome Poor). Area under the curve: 61.2% pROC/tests/testthat/print_output/roc.test-venkatraman.unstratified0000644000176200001440000000031514114130125025313 0ustar liggesusers Venkatraman's test for two paired ROC curves data: r.s100b and r.wfns E = 43, boot.n = 12, p-value = 0.05 alternative hypothesis: true difference in at least one ROC operating point is not equal to 0 pROC/tests/testthat/print_output/multiclass_partial0000644000176200001440000000035013607143106022451 0ustar liggesusers Call: multiclass.roc.default(response = aSAH$gos6, predictor = aSAH$ndka, partial.auc = c(1, 0.9)) Data: aSAH$ndka with 4 levels of aSAH$gos6: 1, 3, 4, 5. Multi-class partial area under the curve (specificity 1-0.9): 0.009568 pROC/tests/testthat/print_output/smooth.s100b.logcondens.smooth0000644000176200001440000000032313607143106024354 0ustar liggesusers Call: smooth.roc(roc = roc(outcome ~ s100b, aSAH), method = "logcondens.smooth") Data: s100b in 72 controls (outcome Good) < 41 cases (outcome Poor). Smoothing: logcondens.smooth Area under the curve: 0.7149 pROC/tests/testthat/print_output/mv_multiclass0000644000176200001440000000030413607143106021436 0ustar liggesusers Call: multiclass.roc.default(response = responses, predictor = predictor) Data: multivariate predictor predictor with 3 levels of responses: X1, X2, X3. Multi-class area under the curve: 0.6668 pROC/tests/testthat/print_output/ndka_formula0000644000176200001440000000023313607143106021217 0ustar liggesusers Call: roc.formula(formula = outcome ~ ndka, data = aSAH) Data: ndka in 72 controls (outcome Good) < 41 cases (outcome Poor). Area under the curve: 0.612 pROC/tests/testthat/print_output/mv_multiclass.ndka.formula0000644000176200001440000000023213607143106024016 0ustar liggesusers Call: multiclass.roc.formula(formula = gos6 ~ ndka, data = aSAH) Data: ndka with 4 levels of gos6: 1, 3, 4, 5. Multi-class area under the curve: 0.6087 pROC/tests/testthat/print_output/smooth.s100b.fitdistr0000644000176200001440000000030113607143106022535 0ustar liggesusers Call: smooth.roc(roc = roc(outcome ~ s100b, aSAH), method = "fitdistr") Data: s100b in 72 controls (outcome Good) < 41 cases (outcome Poor). Smoothing: fitdistr Area under the curve: 0.8311 pROC/tests/testthat/print_output/r.ndka.ci.sp0000644000176200001440000000065414114130125020743 0ustar liggesusers95% CI (3 stratified bootstrap replicates): se sp.low sp.median sp.high 0.0 1.000000 1.00000 1.00000 0.1 0.944400 0.94440 0.95760 0.2 0.862500 0.88890 0.94170 0.3 0.720300 0.76390 0.85620 0.4 0.644400 0.75000 0.81600 0.5 0.577800 0.73610 0.74930 0.6 0.561100 0.66670 0.68250 0.7 0.542400 0.55560 0.56880 0.8 0.226400 0.30560 0.38470 0.9 0.045140 0.11110 0.21670 1.0 0.002083 0.04167 0.04167 pROC/tests/testthat/helper-rocs.R0000644000176200001440000000215213607143106016426 0ustar liggesusersdata(aSAH) r.wfns <- roc(aSAH$outcome, aSAH$wfns, quiet = TRUE) r.ndka <- roc(aSAH$outcome, aSAH$ndka, quiet = TRUE) r.s100b <- roc(aSAH$outcome, aSAH$s100b, quiet = TRUE) r.wfns.percent <- roc(aSAH$outcome, aSAH$wfns, percent = TRUE, quiet = TRUE) r.ndka.percent <- roc(aSAH$outcome, aSAH$ndka, percent = TRUE, quiet = TRUE) r.s100b.percent <- roc(aSAH$outcome, aSAH$s100b, percent = TRUE, quiet = TRUE) r.wfns.partial1 <- roc(aSAH$outcome, aSAH$wfns, quiet = TRUE, partial.auc = c(0.9, 0.99)) r.ndka.partial1 <- roc(aSAH$outcome, aSAH$ndka, quiet = TRUE, partial.auc = c(0.9, 0.99)) r.s100b.partial1 <- roc(aSAH$outcome, aSAH$s100b, quiet = TRUE, partial.auc = c(0.9, 0.99)) r.wfns.percent.partial1 <- roc(aSAH$outcome, aSAH$wfns, percent = TRUE, quiet = TRUE, partial.auc = c(90, 99)) r.ndka.percent.partial1 <- roc(aSAH$outcome, aSAH$ndka, percent = TRUE, quiet = TRUE, partial.auc = c(90, 99)) r.s100b.percent.partial1 <- roc(aSAH$outcome, aSAH$s100b, percent = TRUE, quiet = TRUE, partial.auc = c(90, 99)) r.s100b.partial2 <- roc(aSAH$outcome, aSAH$s100b, quiet = TRUE, partial.auc = c(.9, .99), partial.auc.focus = "se") pROC/tests/testthat/test-var.R0000644000176200001440000000326314114130125015743 0ustar liggesuserslibrary(pROC) data(aSAH) test_that("var with delong works", { expect_equal(var(r.wfns), 0.00146991470882363) expect_equal(var(r.ndka), 0.0031908105493913) expect_equal(var(r.s100b), 0.00266868245717244) }) test_that("var works with auc", { expect_equal(var(auc(r.wfns)), 0.00146991470882363) expect_equal(var(auc(r.ndka)), 0.0031908105493913) expect_equal(var(auc(r.s100b)), 0.00266868245717244) }) test_that("var with delong and percent works", { expect_equal(var(r.wfns.percent), 14.6991470882363) expect_equal(var(r.ndka.percent), 31.908105493913) expect_equal(var(r.s100b.percent), 26.6868245717244) }) test_that("var works with auc and percent", { expect_equal(var(auc(r.wfns.percent)), 14.6991470882363) expect_equal(var(auc(r.ndka.percent)), 31.908105493913) expect_equal(var(auc(r.s100b.percent)), 26.6868245717244) }) test_that("var with delong and percent works", { expect_equal(var(roc(aSAH$outcome, -aSAH$ndka, percent=TRUE)), 31.908105493913) expect_equal(var(roc(aSAH$outcome, -aSAH$s100b, percent=TRUE)), 26.6868245717244) }) # Only test whether var runs and returns without error. # Uses a very small number of iterations for speed # Doesn't test whether the results are correct. test_that("bootstrap var runs with roc, auc and smooth.roc objects", { skip_slow() for (roc1 in list(r.s100b, auc(r.s100b), smooth(r.s100b), r.s100b.partial1, r.s100b.partial1$auc)) { n <- round(runif(1, 3, 9)) # keep boot.n small for (stratified in c(TRUE, FALSE)) { stratified <- sample(c(TRUE, FALSE), 1) obtained <- var(roc1, method = "bootstrap", boot.n = n, boot.stratified = stratified) expect_is(obtained, "numeric") expect_false(is.na(obtained)) } } }) pROC/tests/testthat/test-deLongPlacementsCpp.R0000644000176200001440000000310713607143106021050 0ustar liggesuserslibrary(pROC) data(aSAH) context("DeLong Placements C++ code works") for (percent in c(FALSE, TRUE)) { for (marker in c("ndka", "wfns", "s100b")) { desc <- sprintf("delongPlacementsCpp runs with %s (percent = %s)", marker, percent) r <- roc(aSAH$outcome, aSAH[[marker]], percent = percent) test_that(desc, { placements <- pROC:::delongPlacementsCpp(r) expect_equal(placements, expected.placements[[marker]][["forward"]]) }) } for (marker in c("ndka", "wfns", "s100b")) { desc <- sprintf("delongPlacementsCpp runs with reversed levels and %s (percent = %s)", marker, percent) r <- roc(aSAH$outcome, aSAH[[marker]], levels = c("Poor", "Good"), percent = percent) test_that(desc, { placements <- pROC:::delongPlacementsCpp(r) expect_identical(names(placements), c("theta", "X", "Y")) }) } for (marker in c("ndka", "wfns", "s100b")) { desc <- sprintf("delongPlacementsCpp runs with reversed direction and %s (percent = %s)", marker, percent) r <- roc(aSAH$outcome, aSAH[[marker]], direction = ">", percent = percent) test_that(desc, { placements <- pROC:::delongPlacementsCpp(r) expect_identical(names(placements), c("theta", "X", "Y")) }) } for (marker in c("ndka", "wfns", "s100b")) { desc <- sprintf("delongPlacementsCpp runs with reversed levels reversed direction and %s (percent = %s)", marker, percent) r <- roc(aSAH$outcome, aSAH[[marker]], levels = c("Poor", "Good"), direction = ">", percent = percent) test_that(desc, { placements <- pROC:::delongPlacementsCpp(r) expect_identical(names(placements), c("theta", "X", "Y")) }) } }pROC/tests/testthat/helper-roc-expected.R0000644000176200001440000014455314114130125020045 0ustar liggesusersexpected.roc <- list(ndka = list(forward = list(`<` = list(sensitivities = c(1, 1, 0.975609756097561, 0.975609756097561, 0.975609756097561, 0.951219512195122, 0.926829268292683, 0.902439024390244, 0.902439024390244, 0.902439024390244, 0.902439024390244, 0.902439024390244, 0.902439024390244, 0.902439024390244, 0.902439024390244, 0.902439024390244, 0.902439024390244, 0.878048780487805, 0.878048780487805, 0.878048780487805, 0.878048780487805, 0.878048780487805, 0.878048780487805, 0.878048780487805, 0.853658536585366, 0.829268292682927, 0.829268292682927, 0.829268292682927, 0.804878048780488, 0.804878048780488, 0.804878048780488, 0.804878048780488, 0.780487804878049, 0.75609756097561, 0.75609756097561, 0.75609756097561, 0.75609756097561, 0.75609756097561, 0.731707317073171, 0.731707317073171, 0.731707317073171, 0.707317073170732, 0.707317073170732, 0.707317073170732, 0.707317073170732, 0.707317073170732, 0.707317073170732, 0.707317073170732, 0.682926829268293, 0.658536585365854, 0.634146341463415, 0.634146341463415, 0.609756097560976, 0.609756097560976, 0.609756097560976, 0.585365853658537, 0.585365853658537, 0.585365853658537, 0.585365853658537, 0.585365853658537, 0.585365853658537, 0.560975609756098, 0.560975609756098, 0.536585365853659, 0.536585365853659, 0.536585365853659, 0.51219512195122, 0.51219512195122, 0.51219512195122, 0.48780487804878, 0.463414634146341, 0.463414634146341, 0.439024390243902, 0.414634146341463, 0.414634146341463, 0.414634146341463, 0.390243902439024, 0.365853658536585, 0.341463414634146, 0.341463414634146, 0.341463414634146, 0.341463414634146, 0.317073170731707, 0.317073170731707, 0.317073170731707, 0.317073170731707, 0.317073170731707, 0.292682926829268, 0.268292682926829, 0.24390243902439, 0.219512195121951, 0.219512195121951, 0.219512195121951, 0.195121951219512, 0.195121951219512, 0.195121951219512, 0.195121951219512, 0.170731707317073, 0.146341463414634, 0.121951219512195, 0.0975609756097561, 0.0975609756097561, 0.0975609756097561, 0.0731707317073171, 0.0731707317073171, 0.0487804878048781, 0.0487804878048781, 0.024390243902439, 0.024390243902439, 0), specificities = c(0, 0.0138888888888889, 0.0138888888888889, 0.0277777777777778, 0.0416666666666667, 0.0416666666666667, 0.0416666666666667, 0.0416666666666667, 0.0555555555555556, 0.0694444444444444, 0.0833333333333333, 0.0972222222222222, 0.111111111111111, 0.125, 0.138888888888889, 0.152777777777778, 0.166666666666667, 0.166666666666667, 0.180555555555556, 0.194444444444444, 0.208333333333333, 0.222222222222222, 0.236111111111111, 0.25, 0.25, 0.25, 0.263888888888889, 0.277777777777778, 0.277777777777778, 0.291666666666667, 0.319444444444444, 0.333333333333333, 0.333333333333333, 0.347222222222222, 0.361111111111111, 0.375, 0.388888888888889, 0.402777777777778, 0.402777777777778, 0.416666666666667, 0.430555555555556, 0.430555555555556, 0.444444444444444, 0.458333333333333, 0.472222222222222, 0.486111111111111, 0.5, 0.513888888888889, 0.513888888888889, 0.513888888888889, 0.513888888888889, 0.527777777777778, 0.527777777777778, 0.541666666666667, 0.555555555555556, 0.555555555555556, 0.569444444444444, 0.583333333333333, 0.597222222222222, 0.611111111111111, 0.625, 0.625, 0.638888888888889, 0.652777777777778, 0.666666666666667, 0.680555555555556, 0.680555555555556, 0.694444444444444, 0.708333333333333, 0.708333333333333, 0.708333333333333, 0.722222222222222, 0.722222222222222, 0.722222222222222, 0.736111111111111, 0.75, 0.763888888888889, 0.763888888888889, 0.763888888888889, 0.777777777777778, 0.791666666666667, 0.805555555555556, 0.805555555555556, 0.819444444444444, 0.833333333333333, 0.847222222222222, 0.861111111111111, 0.861111111111111, 0.861111111111111, 0.861111111111111, 0.861111111111111, 0.875, 0.888888888888889, 0.888888888888889, 0.902777777777778, 0.916666666666667, 0.930555555555556, 0.930555555555556, 0.930555555555556, 0.930555555555556, 0.930555555555556, 0.944444444444444, 0.958333333333333, 0.958333333333333, 0.972222222222222, 0.972222222222222, 0.986111111111111, 0.986111111111111, 1, 1), thresholds = c(-Inf, 3.44, 4.24, 4.82, 5.105, 5.185, 5.28, 5.685, 6.005, 6.15, 6.295, 6.345, 6.465, 6.565, 6.69, 6.925, 7.24, 7.525, 7.645, 7.705, 7.855, 7.99, 8.055, 8.16, 8.305, 8.455, 8.535, 8.72, 8.955, 9.225, 9.455, 9.52, 9.6, 9.665, 9.75, 9.805, 9.82, 9.84, 9.9, 10.14, 10.365, 10.41, 10.465, 10.53, 10.575, 10.715, 10.95, 11.08, 11.345, 11.635, 11.675, 11.7, 11.725, 11.85, 12.095, 12.375, 12.55, 12.58, 12.63, 12.69, 12.73, 12.775, 12.85, 12.94, 13.05, 13.16, 13.305, 13.43, 13.505, 13.615, 13.77, 13.955, 14.15, 14.3, 14.455, 15.055, 15.715, 15.925, 16.035, 16.66, 17.255, 17.35, 17.63, 18.035, 18.835, 20.105, 20.985, 21.35, 21.525, 21.75, 22.1, 22.35, 22.53, 23.605, 25.885, 27.84, 30.43, 32.39, 33.235, 37.2, 40.885, 44.13, 47.22, 48.775, 52.38, 56.825, 65.7, 76.435, 249.745, Inf), auc = 0.611957994579946, smooth = list(binormal = list(sensitivities = c(1, 1, 0.888888888888889, 0.777777777777778, 0.666666666666667, 0.555555555555556, 0.444444444444444, 0.333333333333333, 0.222222222222222, 0.111111111111111, 0, 0), specificities = c(0, 0, 0.166612428114063, 0.321160610790934, 0.461815951998755, 0.589134007800477, 0.703224531341884, 0.803689843297276, 0.889424082847415, 0.957885081929006, 1, 1)), density = list( sensitivities = c(1, 1, 0.990665980982577, 0.0245381464120019, 0.0245381464120019, 0.0245381464120019, 0.0245381464120019, 0.0245381464120019, 0.0245381464120019, 0.0245381464120019, 0.0245381464120017, 0), specificities = c(0, 0, 0.0156013270594681, 0.999999169362677, 0.999999999999999, 0.999999999999999, 0.999999999999999, 0.999999999999999, 1, 1, 1, 1)), fitdistr = list( sensitivities = c(1, 1, 0.65584212882921, 0.303849532306639, 0.0922807400203477, 0.017547821937714, 0.00203415264061833, 0.000141550295211778, 5.86072275643637e-06, 1.43622216786009e-07, 2.05997195401133e-09, 0), specificities = c(0, 0, 0.961731211013412, 0.999999997253703, 1, 1, 1, 1, 1, 1, 1, 1)), logcondens = list( sensitivities = c(1, 1, 0.903633007088737, 0.851198561961629, 0.798839025851673, 0.744819153259661, 0.683735938225222, 0.612286662176827, 0.524234645344731, 0.404431562609794, 0, 0), specificities = c(0, 0, 0.111111111111111, 0.222222222222222, 0.333333333333333, 0.444444444444444, 0.555555555555556, 0.666666666666667, 0.777777777777778, 0.888888888888889, 1, 1)), logcondens.smooth = list(sensitivities = c(1, 1, 0.627581338427901, 0.618664217597117, 0.609443655071806, 0.599222351702925, 0.586646929429193, 0.570309951909822, 0.54715707821662, 0.508219615419292, 0, 0), specificities = c(0, 0, 0.111111111111111, 0.222222222222222, 0.333333333333333, 0.444444444444444, 0.555555555555556, 0.666666666666667, 0.777777777777778, 0.888888888888889, 1, 1)))), `>` = list( sensitivities = c(1, 0.975609756097561, 0.975609756097561, 0.951219512195122, 0.951219512195122, 0.926829268292683, 0.926829268292683, 0.902439024390244, 0.902439024390244, 0.902439024390244, 0.878048780487805, 0.853658536585366, 0.829268292682927, 0.804878048780488, 0.804878048780488, 0.804878048780488, 0.804878048780488, 0.780487804878049, 0.780487804878049, 0.780487804878049, 0.75609756097561, 0.731707317073171, 0.707317073170732, 0.682926829268293, 0.682926829268293, 0.682926829268293, 0.682926829268293, 0.682926829268293, 0.658536585365854, 0.658536585365854, 0.658536585365854, 0.658536585365854, 0.634146341463415, 0.609756097560976, 0.585365853658537, 0.585365853658537, 0.585365853658537, 0.560975609756098, 0.536585365853659, 0.536585365853659, 0.51219512195122, 0.48780487804878, 0.48780487804878, 0.48780487804878, 0.463414634146341, 0.463414634146341, 0.463414634146341, 0.439024390243902, 0.439024390243902, 0.414634146341463, 0.414634146341463, 0.414634146341463, 0.414634146341463, 0.414634146341463, 0.414634146341463, 0.390243902439024, 0.390243902439024, 0.390243902439024, 0.365853658536585, 0.365853658536585, 0.341463414634146, 0.317073170731707, 0.292682926829268, 0.292682926829268, 0.292682926829268, 0.292682926829268, 0.292682926829268, 0.292682926829268, 0.292682926829268, 0.268292682926829, 0.268292682926829, 0.268292682926829, 0.24390243902439, 0.24390243902439, 0.24390243902439, 0.24390243902439, 0.24390243902439, 0.219512195121951, 0.195121951219512, 0.195121951219512, 0.195121951219512, 0.195121951219512, 0.170731707317073, 0.170731707317073, 0.170731707317073, 0.146341463414634, 0.121951219512195, 0.121951219512195, 0.121951219512195, 0.121951219512195, 0.121951219512195, 0.121951219512195, 0.121951219512195, 0.0975609756097561, 0.0975609756097561, 0.0975609756097561, 0.0975609756097561, 0.0975609756097561, 0.0975609756097561, 0.0975609756097561, 0.0975609756097561, 0.0975609756097561, 0.0975609756097561, 0.0731707317073171, 0.0487804878048781, 0.024390243902439, 0.024390243902439, 0.024390243902439, 0, 0), specificities = c(0, 0, 0.0138888888888889, 0.0138888888888889, 0.0277777777777778, 0.0277777777777778, 0.0416666666666667, 0.0416666666666667, 0.0555555555555556, 0.0694444444444444, 0.0694444444444444, 0.0694444444444444, 0.0694444444444444, 0.0694444444444444, 0.0833333333333333, 0.0972222222222222, 0.111111111111111, 0.111111111111111, 0.125, 0.138888888888889, 0.138888888888889, 0.138888888888889, 0.138888888888889, 0.138888888888889, 0.152777777777778, 0.166666666666667, 0.180555555555556, 0.194444444444444, 0.194444444444444, 0.208333333333333, 0.222222222222222, 0.236111111111111, 0.236111111111111, 0.236111111111111, 0.25, 0.263888888888889, 0.277777777777778, 0.277777777777778, 0.277777777777778, 0.291666666666667, 0.291666666666667, 0.291666666666667, 0.305555555555556, 0.319444444444444, 0.319444444444444, 0.333333333333333, 0.347222222222222, 0.361111111111111, 0.375, 0.375, 0.388888888888889, 0.402777777777778, 0.416666666666667, 0.430555555555556, 0.444444444444444, 0.444444444444444, 0.458333333333333, 0.472222222222222, 0.472222222222222, 0.486111111111111, 0.486111111111111, 0.486111111111111, 0.486111111111111, 0.5, 0.513888888888889, 0.527777777777778, 0.541666666666667, 0.555555555555556, 0.569444444444444, 0.569444444444444, 0.583333333333333, 0.597222222222222, 0.597222222222222, 0.611111111111111, 0.625, 0.638888888888889, 0.652777777777778, 0.666666666666667, 0.666666666666667, 0.680555555555556, 0.708333333333333, 0.722222222222222, 0.722222222222222, 0.736111111111111, 0.75, 0.75, 0.75, 0.763888888888889, 0.777777777777778, 0.791666666666667, 0.805555555555556, 0.819444444444444, 0.833333333333333, 0.833333333333333, 0.847222222222222, 0.861111111111111, 0.875, 0.888888888888889, 0.902777777777778, 0.916666666666667, 0.930555555555556, 0.944444444444444, 0.958333333333333, 0.958333333333333, 0.958333333333333, 0.958333333333333, 0.972222222222222, 0.986111111111111, 0.986111111111111, 1), thresholds = c(Inf, 249.745, 76.435, 65.7, 56.825, 52.38, 48.775, 47.22, 44.13, 40.885, 37.2, 33.235, 32.39, 30.43, 27.84, 25.885, 23.605, 22.53, 22.35, 22.1, 21.75, 21.525, 21.35, 20.985, 20.105, 18.835, 18.035, 17.63, 17.35, 17.255, 16.66, 16.035, 15.925, 15.715, 15.055, 14.455, 14.3, 14.15, 13.955, 13.77, 13.615, 13.505, 13.43, 13.305, 13.16, 13.05, 12.94, 12.85, 12.775, 12.73, 12.69, 12.63, 12.58, 12.55, 12.375, 12.095, 11.85, 11.725, 11.7, 11.675, 11.635, 11.345, 11.08, 10.95, 10.715, 10.575, 10.53, 10.465, 10.41, 10.365, 10.14, 9.9, 9.84, 9.82, 9.805, 9.75, 9.665, 9.6, 9.52, 9.455, 9.225, 8.955, 8.72, 8.535, 8.455, 8.305, 8.16, 8.055, 7.99, 7.855, 7.705, 7.645, 7.525, 7.24, 6.925, 6.69, 6.565, 6.465, 6.345, 6.295, 6.15, 6.005, 5.685, 5.28, 5.185, 5.105, 4.82, 4.24, 3.44, -Inf), auc = 0.388042005420054, smooth = list(binormal = list(sensitivities = c(1, 1, 0.888888888888889, 0.777777777777778, 0.666666666666667, 0.555555555555556, 0.444444444444444, 0.333333333333333, 0.222222222222222, 0.111111111111111, 0, 0), specificities = c(0, 0, 0.0421149180709943, 0.110575917152585, 0.196310156702724, 0.296775468658116, 0.410865992199523, 0.538184048001245, 0.678839389209066, 0.833387571885937, 1, 1)), density = list(sensitivities = c(1, 1, 0.975461853587998, 0.975461853587998, 0.975461853587998, 0.975461853587998, 0.975461853587998, 0.975461853587998, 0.975461853587998, 0.975461853587998, 0.00933401901742277, 0), specificities = c(0, 0, 0, 5.06248629797098e-16, 5.06248629797098e-16, 5.76853957534923e-16, 5.76853957534923e-16, 5.76853957534923e-16, 1.13170928716523e-15, 8.30637323256579e-07, 0.984398672940532, 1)), fitdistr = list(sensitivities = c(1, 1, 0.999999997940028, 0.999999856377783, 0.999994139277244, 0.999858449704788, 0.997965847359382, 0.982452178062286, 0.907719259979652, 0.696150467693361, 0.34415787117079, 0), specificities = c(0, 0, 3.99208364201216e-220, 8.96424542447001e-173, 3.63027653816842e-131, 2.65141399391394e-95, 3.49242625020753e-65, 8.29638329047548e-41, 3.55436674466438e-22, 2.7462971753676e-09, 0.0382687889865875, 1)), logcondens = list(sensitivities = c(1, 1, 0.903633007088737, 0.851198561961629, 0.798839025851673, 0.744819153259661, 0.683735938225222, 0.612286662176827, 0.524234645344731, 0.404431562609794, 0, 0), specificities = c(0, 0, 0.111111111111111, 0.222222222222222, 0.333333333333333, 0.444444444444444, 0.555555555555556, 0.666666666666667, 0.777777777777778, 0.888888888888889, 1, 1)), logcondens.smooth = list(sensitivities = c(1, 1, 0.627581338427901, 0.618664217597117, 0.609443655071806, 0.599222351702925, 0.586646929429193, 0.570309951909822, 0.54715707821662, 0.508219615419292, 0, 0), specificities = c(0, 0, 0.111111111111111, 0.222222222222222, 0.333333333333333, 0.444444444444444, 0.555555555555556, 0.666666666666667, 0.777777777777778, 0.888888888888889, 1, 1))))), reversed = list( `<` = list(sensitivities = c(1, 0.986111111111111, 0.986111111111111, 0.972222222222222, 0.958333333333333, 0.958333333333333, 0.958333333333333, 0.958333333333333, 0.944444444444444, 0.930555555555556, 0.916666666666667, 0.902777777777778, 0.888888888888889, 0.875, 0.861111111111111, 0.847222222222222, 0.833333333333333, 0.833333333333333, 0.819444444444444, 0.805555555555556, 0.791666666666667, 0.777777777777778, 0.763888888888889, 0.75, 0.75, 0.75, 0.736111111111111, 0.722222222222222, 0.722222222222222, 0.708333333333333, 0.680555555555556, 0.666666666666667, 0.666666666666667, 0.652777777777778, 0.638888888888889, 0.625, 0.611111111111111, 0.597222222222222, 0.597222222222222, 0.583333333333333, 0.569444444444444, 0.569444444444444, 0.555555555555556, 0.541666666666667, 0.527777777777778, 0.513888888888889, 0.5, 0.486111111111111, 0.486111111111111, 0.486111111111111, 0.486111111111111, 0.472222222222222, 0.472222222222222, 0.458333333333333, 0.444444444444444, 0.444444444444444, 0.430555555555556, 0.416666666666667, 0.402777777777778, 0.388888888888889, 0.375, 0.375, 0.361111111111111, 0.347222222222222, 0.333333333333333, 0.319444444444444, 0.319444444444444, 0.305555555555556, 0.291666666666667, 0.291666666666667, 0.291666666666667, 0.277777777777778, 0.277777777777778, 0.277777777777778, 0.263888888888889, 0.25, 0.236111111111111, 0.236111111111111, 0.236111111111111, 0.222222222222222, 0.208333333333333, 0.194444444444444, 0.194444444444444, 0.180555555555556, 0.166666666666667, 0.152777777777778, 0.138888888888889, 0.138888888888889, 0.138888888888889, 0.138888888888889, 0.138888888888889, 0.125, 0.111111111111111, 0.111111111111111, 0.0972222222222222, 0.0833333333333333, 0.0694444444444444, 0.0694444444444444, 0.0694444444444444, 0.0694444444444444, 0.0694444444444444, 0.0555555555555556, 0.0416666666666667, 0.0416666666666667, 0.0277777777777778, 0.0277777777777778, 0.0138888888888889, 0.0138888888888889, 0, 0), specificities = c(0, 0, 0.024390243902439, 0.024390243902439, 0.024390243902439, 0.0487804878048781, 0.0731707317073171, 0.0975609756097561, 0.0975609756097561, 0.0975609756097561, 0.0975609756097561, 0.0975609756097561, 0.0975609756097561, 0.0975609756097561, 0.0975609756097561, 0.0975609756097561, 0.0975609756097561, 0.121951219512195, 0.121951219512195, 0.121951219512195, 0.121951219512195, 0.121951219512195, 0.121951219512195, 0.121951219512195, 0.146341463414634, 0.170731707317073, 0.170731707317073, 0.170731707317073, 0.195121951219512, 0.195121951219512, 0.195121951219512, 0.195121951219512, 0.219512195121951, 0.24390243902439, 0.24390243902439, 0.24390243902439, 0.24390243902439, 0.24390243902439, 0.268292682926829, 0.268292682926829, 0.268292682926829, 0.292682926829268, 0.292682926829268, 0.292682926829268, 0.292682926829268, 0.292682926829268, 0.292682926829268, 0.292682926829268, 0.317073170731707, 0.341463414634146, 0.365853658536585, 0.365853658536585, 0.390243902439024, 0.390243902439024, 0.390243902439024, 0.414634146341463, 0.414634146341463, 0.414634146341463, 0.414634146341463, 0.414634146341463, 0.414634146341463, 0.439024390243902, 0.439024390243902, 0.463414634146341, 0.463414634146341, 0.463414634146341, 0.48780487804878, 0.48780487804878, 0.48780487804878, 0.51219512195122, 0.536585365853659, 0.536585365853659, 0.560975609756098, 0.585365853658537, 0.585365853658537, 0.585365853658537, 0.609756097560976, 0.634146341463415, 0.658536585365854, 0.658536585365854, 0.658536585365854, 0.658536585365854, 0.682926829268293, 0.682926829268293, 0.682926829268293, 0.682926829268293, 0.682926829268293, 0.707317073170732, 0.731707317073171, 0.75609756097561, 0.780487804878049, 0.780487804878049, 0.780487804878049, 0.804878048780488, 0.804878048780488, 0.804878048780488, 0.804878048780488, 0.829268292682927, 0.853658536585366, 0.878048780487805, 0.902439024390244, 0.902439024390244, 0.902439024390244, 0.926829268292683, 0.926829268292683, 0.951219512195122, 0.951219512195122, 0.975609756097561, 0.975609756097561, 1), thresholds = c(-Inf, 3.44, 4.24, 4.82, 5.105, 5.185, 5.28, 5.685, 6.005, 6.15, 6.295, 6.345, 6.465, 6.565, 6.69, 6.925, 7.24, 7.525, 7.645, 7.705, 7.855, 7.99, 8.055, 8.16, 8.305, 8.455, 8.535, 8.72, 8.955, 9.225, 9.455, 9.52, 9.6, 9.665, 9.75, 9.805, 9.82, 9.84, 9.9, 10.14, 10.365, 10.41, 10.465, 10.53, 10.575, 10.715, 10.95, 11.08, 11.345, 11.635, 11.675, 11.7, 11.725, 11.85, 12.095, 12.375, 12.55, 12.58, 12.63, 12.69, 12.73, 12.775, 12.85, 12.94, 13.05, 13.16, 13.305, 13.43, 13.505, 13.615, 13.77, 13.955, 14.15, 14.3, 14.455, 15.055, 15.715, 15.925, 16.035, 16.66, 17.255, 17.35, 17.63, 18.035, 18.835, 20.105, 20.985, 21.35, 21.525, 21.75, 22.1, 22.35, 22.53, 23.605, 25.885, 27.84, 30.43, 32.39, 33.235, 37.2, 40.885, 44.13, 47.22, 48.775, 52.38, 56.825, 65.7, 76.435, 249.745, Inf), auc = 0.388042005420054, smooth = list( binormal = list(sensitivities = c(1, 1, 0.888888888888889, 0.777777777777778, 0.666666666666667, 0.555555555555556, 0.444444444444444, 0.333333333333333, 0.222222222222222, 0.111111111111111, 0, 0), specificities = c(0, 0, 0.0788674408487341, 0.155747871623968, 0.236191728311837, 0.321725359323499, 0.41397059696043, 0.515309270283155, 0.630004833174615, 0.768070867949782, 1, 1)), density = list(sensitivities = c(1, 1, 0.984398672940532, 8.30637323256579e-07, 1.13170928716523e-15, 5.76853957534923e-16, 5.76853957534923e-16, 5.76853957534923e-16, 5.06248629797098e-16, 5.06248629797098e-16, 0, 0), specificities = c(0, 0, 0.00933401901742277, 0.975461853587998, 0.975461853587998, 0.975461853587998, 0.975461853587998, 0.975461853587998, 0.975461853587998, 0.975461853587998, 0.975461853587998, 1)), fitdistr = list(sensitivities = c(1, 1, 0.0382687889865875, 2.7462971753676e-09, 3.55436674466438e-22, 8.29638329047548e-41, 3.49242625020753e-65, 2.65141399391394e-95, 3.63027653816842e-131, 8.96424542447001e-173, 3.99208364201216e-220, 0), specificities = c(0, 0, 0.34415787117079, 0.696150467693361, 0.907719259979652, 0.982452178062286, 0.997965847359382, 0.999858449704788, 0.999994139277244, 0.999999856377783, 0.999999997940028, 1)), logcondens = list(sensitivities = c(1, 1, 0.85778454966568, 0.621790781743177, 0.416037230851085, 0.262390375702792, 0.155118835197992, 0.101286380514361, 0.0239851631980169, 0.00441622889735893, 0, 0), specificities = c(0, 0, 0.111111111111111, 0.222222222222222, 0.333333333333333, 0.444444444444444, 0.555555555555556, 0.666666666666667, 0.777777777777778, 0.888888888888889, 1, 1)), logcondens.smooth = list(sensitivities = c(1, 1, 0.726586800701676, 0.621191077809758, 0.494463460377412, 0.358063532316877, 0.232023673461771, 0.157353649255668, 0.0384450473280121, 0.00722953307469232, 0, 0), specificities = c(0, 0, 0.111111111111111, 0.222222222222222, 0.333333333333333, 0.444444444444444, 0.555555555555556, 0.666666666666667, 0.777777777777778, 0.888888888888889, 1, 1)))), `>` = list( sensitivities = c(1, 1, 0.986111111111111, 0.986111111111111, 0.972222222222222, 0.972222222222222, 0.958333333333333, 0.958333333333333, 0.944444444444444, 0.930555555555556, 0.930555555555556, 0.930555555555556, 0.930555555555556, 0.930555555555556, 0.916666666666667, 0.902777777777778, 0.888888888888889, 0.888888888888889, 0.875, 0.861111111111111, 0.861111111111111, 0.861111111111111, 0.861111111111111, 0.861111111111111, 0.847222222222222, 0.833333333333333, 0.819444444444444, 0.805555555555556, 0.805555555555556, 0.791666666666667, 0.777777777777778, 0.763888888888889, 0.763888888888889, 0.763888888888889, 0.75, 0.736111111111111, 0.722222222222222, 0.722222222222222, 0.722222222222222, 0.708333333333333, 0.708333333333333, 0.708333333333333, 0.694444444444444, 0.680555555555556, 0.680555555555556, 0.666666666666667, 0.652777777777778, 0.638888888888889, 0.625, 0.625, 0.611111111111111, 0.597222222222222, 0.583333333333333, 0.569444444444444, 0.555555555555556, 0.555555555555556, 0.541666666666667, 0.527777777777778, 0.527777777777778, 0.513888888888889, 0.513888888888889, 0.513888888888889, 0.513888888888889, 0.5, 0.486111111111111, 0.472222222222222, 0.458333333333333, 0.444444444444444, 0.430555555555556, 0.430555555555556, 0.416666666666667, 0.402777777777778, 0.402777777777778, 0.388888888888889, 0.375, 0.361111111111111, 0.347222222222222, 0.333333333333333, 0.333333333333333, 0.319444444444444, 0.291666666666667, 0.277777777777778, 0.277777777777778, 0.263888888888889, 0.25, 0.25, 0.25, 0.236111111111111, 0.222222222222222, 0.208333333333333, 0.194444444444444, 0.180555555555556, 0.166666666666667, 0.166666666666667, 0.152777777777778, 0.138888888888889, 0.125, 0.111111111111111, 0.0972222222222222, 0.0833333333333333, 0.0694444444444444, 0.0555555555555556, 0.0416666666666667, 0.0416666666666667, 0.0416666666666667, 0.0416666666666667, 0.0277777777777778, 0.0138888888888889, 0.0138888888888889, 0), specificities = c(0, 0.024390243902439, 0.024390243902439, 0.0487804878048781, 0.0487804878048781, 0.0731707317073171, 0.0731707317073171, 0.0975609756097561, 0.0975609756097561, 0.0975609756097561, 0.121951219512195, 0.146341463414634, 0.170731707317073, 0.195121951219512, 0.195121951219512, 0.195121951219512, 0.195121951219512, 0.219512195121951, 0.219512195121951, 0.219512195121951, 0.24390243902439, 0.268292682926829, 0.292682926829268, 0.317073170731707, 0.317073170731707, 0.317073170731707, 0.317073170731707, 0.317073170731707, 0.341463414634146, 0.341463414634146, 0.341463414634146, 0.341463414634146, 0.365853658536585, 0.390243902439024, 0.414634146341463, 0.414634146341463, 0.414634146341463, 0.439024390243902, 0.463414634146341, 0.463414634146341, 0.48780487804878, 0.51219512195122, 0.51219512195122, 0.51219512195122, 0.536585365853659, 0.536585365853659, 0.536585365853659, 0.560975609756098, 0.560975609756098, 0.585365853658537, 0.585365853658537, 0.585365853658537, 0.585365853658537, 0.585365853658537, 0.585365853658537, 0.609756097560976, 0.609756097560976, 0.609756097560976, 0.634146341463415, 0.634146341463415, 0.658536585365854, 0.682926829268293, 0.707317073170732, 0.707317073170732, 0.707317073170732, 0.707317073170732, 0.707317073170732, 0.707317073170732, 0.707317073170732, 0.731707317073171, 0.731707317073171, 0.731707317073171, 0.75609756097561, 0.75609756097561, 0.75609756097561, 0.75609756097561, 0.75609756097561, 0.780487804878049, 0.804878048780488, 0.804878048780488, 0.804878048780488, 0.804878048780488, 0.829268292682927, 0.829268292682927, 0.829268292682927, 0.853658536585366, 0.878048780487805, 0.878048780487805, 0.878048780487805, 0.878048780487805, 0.878048780487805, 0.878048780487805, 0.878048780487805, 0.902439024390244, 0.902439024390244, 0.902439024390244, 0.902439024390244, 0.902439024390244, 0.902439024390244, 0.902439024390244, 0.902439024390244, 0.902439024390244, 0.902439024390244, 0.926829268292683, 0.951219512195122, 0.975609756097561, 0.975609756097561, 0.975609756097561, 1, 1), thresholds = c(Inf, 249.745, 76.435, 65.7, 56.825, 52.38, 48.775, 47.22, 44.13, 40.885, 37.2, 33.235, 32.39, 30.43, 27.84, 25.885, 23.605, 22.53, 22.35, 22.1, 21.75, 21.525, 21.35, 20.985, 20.105, 18.835, 18.035, 17.63, 17.35, 17.255, 16.66, 16.035, 15.925, 15.715, 15.055, 14.455, 14.3, 14.15, 13.955, 13.77, 13.615, 13.505, 13.43, 13.305, 13.16, 13.05, 12.94, 12.85, 12.775, 12.73, 12.69, 12.63, 12.58, 12.55, 12.375, 12.095, 11.85, 11.725, 11.7, 11.675, 11.635, 11.345, 11.08, 10.95, 10.715, 10.575, 10.53, 10.465, 10.41, 10.365, 10.14, 9.9, 9.84, 9.82, 9.805, 9.75, 9.665, 9.6, 9.52, 9.455, 9.225, 8.955, 8.72, 8.535, 8.455, 8.305, 8.16, 8.055, 7.99, 7.855, 7.705, 7.645, 7.525, 7.24, 6.925, 6.69, 6.565, 6.465, 6.345, 6.295, 6.15, 6.005, 5.685, 5.28, 5.185, 5.105, 4.82, 4.24, 3.44, -Inf), auc = 0.611957994579946, smooth = list( binormal = list(sensitivities = c(1, 1, 0.888888888888889, 0.777777777777778, 0.666666666666667, 0.555555555555556, 0.444444444444444, 0.333333333333333, 0.222222222222222, 0.111111111111111, 0, 0), specificities = c(0, 0, 0.231929132050218, 0.369995166825385, 0.484690729716845, 0.58602940303957, 0.678274640676501, 0.763808271688163, 0.844252128376032, 0.921132559151266, 1, 1)), density = list( sensitivities = c(1, 1, 1, 1, 1, 0.999999999999999, 0.999999999999999, 0.999999999999999, 0.999999999999999, 0.999999169362677, 0.0156013270594681, 0), specificities = c(0, 0, 0.0245381464120017, 0.0245381464120019, 0.0245381464120019, 0.0245381464120019, 0.0245381464120019, 0.0245381464120019, 0.0245381464120019, 0.0245381464120019, 0.990665980982577, 1)), fitdistr = list(sensitivities = c(1, 1, 1, 1, 1, 1, 1, 1, 1, 0.999999997253703, 0.961731211013412, 0), specificities = c(0, 0, 2.05997195401133e-09, 1.43622216786009e-07, 5.86072275643637e-06, 0.000141550295211778, 0.00203415264061833, 0.017547821937714, 0.0922807400203477, 0.303849532306639, 0.65584212882921, 1)), logcondens = list( sensitivities = c(1, 1, 0.85778454966568, 0.621790781743177, 0.416037230851085, 0.262390375702792, 0.155118835197992, 0.101286380514361, 0.0239851631980169, 0.00441622889735893, 0, 0), specificities = c(0, 0, 0.111111111111111, 0.222222222222222, 0.333333333333333, 0.444444444444444, 0.555555555555556, 0.666666666666667, 0.777777777777778, 0.888888888888889, 1, 1)), logcondens.smooth = list( sensitivities = c(1, 1, 0.726586800701676, 0.621191077809758, 0.494463460377412, 0.358063532316877, 0.232023673461771, 0.157353649255668, 0.0384450473280121, 0.00722953307469232, 0, 0), specificities = c(0, 0, 0.111111111111111, 0.222222222222222, 0.333333333333333, 0.444444444444444, 0.555555555555556, 0.666666666666667, 0.777777777777778, 0.888888888888889, 1, 1)))))), wfns = list(forward = list( `<` = list(sensitivities = c(1, 0.951219512195122, 0.658536585365854, 0.634146341463415, 0.439024390243902, 0), specificities = c(0, 0.513888888888889, 0.791666666666667, 0.833333333333333, 0.944444444444444, 1), thresholds = c(-Inf, 1.5, 2.5, 3.5, 4.5, Inf), auc = 0.823678861788618, smooth = list(binormal = list( sensitivities = c(1, 1, 0.888888888888889, 0.777777777777778, 0.666666666666667, 0.555555555555556, 0.444444444444444, 0.333333333333333, 0.222222222222222, 0.111111111111111, 0, 0), specificities = c(0, 0, 0.625333127333874, 0.754588159419005, 0.831385583051929, 0.884052600012775, 0.922476948429837, 0.95131791780447, 0.973098822204584, 0.98921642370298, 1, 1)))), `>` = list(sensitivities = c(1, 0.560975609756098, 0.365853658536585, 0.341463414634146, 0.0487804878048781, 0), specificities = c(0, 0.0555555555555556, 0.166666666666667, 0.208333333333333, 0.486111111111111, 1), thresholds = c(Inf, 4.5, 3.5, 2.5, 1.5, -Inf), auc = 0.176321138211382, smooth = list( binormal = list(sensitivities = c(1, 1, 0.888888888888889, 0.777777777777778, 0.666666666666667, 0.555555555555556, 0.444444444444444, 0.333333333333333, 0.222222222222222, 0.111111111111111, 0, 0), specificities = c(0, 0, 0.0107835762970204, 0.0269011777954162, 0.0486820821955305, 0.0775230515701628, 0.115947399987225, 0.168614416948071, 0.245411840580995, 0.374666872666126, 1, 1))))), reversed = list(`<` = list( sensitivities = c(1, 0.486111111111111, 0.208333333333333, 0.166666666666667, 0.0555555555555556, 0), specificities = c(0, 0.0487804878048781, 0.341463414634146, 0.365853658536585, 0.560975609756098, 1), thresholds = c(-Inf, 1.5, 2.5, 3.5, 4.5, Inf), auc = 0.176321138211382, smooth = list(binormal = list( sensitivities = c(1, 1, 0.888888888888889, 0.777777777777778, 0.666666666666667, 0.555555555555556, 0.444444444444444, 0.333333333333333, 0.222222222222222, 0.111111111111111, 0, 0), specificities = c(0, 0, 0.00138166104981697, 0.0069756572121715, 0.0193644779731441, 0.0421777209172901, 0.0809893381456389, 0.145176425426803, 0.2527411706513, 0.447692214281295, 1, 1)))), `>` = list(sensitivities = c(1, 0.944444444444444, 0.833333333333333, 0.791666666666667, 0.513888888888889, 0), specificities = c(0, 0.439024390243902, 0.634146341463415, 0.658536585365854, 0.951219512195122, 1), thresholds = c(Inf, 4.5, 3.5, 2.5, 1.5, -Inf), auc = 0.823678861788618, smooth = list( binormal = list(sensitivities = c(1, 1, 0.888888888888889, 0.777777777777778, 0.666666666666667, 0.555555555555556, 0.444444444444444, 0.333333333333333, 0.222222222222222, 0.111111111111111, 0, 0), specificities = c(0, 0, 0.552307785718706, 0.747258829348701, 0.854823574573197, 0.919010661854361, 0.95782227908271, 0.980635522026856, 0.993024342787828, 0.998618338950183, 1, 1)))))), s100b = list(forward = list( `<` = list(sensitivities = c(1, 0.975609756097561, 0.975609756097561, 0.975609756097561, 0.975609756097561, 0.902439024390244, 0.878048780487805, 0.829268292682927, 0.780487804878049, 0.75609756097561, 0.731707317073171, 0.682926829268293, 0.658536585365854, 0.658536585365854, 0.634146341463415, 0.634146341463415, 0.634146341463415, 0.634146341463415, 0.609756097560976, 0.585365853658537, 0.585365853658537, 0.560975609756098, 0.536585365853659, 0.51219512195122, 0.51219512195122, 0.48780487804878, 0.463414634146341, 0.439024390243902, 0.439024390243902, 0.414634146341463, 0.414634146341463, 0.390243902439024, 0.390243902439024, 0.341463414634146, 0.341463414634146, 0.341463414634146, 0.341463414634146, 0.317073170731707, 0.292682926829268, 0.292682926829268, 0.268292682926829, 0.24390243902439, 0.219512195121951, 0.195121951219512, 0.146341463414634, 0.121951219512195, 0.0975609756097561, 0.0731707317073171, 0.0487804878048781, 0.024390243902439, 0), specificities = c(0, 0, 0.0694444444444444, 0.111111111111111, 0.138888888888889, 0.222222222222222, 0.305555555555556, 0.388888888888889, 0.486111111111111, 0.541666666666667, 0.541666666666667, 0.583333333333333, 0.638888888888889, 0.694444444444444, 0.736111111111111, 0.763888888888889, 0.777777777777778, 0.805555555555556, 0.805555555555556, 0.805555555555556, 0.819444444444444, 0.819444444444444, 0.819444444444444, 0.819444444444444, 0.833333333333333, 0.833333333333333, 0.847222222222222, 0.861111111111111, 0.875, 0.875, 0.888888888888889, 0.888888888888889, 0.902777777777778, 0.902777777777778, 0.916666666666667, 0.930555555555556, 0.958333333333333, 0.972222222222222, 0.972222222222222, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1), thresholds = c(-Inf, 0.035, 0.045, 0.055, 0.065, 0.075, 0.085, 0.095, 0.105, 0.115, 0.125, 0.135, 0.145, 0.155, 0.165, 0.175, 0.185, 0.205, 0.225, 0.235, 0.245, 0.255, 0.265, 0.275, 0.29, 0.31, 0.325, 0.335, 0.345, 0.365, 0.395, 0.42, 0.435, 0.445, 0.455, 0.465, 0.475, 0.485, 0.495, 0.51, 0.54, 0.57, 0.64, 0.705, 0.725, 0.755, 0.795, 0.84, 0.91, 1.515, Inf), auc = 0.731368563685637, smooth = list(binormal = list( sensitivities = c(1, 1, 0.888888888888889, 0.777777777777778, 0.666666666666667, 0.555555555555556, 0.444444444444444, 0.333333333333333, 0.222222222222222, 0.111111111111111, 0, 0), specificities = c(0, 0, 0.319260340683902, 0.53332668430382, 0.687585799562097, 0.800176459780303, 0.881279866960104, 0.937564100823674, 0.973811718959788, 0.993674203719721, 1, 1)), density = list(sensitivities = c(1, 1, 0.999312614762569, 0.465046300208708, 0.229318781077021, 0.0900955897959522, 0.0175723714381905, 0.0175067574856141, 0.0175067574856125, 0.0175067500338431, 0.000440214715648306, 0), specificities = c(0, 0, 0.00127421929813956, 0.874957647252127, 0.996086700050316, 0.999999999988358, 1, 1, 1, 1, 1, 1)), fitdistr = list(sensitivities = c(1, 1, 0.835114036701977, 0.584469821284334, 0.322372236881631, 0.133833895269473, 0.0405368952539577, 0.00877788147789246, 0.00134088341676637, 0.000142875574638886, 1.01199331237367e-05, 0), specificities = c(0, 0, 0.424695713210589, 0.966885110003963, 0.999904065462202, 0.999999986707449, 0.999999999999912, 1, 1, 1, 1, 1)), logcondens = list(sensitivities = c(1, 1, 0.969257850713414, 0.929979529312436, 0.879336261925595, 0.822878673902115, 0.76057870800949, 0.68785049271852, 0.59811207367259, 0.482117579000528, 0, 0), specificities = c(0, 0, 0.111111111111111, 0.222222222222222, 0.333333333333333, 0.444444444444444, 0.555555555555556, 0.666666666666667, 0.777777777777778, 0.888888888888889, 1, 1)), logcondens.smooth = list(sensitivities = c(1, 1, 0.841771912144968, 0.823440924004266, 0.801262619099338, 0.773487048176685, 0.738772202096164, 0.692408972433331, 0.625991941424993, 0.524945639409855, 0, 0), specificities = c(0, 0, 0.111111111111111, 0.222222222222222, 0.333333333333333, 0.444444444444444, 0.555555555555556, 0.666666666666667, 0.777777777777778, 0.888888888888889, 1, 1)))), `>` = list( sensitivities = c(1, 0.975609756097561, 0.951219512195122, 0.926829268292683, 0.902439024390244, 0.878048780487805, 0.853658536585366, 0.804878048780488, 0.780487804878049, 0.75609756097561, 0.731707317073171, 0.707317073170732, 0.707317073170732, 0.682926829268293, 0.658536585365854, 0.658536585365854, 0.658536585365854, 0.658536585365854, 0.609756097560976, 0.609756097560976, 0.585365853658537, 0.585365853658537, 0.560975609756098, 0.560975609756098, 0.536585365853659, 0.51219512195122, 0.48780487804878, 0.48780487804878, 0.463414634146341, 0.439024390243902, 0.414634146341463, 0.414634146341463, 0.390243902439024, 0.365853658536585, 0.365853658536585, 0.365853658536585, 0.365853658536585, 0.341463414634146, 0.341463414634146, 0.317073170731707, 0.268292682926829, 0.24390243902439, 0.219512195121951, 0.170731707317073, 0.121951219512195, 0.0975609756097561, 0.024390243902439, 0.024390243902439, 0.024390243902439, 0.024390243902439, 0), specificities = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.0277777777777778, 0.0277777777777778, 0.0416666666666667, 0.0694444444444444, 0.0833333333333333, 0.0972222222222222, 0.0972222222222222, 0.111111111111111, 0.111111111111111, 0.125, 0.125, 0.138888888888889, 0.152777777777778, 0.166666666666667, 0.166666666666667, 0.180555555555556, 0.180555555555556, 0.180555555555556, 0.180555555555556, 0.194444444444444, 0.194444444444444, 0.194444444444444, 0.222222222222222, 0.236111111111111, 0.263888888888889, 0.305555555555556, 0.361111111111111, 0.416666666666667, 0.458333333333333, 0.458333333333333, 0.513888888888889, 0.611111111111111, 0.694444444444444, 0.777777777777778, 0.861111111111111, 0.888888888888889, 0.930555555555556, 1, 1), thresholds = c(Inf, 1.515, 0.91, 0.84, 0.795, 0.755, 0.725, 0.705, 0.64, 0.57, 0.54, 0.51, 0.495, 0.485, 0.475, 0.465, 0.455, 0.445, 0.435, 0.42, 0.395, 0.365, 0.345, 0.335, 0.325, 0.31, 0.29, 0.275, 0.265, 0.255, 0.245, 0.235, 0.225, 0.205, 0.185, 0.175, 0.165, 0.155, 0.145, 0.135, 0.125, 0.115, 0.105, 0.095, 0.085, 0.075, 0.065, 0.055, 0.045, 0.035, -Inf ), auc = 0.268631436314363, smooth = list(binormal = list( sensitivities = c(1, 1, 0.888888888888889, 0.777777777777778, 0.666666666666667, 0.555555555555556, 0.444444444444444, 0.333333333333333, 0.222222222222222, 0.111111111111111, 0, 0), specificities = c(0, 0, 0.00632579628027938, 0.0261882810402116, 0.0624358991763263, 0.118720133039896, 0.199823540219697, 0.312414200437903, 0.46667331569618, 0.680739659316098, 1, 1)), density = list(sensitivities = c(1, 1, 0.999559785284352, 0.982493249966157, 0.982493242514388, 0.982493242514386, 0.982427628561809, 0.909904410204048, 0.770681218922979, 0.534953699791292, 0.000687385237430932, 0), specificities = c(0, 0, 1.14128246275547e-19, 1.14128246275547e-19, 1.14128246275547e-19, 1.14128246275547e-19, 6.57976662013777e-18, 1.16416907283642e-11, 0.00391329994968408, 0.125042352747873, 0.99872578070186, 1)), fitdistr = list(sensitivities = c(1, 1, 0.999989880066876, 0.999857124425361, 0.998659116583234, 0.991222118522108, 0.959463104746042, 0.866166104730527, 0.677627763118369, 0.415530178715666, 0.164885963298023, 0), specificities = c(0, 0, 1.023637508323e-47, 2.9906095000628e-37, 4.16785300823212e-28, 2.77079408948358e-20, 8.78689431408789e-14, 1.3292550660413e-08, 9.59345377977921e-05, 0.033114889996037, 0.575304286789411, 1)), logcondens = list(sensitivities = c(1, 1, 0.969257850713414, 0.929979529312436, 0.879336261925595, 0.822878673902115, 0.76057870800949, 0.68785049271852, 0.59811207367259, 0.482117579000528, 0, 0), specificities = c(0, 0, 0.111111111111111, 0.222222222222222, 0.333333333333333, 0.444444444444444, 0.555555555555556, 0.666666666666667, 0.777777777777778, 0.888888888888889, 1, 1)), logcondens.smooth = list( sensitivities = c(1, 1, 0.841771912144968, 0.823440924004266, 0.801262619099338, 0.773487048176685, 0.738772202096164, 0.692408972433331, 0.625991941424993, 0.524945639409855, 0, 0), specificities = c(0, 0, 0.111111111111111, 0.222222222222222, 0.333333333333333, 0.444444444444444, 0.555555555555556, 0.666666666666667, 0.777777777777778, 0.888888888888889, 1, 1))))), reversed = list(`<` = list( sensitivities = c(1, 1, 0.930555555555556, 0.888888888888889, 0.861111111111111, 0.777777777777778, 0.694444444444444, 0.611111111111111, 0.513888888888889, 0.458333333333333, 0.458333333333333, 0.416666666666667, 0.361111111111111, 0.305555555555556, 0.263888888888889, 0.236111111111111, 0.222222222222222, 0.194444444444444, 0.194444444444444, 0.194444444444444, 0.180555555555556, 0.180555555555556, 0.180555555555556, 0.180555555555556, 0.166666666666667, 0.166666666666667, 0.152777777777778, 0.138888888888889, 0.125, 0.125, 0.111111111111111, 0.111111111111111, 0.0972222222222222, 0.0972222222222222, 0.0833333333333333, 0.0694444444444444, 0.0416666666666667, 0.0277777777777778, 0.0277777777777778, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0), specificities = c(0, 0.024390243902439, 0.024390243902439, 0.024390243902439, 0.024390243902439, 0.0975609756097561, 0.121951219512195, 0.170731707317073, 0.219512195121951, 0.24390243902439, 0.268292682926829, 0.317073170731707, 0.341463414634146, 0.341463414634146, 0.365853658536585, 0.365853658536585, 0.365853658536585, 0.365853658536585, 0.390243902439024, 0.414634146341463, 0.414634146341463, 0.439024390243902, 0.463414634146341, 0.48780487804878, 0.48780487804878, 0.51219512195122, 0.536585365853659, 0.560975609756098, 0.560975609756098, 0.585365853658537, 0.585365853658537, 0.609756097560976, 0.609756097560976, 0.658536585365854, 0.658536585365854, 0.658536585365854, 0.658536585365854, 0.682926829268293, 0.707317073170732, 0.707317073170732, 0.731707317073171, 0.75609756097561, 0.780487804878049, 0.804878048780488, 0.853658536585366, 0.878048780487805, 0.902439024390244, 0.926829268292683, 0.951219512195122, 0.975609756097561, 1), thresholds = c(-Inf, 0.035, 0.045, 0.055, 0.065, 0.075, 0.085, 0.095, 0.105, 0.115, 0.125, 0.135, 0.145, 0.155, 0.165, 0.175, 0.185, 0.205, 0.225, 0.235, 0.245, 0.255, 0.265, 0.275, 0.29, 0.31, 0.325, 0.335, 0.345, 0.365, 0.395, 0.42, 0.435, 0.445, 0.455, 0.465, 0.475, 0.485, 0.495, 0.51, 0.54, 0.57, 0.64, 0.705, 0.725, 0.755, 0.795, 0.84, 0.91, 1.515, Inf), auc = 0.268631436314363, smooth = list( binormal = list(sensitivities = c(1, 1, 0.888888888888889, 0.777777777777778, 0.666666666666667, 0.555555555555556, 0.444444444444444, 0.333333333333333, 0.222222222222222, 0.111111111111111, 0, 0), specificities = c(0, 0, 0.0369804502357855, 0.0772234706040702, 0.123392170122729, 0.17707059391233, 0.240651905596888, 0.318249849091736, 0.418084835714472, 0.562007694093868, 1, 1)), density = list(sensitivities = c(1, 1, 0.99872578070186, 0.125042352747873, 0.00391329994968408, 1.16416907283642e-11, 6.57976662013777e-18, 1.14128246275547e-19, 1.14128246275547e-19, 1.14128246275547e-19, 1.14128246275547e-19, 0), specificities = c(0, 0, 0.000687385237430932, 0.534953699791292, 0.770681218922979, 0.909904410204048, 0.982427628561809, 0.982493242514386, 0.982493242514388, 0.982493249966157, 0.999559785284352, 1)), fitdistr = list(sensitivities = c(1, 1, 0.575304286789411, 0.033114889996037, 9.59345377977921e-05, 1.3292550660413e-08, 8.78689431408789e-14, 2.77079408948358e-20, 4.16785300823212e-28, 2.9906095000628e-37, 1.023637508323e-47, 0), specificities = c(0, 0, 0.164885963298023, 0.415530178715666, 0.677627763118369, 0.866166104730527, 0.959463104746042, 0.991222118522108, 0.998659116583234, 0.999857124425361, 0.999989880066876, 1)), logcondens = list(sensitivities = c(1, 1, 0.686409431702345, 0.473050035023872, 0.301407487870163, 0.17529939841996, 0.0819777468648868, 0.0197066653283436, 0, 0, 0, 0), specificities = c(0, 0, 0.111111111111111, 0.222222222222222, 0.333333333333333, 0.444444444444444, 0.555555555555556, 0.666666666666667, 0.777777777777778, 0.888888888888889, 1, 1)), logcondens.smooth = list(sensitivities = c(1, 1, 0.68160709500888, 0.524478175672325, 0.3564497389029, 0.214213467016302, 0.104401985793222, 0.0327332310671721, 0.00232980315691445, 2.8609038515981e-07, 0, 0), specificities = c(0, 0, 0.111111111111111, 0.222222222222222, 0.333333333333333, 0.444444444444444, 0.555555555555556, 0.666666666666667, 0.777777777777778, 0.888888888888889, 1, 1)))), `>` = list( sensitivities = c(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0.972222222222222, 0.972222222222222, 0.958333333333333, 0.930555555555556, 0.916666666666667, 0.902777777777778, 0.902777777777778, 0.888888888888889, 0.888888888888889, 0.875, 0.875, 0.861111111111111, 0.847222222222222, 0.833333333333333, 0.833333333333333, 0.819444444444444, 0.819444444444444, 0.819444444444444, 0.819444444444444, 0.805555555555556, 0.805555555555556, 0.805555555555556, 0.777777777777778, 0.763888888888889, 0.736111111111111, 0.694444444444444, 0.638888888888889, 0.583333333333333, 0.541666666666667, 0.541666666666667, 0.486111111111111, 0.388888888888889, 0.305555555555556, 0.222222222222222, 0.138888888888889, 0.111111111111111, 0.0694444444444444, 0, 0), specificities = c(0, 0.024390243902439, 0.0487804878048781, 0.0731707317073171, 0.0975609756097561, 0.121951219512195, 0.146341463414634, 0.195121951219512, 0.219512195121951, 0.24390243902439, 0.268292682926829, 0.292682926829268, 0.292682926829268, 0.317073170731707, 0.341463414634146, 0.341463414634146, 0.341463414634146, 0.341463414634146, 0.390243902439024, 0.390243902439024, 0.414634146341463, 0.414634146341463, 0.439024390243902, 0.439024390243902, 0.463414634146341, 0.48780487804878, 0.51219512195122, 0.51219512195122, 0.536585365853659, 0.560975609756098, 0.585365853658537, 0.585365853658537, 0.609756097560976, 0.634146341463415, 0.634146341463415, 0.634146341463415, 0.634146341463415, 0.658536585365854, 0.658536585365854, 0.682926829268293, 0.731707317073171, 0.75609756097561, 0.780487804878049, 0.829268292682927, 0.878048780487805, 0.902439024390244, 0.975609756097561, 0.975609756097561, 0.975609756097561, 0.975609756097561, 1), thresholds = c(Inf, 1.515, 0.91, 0.84, 0.795, 0.755, 0.725, 0.705, 0.64, 0.57, 0.54, 0.51, 0.495, 0.485, 0.475, 0.465, 0.455, 0.445, 0.435, 0.42, 0.395, 0.365, 0.345, 0.335, 0.325, 0.31, 0.29, 0.275, 0.265, 0.255, 0.245, 0.235, 0.225, 0.205, 0.185, 0.175, 0.165, 0.155, 0.145, 0.135, 0.125, 0.115, 0.105, 0.095, 0.085, 0.075, 0.065, 0.055, 0.045, 0.035, -Inf ), auc = 0.731368563685637, smooth = list(binormal = list( sensitivities = c(1, 1, 0.888888888888889, 0.777777777777778, 0.666666666666667, 0.555555555555556, 0.444444444444444, 0.333333333333333, 0.222222222222222, 0.111111111111111, 0, 0), specificities = c(0, 0, 0.437992305906132, 0.581915164285528, 0.681750150908264, 0.759348094403112, 0.82292940608767, 0.876607829877271, 0.92277652939593, 0.963019549764215, 1, 1)), density = list(sensitivities = c(1, 1, 1, 1, 1, 1, 1, 0.999999999988358, 0.996086700050316, 0.874957647252127, 0.00127421929813956, 0), specificities = c(0, 0, 0.000440214715648306, 0.0175067500338431, 0.0175067574856125, 0.0175067574856141, 0.0175723714381905, 0.0900955897959522, 0.229318781077021, 0.465046300208708, 0.999312614762569, 1)), fitdistr = list( sensitivities = c(1, 1, 1, 1, 1, 1, 0.999999999999912, 0.999999986707449, 0.999904065462202, 0.966885110003963, 0.424695713210589, 0), specificities = c(0, 0, 1.01199331237367e-05, 0.000142875574638886, 0.00134088341676637, 0.00877788147789246, 0.0405368952539577, 0.133833895269473, 0.322372236881631, 0.584469821284334, 0.835114036701977, 1)), logcondens = list( sensitivities = c(1, 1, 0.686409431702345, 0.473050035023872, 0.301407487870163, 0.17529939841996, 0.0819777468648868, 0.0197066653283436, 0, 0, 0, 0), specificities = c(0, 0, 0.111111111111111, 0.222222222222222, 0.333333333333333, 0.444444444444444, 0.555555555555556, 0.666666666666667, 0.777777777777778, 0.888888888888889, 1, 1)), logcondens.smooth = list( sensitivities = c(1, 1, 0.68160709500888, 0.524478175672325, 0.3564497389029, 0.214213467016302, 0.104401985793222, 0.0327332310671721, 0.00232980315691445, 2.8609038515981e-07, 0, 0), specificities = c(0, 0, 0.111111111111111, 0.222222222222222, 0.333333333333333, 0.444444444444444, 0.555555555555556, 0.666666666666667, 0.777777777777778, 0.888888888888889, 1, 1))))))) pROC/tests/testthat/helper-vdiffr.R0000644000176200001440000000033614114130125016731 0ustar liggesusers # Skip expect_doppelganger if vdiffr is not installed expect_doppelganger <- function(title, fig, path = NULL, ...) { testthat::skip_if_not_installed("vdiffr") vdiffr::expect_doppelganger(title, fig, path = path, ...) }pROC/tests/testthat/test-roc.R0000644000176200001440000004362314114130125015742 0ustar liggesuserslibrary(pROC) data(aSAH) level.values <- list( forward = c("Good", "Poor"), reversed = c("Poor", "Good") ) expected.algorithm <- list() expected.algorithm[["wfns"]] <- list( pROC:::roc.utils.perfs.all.safe, pROC:::roc.utils.perfs.all.fast, pROC:::rocUtilsPerfsAllC, pROC:::roc.utils.perfs.all.test, pROC:::rocUtilsPerfsAllC, # 6 thresholds pROC:::rocUtilsPerfsAllC # ordered ) expected.algorithm[["ndka"]] <- list( pROC:::roc.utils.perfs.all.safe, pROC:::roc.utils.perfs.all.fast, pROC:::rocUtilsPerfsAllC, pROC:::roc.utils.perfs.all.test, pROC:::roc.utils.perfs.all.fast, # 110 thresholds pROC:::roc.utils.perfs.all.fast # numeric ) expected.algorithm[["s100b"]] <-list( pROC:::roc.utils.perfs.all.safe, pROC:::roc.utils.perfs.all.fast, pROC:::rocUtilsPerfsAllC, pROC:::roc.utils.perfs.all.test, pROC:::rocUtilsPerfsAllC, # 51 thresholds pROC:::roc.utils.perfs.all.fast # numeric ) smooth.methods <- c("binormal", "density", "fitdistr", "logcondens", "logcondens.smooth") for (marker in c("ndka", "wfns", "s100b")) { for (levels.direction in names(level.values)) { for (percent in c(FALSE, TRUE)) { for (direction in c("auto", "<", ">")) { for (algorithm in 1:5) { context(sprintf("'roc' function works with percent = %s, marker = %s, levels.direction = %s, direction = %s and algorithm = %s", percent, marker, levels.direction, direction, algorithm)) expected.direction <- ifelse(direction == "auto", ifelse(levels.direction == "forward", "<", ">"), direction) r <- roc(aSAH$outcome, aSAH[[marker]], levels = level.values[[levels.direction]], direction = direction, percent = percent, algorithm = algorithm, quiet = TRUE) test_that("roc.formula produces the same results as roc.default", { rf <- roc(as.formula(sprintf("outcome ~ %s", marker)), data = aSAH, levels = level.values[[levels.direction]], direction = direction, percent = percent, algorithm = algorithm, quiet = TRUE) expect_is(rf, "roc") expect_equal(as.numeric(rf$auc), as.numeric(r$auc)) for (item in c("percent", "sensitivities", "specificities", "thresholds", "direction", "cases", "controls", "fun.sesp")) { expect_identical(rf[[item]], r[[item]], label = sprintf("roc(outcome ~ %s, %s, %s, %s, %s)[[\"%s\"]]", marker, levels.direction, percent, direction, algorithm, item)) } for (item in c("original.predictor", "original.response", "predictor", "response", "levels")) { expect_identical(unname(rf[[item]]), unname(r[[item]]), label = sprintf("roc(outcome ~ %s, %s, %s, %s, %s)[[\"%s\"]]", marker, levels.direction, percent, direction, algorithm, item)) } expect_identical(rf$fun.sesp, expected.algorithm[[marker]][[algorithm]]) }) test_that("roc.default works with control/cases as well", { rcs <- roc(controls = r$controls, cases = r$cases, levels = level.values[[levels.direction]], direction = direction, percent = percent, algorithm = algorithm, quiet = TRUE) expect_is(rcs, "roc") expect_equal(as.numeric(rcs$auc), as.numeric(r$auc)) for (item in c("percent", "sensitivities", "specificities", "thresholds", "direction", "cases", "controls", "fun.sesp")) { expect_identical(rcs[[item]], r[[item]]) } expect_identical(rcs$fun.sesp, expected.algorithm[[marker]][[algorithm]]) }) test_that("roc.default produces the expected results", { expect_is(r, "roc") expect_identical(r$percent, percent) expect_identical(r$fun.sesp, expected.algorithm[[marker]][[algorithm]]) expect_identical(r$direction, expected.direction) expect_identical(r$levels, level.values[[levels.direction]]) expect_equal(r$thresholds, expected.roc[[marker]][[levels.direction]][[expected.direction]][["thresholds"]]) expect_equal(r$sensitivities, expected.roc[[marker]][[levels.direction]][[expected.direction]][["sensitivities"]] * ifelse(percent, 100, 1)) expect_equal(r$specificities, expected.roc[[marker]][[levels.direction]][[expected.direction]][["specificities"]] * ifelse(percent, 100, 1)) }) if (algorithm == 3) { if (marker == "wfns") { available.smooth.methods <- "binormal" } else { available.smooth.methods <- smooth.methods } for (smooth.method in available.smooth.methods) { context(sprintf("smooth(roc(...)) works with percent = %s, marker = %s, levels.direction = %s, direction = %s and smooth.method = %s", percent, marker, levels.direction, direction, smooth.method)) test_that("smoothing a ROC curve produces expected results", { if (smooth.method == "logcondens" || smooth.method == "logcondens.smooth") { testthat::skip_if_not_installed("logcondens") } s <- smooth(r, method=smooth.method, 10) expect_is(s, "smooth.roc") expect_identical(s$percent, percent) expect_identical(s$direction, expected.direction) expect_equal(s$sensitivities, expected.roc[[marker]][[levels.direction]][[expected.direction]][["smooth"]][[smooth.method]][["sensitivities"]] * ifelse(percent, 100, 1)) expect_equal(s$specificities, expected.roc[[marker]][[levels.direction]][[expected.direction]][["smooth"]][[smooth.method]][["specificities"]] * ifelse(percent, 100, 1)) }) test_that("building curve with smooth=TRUE produces expected results", { context(sprintf("roc(..., smooth=TRUE) works with percent = %s, marker = %s, levels.direction = %s, direction = %s and smooth.method = %s", percent, marker, levels.direction, direction, smooth.method)) if (smooth.method == "logcondens" || smooth.method == "logcondens.smooth") { testthat::skip_if_not_installed("logcondens") } s2 <- roc(aSAH$outcome, aSAH[[marker]], levels = level.values[[levels.direction]], direction = direction, percent = percent, algorithm = algorithm, quiet = TRUE, smooth = TRUE, smooth.n = 10, smooth.method=smooth.method) expect_is(s2, "smooth.roc") expect_identical(s2$percent, percent) expect_identical(s2$direction, expected.direction) expect_equal(s2$sensitivities, expected.roc[[marker]][[levels.direction]][[expected.direction]][["smooth"]][[smooth.method]][["sensitivities"]] * ifelse(percent, 100, 1)) expect_equal(s2$specificities, expected.roc[[marker]][[levels.direction]][[expected.direction]][["smooth"]][[smooth.method]][["specificities"]] * ifelse(percent, 100, 1)) }) } } } } } } } #dump("expected.roc", file="helper-roc-expected.R") test_that("roc.default handles NAs", { # Generate missing values aSAH.missing <- aSAH aSAH.missing$ndka[1:20] <- NA aSAH.missing$wfns[1:20] <- NA # na.rm=FALSE works # With NDKA expect_true(is.na(roc(aSAH.missing$outcome, aSAH.missing$ndka, na.rm = FALSE))) expect_false(is.na(auc(roc(aSAH.missing$outcome, aSAH.missing$ndka, na.rm = TRUE)))) # With WFNS expect_true(is.na(roc(aSAH.missing$outcome, aSAH.missing$wfns, na.rm = FALSE))) expect_false(is.na(auc(roc(aSAH.missing$outcome, aSAH.missing$wfns, na.rm = TRUE)))) # Same as subset expect_identical( as.numeric(auc(roc(aSAH.missing$outcome, aSAH.missing$ndka, na.rm = TRUE))), as.numeric(auc(roc(aSAH[21:113,]$outcome, aSAH.missing[21:113,]$ndka)))) # With ordered expect_identical( as.numeric(auc(roc(aSAH.missing$outcome, aSAH.missing$wfns, na.rm = TRUE))), as.numeric(auc(roc(aSAH[21:113,]$outcome, aSAH.missing[21:113,]$wfns)))) # Also with case/controls expect_identical( as.numeric(auc(roc(controls = aSAH.missing$ndka[aSAH.missing$outcome == "Good"], cases = aSAH.missing$ndka[aSAH.missing$outcome == "Poor"]))), as.numeric(auc(roc(aSAH[21:113,]$outcome, aSAH.missing[21:113,]$ndka)))) # With ordered expect_identical( as.numeric(auc(roc(controls = aSAH.missing$wfns[aSAH.missing$outcome == "Good"], cases = aSAH.missing$wfns[aSAH.missing$outcome == "Poor"]))), as.numeric(auc(roc(aSAH[21:113,]$outcome, aSAH.missing[21:113,]$wfns)))) }) test_that("roc.formula behaves", { # By this point we've tested the main stuff, so just check a few basic elements roc.check.only.items <- c("sensitivities", "specificities", "thresholds", "cases", "controls") expect_identical( roc(outcome ~ wfns, data = aSAH)[roc.check.only.items], roc(aSAH$outcome, aSAH$wfns)[roc.check.only.items] ) # formula without data expect_identical( roc(aSAH$outcome ~ aSAH$wfns)[roc.check.only.items], roc(aSAH$outcome, aSAH$wfns)[roc.check.only.items] ) # formula with data from parent env outcome <- aSAH$outcome wfns <- aSAH$wfns expect_identical( roc(outcome ~ wfns)[roc.check.only.items], roc(outcome, wfns)[roc.check.only.items] ) expect_identical( roc(outcome ~ wfns, data = aSAH, subset = (gender == "Female"))[roc.check.only.items], roc(aSAH$outcome[aSAH$gender == "Female"], aSAH$wfns[aSAH$gender == "Female"])[roc.check.only.items] ) # Generate missing values aSAH.missing <- aSAH aSAH.missing$ndka[1:20] <- NA expect_identical( roc(outcome ~ ndka, data = aSAH.missing, na.action = na.omit)[roc.check.only.items], roc(aSAH[21:113,]$outcome, aSAH[21:113,]$ndka)[roc.check.only.items] ) #na.fail should fail expect_error(roc(outcome ~ ndka, data = aSAH.missing, na.action = na.fail)) #weights should fail too expect_error(roc(outcome ~ ndka, data = aSAH, weights = seq_len(nrow(aSAH)), quiet = TRUE), regexp = "weights are not supported") # invalid formula should fail expect_error(roc(~ndka, data=aSAH)) # Both na.action and subset expect_identical( roc(outcome ~ ndka, data = aSAH.missing, na.action = na.omit, subset = (gender == "Female"))[roc.check.only.items], roc(aSAH[21:113,]$outcome[aSAH[21:113,]$gender == "Female"], aSAH[21:113,]$ndka[aSAH[21:113,]$gender == "Female"])[roc.check.only.items] ) }) test_that("roc can't take both response/predictor and case/control", { expect_error(roc(aSAH$outcome, aSAH$ndka, controls = aSAH$ndka[aSAH$outcome == "Good"], cases = aSAH$ndka[aSAH$outcome == "Poor"])) }) test_that("microbenchmark works", { skip_if_not_installed("microbenchmark") skip_on_cran() skip("Not enough difference any longer, randomly selecting algorithm 2.") # Algorithm 3 (C) should be selected with small low number of thresholds like aSAH$wfns expect_output(r <- roc(aSAH$outcome, aSAH$wfns, algorithm = 0), "Selecting algorithm 3") # Algorithm 2 (R cumsum) should be selected with large datasets with many thresholds # This is going to be slow, so skip unless we're running slow tests skip_slow() expect_output(r <- roc(round(runif(10000)), rnorm(10000), algorithm = 0), "Selecting algorithm 2") }) test_that("roc with multiple predictors returns expected ROC curves", { roclist <- roc(outcome ~ wfns + ndka + s100b, data = aSAH, quiet=TRUE) expect_is(roclist, "list") expect_type(roclist, "list") expect_length(roclist, 3) expect_identical(names(roclist), c("wfns", "ndka", "s100b")) expect_equal_roc_formula(roclist$wfns, r.wfns) expect_equal_roc_formula(roclist$ndka, r.ndka) expect_equal_roc_formula(roclist$s100b, r.s100b) attach(aSAH) roclist <- roc(outcome ~ wfns + ndka + s100b, quiet=TRUE) expect_equal_roc_formula(roclist$wfns, r.wfns) expect_equal_roc_formula(roclist$ndka, r.ndka) expect_equal_roc_formula(roclist$s100b, r.s100b) detach(aSAH) }) test_that("extra arguments passed to roc with multiple predictors", { roclist <- roc(outcome ~ wfns + ndka + s100b, data = aSAH, quiet=TRUE, percent = TRUE, partial.auc = c(90, 99)) expect_equal_roc_formula(roclist$wfns, r.wfns.percent.partial1) expect_equal_roc_formula(roclist$ndka, r.ndka.percent.partial1) expect_equal_roc_formula(roclist$s100b, r.s100b.percent.partial1) }) test_that("roc works with densitites", { range.ndka <- range(aSAH$ndka) bw <- bw.nrd0(aSAH$ndka) from <- min(aSAH$ndka) - (3 * bw) to <- max(aSAH$ndka) + (3 * bw) density.controls <- density(aSAH$ndka[aSAH$outcome == "Good"], from = from, to = to, bw = bw) density.cases <- density(aSAH$ndka[aSAH$outcome == "Poor"], from = from, to = to, bw = bw) density.roc <- roc(density.cases = density.cases$y, density.controls = density.controls$y) smoothed.roc <- smooth(r.ndka, method="density") expect_is(density.roc, "smooth.roc") expect_equal(density.roc$sensitivities, smoothed.roc$sensitivities) expect_equal(density.roc$specificities, smoothed.roc$specificities) expect_equal(as.numeric(density.roc$auc), as.numeric(smoothed.roc$auc)) }) test_that("roc.density works with extra arguments", { range.ndka <- range(aSAH$ndka) bw <- bw.nrd0(aSAH$ndka) from <- min(aSAH$ndka) - (3 * bw) to <- max(aSAH$ndka) + (3 * bw) density.controls <- density(aSAH$ndka[aSAH$outcome == "Good"], from = from, to = to, bw = bw) density.cases <- density(aSAH$ndka[aSAH$outcome == "Poor"], from = from, to = to, bw = bw) density.roc.partial <- roc(density.cases = density.cases$y, density.controls = density.controls$y, partial.auc = c(1, .9), partial.auc.focus = "se", partial.auc.correct = TRUE) expect_equal(as.numeric(density.roc.partial$auc), 0.506203453) density.roc.percent <- roc(density.cases = density.cases$y, density.controls = density.controls$y, percent = TRUE) expect_equal(as.numeric(density.roc.percent$auc), 60.44617865) }) test_that("roc doesn't accept density with other arguments", { density.controls <- density(aSAH$ndka[aSAH$outcome == "Good"]) density.cases <- density(aSAH$ndka[aSAH$outcome == "Poor"]) expect_error(roc(aSAH$outcome, aSAH$ndka, density.cases = density.controls, density.controls = density.cases), "incompatible") expect_error(roc(cases = aSAH$ndka, controls = aSAH$ndka, density.cases = density.controls, density.controls = density.cases), "incompatible") }) test_that("roc.data.frame works", { r <- roc(aSAH, outcome, s100b, ret="roc") expect_is(r, "roc") co <- roc(aSAH, outcome, s100b, ret="coords") expect_equal(dim(co), c(51, 3)) co <- roc(aSAH, outcome, s100b, ret="all_coords") expect_equal(nrow(co), 51) expect_true(nrow(co) >= 22) }) test_that("roc.data.frame works with quoted names", { r <- roc(aSAH, "outcome", "s100b", ret="roc") expect_is(r, "roc") co <- roc(aSAH, "outcome", "s100b", ret="coords") expect_equal(dim(co), c(51, 3)) co <- roc(aSAH, "outcome", "s100b", ret="all_coords") expect_equal(nrow(co), 51) expect_true(nrow(co) >= 22) }) test_that("roc_ works", { r <- roc_(aSAH, "outcome", "s100b", ret="roc") expect_is(r, "roc") co <- roc_(aSAH, "outcome", "s100b", ret="coords") expect_equal(dim(co), c(51, 3)) co <- roc_(aSAH, "outcome", "s100b", ret="all_coords") expect_equal(nrow(co), 51) expect_true(nrow(co) >= 22) }) test_that("roc.data.frame reject invalid columns", { outcomes <- aSAH$outcome expect_error(roc(aSAH, outcomes, s100b), "Column") expect_error(roc(aSAH, "outcomes", "s100b"), "Column") expect_error(roc_(aSAH, "outcomes", "s100b"), "Column") s100c <- aSAH$s100b expect_error(roc(aSAH, outcome, s100c), "Column") expect_error(roc(aSAH, "outcome", "s100c"), "Column") expect_error(roc_(aSAH, "outcome", "s100c"), "Column") }) test_that("roc reject and warns for invalid levels", { expect_error(roc(aSAH$gos6, aSAH$s100b), "No case observation") expect_error(roc(aSAH$gos6, aSAH$s100b, levels = levels(aSAH$gos6)), "levels") expect_warning(roc(factor(aSAH$gos6), aSAH$s100b, quiet = TRUE), "levels") expect_error(roc(aSAH, gos6, s100b), "No case observation") expect_error(roc(aSAH, gos6, s100b, levels = levels(aSAH$gos6)), "levels") dat <- aSAH dat$gos6 <- factor(aSAH$gos6) expect_warning(roc(dat, gos6, s100b, quiet = TRUE), "levels") }) test_that("roc reject and warns for invalid predictors", { expect_error(roc(aSAH$outcome, as.character(aSAH$wfns)), "Predictor") expect_warning(roc(aSAH$outcome, as.matrix(aSAH$ndka)), "Deprecated") expect_warning(roc(as.matrix(aSAH$outcome), aSAH$ndka), "Deprecated") expect_error(roc(aSAH$outcome[1:100], aSAH$ndka), "length") expect_error(roc(aSAH$outcome[1:100], aSAH$ndka[1:50]), "length") }) test_that("roc reject requires cases & controls", { expect_error(roc(aSAH$outcome[aSAH$outcome == "Good"], aSAH$ndka[aSAH$outcome == "Good"]), "case") expect_error(roc(aSAH$outcome[aSAH$outcome == "Poor"], aSAH$ndka[aSAH$outcome == "Poor"]), "control") expect_error(roc(aSAH[aSAH$outcome == "Good",], outcome, ndka), "case") expect_error(roc(aSAH[aSAH$outcome == "Poor",], outcome, ndka), "control") }) test_that("roc works with ordered predictor", { wfns2 <- ordered(as.numeric(aSAH$wfns) + 2) r <- roc(aSAH$outcome, wfns2) expect_equal(r$thresholds, c(-Inf, 3.5, 4.5, 5.5, 6.5, Inf)) levels(wfns2) <- letters[1:5] # TODO: this behavior should be fixed, see issue #63. # For now ensure basic behavior with warning is at least consistent. expect_warning(r <- roc(aSAH$outcome, wfns2)) expect_equal(r$thresholds, c(-Inf, 1.5, 2.5, 3.5, 4.5, Inf)) # In reality we want to say something like c(-Inf, "a", "b", "c", "d", "e", Inf) }) # The code below can be used to refresh the "expected.roc" data, just in case... # expected.roc <- list() # for (marker in c("ndka", "wfns", "s100b")) { # expected.roc[[marker]] <- list() # for (levels.direction in names(level.values)) { # expected.roc[[marker]][[levels.direction]] <- list() # for (direction in c("<", ">")) { # r <- roc(aSAH$outcome, aSAH[[marker]], levels = level.values[[levels.direction]], direction = direction, percent = FALSE, quiet = TRUE) # if (!isTRUE(percent) && direction != "auto") { # expected.roc[[marker]][[levels.direction]][[direction]] <- r[c("sensitivities", "specificities", "thresholds")] # expected.roc[[marker]][[levels.direction]][[direction]][["auc"]] <- as.numeric(r$auc) # } # for (smooth.method in available.smooth.methods) { # s <- smooth(r, method=smooth.method, 10) # expected.roc[[marker]][[levels.direction]][[expected.direction]][["smooth"]][[smooth.method]][["sensitivities"]] <- s$sensitivities # expected.roc[[marker]][[levels.direction]][[expected.direction]][["smooth"]][[smooth.method]][["specificities"]] <- s$specificities # } # } # } # } # save("expected.roc", system.file("extdata", "test-roc-expected.R", package="pROC"), file = "dump_roc_expected.R") pROC/tests/testthat/test-ggroc.R0000644000176200001440000000447114114130125016256 0ustar liggesuserscontext("ggroc") test_that("Ggroc screenshot looks normal", { test_ggplot_screenshot <- function() { print(ggroc(r.s100b.percent, , alpha = 0.5, colour = "red", linetype = 2, size = 2)) } expect_doppelganger("ggroc.screenshot", test_ggplot_screenshot) }) test_that("Ggroc list screenshot looks normal", { test_ggplot_list_screenshot <- function() { print(ggroc(list(s100b=r.s100b, wfns=r.wfns, ndka=r.ndka))) } expect_doppelganger("ggroc.list.screenshot", test_ggplot_list_screenshot) }) test_that("Ggroc list can take multiple aes", { test_ggplot_list_screenshot <- function() { print(ggroc(list(s100b=r.s100b, wfns=r.wfns, ndka=r.ndka), aes=c("c", "linetype", "size"))) } expect_doppelganger("ggroc.list.multi.aes", test_ggplot_list_screenshot) }) test_that("Ggroc list extra aestetics screenshot looks normal", { test_ggplot_list_extra_aes_screenshot <- function() { print(ggroc(list(s100b=r.s100b, wfns=r.wfns, ndka=r.ndka), aes="linetype", color="red")) } expect_doppelganger("ggroc.list.extra.aes.screenshot", test_ggplot_list_extra_aes_screenshot) }) test_that("Ggroc list with group facet screenshot looks normal", { test_ggplot_list_group_facet_screenshot <- function() { library(ggplot2) g <- ggroc(list(s100b=r.s100b, wfns=r.wfns, ndka=r.ndka), aes="group") + facet_grid(.~name) print(g) } expect_doppelganger("ggroc.list.group.facet.screenshot", test_ggplot_list_group_facet_screenshot) }) test_that("Ggroc aesthetics can be modified with scale_colour_manual", { test_ggplot_list_screenshot <- function() { print(ggroc(list(s100b=r.s100b, wfns=r.wfns, ndka=r.ndka), aes=c("c", "linetype")) + scale_colour_manual(values = c("purple", "yellow", "purple"))) } expect_doppelganger("ggroc.list.scale.colour.manual", test_ggplot_list_screenshot) }) test_that("Ggroc screenshot looks normal with a single smooth.roc", { test_ggplot_screenshot <- function() { print(ggroc(smooth(r.s100b), , alpha = 0.5, colour = "red", linetype = 2, size = 2)) } expect_doppelganger("ggroc.smooth.screenshot", test_ggplot_screenshot) }) test_that("Ggroc screenshot looks normal with a list of smooth.roc", { test_ggplot_screenshot <- function() { print(ggroc(list(s100b=smooth(r.s100b), wfns=smooth(r.wfns), ndka=smooth(r.ndka)))) } expect_doppelganger("ggroc.smooth.list.screenshot", test_ggplot_screenshot) }) pROC/tests/testthat/test-roc.test-venkatraman.R0000644000176200001440000000403314114130125021215 0ustar liggesuserslibrary(pROC) data(aSAH) test_that("paired venkatraman works as expected", { skip_slow() ht <- roc.test(r.s100b, r.wfns, method = "venkatraman", boot.n = 12) expect_venkatraman_htest(ht) expect_equal(ht$alternative, "two.sided") expect_equal(ht$method, "Venkatraman's test for two paired ROC curves") expect_equal(unname(ht$parameter), 12) # Test output ht$statistic <- c(E = 42) ht$p.value <- 0 expect_known_output(print(ht), "print_output/roc.test-venkatraman.paired") }) test_that("unpaired venkatraman works as expected", { skip_slow() expect_warning(ht <- roc.test(r.s100b, r.wfns, method = "venkatraman", boot.n = 12, paired = FALSE), "paired") expect_venkatraman_htest(ht) expect_equal(ht$alternative, "two.sided") expect_equal(ht$method, "Venkatraman's test for two unpaired ROC curves") expect_equal(unname(ht$parameter), 12) # Test output ht$statistic <- c(E = 41) ht$p.value <- 0.548347196932 expect_known_output(print(ht), "print_output/roc.test-venkatraman.unpaired") }) test_that("non stratified venkatraman works as expected", { skip_slow() ht <- roc.test(r.s100b, r.wfns, method = "venkatraman", boot.n = 12, boot.stratified = FALSE) expect_venkatraman_htest(ht) expect_equal(ht$alternative, "two.sided") expect_equal(ht$method, "Venkatraman's test for two paired ROC curves") expect_equal(unname(ht$parameter), 12) # Test output ht$statistic <- c(E = 43) ht$p.value <- 0.05 expect_known_output(print(ht), "print_output/roc.test-venkatraman.unstratified") }) test_that("non stratified, unpaired venkatraman works as expected", { skip_slow() expect_warning(ht <- roc.test(r.s100b, r.wfns, method = "venkatraman", boot.n = 12, boot.stratified = FALSE, paired = FALSE), "paired") expect_venkatraman_htest(ht) expect_equal(ht$alternative, "two.sided") expect_equal(ht$method, "Venkatraman's test for two unpaired ROC curves") expect_equal(unname(ht$parameter), 12) # Test output ht$statistic <- c(E = 43) ht$p.value <- 0.05 expect_known_output(print(ht), "print_output/roc.test-venkatraman.unpaired.unstratified") }) pROC/tests/testthat/test-numeric-Inf.R0000644000176200001440000000151413607143106017335 0ustar liggesuserslibrary(pROC) test_that("roc rejects rejects invalid data", { # Control always negative controls <- c(-Inf, 1,2,3,4,5) cases <- c(2,3,4,5,6) expect_warning(r <- roc(controls = controls, cases = cases), "Infinite value") expect_equal(r, NaN) # Control always positive # 100% specificity impossible controls <- c(1,2,3,4,5, Inf) cases <- c(2,3,4,5,6) expect_warning(r <- roc(controls = controls, cases = cases), "Infinite value") expect_equal(r, NaN) }) test_that("roc rejects rejects also valid data", { # OK controls <- c(1,2,3,4,5) cases <- c(-Inf, 2,3,4,5,6) expect_warning(r <- roc(controls = controls, cases = cases), "Infinite value") expect_equal(r, NaN) # OK controls <- c(1,2,3,4,Inf) cases <- c(2,3,4,5,6) expect_warning(r <- roc(controls = controls, cases = cases), "Infinite value") expect_equal(r, NaN) })pROC/tests/testthat/test-roc.utils.percent.R0000644000176200001440000000441514114130125020534 0ustar liggesuserslibrary(pROC) data(aSAH) context("roc.utils.percent") test_that("roc.utils.topercent works on full AUC", { expect_equal_ignore_call(pROC:::roc.utils.topercent.roc(r.wfns), r.wfns.percent) }) test_that("roc.utils.unpercent works on full AUC", { expect_equal_ignore_call(pROC:::roc.utils.unpercent.roc(r.wfns.percent), r.wfns) }) test_that("roc.utils.topercent works on partial AUC", { expect_equal_ignore_call(pROC:::roc.utils.topercent.roc(r.wfns.partial1), r.wfns.percent.partial1) }) test_that("roc.utils.unpercent works on partial AUC", { expect_equal_ignore_call(pROC:::roc.utils.unpercent.roc(r.wfns.percent.partial1), r.wfns.partial1) }) test_that("roc.utils.topercent works with CI", { r <- roc(aSAH$outcome, aSAH$wfns, ci=TRUE) r.percent <- roc(aSAH$outcome, aSAH$wfns, ci=TRUE, percent = TRUE) expect_equal_ignore_call(pROC:::roc.utils.topercent.roc(r), r.percent) }) test_that("roc.utils.unpercent works with CI", { r <- roc(aSAH$outcome, aSAH$wfns, ci=TRUE) r.percent <- roc(aSAH$outcome, aSAH$wfns, ci=TRUE, percent = TRUE) expect_equal_ignore_call(pROC:::roc.utils.unpercent.roc(r.percent), r) }) test_that("roc.utils.topercent works without AUC", { r <- roc(aSAH$outcome, aSAH$wfns, auc=FALSE) r.percent <- roc(aSAH$outcome, aSAH$wfns, auc=FALSE, percent = TRUE) expect_equal_ignore_call(pROC:::roc.utils.topercent.roc(r), r.percent) }) test_that("roc.utils.unpercent works without AUC", { r <- roc(aSAH$outcome, aSAH$wfns, auc=FALSE) r.percent <- roc(aSAH$outcome, aSAH$wfns, auc=FALSE, percent = TRUE) expect_equal_ignore_call(pROC:::roc.utils.unpercent.roc(r.percent), r) }) test_that("roc.utils.topercent works with different types of CI", { r <- roc(aSAH$outcome, aSAH$wfns, ci=TRUE) r.percent <- roc(aSAH$outcome, aSAH$wfns, ci=TRUE, percent = TRUE) expect_equal_ignore_call(pROC:::roc.utils.topercent.roc(r), r.percent) }) test_that("roc.utils.to/unpercent works with ci .thresholds, .sp, .se", { skip_slow() for (of in c("thresholds", "sp", "se")) { set.seed(42) r <- roc(aSAH$outcome, aSAH$wfns, ci=TRUE, of = of) set.seed(42) r.percent <- roc(aSAH$outcome, aSAH$wfns, ci=TRUE, percent = TRUE, of = of) expect_equal_ignore_call(pROC:::roc.utils.unpercent.roc(r.percent), r) expect_equal_ignore_call(pROC:::roc.utils.topercent.roc(r), r.percent) } })pROC/tests/testthat/test-Ops.R0000644000176200001440000000103613607143106015721 0ustar liggesuserslibrary(pROC) data(aSAH) a.ndka <- auc(aSAH$outcome, aSAH$ndka) test_that("can convert auc to numeric", { expect_is(a.ndka, "auc") # a.ndka is not a numeric to start with expect_equal(as.numeric(a.ndka), 0.611957994579946) }) test_that("can do math on an AUC", { expect_equal(sqrt(a.ndka), 0.782277440924859) expect_equal(a.ndka * 2, 1.22391598915989) expect_equal(a.ndka / 0.5, 1.22391598915989) expect_equal(a.ndka + 5, 5.611957994579946) expect_equal(a.ndka - 1, -0.388042005420054) expect_equal(round(a.ndka, digits=1), 0.6) })pROC/tests/testthat/test-ci.thresholds.R0000644000176200001440000000551514114130125017726 0ustar liggesuserslibrary(pROC) data(aSAH) context("ci.thresholds") # Only test whether ci.thresholds runs and returns without error. # Uses a very small number of iterations for speed # Doesn't test whether the results are correct. # Silence progress bars options(pROCProgress = list(name = "none")) for (stratified in c(TRUE, FALSE)) { test_that("ci.threshold accepts thresholds=best", { n <- round(runif(1, 3, 9)) # keep boot.n small obtained <- ci.thresholds(r.wfns, thresholds="best", boot.n = n, boot.stratified = stratified, conf.level = .91) expect_is(obtained, "ci.thresholds") expect_is(obtained, "ci") expect_equal(names(obtained), c("specificity", "sensitivity")) expect_equal(dim(obtained$specificity), c(1, 3)) expect_equal(dim(obtained$sensitivity), c(1, 3)) expect_equal(attr(obtained, "conf.level"), .91) expect_equal(attr(obtained, "boot.n"), n) expect_equal(colnames(obtained$specificity), c("4.5%", "50%", "95.5%")) expect_equal(colnames(obtained$sensitivity), c("4.5%", "50%", "95.5%")) expect_equal(attr(obtained, "boot.stratified"), stratified) }) test_that("ci.threshold accepts thresholds=best", { n <- round(runif(1, 3, 9)) # keep boot.n small obtained <- ci.thresholds(r.ndka, thresholds = "local maximas", boot.n = n, boot.stratified = stratified, conf.level = .91) expected.thresholds <- coords(r.ndka, x = "l", ret = "t", transpose = FALSE)$threshold expect_is(obtained, "ci.thresholds") expect_is(obtained, "ci") expect_equal(names(obtained), c("specificity", "sensitivity")) expect_equal(dim(obtained$specificity), c(length(expected.thresholds), 3)) expect_equal(dim(obtained$sensitivity), c(length(expected.thresholds), 3)) expect_equal(attr(obtained, "conf.level"), .91) expect_equal(attr(obtained, "boot.n"), n) expect_equal(colnames(obtained$specificity), c("4.5%", "50%", "95.5%")) expect_equal(colnames(obtained$sensitivity), c("4.5%", "50%", "95.5%")) expect_equal(attr(obtained, "boot.stratified"), stratified) }) test_that("ci.threshold accepts numeric thresholds", { n <- round(runif(1, 3, 9)) # keep boot.n small obtained <- ci.thresholds(r.ndka, thresholds = c(0.5, 0.2), boot.n = n, boot.stratified = stratified, conf.level = .91) expected.thresholds <- coords(r.ndka, x = "l", ret = "t", transpose = FALSE)$threshold expect_is(obtained, "ci.thresholds") expect_is(obtained, "ci") expect_equal(names(obtained), c("specificity", "sensitivity")) expect_equal(dim(obtained$specificity), c(2, 3)) expect_equal(dim(obtained$sensitivity), c(2, 3)) expect_equal(attr(obtained, "conf.level"), .91) expect_equal(attr(obtained, "boot.n"), n) expect_equal(colnames(obtained$specificity), c("4.5%", "50%", "95.5%")) expect_equal(colnames(obtained$sensitivity), c("4.5%", "50%", "95.5%")) expect_equal(attr(obtained, "boot.stratified"), stratified) }) } pROC/tests/testthat/test-smooth.R0000644000176200001440000000751314114130125016466 0ustar liggesuserslibrary(pROC) data(aSAH) context("smooth") # Define some density functions unif.density <- function(x, n, from, to, bw, kernel, ...) { smooth.x <- seq(from = from, to = to, length.out = n) smooth.y <- dunif(smooth.x, min = min(x), max = max(x)) return(smooth.y) } norm.density <- function(x, n, from, to, bw, kernel, ...) { smooth.x <- seq(from = from, to = to, length.out = n) smooth.y <- dnorm(smooth.x, mean = mean(x), sd = sd(x)) return(smooth.y) } lnorm.density <- function(x, n, from, to, bw, kernel, ...) { smooth.x <- seq(from = from, to = to, length.out = n) smooth.y <- dlnorm(smooth.x, meanlog = mean(x), sdlog = sd(x)) return(smooth.y) } test_that("We fall back to the standard smooth", { tukey <- smooth(c(4, 1, 3, 6, 6, 4, 1, 6, 2, 4, 2)) expect_is(tukey, "tukeysmooth") expect_equal(as.numeric(tukey), c(3, 3, 3, 3, 4, 4, 4, 4, 2, 2, 2)) }) test_that("smooth with a density function works", { smoothed <- smooth(r.ndka, method="density", density = unif.density, n = 10) expect_is(smoothed, "smooth.roc") expect_equal(smoothed$sensitivities, c(1, 1, 1, 0.875, 0.75, 0.625, 0.5, 0.375, 0.25, 0.125, 0, 0)) expect_equal(smoothed$specificities, c(0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1)) expect_equal(as.numeric(smoothed$auc), 0.9375) }) test_that("smooth with two density functions works", { smoothed <- smooth(r.ndka, method="density", density.controls = norm.density, density.cases = lnorm.density, n = 10) expect_is(smoothed, "smooth.roc") expect_equal(smoothed$sensitivities, c(1, 1, 1, 0.635948942024884, 0.460070154191559, 0.344004532431686, 0.25735248652959, 0.188201024566009, 0.130658598389315, 0.0813814489619488, 0.0382893349015216, 0)) expect_equal(smoothed$specificities, c(0, 0, 0.832138478872629, 0.99999996787709, 1, 1, 1, 1, 1, 1, 1, 1)) expect_equal(as.numeric(smoothed$auc), 0.9694449) }) test_that("smooth with fitdistr works", { smoothed <- smooth(r.ndka, method="fitdistr", n = 10) expect_is(smoothed, "smooth.roc") expect_equal(smoothed$sensitivities, c(1, 1, 0.65584212882921, 0.303849532306639, 0.0922807400203477, 0.017547821937714, 0.00203415264061833, 0.000141550295211778, 5.86072275643637e-06, 1.43622216786009e-07, 2.05997195401133e-09, 0)) expect_equal(smoothed$specificities, c(0, 0, 0.961731211013412, 0.999999997253703, 1, 1, 1, 1, 1, 1, 1, 1)) expect_equal(as.numeric(smoothed$auc), 0.814600645965216) }) test_that("smooth with fitdistr different densities works", { smoothed <- smooth(r.ndka, method="fitdistr", density.controls="normal", density.cases="lognormal", n = 10) expect_is(smoothed, "smooth.roc") expect_equal(smoothed$sensitivities, c(1, 1, 0.174065394158716, 0.0241224684680268, 0.00565556180305715, 0.0017644346804079, 0.000654794610631603, 0.000269912354252342, 0.000116632088037343, 4.89426737202444e-05, 1.6544031070368e-05, 0)) expect_equal(smoothed$specificities, c(0, 0, 0.961731211013412, 0.999999997253703, 1, 1, 1, 1, 1, 1, 1, 1)) expect_equal(as.numeric(smoothed$auc), 0.568359871182632) }) test_that("smooth with fitdistr with a density function works", { smoothed <- smooth(r.ndka, method="fitdistr", n = 10, density.controls = dnorm, start.controls = list(mean = 10, sd = 10), density.cases = dlnorm, start = list(meanlog=2.7, sdlog=.822)) expect_is(smoothed, "smooth.roc") expect_equal(smoothed$sensitivities, c(1, 1, 0.174065542189585, 0.0241224212514905, 0.00565553823693818, 0.00176442417351747, 0.000654789746505889, 0.000269910020195159, 0.000116630962648119, 4.8942161699917e-05, 1.65438472509127e-05, 0)) expect_equal(smoothed$specificities, c(0, 0, 0.961730914432089, 0.999999997253745, 1, 1, 1, 1, 1, 1, 1, 1)) expect_equal(as.numeric(smoothed$auc), 0.568359799581078) }) pROC/tests/testthat/test-ci.sp.R0000644000176200001440000000264614114130125016173 0ustar liggesuserslibrary(pROC) data(aSAH) context("ci.sp") # Only test whether ci.sp runs and returns without error. # Uses a very small number of iterations for speed # Doesn't test whether the results are correct. # Silence progress bars options(pROCProgress = list(name = "none")) for (stratified in c(TRUE, FALSE)) { for (test.roc in list(r.s100b, smooth(r.s100b))) { test_that("ci.sp with default sensitivities", { n <- round(runif(1, 3, 9)) # keep boot.n small obtained <- ci.sp(test.roc, boot.n = n, boot.stratified = stratified, conf.level = .91) expect_is(obtained, "ci.sp") expect_is(obtained, "ci") expect_equal(dim(obtained), c(11, 3)) expect_equal(attr(obtained, "conf.level"), .91) expect_equal(attr(obtained, "boot.n"), n) expect_equal(colnames(obtained), c("4.5%", "50%", "95.5%")) expect_equal(attr(obtained, "boot.stratified"), stratified) }) test_that("ci.sp accepts one sensitivity", { n <- round(runif(1, 3, 9)) # keep boot.n small obtained <- ci.sp(test.roc, sensitivities = 0.9, boot.n = n, boot.stratified = stratified, conf.level = .91) expect_is(obtained, "ci.sp") expect_is(obtained, "ci") expect_equal(dim(obtained), c(1, 3)) expect_equal(attr(obtained, "conf.level"), .91) expect_equal(attr(obtained, "boot.n"), n) expect_equal(colnames(obtained), c("4.5%", "50%", "95.5%")) expect_equal(attr(obtained, "boot.stratified"), stratified) }) } } pROC/tests/testthat/test-coords.R0000644000176200001440000007340414114130125016450 0ustar liggesuserslibrary(pROC) data(aSAH) context("coords") test_that("coords with thresholds works", { return.rows <- c("threshold", "specificity", "sensitivity", "accuracy", "tn", "tp", "fn", "fp", "npv", "ppv", "1-specificity", "1-sensitivity", "1-accuracy", "1-npv", "1-ppv", "youden", "closest.topleft") obtained <- coords(r.s100b, "all", ret = return.rows, transpose=TRUE) expect_equal(obtained, expected.coords[return.rows,]) }) test_that("coords returns all thresholds by default", { obtained <- coords(r.s100b, transpose=TRUE) expect_equal(obtained, expected.coords[c("threshold", "specificity", "sensitivity"),]) # but not if it's an empty numeric, as this might be indicative of user error expect_error(coords(r.s100b, numeric(0)), "length") }) test_that("coords returns all thresholds by default with smooth.roc", { obtained <- coords(smooth(r.s100b)) expect_equal(obtained, expected.coords.smooth[,c("specificity", "sensitivity")]) # but not if it's an empty numeric, as this might be indicative of user error expect_error(coords(r.s100b, numeric(0)), "length") }) test_that("coords returns all columns with ret = 'all' with smooth.roc", { obtained <- coords(smooth(r.s100b), ret = "all") expect_equal(obtained, expected.coords.smooth) }) test_that("coords with transpose = FALSE works", { return.rows <- c("threshold", "specificity", "sensitivity", "accuracy", "tn", "tp", "fn", "fp", "npv", "ppv", "1-specificity", "1-sensitivity", "1-accuracy", "1-npv", "1-ppv", "youden", "closest.topleft") obtained <- coords(r.s100b, "all", ret = return.rows, transpose = FALSE) expect_equal(obtained, as.data.frame(t(expected.coords[return.rows,]))) obtained <- coords(r.s100b, transpose = FALSE) expect_equal(obtained, as.data.frame(t(expected.coords[c("threshold", "specificity", "sensitivity"),]))) # With drop=TRUE obtained <- coords(r.s100b, "all", ret = "se", transpose = FALSE, drop=TRUE) expect_is(obtained, "numeric") # Not why drop.data.frame returns a list, skipping # obtained <- coords(r.s100b, "best", ret = "all", transpose = FALSE, drop=TRUE) # With drop=FALSE obtained <- coords(r.s100b, "all", ret = "se", transpose = FALSE, drop=FALSE) expect_is(obtained, "data.frame") }) test_that("coords with ret='all' works", { obtained <- coords(r.s100b, "all", ret = "all", transpose=TRUE) expect_equal(dim(obtained), c(24, 51)) expect_equal(obtained[rownames(expected.coords),], expected.coords) }) test_that("coords with ret='all' doesn't accept additional options", { expect_error(coords(r.s100b, "all", ret = c("all", "thresholds"))) }) test_that("coords with percent works", { return.rows <- "all" percent.rows <- c("specificity", "sensitivity", "accuracy", "npv", "ppv", "1-specificity", "1-sensitivity", "1-accuracy", "1-npv", "1-ppv", "youden", "closest.topleft", "fdr", "fpr", "tpr", "tnr", "fnr", "precision", "recall") obtained.percent <- coords(r.s100b.percent, "all", ret = return.rows, transpose=TRUE) # Adjust for percent obtained.percent[percent.rows,] <- obtained.percent[percent.rows,] / 100 expect_equal(obtained.percent, expected.coords) }) test_that("coords with local maximas thresholds works", { return.rows <- "all" obtained <- coords(r.s100b, "local maximas", ret = return.rows, transpose=TRUE) expected.thresholds <- c(-Inf, 0.065, 0.075, 0.085, 0.095, 0.105, 0.115, 0.135, 0.155, 0.205, 0.245, 0.29, 0.325, 0.345, 0.395, 0.435, 0.475, 0.485, 0.51) expect_equal(as.vector(obtained["threshold",]), expected.thresholds) expect_equivalent(obtained, expected.coords[,expected.coords["threshold",] %in% expected.thresholds]) }) test_that("coords with best threshold works", { return.rows <- "all" obtained <- coords(r.s100b, "best", ret = return.rows, transpose=TRUE) expect_equal(obtained, expected.coords[,expected.coords["threshold",] == 0.205]) }) test_that("coords with arbitrary thresholds works", { return.rows <- c("threshold", "specificity", "sensitivity", "accuracy", "tn", "tp", "fn", "fp", "npv", "ppv", "1-specificity", "1-sensitivity", "1-accuracy", "1-npv", "1-ppv", "youden", "closest.topleft") obtained <- coords(r.s100b, c(0.205, 0.055), input = "threshold", ret = return.rows, transpose=TRUE) expect_equivalent(obtained, expected.coords[return.rows, c(18, 4)]) }) test_that("coords with arbitrary thresholds at exact data point works", { return.rows <- "all" expect_equal(sum(aSAH$s100b == 0.05), 3) expect_equal(sum(aSAH$s100b == 0.52), 1) obtained <- coords(r.s100b, c(0.05, 0.52), input = "threshold", ret = return.rows, transpose=TRUE) expect_equivalent(obtained[-1,], expected.coords[-1, c(3, 40)]) }) test_that("coords with arbitrary thresholds works with direction=>", { obtained <- coords(r.100b.reversed, c(0.05, 0.055, 0.205, 0.52), input = "threshold", ret = c("threshold", "specificity", "sensitivity", "accuracy", "tn", "tp", "fn", "fp", "npv", "ppv", "1-specificity", "1-sensitivity", "1-accuracy", "1-npv", "1-ppv"), transpose=TRUE) expect_equivalent(obtained, expected.coords.reverse) }) test_that("coords with single arbitrary threshold works", { return.rows <- "all" obtained <- coords(r.s100b, c(0.205), input = "threshold", ret = return.rows, transpose=TRUE) expect_equal(obtained, expected.coords[, c(18), drop=T]) }) test_that("coords with arbitrary thresholds at exact data point works", { expect_equal(sum(aSAH$s100b == 0.05), 3) expect_equal(sum(aSAH$s100b == 0.52), 1) obtained <- coords(r.s100b, c(0.05), input = "threshold", ret = "all", transpose=TRUE) expect_equal(obtained[-1], expected.coords[-1, 3]) obtained <- coords(r.s100b, c(0.52), input = "threshold", ret = "all", transpose=TRUE) expect_equal(obtained[-1], expected.coords[-1, 40]) }) test_that("coords with arbitrary thresholds works with direction=>", { obtained <- coords(r.100b.reversed, c(0.05), input = "threshold", ret = c("threshold", "specificity", "sensitivity", "accuracy", "tn", "tp", "fn", "fp", "npv", "ppv", "1-specificity", "1-sensitivity", "1-accuracy", "1-npv", "1-ppv"), transpose=TRUE) expect_equal(obtained, expected.coords.reverse[, 1]) obtained <- coords(r.100b.reversed, c(0.055), input = "threshold", ret = c("threshold", "specificity", "sensitivity", "accuracy", "tn", "tp", "fn", "fp", "npv", "ppv", "1-specificity", "1-sensitivity", "1-accuracy", "1-npv", "1-ppv"), transpose=TRUE) expect_equal(obtained, expected.coords.reverse[, 2]) obtained <- coords(r.100b.reversed, c(0.205), input = "threshold", ret = c("threshold", "specificity", "sensitivity", "accuracy", "tn", "tp", "fn", "fp", "npv", "ppv", "1-specificity", "1-sensitivity", "1-accuracy", "1-npv", "1-ppv"), transpose=TRUE) expect_equal(obtained, expected.coords.reverse[, 3]) obtained <- coords(r.100b.reversed, c(0.52), input = "threshold", ret = c("threshold", "specificity", "sensitivity", "accuracy", "tn", "tp", "fn", "fp", "npv", "ppv", "1-specificity", "1-sensitivity", "1-accuracy", "1-npv", "1-ppv"), transpose=TRUE) expect_equal(obtained, expected.coords.reverse[, 4]) }) test_that("coords with sensitivity works", { obtained <- coords(r.s100b, seq(0, 1, .1), input = "sensitivity", ret = c("threshold", "specificity", "sensitivity"), transpose=TRUE) expect_equal(unname(obtained["threshold",]), c(Inf, rep(NA, 9), -Inf)) expect_equal(unname(obtained["sensitivity",]), seq(0, 1, .1)) expect_equal(unname(obtained["specificity",]), c(1, 1, 1, 0.972222222222222, 0.888888888888889, 0.833333333333333, 0.805555555555556, 0.56875, 0.447222222222222, 0.230555555555556, 0)) }) test_that("coords with sensitivity works with percent", { obtained <- coords(r.s100b.percent, seq(0, 100, 10), input = "sensitivity", ret = c("threshold", "specificity", "sensitivity"), transpose=TRUE) expect_equal(unname(obtained["threshold",]), c(Inf, rep(NA, 9), -Inf)) expect_equal(unname(obtained["sensitivity",]), seq(0, 100, 10)) expect_equal(unname(obtained["specificity",]), c(1, 1, 1, 0.972222222222222, 0.888888888888889, 0.833333333333333, 0.805555555555556, 0.56875, 0.447222222222222, 0.230555555555556, 0) * 100) }) test_that("coords with specificity works", { obtained <- coords(r.s100b, seq(0, 1, .1), input = "specificity", ret = c("threshold", "specificity", "sensitivity"), transpose=TRUE) expect_equal(unname(obtained["threshold",]), c(-Inf, rep(NA, 9), 0.51)) expect_equal(unname(obtained["specificity",]), seq(0, 1, .1)) expect_equal(unname(obtained["sensitivity",]), c(1, 0.975609756097561, 0.921951219512195, 0.879674796747967, 0.823693379790941, 0.774390243902439, 0.675609756097561, 0.655284552845528, 0.634146341463415, 0.390243902439024, 0.292682926829268)) }) test_that("coords with specificity works with percent", { obtained <- coords(r.s100b.percent, seq(0, 100, 10), input = "specificity", ret = c("threshold", "specificity", "sensitivity"), transpose=TRUE) expect_equal(unname(obtained["threshold",]), c(-Inf, rep(NA, 9), 0.51)) expect_equal(unname(obtained["specificity",]), seq(0, 100, 10)) expect_equal(unname(obtained["sensitivity",]), c(1, 0.975609756097561, 0.921951219512195, 0.879674796747967, 0.823693379790941, 0.774390243902439, 0.675609756097561, 0.655284552845528, 0.634146341463415, 0.390243902439024, 0.292682926829268) * 100) }) test_that("coords with specificity works with as.list", { obtained <- coords(r.s100b.percent, "best", ret = c("threshold", "specificity", "accuracy"), as.list = TRUE) expect_equal(obtained, list( threshold = 0.205, specificity = unname(expected.coords["specificity", 18]) * 100, accuracy = unname(expected.coords["accuracy", 18]) * 100 )) }) test_that("coords with specificity works with as.list and drop=FALSE", { obtained <- coords(r.s100b.percent, "best", ret = c("threshold", "specificity", "accuracy"), as.list = TRUE, drop = FALSE) expect_equal(obtained[[1]], list( threshold = 0.205, specificity = unname(expected.coords["specificity", 18]) * 100, accuracy = unname(expected.coords["accuracy", 18]) * 100 )) }) test_that("coords with specificity works with as.list and several thresholds", { obtained <- coords(r.s100b.percent, c(0.205, 0.51), ret = c("threshold", "specificity", "accuracy"), as.list = TRUE, drop = FALSE) expect_equal(obtained[[1]], list( threshold = 0.205, specificity = unname(expected.coords["specificity", 18]) * 100, accuracy = unname(expected.coords["accuracy", 18]) * 100 )) expect_equal(obtained[[2]], list( threshold = 0.51, specificity = unname(expected.coords["specificity", 40]) * 100, accuracy = unname(expected.coords["accuracy", 40]) * 100 )) }) test_that("drop works", { # First make sure we get matrices with drop = FALSE expect_is(coords(r.s100b, 0.51, input = "threshold", ret = c("sensitivity", "specificity"), drop = FALSE, transpose=TRUE), "matrix") expect_is(coords(r.s100b, 0.51, input = "threshold", ret = "specificity", drop = FALSE, transpose=TRUE), "matrix") expect_is(coords(r.s100b, "local maximas", input = "threshold", ret = "specificity", drop = FALSE, transpose=TRUE), "matrix") expect_is(coords(r.s100b, c(0.51, 0.2), input = "threshold", ret = "specificity", drop = FALSE, transpose=TRUE), "matrix") # Look for numeric expect_is(coords(r.s100b, 0.51, input = "threshold", ret = c("sensitivity", "specificity"), drop = TRUE, transpose=TRUE), "numeric") expect_is(coords(r.s100b, 0.51, input = "threshold", ret = "specificity", drop = TRUE, transpose=TRUE), "numeric") expect_is(coords(r.s100b, "local maximas", input = "threshold", ret = "specificity", drop = TRUE, transpose=TRUE), "numeric") expect_is(coords(r.s100b, c(0.51, 0.2), input = "threshold", ret = "specificity", drop = TRUE, transpose=TRUE), "numeric") }) test_that("as.matrix works", { obtained <- coords(r.s100b, c(0.51, 0.205), ret="sensitivity", transpose = FALSE, as.matrix = TRUE) expect_equal(obtained, t(expected.coords["sensitivity", c(40, 18), drop = FALSE])) }) test_that("as.matrix works with drop=TRUE", { obtained <- coords(r.s100b, c(0.51, 0.205), ret="sensitivity", transpose = FALSE, as.matrix = TRUE, drop = TRUE) expect_equal(obtained, expected.coords["sensitivity", c(40, 18), drop = TRUE]) }) test_that("coords returns the correct basic values ", { obtained <- coords(r.s100b, 0.205, ret = c("t", "tp", "fp", "tn", "fn", "sp", "se", "acc", "npv", "ppv", "precision", "recall", "tpr", "fpr", "tnr", "fnr", "fdr"), transpose=TRUE) obtained.percent <- coords(r.s100b.percent, 0.205, ret = c("t", "tp", "fp", "tn", "fn", "sp", "se", "acc", "npv", "ppv", "precision", "recall", "tpr", "fpr", "tnr", "fnr", "fdr"), transpose=TRUE) # We assume the following values: # tp fp tn fn N # 26 14 58 15 113 expected <- c( threshold = 0.205, tp = 26, fp = 14, tn = 58, fn = 15, specificity = 58 / (58 + 14), sensitivity = 26 / (26 + 15), accuracy = (26 + 58) / 113, npv = 58 / (58 + 15), ppv = 26 / (26 + 14), precision = 26 / (26 + 14), recall = 26 / (26 + 15), tpr = 26 / (26 + 15), fpr = 1 - (58 / (58 + 14)), tnr = 58 / (58 + 14), fnr = 1 - (26 / (26 + 15)), fdr = 14 / (26 + 14) ) expect_equal(obtained, expected) expect_equal(obtained.percent[1:5], expected[1:5]) expect_equal(obtained.percent[6:17], expected[6:17]*100) }) test_that("coords works with smooth.roc and x = 'best'", { smooth.s100b <- smooth(r.s100b) expect <- structure(c(0.750857175922901, 0.608610567514677, 0.699245574642041, 54.0617166664488, 24.9530332681018, 16.0469667318982, 17.9382833335512, 0.771112992655678, 0.581773544045047, 0.418226455954953, 0.249142824077099, 0.608610567514677, 0.750857175922901, 0.391389432485323, 0.249142824077099, 0.391389432485323, 0.300754425357959, 0.228887007344322, 0.418226455954953, 0.581773544045047, 0.608610567514677, 1.35946774343758, 0.215257834650296 ), .Dim = c(23L, 1L), .Dimnames = list(c("specificity", "sensitivity", "accuracy", "tn", "tp", "fn", "fp", "npv", "ppv", "fdr", "fpr", "tpr", "tnr", "fnr", "1-specificity", "1-sensitivity", "1-accuracy", "1-npv", "1-ppv", "precision", "recall", "youden", "closest.topleft" ), NULL)) reduced.cols <- c("specificity", "sensitivity", "youden") obtained <- coords(smooth.s100b, "best", ret = reduced.cols, transpose=TRUE) expect_equal(obtained, expect[reduced.cols,]) obtained <- coords(smooth.s100b, "best", ret = reduced.cols, drop = FALSE, transpose=TRUE) expect_equal(obtained, expect[reduced.cols,, drop=FALSE]) obtained <- coords(smooth.s100b, "best", ret = "all", drop = FALSE, transpose=TRUE) expect_equal(obtained, expect) obtained <- coords(smooth.s100b, "best", ret = "all", transpose=TRUE) expect_equal(obtained, expect[, 1]) obtained <- coords(smooth.s100b, "best", ret = "all", drop = FALSE, transpose=TRUE) expect_equal(obtained, expect) obtained <- coords(smooth.s100b, "best", ret = "all", as.list = TRUE) expect_equal(obtained, as.list(expect[, 1])) expect_equal(names(obtained), rownames(expect)) obtained <- coords(smooth.s100b, "best", ret = "all", as.list = TRUE, drop = FALSE) expect_equal(obtained[[1]], as.list(expect[, 1])) # names expect_equal(names(obtained[[1]]), rownames(expect)) obtained <- coords(smooth.s100b, "best", ret = reduced.cols, as.list = TRUE) expect_equal(obtained, as.list(expect[reduced.cols, 1])) expect_equal(names(obtained), reduced.cols) obtained <- coords(smooth.s100b, "best", ret = reduced.cols, as.list = TRUE, drop = FALSE) expect_equal(obtained[[1]], as.list(expect[reduced.cols, 1])) # names expect_equal(names(obtained[[1]]), reduced.cols) }) test_that("coords works with smooth.roc and transpose = FALSE", { smooth.s100b <- smooth(r.s100b) expect <- structure(c(0.750857175922901, 0.608610567514677, 0.699245574642041, 54.0617166664488, 24.9530332681018, 16.0469667318982, 17.9382833335512, 0.771112992655678, 0.581773544045047, 0.418226455954953, 0.249142824077099, 0.608610567514677, 0.750857175922901, 0.391389432485323, 0.249142824077099, 0.391389432485323, 0.300754425357959, 0.228887007344322, 0.418226455954953, 0.581773544045047, 0.608610567514677, 1.35946774343758, 0.215257834650296 ), .Dim = c(23L, 1L), .Dimnames = list(c("specificity", "sensitivity", "accuracy", "tn", "tp", "fn", "fp", "npv", "ppv", "fdr", "fpr", "tpr", "tnr", "fnr", "1-specificity", "1-sensitivity", "1-accuracy", "1-npv", "1-ppv", "precision", "recall", "youden", "closest.topleft" ), NULL)) reduced.cols <- c("specificity", "sensitivity", "youden") obtained <- coords(smooth.s100b, "best", ret = reduced.cols, drop = FALSE, transpose = FALSE) expect_equal(obtained, as.data.frame(t(expect[reduced.cols,, drop=FALSE]))) obtained <- coords(smooth.s100b, "best", ret = "all", drop = FALSE, transpose = FALSE) expect_equal(obtained, as.data.frame(t(expect))) # Without drop obtained <- coords(smooth.s100b, "best", ret = reduced.cols, transpose = FALSE) expect_equivalent(obtained, as.data.frame(t(expect[reduced.cols,]))) # drop = TRUE obtained <- coords(smooth.s100b, "best", ret = reduced.cols, drop = TRUE, transpose = FALSE) expect_equal(obtained, as.list(expect[reduced.cols,])) # With as.matrix obtained <- coords(smooth.s100b, "best", ret = reduced.cols, transpose = FALSE, as.matrix = TRUE) expect_equal(obtained, t(expect[reduced.cols,, drop=FALSE])) # With matrix and drop = TRUE obtained <- coords(smooth.s100b, "best", ret = reduced.cols, transpose = FALSE, as.matrix = TRUE, drop = TRUE) expect_equal(obtained, expect[reduced.cols,]) # Default drop with numeric obtained <- coords(smooth.s100b, c(0.2, 0.5), input = "specificity", ret="se") expect_is(obtained, "data.frame") # With numeric x obtained <- coords(smooth.s100b, c(0.2, 0.5, 0.6), input = "specificity", transpose = FALSE) expect_is(obtained, "data.frame") expect_equal(dim(obtained), c(3, 2)) }) test_that("coords works with smooth.roc and x = numeric", { smooth.s100b <- smooth(r.s100b) expect <- structure(c(0.5, 0.797749392103789, 0.608032965276596, 36, 32.7077250762554, 8.29227492374464, 36, 0.812782817364406, 0.476041450069183, 0.523958549930817, 0.5, 0.797749392103789, 0.5, 0.202250607896211, 0.5, 0.202250607896211, 0.391967034723404, 0.187217182635594, 0.523958549930817, 0.476041450069183, 0.797749392103789, 1.29774939210379, 0.290905308394387, 0.9, 0.412071871553968, 0.722964130386838, 64.8, 16.8949467337127, 24.1050532662873, 7.2, 0.728867456002887, 0.701182157421994, 0.298817842578006, 0.1, 0.412071871553968, 0.9, 0.587928128446032, 0.1, 0.587928128446032, 0.277035869613162, 0.271132543997113, 0.298817842578006, 0.701182157421994, 0.412071871553968, 1.31207187155397, 0.355659484218054), .Dim = c(23L, 2L), .Dimnames = list(c("specificity", "sensitivity", "accuracy", "tn", "tp", "fn", "fp", "npv", "ppv", "fdr", "fpr", "tpr", "tnr", "fnr", "1-specificity", "1-sensitivity", "1-accuracy", "1-npv", "1-ppv", "precision", "recall", "youden", "closest.topleft"), NULL)) reduced.cols <- c("specificity", "sensitivity", "youden") obtained <- coords(smooth.s100b, c(0.5, 0.9), input = "sp", ret="all", transpose=TRUE) expect_equal(obtained, expect) obtained <- coords(smooth.s100b, c(0.5, 0.9), input = "spe", ret=reduced.cols, transpose=TRUE) expect_equal(obtained, expect[reduced.cols,]) obtained <- coords(smooth.s100b, 0.9, input = "specificity", ret="all", drop = TRUE, transpose=TRUE) expect_equal(obtained, expect[, 2]) obtained <- coords(smooth.s100b, 0.9, input = "specificity", ret=reduced.cols, drop = TRUE, transpose=TRUE) expect_equal(obtained, expect[reduced.cols, 2]) obtained <- coords(smooth.s100b, 0.9, input = "specificity", ret="all", drop = FALSE, transpose=TRUE) expect_equal(obtained, expect[, 2, drop=FALSE]) obtained <- coords(smooth.s100b, 0.9, input = "specificity", ret=reduced.cols, drop = FALSE, transpose=TRUE) expect_equal(obtained, expect[reduced.cols, 2, drop=FALSE]) obtained <- coords(smooth.s100b, c(0.5, 0.9), input = "specificity", ret="all", as.list = TRUE, drop = TRUE) expect_equal(obtained[[1]], as.list(expect[, 1])) expect_equal(obtained[[2]], as.list(expect[, 2])) obtained <- coords(smooth.s100b, c(0.5, 0.9), input = "specificity", ret=reduced.cols, as.list = TRUE, drop = TRUE) expect_equal(obtained[[1]], as.list(expect[reduced.cols, 1])) expect_equal(obtained[[2]], as.list(expect[reduced.cols, 2])) obtained <- coords(smooth.s100b, 0.9, input = "specificity", ret="all", as.list = TRUE, drop = TRUE) expect_equal(obtained, as.list(expect[, 2])) obtained <- coords(smooth.s100b, 0.9, input = "specificity", ret=reduced.cols, as.list = TRUE, drop = TRUE) expect_equal(obtained, as.list(expect[reduced.cols, 2])) obtained <- coords(smooth.s100b, 0.9, input = "specificity", ret="all", as.list = TRUE, drop = FALSE) expect_equal(obtained[[1]], as.list(expect[, 2])) obtained <- coords(smooth.s100b, 0.9, input = "specificity", ret=reduced.cols, as.list = TRUE, drop = FALSE) expect_equal(obtained[[1]], as.list(expect[reduced.cols, 2])) }) test_that("coords works with smooth.roc and x = numeric and input = 'se'", { smooth.s100b <- smooth(r.s100b) expect <- structure(c(0.844189345484777, 0.5, 0.719306485618619, 60.781632874904, 20.5, 20.5, 11.218367125096, 0.747790499834687, 0.646313220322748, 0.353686779677252, 0.155810654515223, 0.5, 0.844189345484777, 0.5, 0.155810654515223, 0.5, 0.280693514381381, 0.252209500165313, 0.353686779677252, 0.646313220322748, 0.5, 1.34418934548478, 0.274276960060462, 0.293322024198721, 0.9, 0.513444121613345, 21.1191857423079, 36.9, 4.1, 50.8808142576921, 0.837425361710953, 0.420365205222125, 0.579634794777875, 0.706677975801279, 0.9, 0.293322024198721, 0.1, 0.706677975801279, 0.1, 0.486555878386655, 0.162574638289047, 0.579634794777875, 0.420365205222125, 0.9, 1.19332202419872, 0.509393761482593), .Dim = c(23L, 2L), .Dimnames = list( c("specificity", "sensitivity", "accuracy", "tn", "tp", "fn", "fp", "npv", "ppv", "fdr", "fpr", "tpr", "tnr", "fnr", "1-specificity", "1-sensitivity", "1-accuracy", "1-npv", "1-ppv", "precision", "recall", "youden", "closest.topleft"), NULL)) reduced.cols <- c("specificity", "sensitivity", "youden") obtained <- coords(smooth.s100b, c(0.5, 0.9), input = "se", ret="all", transpose=TRUE) expect_equal(obtained, expect) obtained <- coords(smooth.s100b, c(0.5, 0.9), input = "se", ret=reduced.cols, transpose=TRUE) expect_equal(obtained, expect[reduced.cols,]) obtained <- coords(smooth.s100b, 0.9, input = "se", ret="all", drop = TRUE, transpose=TRUE) expect_equal(obtained, expect[, 2]) obtained <- coords(smooth.s100b, 0.9, input = "se", ret=reduced.cols, drop = TRUE, transpose=TRUE) expect_equal(obtained, expect[reduced.cols, 2]) obtained <- coords(smooth.s100b, 0.9, input = "se", ret="all", drop = FALSE, transpose=TRUE) expect_equal(obtained, expect[, 2, drop=FALSE]) obtained <- coords(smooth.s100b, 0.9, input = "se", ret=reduced.cols, drop = FALSE, transpose=TRUE) expect_equal(obtained, expect[reduced.cols, 2, drop=FALSE]) obtained <- coords(smooth.s100b, c(0.5, 0.9), input = "se", ret="all", as.list = TRUE, drop = TRUE) expect_equal(obtained[[1]], as.list(expect[, 1])) expect_equal(obtained[[2]], as.list(expect[, 2])) obtained <- coords(smooth.s100b, c(0.5, 0.9), input = "se", ret=reduced.cols, as.list = TRUE, drop = TRUE) expect_equal(obtained[[1]], as.list(expect[reduced.cols, 1])) expect_equal(obtained[[2]], as.list(expect[reduced.cols, 2])) obtained <- coords(smooth.s100b, 0.9, input = "se", ret="all", as.list = TRUE, drop = TRUE) expect_equal(obtained, as.list(expect[, 2])) obtained <- coords(smooth.s100b, 0.9, input = "se", ret=reduced.cols, as.list = TRUE, drop = TRUE) expect_equal(obtained, as.list(expect[reduced.cols, 2])) obtained <- coords(smooth.s100b, 0.9, input = "se", ret="all", as.list = TRUE, drop = FALSE) expect_equal(obtained[[1]], as.list(expect[, 2])) obtained <- coords(smooth.s100b, 0.9, input = "se", ret=reduced.cols, as.list = TRUE, drop = FALSE) expect_equal(obtained[[1]], as.list(expect[reduced.cols, 2])) }) test_that("coords with x = 'best' takes partial AUC into account", { # with sp obtained <- coords(r.s100b.partial1, "b", ret="t", transpose=TRUE) expect_equal(unname(obtained), 0.475) # with se obtained <- coords(r.s100b.partial2, "b", ret="t", transpose=TRUE) expect_equal(unname(obtained), 0.075) }) test_that("coords with x = 'best' takes partial AUC into account with smooth.roc", { # with sp obtained <- coords(smooth(r.s100b.partial1), "b", ret="sp", transpose=TRUE) expect_equal(unname(obtained), 0.900608847772859) obtained <- coords(smooth(r.s100b.partial1), "b", ret=c("se", "se", "youden"), transpose=TRUE) expect_equal(as.vector(obtained), c(0.410958904109589, 0.410958904109589, 1.311567751882448)) # with se obtained <- coords(smooth(r.s100b.partial2), "b", ret="se", transpose=TRUE) expect_equal(unname(obtained), 0.900195694716243) obtained <- coords(smooth(r.s100b.partial2), "b", ret=c("se", "se", "youden"), transpose=TRUE) expect_equal(as.vector(obtained), c(0.900195694716243, 0.900195694716243, 1.193053239288330)) }) test_that("coords with x = 'all' takes partial AUC into account", { # with sp obtained <- coords(r.s100b.partial1, "all", ret="t", transpose=TRUE) expect_equal(length(obtained), 7) expect_equal(min(obtained), 0.435) # with se obtained <- coords(r.s100b.partial2, "all", ret="t", transpose=TRUE) expect_equal(length(obtained), 5) expect_equal(max(obtained), 0.075) }) test_that("coords with x = 'all' takes partial AUC into account with smooth.roc", { # with sp obtained <- coords(smooth(r.s100b.partial1), "all", ret="sp", transpose=TRUE) expect_equal(length(obtained), 139) expect_equal(min(obtained), 0.90060885) # with se obtained <- coords(smooth(r.s100b.partial2), "all", ret="se", transpose=TRUE) expect_equal(length(obtained), 46) expect_equal(min(obtained), 0.90019569) }) test_that("coords with x = 'local maximas' takes partial AUC into account", { # with sp obtained <- coords(r.s100b.partial1, "local maximas", ret="t", transpose=TRUE) expect_equal(unname(obtained), c(0.435, 0.475, 0.485)) # with se obtained <- coords(r.s100b.partial2, "local maximas", ret="t", transpose=TRUE) expect_equal(unname(obtained), c(0.065, 0.075)) }) test_that("invalid best.weights", { expect_error(coords(r.s100b, "best", best.weights = 1, transpose=FALSE)) expect_error(coords(r.s100b, "best", best.weights = 0:1, transpose=FALSE)) expect_error(coords(r.s100b, "best", best.weights = c(0.1, 0.9), transpose=FALSE), NA) expect_error(coords(r.s100b, "best", best.weights = 1:3, transpose=FALSE)) # with smooth expect_error(coords(smooth(r.s100b), "best", best.weights = 1, transpose=FALSE)) expect_error(coords(smooth(r.s100b), "best", best.weights = 0:1, transpose=FALSE)) expect_error(coords(smooth(r.s100b), "best", best.weights = c(0.1, 0.9), transpose=FALSE), NA) expect_error(coords(smooth(r.s100b), "best", best.weights = 1:3, transpose=FALSE)) }) test_that("invalid best.method", { expect_error(coords(r.s100b, "best", best.method = 1, transpose=FALSE)) expect_error(coords(r.s100b, "best", best.method = "1", transpose=FALSE)) # with smooth expect_error(coords(smooth(r.s100b), "best", best.method = 1, transpose=FALSE)) expect_error(coords(smooth(r.s100b), "best", best.method = "1", transpose=FALSE)) }) test_that("invalid se/sp", { smooth.s100b <- smooth(r.s100b) for (inp in c("sens", "spec")) { for (r in list(r.s100b, smooth.s100b)) { expect_error(coords(r, x=-2, input=inp, transpose=FALSE)) expect_error(coords(r, x=0, input=inp, transpose=FALSE), NA) expect_error(coords(r, x=1, input=inp, transpose=FALSE), NA) expect_error(coords(r, x=10, input=inp, transpose=FALSE)) } } smooth.s100b.percent <- smooth(r.s100b.percent) for (inp in c("sens", "spec")) { for (r in list(r.s100b.percent, smooth.s100b.percent)) { expect_error(coords(r.s100b.percent, x=-2, input=inp, transpose=FALSE)) expect_error(coords(r.s100b.percent, x=0, input=inp, transpose=FALSE), NA) expect_error(coords(r.s100b.percent, x=10, input=inp, transpose=FALSE), NA) expect_error(coords(r.s100b.percent, x=100, input=inp, transpose=FALSE), NA) expect_error(coords(r.s100b.percent, x=101, input=inp, transpose=FALSE)) } } }) test_that("invalid x", { expect_error(coords(r.s100b.percent, x=list(1), transpose=FALSE)) expect_error(coords(r.s100b, x=aSAH, transpose=FALSE)) expect_error(coords(smooth(r.s100b), x=mean, transpose=FALSE)) # character but invalid expect_error(coords(smooth(r.s100b), x="c", transpose=FALSE)) expect_error(coords(r.s100b, x="c", transpose=FALSE)) }) test_that("Infinite values work with both directions", { # direction = > Data <- structure(list(Outcome = c(1L, 1L, 0L, 0L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 0L, 1L, 1L, 1L, 1L, 0L, 1L, 1L, 1L, 1L, 0L, 1L, 1L, 0L, 1L, 0L, 1L, 1L, 1L, 1L), Value = c(72L, 65L, 271L, 73L, 87L, 114L, 111L, 47L, 88L, 44L, 121L, 207L, 33L, 138L, 284L, 62L, 120L, 116L, 202L, 172L, 117L, 69L, 102L, 150L, 131L, 77L, 124L, 46L, 579L, 117L, 96L, 83L, 102L)), class = "data.frame", row.names = c(NA, -33L)) ROC <- roc(Outcome~Value, data=Data, ci=TRUE, direction=">") co <- coords(ROC, x=c(-Inf, Inf), transpose = FALSE) expect_equivalent(co, data.frame(threshold = c(-Inf, Inf), specificity = c(1, 0), sensitivity = c(0, 1))) # direction = < co <- coords(r.s100b, x=c(-Inf, Inf), transpose = FALSE) expect_equivalent(co, data.frame(threshold = c(-Inf, Inf), specificity = c(0, 1), sensitivity = c(1, 0))) }) test_that("Coords pick the right end of 'flat' bits of the curve, according to direction", { # expect_equal(r.s100b$sensitivities[2], 0.975609756097561) # tested elsewhere expect_equivalent( coords(r.s100b, 0.975609756097561, "se", "sp", transpose = TRUE), 0.13888888888888889 # and not 0 ) expect_equivalent( coords(r.s100b, 1, "sp", "se", transpose = TRUE), 0.2926829268292683 # and not 0 ) }) pROC/tests/testthat/helper-deLongPlacementsCpp-expected.R0000644000176200001440000003147013607143106023153 0ustar liggesusersexpected.placements <- list( "ndka" = list( "forward" = structure(list(theta = 0.611957994579946, X = c(0.805555555555556, 0.625, 0.680555555555556, 0.763888888888889, 0.0416666666666667, 0.277777777777778, 0.513888888888889, 0.930555555555556, 0.972222222222222, 0.930555555555556, 0.930555555555556, 0.402777777777778, 0.722222222222222, 0.861111111111111, 0.166666666666667, 0.25, 0.708333333333333, 0.0138888888888889, 1, 0.861111111111111, 0.430555555555556, 0.513888888888889, 0.555555555555556, 0.708333333333333, 0.888888888888889, 0.645833333333333, 0.861111111111111, 0.25, 0.986111111111111, 0.756944444444444, 0.0416666666666667, 0.340277777777778, 0.861111111111111, 0.0416666666666667, 0.333333333333333, 0.930555555555556, 0.527777777777778, 0.722222222222222, 0.958333333333333, 0.513888888888889, 0.763888888888889 ), Y = c(1, 0.829268292682927, 0.878048780487805, 0.707317073170732, 0.902439024390244, 0.402439024390244, 0.902439024390244, 0.317073170731707, 0.51219512195122, 0.317073170731707, 0.341463414634146, 0.0731707317073171, 0.804878048780488, 0.902439024390244, 0.585365853658537, 0.902439024390244, 0.902439024390244, 0.024390243902439, 0.560975609756098, 0.75609756097561, 0.75609756097561, 0.317073170731707, 0.975609756097561, 0.878048780487805, 0.902439024390244, 0.768292682926829, 0.536585365853659, 0.878048780487805, 0.414634146341463, 0.0975609756097561, 0.878048780487805, 0.902439024390244, 0.585365853658537, 0.804878048780488, 0.878048780487805, 0.536585365853659, 0.195121951219512, 0.219512195121951, 0.731707317073171, 0.609756097560976, 0.0487804878048781, 0.902439024390244, 0.341463414634146, 0.75609756097561, 0.707317073170732, 0.707317073170732, 0.414634146341463, 0.975609756097561, 0.341463414634146, 0.585365853658537, 0.804878048780488, 0.707317073170732, 0.317073170731707, 0.707317073170732, 0.609756097560976, 0.878048780487805, 0.75609756097561, 0.707317073170732, 0.195121951219512, 0.829268292682927, 0.585365853658537, 0.548780487804878, 0.0975609756097561, 0.634146341463415, 0.585365853658537, 0.804878048780488, 0.195121951219512, 0.731707317073171, 0.463414634146341, 0.219512195121951, 0.902439024390244, 0.51219512195122 )), .Names = c("theta", "X", "Y")), "reverse" = structure(list(theta = 0.388042005420054, X = c(0, 0.170731707317073, 0.121951219512195, 0.292682926829268, 0.0975609756097561, 0.597560975609756, 0.0975609756097561, 0.682926829268293, 0.48780487804878, 0.682926829268293, 0.658536585365854, 0.926829268292683, 0.195121951219512, 0.0975609756097561, 0.414634146341463, 0.0975609756097561, 0.0975609756097561, 0.975609756097561, 0.439024390243902, 0.24390243902439, 0.24390243902439, 0.682926829268293, 0.024390243902439, 0.121951219512195, 0.0975609756097561, 0.231707317073171, 0.463414634146341, 0.121951219512195, 0.585365853658537, 0.902439024390244, 0.121951219512195, 0.0975609756097561, 0.414634146341463, 0.195121951219512, 0.121951219512195, 0.463414634146341, 0.804878048780488, 0.780487804878049, 0.268292682926829, 0.390243902439024, 0.951219512195122, 0.0975609756097561, 0.658536585365854, 0.24390243902439, 0.292682926829268, 0.292682926829268, 0.585365853658537, 0.024390243902439, 0.658536585365854, 0.414634146341463, 0.195121951219512, 0.292682926829268, 0.682926829268293, 0.292682926829268, 0.390243902439024, 0.121951219512195, 0.24390243902439, 0.292682926829268, 0.804878048780488, 0.170731707317073, 0.414634146341463, 0.451219512195122, 0.902439024390244, 0.365853658536585, 0.414634146341463, 0.195121951219512, 0.804878048780488, 0.268292682926829, 0.536585365853659, 0.780487804878049, 0.0975609756097561, 0.48780487804878), Y = c(0.194444444444444, 0.375, 0.319444444444444, 0.236111111111111, 0.958333333333333, 0.722222222222222, 0.486111111111111, 0.0694444444444444, 0.0277777777777778, 0.0694444444444444, 0.0694444444444444, 0.597222222222222, 0.277777777777778, 0.138888888888889, 0.833333333333333, 0.75, 0.291666666666667, 0.986111111111111, 0, 0.138888888888889, 0.569444444444444, 0.486111111111111, 0.444444444444444, 0.291666666666667, 0.111111111111111, 0.354166666666667, 0.138888888888889, 0.75, 0.0138888888888889, 0.243055555555556, 0.958333333333333, 0.659722222222222, 0.138888888888889, 0.958333333333333, 0.666666666666667, 0.0694444444444444, 0.472222222222222, 0.277777777777778, 0.0416666666666667, 0.486111111111111, 0.236111111111111)), .Names = c("theta", "X", "Y")) ), "wfns" = list( "forward" = structure(list(theta = 0.823678861788618, X = c(0.8125, 0.652777777777778, 0.888888888888889, 0.972222222222222, 0.972222222222222, 0.972222222222222, 0.972222222222222, 0.652777777777778, 0.972222222222222, 0.652777777777778, 0.256944444444444, 0.652777777777778, 0.972222222222222, 0.888888888888889, 0.888888888888889, 0.652777777777778, 0.972222222222222, 0.972222222222222, 0.972222222222222, 0.652777777777778, 0.972222222222222, 0.652777777777778, 0.972222222222222, 0.652777777777778, 0.888888888888889, 0.972222222222222, 0.888888888888889, 0.888888888888889, 0.256944444444444, 0.888888888888889, 0.888888888888889, 0.652777777777778, 0.652777777777778, 0.972222222222222, 0.972222222222222, 0.652777777777778, 0.652777777777778, 0.972222222222222, 0.972222222222222, 0.972222222222222, 0.972222222222222), Y = c(0.975609756097561, 0.975609756097561, 0.975609756097561, 0.975609756097561, 0.219512195121951, 0.975609756097561, 0.804878048780488, 0.804878048780488, 0.975609756097561, 0.804878048780488, 0.804878048780488, 0.975609756097561, 0.975609756097561, 0.975609756097561, 0.804878048780488, 0.975609756097561, 0.804878048780488, 0.975609756097561, 0.975609756097561, 0.646341463414634, 0.536585365853659, 0.975609756097561, 0.536585365853659, 0.975609756097561, 0.219512195121951, 0.219512195121951, 0.975609756097561, 0.975609756097561, 0.804878048780488, 0.536585365853659, 0.975609756097561, 0.975609756097561, 0.804878048780488, 0.804878048780488, 0.975609756097561, 0.804878048780488, 0.975609756097561, 0.804878048780488, 0.804878048780488, 0.975609756097561, 0.975609756097561, 0.975609756097561, 0.975609756097561, 0.804878048780488, 0.975609756097561, 0.804878048780488, 0.975609756097561, 0.975609756097561, 0.646341463414634, 0.804878048780488, 0.536585365853659, 0.804878048780488, 0.975609756097561, 0.536585365853659, 0.975609756097561, 0.975609756097561, 0.219512195121951, 0.536585365853659, 0.804878048780488, 0.804878048780488, 0.975609756097561, 0.975609756097561, 0.975609756097561, 0.646341463414634, 0.975609756097561, 0.804878048780488, 0.804878048780488, 0.536585365853659, 0.536585365853659, 0.975609756097561, 0.975609756097561, 0.975609756097561)), .Names = c("theta", "X", "Y")), "reverse" = structure(list(theta = 0.176321138211382, X = c(0.024390243902439, 0.024390243902439, 0.024390243902439, 0.024390243902439, 0.780487804878049, 0.024390243902439, 0.195121951219512, 0.195121951219512, 0.024390243902439, 0.195121951219512, 0.195121951219512, 0.024390243902439, 0.024390243902439, 0.024390243902439, 0.195121951219512, 0.024390243902439, 0.195121951219512, 0.024390243902439, 0.024390243902439, 0.353658536585366, 0.463414634146341, 0.024390243902439, 0.463414634146341, 0.024390243902439, 0.780487804878049, 0.780487804878049, 0.024390243902439, 0.024390243902439, 0.195121951219512, 0.463414634146341, 0.024390243902439, 0.024390243902439, 0.195121951219512, 0.195121951219512, 0.024390243902439, 0.195121951219512, 0.024390243902439, 0.195121951219512, 0.195121951219512, 0.024390243902439, 0.024390243902439, 0.024390243902439, 0.024390243902439, 0.195121951219512, 0.024390243902439, 0.195121951219512, 0.024390243902439, 0.024390243902439, 0.353658536585366, 0.195121951219512, 0.463414634146341, 0.195121951219512, 0.024390243902439, 0.463414634146341, 0.024390243902439, 0.024390243902439, 0.780487804878049, 0.463414634146341, 0.195121951219512, 0.195121951219512, 0.024390243902439, 0.024390243902439, 0.024390243902439, 0.353658536585366, 0.024390243902439, 0.195121951219512, 0.195121951219512, 0.463414634146341, 0.463414634146341, 0.024390243902439, 0.024390243902439, 0.024390243902439), Y = c(0.1875, 0.347222222222222, 0.111111111111111, 0.0277777777777778, 0.0277777777777778, 0.0277777777777778, 0.0277777777777778, 0.347222222222222, 0.0277777777777778, 0.347222222222222, 0.743055555555556, 0.347222222222222, 0.0277777777777778, 0.111111111111111, 0.111111111111111, 0.347222222222222, 0.0277777777777778, 0.0277777777777778, 0.0277777777777778, 0.347222222222222, 0.0277777777777778, 0.347222222222222, 0.0277777777777778, 0.347222222222222, 0.111111111111111, 0.0277777777777778, 0.111111111111111, 0.111111111111111, 0.743055555555556, 0.111111111111111, 0.111111111111111, 0.347222222222222, 0.347222222222222, 0.0277777777777778, 0.0277777777777778, 0.347222222222222, 0.347222222222222, 0.0277777777777778, 0.0277777777777778, 0.0277777777777778, 0.0277777777777778 )), .Names = c("theta", "X", "Y")) ), "s100b" = list( "forward" = structure(list(theta = 0.731368563685637, X = c(0.5625, 0.4375, 0.715277777777778, 0.541666666666667, 0.902777777777778, 1, 0.972222222222222, 0.180555555555556, 0.854166666666667, 0.347222222222222, 0.180555555555556, 0.888888888888889, 0.875, 0.965277777777778, 1, 0.819444444444444, 1, 1, 1, 0.180555555555556, 1, 0.833333333333333, 0, 0.347222222222222, 0.805555555555556, 1, 0.819444444444444, 1, 0.263888888888889, 0.819444444444444, 0.5625, 0.4375, 0.513888888888889, 0.805555555555556, 1, 0.611111111111111, 1, 0.840277777777778, 1, 1, 0.902777777777778 ), Y = c(0.707317073170732, 0.670731707317073, 0.804878048780488, 0.975609756097561, 0.341463414634146, 0.634146341463415, 0.804878048780488, 0.804878048780488, 0.975609756097561, 0.890243902439024, 0.975609756097561, 0.853658536585366, 0.768292682926829, 0.939024390243902, 0.634146341463415, 0.939024390243902, 0.768292682926829, 0.707317073170732, 0.634146341463415, 0.975609756097561, 0.646341463414634, 0.670731707317073, 0.439024390243902, 0.853658536585366, 0.292682926829268, 0.341463414634146, 0.646341463414634, 0.939024390243902, 0.390243902439024, 0.341463414634146, 0.768292682926829, 0.890243902439024, 0.853658536585366, 0.890243902439024, 0.975609756097561, 0.707317073170732, 0.804878048780488, 0.670731707317073, 0.658536585365854, 0.975609756097561, 0.975609756097561, 0.853658536585366, 0.975609756097561, 0.853658536585366, 0.890243902439024, 0.646341463414634, 0.853658536585366, 0.890243902439024, 0.451219512195122, 0.768292682926829, 0.51219512195122, 0.939024390243902, 0.804878048780488, 0.475609756097561, 0.939024390243902, 0.975609756097561, 0.585365853658537, 0.414634146341463, 0.804878048780488, 0.658536585365854, 0.890243902439024, 0.670731707317073, 0.804878048780488, 0.939024390243902, 0.975609756097561, 0.634146341463415, 0.658536585365854, 0.341463414634146, 0.634146341463415, 0.658536585365854, 0.292682926829268, 0.329268292682927)), .Names = c("theta", "X", "Y")), "reverse" = structure(list(theta = 0.268631436314363, X = c(0.292682926829268, 0.329268292682927, 0.195121951219512, 0.024390243902439, 0.658536585365854, 0.365853658536585, 0.195121951219512, 0.195121951219512, 0.024390243902439, 0.109756097560976, 0.024390243902439, 0.146341463414634, 0.231707317073171, 0.0609756097560976, 0.365853658536585, 0.0609756097560976, 0.231707317073171, 0.292682926829268, 0.365853658536585, 0.024390243902439, 0.353658536585366, 0.329268292682927, 0.560975609756098, 0.146341463414634, 0.707317073170732, 0.658536585365854, 0.353658536585366, 0.0609756097560976, 0.609756097560976, 0.658536585365854, 0.231707317073171, 0.109756097560976, 0.146341463414634, 0.109756097560976, 0.024390243902439, 0.292682926829268, 0.195121951219512, 0.329268292682927, 0.341463414634146, 0.024390243902439, 0.024390243902439, 0.146341463414634, 0.024390243902439, 0.146341463414634, 0.109756097560976, 0.353658536585366, 0.146341463414634, 0.109756097560976, 0.548780487804878, 0.231707317073171, 0.48780487804878, 0.0609756097560976, 0.195121951219512, 0.524390243902439, 0.0609756097560976, 0.024390243902439, 0.414634146341463, 0.585365853658537, 0.195121951219512, 0.341463414634146, 0.109756097560976, 0.329268292682927, 0.195121951219512, 0.0609756097560976, 0.024390243902439, 0.365853658536585, 0.341463414634146, 0.658536585365854, 0.365853658536585, 0.341463414634146, 0.707317073170732, 0.670731707317073), Y = c(0.4375, 0.5625, 0.284722222222222, 0.458333333333333, 0.0972222222222222, 0, 0.0277777777777778, 0.819444444444444, 0.145833333333333, 0.652777777777778, 0.819444444444444, 0.111111111111111, 0.125, 0.0347222222222222, 0, 0.180555555555556, 0, 0, 0, 0.819444444444444, 0, 0.166666666666667, 1, 0.652777777777778, 0.194444444444444, 0, 0.180555555555556, 0, 0.736111111111111, 0.180555555555556, 0.4375, 0.5625, 0.486111111111111, 0.194444444444444, 0, 0.388888888888889, 0, 0.159722222222222, 0, 0, 0.0972222222222222)), .Names = c("theta", "X", "Y")) ), list ) pROC/tests/testthat/helper-expectations.R0000644000176200001440000000205014114130125020152 0ustar liggesusers# Make sure the value looks like a p value. expect_p_value <- function(p.value) { expect_is(p.value, "numeric") expect_lte(p.value, 1) expect_gte(p.value, 0) } # Make sure we got a htest expect_htest <- function(ht) { expect_is(ht, "htest") expect_p_value(ht$p.value) } # Make sure we got a venkatraman test expect_venkatraman_htest <- function(ht) { expect_htest(ht) expect_equal(unname(ht$null.value), 0) expect_named(ht$null.value, "difference in at least one ROC operating point") expect_is(ht$statistic, c("numeric", "integer")) # Can be either? expect_named(ht$statistic, "E") expect_is(ht$parameter, "numeric") expect_named(ht$parameter, "boot.n") } # Make sure we got a boostrap test expect_bootstrap_htest <- function(ht) { expect_htest(ht) expect_equal(unname(ht$null.value), 0) expect_named(ht$null.value) # multiple values are possible expect_is(ht$statistic, c("numeric", "integer")) # Can be either? expect_named(ht$statistic, "D") expect_is(ht$parameter, "numeric") expect_named(ht$parameter, c("boot.n", "boot.stratified")) } pROC/tests/testthat/test-ci.formula.R0000644000176200001440000000207714114130125017214 0ustar liggesuserslibrary(pROC) data(aSAH) context("ci.formula") test_that("bootstrap cov works with smooth and !reuse.auc", { skip_slow() if (R.version$minor >= "6.0") { RNGkind(sample.kind="Rounding") } for (pair in list( list(ci, list()), list(ci.se, list(boot.n = 10)), list(ci.sp, list(boot.n = 10)), list(ci.thresholds, list(boot.n = 10)), list(ci.coords, list(boot.n = 10, x = 0.5)), list(ci.auc, list()))) { fun <- pair[[1]] # First calculate ci with .default args.default <- c( list(response = aSAH$outcome, predictor = aSAH$s100b), pair[[2]]) set.seed(42) # For reproducible CI obs.default <- do.call(fun, args.default) # Then with .formula args.formula <- c( list(formula = outcome ~ s100b, data = aSAH), pair[[2]]) set.seed(42) # For reproducible CI obs.formula <- do.call(fun, args.formula) # Here we check both returned the same result # We ignore attributes, as we have different # roc objects, and unfortunately equivalent means # we only test near equality expect_equivalent(obs.default, obs.formula) } }) pROC/tests/testthat/test-ci.coords.R0000644000176200001440000000576713607143106017062 0ustar liggesuserslibrary(pROC) data(aSAH) context("ci.coords") # Silence progress bars options(pROCProgress = list(name = "none")) test_that("ci.coords accepts threshold output with x=best", { expect_error(ci.coords(r.wfns, x="best", input="specificity", ret=c("threshold", "specificity", "sensitivity"), boot.n = 1), NA) }) test_that("ci.coords rejects threshold output except with x=best", { expect_error(ci.coords(r.wfns, x=0.9, input="specificity", ret=c("threshold", "specificity", "sensitivity"), boot.n = 1)) }) test_that("ci.coords accepts threshold output with x=best or if input was threshold", { expect_s3_class(ci.coords(r.wfns, x=2, input="threshold", ret=c("threshold", "specificity", "sensitivity"), boot.n = 1), "ci.coords") expect_s3_class(ci.coords(r.wfns, x="best", ret=c("threshold", "specificity", "sensitivity"), boot.n = 1), "ci.coords") }) # Only test whether ci.coords runs and returns without error. # Uses a very small number of iterations for speed # Doesn't test whether the results are correct. for (stratified in c(TRUE, FALSE)) { for (test.roc in list(r.s100b, smooth(r.s100b))) { test_that("ci.coords accepts one x and one ret", { obtained <- ci.coords(test.roc, x=0.8, input = "sensitivity", ret="sp", boot.n=3, conf.level = .91, boot.stratified = stratified) expect_equal(attr(obtained, "ret"), "specificity") expect_equal(names(obtained), attr(obtained, "ret")) for (ci.mat in obtained) { expect_equal(dim(ci.mat), c(1, 3)) expect_equal(colnames(ci.mat), c("4.5%", "50%", "95.5%")) } }) test_that("ci.coords accepts one x and multiple ret", { obtained <- ci.coords(test.roc, x=0.8, input = "sensitivity", ret=c("sp", "ppv", "tp", "1-sensitivity"), boot.n=3, conf.level = .91, boot.stratified = stratified) expect_equal(attr(obtained, "ret"), c("specificity", "ppv", "tp", "1-sensitivity")) expect_equal(names(obtained), attr(obtained, "ret")) for (ci.mat in obtained) { expect_equal(dim(ci.mat), c(1, 3)) expect_equal(colnames(ci.mat), c("4.5%", "50%", "95.5%")) } }) test_that("ci.coords accepts multiple x and one ret", { obtained <- ci.coords(test.roc, x=c(0.8, 0.9), input = "sensitivity", ret="sp", boot.n=3, conf.level = .91, boot.stratified = stratified) expect_equal(attr(obtained, "ret"), "specificity") expect_equal(names(obtained), attr(obtained, "ret")) for (ci.mat in obtained) { expect_equal(dim(ci.mat), c(2, 3)) expect_equal(colnames(ci.mat), c("4.5%", "50%", "95.5%")) } }) test_that("ci.coords accepts multiple x and ret", { obtained <- ci.coords(test.roc, x=c(0.9, 0.8), input = "sensitivity", ret=c("sp", "ppv", "tp", "1-se"), boot.n=3, conf.level = .91, boot.stratified = stratified) expect_equal(attr(obtained, "ret"), c("specificity", "ppv", "tp", "1-sensitivity")) expect_equal(names(obtained), attr(obtained, "ret")) for (ci.mat in obtained) { expect_equal(dim(ci.mat), c(2, 3)) expect_equal(colnames(ci.mat), c("4.5%", "50%", "95.5%")) } }) } } pROC/tests/testthat/test-numeric-accuracy.R0000644000176200001440000001404214114130125020402 0ustar liggesuserslibrary(pROC) data(aSAH) numacc.response <- c(2, 1, 1, 2, 2, 1, 2, 2, 1, 1, 1, 2, 1, 2, 2, 2, 2, 2) numacc.predictor <- c(0.960602681556147, 0.0794407386056549, 0.144842404246611, 0.931816485855784, 0.931816485855784, 0.97764041048215, 0.653549466997938699464, 0.796401132206396, 0.427720540184519, 0.811278021288732, 0.0188323116581187, 0.653549466997938588442, 0.653549466997938477419, 0.959111701445925, 0.931816485855784, 0.663663279418747, 0.800100838413179, 0.780456095511079) # Predictor has near-ties that can break numerical comparisons test_that("AUC is consistent across algorithms with numerical near-ties", { r1 <- roc(numacc.response, numacc.predictor, algorithm=1) r2 <- roc(numacc.response, numacc.predictor, algorithm=2) r3 <- roc(numacc.response, numacc.predictor, algorithm=3) expect_equal(as.numeric(auc(r1)), as.numeric(auc(r2))) expect_equal(as.numeric(auc(r1)), as.numeric(auc(r3))) }) test_that("AUC is consistent across algorithms with numerical near-ties and direction = >", { r1 <- roc(2-numacc.response, numacc.predictor, algorithm=1) r2 <- roc(2-numacc.response, numacc.predictor, algorithm=2) r3 <- roc(2-numacc.response, numacc.predictor, algorithm=3) expect_equal(as.numeric(auc(r1)), as.numeric(auc(r2))) expect_equal(as.numeric(auc(r1)), as.numeric(auc(r3))) }) test_that("delong theta is consistent with auc", { r1 <- roc(numacc.response, numacc.predictor, algorithm=1) r2 <- roc(numacc.response, numacc.predictor, algorithm=2) r3 <- roc(numacc.response, numacc.predictor, algorithm=3) expect_equal(pROC:::delongPlacements(r1)$theta, as.numeric(auc(r1))) expect_equal(pROC:::delongPlacements(r2)$theta, as.numeric(auc(r2))) expect_equal(pROC:::delongPlacements(r3)$theta, as.numeric(auc(r3))) }) test_that("delong theta is consistent with auc and direction = >", { r1 <- roc(2-numacc.response, numacc.predictor, algorithm=1) r2 <- roc(2-numacc.response, numacc.predictor, algorithm=2) r3 <- roc(2-numacc.response, numacc.predictor, algorithm=3) expect_equal(pROC:::delongPlacements(r1)$theta, as.numeric(auc(r1))) expect_equal(pROC:::delongPlacements(r2)$theta, as.numeric(auc(r2))) expect_equal(pROC:::delongPlacements(r3)$theta, as.numeric(auc(r3))) }) # Test some crazy values # Multiple sequencial near-tie that will break the thresholding algorithm at the limits close to +-Inf or 0 # Compare that with an "easy" curve with values with well defined intermediate averages test_that("Hard predictor has same results as easy one", { numacc.predictor.hard <- c(-0x1.fffffffffffffp+1023, -0x1.ffffffffffffep+1023, -0x1.ffffffffffffdp+1023, # Close to -Inf -0x1.249ad2594c37fp+332, -0x1.249ad2594c37ep+332, -0x1.249ad2594c37dp+332, -0x1.249ad2594c37cp+332, -0x1.249ad2594c37bp+332, -0x1.249ad2594c37ap+332, # Close to -1e100 -0x0.0000000000003p-1022, -0x0.0000000000002p-1022, -0x0.0000000000001p-1022, -0x0p+0, # Close to -0 0x0p+0, 0x0.0000000000001p-1022, 0x0.0000000000002p-1022, 0x0.0000000000003p-1022, # Close to +0 0x1.249ad2594c37ap+332, 0x1.249ad2594c37bp+332, 0x1.249ad2594c37cp+332, 0x1.249ad2594c37dp+332, 0x1.249ad2594c37ep+332, 0x1.249ad2594c37fp+332, # Close to +1e100 0x1.ffffffffffffdp+1023, 0x1.ffffffffffffep+1023, 0x1.fffffffffffffp+1023) # Close to +Inf numacc.predictor.easy <- c(-103, -102, -101, -10, -9, -8, -7, -6, -5, -0.1, -0.01, -0.001, 0, 0, 0.001, 0.01, 0.1, 5, 6, 7, 8, 9, 10, 101, 102, 103) response <- rbinom(length(numacc.predictor.easy), 1, 0.5) roc.hard <- roc(response, numacc.predictor.hard, direction="<") roc.easy <- roc(response, numacc.predictor.easy, direction="<") expect_equal(roc.hard$sensitivities, roc.easy$sensitivities, info = paste("Random response: ", paste(response, collapse=","))) expect_equal(roc.hard$specificities, roc.easy$specificities, info = paste("Random response: ", paste(response, collapse=","))) expect_equal(roc.hard$direction, roc.easy$direction, info = paste("Random response: ", paste(response, collapse=","))) }) test_that("Hard predictor has same results as easy one, random sampling", { skip_slow() numacc.predictor.hard <- c(-0x1.fffffffffffffp+1023, -0x1.ffffffffffffep+1023, -0x1.ffffffffffffdp+1023, # Close to -Inf -0x1.249ad2594c37fp+332, -0x1.249ad2594c37ep+332, -0x1.249ad2594c37dp+332, -0x1.249ad2594c37cp+332, -0x1.249ad2594c37bp+332, -0x1.249ad2594c37ap+332, # Close to -1e100 -0x0.0000000000003p-1022, -0x0.0000000000002p-1022, -0x0.0000000000001p-1022, -0x0p+0, # Close to -0 0x0p+0, 0x0.0000000000001p-1022, 0x0.0000000000002p-1022, 0x0.0000000000003p-1022, # Close to +0 0x1.249ad2594c37ap+332, 0x1.249ad2594c37bp+332, 0x1.249ad2594c37cp+332, 0x1.249ad2594c37dp+332, 0x1.249ad2594c37ep+332, 0x1.249ad2594c37fp+332, # Close to +1e100 0x1.ffffffffffffdp+1023, 0x1.ffffffffffffep+1023, 0x1.fffffffffffffp+1023) # Close to +Inf numacc.predictor.easy <- c(-103, -102, -101, -10, -9, -8, -7, -6, -5, -0.1, -0.01, -0.001, 0, 0, 0.001, 0.01, 0.1, 5, 6, 7, 8, 9, 10, 101, 102, 103) a <- replicate(1000, function(n) { response <- rbinom(length(numacc.predictor.easy), 1, 0.5) sample.vector <- sample(length(numacc.predictor.easy), replace = as.logical(rbinom(1, 1, 0.5))) roc.hard <- roc(response, numacc.predictor.hard[sample.vector], direction="<") roc.easy <- roc(response, numacc.predictor.easy[sample.vector], direction="<") expect_equal(roc.hard$sensitivities, roc.easy$sensitivities, info = c(paste("Random response: ", paste(response, collapse=",")), paste("Random sample:", paste(sample.vector, collapse=",")))) expect_equal(roc.hard$specificities, roc.easy$specificities, info = c(paste("Random response: ", paste(response, collapse=",")), paste("Random sample:", paste(sample.vector, collapse=",")))) expect_equal(roc.hard$direction, roc.easy$direction, info = c(paste("Random response: ", paste(response, collapse=",")), paste("Random sample:", paste(sample.vector, collapse=",")))) }) }) pROC/tests/testthat/test-roc.test.R0000644000176200001440000002656114114130125016722 0ustar liggesuserslibrary(pROC) data(aSAH) context("roc.test") test_that("roc.test works", { t1 <<- roc.test(r.wfns, r.s100b) t2 <<- roc.test(r.wfns, r.ndka) t3 <<- roc.test(r.ndka, r.s100b) expect_is(t1, "htest") expect_is(t2, "htest") expect_is(t3, "htest") }) test_that("DeLong roc.test works when curves are identical", { t4 <- roc.test(r.wfns, r.wfns) expect_is(t4, "htest") expect_equal(t4$p.value, 1) expect_equal(t4$statistic, c(Z=0)) }) test_that("roc.test statistic and p are as expected with defaults", { expect_equal(t1$statistic, c(Z=2.20898359144091)) expect_equal(t1$p.value, 0.0271757822291882) expect_equal(t1$conf.int[[1]], 0.0104061769564846) expect_equal(t1$conf.int[[2]], 0.174214419249478) expect_match(t1$method, "DeLong") expect_match(t1$method, "correlated") expect_identical(t1$alternative, "two.sided") expect_identical(attr(t1$conf.int, "conf.level"), 0.95) expect_equal(t2$statistic, c(Z=2.79777591868904)) expect_equal(t2$p.value, 0.00514557970691098) expect_equal(t2$conf.int[[1]], 0.0634011709339876) expect_equal(t2$conf.int[[2]], 0.3600405634833566) expect_match(t2$method, "DeLong") expect_match(t2$method, "correlated") expect_identical(t2$alternative, "two.sided") expect_identical(attr(t2$conf.int, "conf.level"), 0.95) expect_equal(t3$statistic, c(Z=-1.39077002573558)) expect_equal(t3$p.value, 0.164295175223054) expect_equal(t3$conf.int[[1]], -0.2876917446341914) expect_equal(t3$conf.int[[2]], 0.0488706064228094) expect_match(t3$method, "DeLong") expect_match(t3$method, "correlated") expect_identical(t3$alternative, "two.sided") expect_identical(attr(t3$conf.int, "conf.level"), 0.95) }) test_that("two.sided roc.test produces identical p values when roc curves are reversed", { t1b <- roc.test(r.s100b, r.wfns) expect_equal(t1b$p.value, t1$p.value) expect_equal(t1b$statistic, -t1$statistic) t2b <- roc.test(r.ndka, r.wfns) expect_equal(t2b$p.value, t2$p.value) expect_equal(t2b$statistic, -t2$statistic) t3b <- roc.test(r.s100b, r.ndka) expect_equal(t3b$p.value, t3$p.value) expect_equal(t3b$statistic, -t3$statistic) }) test_that("unpaired roc.test works", { # Warns about pairing expect_warning(t1up <<- roc.test(r.wfns, r.s100b, paired = FALSE)) expect_warning(t2up <<- roc.test(r.wfns, r.ndka, paired = FALSE)) expect_warning(t3up <<- roc.test(r.ndka, r.s100b, paired = FALSE)) }) test_that("unpaired roc.test statistic and p are as expected", { expect_equal(t1up$statistic, c(D=1.43490640926908)) expect_equal(t1up$p.value, 0.152825378808796) expect_match(t1up$method, "DeLong") expect_identical(t1up$alternative, "two.sided") expect_equal(t2up$statistic, c(D=3.10125096778969)) expect_equal(t2up$p.value, 0.00220950791756457) expect_match(t2up$method, "DeLong") expect_identical(t2up$alternative, "two.sided") expect_equal(t3up$statistic, c(D=-1.55995743389685)) expect_equal(t3up$p.value, 0.120192832430845) expect_match(t3up$method, "DeLong") expect_identical(t3up$alternative, "two.sided") }) test_that("unpaired two.sided roc.test produces identical p values when roc curves are reversed", { expect_warning(t1upb <- roc.test(r.s100b, r.wfns, paired = FALSE)) expect_equal(t1upb$p.value, t1up$p.value) expect_equal(t1upb$statistic, -t1up$statistic) expect_warning(t2upb <- roc.test(r.ndka, r.wfns, paired = FALSE)) expect_equal(t2upb$p.value, t2up$p.value) expect_equal(t2upb$statistic, -t2up$statistic) expect_warning(t3upb <- roc.test(r.s100b, r.ndka, paired = FALSE)) expect_equal(t3upb$p.value, t3up$p.value) expect_equal(t3upb$statistic, -t3up$statistic) }) test_that("one-sided roc.test work and produce expected results", { t1gt <- roc.test(r.wfns, r.s100b, alternative = "greater") t1lt <- roc.test(r.wfns, r.s100b, alternative = "less") expect_equal(t1gt$statistic, t1$statistic) expect_equal(t1lt$statistic, t1$statistic) expect_equal(t1gt$p.value, 0.0135878911145941) expect_equal(t1lt$p.value, 0.986412108885406) expect_match(t1gt$method, "DeLong") expect_match(t1gt$method, "correlated") expect_identical(t1gt$alternative, "greater") expect_match(t1lt$method, "DeLong") expect_match(t1lt$method, "correlated") expect_identical(t1lt$alternative, "less") }) test_that("unpaired one-sided roc.test work and produce expected results", { expect_warning(t1upgt <- roc.test(r.wfns, r.s100b, alternative = "greater", paired = FALSE)) expect_warning(t1uplt <- roc.test(r.wfns, r.s100b, alternative = "less", paired = FALSE)) expect_equal(t1upgt$statistic, t1up$statistic) expect_equal(t1uplt$statistic, t1up$statistic) expect_equal(t1upgt$p.value, 0.076412689404398) expect_equal(t1uplt$p.value, 0.923587310595602) expect_match(t1upgt$method, "DeLong") expect_identical(t1upgt$alternative, "greater") expect_match(t1uplt$method, "DeLong") expect_identical(t1uplt$alternative, "less") }) test_that("roc.formula works", { expect_silent(t1c <- roc.test(aSAH$outcome ~ aSAH$wfns + aSAH$s100b, quiet = TRUE)) # make sure silent is passed expect_equal(t1c$statistic, t1$statistic) expect_equal(t1c$p.value, t1$p.value) expect_match(t1$method, "DeLong") expect_match(t1$method, "correlated") expect_identical(t1$alternative, "two.sided") expect_warning(t1upc <- roc.test(aSAH$outcome ~ aSAH$wfns + aSAH$s100b, quiet = TRUE, paired = FALSE)) expect_equal(t1upc$statistic, t1up$statistic) expect_equal(t1upc$p.value, t1up$p.value) expect_match(t1upc$method, "DeLong") expect_identical(t1upc$alternative, "two.sided") }) test_that("roc.formula supports subset and na.omit", { check.only.items <- c("p.value", "statistic") expect_identical( roc.test(outcome ~ wfns + ndka, data = aSAH, subset = (gender == "Female"), quiet = TRUE)[check.only.items], roc.test(aSAH$outcome[aSAH$gender == "Female"], aSAH$wfns[aSAH$gender == "Female"], aSAH$ndka[aSAH$gender == "Female"], quiet = TRUE)[check.only.items] ) # Generate missing values aSAH.missing <- aSAH aSAH.missing$wfns[1:20] <- NA aSAH.missing$ndka[1:20] <- NA expect_identical( roc.test(outcome ~ wfns + ndka, data = aSAH.missing, na.action = na.omit, quiet = TRUE)[check.only.items], roc.test(aSAH$outcome[21:113], aSAH$wfns[21:113], aSAH$ndka[21:113], quiet = TRUE)[check.only.items] ) #na.fail should fail expect_error(roc.test(outcome ~ wfns + ndka, data = aSAH.missing, na.action = na.fail, quiet = TRUE)) #weights should fail too expect_error(roc.test(outcome ~ wfns + ndka, data = aSAH, weights = seq_len(nrow(aSAH))), regexp = "weights are not supported") # Both na.action and subset expect_identical( roc.test(outcome ~ wfns + ndka, data = aSAH.missing, na.action = na.omit, subset = (gender == "Female"), quiet = TRUE)[check.only.items], roc.test(aSAH$outcome[21:113][aSAH[21:113,]$gender == "Female"], aSAH$wfns[21:113][aSAH[21:113,]$gender == "Female"], aSAH$ndka[21:113][aSAH[21:113,]$gender == "Female"], quiet = TRUE)[check.only.items] ) }) test_that("paired tests don't work on unpaired curves", { # Make an unpaired ROC curve up.r.ndka <- roc(controls = aSAH$ndka[aSAH$outcome == "Good"], cases = aSAH$ndka[aSAH$outcome == "Poor"], quiet = TRUE) # unpaired by default t4 <- roc.test(r.wfns, up.r.ndka) expect_false(grepl("correlated", t4$method)) # Shoud be an error: expect_error(roc.test(r.wfns, up.r.ndka, paired = TRUE)) }) test_that("one-sided roc.test work with direction='>' and produce expected results", { r.mwfns <- roc(aSAH$outcome, -as.numeric(aSAH$wfns)) r.ms100b <- roc(aSAH$outcome, -aSAH$s100b) ## We already tested those before: #t1gt <- roc.test(r.wfns, r.s100b, alternative = "greater") #t1lt <- roc.test(r.wfns, r.s100b, alternative = "less") # Test with inverted direction m1gt <- roc.test(r.mwfns, r.ms100b, alternative = "greater") m1lt <- roc.test(r.mwfns, r.ms100b, alternative = "less") expect_equal(m1gt$statistic, t1$statistic) expect_equal(m1lt$statistic, t1$statistic) expect_equal(m1gt$p.value, 0.0135878911145941) expect_equal(m1lt$p.value, 0.986412108885406) }) test_that("paired roc.test works with bootstrap", { skip_slow() ht <- roc.test(r.wfns, r.s100b, method = "bootstrap", boot.n = 12, paired = TRUE) expect_bootstrap_htest(ht) expect_equal(ht$alternative, "two.sided") expect_equal(ht$method, "Bootstrap test for two correlated ROC curves") expect_equal(unname(ht$parameter), c(12, 1)) }) test_that("unpaired roc.test works with bootstrap", { skip_slow() expect_warning(ht <- roc.test(r.s100b, r.wfns, method = "bootstrap", boot.n = 12, paired = FALSE), "paired") expect_bootstrap_htest(ht) expect_equal(ht$alternative, "two.sided") expect_equal(ht$method, "Bootstrap test for two ROC curves") expect_equal(unname(ht$parameter), c(12, 1)) }) test_that("paired, non stratified roc.test works with bootstrap", { skip_slow() ht <- roc.test(r.s100b, r.wfns, method = "bootstrap", boot.n = 12, paired = TRUE, boot.stratified = FALSE) expect_bootstrap_htest(ht) expect_equal(ht$alternative, "two.sided") expect_equal(ht$method, "Bootstrap test for two correlated ROC curves") expect_equal(unname(ht$parameter), c(12, 0)) }) test_that("unpaired, non stratified roc.test works with bootstrap", { skip_slow() expect_warning(ht <- roc.test(r.s100b, r.wfns, method = "bootstrap", boot.n = 12, paired = FALSE, boot.stratified = FALSE), "paired") expect_bootstrap_htest(ht) expect_equal(ht$alternative, "two.sided") expect_equal(ht$method, "Bootstrap test for two ROC curves") expect_equal(unname(ht$parameter), c(12, 0)) }) test_that("bootstrap roc.test works with mixed roc, auc and smooth.roc objects", { skip_slow() for (roc1 in list(r.s100b, auc(r.s100b), smooth(r.s100b), r.s100b.partial2, r.s100b.partial2$auc)) { for (roc2 in list(r.wfns, auc(r.wfns), smooth(r.wfns), r.wfns.partial1, r.wfns.partial1$auc)) { n <- round(runif(1, 3, 9)) # keep boot.n small stratified <- sample(c(TRUE, FALSE), 1) paired <- sample(c(TRUE, FALSE), 1) alternative = sample(c("two.sided", "less", "greater"), 1) ht <- roc.test(roc1, roc2, method = "bootstrap", boot.n = n, paired = paired, boot.stratified = stratified, alternative = alternative) expect_bootstrap_htest(ht) expect_equal(ht$alternative, alternative) if (paired) { expect_equal(ht$method, "Bootstrap test for two correlated ROC curves") } else { expect_equal(ht$method, "Bootstrap test for two ROC curves") } expect_equal(unname(ht$parameter), c(n, as.integer(stratified))) } } }) test_that("se/sp roc.test works with mixed roc, auc and smooth.roc objects", { skip_slow() for (roc1 in list(r.s100b, auc(r.s100b), smooth(r.s100b), r.s100b.partial2, r.s100b.partial2$auc)) { for (roc2 in list(r.wfns, auc(r.wfns), smooth(r.wfns), r.wfns.partial1, r.wfns.partial1$auc)) { for (method in c("sensitivity", "specificity")) { n <- round(runif(1, 3, 9)) # keep boot.n small stratified <- sample(c(TRUE, FALSE), 1) paired <- sample(c(TRUE, FALSE), 1) alternative = sample(c("two.sided", "less", "greater"), 1) ht <- roc.test(roc1, roc2, method = method, sensitivity = 0.8, specificity = 0.8, boot.n = n, paired = paired, boot.stratified = stratified, alternative = alternative) expect_bootstrap_htest(ht) expect_equal(ht$alternative, alternative) if (paired) { expect_equal(ht$method, sprintf("%s test for two correlated ROC curves", tools::toTitleCase(method))) } else { expect_equal(ht$method, sprintf("%s test for two ROC curves", tools::toTitleCase(method))) } expect_equal(unname(ht$parameter), c(n, as.integer(stratified))) } } } }) pROC/tests/testthat/test-plot.R0000644000176200001440000001362314114130125016132 0ustar liggesuserscontext("plot") # Tests powered by vdiffr. # To update the reference with vdiffr: # > library(vdiffr) # > source("tests/testthat.R") # > manage_cases() test_that("plot draws correctly", { skip_if(getRversion() < 4.1) test_basic_plot <- function() plot(r) # S100b r <- r.s100b expect_doppelganger("basic-s100b", test_basic_plot) r <- r.ndka expect_doppelganger("basic-ndka", test_basic_plot) r <- r.wfns expect_doppelganger("basic-wfns", test_basic_plot) }) test_that("legacy.axis works correctly", { skip_if(getRversion() < 4.1) r <- r.s100b test_legacy.axis_plot <- function() plot(r, legacy.axes=TRUE) expect_doppelganger("legacy.axes", test_legacy.axis_plot) }) test_that("Advanced screenshot 1 works correctly", { skip_if(getRversion() < 4.1) test_advanced_screenshot_1 <- function() { plot(r.s100b.percent, reuse.auc = FALSE, partial.auc=c(100, 90), partial.auc.correct=TRUE, # define a partial AUC (pAUC) print.auc=TRUE, #display pAUC value on the plot with following options: print.auc.pattern="Corrected pAUC (100-90%% SP):\n%.1f%%", print.auc.col="#1c61b6", auc.polygon=TRUE, auc.polygon.col="#1c61b6", # show pAUC as a polygon max.auc.polygon=TRUE, max.auc.polygon.col="#1c61b622", # also show the 100% polygon main="Partial AUC (pAUC)") plot(r.s100b.percent, reuse.auc = FALSE, partial.auc=c(100, 90), partial.auc.correct=TRUE, partial.auc.focus="se", # focus pAUC on the sensitivity add=TRUE, type="n", # add to plot, but don't re-add the ROC itself (useless) print.auc=TRUE, print.auc.pattern="Corrected pAUC (100-90%% SE):\n%.1f%%", print.auc.col="#008600", print.auc.y=40, # do not print auc over the previous one auc.polygon=TRUE, auc.polygon.col="#008600", max.auc.polygon=TRUE, max.auc.polygon.col="#00860022") } expect_doppelganger("advanced.screenshot.1", test_advanced_screenshot_1) }) test_that("Advanced screenshot 2 works correctly", { skip_slow() skip_if(getRversion() < 4.1) test_advanced_screenshot_2 <- function() { if (paste0(R.version$major, ".", R.version$minor) >= "3.6.0") { RNGkind(sample.kind="Rounding") } set.seed(42) # For reproducible CI rocobj <- plot.roc(aSAH$outcome, aSAH$s100b, main="Confidence intervals", percent=TRUE, ci=TRUE, # compute AUC (of AUC by default) print.auc=TRUE) # print the AUC (will contain the CI) ciobj <- ci.se(rocobj, progress = "none", # CI of sensitivity specificities=seq(0, 100, 5)) # over a select set of specificities plot(ciobj, type="shape", col="#1c61b6AA") # plot as a blue shape plot(ci(rocobj, of="thresholds", thresholds="best", progress="none")) # add one threshold } expect_doppelganger("advanced.screenshot.2", test_advanced_screenshot_2) }) test_that("Advanced screenshot 3 works correctly", { skip_if(getRversion() < 4.1) test_advanced_screenshot_3 <- function() { plot(r.s100b.percent, main="Smoothing") lines(smooth(r.s100b.percent), # smoothing (default: binormal) col = "#1c61b6") lines(smooth(r.s100b.percent, method = "density"), # density smoothing col = "#008600") lines(smooth(r.s100b.percent, method = "fitdistr", # fit a distribution density = "lognormal"), # let the distribution be log-normal col = "#840000") legend("bottomright", legend = c("Empirical", "Binormal", "Density", "Fitdistr\n(Log-normal)"), col = c("black", "#1c61b6", "#008600", "#840000"),lwd = 2) } expect_doppelganger("advanced.screenshot.3", test_advanced_screenshot_3) }) test_that("Advanced screenshot 4 works correctly", { skip_slow() skip_if(getRversion() < 4.1) test_advanced_screenshot_4 <- function() { if (paste0(R.version$major, ".", R.version$minor) >= "3.6.0") { RNGkind(sample.kind="Rounding") } set.seed(42) # For reproducible CI rocobj <- plot.roc(aSAH$outcome, aSAH$s100b, main="Confidence intervals of specificity/sensitivity", percent=TRUE, ci=TRUE, of="se", # ci of sensitivity specificities=seq(0, 100, 5), # on a select set of specificities ci.type="shape", ci.col="#1c61b6AA", # plot the CI as a blue shape progress = "none") # hide progress bar plot(ci.sp(rocobj, sensitivities=seq(0, 100, 5), progress = "none"), # ci of specificity type="bars") # print this one as bars } expect_doppelganger("advanced.screenshot.4", test_advanced_screenshot_4) }) test_that("Advanced screenshot 5 works correctly", { skip_slow() skip_if(getRversion() < 4.1) test_advanced_screenshot_5 <- function() { if (paste0(R.version$major, ".", R.version$minor) >= "3.6.0") { RNGkind(sample.kind="Rounding") } set.seed(42) # For reproducible CI plot.roc(aSAH$outcome, aSAH$s100b, main="Confidence interval of a threshold", percent=TRUE, ci=TRUE, of="thresholds", # compute AUC (of threshold) thresholds="best", # select the (best) threshold print.thres="best", # also highlight this threshold on the plot progress = "none") # hide progress bar } expect_doppelganger("advanced.screenshot.5", test_advanced_screenshot_5) }) test_that("Advanced screenshot 6 works correctly", { skip_if(getRversion() < 4.1) test_advanced_screenshot_6 <- function() { plot(r.s100b.percent, main="Statistical comparison", col="#1c61b6") lines(r.ndka.percent, col="#008600") testobj <- roc.test(r.s100b.percent, r.ndka.percent) text(50, 50, labels=paste("p-value =", format.pval(testobj$p.value)), adj=c(0, .5)) legend("bottomright", legend=c("S100B", "NDKA"), col=c("#1c61b6", "#008600"), lwd=2) } expect_doppelganger("advanced.screenshot.6", test_advanced_screenshot_6) }) test_that("plot and lines work with formula and subset", { skip_if(getRversion() < 4.1) test_plot_formula <- function() { plot.roc(outcome ~ ndka, data = aSAH, subset = gender == "Female", col="red") lines.roc(outcome ~ ndka, data = aSAH) lines.roc(outcome ~ ndka, data = aSAH, subset = gender == "Male", col="blue") } expect_doppelganger("plot_formula", test_plot_formula) }) pROC/tests/testthat/test-multiclass.R0000644000176200001440000002557513607143106017356 0ustar liggesuserslibrary(pROC) data(aSAH) context("multiclass-roc") test_that("univariate multiclass roc/auc works", { uv.mr <- multiclass.roc(aSAH$gos6, aSAH$s100b) expect_equal(class(uv.mr), "multiclass.roc") expect_equal(length(uv.mr$rocs), 6) expect_equal(as.numeric(auc(uv.mr)), 0.6539999352) expect_false(uv.mr$percent) expect_false(attributes(uv.mr$auc)$partial.auc) expect_false(attributes(uv.mr$auc)$percent) }) test_that("univariate multiclass roc works with formula", { uv.mr <- multiclass.roc(gos6 ~ s100b, aSAH) expect_equal(as.numeric(auc(uv.mr)), 0.6539999352) uv.mr <- multiclass.roc(aSAH$gos6 ~ aSAH$s100b) expect_equal(as.numeric(auc(uv.mr)), 0.6539999352) uv.mr <- multiclass.roc(gos6 ~ s100b, aSAH, subset = (gender == "Female")) expect_equal(length(uv.mr$response), sum(aSAH$gender == "Female")) expect_error(multiclass.roc(gos6 ~ s100b, aSAH, weights=age)) }) test_that("univariate multiclass roc/auc works with percent=TRUE", { uv.mr <- multiclass.roc(aSAH$gos6, aSAH$s100b, percent=TRUE) uv.ma <- auc(uv.mr) expect_equal(as.numeric(uv.ma), 65.39999352) expect_equal(as.numeric(uv.mr$auc), 65.39999352) expect_true(uv.mr$percent) expect_true(attributes(uv.mr$auc)$percent) expect_true(attributes(uv.ma)$percent) expect_false(attributes(uv.mr$auc)$partial.auc) expect_false(attributes(uv.ma)$partial.auc) }) test_that("univariate multiclass roc/auc works with partial.auc", { pauc.spec <- c(1, .9) uv.mr <- multiclass.roc(aSAH$gos6, aSAH$s100b, partial.auc=pauc.spec) uv.ma <- auc(uv.mr, partial.auc=pauc.spec) expect_equal(as.numeric(uv.mr$auc), 0.0116176879) expect_equal(as.numeric(uv.ma), 0.0116176879) expect_equal(attributes(uv.mr$auc)$partial.auc, pauc.spec) expect_equal(attributes(uv.ma)$partial.auc, pauc.spec) # Calling AUC without partial.auc gives a full AUC, even if ROC was called with it expect_equal(as.numeric(auc(uv.mr)), 0.6539999352) # SE uv.mr <- multiclass.roc(aSAH$gos6, aSAH$s100b, partial.auc=pauc.spec, partial.auc.focus="se") uv.ma <- auc(uv.mr, partial.auc=pauc.spec, partial.auc.focus="se") expect_equal(as.numeric(uv.mr$auc), 0.02513286) expect_equal(as.numeric(uv.ma), 0.02513286) expect_equal(attributes(uv.mr$auc)$partial.auc.focus, "sensitivity") expect_equal(attributes(uv.ma)$partial.auc.focus, "sensitivity") }) test_that("univariate multiclass roc/auc works with directions", { uv.mr <- multiclass.roc(aSAH$gos6, aSAH$s100b, direction="auto") expect_equal(sapply(uv.mr$rocs, "[[", "direction"), c("<", ">", ">", ">", ">", ">")) expect_equal(as.numeric(uv.mr$auc), 0.6539999352) uv.mr <- multiclass.roc(aSAH$gos6, aSAH$s100b, direction="<") expect_equal(sapply(uv.mr$rocs, "[[", "direction"), rep("<", 6)) expect_equal(as.numeric(uv.mr$auc), 0.3487473175) uv.mr <- multiclass.roc(aSAH$gos6, aSAH$s100b, direction=">") expect_equal(sapply(uv.mr$rocs, "[[", "direction"), rep(">", 6)) expect_equal(as.numeric(uv.mr$auc), 0.6512526825) }) test_that("univariate multiclass handles missing levels", { expect_warning(multiclass.roc(aSAH$gos6, aSAH$s100b), "response level") }) test_that("multivariate multiclass roc/auc works", { n <- c(100, 80, 150) responses <- factor(c(rep("X1", n[1]), rep("X2", n[2]), rep("X3", n[3]))) # construct prediction matrix: one column per class set.seed(42) # Perfect separation preds <- lapply(n, function(x) runif(x, 0.8, 1)) predictor <- as.matrix(data.frame("X1" = c(preds[[1]], runif(n[2] + n[3], 0, 0.3)), "X2" = c(runif(n[1], 0.1, 0.4), preds[[2]], runif(n[3], 0, 0.2)), "X3" = c(runif(n[1] + n[2], 0, 0.5), preds[[3]]))) mv.mr <- multiclass.roc(responses, predictor) expect_equal(class(mv.mr), "mv.multiclass.roc") expect_equal(length(mv.mr$rocs), 3) expect_equal(unname(sapply(mv.mr$rocs, length)), rep(2, 3)) expect_equal(as.numeric(auc(mv.mr)), 1) # Imperfect separation preds <- lapply(n, function(x) runif(x, 0.4, 0.6)) predictor <- as.matrix(data.frame( "X1" = c(preds[[1]], runif(n[2] + n[3], 0, 0.7)), "X2" = c(runif(n[1], 0.1, 0.4), preds[[2]], runif(n[3], 0.2, 0.8)), "X3" = c(runif(n[1] + n[2], 0.3, 0.7), preds[[3]]) )) mv.mr <- multiclass.roc(responses, predictor) expect_equal(class(mv.mr), "mv.multiclass.roc") expect_equal(as.numeric(auc(mv.mr)), 0.6480791667) expect_false(mv.mr$percent) expect_false(attributes(mv.mr$auc)$partial.auc) expect_false(attributes(mv.mr$auc)$percent) }) test_that("multivariate multiclass with formula works", { n <- c(100, 80, 150) responses <- factor(c(rep("X1", n[1]), rep("X2", n[2]), rep("X3", n[3]))) # construct prediction matrix: one column per class set.seed(42) # Imperfect separation preds <- lapply(n, function(x) runif(x, 0.4, 0.6)) predictor <- as.matrix(data.frame( "X1" = c(preds[[1]], runif(n[2] + n[3], 0, 0.7)), "X2" = c(runif(n[1], 0.1, 0.4), preds[[2]], runif(n[3], 0.2, 0.8)), "X3" = c(runif(n[1] + n[2], 0.3, 0.7), preds[[3]]) )) test_data <- cbind(as.data.frame(predictor), "response" = responses) mv.mr <- multiclass.roc(responses, predictor) mv.mr.f <- multiclass.roc(response ~ ., data=test_data) expect_equal(as.numeric(auc(mv.mr.f)), as.numeric(auc(mv.mr))) mv.mr.f <- multiclass.roc(response ~ X1 + X2 + X3, data=test_data) expect_equal(as.numeric(auc(mv.mr)), as.numeric(auc(mv.mr))) subset <- rbinom(sum(n), 1, .5) == 1 mv.mr.f <- multiclass.roc(response ~ X1 + X2 + X3, data=test_data, subset = subset) expect_equal(length(mv.mr.f$response), sum(subset)) }) test_that("multivariate multiclass roc/auc works with percent=TRUE", { n <- c(100, 80, 150) responses <- factor(c(rep("X1", n[1]), rep("X2", n[2]), rep("X3", n[3]))) # construct prediction matrix: one column per class set.seed(42) # Perfect separation preds <- lapply(n, function(x) runif(x, 0.8, 1)) predictor <- as.matrix(data.frame("X1" = c(preds[[1]], runif(n[2] + n[3], 0, 0.3)), "X2" = c(runif(n[1], 0.1, 0.4), preds[[2]], runif(n[3], 0, 0.2)), "X3" = c(runif(n[1] + n[2], 0, 0.5), preds[[3]]))) mv.mr <- multiclass.roc(responses, predictor, percent=TRUE) expect_equal(as.numeric(auc(mv.mr)), 100) # Imperfect separation preds <- lapply(n, function(x) runif(x, 0.4, 0.6)) predictor <- as.matrix(data.frame( "X1" = c(preds[[1]], runif(n[2] + n[3], 0, 0.7)), "X2" = c(runif(n[1], 0.1, 0.4), preds[[2]], runif(n[3], 0.2, 0.8)), "X3" = c(runif(n[1] + n[2], 0.3, 0.7), preds[[3]]) )) mv.mr <- multiclass.roc(responses, predictor, percent=TRUE) expect_equal(as.numeric(auc(mv.mr)), 64.80791667) expect_true(mv.mr$percent) expect_false(attributes(mv.mr$auc)$partial.auc) expect_true(attributes(mv.mr$auc)$percent) }) test_that("multivariate multiclass roc/auc works with partial.auc", { pauc.spec <- c(1, .9) n <- c(100, 80, 150) responses <- factor(c(rep("X1", n[1]), rep("X2", n[2]), rep("X3", n[3]))) # construct prediction matrix: one column per class set.seed(42) # Perfect separation preds <- lapply(n, function(x) runif(x, 0.8, 1)) predictor <- as.matrix(data.frame("X1" = c(preds[[1]], runif(n[2] + n[3], 0, 0.3)), "X2" = c(runif(n[1], 0.1, 0.4), preds[[2]], runif(n[3], 0, 0.2)), "X3" = c(runif(n[1] + n[2], 0, 0.5), preds[[3]]))) mv.mr <- multiclass.roc(responses, predictor, partial.auc=c(1, .9)) expect_equal(as.numeric(mv.mr$auc), .1) expect_equal(as.numeric(auc(mv.mr)), 1) expect_equal(as.numeric(auc(mv.mr, partial.auc=c(1, .9))), .1) # Imperfect separation preds <- lapply(n, function(x) runif(x, 0.4, 0.6)) predictor <- as.matrix(data.frame( "X1" = c(preds[[1]], runif(n[2] + n[3], 0, 0.7)), "X2" = c(runif(n[1], 0.1, 0.4), preds[[2]], runif(n[3], 0.2, 0.8)), "X3" = c(runif(n[1] + n[2], 0.3, 0.7), preds[[3]]) )) mv.mr <- multiclass.roc(responses, predictor, partial.auc=c(1, .9)) expect_equal(as.numeric(mv.mr$auc), 0.0529250000) expect_equal(as.numeric(auc(mv.mr)), 0.6480791667) expect_equal(as.numeric(auc(mv.mr, partial.auc=c(1, .9))), 0.0529250000) expect_false(mv.mr$percent) expect_equal(attributes(mv.mr$auc)$partial.auc, pauc.spec) expect_false(attributes(mv.mr$auc)$percent) }) test_that("multivariate multiclass roc/auc works with direction", { n <- c(100, 80, 150) responses <- factor(c(rep("X1", n[1]), rep("X2", n[2]), rep("X3", n[3]))) # construct prediction matrix: one column per class set.seed(42) # Perfect separation preds <- lapply(n, function(x) runif(x, 0.8, 1)) predictor <- as.matrix(data.frame("X1" = c(preds[[1]], runif(n[2] + n[3], 0, 0.3)), "X2" = c(runif(n[1], 0.1, 0.4), preds[[2]], runif(n[3], 0, 0.2)), "X3" = c(runif(n[1] + n[2], 0, 0.5), preds[[3]]))) expect_error(multiclass.roc(responses, predictor, direction = "auto")) mr.mv.1 <- multiclass.roc(responses, predictor, direction = "<") mr.mv.2 <- multiclass.roc(responses, predictor, direction = ">") expect_equal(as.numeric(mr.mv.1$auc), 0) expect_equal(as.numeric(mr.mv.2$auc), 1) for (i in 1:3) { for (j in 1:2) { expect_equal(mr.mv.1$rocs[[i]][[j]]$direction, "<") expect_equal(mr.mv.2$rocs[[i]][[j]]$direction, ">") } } }) test_that("multivariate behavior with missing levels/columns", { n <- c(10, 10, 10) responses <- factor(c(rep("X1", n[1]), rep("X2", n[2]), rep("X3", n[3]))) # construct prediction matrix: one column per class set.seed(42) # Perfect separation preds <- lapply(n, function(x) runif(x, 0.8, 1)) predictor <- as.matrix(data.frame("X1" = c(preds[[1]], runif(n[2] + n[3], 0, 0.3)), "X2" = c(runif(n[1], 0.1, 0.4), preds[[2]], runif(n[3], 0, 0.2)), "X3" = c(runif(n[1] + n[2], 0, 0.5), preds[[3]]))) # Wrong number of predictor rows expect_error(multiclass.roc(responses[1:20], predictor), "agree") # Column in predictor not in response warns: expect_warning(multiclass.roc(as.character(responses[1:20]), predictor[1:20,]), "X3") # Level with no obervation warns: expect_warning(multiclass.roc(responses[1:20], predictor[1:20,1:2]), "X3") # Removed both level and column should be silent expect_silent(multiclass.roc(as.character(responses[1:20]), predictor[1:20,1:2])) # Single column is an error expect_error(multiclass.roc(responses, predictor[,1, drop=F])) # Wrong column names pr2 <- predictor colnames(pr2) <- c("Y1", "Y2", "Y3") expect_error(multiclass.roc(responses, pr2)) colnames(pr2) <- c("Y1", "X2", "X3") expect_warning(multiclass.roc(as.character(responses[11:30]), pr2[11:30,]), "Y1") }) test_that("Invalid CI functions fail cleanly", { uv.mr <- multiclass.roc(aSAH$gos6, aSAH$s100b) expect_error(ci.se(uv.mr), "not available for multiclass ROC curves") expect_error(ci.se(uv.mr$auc), "not available for multiclass ROC curves") expect_error(ci.sp(uv.mr), "not available for multiclass ROC curves") expect_error(ci.sp(uv.mr$auc), "not available for multiclass ROC curves") expect_error(ci.coords(uv.mr), "not available for multiclass ROC curves") expect_error(ci.coords(uv.mr$auc), "not available for multiclass ROC curves") expect_error(ci.thresholds(uv.mr), "not available for multiclass ROC curves") expect_error(ci.thresholds(uv.mr$auc), "not available for multiclass ROC curves") }) pROC/tests/testthat/test-are-paired.R0000644000176200001440000001272014114130125017162 0ustar liggesuserslibrary(pROC) data(aSAH) context("are.paired") test_that("are.paired works", { # most basic example expect_true(are.paired(r.wfns, r.ndka)) # Missing values shouldn't screw up aSAH.missing <- aSAH aSAH.missing$wfns[1:20] <- NA expect_true(are.paired(roc(aSAH.missing$outcome, aSAH.missing$wfns), roc(aSAH.missing$outcome, aSAH.missing$ndka))) # Also with different data.frames expect_true(are.paired(roc(aSAH.missing$outcome, aSAH.missing$wfns), r.ndka)) # The following should fail though expect_false(are.paired(roc(aSAH$outcome[21:113], aSAH$wfns[21:113]), roc(aSAH$outcome, aSAH$ndka))) # Opposite levels should probably fail expect_false(are.paired(roc(aSAH$outcome, aSAH$wfns, levels = c("Good", "Poor")), roc(aSAH$outcome, aSAH$ndka, levels = c("Poor", "Good")))) }) test_that("are.paired works with formula", { r.wfns.f <- roc(outcome ~ wfns, aSAH) r.ndka.f <- roc(outcome ~ ndka, aSAH) # most basic example expect_true(are.paired(r.wfns.f, r.ndka.f)) # Missing values shouldn't screw up aSAH.missing <- aSAH aSAH.missing$wfns[1:20] <- NA expect_true(are.paired(roc(outcome ~ wfns, aSAH.missing), roc(outcome ~ ndka, aSAH.missing))) # Also with different data.frames expect_true(are.paired(roc(outcome ~ wfns, aSAH.missing), r.ndka.f)) # The following should fail though expect_false(are.paired(roc(outcome ~ wfns, aSAH.missing[21:113,]), r.ndka)) # Opposite levels should probably fail expect_false(are.paired(roc(outcome ~ wfns, aSAH, levels = c("Good", "Poor")), roc(outcome ~ ndka, aSAH, levels = c("Poor", "Good")))) }) test_that("are.paired works with auc and mixed roc", { expect_true(are.paired(auc(aSAH$outcome, aSAH$wfns), auc(aSAH$outcome, aSAH$ndka))) expect_true(are.paired(roc(aSAH$outcome, aSAH$wfns), auc(aSAH$outcome, aSAH$ndka))) expect_true(are.paired(auc(aSAH$outcome, aSAH$wfns), roc(aSAH$outcome, aSAH$ndka))) }) test_that("are.paired return.paired.rocs works", { pair <- are.paired(r.wfns, r.ndka, return.paired.rocs = TRUE) expect_true(pair) expect_identical(attr(pair, "roc1"), r.wfns) expect_identical(attr(pair, "roc2"), r.ndka) }) test_that("are.paired return.paired.rocs works with missing values", { aSAH.missing <- aSAH aSAH.missing$ndka[1:20] <- NA r1 <- roc(aSAH.missing$outcome, aSAH.missing$ndka) pair <- are.paired(r1, r.wfns, return.paired.rocs = TRUE) expect_true(pair) expect_identical(attr(pair, "roc1")$thresholds, roc(aSAH$outcome[21:113], aSAH$ndka[21:113])$thresholds) expect_identical(attr(pair, "roc2")$thresholds, roc(aSAH$outcome[21:113], aSAH$wfns[21:113])$thresholds) }) test_that("are.paired return.paired.rocs doesn't return when unpaired", { pair <- are.paired(roc(aSAH$outcome[21:113], aSAH$wfns[21:113]), r.ndka, return.paired.rocs = TRUE) expect_null(attributes(pair)) }) test_that("are.paired works with smooth.roc curves", { expect_true(are.paired(smooth(r.wfns), smooth(r.ndka))) # Missing values shouldn't screw up aSAH.missing <- aSAH aSAH.missing$wfns[1:20] <- NA expect_true(are.paired(smooth(roc(aSAH.missing$outcome, aSAH.missing$wfns)), smooth(roc(aSAH.missing$outcome, aSAH.missing$ndka)))) # Also with different data.frames expect_true(are.paired(smooth(roc(aSAH.missing$outcome, aSAH.missing$wfns)), smooth(r.ndka))) # The following should fail though expect_false(are.paired(smooth(roc(aSAH$outcome[21:113], aSAH$wfns[21:113])), smooth(roc(aSAH$outcome, aSAH$ndka)))) # Opposite levels should probably fail expect_false(are.paired(smooth(roc(aSAH$outcome, aSAH$wfns, levels = c("Good", "Poor"))), smooth(roc(aSAH$outcome, aSAH$ndka, levels = c("Poor", "Good"))))) }) test_that("are.paired works with auc and mixed roc and smooth", { expect_true(are.paired(auc(aSAH$outcome, aSAH$wfns), smooth(roc(aSAH$outcome, aSAH$ndka)))) expect_true(are.paired(smooth(roc(aSAH$outcome, aSAH$wfns)), auc(aSAH$outcome, aSAH$ndka))) expect_true(are.paired(roc(aSAH$outcome, aSAH$wfns), smooth(roc(aSAH$outcome, aSAH$ndka)))) expect_true(are.paired(smooth(roc(aSAH$outcome, aSAH$wfns)), roc(aSAH$outcome, aSAH$ndka))) }) test_that("are.paired return.paired.rocs returns smooth curves", { aSAH.missing <- aSAH aSAH.missing$ndka[1:20] <- NA r1 <- roc(aSAH.missing$outcome, aSAH.missing$ndka, smooth=TRUE) pair <- are.paired(r1, smooth(r.wfns), return.paired.rocs = TRUE) expect_true(pair) expect_is(attr(pair, "roc1"), "smooth.roc") expect_is(attr(pair, "roc2"), "smooth.roc") }) test_that("are.paired return.paired.rocs smoothes curves with the right method", { skip_slow() aSAH.missing <- aSAH aSAH.missing$ndka[1:20] <- NA smooth.methods <- c("binormal", "density", "fitdistr", "logcondens", "logcondens.smooth") for (smooth.method in smooth.methods) { r1 <- smooth(roc(aSAH.missing$outcome, aSAH.missing$ndka), method=smooth.method) pair <- are.paired(r1, smooth(r.s100b, method=smooth.method), return.paired.rocs = TRUE) expect_true(pair) expect_identical(attr(pair, "roc1")$smoothing.args$method, smooth.method) expect_identical(attr(pair, "roc2")$smoothing.args$method, smooth.method) } }) test_that("are.paired return.paired.rocs doesn't return when unpaired and smooth", { pair <- are.paired(smooth(roc(aSAH$outcome[21:113], aSAH$wfns[21:113])), r.ndka, return.paired.rocs = TRUE) expect_null(attributes(pair)) pair <- are.paired(roc(aSAH$outcome[21:113], aSAH$wfns[21:113]), smooth(r.ndka), return.paired.rocs = TRUE) expect_null(attributes(pair)) pair <- are.paired(smooth(roc(aSAH$outcome[21:113], aSAH$wfns[21:113])), smooth(r.ndka), return.paired.rocs = TRUE) expect_null(attributes(pair)) }) pROC/tests/testthat/test-onload.R0000644000176200001440000000421314114130125016423 0ustar liggesuserslibrary(pROC) context("onLoad") test_that("Progress bar is set after pROC is loaded", { progress.opt <- getOption("pROCProgress") expect_is(progress.opt, "list") expect_true("name" %in% names(progress.opt)) }) test_that("Progress bar is set after pROC is loaded", { skip("Breaks everything for some reason...") options("pROCProgress"=NULL) expect_null(getOption("pROCProgress")) detach("package:pROC", unload = TRUE) library(pROC) progress.opt <- getOption("pROCProgress") expect_is(progress.opt, "list") expect_true("name" %in% names(progress.opt)) }) test_that("Progress bar is set by .onLoad", { options("pROCProgress"=NULL) expect_null(getOption("pROCProgress")) pROC:::.onLoad() progress.opt <- getOption("pROCProgress") expect_is(progress.opt, "list") expect_true("name" %in% names(progress.opt)) }) test_that(".onLoad doesn't override user setting", { old.progress.opt <- getOption("pROCProgress") options("pROCProgress"=list(dummy=TRUE)) expect_false("name" %in% names(getOption("pROCProgress"))) pROC:::.onLoad() expect_false("name" %in% names(getOption("pROCProgress"))) # Restore options("pROCProgress"=old.progress.opt) }) test_that(".parseRcppVersion works", { expect_equal(pROC:::.parseRcppVersion("65538"), "1.0.2") expect_equal(pROC:::.parseRcppVersion("1"), "0.0.1") }) test_that("We're running the right Rcpp version", { skip_if_not(exists("run_slow_tests") && run_slow_tests, message = "Skipping error-prone Rcpp version check") skip_if(Rcpp:::getRcppVersion() == '1.0.3', "RCPP_VERSION broken in 1.0.3") # This check will often fail, RCPP_VERSION is regularly out of sync, # for instance Rcpp 1.0.4.6 has RCPP_VERSION 1.0.4. We can't expect # it to be silent, however we still want it to execute without error # expect_silent(pROC:::.checkRcppVersion()) pROC:::.checkRcppVersion() # Replace the actual RcppVersion with a dummy function that returns 1 # (= 0.0.1) so we actually see a warning saved.RcppVersion <- pROC:::RcppVersion assignInNamespace("RcppVersion", function() {return("1")}, "pROC") expect_warning(pROC:::.checkRcppVersion()) # Restore assignInNamespace("RcppVersion", saved.RcppVersion, "pROC") })pROC/tests/testthat/test-power.roc.test.R0000644000176200001440000002411314114130125020044 0ustar liggesuserslibrary(pROC) data(aSAH) context("power.roc.test") test_that("power.roc.test basic function", { res <- power.roc.test(r.s100b) expect_equal(as.numeric(res$auc), as.numeric(r.s100b$auc)) expect_equal(res$ncases, length(r.s100b$cases)) expect_equal(res$ncontrols, length(r.s100b$controls)) expect_equal(res$sig.level, 0.05) expect_equal(res$power, 0.9904833, tolerance = 0.000001) }) test_that("power.roc.test with percent works", { res <- power.roc.test(r.s100b.percent) expect_equal(as.numeric(res$auc), as.numeric(r.s100b$auc)) expect_equal(res$ncases, length(r.s100b$cases)) expect_equal(res$ncontrols, length(r.s100b$controls)) expect_equal(res$sig.level, 0.05) expect_equal(res$power, 0.9904833, tolerance = 0.000001) }) test_that("power.roc.test with given auc function", { res <- power.roc.test(ncases=41, ncontrols=72, auc=0.73, sig.level=0.05) expect_equal(as.numeric(res$auc), 0.73) expect_equal(res$ncases, 41) expect_equal(res$ncontrols, 72) expect_equal(res$sig.level, 0.05) expect_equal(res$power, 0.9897453, tolerance = 0.000001) }) test_that("power.roc.test sig.level can be omitted", { res <- power.roc.test(ncases=41, ncontrols=72, auc=0.73) expect_equal(res$sig.level, 0.05) expect_equal(res$power, 0.9897453, tolerance = 0.000001) }) test_that("power.roc.test can determine ncases & ncontrols", { res <- power.roc.test(auc=r.s100b$auc, sig.level=0.05, power=0.95, kappa=1.7) expect_equal(as.numeric(res$auc), as.numeric(r.s100b$auc)) expect_equal(res$sig.level, 0.05) expect_equal(res$power, 0.95) expect_equal(res$ncases, 29.29764, tolerance = 0.000001) expect_equal(res$ncontrols, 49.806, tolerance = 0.000001) }) test_that("power.roc.test can determine sig.level", { res <- power.roc.test(ncases=41, ncontrols=72, auc=0.73, power=0.95, sig.level=NULL) expect_equal(as.numeric(res$auc), 0.73) expect_equal(res$ncases, 41) expect_equal(res$ncontrols, 72) expect_equal(res$power, 0.95) expect_equal(res$sig.level, 0.009238584, tolerance = 0.000001) }) test_that("power.roc.test can determine AUC", { res <- power.roc.test(ncases=41, ncontrols=72, sig.level=0.05, power=0.95) expect_equal(res$ncases, 41) expect_equal(res$ncontrols, 72) expect_equal(res$power, 0.95) expect_equal(res$sig.level, 0.05) expect_equal(as.numeric(res$auc), 0.6961054, tolerance = 0.000001) }) test_that("power.roc.test can take 2 ROC curves with DeLong variance", { res <- power.roc.test(r.ndka, r.wfns) expect_equal(res$ncases, 41) expect_equal(res$ncontrols, 72) expect_equal(as.numeric(res$auc1), as.numeric(r.ndka$auc)) expect_equal(as.numeric(res$auc2), as.numeric(r.wfns$auc)) expect_equal(res$power, 0.7131594, tolerance = 0.000001) expect_equal(res$sig.level, 0.05) expect_equal(res$alternative, "two.sided") }) test_that("power.roc.test can take 2 percent ROC curves with DeLong variance", { res <- power.roc.test(r.ndka.percent, r.wfns.percent) expect_equal(res$ncases, 41) expect_equal(res$ncontrols, 72) expect_equal(as.numeric(res$auc1), as.numeric(r.ndka$auc)) expect_equal(as.numeric(res$auc2), as.numeric(r.wfns$auc)) expect_equal(res$power, 0.7131594, tolerance = 0.000001) expect_equal(res$sig.level, 0.05) expect_equal(res$alternative, "two.sided") }) test_that("power.roc.test can take 2 ROC curves with Obuchowski variance", { res <- power.roc.test(r.ndka, r.wfns, method="obuchowski") expect_equal(res$ncases, 41) expect_equal(res$ncontrols, 72) expect_equal(as.numeric(res$auc1), as.numeric(r.ndka$auc)) expect_equal(as.numeric(res$auc2), as.numeric(r.wfns$auc)) expect_equal(res$power, 0.8061004, tolerance = 0.000001) expect_equal(res$sig.level, 0.05) expect_equal(res$alternative, "two.sided") }) test_that("power.roc.test ncases/ncontrols can take 2 ROC curves with DeLong variance", { res <- power.roc.test(r.ndka, r.wfns, power=0.9) expect_equal(res$ncases, 64.77777, tolerance = 0.000001) expect_equal(res$ncontrols, 113.7561, tolerance = 0.000001) expect_equal(as.numeric(res$auc1), as.numeric(r.ndka$auc)) expect_equal(as.numeric(res$auc2), as.numeric(r.wfns$auc)) expect_equal(res$power, 0.9) expect_equal(res$sig.level, 0.05) expect_equal(res$alternative, "two.sided") }) test_that("power.roc.test ncases/ncontrols can take 2 ROC curves with Obuchowski variance", { res <- power.roc.test(r.ndka, r.wfns, power=0.9, method="obuchowski") expect_equal(res$ncases, 53.23685, tolerance = 0.000001) expect_equal(res$ncontrols, 93.48911, tolerance = 0.000001) expect_equal(as.numeric(res$auc1), as.numeric(r.ndka$auc)) expect_equal(as.numeric(res$auc2), as.numeric(r.wfns$auc)) expect_equal(res$power, 0.9) expect_equal(res$sig.level, 0.05) expect_equal(res$alternative, "two.sided") }) test_that("power.roc.test sig.level can take 2 ROC curves with DeLong variance", { res <- power.roc.test(r.ndka, r.wfns, power=0.9, sig.level=NULL) expect_equal(res$ncases, 41) expect_equal(res$ncontrols, 72) expect_equal(as.numeric(res$auc1), as.numeric(r.ndka$auc)) expect_equal(as.numeric(res$auc2), as.numeric(r.wfns$auc)) expect_equal(res$power, 0.9) expect_equal(res$sig.level, 0.1836639, tolerance = 0.000001) expect_equal(res$alternative, "two.sided") }) test_that("power.roc.test sig.level can take 2 ROC curves with Obuchowski variance", { res <- power.roc.test(r.ndka, r.wfns, power=0.9, sig.level=NULL, method="obuchowski") expect_equal(res$ncases, 41) expect_equal(res$ncontrols, 72) expect_equal(as.numeric(res$auc1), as.numeric(r.ndka$auc)) expect_equal(as.numeric(res$auc2), as.numeric(r.wfns$auc)) expect_equal(res$power, 0.9) expect_equal(res$sig.level, 0.1150686, tolerance = 0.000001) expect_equal(res$alternative, "two.sided") }) test_that("power.roc.test works with partial AUC", { skip_slow() skip("Bootstrap cannot be tested yet") r.wfns.partial <<- roc(aSAH$outcome, aSAH$wfns, quiet = TRUE, partial.auc=c(1, 0.9)) r.ndka.partial <<- roc(aSAH$outcome, aSAH$ndka, quiet = TRUE, partial.auc=c(1, 0.9)) power.roc.test(r.wfns.partial, r.ndka.partial, power=0.9) }) test_that("power.roc.test works with partial AUC", { r.wfns.partial <<- roc(aSAH$outcome, aSAH$wfns, quiet = TRUE, partial.auc=c(1, 0.9)) r.ndka.partial <<- roc(aSAH$outcome, aSAH$ndka, quiet = TRUE, partial.auc=c(1, 0.9)) res <- power.roc.test(r.wfns.partial, r.ndka.partial, power=0.9, method="obuchowski") expect_equal(res$ncases, 0.5061498, tolerance = 0.000001) expect_equal(res$ncontrols, 0.8888484, tolerance = 0.000001) expect_equal(as.numeric(res$auc1), as.numeric(r.wfns.partial$auc)) expect_equal(as.numeric(res$auc2), as.numeric(r.ndka.partial$auc)) expect_equal(res$power, 0.9) expect_equal(res$sig.level, 0.05) expect_equal(res$alternative, "two.sided") }) test_that("power.roc.test works with binormal parameters", { ob.params <- list(A1=2.6, B1=1, A2=1.9, B2=1, rn=0.6, ra=0.6, FPR11=0, FPR12=0.2, FPR21=0, FPR22=0.2, delta=0.037) res1 <- power.roc.test(ob.params, power=0.8, sig.level=0.05) expect_equal(res1$ncases, 107.0238, tolerance = 0.000001) expect_equal(res1$ncontrols, 107.0238, tolerance = 0.000001) expect_equal(res1$power, 0.8) expect_equal(res1$sig.level, 0.05) res2 <- power.roc.test(ob.params, power=0.8, sig.level=NULL, ncases=107) expect_equal(res2$ncases, 107) expect_equal(res2$ncontrols, 107) expect_equal(res2$power, 0.8) expect_equal(res2$sig.level, 0.05004012, tolerance = 0.000001) res3 <- power.roc.test(ob.params, power=NULL, sig.level=0.05, ncases=107) expect_equal(res3$ncases, 107) expect_equal(res3$ncontrols, 107) expect_equal(res3$sig.level, 0.05) expect_equal(res3$power, 0.7999286, tolerance = 0.000001) }) ## With only binormal parameters given # From example 2 of Obuchowski and McClish, 1997. test_that("power.roc.test returns correct results from litterature", { context("Check results in Obuchowski 2004 Table 4") # Note: the table reports at least 10 in each cell, and adapts # the complement value to match kappa. So in 0.25/0.95 we have 10/40 # although both values are < 10. # Note2: some values don't match exactly, specifically # expected.ncases[0.5, 0.6] and expected.ncontrols[4, 0.6] # are off by 1 (< 1%). kappas <- c(0.25, 0.5, 1, 2, 4) thetas <- c(0.6, 0.7, 0.8, 0.9, 0.95) expected.ncontrols <- matrix(c( 84, 20, 10, 10, 10, 101, 25, 10, 10, 10, 135, 33, 14, 10, 10, 203, 50, 21, 20, 20, #339, 84, 40, 40, 40 340, 84, 40, 40, 40 # Fixed ), nrow = 5, byrow = TRUE, dimnames = list(kappas, thetas)) expected.ncases <- matrix(c( 334, 80, 40, 40, 40, #201, 49, 20, 20, 20, 202, 49, 20, 20, 20, # Fixed 135, 33, 14, 10, 10, 102, 25, 11, 10, 10, 85, 21, 10, 10, 10 ), nrow = 5, byrow = TRUE, dimnames = list(kappas, thetas)) for (kappa in kappas) { for (theta in thetas) { context(sprintf("kappa: %s, theta: %s", kappa, theta)) pr <- power.roc.test(auc=theta, sig.level=0.05, power=0.9, kappa=kappa, alternative="one.sided") expect_equal(max(10, ifelse(ceiling(pr$ncases) < 10, 10, 0) * kappa, ceiling(pr$ncontrols)), expected.ncontrols[as.character(kappa), as.character(theta)]) expect_equal(max(10, ifelse(ceiling(pr$ncontrols) < 10, 10, 0) / kappa, ceiling(pr$ncases)), expected.ncases[as.character(kappa), as.character(theta)]) } } }) test_that("kappa works with a single ROC curve", { # kappa from data res <- power.roc.test(r.s100b, sig.level = 0.05, power = 0.9) expect_equal(res$ncases, 23.5598674) expect_equal(res$ncontrols, 41.3734257) expect_equal(res$ncases/res$ncontrols, length(r.s100b$cases)/length(r.s100b$controls)) # set kappa res <- power.roc.test(r.s100b, sig.level = 0.05, power = 0.9, kappa = 1) expect_equal(res$ncases, 29.5697422) expect_equal(res$ncontrols, 29.5697422) }) test_that("kappa works with two ROC curves", { # kappa from data res <- power.roc.test(r.s100b, r.ndka, sig.level = 0.05, power = 0.9) expect_equal(res$ncases, 213.117677) expect_equal(res$ncontrols, 374.255432) expect_equal(res$ncases/res$ncontrols, length(r.s100b$cases)/length(r.s100b$controls)) # set kappa res <- power.roc.test(r.s100b, r.ndka, sig.level = 0.05, power = 0.9, kappa = 1) expect_equal(res$ncases, 213.117677) expect_equal(res$ncases, 213.117677) # ... }) pROC/tests/testthat/helper-expect_equal_roc.R0000644000176200001440000000262213607143106021004 0ustar liggesusersremove.calls.recursive <- function(x) { if (is.null(x)) return(NULL) attr(x, "roc") <- remove.calls.recursive(attr(x, "roc")) attr(x, "auc") <- remove.calls.recursive(attr(x, "auc")) attr(x, "ci") <- remove.calls.recursive(attr(x, "ci")) if (!is.list(x)) return(x) x$roc <- remove.calls.recursive(x$roc) x$auc <- remove.calls.recursive(x$auc) x$ci <- remove.calls.recursive(x$ci) x$call <- NULL return(x) } remove.response.names.recursive <- function(x) { if (is.null(x)) return(NULL) attr(x, "roc") <- remove.response.names.recursive(attr(x, "roc")) attr(x, "auc") <- remove.response.names.recursive(attr(x, "auc")) attr(x, "ci") <- remove.response.names.recursive(attr(x, "ci")) if (!is.list(x)) return(x) x$roc <- remove.response.names.recursive(x$roc) x$auc <- remove.response.names.recursive(x$auc) x$ci <- remove.response.names.recursive(x$ci) names(x$response) <- NULL names(x$original.response) <- NULL return(x) } expect_equal_ignore_call <- function(x, y, ...) { x <- remove.calls.recursive(x) y <- remove.calls.recursive(y) expect_equal(x, y, ...) } expect_equal_roc_formula <- function(x, y, ...) { # roc.formula adds names to response and original.response # this expectation ignores them, as well as the call x <- remove.calls.recursive(x) x <- remove.response.names.recursive(x) y <- remove.calls.recursive(y) y <- remove.response.names.recursive(y) expect_equal(x, y, ...) } pROC/tests/testthat/test-ci.auc.R0000644000176200001440000000516514114130125016320 0ustar liggesuserslibrary(pROC) data(aSAH) context("ci.auc") expected.ci.auc <- c(0.501244999271703, 0.611957994579946, 0.722670989888189) test_that("ci.auc with delong works", { test.ci <- ci.auc(r.ndka) expect_is(test.ci, "ci.auc") expect_equal(as.numeric(test.ci), expected.ci.auc) }) test_that("ci.auc with delong and percent works", { expect_equal(as.numeric(ci.auc(r.ndka.percent)), expected.ci.auc * 100) }) test_that("ci.auc works with an auc", { expect_equal(as.numeric(ci.auc(auc(r.ndka))), expected.ci.auc) }) test_that("ci.auc works with a formula", { expect_equal(as.numeric(ci.auc(outcome ~ ndka, data = aSAH)), expected.ci.auc) expect_equal(as.numeric(ci.auc(outcome ~ ndka, data = aSAH, subset = (gender == "Female"))), c(0.5261398281, 0.6671428571, 0.8081458862)) }) test_that("ci.auc works with a response, predictor", { expect_equal(as.numeric(ci.auc(aSAH$outcome, aSAH$ndka)), expected.ci.auc) }) test_that("ci.auc works with a direction = >", { expect_equal(as.numeric(ci.auc(aSAH$outcome, -aSAH$ndka)), expected.ci.auc) }) test_that("ci.auc works with a direction = > and percent", { expect_equal(as.numeric(ci.auc(aSAH$outcome, -aSAH$ndka, percent = TRUE)), expected.ci.auc * 100) }) test_that("ci.auc.auc works with a partial AUC from a roc with full AUC", { ci.s100b <- ci.auc(r.s100b) expect_equal(attr(ci.s100b, "method"), "delong") pauc.s100b <- auc(r.s100b, partial.auc = c(1, .9), partial.auc.focus = "se", partial.auc.correct = TRUE) ci.pauc.s100b <- ci.auc(pauc.s100b, boot.n = 10, progress = "none") expect_equal(attr(ci.pauc.s100b, "method"), "bootstrap") expect_equal(attr(attr(ci.pauc.s100b, "auc"), "partial.auc"), c(1, .9)) expect_equal(attr(attr(ci.pauc.s100b, "auc"), "partial.auc.focus"), "sensitivity") expect_equal(attr(attr(ci.pauc.s100b, "auc"), "partial.auc.correct"), TRUE) }) # Only test whether ci.auc runs and returns without error. # Uses a very small number of iterations for speed # Doesn't test whether the results are correct. for (stratified in c(TRUE, FALSE)) { for (test.roc in list(r.s100b, smooth(r.s100b), auc(r.s100b), r.s100b.partial1, r.s100b.partial2$auc)) { test_that("ci.auc with bootstrap works", { n <- round(runif(1, 3, 9)) # keep boot.n small test.ci <- ci.auc(test.roc, method = "bootstrap", boot.n = n, conf.level = .91, boot.stratified = stratified) expect_is(test.ci, "ci.auc") expect_equal(attr(test.ci, "conf.level"), .91) expect_equal(attr(test.ci, "boot.n"), n) expect_equal(attr(test.ci, "names"), c("4.5%", "50%", "95.5%")) expect_equal(attr(test.ci, "boot.stratified"), stratified) expect_equal(attr(test.ci, "method"), "bootstrap") }) } } pROC/tests/testthat/helper-coords-expected-smooth.R0000644000176200001440000074517114114130125022065 0ustar liggesusersexpected.coords.smooth <- structure(list(specificity = c(0, 0, 0.0063876682047232566, 0.013341366018777983, 0.020344288637047788, 0.027321138458733209, 0.034245743799788037, 0.041107222765956283, 0.047900945707538736, 0.054625228227432557, 0.06127989178096771, 0.067865563419956504, 0.074383308025182157, 0.080834424386697454, 0.087220327715743229, 0.093542480197314287, 0.099802349355844783, 0.10600138304507743, 0.11214099462234878, 0.11822255447772069, 0.12424738557818903, 0.13021676156515763, 0.13613190647507273, 0.1419939954827657, 0.14780415627554608, 0.15356347080026317, 0.15927297721313649, 0.16493367192005864, 0.17054651163370069, 0.17611241539974179, 0.18163226656209822, 0.1871069146489438, 0.1925371771693811, 0.19792384131606294, 0.20326766557271303, 0.20856938122789384, 0.21382969379791589, 0.219049284362727, 0.22422881081915672, 0.22936890905615351, 0.23447019405671882, 0.23953326093117833, 0.24455868588628721, 0.2495470271344763, 0.25449882574732086, 0.25941460645706815, 0.26429487840982402, 0.26914013587375324, 0.27395085890542092, 0.27872751397717088, 0.28347055456823173, 0.28818042172204017, 0.29285754457208801, 0.2975023408384237, 0.30211521729678031, 0.30669657022215341, 0.31124678580851772, 0.31576624056624358, 0.32025530169865385, 0.32471432745906315, 0.32914366748953655, 0.33354366314251832, 0.33791464778639069, 0.342256947095955, 0.34657087932875247, 0.35085675558807577, 0.35511488007346248, 0.35934555031941051, 0.36354905742300025, 0.36772568626106339, 0.37187571569749278, 0.37599941878125098, 0.38009706293559647, 0.38416891013901217, 0.38821521709828771, 0.39223623541418051, 0.39623221174005496, 0.40020338793386673, 0.40415000120384392, 0.40807228424818842, 0.41197046538910903, 0.41584476870146958, 0.41969541413632322, 0.42352261763959081, 0.4273265912661155, 0.43110754328932877, 0.43486567830672918, 0.43860119734138125, 0.44231429793962029, 0.4460051742651413, 0.44967401718964001, 0.45332101438016259, 0.45694635038331716, 0.46055020670648894, 0.46413276189618768, 0.46769419161365994, 0.47123466870788472, 0.47475436328606568, 0.4782534427817271, 0.48173207202051782, 0.48519041328381829, 0.48862862637024612, 0.4920468686551428, 0.49544529514812818, 0.4988240585488013, 0.50218330930066313, 0.50552319564333026, 0.50884386366310908, 0.51214545734199823, 0.51542811860517501, 0.51869198736703048, 0.52193720157580414, 0.5251638972568754, 0.52837220855476352, 0.53156226777387916, 0.53473420541808003, 0.53788815022907221, 0.54102422922370053, 0.54414256773016745, 0.54724328942321931, 0.55032651635833885, 0.55339236900497768, 0.55644096627886364, 0.55947242557341292, 0.56248686279028304, 0.56548439236909254, 0.56846512731633758, 0.57142917923353087, 0.57437665834459217, 0.57730767352251555, 0.58022233231533249, 0.58312074097140132, 0.58600300446403908, 0.58886922651552276, 0.59171950962047493, 0.5945539550686566, 0.59737266296718738, 0.60017573226220944, 0.60296326076001072, 0.60573534514762939, 0.60849208101295238, 0.61123356286432329, 0.61395988414967717, 0.61667113727521439, 0.61936741362362824, 0.62204880357190162, 0.62471539650868158, 0.62736728085124871, 0.6300045440620905, 0.63262727266509211, 0.63523555226135375, 0.63782946754464698, 0.64040910231652071, 0.64297453950106542, 0.6455258611593474, 0.64806314850351865, 0.65058648191061685, 0.65309594093606016, 0.65559160432684593, 0.65807355003446322, 0.6605418552275244, 0.66299659630412688, 0.66543784890394897, 0.66786568792008838, 0.67028018751065144, 0.67268142111009854, 0.67506946144035118, 0.67744438052166933, 0.67980624968330339, 0.68215513957392748, 0.68449112017185987, 0.68681426079507402, 0.68912463011100922, 0.69142229614618289, 0.69370732629561094, 0.69597978733204036, 0.69823974541499956, 0.70048726609967127, 0.70272241434559046, 0.70494525452517365, 0.70715585043208284, 0.70935426528942924, 0.71154056175781788, 0.71371480194324077, 0.71587704740481894, 0.71802735916239968, 0.72016579770401035, 0.72229242299317242, 0.72440729447608099, 0.72651047108865063, 0.72860201126343227, 0.73068197293640225, 0.73275041355362869, 0.7348073900778177, 0.73685295899474013, 0.73888717631954259, 0.74091009760294813, 0.74292177793734493, 0.74492227196276717, 0.74691163387277126, 0.74888991742020927, 0.7508571759229008, 0.75281346226920764, 0.75475882892351143, 0.75669332793159638, 0.75861701092594203, 0.76052992913092377, 0.76243213336792592, 0.76432367406036938, 0.76620460123865342, 0.76807496454501578, 0.76993481323831137, 0.77178419619871241, 0.77362316193233038, 0.77545175857576276, 0.77727003390056426, 0.77907803531764674, 0.78087580988160721, 0.78266340429498593, 0.78444086491245568, 0.78620823774494508, 0.7879655684636957, 0.78971290240425529, 0.79145028457040634, 0.79317775963803561, 0.79489537195894089, 0.79660316556458, 0.7983011841697597, 0.79998947117626984, 0.80166806967646043, 0.80333702245676342, 0.80499637200116236, 0.80664616049460758, 0.8082864298263811, 0.80991722159341029, 0.81153857710353106, 0.81315053737870402, 0.81475314315818159, 0.81634643490162795, 0.81793045279219423, 0.81950523673954656, 0.82107082638285234, 0.82262726109372064, 0.82417457997910082, 0.82571282188413953, 0.82724202539499636, 0.82876222884161865, 0.83027347030047749, 0.83177578759726334, 0.83326921830954548, 0.83475379976939235, 0.83622956906595491, 0.83769656304801488, 0.83915481832649719, 0.84060437127694643, 0.84204525804197017, 0.84347751453364772, 0.84490117643590712, 0.84631627920686747, 0.84772285808115122, 0.84912094807216409, 0.85051058397434431, 0.85189180036538148, 0.85326463160840571, 0.85462911185414769, 0.85598527504306898, 0.85733315490746531, 0.85867278497354116, 0.860004198563457, 0.86132742879735069, 0.86264250859532998, 0.86394947067944194, 0.86524834757561508, 0.86653917161557648, 0.86782197493874436, 0.86909678949409652, 0.8703636470420143, 0.87162257915610364, 0.87287361722499246, 0.87411679245410556, 0.87535213586741711, 0.87657967830918038, 0.8777994504456369, 0.87901148276670371, 0.88021580558763901, 0.8814124490506885, 0.88260144312670974, 0.88378281761677768, 0.88495660215377037, 0.88612282620393445, 0.887281519068432, 0.88843270988486922, 0.8895764276288054, 0.89071270111524437, 0.89184155900010798, 0.89296302978169173, 0.89407714180210296, 0.89518392324868201, 0.89628340215540625, 0.89737560640427838, 0.89846056372669636, 0.89953830170481008, 0.90060884777285888, 0.90167222921849643, 0.9027284731840981, 0.90377760666805396, 0.90481965652604679, 0.90585464947231509, 0.90688261208090193, 0.90790357078688899, 0.90891755188761658, 0.90992458154389055, 0.9109246857811738, 0.91191789049076621, 0.9129042214309695, 0.91388370422824039, 0.91485636437832973, 0.91582222724740936, 0.91678131807318641, 0.9177336619660047, 0.9186792839099347, 0.91961820876385059, 0.92055046126249596, 0.92147606601753718, 0.92239504751860624, 0.92330743013433036, 0.92421323811335276, 0.92511249558533959, 0.92600522656197815, 0.9268914549379631, 0.9277712044919717, 0.92864449888762968, 0.9295113616744658, 0.93037181628885568, 0.93122588605495715, 0.93207359418563374, 0.93291496378336902, 0.93375001784117173, 0.9345787792434701, 0.93540127076699753, 0.93621751508166828, 0.9370275347514444, 0.93783135223519287, 0.93862898988753385, 0.93942046995968032, 0.94020581460026809, 0.94098504585617782, 0.94175818567334779, 0.94252525589757796, 0.94328627827532674, 0.94404127445449715, 0.94479026598521709, 0.94553327432060974, 0.94627032081755624, 0.94700142673745069, 0.94772661324694663, 0.948445901418696, 0.94915931223207983, 0.94986686657393182, 0.95056858523925392, 0.95126448893192372, 0.9519545982653953, 0.95263893376339182, 0.95331751586059132, 0.95399036490330402, 0.95465750115014403, 0.95531894477269186, 0.95597471585615146, 0.95662483439999868, 0.95726932031862366, 0.95790819344196521, 0.95854147351613928, 0.95916918020405906, 0.95979133308604903, 0.96040795166045212, 0.96101905534422882, 0.96162466347355136, 0.96222479530438876, 0.96281947001308654, 0.96340870669693912, 0.96399252437475536, 0.96457094198741689, 0.96514397839843047, 0.96571165239447232, 0.96627398268592701, 0.96683098790741795, 0.96738268661833171, 0.96792909730333621, 0.96847023837289026, 0.9690061281637472, 0.96953678493945172, 0.97006222689082899, 0.97058247213646642, 0.97109753872318938, 0.97160744462652837, 0.97211220775118012, 0.97261184593145977, 0.97310637693174706, 0.97359581844692411, 0.97408018810280539, 0.97455950345656051, 0.9750337819971282, 0.97550304114562336, 0.97596729825573447, 0.97642657061411386, 0.97688087544075852, 0.97733022988938301, 0.97777465104778238, 0.97821415593818695, 0.97864876151760694, 0.97907848467816783, 0.97950334224743574, 0.97992335098873262, 0.98033852760144069, 0.98074888872129673, 0.98115445092067388, 0.98155523070885353, 0.981951244532284, 0.98234250877482743, 0.98272903975799319, 0.98311085374115881, 0.98348796692177631, 0.98386039543556436, 0.98422815535668517, 0.98459126269790587, 0.98494973341074321, 0.98530358338559165, 0.98565282845183233, 0.98599748437792412, 0.98633756687147511, 0.98667309157929162, 0.98700407408740765, 0.98733052992108938, 0.98765247454481619, 0.98796992336223621, 0.98828289171609418, 0.98859139488813152, 0.9888954480989548, 0.98919506650787348, 0.98949026521270289, 0.9897810592495303, 0.99006746359244391, 0.99034949315321963, 0.99062716278096463, 0.99090048726171431, 0.99116948131797933, 0.99143415960823911, 0.99169453672637875, 0.99195062720106486, 0.99220244549505521, 0.99245000600443833, 0.99269332305779756, 0.99293241091529283, 0.99316728376765517, 0.9933979557350856, 0.99362444086605128, 0.99384675313597126, 0.99406490644578094, 0.99427891462036555, 0.9944887914068522, 0.99469455047274657, 0.99489620540390078, 0.99509376970229735, 0.99528725678363095, 0.99547667997466949, 0.99566205251037365, 0.99584338753074819, 0.99602069807740146, 0.99619399708977974, 0.9963632974010439, 0.99652861173354923, 0.99668995269388394, 0.99684733276741755, 0.99700076431230134, 0.99715025955285719, 0.99729583057227922, 0.99743748930456388, 0.99757524752556959, 0.99770911684309094, 0.99783910868581716, 0.99796523429101713, 0.99808750469077223, 0.99820593069654184, 0.99832052288181017, 0.99843129156251398, 0.998538246774892, 0.99864139825032627, 0.99874075538665208, 0.99883632721530369, 0.99892812236351414, 0.99901614901061087, 0.9991004148372028, 0.99918092696575589, 0.9992576918906384, 0.99933071539517937, 0.99940000245254867, 0.99946555710625573, 0.99952738232466198, 0.99958547982189927, 0.99963984983468901, 0.99969049084025274, 0.99973739919394899, 0.99978056865497356, 0.99981998975172415, 0.99985564891007006, 0.99988752721731322, 0.99991559859934254, 0.99993982699459871, 0.99996016167415558, 0.99997652874920029, 0.99998881349177671, 0.99999681366490334, 1, 1), sensitivity = c(1, 1, 0.99804305283757333, 0.99608610567514666, 0.9941291585127201, 0.99217221135029354, 0.99021526418786687, 0.9882583170254402, 0.98630136986301364, 0.98434442270058709, 0.98238747553816042, 0.98043052837573375, 0.97847358121330719, 0.97651663405088063, 0.97455968688845396, 0.97260273972602729, 0.97064579256360073, 0.96868884540117417, 0.9667318982387475, 0.96477495107632083, 0.96281800391389427, 0.96086105675146771, 0.95890410958904104, 0.95694716242661437, 0.95499021526418781, 0.95303326810176126, 0.95107632093933459, 0.94911937377690792, 0.94716242661448136, 0.9452054794520548, 0.94324853228962813, 0.94129158512720146, 0.9393346379647749, 0.93737769080234834, 0.93542074363992167, 0.93346379647749489, 0.93150684931506844, 0.92954990215264188, 0.92759295499021521, 0.92563600782778854, 0.92367906066536198, 0.92172211350293543, 0.91976516634050876, 0.91780821917808209, 0.91585127201565553, 0.91389432485322897, 0.9119373776908023, 0.90998043052837563, 0.90802348336594907, 0.90606653620352251, 0.90410958904109584, 0.90215264187866917, 0.90019569471624261, 0.89823874755381605, 0.89628180039138938, 0.89432485322896271, 0.89236790606653615, 0.8904109589041096, 0.88845401174168304, 0.88649706457925626, 0.8845401174168297, 0.88258317025440314, 0.88062622309197647, 0.8786692759295498, 0.87671232876712324, 0.87475538160469657, 0.8727984344422699, 0.87084148727984334, 0.86888454011741678, 0.86692759295499022, 0.86497064579256355, 0.86301369863013688, 0.86105675146771044, 0.85909980430528377, 0.8571428571428571, 0.85518590998043043, 0.85322896281800387, 0.85127201565557742, 0.84931506849315064, 0.84735812133072397, 0.84540117416829741, 0.84344422700587085, 0.84148727984344429, 0.83953033268101751, 0.83757338551859095, 0.83561643835616439, 0.83365949119373772, 0.83170254403131105, 0.82974559686888449, 0.82778864970645794, 0.82583170254403138, 0.8238747553816046, 0.82191780821917804, 0.81996086105675148, 0.81800391389432481, 0.81604696673189814, 0.81409001956947158, 0.81213307240704502, 0.81017612524461835, 0.80821917808219157, 0.80626223091976512, 0.80430528375733856, 0.802348336594912, 0.80039138943248522, 0.79843444227005878, 0.79647749510763211, 0.79452054794520544, 0.79256360078277877, 0.79060665362035221, 0.78864970645792565, 0.78669275929549909, 0.78473581213307231, 0.78277886497064575, 0.78082191780821919, 0.77886497064579252, 0.77690802348336585, 0.77495107632093929, 0.77299412915851273, 0.77103718199608617, 0.76908023483365939, 0.76712328767123283, 0.76516634050880639, 0.76320939334637972, 0.76125244618395294, 0.75929549902152638, 0.75733855185909993, 0.75538160469667315, 0.75342465753424648, 0.75146771037181992, 0.74951076320939336, 0.74755381604696669, 0.74559686888454002, 0.74363992172211346, 0.7416829745596869, 0.73972602739726023, 0.73776908023483356, 0.73581213307240712, 0.73385518590998045, 0.73189823874755378, 0.72994129158512711, 0.72798434442270055, 0.72602739726027399, 0.72407045009784743, 0.72211350293542065, 0.72015655577299409, 0.71819960861056753, 0.71624266144814086, 0.71428571428571419, 0.71232876712328763, 0.71037181996086107, 0.7084148727984344, 0.70645792563600773, 0.70450097847358117, 0.70254403131115462, 0.70058708414872795, 0.69863013698630128, 0.69667318982387472, 0.69471624266144816, 0.69275929549902149, 0.69080234833659482, 0.68884540117416826, 0.6868884540117417, 0.68493150684931503, 0.68297455968688836, 0.6810176125244618, 0.67906066536203524, 0.67710371819960857, 0.6751467710371819, 0.67318982387475523, 0.67123287671232879, 0.669275929549902, 0.66731898238747545, 0.66536203522504889, 0.66340508806262233, 0.66144814090019555, 0.65949119373776899, 0.65753424657534243, 0.65557729941291587, 0.6536203522504892, 0.65166340508806253, 0.64970645792563597, 0.64774951076320941, 0.64579256360078274, 0.64383561643835607, 0.64187866927592951, 0.63992172211350296, 0.63796477495107629, 0.63600782778864962, 0.63405088062622306, 0.6320939334637965, 0.63013698630136983, 0.62818003913894316, 0.6262230919765166, 0.62426614481409004, 0.62230919765166337, 0.6203522504892367, 0.61839530332681014, 0.61643835616438358, 0.61448140900195691, 0.61252446183953024, 0.61056751467710368, 0.60861056751467713, 0.60665362035225046, 0.60469667318982379, 0.60273972602739723, 0.60078277886497067, 0.598825831702544, 0.59686888454011733, 0.59491193737769077, 0.59295499021526421, 0.59099804305283754, 0.58904109589041087, 0.58708414872798431, 0.58512720156555775, 0.58317025440313108, 0.58121330724070441, 0.57925636007827785, 0.5772994129158513, 0.57534246575342463, 0.57338551859099796, 0.5714285714285714, 0.56947162426614484, 0.56751467710371817, 0.5655577299412915, 0.56360078277886494, 0.56164383561643838, 0.55968688845401171, 0.55772994129158504, 0.55577299412915848, 0.55381604696673192, 0.55185909980430525, 0.54990215264187858, 0.54794520547945202, 0.54598825831702547, 0.5440313111545988, 0.54207436399217213, 0.54011741682974557, 0.53816046966731901, 0.53620352250489234, 0.53424657534246567, 0.53228962818003911, 0.53033268101761255, 0.52837573385518588, 0.52641878669275921, 0.52446183953033265, 0.52250489236790609, 0.52054794520547942, 0.51859099804305275, 0.51663405088062619, 0.51467710371819964, 0.51272015655577297, 0.5107632093933463, 0.50880626223091974, 0.50684931506849318, 0.50489236790606651, 0.50293542074363984, 0.50097847358121328, 0.49902152641878667, 0.49706457925636005, 0.49510763209393344, 0.49315068493150682, 0.49119373776908021, 0.48923679060665359, 0.48727984344422698, 0.48532289628180036, 0.48336594911937375, 0.48140900195694714, 0.47945205479452052, 0.47749510763209391, 0.47553816046966729, 0.47358121330724068, 0.47162426614481406, 0.46966731898238745, 0.46771037181996084, 0.46575342465753422, 0.46379647749510761, 0.46183953033268099, 0.45988258317025438, 0.45792563600782776, 0.45596868884540115, 0.45401174168297453, 0.45205479452054792, 0.45009784735812131, 0.44814090019569469, 0.44618395303326808, 0.44422700587084146, 0.44227005870841485, 0.44031311154598823, 0.43835616438356162, 0.43639921722113501, 0.43444227005870839, 0.43248532289628178, 0.43052837573385516, 0.42857142857142855, 0.42661448140900193, 0.42465753424657537, 0.4227005870841487, 0.42074363992172209, 0.41878669275929548, 0.41682974559686886, 0.41487279843444225, 0.41291585127201569, 0.41095890410958907, 0.4090019569471624, 0.40704500978473579, 0.40508806262230923, 0.40313111545988256, 0.40117416829745595, 0.39921722113502939, 0.39726027397260272, 0.39530332681017616, 0.39334637964774949, 0.39138943248532287, 0.38943248532289626, 0.38747553816046965, 0.38551859099804303, 0.38356164383561642, 0.38160469667318986, 0.37964774951076319, 0.37769080234833657, 0.37573385518590996, 0.3737769080234834, 0.37181996086105673, 0.36986301369863012, 0.3679060665362035, 0.36594911937377694, 0.36399217221135027, 0.36203522504892366, 0.36007827788649704, 0.35812133072407043, 0.35616438356164382, 0.3542074363992172, 0.35225048923679059, 0.35029354207436392, 0.34833659491193741, 0.3463796477495108, 0.34442270058708419, 0.34246575342465752, 0.34050880626223096, 0.33855185909980429, 0.33659491193737767, 0.33463796477495111, 0.33268101761252444, 0.33072407045009783, 0.32876712328767127, 0.3268101761252446, 0.32485322896281799, 0.32289628180039132, 0.32093933463796476, 0.31898238747553814, 0.31702544031311153, 0.31506849315068497, 0.31311154598825836, 0.31115459882583163, 0.30919765166340507, 0.30724070450097851, 0.30528375733855184, 0.30332681017612523, 0.30136986301369861, 0.299412915851272, 0.29745596868884538, 0.29549902152641883, 0.29354207436399216, 0.2915851272015656, 0.28962818003913887, 0.28767123287671237, 0.2857142857142857, 0.28375733855185903, 0.28180039138943253, 0.27984344422700586, 0.27788649706457924, 0.27592954990215257, 0.27397260273972601, 0.27201565557729945, 0.27005870841487278, 0.26810176125244617, 0.26614481409001955, 0.264187866927593, 0.26223091976516638, 0.26027397260273977, 0.2583170254403131, 0.25636007827788648, 0.25440313111545987, 0.25244618395303331, 0.2504892367906067, 0.24853228962818005, 0.24657534246575341, 0.2446183953033268, 0.2426614481409001, 0.24070450097847362, 0.23874755381604693, 0.23679060665362034, 0.23483365949119361, 0.23287671232876717, 0.23091976516634047, 0.22896281800391383, 0.22700587084148729, 0.22504892367906071, 0.22309197651663407, 0.2211350293542074, 0.21917808219178078, 0.2172211350293542, 0.21526418786692758, 0.21330724070450094, 0.21135029354207435, 0.20939334637964774, 0.20743639921722107, 0.20547945205479451, 0.20352250489236787, 0.20156555772994122, 0.19960861056751467, 0.19765166340508805, 0.19569471624266147, 0.19373776908023482, 0.19178082191780826, 0.18982387475538162, 0.18786692759295498, 0.18590998043052842, 0.18395303326810175, 0.18199608610567519, 0.18003913894324852, 0.17808219178082194, 0.17612524461839529, 0.17416829745596865, 0.17221135029354201, 0.17025440313111548, 0.16829745596868884, 0.16634050880626222, 0.16438356164383566, 0.16242661448140899, 0.16046966731898241, 0.15851272015655576, 0.15655577299412918, 0.15459882583170251, 0.15264187866927589, 0.15068493150684936, 0.14872798434442261, 0.14677103718199611, 0.14481409001956941, 0.14285714285714282, 0.14090019569471618, 0.13894324853228959, 0.13698630136986298, 0.13502935420743636, 0.13307240704500972, 0.13111545988258316, 0.12915851272015663, 0.12720156555772999, 0.1252446183953034, 0.12328767123287671, 0.12133072407045009, 0.11937377690802352, 0.11741682974559686, 0.11545988258317025, 0.11350293542074361, 0.11154598825831699, 0.10958904109589039, 0.1076320939334638, 0.1056751467710372, 0.10371819960861053, 0.10176125244618392, 0.099804305283757389, 0.097847358121330733, 0.09589041095890416, 0.093933463796477504, 0.091976516634050862, 0.090019569471624289, 0.088062622309197675, 0.086105675146771019, 0.084148727984344446, 0.082191780821917845, 0.080234833659491259, 0.078277886497064589, 0.076320939334637947, 0.074363992172211374, 0.072407045009784773, 0.070450097847358159, 0.068493150684931517, 0.066536203522504889, 0.064579256360078302, 0.062622309197651688, 0.060665362035225066, 0.058708414872798501, 0.056751467710371865, 0.054794520547945209, 0.052837573385518657, 0.050880626223092015, 0.048923679060665401, 0.046966731898238773, 0.045009784735812165, 0.043052837573385544, 0.041095890410958923, 0.039138943248532329, 0.03718199608610568, 0.035225048923679107, 0.033268101761252479, 0.031311154598825837, 0.029354207436399233, 0.027397260273972615, 0.02544031311154599, 0.023483365949119386, 0.021526418786692772, 0.019569471624266147, 0.017612524461839554, 0.015655577299412939, 0.013698630136986308, 0.011741682974559685, 0.0097847358121330927, 0.0078277886497064766, 0.0058708414872798544, 0.0039138943248532305, 0.0019569471624266178, 0, 0), accuracy = c(0.36283185840707965, 0.36283185840707965, 0.36619183431044761, 0.36991246624807989, 0.37366446266273423, 0.37739984632204271, 0.38110194146271931, 0.38476381448842389, 0.38838251553386144, 0.3919569713548603, 0.39548706818844476, 0.39897320557205268, 0.40241606201379387, 0.40581646506131258, 0.40917531644212501, 0.41249354781392694, 0.41577209423653499, 0.4190118782362276, 0.4222138003592722, 0.42537873377455793, 0.42850752143450693, 0.43160097486284538, 0.43465987397660105, 0.43768496755973735, 0.44067697413868157, 0.44363658309549697, 0.44656445591025262, 0.44946122746103934, 0.4523275073346919, 0.45516388111783768, 0.45797091164907805, 0.46074914022070107, 0.46349908772346204, 0.46622125573144085, 0.46891612752630196, 0.47158416906181994, 0.47422582987051104, 0.47684154391481998, 0.47943173038564696, 0.48199679445117155, 0.48453712795896986, 0.48705311009438224, 0.48954510799799594, 0.49201347734498818, 0.49445856288892903, 0.49688069897248932, 0.49928021000734707, 0.50165741092543037, 0.50401260760348865, 0.5063460972628383, 0.50865816884599657, 0.51094910337179045, 0.51321917427040953, 0.51546864769976075, 0.51769778284438184, 0.51990683219807543, 0.52209604183133851, 0.52426565164458427, 0.52641589560807156, 0.52854700198939875, 0.53065919356935087, 0.53275268784683061, 0.53482769723355006, 0.53688442923911772, 0.53892308664709943, 0.54094386768260194, 0.54294696617187932, 0.54493257169443476, 0.54690086972805407, 0.54885204178717839, 0.55078626555499632, 0.5527037150096078, 0.55460456054459362, 0.55648896908429646, 0.55835710419410489, 0.56020912618600571, 0.56204519221966476, 0.56386545639926622, 0.56567006986633572, 0.56745918088875447, 0.56923293494615979, 0.57099147481191603, 0.57273494063182739, 0.57446346999975439, 0.576177198030288, 0.57787625742862314, 0.57956077855776766, 0.58123088950321422, 0.58288671613519405, 0.5845283821686279, 0.5861560092208794, 0.58776971686741153, 0.5893696226954438, 0.59095584235569931, 0.59252848961232596, 0.59408767639107385, 0.59563351282580557, 0.59716610730341213, 0.59868556650720095, 0.60019199545882418, 0.60168549755880785, 0.60316617462573996, 0.60463412693417418, 0.60608945325130203, 0.60753225087244334, 0.6089626156554041, 0.61038064205374509, 0.61178642314900689, 0.61318005068193193, 0.61456161508272167, 0.61593120550036851, 0.61728890983109619, 0.61863481474594251, 0.61996900571752178, 0.62129156704598931, 0.62260258188424578, 0.62390213226240443, 0.62519029911155266, 0.62646716228682831, 0.62773280058983916, 0.62898729179045088, 0.63023071264795971, 0.63146313893167927, 0.63268464544095393, 0.63389530602462796, 0.63509519359998012, 0.63628438017114963, 0.63746293684706479, 0.63863093385889602, 0.63978844057704631, 0.64093552552769528, 0.64207225640891186, 0.64319870010634927, 0.64431492270853807, 0.64542098952178639, 0.64651696508470313, 0.64760291318235563, 0.6486788968600733, 0.64974497843690693, 0.6508012195187568, 0.65184768101117951, 0.65288442313188066, 0.6539115054229071, 0.65492898676254585, 0.65593692537693793, 0.65693537885141762, 0.65792440414158282, 0.65890405758410786, 0.6598743949073036, 0.66083547124143305, 0.66178734112879001, 0.66273005853354783, 0.66366367685138339, 0.66458824891888546, 0.66550382702275102, 0.66641046290877604, 0.66730820779064848, 0.66819711235854606, 0.66907722678754677, 0.66994860074585616, 0.67081128340285545, 0.67166532343697827, 0.672510769043418, 0.67334766794167067, 0.67417606738291891, 0.6749960141572614, 0.67580755460078967, 0.67661073460251908, 0.6774055996111753, 0.67819219464184288, 0.67897056428247693, 0.67974075270028156, 0.68050280364796167, 0.68125676046984662, 0.68200266610789384, 0.68274056310757025, 0.68347049362361956, 0.68419249942571581, 0.68490662190400509, 0.6856129020745404, 0.68631138058461094, 0.68700209771796894, 0.68768509339995565, 0.68836040720253044, 0.68902807834920421, 0.68968814571987969, 0.69034064785560068, 0.69098562296321286, 0.69162310891993783, 0.69225314327786291, 0.69287576326834766, 0.6934910058063507, 0.69409890749467651, 0.69469950462814656, 0.69529283319769464, 0.69587892889438741, 0.69645782711337589, 0.69702956295777485, 0.69759417124247314, 0.69815168649787851, 0.69870214297359579, 0.69924557464204096, 0.69978201520199301, 0.70031149808208493, 0.70083405644423202, 0.7013497231870055, 0.70185853094894524, 0.70236051211181838, 0.70285569880382237, 0.70334412290273352, 0.70382581603900418, 0.7043008095988077, 0.70476913472703229, 0.70523082233022705, 0.70568590307949819, 0.70613440741335853, 0.7065763655405306, 0.70701180744270464, 0.70744076287725133, 0.70786326137989131, 0.70827933226732276, 0.70868900463980555, 0.70909230738370643, 0.7094892691740019, 0.70987991847674359, 0.71026428355148419, 0.71064239245366589, 0.71101427303697073, 0.71137995295563661, 0.71173945966673591, 0.71209282043242017, 0.7124400623221302, 0.71278121221477231, 0.71311629680086264, 0.7134453425846381, 0.7137683758861354, 0.71408542284324117, 0.71439650941370936, 0.71470166137714863, 0.71500090433698293, 0.71529426372238003, 0.71558176479015478, 0.71586343262664165, 0.71613929214954319, 0.71640936810974942, 0.71667368509313178, 0.71693226752231154, 0.71718513965840303, 0.71743232560273129, 0.71767384929852618, 0.71790973453259244, 0.7181400049369554, 0.71836468399048481, 0.71858379502049574, 0.71879736120432625, 0.71900540557089454, 0.71920795100223345, 0.71940502023500497, 0.71959663586199307, 0.71978282033357655, 0.71996359595918225, 0.72013898490871753, 0.72030900921398466, 0.72047369077007528, 0.72063305133674738, 0.72078711253978134, 0.72093589587232154, 0.72107942269619729, 0.72121771424322789, 0.72135079161650983, 0.72147867579168701, 0.72160138761820536, 0.72171894782055024, 0.7218313769994682, 0.72193869563317248, 0.72204092407853415, 0.72213808257225609, 0.72223019123203447, 0.72231727005770263, 0.7223993389323633, 0.72247641762350434, 0.72254852578410134, 0.72261568295370648, 0.72267790855952341, 0.72273522191746897, 0.72278764223322189, 0.72283518860325757, 0.72287788001587183, 0.72291573535219023, 0.72294877338716657, 0.7229770127905677, 0.72300047212794816, 0.72301916986161097, 0.72303312435155898, 0.72304235385643245, 0.72304687653443711, 0.72304671044426128, 0.72304187354597971, 0.72303238370195011, 0.72301825867769609, 0.72299951614278113, 0.72297617367167222, 0.72294824874459285, 0.72291575874836644, 0.72287872097724981, 0.72283715263375714, 0.72279107082947391, 0.72274049258586182, 0.72268543483505443, 0.7226259144206435, 0.72256194809845664, 0.72249355253732606, 0.72242074431984737, 0.72234353994313194, 0.72226195581954922, 0.72217600827746087, 0.72208571356194695, 0.72199108783552435, 0.72189214717885586, 0.72178890759145253, 0.72168138499236822, 0.7215695952208856, 0.72145355403719491, 0.72133327712306639, 0.72120878008251321, 0.72108007844244815, 0.72094718765333421, 0.72081012308982595, 0.72066890005140549, 0.72052353376301082, 0.72037403937565803, 0.72022043196705532, 0.72006272654221193, 0.71990093803404021, 0.71973508130395003, 0.71956517114243856, 0.71939122226967267, 0.71921324933606479, 0.71903126692284347, 0.71884528954261773, 0.71865533163993445, 0.71846140759183186, 0.71826353170838397, 0.71806171823324294, 0.71785598134417261, 0.71764633515357823, 0.71743279370902957, 0.71721537099377952, 0.71699408092727579, 0.71676893736566882, 0.71653995410231308, 0.71630714486826286, 0.71607052333276544, 0.71583010310374462, 0.71558589772828363, 0.71533792069309965, 0.71508618542501545, 0.71483070529142378, 0.7145714936007499, 0.7143085636029064, 0.7140419284897449, 0.71377160139550122, 0.713497595397238, 0.71321992351528118, 0.71293859871365117, 0.71265363390049186, 0.71236504192849126, 0.71207283559530199, 0.71177702764395256, 0.71147763076325798, 0.7111746575882234, 0.71086812070044492, 0.71055803262850459, 0.71024440584836102, 0.70992725278373747, 0.70960658580650238, 0.70928241723704866, 0.70895475934466645, 0.70862362434791193, 0.70828902441497299, 0.70795097166402854, 0.70760947816360498, 0.70726455593292792, 0.7069162169422688, 0.70656447311328863, 0.70620933631937588, 0.70585081838598029, 0.70548893109094335, 0.70512368616482313, 0.70475509529121427, 0.70438317010706597, 0.70400792220299213, 0.70362936312357993, 0.70324750436769101, 0.70286235738876113, 0.70247393359509247, 0.70208224435014233, 0.70168730097280785, 0.70128911473770383, 0.70088769687543795, 0.7004830585728794, 0.70007521097342262, 0.69966416517724705, 0.69924993224157006, 0.69883252318089595, 0.69841194896725822, 0.69798822053045706, 0.69756134875829123, 0.6971313444967836, 0.69669821855040082, 0.69626198168226705, 0.69582264461437149, 0.69538021802776873, 0.69493471256277317, 0.69448613881914611, 0.69403450735627592, 0.69357982869335044, 0.69312211330952311, 0.6926613716440686, 0.69219761409653258, 0.69173085102687282, 0.69126109275558933, 0.69078834956384805, 0.69031263169359336, 0.68983394934764997, 0.68935231268981634, 0.68886773184494554, 0.68838021689901496, 0.68788977789918415, 0.68739642485384045, 0.68690016773263074, 0.68640101646647911, 0.68589898094759061, 0.68539407102943872, 0.68488629652673738, 0.68437566721539478, 0.68386219283244964, 0.68334588307598754, 0.68282674760503748, 0.68230479603944671, 0.68178003795973041, 0.6812524829069011, 0.68072214038226719, 0.68018901984720648, 0.67965313072291, 0.67911448239009231, 0.67857308418866935, 0.6780289454174, 0.67748207533348759, 0.67693248315214094, 0.67638017804608863, 0.67582516914504764, 0.67526746553513772, 0.67470707625824022, 0.67414401031129778, 0.67357827664554593, 0.67300988416567653, 0.67243884172892254, 0.67186515814406067, 0.67128884217032203, 0.6707099025162061, 0.67012834783818498, 0.66954418673929184, 0.6689574277675796, 0.66836807941444054, 0.66777615011276981, 0.66718164823495973, 0.66658458209070792, 0.66598495992461726, 0.66538278991356881, 0.66477808016384221, 0.6641708387079539, 0.66356107350118321, 0.66294879241775084, 0.66233400324660519, 0.66171671368677232, 0.66109693134221492, 0.66047466371613461, 0.65984991820464811, 0.65922270208975253, 0.65859302253147745, 0.65796088655911356, 0.65732630106137835, 0.65668927277535916, 0.65604980827404225, 0.65540791395219911, 0.65476359601035639, 0.65411686043651529, 0.65346771298521822, 0.65281615915346292, 0.65216220415285664, 0.65150585287723817, 0.65084710986481642, 0.65018597925359556, 0.64952246472852893, 0.64885656945836157, 0.64818829601948924, 0.64751764630325681, 0.64684462140185506, 0.646169221466115, 0.64549144552577065, 0.64481129125857295, 0.64412875468807984, 0.64344382977928827, 0.64275650788319449, 0.64206677694922998, 0.64137462036380188, 0.64068001514963335, 0.63998292898386888, 0.63928331478691058, 0.6385810994577602, 0.63787615413745602, 0.63716814159292035, 0.63716814159292035 ), tn = c(0, 0, 0.45991211074007449, 0.9605783533520148, 1.4647887818674408, 1.9671219690287911, 2.4656935535847389, 2.9597200391488525, 3.4488680909427889, 3.933016432375144, 4.4121522082296751, 4.8863205662368685, 5.355598177813115, 5.8200785558422163, 6.2798635955335129, 6.7350585742066285, 7.1857691536208241, 7.6320995792455752, 8.0741516128091124, 8.5120239223958905, 8.94581176162961, 9.37560683269135, 9.8014972662052369, 10.223567674759131, 10.641899251839318, 11.056569897618948, 11.467654359345827, 11.875224378244223, 12.279348837626449, 12.680093908781409, 13.077523192471071, 13.471697854723953, 13.862676756195439, 14.250516574756531, 14.635271921235338, 15.016995448408357, 15.395737953449943, 15.771548474116344, 16.144474378979282, 16.514561452043054, 16.881853972083753, 17.246394787044839, 17.60822538381268, 17.967385953682292, 18.323915453807103, 18.677851664908907, 19.029231245507329, 19.378089782910234, 19.724461841190305, 20.068381006356304, 20.409879928912684, 20.748990363986891, 21.085743209190337, 21.420168540366507, 21.752295645368182, 22.082153055995047, 22.409768578213274, 22.735169320769536, 23.058381722303078, 23.379431577052546, 23.698344059246633, 24.01514374626132, 24.32985464062013, 24.642500190908759, 24.953103311670176, 25.261686402341457, 25.568271365289299, 25.872879622997559, 26.17553213445602, 26.476249410796562, 26.775051530219478, 27.071958152250069, 27.366988531362946, 27.660161530008875, 27.951495631076714, 28.241008949820998, 28.528719245283959, 28.814643931238404, 29.098800086676761, 29.381204465869565, 29.661873508015852, 29.940823346505809, 30.218069817815273, 30.493628470050538, 30.767514571160316, 31.039743116831673, 31.310328838084502, 31.57928620857945, 31.84662945165266, 32.112372547090175, 32.376529237654083, 32.639113035371707, 32.900137227598833, 33.159614882867203, 33.417558856525517, 33.673981796183519, 33.928896146967702, 34.182314156596732, 34.434247880284353, 34.684709185477281, 34.933709756434915, 35.181261098657721, 35.427374543170281, 35.67206125066523, 35.915332215513693, 36.157198269647743, 36.397670086319778, 36.636758183743851, 36.874472928623874, 37.110824539572604, 37.345823090426194, 37.5794785134579, 37.811800602495026, 38.042799015942975, 38.272483279719296, 38.500862790101763, 38.727946816493201, 38.953744504106439, 39.178264876572058, 39.401516838471792, 39.6235091778004, 39.84425056835839, 40.06374957207818, 40.282014641285727, 40.499054120900382, 40.714876250574662, 40.929489166776307, 41.142900904814226, 41.355119400810636, 41.566152493621118, 41.77600792670394, 41.984693349940898, 42.192216321410811, 42.398584309117638, 42.603804692674196, 42.807884764943275, 43.010831733637488, 43.212652722879078, 43.413354774720773, 43.612944850629319, 43.811429832932575, 44.008816526231278, 44.205111658776758, 44.400321883815437, 44.594453780901233, 44.787513857176918, 44.979508548625077, 45.170444221289905, 45.360327172470519, 45.549163631886628, 45.73695976281747, 45.923721663214579, 46.10945536678949, 46.294166844076713, 46.477862003473014, 46.660546692253341, 46.842226697564413, 47.022907747396332, 47.202595511532905, 47.381295602481352, 47.559013576381759, 47.735754933897134, 47.911525121084324, 48.08632953024636, 48.260173500766903, 48.433062319927096, 48.605001223705287, 48.775995397560195, 48.946049977197845, 49.115170049322778, 49.283360652373908, 49.450626777245333, 49.616973367992664, 49.782405322525165, 49.946927493283987, 50.110544687906909, 50.273261669879972, 50.43508315917633, 50.596013832882512, 50.756058325812504, 50.915221231109967, 51.073507100838903, 51.230920446562891, 51.387465739913338, 51.543147413146961, 51.697969859692776, 51.851937434688743, 52.005054455508414, 52.157325202277832, 52.308753918382848, 52.459344810967124, 52.609102051420962, 52.758029775861267, 52.906132085602877, 53.053413047621291, 53.199876695007063, 53.345527027412267, 53.490368011488833, 53.634403581319233, 53.777637638839529, 53.920074054255068, 54.061716666448859, 54.20256928338295, 54.342635682492826, 54.481919611074943, 54.620424786667826, 54.758154897426508, 54.895113602490667, 55.031304532346596, 55.166731289183048, 55.301397447241136, 55.435306553158419, 55.568462126307296, 55.700867659127788, 55.832526617454917, 55.963442440840623, 56.093618542870566, 56.223058311475718, 56.35176510923899, 56.479742273696807, 56.606993117636044, 56.733520929386088, 56.859328973106379, 56.984420489069258, 57.108798693938567, 57.23246678104374, 57.35542792064976, 57.4776852602227, 57.599241924691427, 57.720101016705151, 57.840265616886967, 57.95973878408369, 58.078523555611746, 58.196622947499442, 58.314039954725544, 58.430777551454234, 58.546838691266686, 58.662226307389076, 58.776943312917211, 58.890992601037986, 59.004377045247352, 59.11709949956537, 59.229162798747886, 59.340569758495256, 59.451323175658047, 59.561425828439738, 59.670880476596544, 59.779689861634381, 59.88785670700296, 59.995383718287272, 60.102273583396247, 60.208528972748752, 60.314152539457069, 60.419146919507796, 60.523514731940139, 60.627258579021856, 60.730381046422636, 60.832884703385311, 60.934772102894456, 61.036045781842887, 61.136708261195814, 61.236762046152791, 61.336209626307465, 61.435053475805212, 61.533296053498631, 61.630939803100965, 61.727987153337502, 61.82444051809496, 61.920302296568906, 62.01557487340925, 62.110260618863762, 62.20436188891982, 62.297881025444283, 62.390820356321505, 62.483182195589592, 62.57496884357495, 62.666182587025027, 62.756825699239464, 62.846900440199455, 62.936409056695602, 63.025353782454033, 63.113736838260991, 63.201560432085856, 63.288826759202664, 63.375538002310009, 63.46169633164957, 63.547303905123101, 63.632362868407995, 63.716875355071465, 63.800843486683277, 63.884269372927108, 63.967155111710582, 64.049502789273987, 64.13131448029759, 64.21259224800778, 64.293338144281805, 64.373554209751418, 64.453242473905107, 64.53240495518925, 64.611043661108042, 64.689160588322139, 64.76675772274632, 64.843837039645834, 64.920400503731742, 64.996450069255062, 65.07198768009988, 65.147015269875368, 65.221534762006684, 65.295548069824946, 65.369057096656007, 65.442063735908391, 65.51456987116012, 65.58657737624452, 65.658088115335161, 65.729103943029799, 65.799626704433308, 65.86965823523974, 65.939200361813477, 66.008254901269424, 66.076823661552339, 66.144908441515298, 66.212511030997248, 66.279633210899703, 66.346276753262671, 66.412443421339646, 66.478134969671785, 66.543353144161401, 66.608099682144456, 66.672376312462433, 66.736184755533344, 66.799526723421963, 66.86240391990934, 66.924818040561533, 66.986770772797612, 67.048263795956913, 67.109298781365624, 67.169877392402569, 67.230001284564366, 67.289672105529846, 67.348891495223825, 67.407661085880122, 67.465982502103998, 67.523857360933889, 67.58128727190244, 67.638273837096989, 67.694818651219308, 67.750923301644804, 67.806589368481042, 67.861818424625611, 67.916612035823519, 67.970971760723799, 68.024899150935624, 68.078395751083903, 68.131463098864046, 68.184102725096452, 68.236316153780152, 68.288104902146117, 68.33947048070975, 68.390414393323084, 68.440938137226283, 68.491043203098513, 68.540731075108468, 68.590003230964214, 68.638861141962579, 68.68730627303789, 68.735340082810367, 68.782964023633809, 68.830179541642906, 68.876988076799904, 68.923391062940908, 68.969389927821496, 69.014986093162022, 69.060180974692258, 69.104975982195526, 69.149372519552557, 69.193371984784477, 69.236975770095697, 69.280185261915989, 69.323001840942226, 69.365426882179619, 69.407461754982393, 69.44910782309401, 69.490366444686998, 69.531238972402008, 69.571726753386741, 69.611831129334092, 69.65155343651989, 69.690895005840204, 69.729857162848106, 69.768441227789793, 69.806648515640518, 69.844480336139682, 69.881937993825588, 69.91902278806964, 69.955736013110041, 69.992078958084974, 70.028052907065103, 70.063659139085786, 70.098898928178542, 70.133773543401986, 70.168284248872354, 70.202432303793231, 70.236218962484884, 70.269645474412883, 70.302713084216194, 70.335423031734621, 70.367776552035579, 70.399774875440329, 70.431419227549455, 70.462710829267706, 70.493650896828086, 70.524240641815368, 70.554481271188749, 70.584373987303735, 70.613919987933372, 70.643120466288522, 70.671976611037451, 70.700489606324453, 70.728660631787577, 70.756490862575504, 70.783981469363439, 70.81113361836789, 70.837948471360633, 70.864427185681336, 70.890570914249224, 70.91638080557351, 70.941858003762604, 70.967003648531929, 70.991818875210541, 71.016304814746206, 71.040462593708995, 71.064293334293353, 71.087798154318435, 71.110978167226762, 71.133834482081014, 71.156368203558785, 71.178580431945477, 71.200472263124752, 71.22204478856689, 71.243299095314612, 71.264236265966176, 71.284857378655957, 71.305163507031807, 71.325155720229446, 71.344835082843431, 71.364202654894513, 71.383259491793211, 71.402006644299263, 71.420445158476667, 71.438576075643979, 71.456400432319555, 71.473919260161423, 71.491133585901082, 71.508044431271173, 71.524652812926163, 71.540959742355696, 71.556966225789935, 71.572673264096224, 71.588081852666321, 71.603192981293361, 71.618007634037752, 71.632526789080856, 71.646751418565415, 71.660682488421429, 71.674320958176196, 71.687667780746906, 71.700723902213866, 71.7134902615729, 71.725967790464139, 71.738157412875154, 71.750060044815541, 71.761676593959649, 71.773007959254059, 71.784055030485689, 71.794818687805716, 71.8052998012041, 71.815499229928605, 71.825417821841015, 71.835056412702542, 71.844415825378832, 71.853496868953229, 71.862300337735604, 71.870827010151018, 71.879077647490334, 71.887052992501012, 71.894753767792224, 71.902180674023498, 71.909334387838953, 71.916215559501865, 71.922824810173012, 71.929162728763984, 71.935229868278597, 71.941026741534429, 71.94655381612597, 71.95181150845292, 71.956800176583499, 71.961520111650415, 71.965971527375658, 71.970154547176747, 71.974069188097616, 71.977715340498193, 71.981092741964332, 71.9842009431581, 71.987039262124142, 71.98960672152505, 71.991901959646555, 71.993923099152667, 71.995667543611106, 71.997131640539209, 71.99831006994242, 71.999194571407926, 71.999770583873044, 72, 72), tp = c(41, 41, 40.919765166340504, 40.839530332681015, 40.759295499021526, 40.679060665362037, 40.598825831702541, 40.518590998043045, 40.438356164383556, 40.358121330724067, 40.277886497064578, 40.197651663405082, 40.117416829745594, 40.037181996086105, 39.956947162426616, 39.87671232876712, 39.796477495107631, 39.716242661448142, 39.636007827788646, 39.555772994129157, 39.475538160469668, 39.395303326810179, 39.315068493150683, 39.234833659491187, 39.154598825831698, 39.074363992172209, 38.99412915851272, 38.913894324853224, 38.833659491193735, 38.753424657534246, 38.67318982387475, 38.592954990215262, 38.512720156555773, 38.432485322896284, 38.352250489236788, 38.272015655577292, 38.191780821917803, 38.111545988258314, 38.031311154598825, 37.951076320939329, 37.87084148727984, 37.790606653620351, 37.710371819960862, 37.630136986301366, 37.549902152641877, 37.469667318982388, 37.389432485322892, 37.309197651663403, 37.228962818003914, 37.148727984344426, 37.06849315068493, 36.988258317025434, 36.908023483365945, 36.827788649706456, 36.747553816046967, 36.667318982387471, 36.587084148727982, 36.506849315068493, 36.426614481409004, 36.346379647749508, 36.266144814090019, 36.18590998043053, 36.105675146771034, 36.025440313111545, 35.945205479452056, 35.86497064579256, 35.784735812133064, 35.704500978473575, 35.624266144814086, 35.544031311154598, 35.463796477495109, 35.383561643835613, 35.303326810176131, 35.223091976516635, 35.142857142857139, 35.06262230919765, 34.982387475538161, 34.902152641878672, 34.821917808219176, 34.74168297455968, 34.661448140900191, 34.581213307240702, 34.500978473581213, 34.420743639921717, 34.340508806262228, 34.260273972602739, 34.180039138943243, 34.099804305283755, 34.019569471624266, 33.939334637964777, 33.859099804305288, 33.778864970645792, 33.698630136986303, 33.618395303326814, 33.538160469667318, 33.457925636007822, 33.377690802348333, 33.297455968688844, 33.217221135029355, 33.136986301369852, 33.05675146771037, 32.976516634050881, 32.896281800391392, 32.816046966731896, 32.735812133072407, 32.655577299412919, 32.575342465753423, 32.495107632093926, 32.414872798434438, 32.334637964774949, 32.25440313111546, 32.174168297455964, 32.093933463796475, 32.013698630136986, 31.933463796477493, 31.853228962818001, 31.772994129158512, 31.692759295499023, 31.612524461839534, 31.532289628180035, 31.452054794520546, 31.37181996086106, 31.291585127201568, 31.211350293542072, 31.131115459882583, 31.050880626223098, 30.970645792563598, 30.890410958904106, 30.810176125244617, 30.729941291585128, 30.649706457925635, 30.569471624266139, 30.48923679060665, 30.409001956947161, 30.328767123287669, 30.248532289628177, 30.168297455968691, 30.088062622309199, 30.007827788649706, 29.92759295499021, 29.847358121330721, 29.767123287671232, 29.686888454011743, 29.606653620352247, 29.526418786692759, 29.44618395303327, 29.365949119373774, 29.285714285714281, 29.205479452054792, 29.125244618395303, 29.045009784735811, 28.964774951076318, 28.884540117416829, 28.804305283757341, 28.724070450097845, 28.643835616438352, 28.563600782778863, 28.483365949119374, 28.403131115459882, 28.322896281800389, 28.2426614481409, 28.162426614481411, 28.082191780821915, 28.001956947162423, 27.921722113502934, 27.841487279843445, 27.761252446183953, 27.681017612524457, 27.600782778864964, 27.520547945205479, 27.440313111545983, 27.360078277886494, 27.279843444227005, 27.199608610567516, 27.119373776908017, 27.039138943248528, 26.958904109589039, 26.87866927592955, 26.798434442270057, 26.718199608610565, 26.637964774951076, 26.557729941291587, 26.477495107632091, 26.397260273972599, 26.31702544031311, 26.236790606653621, 26.156555772994128, 26.076320939334636, 25.996086105675147, 25.915851272015658, 25.835616438356162, 25.755381604696669, 25.675146771037181, 25.594911937377692, 25.514677103718199, 25.434442270058703, 25.354207436399214, 25.273972602739725, 25.193737769080233, 25.11350293542074, 25.033268101761252, 24.953033268101763, 24.87279843444227, 24.792563600782774, 24.712328767123285, 24.632093933463796, 24.551859099804304, 24.471624266144811, 24.391389432485322, 24.311154598825834, 24.230919765166337, 24.150684931506845, 24.070450097847356, 23.990215264187867, 23.909980430528375, 23.829745596868882, 23.749510763209393, 23.669275929549904, 23.589041095890408, 23.508806262230916, 23.428571428571427, 23.348336594911938, 23.268101761252446, 23.18786692759295, 23.107632093933461, 23.027397260273972, 22.947162426614479, 22.866927592954987, 22.786692759295498, 22.706457925636009, 22.626223091976517, 22.545988258317021, 22.465753424657532, 22.385518590998043, 22.30528375733855, 22.225048923679058, 22.144814090019569, 22.06457925636008, 21.984344422700588, 21.904109589041092, 21.823874755381603, 21.743639921722114, 21.663405088062621, 21.583170254403129, 21.50293542074364, 21.422700587084151, 21.342465753424655, 21.262230919765162, 21.181996086105674, 21.101761252446185, 21.021526418786692, 20.9412915851272, 20.861056751467711, 20.780821917808222, 20.700587084148726, 20.620352250489233, 20.540117416829744, 20.459882583170252, 20.379647749510763, 20.299412915851271, 20.219178082191778, 20.138943248532289, 20.058708414872797, 19.978473581213308, 19.898238747553815, 19.818003913894323, 19.737769080234834, 19.657534246575342, 19.577299412915849, 19.49706457925636, 19.416829745596868, 19.336594911937375, 19.256360078277886, 19.176125244618394, 19.095890410958901, 19.015655577299412, 18.93542074363992, 18.855185909980431, 18.774951076320939, 18.694716242661446, 18.614481409001957, 18.534246575342465, 18.454011741682972, 18.373776908023483, 18.293542074363991, 18.213307240704498, 18.13307240704501, 18.052837573385517, 17.972602739726028, 17.892367906066536, 17.812133072407043, 17.731898238747554, 17.651663405088062, 17.571428571428569, 17.49119373776908, 17.410958904109592, 17.330724070450096, 17.250489236790607, 17.170254403131114, 17.090019569471622, 17.009784735812133, 16.929549902152644, 16.849315068493151, 16.769080234833659, 16.688845401174166, 16.608610567514678, 16.528375733855185, 16.448140900195693, 16.367906066536204, 16.287671232876711, 16.207436399217222, 16.12720156555773, 16.046966731898237, 15.966731898238747, 15.886497064579256, 15.806262230919764, 15.726027397260273, 15.645792563600784, 15.565557729941291, 15.485322896281799, 15.405088062622308, 15.324853228962819, 15.244618395303325, 15.164383561643834, 15.084148727984344, 15.003913894324855, 14.923679060665361, 14.84344422700587, 14.763209393346379, 14.682974559686887, 14.602739726027396, 14.522504892367905, 14.442270058708415, 14.36203522504892, 14.281800391389433, 14.201565557729943, 14.121330724070452, 14.041095890410958, 13.960861056751469, 13.880626223091976, 13.800391389432484, 13.720156555772995, 13.639921722113503, 13.559686888454012, 13.479452054794523, 13.399217221135029, 13.318982387475538, 13.238747553816044, 13.158512720156555, 13.078277886497064, 12.998043052837573, 12.917808219178085, 12.837573385518592, 12.757338551859096, 12.677103718199607, 12.596868884540118, 12.516634050880626, 12.436399217221135, 12.356164383561643, 12.275929549902152, 12.195694716242661, 12.115459882583172, 12.035225048923678, 11.954990215264189, 11.874755381604693, 11.794520547945208, 11.714285714285714, 11.634050880626219, 11.553816046966734, 11.47358121330724, 11.393346379647749, 11.313111545988255, 11.232876712328766, 11.152641878669277, 11.072407045009784, 10.992172211350294, 10.911937377690801, 10.831702544031312, 10.751467710371822, 10.671232876712331, 10.590998043052837, 10.510763209393346, 10.430528375733855, 10.350293542074366, 10.270058708414874, 10.189823874755382, 10.109589041095889, 10.029354207436398, 9.9491193737769041, 9.8688845401174188, 9.7886497064579245, 9.7084148727984338, 9.6281800391389378, 9.5479452054794542, 9.46771037181996, 9.3874755381604675, 9.3072407045009786, 9.2270058708414897, 9.1467710371819972, 9.066536203522503, 8.9863013698630123, 8.9060665362035216, 8.8258317025440309, 8.7455968688845385, 8.6653620352250478, 8.5851272015655571, 8.5048923679060646, 8.4246575342465757, 8.3444227005870832, 8.2641878669275908, 8.1839530332681019, 8.1037181996086094, 8.0234833659491205, 7.943248532289628, 7.8630136986301391, 7.7827788649706466, 7.7025440313111542, 7.6223091976516653, 7.5420743639921719, 7.461839530332683, 7.3816046966731896, 7.3013698630136989, 7.2211350293542074, 7.1409001956947149, 7.0606653620352224, 6.9804305283757344, 6.9001956947162419, 6.8199608610567513, 6.7397260273972623, 6.659491193737769, 6.5792563600782783, 6.4990215264187867, 6.418786692759296, 6.3385518590998027, 6.258317025440312, 6.178082191780824, 6.0978473581213271, 6.0176125244618399, 5.9373776908023457, 5.8571428571428559, 5.7769080234833634, 5.6966731898238736, 5.616438356164382, 5.5362035225048913, 5.4559686888453989, 5.37573385518591, 5.2954990215264219, 5.2152641878669295, 5.1350293542074397, 5.0547945205479445, 4.9745596868884538, 4.894324853228964, 4.8140900195694716, 4.73385518590998, 4.6536203522504875, 4.5733855185909968, 4.4931506849315062, 4.4129158512720164, 4.3326810176125257, 4.2524461839530323, 4.1722113502935407, 4.0919765166340527, 4.0117416829745602, 3.9315068493150704, 3.8512720156555775, 3.7710371819960855, 3.6908023483365957, 3.6105675146771046, 3.5303326810176117, 3.4500978473581223, 3.3698630136986316, 3.2896281800391418, 3.209393346379648, 3.129158512720156, 3.0489236790606662, 2.9686888454011755, 2.8884540117416844, 2.8082191780821923, 2.7279843444227003, 2.6477495107632105, 2.5675146771037194, 2.4872798434442278, 2.4070450097847385, 2.3268101761252464, 2.2465753424657535, 2.1663405088062651, 2.0861056751467726, 2.0058708414872815, 1.9256360078277897, 1.8454011741682987, 1.7651663405088074, 1.6849315068493158, 1.6046966731898256, 1.5244618395303329, 1.4442270058708433, 1.3639921722113517, 1.2837573385518593, 1.2035225048923686, 1.1232876712328772, 1.0430528375733856, 0.96281800391389483, 0.88258317025440369, 0.802348336594912, 0.72211350293542165, 0.64187866927593051, 0.5616438356164386, 0.48140900195694708, 0.40117416829745678, 0.32093933463796553, 0.24070450097847404, 0.16046966731898246, 0.080234833659491328, 0, 0), fn = c(0, 0, 0.080234833659496019, 0.16046966731898493, 0.24070450097847385, 0.32093933463796276, 0.40117416829745878, 0.4814090019569548, 0.56164383561644371, 0.64187866927593262, 0.72211350293542154, 0.80234833659491755, 0.88258317025440647, 0.96281800391389538, 1.0430528375733843, 1.1232876712328803, 1.2035225048923692, 1.2837573385518581, 1.3639921722113542, 1.4442270058708431, 1.524461839530332, 1.6046966731898209, 1.6849315068493169, 1.7651663405088129, 1.8454011741683018, 1.9256360078277908, 2.0058708414872797, 2.0861056751467757, 2.1663405088062646, 2.2465753424657535, 2.3268101761252495, 2.4070450097847385, 2.4872798434442274, 2.5675146771037163, 2.6477495107632123, 2.7279843444227083, 2.8082191780821972, 2.8884540117416861, 2.9686888454011751, 3.0489236790606711, 3.12915851272016, 3.2093933463796489, 3.2896281800391378, 3.3698630136986338, 3.4500978473581227, 3.5303326810176117, 3.6105675146771077, 3.6908023483365966, 3.7710371819960855, 3.8512720156555744, 3.9315068493150704, 4.0117416829745665, 4.0919765166340554, 4.1722113502935443, 4.2524461839530332, 4.3326810176125292, 4.4129158512720181, 4.493150684931507, 4.573385518590996, 4.653620352250492, 4.7338551859099809, 4.8140900195694698, 4.8943248532289658, 4.9745596868884547, 5.0547945205479436, 5.1350293542074397, 5.2152641878669357, 5.2954990215264246, 5.3757338551859135, 5.4559686888454024, 5.5362035225048913, 5.6164383561643874, 5.6966731898238692, 5.7769080234833652, 5.8571428571428612, 5.9373776908023501, 6.017612524461839, 6.0978473581213279, 6.178082191780824, 6.25831702544032, 6.3385518590998089, 6.4187866927592978, 6.4990215264187867, 6.5792563600782827, 6.6594911937377717, 6.7397260273972606, 6.8199608610567566, 6.9001956947162455, 6.9804305283757344, 7.0606653620352233, 7.1409001956947122, 7.2211350293542083, 7.3013698630136972, 7.3816046966731861, 7.4618395303326821, 7.5420743639921781, 7.622309197651667, 7.7025440313111559, 7.7827788649706449, 7.863013698630148, 7.9432485322896298, 8.0234833659491187, 8.1037181996086076, 8.1839530332681036, 8.2641878669275926, 8.3444227005870815, 8.4246575342465775, 8.5048923679060735, 8.5851272015655624, 8.6653620352250513, 8.7455968688845402, 8.8258317025440363, 8.9060665362035252, 8.9863013698630141, 9.0665362035225066, 9.146771037181999, 9.2270058708414879, 9.3072407045009768, 9.3874755381604658, 9.4677103718199653, 9.5479452054794542, 9.6281800391389396, 9.7084148727984321, 9.7886497064579281, 9.868884540117417, 9.9491193737769024, 10.029354207436402, 10.109589041095894, 10.189823874755383, 10.270058708414872, 10.350293542074365, 10.430528375733861, 10.51076320939335, 10.590998043052839, 10.671232876712331, 10.751467710371823, 10.831702544031309, 10.911937377690801, 10.992172211350294, 11.07240704500979, 11.152641878669279, 11.232876712328768, 11.313111545988257, 11.393346379647753, 11.473581213307241, 11.55381604696673, 11.634050880626226, 11.714285714285719, 11.794520547945208, 11.874755381604697, 11.954990215264189, 12.035225048923682, 12.115459882583171, 12.195694716242659, 12.275929549902155, 12.356164383561648, 12.436399217221137, 12.516634050880626, 12.596868884540118, 12.677103718199611, 12.7573385518591, 12.837573385518589, 12.917808219178085, 12.998043052837577, 13.078277886497066, 13.158512720156555, 13.238747553816047, 13.318982387475543, 13.399217221135036, 13.479452054794521, 13.559686888454017, 13.639921722113506, 13.720156555772995, 13.800391389432484, 13.880626223091983, 13.960861056751472, 14.041095890410961, 14.12133072407045, 14.201565557729943, 14.281800391389435, 14.362035225048924, 14.442270058708413, 14.522504892367909, 14.602739726027401, 14.68297455968689, 14.763209393346379, 14.843444227005872, 14.923679060665364, 15.003913894324853, 15.084148727984342, 15.164383561643838, 15.244618395303331, 15.324853228962819, 15.405088062622308, 15.485322896281801, 15.565557729941297, 15.645792563600786, 15.726027397260275, 15.806262230919767, 15.88649706457926, 15.966731898238748, 16.046966731898237, 16.12720156555773, 16.207436399217226, 16.287671232876715, 16.367906066536204, 16.448140900195696, 16.528375733855189, 16.608610567514678, 16.688845401174166, 16.769080234833663, 16.849315068493155, 16.929549902152644, 17.009784735812133, 17.090019569471625, 17.170254403131118, 17.250489236790607, 17.330724070450096, 17.410958904109592, 17.491193737769084, 17.571428571428573, 17.651663405088062, 17.731898238747554, 17.81213307240705, 17.892367906066539, 17.972602739726028, 18.052837573385521, 18.133072407045013, 18.213307240704502, 18.293542074363991, 18.373776908023483, 18.454011741682979, 18.534246575342468, 18.614481409001957, 18.69471624266145, 18.774951076320942, 18.855185909980431, 18.93542074363992, 19.015655577299412, 19.095890410958908, 19.176125244618397, 19.256360078277886, 19.336594911937379, 19.416829745596871, 19.49706457925636, 19.577299412915849, 19.657534246575345, 19.737769080234838, 19.818003913894326, 19.898238747553815, 19.978473581213308, 20.0587084148728, 20.138943248532289, 20.219178082191778, 20.299412915851274, 20.379647749510767, 20.459882583170256, 20.540117416829748, 20.620352250489237, 20.700587084148729, 20.780821917808222, 20.861056751467711, 20.941291585127203, 21.021526418786692, 21.101761252446185, 21.181996086105677, 21.262230919765166, 21.342465753424658, 21.422700587084151, 21.50293542074364, 21.583170254403132, 21.663405088062625, 21.743639921722114, 21.823874755381606, 21.904109589041099, 21.984344422700588, 22.06457925636008, 22.144814090019569, 22.225048923679061, 22.305283757338554, 22.385518590998043, 22.465753424657535, 22.545988258317028, 22.626223091976517, 22.706457925636009, 22.786692759295502, 22.86692759295499, 22.947162426614483, 23.027397260273972, 23.107632093933464, 23.187866927592957, 23.268101761252446, 23.348336594911938, 23.428571428571431, 23.50880626223092, 23.589041095890408, 23.669275929549904, 23.749510763209393, 23.829745596868886, 23.909980430528378, 23.990215264187867, 24.070450097847356, 24.150684931506849, 24.230919765166341, 24.311154598825834, 24.391389432485322, 24.471624266144815, 24.551859099804307, 24.632093933463796, 24.712328767123289, 24.792563600782778, 24.87279843444227, 24.953033268101763, 25.033268101761252, 25.113502935420744, 25.193737769080236, 25.273972602739725, 25.354207436399214, 25.43444227005871, 25.514677103718199, 25.594911937377692, 25.675146771037181, 25.755381604696673, 25.835616438356166, 25.915851272015658, 25.996086105675147, 26.076320939334639, 26.156555772994132, 26.236790606653621, 26.317025440313113, 26.397260273972606, 26.477495107632095, 26.557729941291583, 26.63796477495108, 26.718199608610568, 26.798434442270057, 26.878669275929546, 26.958904109589042, 27.039138943248531, 27.119373776908024, 27.199608610567516, 27.279843444227005, 27.360078277886497, 27.44031311154599, 27.520547945205479, 27.600782778864971, 27.681017612524464, 27.761252446183956, 27.841487279843445, 27.921722113502938, 28.001956947162427, 28.082191780821915, 28.162426614481408, 28.242661448140904, 28.322896281800393, 28.403131115459882, 28.483365949119374, 28.563600782778863, 28.643835616438359, 28.724070450097848, 28.804305283757337, 28.884540117416826, 28.964774951076322, 29.045009784735811, 29.125244618395307, 29.205479452054792, 29.285714285714285, 29.365949119373781, 29.446183953033266, 29.526418786692759, 29.606653620352251, 29.686888454011743, 29.767123287671232, 29.847358121330721, 29.927592954990217, 30.007827788649706, 30.088062622309199, 30.168297455968688, 30.24853228962818, 30.328767123287669, 30.409001956947165, 30.489236790606654, 30.569471624266143, 30.649706457925632, 30.729941291585128, 30.810176125244617, 30.890410958904113, 30.970645792563602, 31.050880626223098, 31.131115459882579, 31.211350293542075, 31.291585127201564, 31.37181996086106, 31.452054794520546, 31.532289628180038, 31.612524461839534, 31.692759295499023, 31.772994129158512, 31.853228962818001, 31.933463796477497, 32.013698630136986, 32.093933463796475, 32.174168297455971, 32.25440313111546, 32.334637964774956, 32.414872798434445, 32.495107632093934, 32.575342465753423, 32.655577299412919, 32.735812133072407, 32.816046966731896, 32.896281800391392, 32.976516634050881, 33.05675146771037, 33.136986301369859, 33.217221135029355, 33.297455968688844, 33.377690802348333, 33.457925636007829, 33.538160469667318, 33.618395303326807, 33.698630136986303, 33.778864970645792, 33.859099804305288, 33.939334637964777, 34.019569471624266, 34.099804305283755, 34.180039138943251, 34.260273972602739, 34.340508806262228, 34.420743639921724, 34.500978473581213, 34.581213307240702, 34.661448140900198, 34.741682974559687, 34.821917808219176, 34.902152641878672, 34.982387475538161, 35.062622309197657, 35.142857142857146, 35.223091976516635, 35.303326810176124, 35.38356164383562, 35.463796477495109, 35.544031311154598, 35.624266144814086, 35.704500978473575, 35.784735812133071, 35.86497064579256, 35.945205479452056, 36.025440313111545, 36.105675146771034, 36.18590998043053, 36.266144814090019, 36.346379647749515, 36.426614481409004, 36.506849315068493, 36.587084148727982, 36.667318982387471, 36.747553816046967, 36.827788649706463, 36.908023483365945, 36.988258317025441, 37.06849315068493, 37.148727984344426, 37.228962818003914, 37.309197651663403, 37.389432485322892, 37.469667318982388, 37.549902152641877, 37.630136986301366, 37.710371819960855, 37.790606653620351, 37.870841487279847, 37.951076320939336, 38.031311154598825, 38.111545988258314, 38.19178082191781, 38.272015655577299, 38.352250489236788, 38.432485322896284, 38.512720156555773, 38.592954990215262, 38.67318982387475, 38.753424657534246, 38.833659491193735, 38.913894324853224, 38.99412915851272, 39.074363992172209, 39.154598825831698, 39.234833659491194, 39.315068493150683, 39.395303326810172, 39.475538160469668, 39.555772994129157, 39.636007827788646, 39.716242661448142, 39.796477495107631, 39.87671232876712, 39.956947162426616, 40.037181996086105, 40.117416829745594, 40.19765166340509, 40.277886497064578, 40.358121330724067, 40.438356164383563, 40.518590998043052, 40.598825831702541, 40.679060665362037, 40.759295499021526, 40.839530332681015, 40.919765166340511, 41, 41), fp = c(72, 72, 71.540087889259922, 71.03942164664798, 70.535211218132559, 70.032878030971204, 69.534306446415258, 69.040279960851151, 68.551131909057204, 68.06698356762486, 67.587847791770329, 67.113679433763139, 66.644401822186879, 66.179921444157785, 65.720136404466487, 65.264941425793367, 64.814230846379175, 64.367900420754424, 63.925848387190889, 63.48797607760411, 63.054188238370386, 62.624393167308654, 62.198502733794761, 61.776432325240869, 61.35810074816068, 60.943430102381051, 60.532345640654171, 60.124775621755774, 59.720651162373549, 59.319906091218591, 58.92247680752893, 58.528302145276044, 58.137323243804559, 57.749483425243469, 57.364728078764664, 56.983004551591641, 56.604262046550055, 56.228451525883656, 55.855525621020718, 55.485438547956946, 55.118146027916247, 54.753605212955165, 54.39177461618732, 54.032614046317704, 53.676084546192897, 53.322148335091093, 52.970768754492667, 52.621910217089763, 52.275538158809695, 51.931618993643696, 51.590120071087313, 51.251009636013109, 50.914256790809659, 50.579831459633496, 50.247704354631821, 49.91784694400495, 49.590231421786726, 49.264830679230464, 48.941618277696918, 48.620568422947457, 48.301655940753363, 47.984856253738684, 47.670145359379873, 47.357499809091237, 47.046896688329824, 46.738313597658546, 46.431728634710701, 46.127120377002441, 45.82446786554398, 45.523750589203438, 45.224948469780522, 44.928041847749931, 44.633011468637051, 44.339838469991122, 44.04850436892329, 43.758991050179006, 43.471280754716041, 43.185356068761592, 42.901199913323239, 42.618795534130435, 42.338126491984148, 42.059176653494191, 41.781930182184723, 41.506371529949462, 41.232485428839681, 40.960256883168327, 40.689671161915498, 40.420713791420553, 40.15337054834734, 39.887627452909825, 39.623470762345917, 39.360886964628293, 39.099862772401167, 38.840385117132797, 38.582441143474483, 38.326018203816481, 38.071103853032298, 37.817685843403268, 37.565752119715647, 37.315290814522719, 37.066290243565085, 36.818738901342279, 36.572625456829719, 36.32793874933477, 36.084667784486307, 35.842801730352257, 35.602329913680222, 35.363241816256149, 35.125527071376126, 34.889175460427396, 34.654176909573806, 34.4205214865421, 34.188199397504974, 33.957200984057025, 33.727516720280704, 33.499137209898237, 33.272053183506799, 33.046255495893561, 32.821735123427942, 32.598483161528208, 32.3764908221996, 32.15574943164161, 31.93625042792182, 31.717985358714273, 31.500945879099618, 31.285123749425338, 31.070510833223693, 30.857099095185774, 30.644880599189364, 30.433847506378882, 30.22399207329606, 30.015306650059102, 29.807783678589189, 29.601415690882362, 29.396195307325804, 29.192115235056725, 28.989168266362512, 28.787347277120922, 28.586645225279227, 28.387055149370681, 28.188570167067425, 27.991183473768722, 27.794888341223242, 27.599678116184563, 27.405546219098767, 27.212486142823082, 27.020491451374923, 26.829555778710095, 26.639672827529481, 26.450836368113372, 26.26304023718253, 26.076278336785421, 25.89054463321051, 25.705833155923287, 25.522137996526986, 25.339453307746659, 25.157773302435587, 24.977092252603668, 24.797404488467095, 24.618704397518648, 24.440986423618241, 24.264245066102866, 24.088474878915676, 23.91367046975364, 23.739826499233097, 23.566937680072904, 23.394998776294713, 23.224004602439805, 23.053950022802155, 22.884829950677222, 22.716639347626092, 22.549373222754667, 22.383026632007336, 22.217594677474835, 22.053072506716013, 21.889455312093091, 21.726738330120028, 21.56491684082367, 21.403986167117488, 21.243941674187496, 21.084778768890033, 20.926492899161097, 20.769079553437109, 20.612534260086662, 20.456852586853039, 20.302030140307224, 20.148062565311257, 19.994945544491586, 19.842674797722168, 19.691246081617152, 19.540655189032876, 19.390897948579038, 19.241970224138733, 19.093867914397123, 18.946586952378709, 18.800123304992937, 18.654472972587733, 18.509631988511167, 18.365596418680767, 18.222362361160471, 18.079925945744932, 17.938283333551141, 17.79743071661705, 17.657364317507174, 17.518080388925057, 17.379575213332174, 17.241845102573492, 17.104886397509333, 16.968695467653404, 16.833268710816952, 16.698602552758864, 16.564693446841581, 16.431537873692704, 16.299132340872212, 16.167473382545083, 16.036557559159377, 15.906381457129434, 15.776941688524282, 15.64823489076101, 15.520257726303193, 15.393006882363956, 15.266479070613912, 15.140671026893621, 15.015579510930742, 14.891201306061433, 14.76753321895626, 14.64457207935024, 14.5223147397773, 14.400758075308573, 14.279898983294849, 14.159734383113033, 14.04026121591631, 13.921476444388254, 13.803377052500558, 13.685960045274456, 13.569222448545766, 13.453161308733314, 13.337773692610924, 13.223056687082789, 13.109007398962014, 12.995622954752648, 12.88290050043463, 12.770837201252114, 12.659430241504744, 12.548676824341953, 12.438574171560262, 12.329119523403456, 12.220310138365619, 12.11214329299704, 12.004616281712728, 11.897726416603753, 11.791471027251248, 11.685847460542931, 11.580853080492204, 11.476485268059861, 11.372741420978144, 11.269618953577364, 11.167115296614689, 11.065227897105544, 10.963954218157113, 10.863291738804186, 10.763237953847209, 10.663790373692535, 10.564946524194788, 10.466703946501369, 10.369060196899035, 10.272012846662498, 10.17555948190504, 10.079697703431094, 9.9844251265907502, 9.8897393811362377, 9.79563811108018, 9.7021189745557166, 9.6091796436784946, 9.5168178044104081, 9.4250311564250495, 9.3338174129749731, 9.2431743007605363, 9.1530995598005447, 9.0635909433043977, 8.9746462175459669, 8.8862631617390093, 8.7984395679141443, 8.7111732407973363, 8.6244619976899912, 8.5383036683504301, 8.4526960948768988, 8.3676371315920051, 8.2831246449285345, 8.1991565133167228, 8.1157306270728924, 8.0328448882894179, 7.950497210726013, 7.8686855197024101, 7.7874077519922196, 7.7066618557181954, 7.6264457902485816, 7.5467575260948934, 7.46759504481075, 7.3889563388919584, 7.3108394116778612, 7.2332422772536802, 7.1561629603541661, 7.0795994962682585, 7.0035499307449385, 6.9280123199001196, 6.8529847301246321, 6.7784652379933164, 6.704451930175054, 6.6309429033439926, 6.5579362640916088, 6.4854301288398801, 6.4134226237554799, 6.3419118846648388, 6.2708960569702015, 6.2003732955666919, 6.13034176476026, 6.0607996381865235, 5.9917450987305756, 5.9231763384476608, 5.8550915584847019, 5.7874889690027516, 5.7203667891002965, 5.6537232467373286, 5.5875565786603545, 5.5218650303282146, 5.4566468558385992, 5.3919003178555442, 5.3276236875375673, 5.2638152444666559, 5.2004732765780375, 5.1375960800906597, 5.0751819594384671, 5.0132292272023875, 4.9517362040430868, 4.8907012186343763, 4.8301226075974313, 4.7699987154356336, 4.7103278944701543, 4.6511085047761753, 4.5923389141198783, 4.5340174978960022, 4.4761426390661114, 4.4187127280975602, 4.3617261629030111, 4.3051813487806925, 4.2490766983551964, 4.1934106315189581, 4.1381815753743894, 4.083387964176481, 4.0290282392762009, 3.9751008490643756, 3.9216042489160969, 3.8685369011359541, 3.8158972749035485, 3.7636838462198483, 3.7118950978538834, 3.6605295192902503, 3.6095856066769159, 3.5590618627737172, 3.5089567969014865, 3.459268924891532, 3.4099967690357857, 3.3611388580374211, 3.3126937269621095, 3.2646599171896327, 3.2170359763661907, 3.1698204583570941, 3.1230119232000959, 3.0766089370590919, 3.0306100721785043, 2.9850139068379775, 2.9398190253077416, 2.8950240178044737, 2.850627480447443, 2.806628015215523, 2.7630242299043033, 2.7198147380840112, 2.6769981590577743, 2.6345731178203806, 2.5925382450176073, 2.5508921769059896, 2.5096335553130018, 2.4687610275979921, 2.4282732466132586, 2.3881688706659077, 2.3484465634801097, 2.3091049941597959, 2.2701428371518944, 2.2315587722102066, 2.1933514843594821, 2.1555196638603178, 2.1180620061744122, 2.0809772119303602, 2.044263986889959, 2.0079210419150257, 1.9719470929348972, 1.9363408609142141, 1.9011010718214578, 1.8662264565980138, 1.8317157511276463, 1.7975676962067695, 1.7637810375151162, 1.7303545255871171, 1.6972869157838062, 1.6645769682653793, 1.6322234479644209, 1.600225124559671, 1.5685807724505452, 1.5372891707322935, 1.5063491031719138, 1.4757593581846322, 1.4455187288112512, 1.415626012696265, 1.3860800120666283, 1.3568795337114778, 1.3280233889625492, 1.299510393675547, 1.2713393682124234, 1.2435091374244962, 1.2160185306365605, 1.1888663816321099, 1.1620515286393669, 1.1355728143186639, 1.1094290857507758, 1.0836191944264897, 1.0581419962373957, 1.0329963514680713, 1.0081811247894592, 0.98369518525379362, 0.95953740629100537, 0.93570666570664685, 0.91220184568156526, 0.88902183277323843, 0.86616551791898644, 0.84363179644121544, 0.8214195680545231, 0.79952773687524825, 0.77795521143310964, 0.75670090468538831, 0.73576373403382433, 0.71514262134404305, 0.69483649296819294, 0.67484427977055361, 0.65516491715656855, 0.63579734510548747, 0.61674050820678872, 0.59799335570073708, 0.5795548415233327, 0.56142392435602062, 0.54359956768044526, 0.52608073983857651, 0.50886641409891809, 0.49195556872882662, 0.47534718707383661, 0.45904025764430401, 0.44303377421006473, 0.42732673590377601, 0.41191814733367949, 0.39680701870663881, 0.3819923659622475, 0.36747321091914387, 0.35324858143458471, 0.33931751157857093, 0.32567904182380403, 0.31233221925309351, 0.29927609778613373, 0.28650973842709959, 0.27403220953586072, 0.2618425871248462, 0.249939955184459, 0.23832340604035096, 0.22699204074594093, 0.21594496951431097, 0.20518131219428426, 0.19470019879589984, 0.18450077007139498, 0.17458217815898536, 0.16494358729745784, 0.15558417462116836, 0.14650313104677082, 0.13769966226439578, 0.12917298984898196, 0.1209223525096661, 0.11294700749898823, 0.10524623220777585, 0.097819325976502114, 0.090665612161046738, 0.083784440498135382, 0.077175189826988344, 0.070837271236015908, 0.06477013172140289, 0.058973258465570666, 0.053446183874029884, 0.048188491547080048, 0.043199823416500749, 0.038479888349584712, 0.034028472624342498, 0.029845452823252572, 0.025930811902384221, 0.022284659501806914, 0.018907258035667951, 0.015799056841899528, 0.012960737875857831, 0.010393278474950307, 0.0080980403534454126, 0.0060769008473329222, 0.0043324563888944567, 0.0028683594607912255, 0.0016899300575801135, 0.00080542859207355377, 0.00022941612695603908, 0, 0), npv = c(NaN, NaN, 0.8514573960078855, 0.8568574544889378, 0.85886517208861934, 0.85973307003460153, 0.86006533708012378, 0.86010143874109002, 0.85995707134118948, 0.85969543453700636, 0.85935408419453319, 0.85895675239676661, 0.85851915470078233, 0.85805208800817756, 0.85756319260209724, 0.85705800735303994, 0.85654062894915894, 0.85601413858613185, 0.85548088657261367, 0.85494268713431609, 0.85440095477911426, 0.8538568016512178, 0.8533111082530791, 0.85276457562067598, 0.85221776435162577, 0.85167112416389246, 0.85112501653514916, 0.85057973221970407, 0.85003550492789526, 0.84949252209912496, 0.84895093345170358, 0.84841085781640591, 0.84787238863379943, 0.84733559840306971, 0.84680054230210866, 0.84626726114814688, 0.84573578383032344, 0.84520612931692929, 0.84467830831819812, 0.84415232466871515, 0.84362817648050548, 0.8431058571077229, 0.84258535595591544, 0.84206665916256251, 0.84154975017060851, 0.84103461021273651, 0.84052121872095231, 0.84000955367347696, 0.83949959188886947, 0.83899130927562071, 0.8384846810440717, 0.83797968188638949, 0.83747628612939962, 0.83697446786431162, 0.83647420105673731, 0.83597545963987208, 0.83547821759327545, 0.83498244900931329, 0.83448812814901896, 0.83399522948887173, 0.83350372775977266, 0.83301359797931007, 0.8325248154782553, 0.83203735592209493, 0.83155119532828992, 0.83106631007986087, 0.83058267693581367, 0.83010027303884804, 0.82961907592073392, 0.82913906350568933, 0.82866021411204516, 0.82818250645244595, 0.82770591963280615, 0.82723043315020384, 0.8267560268898807, 0.82628268112148484, 0.8258103764946817, 0.82533909403423844, 0.82486881513467614, 0.82439952155456664, 0.82393119541054882, 0.8234638191711191, 0.82299737565025355, 0.82253184800090395, 0.82206721970840768, 0.82160347458384553, 0.82114059675737661, 0.82067857067157512, 0.82021738107478959, 0.81975701301454507, 0.81929745183100144, 0.81883868315048169, 0.81838069287908255, 0.8179234671963741, 0.81746699254919819, 0.81701125564557098, 0.81655624344869426, 0.81610194317107965, 0.81564834226878868, 0.8151954284357914, 0.81474318959844494, 0.81429161391008975, 0.81384068974577062, 0.81339040569707455, 0.81294075056709114, 0.81249171336549075, 0.81204328330372133, 0.81159544979032183, 0.81114820242635099, 0.81070153100092845, 0.81025542548688867, 0.80980987603654409, 0.80936487297755466, 0.8089204068089042, 0.80847646819697871, 0.80803304797174591, 0.8075901371230334, 0.80714772679690305, 0.80670580829211957, 0.80626437305670995, 0.80582341268461422, 0.80538291891242086, 0.80494288361618993, 0.80450329880835625, 0.80406415663471587, 0.80362544937148872, 0.80318716942245849, 0.80274930931618815, 0.80231186170330526, 0.80187481935385951, 0.8014381751547478, 0.80100192210720667, 0.80056605332436748, 0.80013056202887733, 0.79969544155057815, 0.79926068532424754, 0.79882628688739565, 0.79839223987811958, 0.79795853803301053, 0.79752517518511645, 0.79709214526195349, 0.79665944228356955, 0.79622706036065516, 0.79579499369270268, 0.795363236566211, 0.79493178335293435, 0.79450062850817493, 0.79406976656911898, 0.79363919215321077, 0.79320889995657018, 0.79277888475244584, 0.7923491413897078, 0.79191966479137632, 0.79149044995318563, 0.79106149194218345, 0.79063278589536323, 0.79020432701832932, 0.78977611058399433, 0.78934813193130637, 0.78892038646400819, 0.78849286964942367, 0.78806557701727398, 0.78763850415852088, 0.78721164672423738, 0.78678500042450406, 0.78635856102733159, 0.7859323243576074, 0.78550628629606689, 0.78508044277828792, 0.78465478979370851, 0.78422932338466644, 0.78380403964546097, 0.78337893472143494, 0.78295400480807842, 0.7825292461501514, 0.78210465504082716, 0.78168022782085234, 0.78125596087772908, 0.78083185064491167, 0.78040789360102303, 0.77998408626908722, 0.77956042521577862, 0.77913690705068817, 0.77871352842560482, 0.77829028603381167, 0.77786717660939975, 0.77744419692659239, 0.77702134379908805, 0.77659861407941444, 0.77617600465829684, 0.77575351246404012, 0.77533113446192348, 0.77490886765360745, 0.77448670907655348, 0.77406465580345585, 0.77364270494168441, 0.77322085363273962, 0.77279909905171873, 0.77237743840679163, 0.77195586893868895, 0.77153438792019946, 0.77111299265567768, 0.77069168048056214, 0.77027044876090256, 0.76984929489289611, 0.76942821630243408, 0.76900721044465636, 0.76858627480351538, 0.76816540689134849, 0.76774460424845836, 0.76732386444270195, 0.76690318506908739, 0.76648256374937906, 0.76606199813170861, 0.76564148589019654, 0.76522102472457709, 0.76480061235983454, 0.7643802465458428, 0.76395992505701393, 0.76353964569195309, 0.76311940627311892, 0.76269920464649144, 0.76227903868124558, 0.76185890626943098, 0.76143880532565844, 0.76101873378679019, 0.76059868961163835, 0.76017867078066714, 0.75975867529570129, 0.75933870117963986, 0.75891874647617541, 0.75849880924951718, 0.75807888758412101, 0.75765897958442252, 0.75723908337457635, 0.75681919709819889, 0.7563993189181174, 0.75597944701612152, 0.75555957959272058, 0.75513971486690468, 0.75471985107591033, 0.75429998647499041, 0.75388011933718646, 0.75346024795310829, 0.75304037063071372, 0.75262048569509532, 0.75220059148826823, 0.75178068636896433, 0.75136076871242719, 0.75094083691021263, 0.75052088936999217, 0.75010092451535948, 0.74968094078563996, 0.74926093663570481, 0.74884091053578672, 0.74842086097130023, 0.74800078644266321, 0.74758068546512335, 0.74716055656858671, 0.74674039829744832, 0.74632020921042774, 0.74589998788040468, 0.74547973289425995, 0.7450594428527173, 0.74463911637018843, 0.74421875207462107, 0.74379834860734861, 0.74337790462294306, 0.74295741878907018, 0.74253688978634647, 0.74211631630819952, 0.74169569706072946, 0.74127503076257417, 0.7408543161447747, 0.74043355195064509, 0.74001273693564262, 0.73959186986724046, 0.73917094952480378, 0.73874997469946535, 0.73832894419400574, 0.73790785682273341, 0.73748671141136823, 0.73706550679692562, 0.73664424182760369, 0.73622291536267115, 0.73580152627235795, 0.73538007343774658, 0.73495855575066626, 0.73453697211358804, 0.73411532143952163, 0.73369360265191441, 0.73327181468455138, 0.73284995648145657, 0.7324280269967971, 0.73200602519478741, 0.73158395004959609, 0.73116180054525304, 0.73073957567555914, 0.7303172744439973, 0.72989489586364353, 0.72947243895708092, 0.72904990275631443, 0.72862728630268703, 0.7282045886467966, 0.72778180884841492, 0.72735894597640804, 0.72693599910865636, 0.72651296733197801, 0.72608984974205182, 0.72566664544334192, 0.72524335354902447, 0.72481997318091396, 0.72439650346939122, 0.72397294355333308, 0.72354929258004264, 0.72312554970518039, 0.7227017140926969, 0.72227778491476591, 0.72185376135171919, 0.72142964259198161, 0.72100542783200794, 0.72058111627621968, 0.72015670713694357, 0.71973219963435142, 0.71930759299639946, 0.71888288645876963, 0.71845807926481142, 0.71803317066548522, 0.71760815991930504, 0.71718304629228358, 0.71675782905787755, 0.71633250749693345, 0.71590708089763466, 0.71548154855544888, 0.71505590977307687, 0.71463016386040135, 0.7142043101344373, 0.71377834791928196, 0.71335227654606692, 0.71292609535290963, 0.71249980368486598, 0.71207340089388493, 0.71164688633876061, 0.7112202593850887, 0.71079351940522117, 0.71036666577822172, 0.70993969788982336, 0.70951261513238484, 0.7090854169048485, 0.70865810261269901, 0.70823067166792142, 0.70780312348896135, 0.70737545750068487, 0.70694767313433804, 0.70651976982750953, 0.70609174702409028, 0.7056636041742369, 0.70523534073433303, 0.70480695616695288, 0.70437844994082455, 0.70394982153079322, 0.70352107041778589, 0.70309219608877516, 0.70266319803674571, 0.70223407576065766, 0.70180482876541417, 0.70137545656182554, 0.70094595866657727, 0.70051633460219609, 0.70008658389701672, 0.69965670608514952, 0.69922670070644777, 0.69879656730647577, 0.69836630543647693, 0.69793591465334159, 0.69750539451957594, 0.69707474460327068, 0.69664396447806975, 0.69621305372313946, 0.69578201192313738, 0.69535083866818215, 0.6949195335538223, 0.69448809618100582, 0.69405652615604996, 0.69362482309061035, 0.69319298660165107, 0.69276101631141362, 0.69232891184738643, 0.69189667284227507, 0.69146429893397054, 0.69103178976551904, 0.69059914498509123, 0.69016636424595068, 0.6897334472064226, 0.68930039352986261, 0.68886720288462477, 0.68843387494402908, 0.68800040938632967, 0.68756680589468133, 0.68713306415710607, 0.68669918386646045, 0.68626516472039989, 0.68583100642134465, 0.68539670867644387, 0.68496227119754005, 0.68452769370113153, 0.68409297590833518, 0.68365811754484773, 0.68322311834090677, 0.68278797803124969, 0.68235269635507301, 0.68191727305598926, 0.68148170788198337, 0.68104600058536802, 0.68061015092273658, 0.68017415865491559, 0.6797380235469157, 0.67930174536787946, 0.67886532389102916, 0.67842875889361209, 0.67799205015684316, 0.67755519746584569, 0.67711820060959071, 0.67668105938083234, 0.67624377357604148, 0.6758063429953366, 0.67536876744241103, 0.67493104672445736, 0.67449318065208874, 0.67405516903925577, 0.67361701170316002, 0.67317870846416328, 0.67274025914569235, 0.67230166357413879, 0.67186292157875427, 0.6714240329915393, 0.67098499764712771, 0.67054581538266389, 0.67010648603767309, 0.66966700945392588, 0.6692273854752937, 0.66878761394759667, 0.66834769471844291, 0.66790762763705847, 0.66746741255410635, 0.66702704932149548, 0.66658653779217814, 0.66614587781993351, 0.66570506925913986, 0.66526411196452939, 0.66482300579093001, 0.66438175059298821, 0.6639403462248743, 0.66349879253996824, 0.66305708939052233, 0.66261523662730248, 0.66217323409920292, 0.66173108165283334, 0.66128877913207673, 0.66084632637761387, 0.66040372322641272, 0.659960969511179, 0.65951806505976318, 0.65907500969452215, 0.65863180323162929, 0.65818844548032773, 0.65774493624212338, 0.65730127530990734, 0.65685746246700583, 0.65641349748614475, 0.65596938012832251, 0.65552511014158032, 0.65508068725965785, 0.65463611120052201, 0.65419138166475177, 0.65374649833376397, 0.65330146086785801, 0.65285626890405835, 0.65241092205372619, 0.65196541989991175, 0.6515197619944072, 0.65107394785446349, 0.65062797695911501, 0.65018184874505836, 0.64973556260201226, 0.64928911786747501, 0.64884251382078206, 0.64839574967633651, 0.64794882457587055, 0.64750173757955165, 0.64705448765571294, 0.646607073668925, 0.64615949436606102, 0.6457117483599073, 0.64526383410974886, 0.6448157498981858, 0.64436749380320535, 0.64391906366420304, 0.64347045704018868, 0.6430216711577329, 0.64257270284521451, 0.64212354844840913, 0.64167420372006478, 0.64122466367223441, 0.64077492237355371, 0.64032497266195876, 0.63987480572125133, 0.63942441042499654, 0.63897377225063068, 0.63852287131006302, 0.63807167825235589, 0.63762014345455609, 0.63716814159292035, 0.63716814159292035 ), ppv = c(0.36283185840707965, 0.36283185840707965, 0.3638610940217899, 0.36503318640513022, 0.36622917609588718, 0.36743156288626455, 0.36863407942651483, 0.36983395907069327, 0.37102987525856479, 0.37222118778267033, 0.37340761422168994, 0.37458906950848397, 0.37576558114411102, 0.37693724173725379, 0.37810418128291789, 0.37926655045634072, 0.38042451032066127, 0.38157822589826612, 0.38272786213400795, 0.38387358137166239, 0.38501554180404274, 0.38615389655742816, 0.38728879319255999, 0.38842037348013797, 0.38954877335682403, 0.39067412299888055, 0.39179654697102895, 0.39291616442174976, 0.39403308930544589, 0.39514743061815566, 0.39625929263780196, 0.39736877516294139, 0.39847597374604166, 0.39958097991875013, 0.4006838814076199, 0.40178476233945432, 0.40288370343591201, 0.40398078219734135, 0.40507607307603705, 0.40616964763925201, 0.40726157472239449, 0.40835192057288783, 0.40944074898519761, 0.41052812142753953, 0.41161409716077646, 0.41269873334999518, 0.41378208516923853, 0.41486420589984296, 0.41594514702280933, 0.41702495830560621, 0.41810368788378333, 0.41918138233774566, 0.42025808676501492, 0.42133384484828479, 0.42240869891955213, 0.42348269002058631, 0.42455585795998196, 0.42562824136702254, 0.42669987774256118, 0.42777080350711683, 0.42884105404636508, 0.42991066375419096, 0.43097966607345994, 0.43204809353464951, 0.43311597779247768, 0.43418334966065208, 0.43525023914485317, 0.43631667547406228, 0.43738268713033218, 0.43844830187709405, 0.43951354678608745, 0.44057844826299403, 0.44164303207184985, 0.44270732335830748, 0.44377134667181245, 0.44483512598675556, 0.44589868472265837, 0.44696204576344589, 0.44802523147585505, 0.4490882637270277, 0.45015116390132981, 0.4512139529164409, 0.45227665123874922, 0.45333927889809117, 0.45440185550186735, 0.45546440024856882, 0.45652693194074245, 0.4575894689974227, 0.45865202946605932, 0.45971463103396282, 0.46077729103929382, 0.46184002648161571, 0.46290285403203468, 0.46396579004294491, 0.46502885055739746, 0.46609205131811149, 0.46715540777614428, 0.46821893509923496, 0.46928264817983761, 0.4703465616428576, 0.47141068985310436, 0.47247504692247311, 0.4735396467168686, 0.47460450286288003, 0.47566962875422003, 0.47673503755793722, 0.47780074222041119, 0.47886675547313973, 0.47993308983832877, 0.48099975763428843, 0.48206677098065032, 0.48313414180340614, 0.48420188183977986, 0.4852700026429389, 0.48633851558654895, 0.48740743186918162, 0.48847676251857852, 0.48954651839577817, 0.49061671019911202, 0.49168734846807211, 0.49275844358705789, 0.49383000578900577, 0.49490204515890612, 0.49597457163721043, 0.49704759502313517, 0.49812112497786476, 0.49919517102765787, 0.50026974256685941, 0.50134484886082231, 0.50242049904874519, 0.50349670214642239, 0.50457346704891615, 0.50565080253314998, 0.50672871726042723, 0.50780721977887633, 0.50888631852582633, 0.50996602183011597, 0.51104633791433585, 0.51212727489700816, 0.5132088407947053, 0.51429104352411037, 0.51537389090401931, 0.51645739065728868, 0.51754155041273042, 0.51862637770695463, 0.51971187998616253, 0.5207980646078908, 0.52188493884271014, 0.52297250987587796, 0.52406078480894647, 0.52514977066133051, 0.52623947437183127, 0.52732990280012326, 0.52842106272819989, 0.52951296086178423, 0.53060560383170075, 0.53169899819521416, 0.53279315043733289, 0.5338880669720798, 0.53498375414373078, 0.53608021822802188, 0.53717746543332634, 0.53827550190180307, 0.53937433371051446, 0.54047396687251925, 0.54157440733793594, 0.54267566099498177, 0.54377773367098592, 0.54488063113337715, 0.54598435909064891, 0.54708892319329983, 0.54819432903475229, 0.54930058215224853, 0.55040768802772566, 0.55151565208867026, 0.5526244797089509, 0.55373417620963283, 0.55484474685977292, 0.55595619687719566, 0.55706853142925095, 0.55818175563355388, 0.55929587455870844, 0.5604108932250137, 0.56152681660515258, 0.56264364962486646, 0.56376139716361373, 0.56488006405521274, 0.56599965508847017, 0.56712017500779477, 0.56824162851379856, 0.56936402026388233, 0.57048735487280966, 0.57161163691326589, 0.57273687091640724, 0.57386306137239496, 0.57499021273091844, 0.57611832940170749, 0.5772474157550318, 0.57837747612219004, 0.5795085147959872, 0.5806405360312028, 0.58177354404504678, 0.58290754301760728, 0.58404253709228726, 0.58517853037623069, 0.58631552694074218, 0.58745353082169394, 0.58859254601992628, 0.58973257650163835, 0.59087362619877004, 0.59201569900937578, 0.59315879879799094, 0.59430292939598872, 0.59544809460193027, 0.59659429818190757, 0.59774154386987699, 0.5988898353679879, 0.6000391763469024, 0.60118957044610932, 0.60234102127423028, 0.6034935324093198, 0.60464710739915906, 0.60580174976154355, 0.60695746298456221, 0.60811425052687451, 0.60927211581797758, 0.61043106225847144, 0.61159109322031413, 0.6127522120470752, 0.61391442205418256, 0.61507772652916215, 0.61624212873187589, 0.61740763189475167, 0.61857423922300991, 0.61974195389488484, 0.62091077906184067, 0.62208071784878471, 0.62325177335427384, 0.62442394865071749, 0.6255972467845784, 0.62677167077656437, 0.62794722362182187, 0.6291239082901201, 0.63030172772603543, 0.63148068484912911, 0.63266078255412317, 0.63384202371107168, 0.63502441116552955, 0.63620794773871503, 0.63739263622767384, 0.63857847940543522, 0.63976548002116673, 0.64095364080032668, 0.64214296444481289, 0.64333345363310745, 0.64452511102042076, 0.64571793923883025, 0.64691194089741966, 0.64810711858241232, 0.64930347485730378, 0.65050101226299217, 0.65169973331790476, 0.65289964051812377, 0.65410073633750887, 0.6553030232278183, 0.65650650361882701, 0.65771117991844374, 0.65891705451282556, 0.66012412976649071, 0.66133240802243032, 0.66254189160221644, 0.66375258280611082, 0.66496448391317153, 0.66617759718135705, 0.66739192484762933, 0.6686074691280568, 0.66982423221791365, 0.67104221629178162, 0.67226142350364615, 0.67348185598699606, 0.67470351585491883, 0.67592640520019642, 0.6771505260954005, 0.67837588059298726, 0.67960247072538982, 0.68083029850511279, 0.68205936592482375, 0.68328967495744608, 0.68452122755625144, 0.68575402565495136, 0.68698807116778859, 0.68822336598962941, 0.68945991199605594, 0.69069771104345723, 0.69193676496912271, 0.69317707559133346, 0.69441864470945747, 0.69566147410404189, 0.69690556553690775, 0.69815092075124685, 0.69939754147171529, 0.70064542940453334, 0.70189458623758194, 0.70314501364050352, 0.70439671326480247, 0.70564968674394757, 0.70690393569347665, 0.70815946171110145, 0.70941626637681732, 0.71067435125300993, 0.71193371788457049, 0.71319436779900869, 0.71445630250656822, 0.71571952350034762, 0.71698403225642271, 0.7182498302339706, 0.7195169188753977, 0.72078529960647242, 0.72205497383645922, 0.72332594295825647, 0.72459820834854127, 0.72587177136791359, 0.72714663336104701, 0.72842279565684642, 0.72970025956860496, 0.73097902639416912, 0.73225909741611084, 0.73354047390190014, 0.7348231571040873, 0.73610714826049028, 0.73739244859438569, 0.7386790593147099, 0.73996698161626429, 0.74125621667992891, 0.74254676567288214, 0.74383862974882975, 0.74513181004824069, 0.7464263076985912, 0.74772212381461833, 0.74901925949858295, 0.75031771584053963, 0.75161749391862032, 0.75291859479932588, 0.7542210195378275, 0.75552476917828215, 0.75682984475415671, 0.75813624728856777, 0.75944397779463069, 0.76075303727582222, 0.76206342672636185, 0.76337514713159871, 0.76468819946842082, 0.76600258470567983, 0.76731830380462396, 0.7686353577193602, 0.76995374739732148, 0.7712734737797643, 0.77259453780227261, 0.77391694039529535, 0.77524068248469669, 0.7765657649923251, 0.77789218883661448, 0.77921995493320173, 0.78054906419557357, 0.78187951753573193, 0.7832113158648969, 0.78454446009422663, 0.78587895113557582, 0.78721478990227634, 0.78855197730995752, 0.78989051427739221, 0.79123040172738546, 0.79257164058769269, 0.79391423179197451, 0.79525817628080409, 0.79660347500269424, 0.79795012891519101, 0.79929813898599389, 0.80064750619413194, 0.80199823153118921, 0.80335031600257734, 0.80470376062886506, 0.80605856644716867, 0.8074147345125865, 0.80877226589971607, 0.81013116170421851, 0.81149142304445698, 0.81285305106320949, 0.81421604692945382, 0.81558041184022145, 0.81694614702255319, 0.81831325373552011, 0.81968173327234473, 0.82105158696261471, 0.82242281617459678, 0.82379542231765635, 0.82516940684477436, 0.82654477125519887, 0.8279215170972013, 0.82929964597096251, 0.83067915953160298, 0.83206005949233697, 0.83344234762778824, 0.83482602577745291, 0.83621109584933229, 0.83759755982373529, 0.8389854197572606, 0.84037467778697927, 0.84176533613481253, 0.84315739711212712, 0.84455086312455163, 0.84594573667704354, 0.84734202037919892, 0.84873971695082717, 0.85013882922781958, 0.85153936016830445, 0.85294131285913166, 0.85434469052268391, 0.85574949652404342, 0.85715573437854387, 0.85856340775972106, 0.85997252050767803, 0.86138307663792557, 0.86279508035067842, 0.86420853604067949, 0.86562344830756621, 0.86703982196681584, 0.86845766206130259, 0.86987697387352969, 0.8712977629385531, 0.87272003505766116, 0.87414379631286188, 0.8755690530822231, 0.87699581205614152, 0.8784240802545954, 0.87985386504544449, 0.88128517416388985, 0.88271801573312036, 0.88415239828629533, 0.88558833078992849, 0.88702582266877239, 0.88846488383237265, 0.88990552470335027, 0.89134775624761386, 0.89279159000662212, 0.89423703813187094, 0.89568411342180188, 0.89713282936132543, 0.89858320016418625, 0.90003524081841146, 0.90148896713512605, 0.90294439580104291, 0.90440154443491738, 0.9058604316484038, 0.90732107711166032, 0.90878350162419952, 0.91024772719147717, 0.91171377710778856, 0.91318167604610501, 0.91465145015555627, 0.91612312716737665, 0.91759673651018636, 0.91907230943563145, 0.92054987915551478, 0.92202948099173121, 0.92351115254046201, 0.92499493385225329, 0.92648086762999604, 0.92796899944684497, 0.92945937798667344, 0.93095205530991121, 0.93244708714804314, 0.93394453323065385, 0.93544445764946449, 0.93694692926451772, 0.93845202215862189, 0.93995981614720103, 0.94147039735190818, 0.94298385884802149, 0.94450030139746444, 0.94601983428155634, 0.94754257625061977, 0.9490686566108919, 0.9505982164737975, 0.95213141019805303, 0.95366840706210776, 0.95520939321350784, 0.95675457395301988, 0.95830417642662213, 0.9598584528176497, 0.96141768415765994, 0.96298218490878718, 0.96455230851777751, 0.96612845420563942, 0.96771107534701128, 0.9693006899195542, 0.97089789368602242, 0.97250337703855683, 0.97411794683490527, 0.97574255516901431, 0.97737833798506024, 0.97902666801295846, 0.98068922914301293, 0.98236812398492779, 0.98406603486354471, 0.98578647507757799, 0.98753420188691543, 0.9893159417746985, 0.99114178102291661, 0.99302818117414282, 0.99500587125666473, 0.99714884401998516, NaN, NaN), fdr = c(0.63716814159292035, 0.63716814159292035, 0.6361389059782101, 0.63496681359486973, 0.63377082390411277, 0.63256843711373534, 0.63136592057348517, 0.63016604092930661, 0.62897012474143532, 0.62777881221732956, 0.62659238577831, 0.62541093049151608, 0.62423441885588904, 0.62306275826274615, 0.62189581871708211, 0.62073344954365928, 0.61957548967933884, 0.61842177410173393, 0.617272137865992, 0.61612641862833772, 0.61498445819595726, 0.61384610344257184, 0.61271120680743996, 0.61157962651986197, 0.61045122664317597, 0.6093258770011194, 0.60820345302897105, 0.6070838355782503, 0.60596691069455411, 0.60485256938184428, 0.60374070736219809, 0.60263122483705867, 0.60152402625395829, 0.60041902008124981, 0.5993161185923801, 0.59821523766054563, 0.59711629656408804, 0.59601921780265865, 0.5949239269239629, 0.5938303523607481, 0.59273842527760545, 0.59164807942711206, 0.59055925101480233, 0.58947187857246042, 0.58838590283922354, 0.58730126665000493, 0.58621791483076158, 0.58513579410015693, 0.58405485297719073, 0.58297504169439385, 0.58189631211621662, 0.5808186176622544, 0.57974191323498514, 0.57866615515171527, 0.57759130108044776, 0.57651730997941375, 0.57544414204001804, 0.57437175863297751, 0.57330012225743876, 0.57222919649288329, 0.57115894595363503, 0.57008933624580915, 0.56902033392654006, 0.56795190646535054, 0.56688402220752232, 0.56581665033934803, 0.56474976085514694, 0.56368332452593772, 0.56261731286966787, 0.56155169812290606, 0.56048645321391244, 0.55942155173700592, 0.55835696792815015, 0.55729267664169257, 0.55622865332818749, 0.55516487401324444, 0.55410131527734152, 0.55303795423655411, 0.55197476852414484, 0.55091173627297241, 0.5498488360986703, 0.54878604708355916, 0.54772334876125084, 0.54666072110190889, 0.54559814449813271, 0.54453559975143107, 0.54347306805925755, 0.5424105310025773, 0.54134797053394068, 0.54028536896603718, 0.53922270896070623, 0.53815997351838418, 0.53709714596796521, 0.53603420995705497, 0.53497114944260249, 0.53390794868188851, 0.53284459222385583, 0.53178106490076515, 0.53071735182016233, 0.5296534383571424, 0.5285893101468957, 0.527524953077527, 0.52646035328313145, 0.52539549713711997, 0.52433037124577997, 0.52326496244206278, 0.52219925777958887, 0.52113324452686016, 0.52006691016167139, 0.51900024236571163, 0.51793322901934979, 0.51686585819659381, 0.51579811816022014, 0.51472999735706104, 0.51366148441345105, 0.51259256813081833, 0.51152323748142159, 0.51045348160422188, 0.50938328980088787, 0.50831265153192784, 0.50724155641294211, 0.50616999421099418, 0.50509795484109377, 0.50402542836278963, 0.50295240497686489, 0.50187887502213524, 0.50080482897234202, 0.49973025743314059, 0.49865515113917769, 0.49757950095125481, 0.49650329785357772, 0.4954265329510838, 0.49434919746684997, 0.49327128273957271, 0.49219278022112367, 0.49111368147417356, 0.49003397816988403, 0.48895366208566415, 0.4878727251029919, 0.48679115920529475, 0.48570895647588957, 0.48462610909598075, 0.48354260934271137, 0.48245844958726958, 0.48137362229304537, 0.48028812001383753, 0.4792019353921092, 0.4781150611572898, 0.4770274901241221, 0.47593921519105359, 0.47485022933866949, 0.47376052562816867, 0.47267009719987668, 0.4715789372718, 0.47048703913821571, 0.46939439616829925, 0.46830100180478584, 0.46720684956266706, 0.46611193302792014, 0.46501624585626916, 0.46391978177197812, 0.4628225345666736, 0.46172449809819693, 0.46062566628948542, 0.4595260331274808, 0.45842559266206417, 0.45732433900501823, 0.45622226632901414, 0.4551193688666228, 0.45401564090935109, 0.45291107680670017, 0.45180567096524765, 0.45069941784775153, 0.44959231197227428, 0.44848434791132979, 0.44737552029104904, 0.44626582379036717, 0.44515525314022708, 0.44404380312280428, 0.44293146857074911, 0.44181824436644623, 0.44070412544129145, 0.43958910677498625, 0.43847318339484742, 0.43735635037513354, 0.43623860283638621, 0.43511993594478715, 0.43400034491152983, 0.43287982499220523, 0.4317583714862015, 0.43063597973611767, 0.4295126451271904, 0.42838836308673406, 0.42726312908359282, 0.42613693862760504, 0.42500978726908156, 0.42388167059829251, 0.42275258424496814, 0.42162252387781002, 0.4204914852040128, 0.4193594639687972, 0.41822645595495317, 0.41709245698239278, 0.41595746290771285, 0.41482146962376937, 0.41368447305925793, 0.41254646917830606, 0.41140745398007361, 0.41026742349836154, 0.4091263738012299, 0.4079843009906241, 0.40684120120200906, 0.40569707060401128, 0.40455190539806973, 0.40340570181809238, 0.40225845613012295, 0.4011101646320121, 0.3999608236530976, 0.39881042955389062, 0.39765897872576983, 0.39650646759068031, 0.39535289260084089, 0.3941982502384565, 0.39304253701543779, 0.39188574947312549, 0.39072788418202242, 0.38956893774152851, 0.38840890677968587, 0.3872477879529248, 0.38608557794581749, 0.38492227347083791, 0.38375787126812422, 0.38259236810524844, 0.3814257607769902, 0.38025804610511516, 0.37908922093815922, 0.3779192821512154, 0.37674822664572633, 0.37557605134928257, 0.37440275321542166, 0.37322832922343557, 0.37205277637817818, 0.37087609170987978, 0.36969827227396462, 0.36851931515087094, 0.36733921744587689, 0.36615797628892832, 0.36497558883447062, 0.36379205226128492, 0.36260736377232622, 0.36142152059456478, 0.36023451997883316, 0.3590463591996732, 0.35785703555518705, 0.3566665463668926, 0.35547488897957918, 0.3542820607611698, 0.35308805910258034, 0.35189288141758773, 0.35069652514269617, 0.34949898773700788, 0.34830026668209524, 0.34710035948187629, 0.34589926366249113, 0.3446969767721817, 0.34349349638117299, 0.3422888200815562, 0.34108294548717444, 0.33987587023350935, 0.33866759197756968, 0.33745810839778356, 0.33624741719388923, 0.33503551608682841, 0.33382240281864289, 0.33260807515237062, 0.3313925308719432, 0.33017576778208635, 0.32895778370821838, 0.32773857649635385, 0.32651814401300394, 0.32529648414508117, 0.32407359479980352, 0.32284947390459956, 0.3216241194070128, 0.32039752927461018, 0.31916970149488721, 0.3179406340751762, 0.31671032504255392, 0.31547877244374856, 0.3142459743450487, 0.31301192883221146, 0.31177663401037059, 0.31054008800394406, 0.30930228895654277, 0.30806323503087729, 0.3068229244086666, 0.30558135529054248, 0.30433852589595817, 0.30309443446309231, 0.3018490792487532, 0.30060245852828471, 0.29935457059546666, 0.29810541376241806, 0.29685498635949642, 0.29560328673519753, 0.29435031325605249, 0.29309606430652341, 0.29184053828889861, 0.29058373362318274, 0.28932564874699007, 0.28806628211542951, 0.28680563220099131, 0.28554369749343178, 0.28428047649965238, 0.28301596774357723, 0.28175016976602935, 0.28048308112460224, 0.27921470039352747, 0.27794502616354089, 0.27667405704174347, 0.27540179165145873, 0.27412822863208641, 0.27285336663895288, 0.27157720434315363, 0.2702997404313951, 0.26902097360583099, 0.26774090258388922, 0.26645952609809997, 0.26517684289591265, 0.26389285173950977, 0.26260755140561443, 0.26132094068529016, 0.26003301838373566, 0.25874378332007103, 0.25745323432711797, 0.2561613702511702, 0.25486818995175925, 0.25357369230140875, 0.25227787618538167, 0.25098074050141705, 0.24968228415946034, 0.24838250608137966, 0.24708140520067409, 0.24577898046217261, 0.24447523082171799, 0.24317015524584332, 0.24186375271143234, 0.24055602220536937, 0.23924696272417773, 0.23793657327363826, 0.23662485286840126, 0.23531180053157921, 0.23399741529432022, 0.23268169619537604, 0.2313646422806398, 0.23004625260267847, 0.22872652622023573, 0.22740546219772728, 0.22608305960470459, 0.22475931751530331, 0.2234342350076749, 0.22210781116338552, 0.22078004506679824, 0.21945093580442643, 0.2181204824642681, 0.21678868413510316, 0.21545553990577335, 0.21412104886442415, 0.21278521009772366, 0.21144802269004243, 0.21010948572260776, 0.20876959827261454, 0.20742835941230733, 0.20608576820802546, 0.20474182371919597, 0.20339652499730579, 0.20204987108480899, 0.20070186101400608, 0.19935249380586806, 0.19800176846881079, 0.19664968399742266, 0.19529623937113497, 0.19394143355283133, 0.19258526548741348, 0.19122773410028396, 0.18986883829578149, 0.18850857695554304, 0.18714694893679051, 0.18578395307054618, 0.18441958815977849, 0.18305385297744681, 0.18168674626447984, 0.18031826672765533, 0.17894841303738526, 0.17757718382540316, 0.17620457768234368, 0.17483059315522564, 0.17345522874480115, 0.1720784829027987, 0.17070035402903749, 0.16932084046839696, 0.167939940507663, 0.16655765237221176, 0.16517397422254707, 0.16378890415066769, 0.16240244017626468, 0.1610145802427394, 0.15962532221302073, 0.15823466386518747, 0.15684260288787286, 0.15544913687544837, 0.15405426332295649, 0.15265797962080105, 0.15126028304917286, 0.14986117077218045, 0.14846063983169552, 0.14705868714086837, 0.14565530947731611, 0.14425050347595672, 0.14284426562145619, 0.14143659224027899, 0.140027479492322, 0.13861692336207432, 0.13720491964932149, 0.13579146395932035, 0.13437655169243382, 0.13296017803318419, 0.13154233793869741, 0.13012302612647034, 0.12870223706144684, 0.1272799649423389, 0.12585620368713812, 0.12443094691777684, 0.12300418794385845, 0.12157591974540465, 0.12014613495455552, 0.11871482583611012, 0.11728198426687966, 0.11584760171370469, 0.11441166921007155, 0.11297417733122758, 0.1115351161676273, 0.11009447529664972, 0.10865224375238609, 0.10720840999337786, 0.10576296186812911, 0.10431588657819807, 0.10286717063867452, 0.1014167998358138, 0.09996475918158855, 0.098511032864873962, 0.097055604198957091, 0.095598455565082605, 0.094139568351596231, 0.092678922888339732, 0.091216498375800523, 0.089752272808522784, 0.088286222892211413, 0.086818323953895035, 0.085348549844443775, 0.083876872832623364, 0.08240326348981368, 0.08092769056436859, 0.079450120844485161, 0.077970519008268652, 0.076488847459538004, 0.075005066147746713, 0.073519132370004001, 0.07203100055315502, 0.070540622013326545, 0.069047944690088833, 0.067552912851956859, 0.066055466769346122, 0.064555542350535525, 0.063053070735482261, 0.061547977841378096, 0.060040183852798953, 0.058529602648091768, 0.057016141151978526, 0.055499698602535591, 0.053980165718443704, 0.052457423749380172, 0.050931343389108139, 0.049401783526202454, 0.047868589801946984, 0.046331592937892269, 0.044790606786492194, 0.043245426046980118, 0.041695823573377741, 0.040141547182350322, 0.038582315842340086, 0.037017815091212783, 0.035447691482222494, 0.033871545794360594, 0.032288924652988743, 0.030699310080445782, 0.029102106313977576, 0.027496622961443219, 0.02588205316509477, 0.024257444830985679, 0.022621662014939706, 0.020973331987041554, 0.019310770856987087, 0.017631876015072236, 0.015933965136455269, 0.014213524922422003, 0.012465798113084571, 0.010684058225301494, 0.0088582189770834065, 0.0069718188258572266, 0.004994128743335248, 0.0028511559800148633, NaN, NaN), fpr = c(1, 1, 0.99361233179527675, 0.986658633981222, 0.97965571136295226, 0.97267886154126681, 0.96575425620021194, 0.95889277723404376, 0.95209905429246122, 0.94537477177256746, 0.93872010821903229, 0.93213443658004347, 0.92561669197481788, 0.91916557561330259, 0.91277967228425672, 0.90645751980268574, 0.90019765064415525, 0.89399861695492255, 0.88785900537765117, 0.88177744552227932, 0.87575261442181096, 0.8697832384348424, 0.86386809352492722, 0.8580060045172343, 0.85219584372445389, 0.84643652919973689, 0.84072702278686351, 0.8350663280799413, 0.82945348836629929, 0.82388758460025824, 0.81836773343790181, 0.8128930853510562, 0.80746282283061888, 0.80207615868393711, 0.79673233442728697, 0.79143061877210619, 0.78617030620208417, 0.78095071563727303, 0.77577118918084331, 0.77063109094384652, 0.76552980594328113, 0.76046673906882167, 0.75544131411371285, 0.7504529728655237, 0.74550117425267914, 0.74058539354293185, 0.73570512159017598, 0.73085986412624671, 0.72604914109457908, 0.72127248602282912, 0.71652944543176833, 0.71181957827795983, 0.70714245542791199, 0.70249765916157636, 0.69788478270321974, 0.69330342977784665, 0.68875321419148228, 0.68423375943375642, 0.67974469830134621, 0.67528567254093685, 0.6708563325104635, 0.66645633685748162, 0.66208535221360931, 0.657743052904045, 0.65342912067124748, 0.64914324441192428, 0.64488511992653752, 0.64065444968058949, 0.63645094257699975, 0.63227431373893661, 0.62812428430250722, 0.62400058121874902, 0.61990293706440358, 0.61583108986098778, 0.61178478290171223, 0.60776376458581949, 0.60376778825994504, 0.59979661206613333, 0.59584999879615608, 0.59192771575181158, 0.58802953461089102, 0.58415523129853042, 0.58030458586367684, 0.57647738236040924, 0.5726734087338845, 0.56889245671067123, 0.56513432169327082, 0.56139880265861875, 0.55768570206037971, 0.5539948257348587, 0.55032598281035994, 0.54667898561983741, 0.5430536496166829, 0.53944979329351106, 0.53586723810381232, 0.53230580838634012, 0.52876533129211523, 0.52524563671393432, 0.5217465572182729, 0.51826792797948218, 0.51480958671618171, 0.51137137362975382, 0.5079531313448572, 0.50455470485187182, 0.5011759414511987, 0.49781669069933687, 0.49447680435666974, 0.49115613633689092, 0.48785454265800177, 0.48457188139482499, 0.48130801263296952, 0.47806279842419586, 0.4748361027431246, 0.47162779144523648, 0.46843773222612084, 0.46526579458191997, 0.46211184977092779, 0.45897577077629947, 0.45585743226983255, 0.45275671057678069, 0.44967348364166115, 0.44660763099502232, 0.44355903372113636, 0.44052757442658708, 0.43751313720971696, 0.43451560763090746, 0.43153487268366242, 0.42857082076646913, 0.42562334165540783, 0.42269232647748445, 0.41977766768466751, 0.41687925902859868, 0.41399699553596092, 0.41113077348447724, 0.40828049037952507, 0.4054460449313434, 0.40262733703281262, 0.39982426773779056, 0.39703673923998928, 0.39426465485237061, 0.39150791898704762, 0.38876643713567671, 0.38604011585032283, 0.38332886272478561, 0.38063258637637176, 0.37795119642809838, 0.37528460349131842, 0.37263271914875129, 0.3699954559379095, 0.36737272733490789, 0.36476444773864625, 0.36217053245535302, 0.35959089768347929, 0.35702546049893458, 0.3544741388406526, 0.35193685149648135, 0.34941351808938315, 0.34690405906393984, 0.34440839567315407, 0.34192644996553678, 0.3394581447724756, 0.33700340369587312, 0.33456215109605103, 0.33213431207991162, 0.32971981248934856, 0.32731857888990146, 0.32493053855964882, 0.32255561947833067, 0.32019375031669661, 0.31784486042607252, 0.31550887982814013, 0.31318573920492598, 0.31087536988899078, 0.30857770385381711, 0.30629267370438906, 0.30402021266795964, 0.30176025458500044, 0.29951273390032873, 0.29727758565440954, 0.29505474547482635, 0.29284414956791716, 0.29064573471057076, 0.28845943824218212, 0.28628519805675923, 0.28412295259518106, 0.28197264083760032, 0.27983420229598965, 0.27770757700682758, 0.27559270552391901, 0.27348952891134937, 0.27139798873656773, 0.26931802706359775, 0.26724958644637131, 0.2651926099221823, 0.26314704100525987, 0.26111282368045741, 0.25908990239705187, 0.25707822206265507, 0.25507772803723283, 0.25308836612722874, 0.25111008257979073, 0.2491428240770992, 0.24718653773079236, 0.24524117107648857, 0.24330667206840362, 0.24138298907405797, 0.23947007086907623, 0.23756786663207408, 0.23567632593963062, 0.23379539876134658, 0.23192503545498422, 0.23006518676168863, 0.22821580380128759, 0.22637683806766962, 0.22454824142423724, 0.22272996609943574, 0.22092196468235326, 0.21912419011839279, 0.21733659570501407, 0.21555913508754432, 0.21379176225505492, 0.2120344315363043, 0.21028709759574471, 0.20854971542959366, 0.20682224036196439, 0.20510462804105911, 0.20339683443542, 0.2016988158302403, 0.20001052882373016, 0.19833193032353957, 0.19666297754323658, 0.19500362799883764, 0.19335383950539242, 0.1917135701736189, 0.19008277840658971, 0.18846142289646894, 0.18684946262129598, 0.18524685684181841, 0.18365356509837205, 0.18206954720780577, 0.18049476326045344, 0.17892917361714766, 0.17737273890627936, 0.17582542002089918, 0.17428717811586047, 0.17275797460500364, 0.17123777115838135, 0.16972652969952251, 0.16822421240273666, 0.16673078169045452, 0.16524620023060765, 0.16377043093404509, 0.16230343695198512, 0.16084518167350281, 0.15939562872305357, 0.15795474195802983, 0.15652248546635228, 0.15509882356409288, 0.15368372079313253, 0.15227714191884878, 0.15087905192783591, 0.14948941602565569, 0.14810819963461852, 0.14673536839159429, 0.14537088814585231, 0.14401472495693102, 0.14266684509253469, 0.14132721502645884, 0.139995801436543, 0.13867257120264931, 0.13735749140467002, 0.13605052932055806, 0.13475165242438492, 0.13346082838442352, 0.13217802506125564, 0.13090321050590348, 0.1296363529579857, 0.12837742084389636, 0.12712638277500754, 0.12588320754589444, 0.12464786413258289, 0.12342032169081962, 0.1222005495543631, 0.12098851723329629, 0.11978419441236099, 0.1185875509493115, 0.11739855687329026, 0.11621718238322232, 0.11504339784622963, 0.11387717379606555, 0.112718480931568, 0.11156729011513078, 0.1104235723711946, 0.10928729888475563, 0.10815844099989202, 0.10703697021830827, 0.10592285819789704, 0.10481607675131799, 0.10371659784459375, 0.10262439359572162, 0.10153943627330364, 0.10046169829518992, 0.099391152227141122, 0.098327770781503565, 0.097271526815901899, 0.096222393331946043, 0.095180343473953211, 0.094145350527684912, 0.093117387919098071, 0.092096429213111008, 0.091082448112383418, 0.090075418456109446, 0.089075314218826196, 0.088082109509233786, 0.087095778569030502, 0.08611629577175961, 0.085143635621670266, 0.084177772752590641, 0.083218681926813587, 0.082266338033995301, 0.081320716090065304, 0.080381791236149414, 0.079449538737504044, 0.078523933982462824, 0.077604952481393763, 0.076692569865669635, 0.075786761886647236, 0.074887504414660411, 0.073994773438021855, 0.0731085450620369, 0.072228795508028298, 0.071355501112370323, 0.070488638325534203, 0.06962818371114432, 0.068774113945042847, 0.067926405814366264, 0.067085036216630978, 0.066249982158828269, 0.065421220756529896, 0.064598729233002472, 0.063782484918331717, 0.062972465248555598, 0.062168647764807128, 0.061371010112466151, 0.060579530040319685, 0.059794185399731914, 0.059014954143822185, 0.058241814326652208, 0.057474744102422037, 0.056713721724673261, 0.055958725545502852, 0.055209734014782907, 0.05446672567939026, 0.053729679182443757, 0.052998573262549309, 0.052273386753053375, 0.051554098581303998, 0.050840687767920167, 0.050133133426068177, 0.049431414760746084, 0.048735511068076276, 0.048045401734604698, 0.047361066236608185, 0.046682484139408675, 0.046009635096695978, 0.045342498849855972, 0.044681055227308142, 0.044025284143848542, 0.04337516560000132, 0.042730679681376338, 0.042091806558034794, 0.041458526483860725, 0.040830819795940942, 0.040208666913950974, 0.039592048339547881, 0.038980944655771177, 0.038375336526448645, 0.037775204695611242, 0.037180529986913458, 0.036591293303060879, 0.036007475625244645, 0.035429058012583114, 0.034856021601569531, 0.03428834760552768, 0.033726017314072987, 0.033169012092582051, 0.032617313381668289, 0.032070902696663794, 0.031529761627109743, 0.030993871836252795, 0.030463215060548277, 0.029937773109171006, 0.029417527863533577, 0.02890246127681062, 0.028392555373471628, 0.027887792248819876, 0.027388154068540227, 0.026893623068252936, 0.026404181553075889, 0.025919811897194611, 0.025440496543439495, 0.024966218002871798, 0.024496958854376638, 0.024032701744265528, 0.023573429385886135, 0.023119124559241477, 0.022669770110616994, 0.022225348952217616, 0.021785844061813053, 0.021351238482393065, 0.020921515321832174, 0.020496657752564262, 0.020076649011267378, 0.01966147239855931, 0.01925111127870327, 0.018845549079326118, 0.018444769291146468, 0.018048755467716004, 0.017657491225172572, 0.017270960242006805, 0.016889146258841192, 0.016512033078223687, 0.016139604564435639, 0.015771844643314825, 0.015408737302094133, 0.015050266589256789, 0.014696416614408347, 0.01434717154816767, 0.014002515622075884, 0.013662433128524887, 0.013326908420708383, 0.012995925912592354, 0.012669470078910616, 0.012347525455183805, 0.012030076637763787, 0.011717108283905819, 0.011408605111868475, 0.011104551901045201, 0.010804933492126523, 0.010509734787297109, 0.010218940750469696, 0.0099325364075560918, 0.0096505068467803712, 0.0093728372190353682, 0.0090995127382856866, 0.0088305186820206716, 0.0085658403917608927, 0.0083054632736212497, 0.0080493727989351394, 0.0077975545049447925, 0.0075499939955616657, 0.0073066769422024391, 0.007067589084707171, 0.0068327162323448265, 0.0066020442649143973, 0.0063755591339487161, 0.0061532468640287385, 0.0059350935542190619, 0.0057210853796344496, 0.0055112085931477983, 0.0053054495272534252, 0.0051037945960992204, 0.0049062302977026517, 0.004712743216369053, 0.0045233200253305128, 0.0043379474896263481, 0.0041566124692518081, 0.0039793019225985438, 0.003806002910220263, 0.0036367025989560986, 0.00347138826645077, 0.0033100473061160596, 0.0031526672325824512, 0.0029992356876986648, 0.0028497404471428123, 0.0027041694277207817, 0.0025625106954361154, 0.0024247524744304139, 0.0022908831569090626, 0.0021608913141828445, 0.0020347657089828664, 0.0019124953092277686, 0.0017940693034581567, 0.0016794771181898316, 0.0015687084374860216, 0.0014617532251079979, 0.0013586017496737268, 0.0012592446133479207, 0.0011636727846963124, 0.0010718776364858629, 0.00098385098938913451, 0.00089958516279720069, 0.00081907303424411104, 0.00074230810936160019, 0.00066928460482063024, 0.00059999754745132527, 0.00053444289374426912, 0.00047261767533801624, 0.00041452017810073016, 0.00036015016531099064, 0.00030950915974725657, 0.00026260080605100544, 0.00021943134502644401, 0.00018001024827585255, 0.00014435108992993939, 0.00011247278268677885, 8.4401400657463377e-05, 6.0173005401287227e-05, 3.9838325844421263e-05, 2.3471250799711463e-05, 1.1186508223293146e-05, 3.1863350966609971e-06, 0, 0), tpr = c(1, 1, 0.99804305283757333, 0.99608610567514666, 0.9941291585127201, 0.99217221135029354, 0.99021526418786687, 0.9882583170254402, 0.98630136986301364, 0.98434442270058709, 0.98238747553816042, 0.98043052837573375, 0.97847358121330719, 0.97651663405088063, 0.97455968688845396, 0.97260273972602729, 0.97064579256360073, 0.96868884540117417, 0.9667318982387475, 0.96477495107632083, 0.96281800391389427, 0.96086105675146771, 0.95890410958904104, 0.95694716242661437, 0.95499021526418781, 0.95303326810176126, 0.95107632093933459, 0.94911937377690792, 0.94716242661448136, 0.9452054794520548, 0.94324853228962813, 0.94129158512720146, 0.9393346379647749, 0.93737769080234834, 0.93542074363992167, 0.93346379647749489, 0.93150684931506844, 0.92954990215264188, 0.92759295499021521, 0.92563600782778854, 0.92367906066536198, 0.92172211350293543, 0.91976516634050876, 0.91780821917808209, 0.91585127201565553, 0.91389432485322897, 0.9119373776908023, 0.90998043052837563, 0.90802348336594907, 0.90606653620352251, 0.90410958904109584, 0.90215264187866917, 0.90019569471624261, 0.89823874755381605, 0.89628180039138938, 0.89432485322896271, 0.89236790606653615, 0.8904109589041096, 0.88845401174168304, 0.88649706457925626, 0.8845401174168297, 0.88258317025440314, 0.88062622309197647, 0.8786692759295498, 0.87671232876712324, 0.87475538160469657, 0.8727984344422699, 0.87084148727984334, 0.86888454011741678, 0.86692759295499022, 0.86497064579256355, 0.86301369863013688, 0.86105675146771044, 0.85909980430528377, 0.8571428571428571, 0.85518590998043043, 0.85322896281800387, 0.85127201565557742, 0.84931506849315064, 0.84735812133072397, 0.84540117416829741, 0.84344422700587085, 0.84148727984344429, 0.83953033268101751, 0.83757338551859095, 0.83561643835616439, 0.83365949119373772, 0.83170254403131105, 0.82974559686888449, 0.82778864970645794, 0.82583170254403138, 0.8238747553816046, 0.82191780821917804, 0.81996086105675148, 0.81800391389432481, 0.81604696673189814, 0.81409001956947158, 0.81213307240704502, 0.81017612524461835, 0.80821917808219157, 0.80626223091976512, 0.80430528375733856, 0.802348336594912, 0.80039138943248522, 0.79843444227005878, 0.79647749510763211, 0.79452054794520544, 0.79256360078277877, 0.79060665362035221, 0.78864970645792565, 0.78669275929549909, 0.78473581213307231, 0.78277886497064575, 0.78082191780821919, 0.77886497064579252, 0.77690802348336585, 0.77495107632093929, 0.77299412915851273, 0.77103718199608617, 0.76908023483365939, 0.76712328767123283, 0.76516634050880639, 0.76320939334637972, 0.76125244618395294, 0.75929549902152638, 0.75733855185909993, 0.75538160469667315, 0.75342465753424648, 0.75146771037181992, 0.74951076320939336, 0.74755381604696669, 0.74559686888454002, 0.74363992172211346, 0.7416829745596869, 0.73972602739726023, 0.73776908023483356, 0.73581213307240712, 0.73385518590998045, 0.73189823874755378, 0.72994129158512711, 0.72798434442270055, 0.72602739726027399, 0.72407045009784743, 0.72211350293542065, 0.72015655577299409, 0.71819960861056753, 0.71624266144814086, 0.71428571428571419, 0.71232876712328763, 0.71037181996086107, 0.7084148727984344, 0.70645792563600773, 0.70450097847358117, 0.70254403131115462, 0.70058708414872795, 0.69863013698630128, 0.69667318982387472, 0.69471624266144816, 0.69275929549902149, 0.69080234833659482, 0.68884540117416826, 0.6868884540117417, 0.68493150684931503, 0.68297455968688836, 0.6810176125244618, 0.67906066536203524, 0.67710371819960857, 0.6751467710371819, 0.67318982387475523, 0.67123287671232879, 0.669275929549902, 0.66731898238747545, 0.66536203522504889, 0.66340508806262233, 0.66144814090019555, 0.65949119373776899, 0.65753424657534243, 0.65557729941291587, 0.6536203522504892, 0.65166340508806253, 0.64970645792563597, 0.64774951076320941, 0.64579256360078274, 0.64383561643835607, 0.64187866927592951, 0.63992172211350296, 0.63796477495107629, 0.63600782778864962, 0.63405088062622306, 0.6320939334637965, 0.63013698630136983, 0.62818003913894316, 0.6262230919765166, 0.62426614481409004, 0.62230919765166337, 0.6203522504892367, 0.61839530332681014, 0.61643835616438358, 0.61448140900195691, 0.61252446183953024, 0.61056751467710368, 0.60861056751467713, 0.60665362035225046, 0.60469667318982379, 0.60273972602739723, 0.60078277886497067, 0.598825831702544, 0.59686888454011733, 0.59491193737769077, 0.59295499021526421, 0.59099804305283754, 0.58904109589041087, 0.58708414872798431, 0.58512720156555775, 0.58317025440313108, 0.58121330724070441, 0.57925636007827785, 0.5772994129158513, 0.57534246575342463, 0.57338551859099796, 0.5714285714285714, 0.56947162426614484, 0.56751467710371817, 0.5655577299412915, 0.56360078277886494, 0.56164383561643838, 0.55968688845401171, 0.55772994129158504, 0.55577299412915848, 0.55381604696673192, 0.55185909980430525, 0.54990215264187858, 0.54794520547945202, 0.54598825831702547, 0.5440313111545988, 0.54207436399217213, 0.54011741682974557, 0.53816046966731901, 0.53620352250489234, 0.53424657534246567, 0.53228962818003911, 0.53033268101761255, 0.52837573385518588, 0.52641878669275921, 0.52446183953033265, 0.52250489236790609, 0.52054794520547942, 0.51859099804305275, 0.51663405088062619, 0.51467710371819964, 0.51272015655577297, 0.5107632093933463, 0.50880626223091974, 0.50684931506849318, 0.50489236790606651, 0.50293542074363984, 0.50097847358121328, 0.49902152641878667, 0.49706457925636005, 0.49510763209393344, 0.49315068493150682, 0.49119373776908021, 0.48923679060665359, 0.48727984344422698, 0.48532289628180036, 0.48336594911937375, 0.48140900195694714, 0.47945205479452052, 0.47749510763209391, 0.47553816046966729, 0.47358121330724068, 0.47162426614481406, 0.46966731898238745, 0.46771037181996084, 0.46575342465753422, 0.46379647749510761, 0.46183953033268099, 0.45988258317025438, 0.45792563600782776, 0.45596868884540115, 0.45401174168297453, 0.45205479452054792, 0.45009784735812131, 0.44814090019569469, 0.44618395303326808, 0.44422700587084146, 0.44227005870841485, 0.44031311154598823, 0.43835616438356162, 0.43639921722113501, 0.43444227005870839, 0.43248532289628178, 0.43052837573385516, 0.42857142857142855, 0.42661448140900193, 0.42465753424657537, 0.4227005870841487, 0.42074363992172209, 0.41878669275929548, 0.41682974559686886, 0.41487279843444225, 0.41291585127201569, 0.41095890410958907, 0.4090019569471624, 0.40704500978473579, 0.40508806262230923, 0.40313111545988256, 0.40117416829745595, 0.39921722113502939, 0.39726027397260272, 0.39530332681017616, 0.39334637964774949, 0.39138943248532287, 0.38943248532289626, 0.38747553816046965, 0.38551859099804303, 0.38356164383561642, 0.38160469667318986, 0.37964774951076319, 0.37769080234833657, 0.37573385518590996, 0.3737769080234834, 0.37181996086105673, 0.36986301369863012, 0.3679060665362035, 0.36594911937377694, 0.36399217221135027, 0.36203522504892366, 0.36007827788649704, 0.35812133072407043, 0.35616438356164382, 0.3542074363992172, 0.35225048923679059, 0.35029354207436392, 0.34833659491193741, 0.3463796477495108, 0.34442270058708419, 0.34246575342465752, 0.34050880626223096, 0.33855185909980429, 0.33659491193737767, 0.33463796477495111, 0.33268101761252444, 0.33072407045009783, 0.32876712328767127, 0.3268101761252446, 0.32485322896281799, 0.32289628180039132, 0.32093933463796476, 0.31898238747553814, 0.31702544031311153, 0.31506849315068497, 0.31311154598825836, 0.31115459882583163, 0.30919765166340507, 0.30724070450097851, 0.30528375733855184, 0.30332681017612523, 0.30136986301369861, 0.299412915851272, 0.29745596868884538, 0.29549902152641883, 0.29354207436399216, 0.2915851272015656, 0.28962818003913887, 0.28767123287671237, 0.2857142857142857, 0.28375733855185903, 0.28180039138943253, 0.27984344422700586, 0.27788649706457924, 0.27592954990215257, 0.27397260273972601, 0.27201565557729945, 0.27005870841487278, 0.26810176125244617, 0.26614481409001955, 0.264187866927593, 0.26223091976516638, 0.26027397260273977, 0.2583170254403131, 0.25636007827788648, 0.25440313111545987, 0.25244618395303331, 0.2504892367906067, 0.24853228962818005, 0.24657534246575341, 0.2446183953033268, 0.2426614481409001, 0.24070450097847362, 0.23874755381604693, 0.23679060665362034, 0.23483365949119361, 0.23287671232876717, 0.23091976516634047, 0.22896281800391383, 0.22700587084148729, 0.22504892367906071, 0.22309197651663407, 0.2211350293542074, 0.21917808219178078, 0.2172211350293542, 0.21526418786692758, 0.21330724070450094, 0.21135029354207435, 0.20939334637964774, 0.20743639921722107, 0.20547945205479451, 0.20352250489236787, 0.20156555772994122, 0.19960861056751467, 0.19765166340508805, 0.19569471624266147, 0.19373776908023482, 0.19178082191780826, 0.18982387475538162, 0.18786692759295498, 0.18590998043052842, 0.18395303326810175, 0.18199608610567519, 0.18003913894324852, 0.17808219178082194, 0.17612524461839529, 0.17416829745596865, 0.17221135029354201, 0.17025440313111548, 0.16829745596868884, 0.16634050880626222, 0.16438356164383566, 0.16242661448140899, 0.16046966731898241, 0.15851272015655576, 0.15655577299412918, 0.15459882583170251, 0.15264187866927589, 0.15068493150684936, 0.14872798434442261, 0.14677103718199611, 0.14481409001956941, 0.14285714285714282, 0.14090019569471618, 0.13894324853228959, 0.13698630136986298, 0.13502935420743636, 0.13307240704500972, 0.13111545988258316, 0.12915851272015663, 0.12720156555772999, 0.1252446183953034, 0.12328767123287671, 0.12133072407045009, 0.11937377690802352, 0.11741682974559686, 0.11545988258317025, 0.11350293542074361, 0.11154598825831699, 0.10958904109589039, 0.1076320939334638, 0.1056751467710372, 0.10371819960861053, 0.10176125244618392, 0.099804305283757389, 0.097847358121330733, 0.09589041095890416, 0.093933463796477504, 0.091976516634050862, 0.090019569471624289, 0.088062622309197675, 0.086105675146771019, 0.084148727984344446, 0.082191780821917845, 0.080234833659491259, 0.078277886497064589, 0.076320939334637947, 0.074363992172211374, 0.072407045009784773, 0.070450097847358159, 0.068493150684931517, 0.066536203522504889, 0.064579256360078302, 0.062622309197651688, 0.060665362035225066, 0.058708414872798501, 0.056751467710371865, 0.054794520547945209, 0.052837573385518657, 0.050880626223092015, 0.048923679060665401, 0.046966731898238773, 0.045009784735812165, 0.043052837573385544, 0.041095890410958923, 0.039138943248532329, 0.03718199608610568, 0.035225048923679107, 0.033268101761252479, 0.031311154598825837, 0.029354207436399233, 0.027397260273972615, 0.02544031311154599, 0.023483365949119386, 0.021526418786692772, 0.019569471624266147, 0.017612524461839554, 0.015655577299412939, 0.013698630136986308, 0.011741682974559685, 0.0097847358121330927, 0.0078277886497064766, 0.0058708414872798544, 0.0039138943248532305, 0.0019569471624266178, 0, 0), tnr = c(0, 0, 0.0063876682047232566, 0.013341366018777983, 0.020344288637047788, 0.027321138458733209, 0.034245743799788037, 0.041107222765956283, 0.047900945707538736, 0.054625228227432557, 0.06127989178096771, 0.067865563419956504, 0.074383308025182157, 0.080834424386697454, 0.087220327715743229, 0.093542480197314287, 0.099802349355844783, 0.10600138304507743, 0.11214099462234878, 0.11822255447772069, 0.12424738557818903, 0.13021676156515763, 0.13613190647507273, 0.1419939954827657, 0.14780415627554608, 0.15356347080026317, 0.15927297721313649, 0.16493367192005864, 0.17054651163370069, 0.17611241539974179, 0.18163226656209822, 0.1871069146489438, 0.1925371771693811, 0.19792384131606294, 0.20326766557271303, 0.20856938122789384, 0.21382969379791589, 0.219049284362727, 0.22422881081915672, 0.22936890905615351, 0.23447019405671882, 0.23953326093117833, 0.24455868588628721, 0.2495470271344763, 0.25449882574732086, 0.25941460645706815, 0.26429487840982402, 0.26914013587375324, 0.27395085890542092, 0.27872751397717088, 0.28347055456823173, 0.28818042172204017, 0.29285754457208801, 0.2975023408384237, 0.30211521729678031, 0.30669657022215341, 0.31124678580851772, 0.31576624056624358, 0.32025530169865385, 0.32471432745906315, 0.32914366748953655, 0.33354366314251832, 0.33791464778639069, 0.342256947095955, 0.34657087932875247, 0.35085675558807577, 0.35511488007346248, 0.35934555031941051, 0.36354905742300025, 0.36772568626106339, 0.37187571569749278, 0.37599941878125098, 0.38009706293559647, 0.38416891013901217, 0.38821521709828771, 0.39223623541418051, 0.39623221174005496, 0.40020338793386673, 0.40415000120384392, 0.40807228424818842, 0.41197046538910903, 0.41584476870146958, 0.41969541413632322, 0.42352261763959081, 0.4273265912661155, 0.43110754328932877, 0.43486567830672918, 0.43860119734138125, 0.44231429793962029, 0.4460051742651413, 0.44967401718964001, 0.45332101438016259, 0.45694635038331716, 0.46055020670648894, 0.46413276189618768, 0.46769419161365994, 0.47123466870788472, 0.47475436328606568, 0.4782534427817271, 0.48173207202051782, 0.48519041328381829, 0.48862862637024612, 0.4920468686551428, 0.49544529514812818, 0.4988240585488013, 0.50218330930066313, 0.50552319564333026, 0.50884386366310908, 0.51214545734199823, 0.51542811860517501, 0.51869198736703048, 0.52193720157580414, 0.5251638972568754, 0.52837220855476352, 0.53156226777387916, 0.53473420541808003, 0.53788815022907221, 0.54102422922370053, 0.54414256773016745, 0.54724328942321931, 0.55032651635833885, 0.55339236900497768, 0.55644096627886364, 0.55947242557341292, 0.56248686279028304, 0.56548439236909254, 0.56846512731633758, 0.57142917923353087, 0.57437665834459217, 0.57730767352251555, 0.58022233231533249, 0.58312074097140132, 0.58600300446403908, 0.58886922651552276, 0.59171950962047493, 0.5945539550686566, 0.59737266296718738, 0.60017573226220944, 0.60296326076001072, 0.60573534514762939, 0.60849208101295238, 0.61123356286432329, 0.61395988414967717, 0.61667113727521439, 0.61936741362362824, 0.62204880357190162, 0.62471539650868158, 0.62736728085124871, 0.6300045440620905, 0.63262727266509211, 0.63523555226135375, 0.63782946754464698, 0.64040910231652071, 0.64297453950106542, 0.6455258611593474, 0.64806314850351865, 0.65058648191061685, 0.65309594093606016, 0.65559160432684593, 0.65807355003446322, 0.6605418552275244, 0.66299659630412688, 0.66543784890394897, 0.66786568792008838, 0.67028018751065144, 0.67268142111009854, 0.67506946144035118, 0.67744438052166933, 0.67980624968330339, 0.68215513957392748, 0.68449112017185987, 0.68681426079507402, 0.68912463011100922, 0.69142229614618289, 0.69370732629561094, 0.69597978733204036, 0.69823974541499956, 0.70048726609967127, 0.70272241434559046, 0.70494525452517365, 0.70715585043208284, 0.70935426528942924, 0.71154056175781788, 0.71371480194324077, 0.71587704740481894, 0.71802735916239968, 0.72016579770401035, 0.72229242299317242, 0.72440729447608099, 0.72651047108865063, 0.72860201126343227, 0.73068197293640225, 0.73275041355362869, 0.7348073900778177, 0.73685295899474013, 0.73888717631954259, 0.74091009760294813, 0.74292177793734493, 0.74492227196276717, 0.74691163387277126, 0.74888991742020927, 0.7508571759229008, 0.75281346226920764, 0.75475882892351143, 0.75669332793159638, 0.75861701092594203, 0.76052992913092377, 0.76243213336792592, 0.76432367406036938, 0.76620460123865342, 0.76807496454501578, 0.76993481323831137, 0.77178419619871241, 0.77362316193233038, 0.77545175857576276, 0.77727003390056426, 0.77907803531764674, 0.78087580988160721, 0.78266340429498593, 0.78444086491245568, 0.78620823774494508, 0.7879655684636957, 0.78971290240425529, 0.79145028457040634, 0.79317775963803561, 0.79489537195894089, 0.79660316556458, 0.7983011841697597, 0.79998947117626984, 0.80166806967646043, 0.80333702245676342, 0.80499637200116236, 0.80664616049460758, 0.8082864298263811, 0.80991722159341029, 0.81153857710353106, 0.81315053737870402, 0.81475314315818159, 0.81634643490162795, 0.81793045279219423, 0.81950523673954656, 0.82107082638285234, 0.82262726109372064, 0.82417457997910082, 0.82571282188413953, 0.82724202539499636, 0.82876222884161865, 0.83027347030047749, 0.83177578759726334, 0.83326921830954548, 0.83475379976939235, 0.83622956906595491, 0.83769656304801488, 0.83915481832649719, 0.84060437127694643, 0.84204525804197017, 0.84347751453364772, 0.84490117643590712, 0.84631627920686747, 0.84772285808115122, 0.84912094807216409, 0.85051058397434431, 0.85189180036538148, 0.85326463160840571, 0.85462911185414769, 0.85598527504306898, 0.85733315490746531, 0.85867278497354116, 0.860004198563457, 0.86132742879735069, 0.86264250859532998, 0.86394947067944194, 0.86524834757561508, 0.86653917161557648, 0.86782197493874436, 0.86909678949409652, 0.8703636470420143, 0.87162257915610364, 0.87287361722499246, 0.87411679245410556, 0.87535213586741711, 0.87657967830918038, 0.8777994504456369, 0.87901148276670371, 0.88021580558763901, 0.8814124490506885, 0.88260144312670974, 0.88378281761677768, 0.88495660215377037, 0.88612282620393445, 0.887281519068432, 0.88843270988486922, 0.8895764276288054, 0.89071270111524437, 0.89184155900010798, 0.89296302978169173, 0.89407714180210296, 0.89518392324868201, 0.89628340215540625, 0.89737560640427838, 0.89846056372669636, 0.89953830170481008, 0.90060884777285888, 0.90167222921849643, 0.9027284731840981, 0.90377760666805396, 0.90481965652604679, 0.90585464947231509, 0.90688261208090193, 0.90790357078688899, 0.90891755188761658, 0.90992458154389055, 0.9109246857811738, 0.91191789049076621, 0.9129042214309695, 0.91388370422824039, 0.91485636437832973, 0.91582222724740936, 0.91678131807318641, 0.9177336619660047, 0.9186792839099347, 0.91961820876385059, 0.92055046126249596, 0.92147606601753718, 0.92239504751860624, 0.92330743013433036, 0.92421323811335276, 0.92511249558533959, 0.92600522656197815, 0.9268914549379631, 0.9277712044919717, 0.92864449888762968, 0.9295113616744658, 0.93037181628885568, 0.93122588605495715, 0.93207359418563374, 0.93291496378336902, 0.93375001784117173, 0.9345787792434701, 0.93540127076699753, 0.93621751508166828, 0.9370275347514444, 0.93783135223519287, 0.93862898988753385, 0.93942046995968032, 0.94020581460026809, 0.94098504585617782, 0.94175818567334779, 0.94252525589757796, 0.94328627827532674, 0.94404127445449715, 0.94479026598521709, 0.94553327432060974, 0.94627032081755624, 0.94700142673745069, 0.94772661324694663, 0.948445901418696, 0.94915931223207983, 0.94986686657393182, 0.95056858523925392, 0.95126448893192372, 0.9519545982653953, 0.95263893376339182, 0.95331751586059132, 0.95399036490330402, 0.95465750115014403, 0.95531894477269186, 0.95597471585615146, 0.95662483439999868, 0.95726932031862366, 0.95790819344196521, 0.95854147351613928, 0.95916918020405906, 0.95979133308604903, 0.96040795166045212, 0.96101905534422882, 0.96162466347355136, 0.96222479530438876, 0.96281947001308654, 0.96340870669693912, 0.96399252437475536, 0.96457094198741689, 0.96514397839843047, 0.96571165239447232, 0.96627398268592701, 0.96683098790741795, 0.96738268661833171, 0.96792909730333621, 0.96847023837289026, 0.9690061281637472, 0.96953678493945172, 0.97006222689082899, 0.97058247213646642, 0.97109753872318938, 0.97160744462652837, 0.97211220775118012, 0.97261184593145977, 0.97310637693174706, 0.97359581844692411, 0.97408018810280539, 0.97455950345656051, 0.9750337819971282, 0.97550304114562336, 0.97596729825573447, 0.97642657061411386, 0.97688087544075852, 0.97733022988938301, 0.97777465104778238, 0.97821415593818695, 0.97864876151760694, 0.97907848467816783, 0.97950334224743574, 0.97992335098873262, 0.98033852760144069, 0.98074888872129673, 0.98115445092067388, 0.98155523070885353, 0.981951244532284, 0.98234250877482743, 0.98272903975799319, 0.98311085374115881, 0.98348796692177631, 0.98386039543556436, 0.98422815535668517, 0.98459126269790587, 0.98494973341074321, 0.98530358338559165, 0.98565282845183233, 0.98599748437792412, 0.98633756687147511, 0.98667309157929162, 0.98700407408740765, 0.98733052992108938, 0.98765247454481619, 0.98796992336223621, 0.98828289171609418, 0.98859139488813152, 0.9888954480989548, 0.98919506650787348, 0.98949026521270289, 0.9897810592495303, 0.99006746359244391, 0.99034949315321963, 0.99062716278096463, 0.99090048726171431, 0.99116948131797933, 0.99143415960823911, 0.99169453672637875, 0.99195062720106486, 0.99220244549505521, 0.99245000600443833, 0.99269332305779756, 0.99293241091529283, 0.99316728376765517, 0.9933979557350856, 0.99362444086605128, 0.99384675313597126, 0.99406490644578094, 0.99427891462036555, 0.9944887914068522, 0.99469455047274657, 0.99489620540390078, 0.99509376970229735, 0.99528725678363095, 0.99547667997466949, 0.99566205251037365, 0.99584338753074819, 0.99602069807740146, 0.99619399708977974, 0.9963632974010439, 0.99652861173354923, 0.99668995269388394, 0.99684733276741755, 0.99700076431230134, 0.99715025955285719, 0.99729583057227922, 0.99743748930456388, 0.99757524752556959, 0.99770911684309094, 0.99783910868581716, 0.99796523429101713, 0.99808750469077223, 0.99820593069654184, 0.99832052288181017, 0.99843129156251398, 0.998538246774892, 0.99864139825032627, 0.99874075538665208, 0.99883632721530369, 0.99892812236351414, 0.99901614901061087, 0.9991004148372028, 0.99918092696575589, 0.9992576918906384, 0.99933071539517937, 0.99940000245254867, 0.99946555710625573, 0.99952738232466198, 0.99958547982189927, 0.99963984983468901, 0.99969049084025274, 0.99973739919394899, 0.99978056865497356, 0.99981998975172415, 0.99985564891007006, 0.99988752721731322, 0.99991559859934254, 0.99993982699459871, 0.99996016167415558, 0.99997652874920029, 0.99998881349177671, 0.99999681366490334, 1, 1), fnr = c(0, 0, 0.0019569471624267323, 0.0039138943248532912, 0.0058708414872798501, 0.0078277886497064089, 0.0097847358121331413, 0.011741682974559874, 0.013698630136986432, 0.015655577299412991, 0.01761252446183955, 0.019569471624266283, 0.021526418786692841, 0.0234833659491194, 0.025440313111545959, 0.027397260273972691, 0.02935420743639925, 0.031311154598825809, 0.033268101761252541, 0.0352250489236791, 0.037181996086105659, 0.039138943248532218, 0.04109589041095895, 0.043052837573385683, 0.045009784735812242, 0.0469667318982388, 0.048923679060665359, 0.050880626223092092, 0.052837573385518651, 0.054794520547945209, 0.056751467710371942, 0.058708414872798501, 0.060665362035225059, 0.062622309197651618, 0.064579256360078344, 0.066536203522505083, 0.068493150684931642, 0.070450097847358201, 0.07240704500978476, 0.074363992172211485, 0.076320939334638044, 0.078277886497064603, 0.080234833659491162, 0.082191780821917901, 0.08414872798434446, 0.086105675146771019, 0.088062622309197744, 0.090019569471624303, 0.091976516634050862, 0.093933463796477421, 0.09589041095890416, 0.097847358121330885, 0.099804305283757444, 0.101761252446184, 0.10371819960861056, 0.1056751467710373, 0.10763209393346386, 0.10958904109589042, 0.11154598825831698, 0.1135029354207437, 0.11545988258317026, 0.11741682974559682, 0.11937377690802356, 0.12133072407045012, 0.12328767123287668, 0.1252446183953034, 0.12720156555773013, 0.12915851272015669, 0.13111545988258325, 0.13307240704500981, 0.13502935420743636, 0.13698630136986312, 0.13894324853228948, 0.14090019569471623, 0.14285714285714296, 0.14481409001956952, 0.14677103718199608, 0.14872798434442264, 0.15068493150684936, 0.15264187866927609, 0.15459882583170265, 0.15655577299412921, 0.15851272015655576, 0.16046966731898252, 0.16242661448140908, 0.16438356164383564, 0.16634050880626236, 0.16829745596868892, 0.17025440313111548, 0.17221135029354204, 0.1741682974559686, 0.17612524461839532, 0.17808219178082188, 0.18003913894324844, 0.18199608610567516, 0.18395303326810192, 0.18590998043052848, 0.18786692759295504, 0.18982387475538159, 0.19178082191780849, 0.19373776908023488, 0.19569471624266144, 0.197651663405088, 0.19960861056751472, 0.20156555772994128, 0.20352250489236784, 0.20547945205479456, 0.20743639921722132, 0.20939334637964788, 0.21135029354207444, 0.21330724070450099, 0.21526418786692772, 0.21722113502935428, 0.21917808219178084, 0.22113502935420748, 0.22309197651663412, 0.22504892367906068, 0.22700587084148724, 0.2289628180039138, 0.23091976516634061, 0.23287671232876717, 0.23483365949119364, 0.23679060665362028, 0.23874755381604704, 0.2407045009784736, 0.24266144814090007, 0.24461839530332688, 0.24657534246575352, 0.24853228962818008, 0.25048923679060664, 0.25244618395303331, 0.25440313111546003, 0.25636007827788659, 0.25831702544031315, 0.26027397260273977, 0.26223091976516644, 0.26418786692759288, 0.26614481409001955, 0.26810176125244617, 0.27005870841487289, 0.27201565557729945, 0.27397260273972601, 0.27592954990215257, 0.27788649706457935, 0.27984344422700591, 0.28180039138943247, 0.2837573385518592, 0.28571428571428581, 0.28767123287671237, 0.28962818003913893, 0.2915851272015656, 0.29354207436399221, 0.29549902152641877, 0.29745596868884533, 0.29941291585127211, 0.30136986301369872, 0.30332681017612528, 0.30528375733855184, 0.30724070450097851, 0.30919765166340513, 0.31115459882583169, 0.31311154598825824, 0.31506849315068497, 0.31702544031311164, 0.3189823874755382, 0.32093933463796476, 0.32289628180039137, 0.32485322896281815, 0.32681017612524477, 0.32876712328767127, 0.330724070450098, 0.33268101761252455, 0.33463796477495111, 0.33659491193737767, 0.33855185909980445, 0.34050880626223101, 0.34246575342465757, 0.34442270058708413, 0.3463796477495108, 0.34833659491193747, 0.35029354207436403, 0.35225048923679059, 0.35420743639921731, 0.35616438356164393, 0.35812133072407049, 0.36007827788649704, 0.36203522504892371, 0.36399217221135033, 0.36594911937377689, 0.36790606653620345, 0.36986301369863017, 0.37181996086105684, 0.3737769080234834, 0.37573385518590996, 0.37769080234833663, 0.37964774951076335, 0.38160469667318991, 0.38356164383561647, 0.38551859099804309, 0.38747553816046976, 0.38943248532289632, 0.39138943248532287, 0.39334637964774949, 0.39530332681017621, 0.39726027397260277, 0.39921722113502933, 0.401174168297456, 0.40313111545988267, 0.40508806262230923, 0.40704500978473579, 0.40900195694716251, 0.41095890410958913, 0.41291585127201569, 0.41487279843444225, 0.41682974559686892, 0.41878669275929553, 0.42074363992172209, 0.42270058708414865, 0.42465753424657543, 0.42661448140900204, 0.4285714285714286, 0.43052837573385516, 0.43248532289628183, 0.43444227005870856, 0.43639921722113512, 0.43835616438356168, 0.44031311154598829, 0.44227005870841496, 0.44422700587084152, 0.44618395303326808, 0.44814090019569469, 0.45009784735812147, 0.45205479452054803, 0.45401174168297459, 0.4559686888454012, 0.45792563600782787, 0.45988258317025443, 0.46183953033268099, 0.46379647749510761, 0.46575342465753433, 0.46771037181996089, 0.46966731898238745, 0.47162426614481412, 0.47358121330724079, 0.47553816046966735, 0.47749510763209391, 0.47945205479452063, 0.48140900195694725, 0.48336594911937381, 0.48532289628180036, 0.48727984344422703, 0.48923679060665365, 0.49119373776908021, 0.49315068493150677, 0.49510763209393349, 0.49706457925636016, 0.49902152641878672, 0.50097847358121339, 0.50293542074363995, 0.50489236790606662, 0.50684931506849318, 0.50880626223091974, 0.51076320939334641, 0.51272015655577297, 0.51467710371819964, 0.51663405088062631, 0.51859099804305286, 0.52054794520547942, 0.52250489236790609, 0.52446183953033265, 0.52641878669275932, 0.52837573385518599, 0.53033268101761255, 0.53228962818003922, 0.53424657534246578, 0.53620352250489234, 0.53816046966731901, 0.54011741682974557, 0.54207436399217224, 0.54403131115459891, 0.54598825831702547, 0.54794520547945202, 0.54990215264187869, 0.55185909980430525, 0.55381604696673192, 0.55577299412915859, 0.55772994129158515, 0.55968688845401182, 0.56164383561643838, 0.56360078277886494, 0.56555772994129161, 0.56751467710371817, 0.56947162426614484, 0.57142857142857151, 0.57338551859099807, 0.57534246575342463, 0.5772994129158513, 0.57925636007827785, 0.58121330724070452, 0.58317025440313119, 0.58512720156555775, 0.58708414872798431, 0.58904109589041098, 0.59099804305283754, 0.59295499021526421, 0.59491193737769077, 0.59686888454011744, 0.59882583170254411, 0.60078277886497067, 0.60273972602739734, 0.6046966731898239, 0.60665362035225046, 0.60861056751467713, 0.61056751467710368, 0.61252446183953035, 0.61448140900195702, 0.61643835616438358, 0.61839530332681014, 0.62035225048923681, 0.62230919765166337, 0.62426614481409004, 0.6262230919765166, 0.62818003913894327, 0.63013698630136994, 0.6320939334637965, 0.63405088062622306, 0.63600782778864973, 0.6379647749510764, 0.63992172211350296, 0.64187866927592963, 0.64383561643835618, 0.64579256360078274, 0.6477495107632093, 0.64970645792563608, 0.65166340508806264, 0.6536203522504892, 0.65557729941291576, 0.65753424657534254, 0.6594911937377691, 0.66144814090019566, 0.66340508806262233, 0.66536203522504889, 0.66731898238747556, 0.66927592954990223, 0.67123287671232879, 0.67318982387475534, 0.67514677103718201, 0.67710371819960868, 0.67906066536203524, 0.68101761252446191, 0.68297455968688847, 0.68493150684931503, 0.6868884540117417, 0.68884540117416837, 0.69080234833659493, 0.69275929549902149, 0.69471624266144816, 0.69667318982387472, 0.6986301369863015, 0.70058708414872806, 0.70254403131115462, 0.70450097847358117, 0.70645792563600784, 0.7084148727984344, 0.71037181996086118, 0.71232876712328763, 0.7142857142857143, 0.71624266144814097, 0.71819960861056742, 0.72015655577299409, 0.72211350293542076, 0.72407045009784743, 0.72602739726027399, 0.72798434442270055, 0.72994129158512722, 0.73189823874755378, 0.73385518590998045, 0.735812133072407, 0.73776908023483367, 0.73972602739726023, 0.7416829745596869, 0.74363992172211346, 0.74559686888454002, 0.74755381604696658, 0.74951076320939336, 0.75146771037181992, 0.7534246575342467, 0.75538160469667326, 0.75733855185909993, 0.75929549902152638, 0.76125244618395305, 0.76320939334637961, 0.76516634050880639, 0.76712328767123283, 0.7690802348336595, 0.77103718199608617, 0.77299412915851273, 0.77495107632093929, 0.77690802348336585, 0.77886497064579263, 0.78082191780821919, 0.78277886497064575, 0.78473581213307242, 0.78669275929549898, 0.78864970645792576, 0.79060665362035232, 0.79256360078277888, 0.79452054794520544, 0.79647749510763211, 0.79843444227005866, 0.80039138943248522, 0.802348336594912, 0.80430528375733856, 0.80626223091976512, 0.80821917808219168, 0.81017612524461846, 0.81213307240704502, 0.81409001956947158, 0.81604696673189825, 0.81800391389432481, 0.81996086105675137, 0.82191780821917815, 0.82387475538160471, 0.82583170254403138, 0.82778864970645794, 0.82974559686888449, 0.83170254403131105, 0.83365949119373783, 0.83561643835616439, 0.83757338551859095, 0.83953033268101762, 0.84148727984344418, 0.84344422700587074, 0.84540117416829752, 0.84735812133072408, 0.84931506849315064, 0.85127201565557742, 0.85322896281800398, 0.85518590998043065, 0.85714285714285721, 0.85909980430528377, 0.86105675146771032, 0.8630136986301371, 0.86497064579256366, 0.86692759295499022, 0.86888454011741678, 0.87084148727984334, 0.87279843444227001, 0.87475538160469657, 0.87671232876712335, 0.87866927592954991, 0.88062622309197647, 0.88258317025440314, 0.8845401174168297, 0.88649706457925648, 0.88845401174168304, 0.8904109589041096, 0.89236790606653615, 0.89432485322896271, 0.89628180039138938, 0.89823874755381616, 0.9001956947162425, 0.90215264187866928, 0.90410958904109584, 0.90606653620352262, 0.90802348336594918, 0.90998043052837574, 0.9119373776908023, 0.91389432485322897, 0.91585127201565553, 0.91780821917808209, 0.91976516634050864, 0.92172211350293543, 0.92367906066536209, 0.92563600782778865, 0.92759295499021521, 0.92954990215264177, 0.93150684931506855, 0.93346379647749511, 0.93542074363992167, 0.93737769080234834, 0.9393346379647749, 0.94129158512720146, 0.94324853228962802, 0.9452054794520548, 0.94716242661448136, 0.94911937377690792, 0.9510763209393347, 0.95303326810176126, 0.95499021526418781, 0.95694716242661448, 0.95890410958904104, 0.9608610567514676, 0.96281800391389438, 0.96477495107632094, 0.9667318982387475, 0.96868884540117417, 0.97064579256360073, 0.97260273972602729, 0.97455968688845407, 0.97651663405088063, 0.97847358121330719, 0.98043052837573386, 0.98238747553816042, 0.98434442270058697, 0.98630136986301375, 0.98825831702544031, 0.99021526418786687, 0.99217221135029354, 0.9941291585127201, 0.99608610567514666, 0.99804305283757344, 1, 1), `1-specificity` = c(1, 1, 0.99361233179527675, 0.986658633981222, 0.97965571136295226, 0.97267886154126681, 0.96575425620021194, 0.95889277723404376, 0.95209905429246122, 0.94537477177256746, 0.93872010821903229, 0.93213443658004347, 0.92561669197481788, 0.91916557561330259, 0.91277967228425672, 0.90645751980268574, 0.90019765064415525, 0.89399861695492255, 0.88785900537765117, 0.88177744552227932, 0.87575261442181096, 0.8697832384348424, 0.86386809352492722, 0.8580060045172343, 0.85219584372445389, 0.84643652919973689, 0.84072702278686351, 0.8350663280799413, 0.82945348836629929, 0.82388758460025824, 0.81836773343790181, 0.8128930853510562, 0.80746282283061888, 0.80207615868393711, 0.79673233442728697, 0.79143061877210619, 0.78617030620208417, 0.78095071563727303, 0.77577118918084331, 0.77063109094384652, 0.76552980594328113, 0.76046673906882167, 0.75544131411371285, 0.7504529728655237, 0.74550117425267914, 0.74058539354293185, 0.73570512159017598, 0.73085986412624671, 0.72604914109457908, 0.72127248602282912, 0.71652944543176833, 0.71181957827795983, 0.70714245542791199, 0.70249765916157636, 0.69788478270321974, 0.69330342977784665, 0.68875321419148228, 0.68423375943375642, 0.67974469830134621, 0.67528567254093685, 0.6708563325104635, 0.66645633685748162, 0.66208535221360931, 0.657743052904045, 0.65342912067124748, 0.64914324441192428, 0.64488511992653752, 0.64065444968058949, 0.63645094257699975, 0.63227431373893661, 0.62812428430250722, 0.62400058121874902, 0.61990293706440358, 0.61583108986098778, 0.61178478290171223, 0.60776376458581949, 0.60376778825994504, 0.59979661206613333, 0.59584999879615608, 0.59192771575181158, 0.58802953461089102, 0.58415523129853042, 0.58030458586367684, 0.57647738236040924, 0.5726734087338845, 0.56889245671067123, 0.56513432169327082, 0.56139880265861875, 0.55768570206037971, 0.5539948257348587, 0.55032598281035994, 0.54667898561983741, 0.5430536496166829, 0.53944979329351106, 0.53586723810381232, 0.53230580838634012, 0.52876533129211523, 0.52524563671393432, 0.5217465572182729, 0.51826792797948218, 0.51480958671618171, 0.51137137362975382, 0.5079531313448572, 0.50455470485187182, 0.5011759414511987, 0.49781669069933687, 0.49447680435666974, 0.49115613633689092, 0.48785454265800177, 0.48457188139482499, 0.48130801263296952, 0.47806279842419586, 0.4748361027431246, 0.47162779144523648, 0.46843773222612084, 0.46526579458191997, 0.46211184977092779, 0.45897577077629947, 0.45585743226983255, 0.45275671057678069, 0.44967348364166115, 0.44660763099502232, 0.44355903372113636, 0.44052757442658708, 0.43751313720971696, 0.43451560763090746, 0.43153487268366242, 0.42857082076646913, 0.42562334165540783, 0.42269232647748445, 0.41977766768466751, 0.41687925902859868, 0.41399699553596092, 0.41113077348447724, 0.40828049037952507, 0.4054460449313434, 0.40262733703281262, 0.39982426773779056, 0.39703673923998928, 0.39426465485237061, 0.39150791898704762, 0.38876643713567671, 0.38604011585032283, 0.38332886272478561, 0.38063258637637176, 0.37795119642809838, 0.37528460349131842, 0.37263271914875129, 0.3699954559379095, 0.36737272733490789, 0.36476444773864625, 0.36217053245535302, 0.35959089768347929, 0.35702546049893458, 0.3544741388406526, 0.35193685149648135, 0.34941351808938315, 0.34690405906393984, 0.34440839567315407, 0.34192644996553678, 0.3394581447724756, 0.33700340369587312, 0.33456215109605103, 0.33213431207991162, 0.32971981248934856, 0.32731857888990146, 0.32493053855964882, 0.32255561947833067, 0.32019375031669661, 0.31784486042607252, 0.31550887982814013, 0.31318573920492598, 0.31087536988899078, 0.30857770385381711, 0.30629267370438906, 0.30402021266795964, 0.30176025458500044, 0.29951273390032873, 0.29727758565440954, 0.29505474547482635, 0.29284414956791716, 0.29064573471057076, 0.28845943824218212, 0.28628519805675923, 0.28412295259518106, 0.28197264083760032, 0.27983420229598965, 0.27770757700682758, 0.27559270552391901, 0.27348952891134937, 0.27139798873656773, 0.26931802706359775, 0.26724958644637131, 0.2651926099221823, 0.26314704100525987, 0.26111282368045741, 0.25908990239705187, 0.25707822206265507, 0.25507772803723283, 0.25308836612722874, 0.25111008257979073, 0.2491428240770992, 0.24718653773079236, 0.24524117107648857, 0.24330667206840362, 0.24138298907405797, 0.23947007086907623, 0.23756786663207408, 0.23567632593963062, 0.23379539876134658, 0.23192503545498422, 0.23006518676168863, 0.22821580380128759, 0.22637683806766962, 0.22454824142423724, 0.22272996609943574, 0.22092196468235326, 0.21912419011839279, 0.21733659570501407, 0.21555913508754432, 0.21379176225505492, 0.2120344315363043, 0.21028709759574471, 0.20854971542959366, 0.20682224036196439, 0.20510462804105911, 0.20339683443542, 0.2016988158302403, 0.20001052882373016, 0.19833193032353957, 0.19666297754323658, 0.19500362799883764, 0.19335383950539242, 0.1917135701736189, 0.19008277840658971, 0.18846142289646894, 0.18684946262129598, 0.18524685684181841, 0.18365356509837205, 0.18206954720780577, 0.18049476326045344, 0.17892917361714766, 0.17737273890627936, 0.17582542002089918, 0.17428717811586047, 0.17275797460500364, 0.17123777115838135, 0.16972652969952251, 0.16822421240273666, 0.16673078169045452, 0.16524620023060765, 0.16377043093404509, 0.16230343695198512, 0.16084518167350281, 0.15939562872305357, 0.15795474195802983, 0.15652248546635228, 0.15509882356409288, 0.15368372079313253, 0.15227714191884878, 0.15087905192783591, 0.14948941602565569, 0.14810819963461852, 0.14673536839159429, 0.14537088814585231, 0.14401472495693102, 0.14266684509253469, 0.14132721502645884, 0.139995801436543, 0.13867257120264931, 0.13735749140467002, 0.13605052932055806, 0.13475165242438492, 0.13346082838442352, 0.13217802506125564, 0.13090321050590348, 0.1296363529579857, 0.12837742084389636, 0.12712638277500754, 0.12588320754589444, 0.12464786413258289, 0.12342032169081962, 0.1222005495543631, 0.12098851723329629, 0.11978419441236099, 0.1185875509493115, 0.11739855687329026, 0.11621718238322232, 0.11504339784622963, 0.11387717379606555, 0.112718480931568, 0.11156729011513078, 0.1104235723711946, 0.10928729888475563, 0.10815844099989202, 0.10703697021830827, 0.10592285819789704, 0.10481607675131799, 0.10371659784459375, 0.10262439359572162, 0.10153943627330364, 0.10046169829518992, 0.099391152227141122, 0.098327770781503565, 0.097271526815901899, 0.096222393331946043, 0.095180343473953211, 0.094145350527684912, 0.093117387919098071, 0.092096429213111008, 0.091082448112383418, 0.090075418456109446, 0.089075314218826196, 0.088082109509233786, 0.087095778569030502, 0.08611629577175961, 0.085143635621670266, 0.084177772752590641, 0.083218681926813587, 0.082266338033995301, 0.081320716090065304, 0.080381791236149414, 0.079449538737504044, 0.078523933982462824, 0.077604952481393763, 0.076692569865669635, 0.075786761886647236, 0.074887504414660411, 0.073994773438021855, 0.0731085450620369, 0.072228795508028298, 0.071355501112370323, 0.070488638325534203, 0.06962818371114432, 0.068774113945042847, 0.067926405814366264, 0.067085036216630978, 0.066249982158828269, 0.065421220756529896, 0.064598729233002472, 0.063782484918331717, 0.062972465248555598, 0.062168647764807128, 0.061371010112466151, 0.060579530040319685, 0.059794185399731914, 0.059014954143822185, 0.058241814326652208, 0.057474744102422037, 0.056713721724673261, 0.055958725545502852, 0.055209734014782907, 0.05446672567939026, 0.053729679182443757, 0.052998573262549309, 0.052273386753053375, 0.051554098581303998, 0.050840687767920167, 0.050133133426068177, 0.049431414760746084, 0.048735511068076276, 0.048045401734604698, 0.047361066236608185, 0.046682484139408675, 0.046009635096695978, 0.045342498849855972, 0.044681055227308142, 0.044025284143848542, 0.04337516560000132, 0.042730679681376338, 0.042091806558034794, 0.041458526483860725, 0.040830819795940942, 0.040208666913950974, 0.039592048339547881, 0.038980944655771177, 0.038375336526448645, 0.037775204695611242, 0.037180529986913458, 0.036591293303060879, 0.036007475625244645, 0.035429058012583114, 0.034856021601569531, 0.03428834760552768, 0.033726017314072987, 0.033169012092582051, 0.032617313381668289, 0.032070902696663794, 0.031529761627109743, 0.030993871836252795, 0.030463215060548277, 0.029937773109171006, 0.029417527863533577, 0.02890246127681062, 0.028392555373471628, 0.027887792248819876, 0.027388154068540227, 0.026893623068252936, 0.026404181553075889, 0.025919811897194611, 0.025440496543439495, 0.024966218002871798, 0.024496958854376638, 0.024032701744265528, 0.023573429385886135, 0.023119124559241477, 0.022669770110616994, 0.022225348952217616, 0.021785844061813053, 0.021351238482393065, 0.020921515321832174, 0.020496657752564262, 0.020076649011267378, 0.01966147239855931, 0.01925111127870327, 0.018845549079326118, 0.018444769291146468, 0.018048755467716004, 0.017657491225172572, 0.017270960242006805, 0.016889146258841192, 0.016512033078223687, 0.016139604564435639, 0.015771844643314825, 0.015408737302094133, 0.015050266589256789, 0.014696416614408347, 0.01434717154816767, 0.014002515622075884, 0.013662433128524887, 0.013326908420708383, 0.012995925912592354, 0.012669470078910616, 0.012347525455183805, 0.012030076637763787, 0.011717108283905819, 0.011408605111868475, 0.011104551901045201, 0.010804933492126523, 0.010509734787297109, 0.010218940750469696, 0.0099325364075560918, 0.0096505068467803712, 0.0093728372190353682, 0.0090995127382856866, 0.0088305186820206716, 0.0085658403917608927, 0.0083054632736212497, 0.0080493727989351394, 0.0077975545049447925, 0.0075499939955616657, 0.0073066769422024391, 0.007067589084707171, 0.0068327162323448265, 0.0066020442649143973, 0.0063755591339487161, 0.0061532468640287385, 0.0059350935542190619, 0.0057210853796344496, 0.0055112085931477983, 0.0053054495272534252, 0.0051037945960992204, 0.0049062302977026517, 0.004712743216369053, 0.0045233200253305128, 0.0043379474896263481, 0.0041566124692518081, 0.0039793019225985438, 0.003806002910220263, 0.0036367025989560986, 0.00347138826645077, 0.0033100473061160596, 0.0031526672325824512, 0.0029992356876986648, 0.0028497404471428123, 0.0027041694277207817, 0.0025625106954361154, 0.0024247524744304139, 0.0022908831569090626, 0.0021608913141828445, 0.0020347657089828664, 0.0019124953092277686, 0.0017940693034581567, 0.0016794771181898316, 0.0015687084374860216, 0.0014617532251079979, 0.0013586017496737268, 0.0012592446133479207, 0.0011636727846963124, 0.0010718776364858629, 0.00098385098938913451, 0.00089958516279720069, 0.00081907303424411104, 0.00074230810936160019, 0.00066928460482063024, 0.00059999754745132527, 0.00053444289374426912, 0.00047261767533801624, 0.00041452017810073016, 0.00036015016531099064, 0.00030950915974725657, 0.00026260080605100544, 0.00021943134502644401, 0.00018001024827585255, 0.00014435108992993939, 0.00011247278268677885, 8.4401400657463377e-05, 6.0173005401287227e-05, 3.9838325844421263e-05, 2.3471250799711463e-05, 1.1186508223293146e-05, 3.1863350966609971e-06, 0, 0), `1-sensitivity` = c(0, 0, 0.0019569471624266699, 0.0039138943248533398, 0.0058708414872798986, 0.0078277886497064575, 0.0097847358121331274, 0.011741682974559797, 0.013698630136986356, 0.015655577299412915, 0.017612524461839585, 0.019569471624266255, 0.021526418786692814, 0.023483365949119372, 0.025440313111546042, 0.027397260273972712, 0.029354207436399271, 0.03131115459882583, 0.0332681017612525, 0.03522504892367917, 0.037181996086105729, 0.039138943248532287, 0.041095890410958957, 0.043052837573385627, 0.045009784735812186, 0.046966731898238745, 0.048923679060665415, 0.050880626223092085, 0.052837573385518644, 0.054794520547945202, 0.056751467710371872, 0.058708414872798542, 0.060665362035225101, 0.06262230919765166, 0.06457925636007833, 0.066536203522505111, 0.068493150684931559, 0.070450097847358117, 0.072407045009784787, 0.074363992172211457, 0.076320939334638016, 0.078277886497064575, 0.080234833659491245, 0.082191780821917915, 0.084148727984344474, 0.086105675146771032, 0.088062622309197702, 0.090019569471624372, 0.091976516634050931, 0.09393346379647749, 0.09589041095890416, 0.09784735812133083, 0.099804305283757389, 0.10176125244618395, 0.10371819960861062, 0.10567514677103729, 0.10763209393346385, 0.1095890410958904, 0.11154598825831696, 0.11350293542074374, 0.1154598825831703, 0.11741682974559686, 0.11937377690802353, 0.1213307240704502, 0.12328767123287676, 0.12524461839530343, 0.1272015655577301, 0.12915851272015666, 0.13111545988258322, 0.13307240704500978, 0.13502935420743645, 0.13698630136986312, 0.13894324853228956, 0.14090019569471623, 0.1428571428571429, 0.14481409001956957, 0.14677103718199613, 0.14872798434442258, 0.15068493150684936, 0.15264187866927603, 0.15459882583170259, 0.15655577299412915, 0.15851272015655571, 0.16046966731898249, 0.16242661448140905, 0.16438356164383561, 0.16634050880626228, 0.16829745596868895, 0.17025440313111551, 0.17221135029354206, 0.17416829745596862, 0.1761252446183954, 0.17808219178082196, 0.18003913894324852, 0.18199608610567519, 0.18395303326810186, 0.18590998043052842, 0.18786692759295498, 0.18982387475538165, 0.19178082191780843, 0.19373776908023488, 0.19569471624266144, 0.197651663405088, 0.19960861056751478, 0.20156555772994122, 0.20352250489236789, 0.20547945205479456, 0.20743639921722123, 0.20939334637964779, 0.21135029354207435, 0.21330724070450091, 0.21526418786692769, 0.21722113502935425, 0.21917808219178081, 0.22113502935420748, 0.22309197651663415, 0.22504892367906071, 0.22700587084148727, 0.22896281800391383, 0.23091976516634061, 0.23287671232876717, 0.23483365949119361, 0.23679060665362028, 0.23874755381604706, 0.24070450097847362, 0.24266144814090007, 0.24461839530332685, 0.24657534246575352, 0.24853228962818008, 0.25048923679060664, 0.25244618395303331, 0.25440313111545998, 0.25636007827788654, 0.2583170254403131, 0.26027397260273977, 0.26223091976516644, 0.26418786692759288, 0.26614481409001955, 0.26810176125244622, 0.27005870841487289, 0.27201565557729945, 0.27397260273972601, 0.27592954990215257, 0.27788649706457935, 0.27984344422700591, 0.28180039138943247, 0.28375733855185914, 0.28571428571428581, 0.28767123287671237, 0.28962818003913893, 0.2915851272015656, 0.29354207436399227, 0.29549902152641883, 0.29745596868884538, 0.29941291585127205, 0.30136986301369872, 0.30332681017612528, 0.30528375733855184, 0.30724070450097851, 0.30919765166340518, 0.31115459882583174, 0.3131115459882583, 0.31506849315068497, 0.31702544031311164, 0.3189823874755382, 0.32093933463796476, 0.32289628180039143, 0.3248532289628181, 0.32681017612524477, 0.32876712328767121, 0.330724070450098, 0.33268101761252455, 0.33463796477495111, 0.33659491193737767, 0.33855185909980445, 0.34050880626223101, 0.34246575342465757, 0.34442270058708413, 0.3463796477495108, 0.34833659491193747, 0.35029354207436403, 0.35225048923679059, 0.35420743639921726, 0.35616438356164393, 0.35812133072407049, 0.36007827788649704, 0.36203522504892371, 0.36399217221135038, 0.36594911937377694, 0.3679060665362035, 0.36986301369863017, 0.37181996086105684, 0.3737769080234834, 0.37573385518590996, 0.37769080234833663, 0.3796477495107633, 0.38160469667318986, 0.38356164383561642, 0.38551859099804309, 0.38747553816046976, 0.38943248532289632, 0.39138943248532287, 0.39334637964774954, 0.39530332681017621, 0.39726027397260277, 0.39921722113502933, 0.401174168297456, 0.40313111545988267, 0.40508806262230923, 0.40704500978473579, 0.40900195694716246, 0.41095890410958913, 0.41291585127201569, 0.41487279843444225, 0.41682974559686892, 0.41878669275929559, 0.42074363992172215, 0.4227005870841487, 0.42465753424657537, 0.42661448140900204, 0.4285714285714286, 0.43052837573385516, 0.43248532289628183, 0.4344422700587085, 0.43639921722113506, 0.43835616438356162, 0.44031311154598829, 0.44227005870841496, 0.44422700587084152, 0.44618395303326808, 0.44814090019569475, 0.45009784735812142, 0.45205479452054798, 0.45401174168297453, 0.4559686888454012, 0.45792563600782787, 0.45988258317025443, 0.46183953033268099, 0.46379647749510766, 0.46575342465753433, 0.46771037181996089, 0.46966731898238745, 0.47162426614481412, 0.47358121330724079, 0.47553816046966735, 0.47749510763209391, 0.47945205479452058, 0.48140900195694725, 0.48336594911937381, 0.48532289628180036, 0.48727984344422703, 0.4892367906066537, 0.49119373776908026, 0.49315068493150682, 0.49510763209393349, 0.49706457925636016, 0.49902152641878672, 0.50097847358121328, 0.50293542074363995, 0.50489236790606662, 0.50684931506849318, 0.50880626223091974, 0.51076320939334641, 0.51272015655577308, 0.51467710371819964, 0.51663405088062619, 0.51859099804305286, 0.52054794520547953, 0.52250489236790609, 0.52446183953033265, 0.52641878669275932, 0.52837573385518599, 0.53033268101761255, 0.53228962818003911, 0.53424657534246578, 0.53620352250489245, 0.53816046966731901, 0.54011741682974557, 0.54207436399217224, 0.54403131115459891, 0.54598825831702547, 0.54794520547945202, 0.54990215264187869, 0.55185909980430536, 0.55381604696673192, 0.55577299412915848, 0.55772994129158515, 0.55968688845401182, 0.56164383561643838, 0.56360078277886494, 0.56555772994129161, 0.56751467710371828, 0.56947162426614484, 0.5714285714285714, 0.57338551859099807, 0.57534246575342463, 0.5772994129158513, 0.57925636007827785, 0.58121330724070452, 0.58317025440313119, 0.58512720156555775, 0.58708414872798431, 0.58904109589041087, 0.59099804305283765, 0.59295499021526421, 0.59491193737769077, 0.59686888454011744, 0.59882583170254411, 0.60078277886497067, 0.60273972602739723, 0.60469667318982379, 0.60665362035225057, 0.60861056751467713, 0.61056751467710368, 0.61252446183953035, 0.61448140900195702, 0.61643835616438358, 0.61839530332681014, 0.62035225048923681, 0.62230919765166348, 0.62426614481409004, 0.6262230919765166, 0.62818003913894327, 0.63013698630136994, 0.6320939334637965, 0.63405088062622306, 0.63600782778864973, 0.6379647749510764, 0.63992172211350296, 0.64187866927592951, 0.64383561643835618, 0.64579256360078285, 0.64774951076320941, 0.64970645792563608, 0.65166340508806253, 0.6536203522504892, 0.65557729941291587, 0.65753424657534243, 0.65949119373776899, 0.66144814090019577, 0.66340508806262233, 0.66536203522504889, 0.66731898238747556, 0.66927592954990223, 0.67123287671232879, 0.67318982387475534, 0.67514677103718201, 0.67710371819960868, 0.67906066536203524, 0.6810176125244618, 0.68297455968688847, 0.68493150684931503, 0.6868884540117417, 0.68884540117416837, 0.69080234833659493, 0.69275929549902149, 0.69471624266144816, 0.69667318982387472, 0.69863013698630139, 0.70058708414872806, 0.70254403131115462, 0.70450097847358117, 0.70645792563600784, 0.7084148727984344, 0.71037181996086107, 0.71232876712328763, 0.7142857142857143, 0.71624266144814097, 0.71819960861056753, 0.72015655577299409, 0.72211350293542076, 0.72407045009784743, 0.72602739726027399, 0.72798434442270055, 0.72994129158512722, 0.73189823874755389, 0.73385518590998045, 0.735812133072407, 0.73776908023483356, 0.73972602739726023, 0.7416829745596869, 0.74363992172211346, 0.74559686888454013, 0.74755381604696669, 0.74951076320939336, 0.75146771037181992, 0.75342465753424659, 0.75538160469667326, 0.75733855185909993, 0.75929549902152638, 0.76125244618395305, 0.76320939334637972, 0.76516634050880639, 0.76712328767123283, 0.7690802348336595, 0.77103718199608617, 0.77299412915851273, 0.77495107632093929, 0.77690802348336596, 0.77886497064579263, 0.78082191780821919, 0.78277886497064575, 0.78473581213307242, 0.78669275929549909, 0.78864970645792565, 0.79060665362035221, 0.79256360078277899, 0.79452054794520555, 0.79647749510763211, 0.79843444227005878, 0.80039138943248533, 0.802348336594912, 0.80430528375733856, 0.80626223091976512, 0.80821917808219168, 0.81017612524461835, 0.81213307240704502, 0.81409001956947158, 0.81604696673189825, 0.81800391389432481, 0.81996086105675148, 0.82191780821917804, 0.82387475538160471, 0.82583170254403138, 0.82778864970645794, 0.82974559686888449, 0.83170254403131116, 0.83365949119373783, 0.83561643835616439, 0.83757338551859095, 0.83953033268101762, 0.84148727984344429, 0.84344422700587085, 0.84540117416829752, 0.84735812133072408, 0.84931506849315064, 0.85127201565557742, 0.85322896281800387, 0.85518590998043065, 0.85714285714285721, 0.85909980430528377, 0.86105675146771044, 0.86301369863013699, 0.86497064579256366, 0.86692759295499022, 0.86888454011741678, 0.87084148727984334, 0.87279843444227001, 0.87475538160469657, 0.87671232876712324, 0.87866927592954991, 0.88062622309197647, 0.88258317025440314, 0.8845401174168297, 0.88649706457925637, 0.88845401174168304, 0.8904109589041096, 0.89236790606653615, 0.89432485322896282, 0.89628180039138949, 0.89823874755381605, 0.90019569471624261, 0.90215264187866928, 0.90410958904109584, 0.90606653620352251, 0.90802348336594918, 0.90998043052837574, 0.9119373776908023, 0.91389432485322897, 0.91585127201565553, 0.9178082191780822, 0.91976516634050876, 0.92172211350293543, 0.92367906066536209, 0.92563600782778865, 0.92759295499021521, 0.92954990215264188, 0.93150684931506844, 0.93346379647749511, 0.93542074363992167, 0.93737769080234834, 0.9393346379647749, 0.94129158512720146, 0.94324853228962813, 0.9452054794520548, 0.94716242661448136, 0.94911937377690803, 0.95107632093933459, 0.95303326810176126, 0.95499021526418781, 0.95694716242661448, 0.95890410958904104, 0.96086105675146771, 0.96281800391389427, 0.96477495107632094, 0.9667318982387475, 0.96868884540117417, 0.97064579256360073, 0.9726027397260274, 0.97455968688845396, 0.97651663405088063, 0.97847358121330719, 0.98043052837573386, 0.98238747553816042, 0.98434442270058709, 0.98630136986301364, 0.98825831702544031, 0.99021526418786687, 0.99217221135029354, 0.9941291585127201, 0.99608610567514677, 0.99804305283757333, 1, 1), `1-accuracy` = c(0.63716814159292035, 0.63716814159292035, 0.63380816568955245, 0.63008753375192006, 0.62633553733726577, 0.62260015367795729, 0.61889805853728075, 0.61523618551157611, 0.61161748446613862, 0.6080430286451397, 0.60451293181155519, 0.60102679442794726, 0.59758393798620613, 0.59418353493868747, 0.59082468355787499, 0.58750645218607311, 0.58422790576346495, 0.58098812176377246, 0.57778619964072786, 0.57462126622544207, 0.57149247856549312, 0.56839902513715468, 0.565340126023399, 0.5623150324402626, 0.55932302586131843, 0.55636341690450308, 0.55343554408974738, 0.55053877253896066, 0.54767249266530804, 0.54483611888216232, 0.54202908835092201, 0.53925085977929887, 0.53650091227653796, 0.53377874426855909, 0.53108387247369804, 0.52841583093818012, 0.5257741701294889, 0.52315845608518008, 0.52056826961435299, 0.51800320554882839, 0.51546287204103014, 0.51294688990561776, 0.510454892002004, 0.50798652265501176, 0.50554143711107091, 0.50311930102751068, 0.50071978999265299, 0.49834258907456963, 0.49598739239651135, 0.4936539027371617, 0.49134183115400343, 0.48905089662820955, 0.48678082572959047, 0.48453135230023925, 0.48230221715561816, 0.48009316780192457, 0.47790395816866149, 0.47573434835541573, 0.47358410439192844, 0.47145299801060125, 0.46934080643064913, 0.46724731215316939, 0.46517230276644994, 0.46311557076088228, 0.46107691335290057, 0.45905613231739806, 0.45705303382812068, 0.45506742830556524, 0.45309913027194593, 0.45114795821282161, 0.44921373444500368, 0.4472962849903922, 0.44539543945540638, 0.44351103091570354, 0.44164289580589511, 0.43979087381399429, 0.43795480778033524, 0.43613454360073378, 0.43432993013366428, 0.43254081911124553, 0.43076706505384021, 0.42900852518808397, 0.42726505936817261, 0.42553653000024561, 0.423822801969712, 0.42212374257137686, 0.42043922144223234, 0.41876911049678578, 0.41711328386480595, 0.4154716178313721, 0.4138439907791206, 0.41223028313258847, 0.4106303773045562, 0.40904415764430069, 0.40747151038767404, 0.40591232360892615, 0.40436648717419443, 0.40283389269658787, 0.40131443349279905, 0.39980800454117582, 0.39831450244119215, 0.39683382537426004, 0.39536587306582582, 0.39391054674869797, 0.39246774912755666, 0.3910373843445959, 0.38961935794625491, 0.38821357685099311, 0.38681994931806807, 0.38543838491727833, 0.38406879449963149, 0.38271109016890381, 0.38136518525405749, 0.38003099428247822, 0.37870843295401069, 0.37739741811575422, 0.37609786773759557, 0.37480970088844734, 0.37353283771317169, 0.37226719941016084, 0.37101270820954912, 0.36976928735204029, 0.36853686106832073, 0.36731535455904607, 0.36610469397537204, 0.36490480640001988, 0.36371561982885037, 0.36253706315293521, 0.36136906614110398, 0.36021155942295369, 0.35906447447230472, 0.35792774359108814, 0.35680129989365073, 0.35568507729146193, 0.35457901047821361, 0.35348303491529687, 0.35239708681764437, 0.3513211031399267, 0.35025502156309307, 0.3491987804812432, 0.34815231898882049, 0.34711557686811934, 0.3460884945770929, 0.34507101323745415, 0.34406307462306207, 0.34306462114858238, 0.34207559585841718, 0.34109594241589214, 0.3401256050926964, 0.33916452875856695, 0.33821265887120999, 0.33726994146645217, 0.33633632314861661, 0.33541175108111454, 0.33449617297724898, 0.33358953709122396, 0.33269179220935152, 0.33180288764145394, 0.33092277321245323, 0.33005139925414384, 0.32918871659714455, 0.32833467656302173, 0.327489230956582, 0.32665233205832933, 0.32582393261708109, 0.3250039858427386, 0.32419244539921033, 0.32338926539748092, 0.3225944003888247, 0.32180780535815712, 0.32102943571752307, 0.32025924729971844, 0.31949719635203833, 0.31874323953015338, 0.31799733389210616, 0.31725943689242975, 0.31652950637638044, 0.31580750057428419, 0.31509337809599491, 0.3143870979254596, 0.31368861941538906, 0.31299790228203106, 0.31231490660004435, 0.31163959279746956, 0.31097192165079579, 0.31031185428012031, 0.30965935214439932, 0.30901437703678714, 0.30837689108006217, 0.30774685672213709, 0.30712423673165234, 0.3065089941936493, 0.30590109250532349, 0.30530049537185344, 0.30470716680230536, 0.30412107110561259, 0.30354217288662411, 0.30297043704222515, 0.30240582875752686, 0.30184831350212149, 0.30129785702640421, 0.30075442535795904, 0.30021798479800699, 0.29968850191791507, 0.29916594355576798, 0.2986502768129945, 0.29814146905105476, 0.29763948788818162, 0.29714430119617763, 0.29665587709726648, 0.29617418396099582, 0.2956991904011923, 0.29523086527296771, 0.29476917766977295, 0.29431409692050181, 0.29386559258664147, 0.2934236344594694, 0.29298819255729536, 0.29255923712274867, 0.29213673862010869, 0.29172066773267724, 0.29131099536019445, 0.29090769261629357, 0.2905107308259981, 0.29012008152325641, 0.28973571644851581, 0.28935760754633411, 0.28898572696302927, 0.28862004704436339, 0.28826054033326409, 0.28790717956757983, 0.2875599376778698, 0.28721878778522769, 0.28688370319913736, 0.2865546574153619, 0.2862316241138646, 0.28591457715675883, 0.28560349058629064, 0.28529833862285137, 0.28499909566301707, 0.28470573627761997, 0.28441823520984522, 0.28413656737335835, 0.28386070785045681, 0.28359063189025058, 0.28332631490686822, 0.28306773247768846, 0.28281486034159697, 0.28256767439726871, 0.28232615070147382, 0.28209026546740756, 0.2818599950630446, 0.28163531600951519, 0.28141620497950426, 0.28120263879567375, 0.28099459442910546, 0.28079204899776655, 0.28059497976499503, 0.28040336413800693, 0.28021717966642345, 0.28003640404081775, 0.27986101509128247, 0.27969099078601534, 0.27952630922992472, 0.27936694866325262, 0.27921288746021866, 0.27906410412767846, 0.27892057730380271, 0.27878228575677211, 0.27864920838349017, 0.27852132420831299, 0.27839861238179464, 0.27828105217944976, 0.2781686230005318, 0.27806130436682752, 0.27795907592146585, 0.27786191742774391, 0.27776980876796553, 0.27768272994229737, 0.2776006610676367, 0.27752358237649566, 0.27745147421589866, 0.27738431704629352, 0.27732209144047659, 0.27726477808253103, 0.27721235776677811, 0.27716481139674243, 0.27712211998412817, 0.27708426464780977, 0.27705122661283343, 0.2770229872094323, 0.27699952787205184, 0.27698083013838903, 0.27696687564844102, 0.27695764614356755, 0.27695312346556289, 0.27695328955573872, 0.27695812645402029, 0.27696761629804989, 0.27698174132230391, 0.27700048385721887, 0.27702382632832778, 0.27705175125540715, 0.27708424125163356, 0.27712127902275019, 0.27716284736624286, 0.27720892917052609, 0.27725950741413818, 0.27731456516494557, 0.2773740855793565, 0.27743805190154336, 0.27750644746267394, 0.27757925568015263, 0.27765646005686806, 0.27773804418045078, 0.27782399172253913, 0.27791428643805305, 0.27800891216447565, 0.27810785282114414, 0.27821109240854747, 0.27831861500763178, 0.2784304047791144, 0.27854644596280509, 0.27866672287693361, 0.27879121991748679, 0.27891992155755185, 0.27905281234666579, 0.27918987691017405, 0.27933109994859451, 0.27947646623698918, 0.27962596062434197, 0.27977956803294468, 0.27993727345778807, 0.28009906196595979, 0.28026491869604997, 0.28043482885756144, 0.28060877773032733, 0.28078675066393521, 0.28096873307715653, 0.28115471045738227, 0.28134466836006555, 0.28153859240816814, 0.28173646829161603, 0.28193828176675706, 0.28214401865582739, 0.28235366484642177, 0.28256720629097043, 0.28278462900622048, 0.28300591907272421, 0.28323106263433118, 0.28346004589768692, 0.28369285513173714, 0.28392947666723456, 0.28416989689625538, 0.28441410227171637, 0.28466207930690035, 0.28491381457498455, 0.28516929470857622, 0.2854285063992501, 0.2856914363970936, 0.2859580715102551, 0.28622839860449878, 0.286502404602762, 0.28678007648471882, 0.28706140128634883, 0.28734636609950814, 0.28763495807150874, 0.28792716440469801, 0.28822297235604744, 0.28852236923674202, 0.2888253424117766, 0.28913187929955508, 0.28944196737149541, 0.28975559415163898, 0.29007274721626253, 0.29039341419349762, 0.29071758276295134, 0.29104524065533355, 0.29137637565208807, 0.29171097558502701, 0.29204902833597146, 0.29239052183639502, 0.29273544406707208, 0.2930837830577312, 0.29343552688671137, 0.29379066368062412, 0.29414918161401971, 0.29451106890905665, 0.29487631383517687, 0.29524490470878573, 0.29561682989293403, 0.29599207779700787, 0.29637063687642007, 0.29675249563230899, 0.29713764261123887, 0.29752606640490753, 0.29791775564985767, 0.29831269902719215, 0.29871088526229617, 0.29911230312456205, 0.2995169414271206, 0.29992478902657738, 0.30033583482275295, 0.30075006775842994, 0.30116747681910405, 0.30158805103274178, 0.30201177946954294, 0.30243865124170877, 0.3028686555032164, 0.30330178144959918, 0.30373801831773295, 0.30417735538562851, 0.30461978197223127, 0.30506528743722683, 0.30551386118085389, 0.30596549264372408, 0.30642017130664956, 0.30687788669047689, 0.3073386283559314, 0.30780238590346742, 0.30826914897312718, 0.30873890724441067, 0.30921165043615195, 0.30968736830640664, 0.31016605065235003, 0.31064768731018366, 0.31113226815505446, 0.31161978310098504, 0.31211022210081585, 0.31260357514615955, 0.31309983226736926, 0.31359898353352089, 0.31410101905240939, 0.31460592897056128, 0.31511370347326262, 0.31562433278460522, 0.31613780716755036, 0.31665411692401246, 0.31717325239496252, 0.31769520396055329, 0.31821996204026959, 0.3187475170930989, 0.31927785961773281, 0.31981098015279352, 0.32034686927709, 0.32088551760990769, 0.32142691581133065, 0.3219710545826, 0.32251792466651241, 0.32306751684785906, 0.32361982195391137, 0.32417483085495236, 0.32473253446486228, 0.32529292374175978, 0.32585598968870222, 0.32642172335445407, 0.32699011583432347, 0.32756115827107746, 0.32813484185593933, 0.32871115782967797, 0.3292900974837939, 0.32987165216181502, 0.33045581326070816, 0.3310425722324204, 0.33163192058555946, 0.33222384988723019, 0.33281835176504027, 0.33341541790929208, 0.33401504007538274, 0.33461721008643119, 0.33522191983615779, 0.3358291612920461, 0.33643892649881679, 0.33705120758224916, 0.33766599675339481, 0.33828328631322768, 0.33890306865778508, 0.33952533628386539, 0.34015008179535189, 0.34077729791024747, 0.34140697746852255, 0.34203911344088644, 0.34267369893862165, 0.34331072722464084, 0.34395019172595775, 0.34459208604780089, 0.34523640398964361, 0.34588313956348471, 0.34653228701478178, 0.34718384084653708, 0.34783779584714336, 0.34849414712276183, 0.34915289013518358, 0.34981402074640444, 0.35047753527147107, 0.35114343054163843, 0.35181170398051076, 0.35248235369674319, 0.35315537859814494, 0.353830778533885, 0.35450855447422935, 0.35518870874142705, 0.35587124531192016, 0.35655617022071173, 0.35724349211680551, 0.35793322305077002, 0.35862537963619812, 0.35931998485036665, 0.36001707101613112, 0.36071668521308942, 0.3614189005422398, 0.36212384586254398, 0.36283185840707965, 0.36283185840707965 ), `1-npv` = c(NaN, NaN, 0.1485426039921145, 0.1431425455110622, 0.14113482791138066, 0.14026692996539847, 0.13993466291987622, 0.13989856125890998, 0.14004292865881052, 0.14030456546299364, 0.14064591580546681, 0.14104324760323339, 0.14148084529921767, 0.14194791199182244, 0.14243680739790276, 0.14294199264696006, 0.14345937105084106, 0.14398586141386815, 0.14451911342738633, 0.14505731286568391, 0.14559904522088574, 0.1461431983487822, 0.1466888917469209, 0.14723542437932402, 0.14778223564837423, 0.14832887583610754, 0.14887498346485084, 0.14942026778029593, 0.14996449507210474, 0.15050747790087504, 0.15104906654829642, 0.15158914218359409, 0.15212761136620057, 0.15266440159693029, 0.15319945769789134, 0.15373273885185312, 0.15426421616967656, 0.15479387068307071, 0.15532169168180188, 0.15584767533128485, 0.15637182351949452, 0.1568941428922771, 0.15741464404408456, 0.15793334083743749, 0.15845024982939149, 0.15896538978726349, 0.15947878127904769, 0.15999044632652304, 0.16050040811113053, 0.16100869072437929, 0.1615153189559283, 0.16202031811361051, 0.16252371387060038, 0.16302553213568838, 0.16352579894326269, 0.16402454036012792, 0.16452178240672455, 0.16501755099068671, 0.16551187185098104, 0.16600477051112827, 0.16649627224022734, 0.16698640202068993, 0.1674751845217447, 0.16796264407790507, 0.16844880467171008, 0.16893368992013913, 0.16941732306418633, 0.16989972696115196, 0.17038092407926608, 0.17086093649431067, 0.17133978588795484, 0.17181749354755405, 0.17229408036719385, 0.17276956684979616, 0.1732439731101193, 0.17371731887851516, 0.1741896235053183, 0.17466090596576156, 0.17513118486532386, 0.17560047844543336, 0.17606880458945118, 0.1765361808288809, 0.17700262434974645, 0.17746815199909605, 0.17793278029159232, 0.17839652541615447, 0.17885940324262339, 0.17932142932842488, 0.17978261892521041, 0.18024298698545493, 0.18070254816899856, 0.18116131684951831, 0.18161930712091745, 0.1820765328036259, 0.18253300745080181, 0.18298874435442902, 0.18344375655130574, 0.18389805682892035, 0.18435165773121132, 0.1848045715642086, 0.18525681040155506, 0.18570838608991025, 0.18615931025422938, 0.18660959430292545, 0.18705924943290886, 0.18750828663450925, 0.18795671669627867, 0.18840455020967817, 0.18885179757364901, 0.18929846899907155, 0.18974457451311133, 0.19019012396345591, 0.19063512702244534, 0.1910795931910958, 0.19152353180302129, 0.19196695202825409, 0.1924098628769666, 0.19285227320309695, 0.19329419170788043, 0.19373562694329005, 0.19417658731538578, 0.19461708108757914, 0.19505711638381007, 0.19549670119164375, 0.19593584336528413, 0.19637455062851128, 0.19681283057754151, 0.19725069068381185, 0.19768813829669474, 0.19812518064614049, 0.1985618248452522, 0.19899807789279333, 0.19943394667563252, 0.19986943797112267, 0.20030455844942185, 0.20073931467575246, 0.20117371311260435, 0.20160776012188042, 0.20204146196698947, 0.20247482481488355, 0.20290785473804651, 0.20334055771643045, 0.20377293963934484, 0.20420500630729732, 0.204636763433789, 0.20506821664706565, 0.20549937149182507, 0.20593023343088102, 0.20636080784678923, 0.20679110004342982, 0.20722111524755416, 0.2076508586102922, 0.20808033520862368, 0.20850955004681437, 0.20893850805781655, 0.20936721410463677, 0.20979567298167068, 0.21022388941600567, 0.21065186806869363, 0.21107961353599181, 0.21150713035057633, 0.21193442298272602, 0.21236149584147912, 0.21278835327576262, 0.21321499957549594, 0.21364143897266841, 0.2140676756423926, 0.21449371370393311, 0.21491955722171208, 0.21534521020629149, 0.21577067661533356, 0.21619596035453903, 0.21662106527856506, 0.21704599519192158, 0.2174707538498486, 0.21789534495917284, 0.21831977217914766, 0.21874403912227092, 0.21916814935508833, 0.21959210639897697, 0.22001591373091278, 0.22043957478422138, 0.22086309294931183, 0.22128647157439518, 0.22170971396618833, 0.22213282339060025, 0.22255580307340761, 0.22297865620091195, 0.22340138592058556, 0.22382399534170316, 0.22424648753595988, 0.22466886553807652, 0.22509113234639255, 0.22551329092344652, 0.22593534419654415, 0.22635729505831559, 0.22677914636726038, 0.22720090094828127, 0.22762256159320837, 0.22804413106131105, 0.22846561207980054, 0.22888700734432232, 0.22930831951943786, 0.22972955123909744, 0.23015070510710389, 0.23057178369756592, 0.23099278955534364, 0.23141372519648462, 0.23183459310865151, 0.23225539575154164, 0.23267613555729805, 0.23309681493091261, 0.23351743625062094, 0.23393800186829139, 0.23435851410980346, 0.23477897527542291, 0.23519938764016546, 0.2356197534541572, 0.23604007494298607, 0.23646035430804691, 0.23688059372688108, 0.23730079535350856, 0.23772096131875442, 0.23814109373056902, 0.23856119467434156, 0.23898126621320981, 0.23940131038836165, 0.23982132921933286, 0.24024132470429871, 0.24066129882036014, 0.24108125352382459, 0.24150119075048282, 0.24192111241587899, 0.24234102041557748, 0.24276091662542365, 0.24318080290180111, 0.2436006810818826, 0.24402055298387848, 0.24444042040727942, 0.24486028513309532, 0.24528014892408967, 0.24570001352500959, 0.24611988066281354, 0.24653975204689171, 0.24695962936928628, 0.24737951430490468, 0.24779940851173177, 0.24821931363103567, 0.24863923128757281, 0.24905916308978737, 0.24947911063000783, 0.24989907548464052, 0.25031905921436004, 0.25073906336429519, 0.25115908946421328, 0.25157913902869977, 0.25199921355733679, 0.25241931453487665, 0.25283944343141329, 0.25325960170255168, 0.25367979078957226, 0.25410001211959532, 0.25452026710574005, 0.2549405571472827, 0.25536088362981157, 0.25578124792537893, 0.25620165139265139, 0.25662209537705694, 0.25704258121092982, 0.25746311021365353, 0.25788368369180048, 0.25830430293927054, 0.25872496923742583, 0.2591456838552253, 0.25956644804935491, 0.25998726306435738, 0.26040813013275954, 0.26082905047519622, 0.26125002530053465, 0.26167105580599426, 0.26209214317726659, 0.26251328858863177, 0.26293449320307438, 0.26335575817239631, 0.26377708463732885, 0.26419847372764205, 0.26461992656225342, 0.26504144424933374, 0.26546302788641196, 0.26588467856047837, 0.26630639734808559, 0.26672818531544862, 0.26715004351854343, 0.2675719730032029, 0.26799397480521259, 0.26841604995040391, 0.26883819945474696, 0.26926042432444086, 0.2696827255560027, 0.27010510413635647, 0.27052756104291908, 0.27095009724368557, 0.27137271369731297, 0.2717954113532034, 0.27221819115158508, 0.27264105402359196, 0.27306400089134364, 0.27348703266802199, 0.27391015025794818, 0.27433335455665808, 0.27475664645097553, 0.27518002681908604, 0.27560349653060878, 0.27602705644666692, 0.27645070741995736, 0.27687445029481961, 0.2772982859073031, 0.27772221508523409, 0.27814623864828081, 0.27857035740801839, 0.27899457216799206, 0.27941888372378032, 0.27984329286305643, 0.28026780036564858, 0.28069240700360054, 0.28111711354123037, 0.28154192073518858, 0.28196682933451478, 0.28239184008069496, 0.28281695370771642, 0.28324217094212245, 0.28366749250306655, 0.28409291910236534, 0.28451845144455112, 0.28494409022692313, 0.28536983613959865, 0.2857956898655627, 0.28622165208071804, 0.28664772345393308, 0.28707390464709037, 0.28750019631513402, 0.28792659910611507, 0.28835311366123939, 0.2887797406149113, 0.28920648059477883, 0.28963333422177828, 0.29006030211017664, 0.29048738486761516, 0.2909145830951515, 0.29134189738730099, 0.29176932833207858, 0.29219687651103865, 0.29262454249931513, 0.29305232686566196, 0.29348023017249047, 0.29390825297590972, 0.2943363958257631, 0.29476465926566697, 0.29519304383304712, 0.29562155005917545, 0.29605017846920678, 0.29647892958221411, 0.29690780391122484, 0.29733680196325429, 0.29776592423934234, 0.29819517123458583, 0.29862454343817446, 0.29905404133342273, 0.29948366539780391, 0.29991341610298328, 0.30034329391485048, 0.30077329929355223, 0.30120343269352423, 0.30163369456352307, 0.30206408534665841, 0.30249460548042406, 0.30292525539672932, 0.30335603552193025, 0.30378694627686054, 0.30421798807686262, 0.30464916133181785, 0.3050804664461777, 0.30551190381899418, 0.30594347384395004, 0.30637517690938965, 0.30680701339834893, 0.30723898368858638, 0.30767108815261357, 0.30810332715772493, 0.30853570106602946, 0.30896821023448096, 0.30940085501490877, 0.30983363575404932, 0.3102665527935774, 0.31069960647013739, 0.31113279711537523, 0.31156612505597092, 0.31199959061367033, 0.31243319410531867, 0.31286693584289393, 0.31330081613353955, 0.31373483527960011, 0.31416899357865535, 0.31460329132355613, 0.31503772880245995, 0.31547230629886847, 0.31590702409166482, 0.31634188245515227, 0.31677688165909323, 0.31721202196875031, 0.31764730364492699, 0.31808272694401074, 0.31851829211801663, 0.31895399941463198, 0.31938984907726342, 0.31982584134508441, 0.3202619764530843, 0.32069825463212054, 0.32113467610897084, 0.32157124110638791, 0.32200794984315684, 0.32244480253415431, 0.32288179939040929, 0.32331894061916766, 0.32375622642395852, 0.3241936570046634, 0.32463123255758897, 0.32506895327554264, 0.32550681934791126, 0.32594483096074423, 0.32638298829683998, 0.32682129153583672, 0.32725974085430765, 0.32769833642586121, 0.32813707842124573, 0.3285759670084607, 0.32901500235287229, 0.32945418461733611, 0.32989351396232691, 0.33033299054607412, 0.3307726145247063, 0.33121238605240333, 0.33165230528155709, 0.33209237236294153, 0.33253258744589365, 0.33297295067850452, 0.33341346220782186, 0.33385412218006649, 0.33429493074086014, 0.33473588803547061, 0.33517699420906999, 0.33561824940701179, 0.3360596537751257, 0.33650120746003176, 0.33694291060947767, 0.33738476337269752, 0.33782676590079708, 0.33826891834716666, 0.33871122086792327, 0.33915367362238613, 0.33959627677358728, 0.340039030488821, 0.34048193494023682, 0.34092499030547785, 0.34136819676837071, 0.34181155451967227, 0.34225506375787662, 0.34269872469009266, 0.34314253753299417, 0.34358650251385525, 0.34403061987167749, 0.34447488985841968, 0.34491931274034215, 0.34536388879947799, 0.34580861833524823, 0.34625350166623603, 0.34669853913214199, 0.34714373109594165, 0.34758907794627381, 0.34803458010008825, 0.3484802380055928, 0.34892605214553651, 0.34937202304088499, 0.34981815125494164, 0.35026443739798774, 0.35071088213252499, 0.35115748617921794, 0.35160425032366349, 0.35205117542412945, 0.35249826242044835, 0.35294551234428706, 0.353392926331075, 0.35384050563393898, 0.3542882516400927, 0.35473616589025114, 0.3551842501018142, 0.35563250619679465, 0.35608093633579696, 0.35652954295981132, 0.3569783288422671, 0.35742729715478549, 0.35787645155159087, 0.35832579627993522, 0.35877533632776559, 0.35922507762644629, 0.35967502733804124, 0.36012519427874867, 0.36057558957500346, 0.36102622774936932, 0.36147712868993698, 0.36192832174764411, 0.36237985654544391, 0.36283185840707965, 0.36283185840707965 ), `1-ppv` = c(0.63716814159292035, 0.63716814159292035, 0.6361389059782101, 0.63496681359486984, 0.63377082390411288, 0.63256843711373545, 0.63136592057348517, 0.63016604092930673, 0.62897012474143521, 0.62777881221732967, 0.62659238577831, 0.62541093049151608, 0.62423441885588904, 0.62306275826274615, 0.62189581871708211, 0.62073344954365928, 0.61957548967933873, 0.61842177410173393, 0.617272137865992, 0.61612641862833761, 0.61498445819595726, 0.61384610344257184, 0.61271120680744007, 0.61157962651986209, 0.61045122664317597, 0.6093258770011194, 0.60820345302897105, 0.60708383557825019, 0.60596691069455411, 0.60485256938184428, 0.60374070736219809, 0.60263122483705867, 0.60152402625395829, 0.60041902008124981, 0.5993161185923801, 0.59821523766054563, 0.59711629656408793, 0.59601921780265865, 0.59492392692396301, 0.59383035236074799, 0.59273842527760556, 0.59164807942711217, 0.59055925101480233, 0.58947187857246042, 0.58838590283922354, 0.58730126665000482, 0.58621791483076147, 0.58513579410015704, 0.58405485297719073, 0.58297504169439374, 0.58189631211621662, 0.58081861766225429, 0.57974191323498503, 0.57866615515171516, 0.57759130108044787, 0.57651730997941364, 0.57544414204001804, 0.57437175863297751, 0.57330012225743876, 0.57222919649288317, 0.57115894595363492, 0.57008933624580904, 0.56902033392654006, 0.56795190646535043, 0.56688402220752232, 0.56581665033934792, 0.56474976085514683, 0.56368332452593772, 0.56261731286966787, 0.56155169812290595, 0.56048645321391255, 0.55942155173700603, 0.55835696792815015, 0.55729267664169257, 0.55622865332818749, 0.55516487401324444, 0.55410131527734163, 0.55303795423655411, 0.55197476852414495, 0.5509117362729723, 0.54984883609867019, 0.54878604708355905, 0.54772334876125073, 0.54666072110190878, 0.5455981444981326, 0.54453559975143118, 0.54347306805925755, 0.5424105310025773, 0.54134797053394068, 0.54028536896603718, 0.53922270896070623, 0.53815997351838429, 0.53709714596796532, 0.53603420995705509, 0.5349711494426026, 0.53390794868188851, 0.53284459222385572, 0.53178106490076504, 0.53071735182016244, 0.5296534383571424, 0.5285893101468957, 0.52752495307752689, 0.52646035328313134, 0.52539549713711997, 0.52433037124577997, 0.52326496244206278, 0.52219925777958887, 0.52113324452686027, 0.52006691016167128, 0.51900024236571163, 0.51793322901934968, 0.51686585819659392, 0.51579811816022014, 0.51472999735706115, 0.51366148441345105, 0.51259256813081833, 0.51152323748142148, 0.51045348160422188, 0.50938328980088798, 0.50831265153192784, 0.50724155641294211, 0.50616999421099429, 0.50509795484109388, 0.50402542836278963, 0.50295240497686478, 0.50187887502213524, 0.50080482897234213, 0.49973025743314059, 0.49865515113917769, 0.49757950095125481, 0.49650329785357761, 0.49542653295108385, 0.49434919746685002, 0.49327128273957277, 0.49219278022112367, 0.49111368147417367, 0.49003397816988403, 0.48895366208566415, 0.48787272510299184, 0.4867911592052947, 0.48570895647588963, 0.48462610909598069, 0.48354260934271132, 0.48245844958726958, 0.48137362229304537, 0.48028812001383747, 0.4792019353921092, 0.47811506115728986, 0.47702749012412204, 0.47593921519105353, 0.47485022933866949, 0.47376052562816873, 0.47267009719987674, 0.47157893727180011, 0.47048703913821577, 0.46939439616829925, 0.46830100180478584, 0.46720684956266711, 0.4661119330279202, 0.46501624585626922, 0.46391978177197812, 0.46282253456667366, 0.46172449809819693, 0.46062566628948554, 0.45952603312748075, 0.45842559266206406, 0.45732433900501823, 0.45622226632901408, 0.45511936886662285, 0.45401564090935109, 0.45291107680670017, 0.45180567096524771, 0.45069941784775147, 0.44959231197227434, 0.44848434791132974, 0.4473755202910491, 0.44626582379036717, 0.44515525314022708, 0.44404380312280434, 0.44293146857074905, 0.44181824436644612, 0.44070412544129156, 0.4395891067749863, 0.43847318339484742, 0.43735635037513354, 0.43623860283638627, 0.43511993594478726, 0.43400034491152983, 0.43287982499220523, 0.43175837148620144, 0.43063597973611767, 0.42951264512719034, 0.42838836308673411, 0.42726312908359276, 0.42613693862760504, 0.42500978726908156, 0.42388167059829251, 0.4227525842449682, 0.42162252387780996, 0.4204914852040128, 0.4193594639687972, 0.41822645595495322, 0.41709245698239272, 0.41595746290771274, 0.41482146962376931, 0.41368447305925782, 0.41254646917830606, 0.41140745398007372, 0.41026742349836165, 0.40912637380122996, 0.40798430099062422, 0.40684120120200906, 0.40569707060401128, 0.40455190539806973, 0.40340570181809243, 0.40225845613012301, 0.4011101646320121, 0.3999608236530976, 0.39881042955389068, 0.39765897872576972, 0.3965064675906802, 0.39535289260084094, 0.39419825023845645, 0.39304253701543779, 0.39188574947312549, 0.39072788418202242, 0.38956893774152856, 0.38840890677968587, 0.3872477879529248, 0.38608557794581744, 0.38492227347083785, 0.38375787126812411, 0.38259236810524833, 0.38142576077699009, 0.38025804610511516, 0.37908922093815933, 0.37791928215121529, 0.37674822664572616, 0.37557605134928251, 0.3744027532154216, 0.37322832922343563, 0.37205277637817813, 0.3708760917098799, 0.36969827227396457, 0.36851931515087089, 0.36733921744587683, 0.36615797628892832, 0.36497558883447045, 0.36379205226128497, 0.36260736377232616, 0.36142152059456478, 0.36023451997883327, 0.35904635919967332, 0.35785703555518711, 0.35666654636689255, 0.35547488897957924, 0.35428206076116975, 0.35308805910258034, 0.35189288141758768, 0.35069652514269622, 0.34949898773700783, 0.34830026668209524, 0.34710035948187623, 0.34589926366249113, 0.3446969767721817, 0.34349349638117299, 0.34228882008155626, 0.34108294548717444, 0.33987587023350929, 0.33866759197756968, 0.33745810839778356, 0.33624741719388918, 0.33503551608682847, 0.33382240281864295, 0.33260807515237067, 0.3313925308719432, 0.33017576778208635, 0.32895778370821838, 0.32773857649635385, 0.32651814401300394, 0.32529648414508117, 0.32407359479980358, 0.3228494739045995, 0.32162411940701274, 0.32039752927461018, 0.31916970149488721, 0.31794063407517625, 0.31671032504255392, 0.31547877244374856, 0.31424597434504864, 0.31301192883221141, 0.31177663401037059, 0.31054008800394406, 0.30930228895654277, 0.30806323503087729, 0.30682292440866654, 0.30558135529054253, 0.30433852589595811, 0.30309443446309225, 0.30184907924875315, 0.30060245852828471, 0.29935457059546666, 0.29810541376241806, 0.29685498635949648, 0.29560328673519753, 0.29435031325605243, 0.29309606430652335, 0.29184053828889855, 0.29058373362318268, 0.28932564874699007, 0.28806628211542951, 0.28680563220099131, 0.28554369749343178, 0.28428047649965238, 0.28301596774357729, 0.2817501697660294, 0.2804830811246023, 0.27921470039352758, 0.27794502616354078, 0.27667405704174353, 0.27540179165145873, 0.27412822863208641, 0.27285336663895299, 0.27157720434315358, 0.27029974043139504, 0.26902097360583088, 0.26774090258388916, 0.26645952609809986, 0.2651768428959127, 0.26389285173950972, 0.26260755140561431, 0.2613209406852901, 0.26003301838373571, 0.25874378332007109, 0.25745323432711786, 0.25616137025117025, 0.25486818995175931, 0.2535736923014088, 0.25227787618538167, 0.25098074050141705, 0.24968228415946037, 0.24838250608137968, 0.24708140520067412, 0.2457789804621725, 0.24447523082171785, 0.24317015524584329, 0.24186375271143223, 0.24055602220536931, 0.23924696272417778, 0.23793657327363815, 0.23662485286840129, 0.23531180053157918, 0.23399741529432017, 0.23268169619537604, 0.2313646422806398, 0.23004625260267852, 0.2287265262202357, 0.22740546219772739, 0.22608305960470465, 0.22475931751530331, 0.2234342350076749, 0.22210781116338552, 0.22078004506679827, 0.21945093580442643, 0.21812048246426807, 0.2167886841351031, 0.21545553990577337, 0.21412104886442418, 0.21278521009772366, 0.21144802269004248, 0.21010948572260779, 0.20876959827261454, 0.20742835941230731, 0.20608576820802549, 0.20474182371919591, 0.20339652499730576, 0.20204987108480899, 0.20070186101400611, 0.19935249380586806, 0.19800176846881079, 0.19664968399742266, 0.19529623937113494, 0.19394143355283133, 0.1925852654874135, 0.19122773410028393, 0.18986883829578149, 0.18850857695554302, 0.18714694893679051, 0.18578395307054618, 0.18441958815977855, 0.18305385297744681, 0.18168674626447989, 0.18031826672765527, 0.17894841303738529, 0.17757718382540322, 0.17620457768234365, 0.17483059315522564, 0.17345522874480113, 0.1720784829027987, 0.17070035402903749, 0.16932084046839702, 0.16793994050766303, 0.16655765237221176, 0.16517397422254709, 0.16378890415066771, 0.16240244017626471, 0.1610145802427394, 0.15962532221302073, 0.15823466386518747, 0.15684260288787288, 0.15544913687544837, 0.15405426332295646, 0.15265797962080108, 0.15126028304917283, 0.14986117077218042, 0.14846063983169555, 0.14705868714086834, 0.14565530947731609, 0.14425050347595658, 0.14284426562145613, 0.14143659224027894, 0.14002747949232197, 0.13861692336207443, 0.13720491964932158, 0.13579146395932051, 0.13437655169243379, 0.13296017803318416, 0.13154233793869741, 0.13012302612647031, 0.1287022370614469, 0.12727996494233884, 0.12585620368713812, 0.1244309469177769, 0.12300418794385848, 0.1215759197454046, 0.12014613495455551, 0.11871482583611015, 0.11728198426687964, 0.11584760171370467, 0.11441166921007151, 0.11297417733122761, 0.11153511616762735, 0.11009447529664973, 0.10865224375238614, 0.10720840999337788, 0.10576296186812906, 0.10431588657819812, 0.10286717063867457, 0.10141679983581375, 0.099964759181588536, 0.098511032864873949, 0.097055604198957091, 0.095598455565082618, 0.094139568351596203, 0.092678922888339677, 0.091216498375800481, 0.089752272808522826, 0.088286222892211441, 0.086818323953894994, 0.085348549844443733, 0.08387687283262335, 0.082403263489813638, 0.080927690564368548, 0.079450120844485217, 0.07797051900826879, 0.07648884745953799, 0.075005066147746713, 0.073519132370003959, 0.072031000553155033, 0.070540622013326559, 0.069047944690088792, 0.067552912851956859, 0.066055466769346149, 0.064555542350535511, 0.063053070735482275, 0.06154797784137811, 0.060040183852798967, 0.058529602648091816, 0.057016141151978506, 0.055499698602535563, 0.053980165718443662, 0.052457423749380228, 0.050931343389108097, 0.049401783526202503, 0.04786858980194697, 0.046331592937892241, 0.04479060678649216, 0.043245426046980118, 0.041695823573377866, 0.040141547182350301, 0.038582315842340065, 0.037017815091212825, 0.035447691482222488, 0.03387154579436058, 0.032288924652988715, 0.030699310080445796, 0.029102106313977583, 0.027496622961443173, 0.025882053165094732, 0.024257444830985686, 0.022621662014939758, 0.020973331987041544, 0.01931077085698707, 0.017631876015072212, 0.015933965136455286, 0.014213524922422005, 0.01246579811308457, 0.010684058225301496, 0.0088582189770833875, 0.0069718188258571789, 0.0049941287433352688, 0.0028511559800148412, NaN, NaN), precision = c(0.36283185840707965, 0.36283185840707965, 0.3638610940217899, 0.36503318640513022, 0.36622917609588718, 0.36743156288626455, 0.36863407942651483, 0.36983395907069327, 0.37102987525856479, 0.37222118778267033, 0.37340761422168994, 0.37458906950848397, 0.37576558114411102, 0.37693724173725379, 0.37810418128291789, 0.37926655045634072, 0.38042451032066127, 0.38157822589826612, 0.38272786213400795, 0.38387358137166239, 0.38501554180404274, 0.38615389655742816, 0.38728879319255999, 0.38842037348013797, 0.38954877335682403, 0.39067412299888055, 0.39179654697102895, 0.39291616442174976, 0.39403308930544589, 0.39514743061815566, 0.39625929263780196, 0.39736877516294139, 0.39847597374604166, 0.39958097991875013, 0.4006838814076199, 0.40178476233945432, 0.40288370343591201, 0.40398078219734135, 0.40507607307603705, 0.40616964763925201, 0.40726157472239449, 0.40835192057288783, 0.40944074898519761, 0.41052812142753953, 0.41161409716077646, 0.41269873334999518, 0.41378208516923853, 0.41486420589984296, 0.41594514702280933, 0.41702495830560621, 0.41810368788378333, 0.41918138233774566, 0.42025808676501492, 0.42133384484828479, 0.42240869891955213, 0.42348269002058631, 0.42455585795998196, 0.42562824136702254, 0.42669987774256118, 0.42777080350711683, 0.42884105404636508, 0.42991066375419096, 0.43097966607345994, 0.43204809353464951, 0.43311597779247768, 0.43418334966065208, 0.43525023914485317, 0.43631667547406228, 0.43738268713033218, 0.43844830187709405, 0.43951354678608745, 0.44057844826299403, 0.44164303207184985, 0.44270732335830748, 0.44377134667181245, 0.44483512598675556, 0.44589868472265837, 0.44696204576344589, 0.44802523147585505, 0.4490882637270277, 0.45015116390132981, 0.4512139529164409, 0.45227665123874922, 0.45333927889809117, 0.45440185550186735, 0.45546440024856882, 0.45652693194074245, 0.4575894689974227, 0.45865202946605932, 0.45971463103396282, 0.46077729103929382, 0.46184002648161571, 0.46290285403203468, 0.46396579004294491, 0.46502885055739746, 0.46609205131811149, 0.46715540777614428, 0.46821893509923496, 0.46928264817983761, 0.4703465616428576, 0.47141068985310436, 0.47247504692247311, 0.4735396467168686, 0.47460450286288003, 0.47566962875422003, 0.47673503755793722, 0.47780074222041119, 0.47886675547313973, 0.47993308983832877, 0.48099975763428843, 0.48206677098065032, 0.48313414180340614, 0.48420188183977986, 0.4852700026429389, 0.48633851558654895, 0.48740743186918162, 0.48847676251857852, 0.48954651839577817, 0.49061671019911202, 0.49168734846807211, 0.49275844358705789, 0.49383000578900577, 0.49490204515890612, 0.49597457163721043, 0.49704759502313517, 0.49812112497786476, 0.49919517102765787, 0.50026974256685941, 0.50134484886082231, 0.50242049904874519, 0.50349670214642239, 0.50457346704891615, 0.50565080253314998, 0.50672871726042723, 0.50780721977887633, 0.50888631852582633, 0.50996602183011597, 0.51104633791433585, 0.51212727489700816, 0.5132088407947053, 0.51429104352411037, 0.51537389090401931, 0.51645739065728868, 0.51754155041273042, 0.51862637770695463, 0.51971187998616253, 0.5207980646078908, 0.52188493884271014, 0.52297250987587796, 0.52406078480894647, 0.52514977066133051, 0.52623947437183127, 0.52732990280012326, 0.52842106272819989, 0.52951296086178423, 0.53060560383170075, 0.53169899819521416, 0.53279315043733289, 0.5338880669720798, 0.53498375414373078, 0.53608021822802188, 0.53717746543332634, 0.53827550190180307, 0.53937433371051446, 0.54047396687251925, 0.54157440733793594, 0.54267566099498177, 0.54377773367098592, 0.54488063113337715, 0.54598435909064891, 0.54708892319329983, 0.54819432903475229, 0.54930058215224853, 0.55040768802772566, 0.55151565208867026, 0.5526244797089509, 0.55373417620963283, 0.55484474685977292, 0.55595619687719566, 0.55706853142925095, 0.55818175563355388, 0.55929587455870844, 0.5604108932250137, 0.56152681660515258, 0.56264364962486646, 0.56376139716361373, 0.56488006405521274, 0.56599965508847017, 0.56712017500779477, 0.56824162851379856, 0.56936402026388233, 0.57048735487280966, 0.57161163691326589, 0.57273687091640724, 0.57386306137239496, 0.57499021273091844, 0.57611832940170749, 0.5772474157550318, 0.57837747612219004, 0.5795085147959872, 0.5806405360312028, 0.58177354404504678, 0.58290754301760728, 0.58404253709228726, 0.58517853037623069, 0.58631552694074218, 0.58745353082169394, 0.58859254601992628, 0.58973257650163835, 0.59087362619877004, 0.59201569900937578, 0.59315879879799094, 0.59430292939598872, 0.59544809460193027, 0.59659429818190757, 0.59774154386987699, 0.5988898353679879, 0.6000391763469024, 0.60118957044610932, 0.60234102127423028, 0.6034935324093198, 0.60464710739915906, 0.60580174976154355, 0.60695746298456221, 0.60811425052687451, 0.60927211581797758, 0.61043106225847144, 0.61159109322031413, 0.6127522120470752, 0.61391442205418256, 0.61507772652916215, 0.61624212873187589, 0.61740763189475167, 0.61857423922300991, 0.61974195389488484, 0.62091077906184067, 0.62208071784878471, 0.62325177335427384, 0.62442394865071749, 0.6255972467845784, 0.62677167077656437, 0.62794722362182187, 0.6291239082901201, 0.63030172772603543, 0.63148068484912911, 0.63266078255412317, 0.63384202371107168, 0.63502441116552955, 0.63620794773871503, 0.63739263622767384, 0.63857847940543522, 0.63976548002116673, 0.64095364080032668, 0.64214296444481289, 0.64333345363310745, 0.64452511102042076, 0.64571793923883025, 0.64691194089741966, 0.64810711858241232, 0.64930347485730378, 0.65050101226299217, 0.65169973331790476, 0.65289964051812377, 0.65410073633750887, 0.6553030232278183, 0.65650650361882701, 0.65771117991844374, 0.65891705451282556, 0.66012412976649071, 0.66133240802243032, 0.66254189160221644, 0.66375258280611082, 0.66496448391317153, 0.66617759718135705, 0.66739192484762933, 0.6686074691280568, 0.66982423221791365, 0.67104221629178162, 0.67226142350364615, 0.67348185598699606, 0.67470351585491883, 0.67592640520019642, 0.6771505260954005, 0.67837588059298726, 0.67960247072538982, 0.68083029850511279, 0.68205936592482375, 0.68328967495744608, 0.68452122755625144, 0.68575402565495136, 0.68698807116778859, 0.68822336598962941, 0.68945991199605594, 0.69069771104345723, 0.69193676496912271, 0.69317707559133346, 0.69441864470945747, 0.69566147410404189, 0.69690556553690775, 0.69815092075124685, 0.69939754147171529, 0.70064542940453334, 0.70189458623758194, 0.70314501364050352, 0.70439671326480247, 0.70564968674394757, 0.70690393569347665, 0.70815946171110145, 0.70941626637681732, 0.71067435125300993, 0.71193371788457049, 0.71319436779900869, 0.71445630250656822, 0.71571952350034762, 0.71698403225642271, 0.7182498302339706, 0.7195169188753977, 0.72078529960647242, 0.72205497383645922, 0.72332594295825647, 0.72459820834854127, 0.72587177136791359, 0.72714663336104701, 0.72842279565684642, 0.72970025956860496, 0.73097902639416912, 0.73225909741611084, 0.73354047390190014, 0.7348231571040873, 0.73610714826049028, 0.73739244859438569, 0.7386790593147099, 0.73996698161626429, 0.74125621667992891, 0.74254676567288214, 0.74383862974882975, 0.74513181004824069, 0.7464263076985912, 0.74772212381461833, 0.74901925949858295, 0.75031771584053963, 0.75161749391862032, 0.75291859479932588, 0.7542210195378275, 0.75552476917828215, 0.75682984475415671, 0.75813624728856777, 0.75944397779463069, 0.76075303727582222, 0.76206342672636185, 0.76337514713159871, 0.76468819946842082, 0.76600258470567983, 0.76731830380462396, 0.7686353577193602, 0.76995374739732148, 0.7712734737797643, 0.77259453780227261, 0.77391694039529535, 0.77524068248469669, 0.7765657649923251, 0.77789218883661448, 0.77921995493320173, 0.78054906419557357, 0.78187951753573193, 0.7832113158648969, 0.78454446009422663, 0.78587895113557582, 0.78721478990227634, 0.78855197730995752, 0.78989051427739221, 0.79123040172738546, 0.79257164058769269, 0.79391423179197451, 0.79525817628080409, 0.79660347500269424, 0.79795012891519101, 0.79929813898599389, 0.80064750619413194, 0.80199823153118921, 0.80335031600257734, 0.80470376062886506, 0.80605856644716867, 0.8074147345125865, 0.80877226589971607, 0.81013116170421851, 0.81149142304445698, 0.81285305106320949, 0.81421604692945382, 0.81558041184022145, 0.81694614702255319, 0.81831325373552011, 0.81968173327234473, 0.82105158696261471, 0.82242281617459678, 0.82379542231765635, 0.82516940684477436, 0.82654477125519887, 0.8279215170972013, 0.82929964597096251, 0.83067915953160298, 0.83206005949233697, 0.83344234762778824, 0.83482602577745291, 0.83621109584933229, 0.83759755982373529, 0.8389854197572606, 0.84037467778697927, 0.84176533613481253, 0.84315739711212712, 0.84455086312455163, 0.84594573667704354, 0.84734202037919892, 0.84873971695082717, 0.85013882922781958, 0.85153936016830445, 0.85294131285913166, 0.85434469052268391, 0.85574949652404342, 0.85715573437854387, 0.85856340775972106, 0.85997252050767803, 0.86138307663792557, 0.86279508035067842, 0.86420853604067949, 0.86562344830756621, 0.86703982196681584, 0.86845766206130259, 0.86987697387352969, 0.8712977629385531, 0.87272003505766116, 0.87414379631286188, 0.8755690530822231, 0.87699581205614152, 0.8784240802545954, 0.87985386504544449, 0.88128517416388985, 0.88271801573312036, 0.88415239828629533, 0.88558833078992849, 0.88702582266877239, 0.88846488383237265, 0.88990552470335027, 0.89134775624761386, 0.89279159000662212, 0.89423703813187094, 0.89568411342180188, 0.89713282936132543, 0.89858320016418625, 0.90003524081841146, 0.90148896713512605, 0.90294439580104291, 0.90440154443491738, 0.9058604316484038, 0.90732107711166032, 0.90878350162419952, 0.91024772719147717, 0.91171377710778856, 0.91318167604610501, 0.91465145015555627, 0.91612312716737665, 0.91759673651018636, 0.91907230943563145, 0.92054987915551478, 0.92202948099173121, 0.92351115254046201, 0.92499493385225329, 0.92648086762999604, 0.92796899944684497, 0.92945937798667344, 0.93095205530991121, 0.93244708714804314, 0.93394453323065385, 0.93544445764946449, 0.93694692926451772, 0.93845202215862189, 0.93995981614720103, 0.94147039735190818, 0.94298385884802149, 0.94450030139746444, 0.94601983428155634, 0.94754257625061977, 0.9490686566108919, 0.9505982164737975, 0.95213141019805303, 0.95366840706210776, 0.95520939321350784, 0.95675457395301988, 0.95830417642662213, 0.9598584528176497, 0.96141768415765994, 0.96298218490878718, 0.96455230851777751, 0.96612845420563942, 0.96771107534701128, 0.9693006899195542, 0.97089789368602242, 0.97250337703855683, 0.97411794683490527, 0.97574255516901431, 0.97737833798506024, 0.97902666801295846, 0.98068922914301293, 0.98236812398492779, 0.98406603486354471, 0.98578647507757799, 0.98753420188691543, 0.9893159417746985, 0.99114178102291661, 0.99302818117414282, 0.99500587125666473, 0.99714884401998516, NaN, NaN), recall = c(1, 1, 0.99804305283757333, 0.99608610567514666, 0.9941291585127201, 0.99217221135029354, 0.99021526418786687, 0.9882583170254402, 0.98630136986301364, 0.98434442270058709, 0.98238747553816042, 0.98043052837573375, 0.97847358121330719, 0.97651663405088063, 0.97455968688845396, 0.97260273972602729, 0.97064579256360073, 0.96868884540117417, 0.9667318982387475, 0.96477495107632083, 0.96281800391389427, 0.96086105675146771, 0.95890410958904104, 0.95694716242661437, 0.95499021526418781, 0.95303326810176126, 0.95107632093933459, 0.94911937377690792, 0.94716242661448136, 0.9452054794520548, 0.94324853228962813, 0.94129158512720146, 0.9393346379647749, 0.93737769080234834, 0.93542074363992167, 0.93346379647749489, 0.93150684931506844, 0.92954990215264188, 0.92759295499021521, 0.92563600782778854, 0.92367906066536198, 0.92172211350293543, 0.91976516634050876, 0.91780821917808209, 0.91585127201565553, 0.91389432485322897, 0.9119373776908023, 0.90998043052837563, 0.90802348336594907, 0.90606653620352251, 0.90410958904109584, 0.90215264187866917, 0.90019569471624261, 0.89823874755381605, 0.89628180039138938, 0.89432485322896271, 0.89236790606653615, 0.8904109589041096, 0.88845401174168304, 0.88649706457925626, 0.8845401174168297, 0.88258317025440314, 0.88062622309197647, 0.8786692759295498, 0.87671232876712324, 0.87475538160469657, 0.8727984344422699, 0.87084148727984334, 0.86888454011741678, 0.86692759295499022, 0.86497064579256355, 0.86301369863013688, 0.86105675146771044, 0.85909980430528377, 0.8571428571428571, 0.85518590998043043, 0.85322896281800387, 0.85127201565557742, 0.84931506849315064, 0.84735812133072397, 0.84540117416829741, 0.84344422700587085, 0.84148727984344429, 0.83953033268101751, 0.83757338551859095, 0.83561643835616439, 0.83365949119373772, 0.83170254403131105, 0.82974559686888449, 0.82778864970645794, 0.82583170254403138, 0.8238747553816046, 0.82191780821917804, 0.81996086105675148, 0.81800391389432481, 0.81604696673189814, 0.81409001956947158, 0.81213307240704502, 0.81017612524461835, 0.80821917808219157, 0.80626223091976512, 0.80430528375733856, 0.802348336594912, 0.80039138943248522, 0.79843444227005878, 0.79647749510763211, 0.79452054794520544, 0.79256360078277877, 0.79060665362035221, 0.78864970645792565, 0.78669275929549909, 0.78473581213307231, 0.78277886497064575, 0.78082191780821919, 0.77886497064579252, 0.77690802348336585, 0.77495107632093929, 0.77299412915851273, 0.77103718199608617, 0.76908023483365939, 0.76712328767123283, 0.76516634050880639, 0.76320939334637972, 0.76125244618395294, 0.75929549902152638, 0.75733855185909993, 0.75538160469667315, 0.75342465753424648, 0.75146771037181992, 0.74951076320939336, 0.74755381604696669, 0.74559686888454002, 0.74363992172211346, 0.7416829745596869, 0.73972602739726023, 0.73776908023483356, 0.73581213307240712, 0.73385518590998045, 0.73189823874755378, 0.72994129158512711, 0.72798434442270055, 0.72602739726027399, 0.72407045009784743, 0.72211350293542065, 0.72015655577299409, 0.71819960861056753, 0.71624266144814086, 0.71428571428571419, 0.71232876712328763, 0.71037181996086107, 0.7084148727984344, 0.70645792563600773, 0.70450097847358117, 0.70254403131115462, 0.70058708414872795, 0.69863013698630128, 0.69667318982387472, 0.69471624266144816, 0.69275929549902149, 0.69080234833659482, 0.68884540117416826, 0.6868884540117417, 0.68493150684931503, 0.68297455968688836, 0.6810176125244618, 0.67906066536203524, 0.67710371819960857, 0.6751467710371819, 0.67318982387475523, 0.67123287671232879, 0.669275929549902, 0.66731898238747545, 0.66536203522504889, 0.66340508806262233, 0.66144814090019555, 0.65949119373776899, 0.65753424657534243, 0.65557729941291587, 0.6536203522504892, 0.65166340508806253, 0.64970645792563597, 0.64774951076320941, 0.64579256360078274, 0.64383561643835607, 0.64187866927592951, 0.63992172211350296, 0.63796477495107629, 0.63600782778864962, 0.63405088062622306, 0.6320939334637965, 0.63013698630136983, 0.62818003913894316, 0.6262230919765166, 0.62426614481409004, 0.62230919765166337, 0.6203522504892367, 0.61839530332681014, 0.61643835616438358, 0.61448140900195691, 0.61252446183953024, 0.61056751467710368, 0.60861056751467713, 0.60665362035225046, 0.60469667318982379, 0.60273972602739723, 0.60078277886497067, 0.598825831702544, 0.59686888454011733, 0.59491193737769077, 0.59295499021526421, 0.59099804305283754, 0.58904109589041087, 0.58708414872798431, 0.58512720156555775, 0.58317025440313108, 0.58121330724070441, 0.57925636007827785, 0.5772994129158513, 0.57534246575342463, 0.57338551859099796, 0.5714285714285714, 0.56947162426614484, 0.56751467710371817, 0.5655577299412915, 0.56360078277886494, 0.56164383561643838, 0.55968688845401171, 0.55772994129158504, 0.55577299412915848, 0.55381604696673192, 0.55185909980430525, 0.54990215264187858, 0.54794520547945202, 0.54598825831702547, 0.5440313111545988, 0.54207436399217213, 0.54011741682974557, 0.53816046966731901, 0.53620352250489234, 0.53424657534246567, 0.53228962818003911, 0.53033268101761255, 0.52837573385518588, 0.52641878669275921, 0.52446183953033265, 0.52250489236790609, 0.52054794520547942, 0.51859099804305275, 0.51663405088062619, 0.51467710371819964, 0.51272015655577297, 0.5107632093933463, 0.50880626223091974, 0.50684931506849318, 0.50489236790606651, 0.50293542074363984, 0.50097847358121328, 0.49902152641878667, 0.49706457925636005, 0.49510763209393344, 0.49315068493150682, 0.49119373776908021, 0.48923679060665359, 0.48727984344422698, 0.48532289628180036, 0.48336594911937375, 0.48140900195694714, 0.47945205479452052, 0.47749510763209391, 0.47553816046966729, 0.47358121330724068, 0.47162426614481406, 0.46966731898238745, 0.46771037181996084, 0.46575342465753422, 0.46379647749510761, 0.46183953033268099, 0.45988258317025438, 0.45792563600782776, 0.45596868884540115, 0.45401174168297453, 0.45205479452054792, 0.45009784735812131, 0.44814090019569469, 0.44618395303326808, 0.44422700587084146, 0.44227005870841485, 0.44031311154598823, 0.43835616438356162, 0.43639921722113501, 0.43444227005870839, 0.43248532289628178, 0.43052837573385516, 0.42857142857142855, 0.42661448140900193, 0.42465753424657537, 0.4227005870841487, 0.42074363992172209, 0.41878669275929548, 0.41682974559686886, 0.41487279843444225, 0.41291585127201569, 0.41095890410958907, 0.4090019569471624, 0.40704500978473579, 0.40508806262230923, 0.40313111545988256, 0.40117416829745595, 0.39921722113502939, 0.39726027397260272, 0.39530332681017616, 0.39334637964774949, 0.39138943248532287, 0.38943248532289626, 0.38747553816046965, 0.38551859099804303, 0.38356164383561642, 0.38160469667318986, 0.37964774951076319, 0.37769080234833657, 0.37573385518590996, 0.3737769080234834, 0.37181996086105673, 0.36986301369863012, 0.3679060665362035, 0.36594911937377694, 0.36399217221135027, 0.36203522504892366, 0.36007827788649704, 0.35812133072407043, 0.35616438356164382, 0.3542074363992172, 0.35225048923679059, 0.35029354207436392, 0.34833659491193741, 0.3463796477495108, 0.34442270058708419, 0.34246575342465752, 0.34050880626223096, 0.33855185909980429, 0.33659491193737767, 0.33463796477495111, 0.33268101761252444, 0.33072407045009783, 0.32876712328767127, 0.3268101761252446, 0.32485322896281799, 0.32289628180039132, 0.32093933463796476, 0.31898238747553814, 0.31702544031311153, 0.31506849315068497, 0.31311154598825836, 0.31115459882583163, 0.30919765166340507, 0.30724070450097851, 0.30528375733855184, 0.30332681017612523, 0.30136986301369861, 0.299412915851272, 0.29745596868884538, 0.29549902152641883, 0.29354207436399216, 0.2915851272015656, 0.28962818003913887, 0.28767123287671237, 0.2857142857142857, 0.28375733855185903, 0.28180039138943253, 0.27984344422700586, 0.27788649706457924, 0.27592954990215257, 0.27397260273972601, 0.27201565557729945, 0.27005870841487278, 0.26810176125244617, 0.26614481409001955, 0.264187866927593, 0.26223091976516638, 0.26027397260273977, 0.2583170254403131, 0.25636007827788648, 0.25440313111545987, 0.25244618395303331, 0.2504892367906067, 0.24853228962818005, 0.24657534246575341, 0.2446183953033268, 0.2426614481409001, 0.24070450097847362, 0.23874755381604693, 0.23679060665362034, 0.23483365949119361, 0.23287671232876717, 0.23091976516634047, 0.22896281800391383, 0.22700587084148729, 0.22504892367906071, 0.22309197651663407, 0.2211350293542074, 0.21917808219178078, 0.2172211350293542, 0.21526418786692758, 0.21330724070450094, 0.21135029354207435, 0.20939334637964774, 0.20743639921722107, 0.20547945205479451, 0.20352250489236787, 0.20156555772994122, 0.19960861056751467, 0.19765166340508805, 0.19569471624266147, 0.19373776908023482, 0.19178082191780826, 0.18982387475538162, 0.18786692759295498, 0.18590998043052842, 0.18395303326810175, 0.18199608610567519, 0.18003913894324852, 0.17808219178082194, 0.17612524461839529, 0.17416829745596865, 0.17221135029354201, 0.17025440313111548, 0.16829745596868884, 0.16634050880626222, 0.16438356164383566, 0.16242661448140899, 0.16046966731898241, 0.15851272015655576, 0.15655577299412918, 0.15459882583170251, 0.15264187866927589, 0.15068493150684936, 0.14872798434442261, 0.14677103718199611, 0.14481409001956941, 0.14285714285714282, 0.14090019569471618, 0.13894324853228959, 0.13698630136986298, 0.13502935420743636, 0.13307240704500972, 0.13111545988258316, 0.12915851272015663, 0.12720156555772999, 0.1252446183953034, 0.12328767123287671, 0.12133072407045009, 0.11937377690802352, 0.11741682974559686, 0.11545988258317025, 0.11350293542074361, 0.11154598825831699, 0.10958904109589039, 0.1076320939334638, 0.1056751467710372, 0.10371819960861053, 0.10176125244618392, 0.099804305283757389, 0.097847358121330733, 0.09589041095890416, 0.093933463796477504, 0.091976516634050862, 0.090019569471624289, 0.088062622309197675, 0.086105675146771019, 0.084148727984344446, 0.082191780821917845, 0.080234833659491259, 0.078277886497064589, 0.076320939334637947, 0.074363992172211374, 0.072407045009784773, 0.070450097847358159, 0.068493150684931517, 0.066536203522504889, 0.064579256360078302, 0.062622309197651688, 0.060665362035225066, 0.058708414872798501, 0.056751467710371865, 0.054794520547945209, 0.052837573385518657, 0.050880626223092015, 0.048923679060665401, 0.046966731898238773, 0.045009784735812165, 0.043052837573385544, 0.041095890410958923, 0.039138943248532329, 0.03718199608610568, 0.035225048923679107, 0.033268101761252479, 0.031311154598825837, 0.029354207436399233, 0.027397260273972615, 0.02544031311154599, 0.023483365949119386, 0.021526418786692772, 0.019569471624266147, 0.017612524461839554, 0.015655577299412939, 0.013698630136986308, 0.011741682974559685, 0.0097847358121330927, 0.0078277886497064766, 0.0058708414872798544, 0.0039138943248532305, 0.0019569471624266178, 0, 0), youden = c(1, 1, 1.0044307210422967, 1.0094274716939247, 1.0144734471497678, 1.0194933498090268, 1.0244610079876548, 1.0293655397913966, 1.0342023155705524, 1.0389696509280197, 1.0436673673191281, 1.0482960917956903, 1.0528568892384893, 1.057351058437578, 1.0617800146041971, 1.0661452199233417, 1.0704481419194456, 1.0746902284462516, 1.0788728928610962, 1.0829975055540415, 1.0870653894920832, 1.0910778183166254, 1.0950360160641137, 1.0989411579093802, 1.1027943715397339, 1.1065967389020244, 1.110349298152471, 1.1140530456969666, 1.117708938248182, 1.1213178948517966, 1.1248807988517264, 1.1283984997761451, 1.131871815134156, 1.1353015321184112, 1.1386884092126346, 1.1420331777053887, 1.1453365431129843, 1.1485991865153689, 1.1518217658093719, 1.155004916883942, 1.1581492547220809, 1.1612553744341136, 1.164323852226796, 1.1673552463125585, 1.1703500977629764, 1.1733089313102971, 1.1762322561006262, 1.1791205664021289, 1.18197434227137, 1.1847940501806935, 1.1875801436093276, 1.1903330636007095, 1.1930532392883306, 1.1957410883922397, 1.1983970176881698, 1.2010214234511161, 1.2036146918750539, 1.2061771994703532, 1.2087093134403368, 1.2112113920383194, 1.2136837849063662, 1.2161268333969215, 1.2185408708783672, 1.2209262230255047, 1.2232832080958758, 1.2256121371927724, 1.2279133145157324, 1.2301870375992539, 1.232433597540417, 1.2346532792160536, 1.2368463614900564, 1.2390131174113879, 1.241153814403307, 1.243268714444296, 1.2453580742411448, 1.2474221453946108, 1.2494611745580588, 1.2514754035894442, 1.2534650696969947, 1.2554304055789123, 1.2573716395574064, 1.2592889957073403, 1.2611826939797675, 1.2630529503206083, 1.2648999767847064, 1.2667239816454932, 1.2685251695004669, 1.2703037413726923, 1.2720598948085047, 1.2737938239715993, 1.2755057197336714, 1.2771957697617671, 1.2788641586024951, 1.2805110677632405, 1.2821366757905124, 1.283741158345558, 1.2853246882773564, 1.2868874356931106, 1.2884295680263453, 1.2899512501027095, 1.2914526442035834, 1.2929339101275847, 1.2943952052500549, 1.2958366845806135, 1.29725850081886, 1.2986608044082952, 1.3000437435885357, 1.3014074644458877, 1.3027521109623503, 1.3040778250631007, 1.3053847466625297, 1.3066730137088765, 1.3079427622275213, 1.3091941263629827, 1.3104272384196718, 1.3116422289014458, 1.3128392265500115, 1.3140183583822131, 1.3151797497262536, 1.3163235242568787, 1.3174498040295717, 1.3185587095137841, 1.3196503596252434, 1.3207248717573659, 1.3217823618118094, 1.3228229442281925, 1.3238467320130107, 1.3248538367677773, 1.3258443687164121, 1.3268184367319089, 1.3277761483622992, 1.3287176098559415, 1.3296429261861524, 1.3305522010752098, 1.3314455370177352, 1.3323230353034901, 1.3331847960395944, 1.3340309181721899, 1.3348614995075645, 1.3356766367327566, 1.3364764254356529, 1.3372609601245973, 1.3380303342475246, 1.3387846402106351, 1.3395239693966223, 1.3402484121824692, 1.3409580579568225, 1.3416529951369629, 1.3423333111853781, 1.3429990926259532, 1.343650425059788, 1.3442873931806547, 1.3449100807901018, 1.3455185708122199, 1.3461129453080753, 1.3466932854898199, 1.3472596717344916, 1.3478121835975083, 1.3483508998258675, 1.348875898371058, 1.3493872564016927, 1.3498850503158686, 1.3503693557532639, 1.3508402476069767, 1.3512978000351132, 1.3517420864721337, 1.3521731796399599, 1.3525911515588511, 1.3529960735580586, 1.3533880162862562, 1.3537670497217618, 1.3541332431825495, 1.3544866653360581, 1.3548273842088052, 1.3551554671958064, 1.3554709810698093, 1.355773991990342, 1.3560645655125871, 1.3563427665960797, 1.3566086596132361, 1.3568623083577189, 1.3571037760526385, 1.3573331253586005, 1.3575504183815967, 1.3577557166807486, 1.3579490812759025, 1.3581305726550865, 1.358300250781822, 1.3584581751023039, 1.3586044045524472, 1.3587389975648021, 1.3588620120753454, 1.3589735055301453, 1.3590735348919076, 1.3591621566464034, 1.3592394268087793, 1.3593054009297583, 1.3593601341017285, 1.3594036809647241, 1.3594360957123015, 1.359457432097313, 1.3594677434375779, 1.3594670826214581, 1.3594555021133352, 1.3594330539589936, 1.3593997897909127, 1.3593557608334677, 1.3593010179080434, 1.3592356114380602, 1.3591595914539176, 1.3590730075978534, 1.3589759091287221, 1.3588683449266967, 1.3587503634978881, 1.358622012978894, 1.3584833411412687, 1.3583343953959246, 1.3581752227974584, 1.3580058700484106, 1.3578263835034536, 1.3576368091735165, 1.3574371927298405, 1.3572275795079736, 1.3570080145116978, 1.3567785424169005, 1.3565392075753793, 1.3562900540185918, 1.3560311254613446, 1.3557624653054283, 1.3554841166431923, 1.3551961222610687, 1.3548985246430409, 1.3545913659740596, 1.3542746881434065, 1.3539485327480092, 1.3536129410957032, 1.3532679542084496, 1.3529136128255006, 1.3525499574065203, 1.3521770281346599, 1.3517948649195857, 1.3514035074004649, 1.3510029949489066, 1.3505933666718599, 1.3501746614144721, 1.3497469177629025, 1.3493101740470981, 1.3488644683435302, 1.3484098384778895, 1.3479463220277452, 1.3474739563251652, 1.3469927784593012, 1.3465028252789346, 1.3460041333949904, 1.3454967391830128, 1.34498067878561, 1.344455988114861, 1.3439227028546938, 1.3433808584632274, 1.3428304901750847, 1.342271633003671, 1.3417043217434246, 1.3411285909720352, 1.3405444750526327, 1.3399520081359482, 1.3393512241624428, 1.3387421568644124, 1.3381248397680616, 1.3374993061955509, 1.336865589267018, 1.3362237219025705, 1.335573736824256, 1.3349156665580026, 1.3342495434355373, 1.3335753995962785, 1.3328932669892042, 1.3322031773746952, 1.3315051623263581, 1.3307992532328203, 1.3300854812995067, 1.3293638775503918, 1.3286344728297284, 1.3278972978037582, 1.3271523829623983, 1.3263997586209071, 1.32563945492153, 1.3248715018351245, 1.3240959291627659, 1.3233127665373319, 1.3225220434250695, 1.3217237891271405, 1.3209180327811509, 1.3201048033626606, 1.3192841296866729, 1.3184560404091099, 1.317620564028267, 1.3167777288862517, 1.3159275631704042, 1.3150700949147018, 1.3142053520011472, 1.3133333621611385, 1.3124541529768257, 1.311567751882448, 1.3106741861656588, 1.3097734829688339, 1.3088656692903631, 1.3079507719859294, 1.3070288177697711, 1.3060998332159313, 1.3051638447594918, 1.3042208786977927, 1.30327096119164, 1.3023141182664966, 1.3013503758136624, 1.300379759591439, 1.2994022952262834, 1.2984180082139463, 1.2974269239205993, 1.2964290675839496, 1.2954244643143413, 1.2944131390958447, 1.2933951167873339, 1.2923704221235526, 1.2913390797161672, 1.2903011140548097, 1.2892565495081074, 1.2882054103247031, 1.2871477206342632, 1.2860835044484751, 1.2850127856620335, 1.2839355880536156, 1.2828519352868468, 1.2817618509112565, 1.2806653583632195, 1.2795624809668946, 1.2784532419351446, 1.2773376643704533, 1.2762157712658293, 1.2750875855057011, 1.2739531298668019, 1.272812427019046, 1.2716654995263954, 1.2705123698477174, 1.2693530603376317, 1.2681875932473516, 1.2670159907255127, 1.2658382748189958, 1.264654467473739, 1.2634645905355426, 1.2622686657508648, 1.2610667147676087, 1.2598587591359021, 1.258644820308868, 1.257424919643388, 1.2561990784008557, 1.254967317747925, 1.2537296587572477, 1.2524861224082051, 1.2512367295876303, 1.249981501090526, 1.2487204576207691, 1.247453619791814, 1.2461810081273841, 1.244902643062157, 1.2436185449424428, 1.2423287340268563, 1.2410332304869776, 1.2397320544080106, 1.2384252257894313, 1.2371127645456295, 1.2357946905065444, 1.2344710234182918, 1.2331417829437852, 1.2318069886633485, 1.2304666600753249, 1.2291208165966749, 1.2277694775635708, 1.2264126622319818, 1.225050389778253, 1.2236826792996789, 1.2223095498150685, 1.2209310202653034, 1.2195471095138903, 1.2181578363475056, 1.2167632194765337, 1.215363277535598, 1.2139580290840852, 1.2125474926066631, 1.2111316865137904, 1.2097106291422208, 1.2082843387554987, 1.2068528335444493, 1.2054161316276599, 1.2039742510519567, 1.2025272097928688, 1.201075025755094, 1.1996177167729472, 1.1981553006108077, 1.1966877949635581, 1.1952152174570128, 1.1937375856483412, 1.1922549170264825, 1.1907672290125508, 1.1892745389602355, 1.1877768641561883, 1.1862742218204063, 1.1847666291066041, 1.1832541031025769, 1.1817366608305548, 1.1802143192475483, 1.1786870952456825, 1.1771550056525237, 1.1756180672313941, 1.1740762966816756, 1.172529710639105, 1.1709783256760555, 1.1694221583018085, 1.1678612249628124, 1.1662955420429291, 1.1647251258636684, 1.1631499926844073, 1.1615701587025982, 1.1599856400539597, 1.1583964528126538, 1.1568026129914479, 1.1552041365418586, 1.1536010393542804, 1.1519933372580946, 1.1503810460217598, 1.1487641813528842, 1.1471427588982741, 1.1455167942439635, 1.1438863029152186, 1.1422513003765187, 1.1406118020315121, 1.1389678232229437, 1.1373193792325542, 1.1356664852809508, 1.1340091565274428, 1.1323474080698457, 1.1306812549442464, 1.1290107121247335, 1.1273357945230826, 1.125656516988401, 1.123972894306724, 1.1222849412005624, 1.1205926723283957, 1.1188961022841086, 1.1171952455963683, 1.1154901167279319, 1.1137807300748883, 1.1120670999658211, 1.1103492406608897, 1.1086271663508254, 1.1069008911558291, 1.1051704291243682, 1.1034357942318616, 1.1016970003792448, 1.0999540613914027, 1.0982069910154628, 1.0964558029189304, 1.0947005106876582, 1.0929411278236281, 1.0911776677425351, 1.089410143771147, 1.0876385691444246, 1.0858629570023726, 1.0840833203865992, 1.0822996722365508, 1.0805120253853884, 1.0787203925554671, 1.0769247863533753, 1.0751252192644822, 1.0733217036469394, 1.0715142517250686, 1.0697028755820639, 1.067887587151922, 1.066068398210501, 1.0642453203655959, 1.0624183650458954, 1.0605875434886689, 1.0587528667259973, 1.0569143455693404, 1.0550719905921819, 1.0532258121104592, 1.0513758201604106, 1.0495220244734182, 1.0476644344473174, 1.0458030591135425, 1.0439379070993262, 1.0420689865839965, 1.0401963052481618, 1.0383198702142882, 1.0364396879767441, 1.0345557643188585, 1.0326681042138011, 1.0307767117050817, 1.0288815897610613, 1.026982740095872, 1.0250801629462349, 1.0231738567893722, 1.0212638179806417, 1.0193500402792397, 1.0174325142135636, 1.015511226209483, 1.0135861573542995, 1.0116572815739022, 1.0097245628067317, 1.007787950323862, 1.0058473702364801, 1.00390270781663, 1.0019537608273299, 1, 1), closest.topleft = c(1, 1, 0.98726929553784371, 0.97351057857847711, 0.95975977958582082, 0.94616544196435937, 0.93277702442373789, 0.91961322535069245, 0.90668026165222904, 0.89397855620461186, 0.88150564259267061, 0.8692575720780481, 0.85722964716818495, 0.8454168238688341, 0.83381393966656869, 0.82241584507735621, 0.81121747971947578, 0.80021391551962595, 0.78940038002498902, 0.77877226750347184, 0.76832514249958428, 0.75805473874081375, 0.74795695521906191, 0.7380278506107486, 0.72826363678319805, 0.71866067186889804, 0.70921545321689428, 0.69992461041777021, 0.6907848985242927, 0.68179319154052687, 0.67294647621957004, 0.66424184618843618, 0.65567649640445635, 0.6472477179384265, 0.63895289307397496, 0.63078949070918711, 0.62275506204462749, 0.61484723654107121, 0.60706371813010884, 0.59940228166109177, 0.59186076956847922, 0.58443708874441458, 0.57712920760221953, 0.56993515331738065, 0.56285300923350667, 0.55588091242162041, 0.54901705138198797, 0.54225966387849245, 0.5356070348963099, 0.52905749471435648, 0.52260941708462505, 0.51626121751113652, 0.5100113516217899, 0.50385831362691025, 0.4978006348587718, 0.49183688238680584, 0.48596565770359984, 0.48018559547716844, 0.47449536236531276, 0.46889365588819093, 0.46337920335550903, 0.45795076084499947, 0.45260711222910566, 0.44734706824699311, 0.4421694656192256, 0.43707316620262449, 0.43205705618300216, 0.42712004530362185, 0.42226106612737274, 0.41747907333079598, 0.41277304302821427, 0.40814197212433156, 0.40358487769377949, 0.39910079638618134, 0.39468878385540129, 0.39034791421172343, 0.38607727949578469, 0.38187598917316645, 0.37774316964860311, 0.37367796379884344, 0.36967953052324221, 0.36574704431122884, 0.36187969482584403, 0.3580766865025744, 0.35433723816277901, 0.35066058264101568, 0.34704596642563951, 0.34349264931206358, 0.33999990406811098, 0.33656701611092149, 0.33319328319489938, 0.32987801511022402, 0.32662053339146047, 0.32342017103583814, 0.32027627223079225, 0.31718819209037041, 0.31415529640013984, 0.31117696137024287, 0.30825257339626733, 0.30538152882761588, 0.3025632337430722, 0.29979710373327706, 0.29708256368984393, 0.29441904760085325, 0.29180599835247761, 0.28924286753650319, 0.28672911526352285, 0.28426420998158897, 0.28184762830011523, 0.27947885481884133, 0.27715738196166662, 0.27488270981518126, 0.27265434597172011, 0.27047180537677851, 0.26833461018063709, 0.26624228959404383, 0.26419437974781224, 0.2621904235562002, 0.26022997058393832, 0.25831257691678466, 0.25643780503548269, 0.25460522369301192, 0.25281440779501768, 0.2510649382833185, 0.24935640202238463, 0.24768839168869547, 0.24606050566287943, 0.24447234792454864, 0.24292352794974162, 0.24141366061088892, 0.23994236607922786, 0.23850926972958339, 0.23711400204744656, 0.2357561985382759, 0.23443549963895721, 0.23315155063135407, 0.23190400155788563, 0.2306925071390715, 0.22951672669298689, 0.22837632405656827, 0.22727096750871661, 0.22620032969514781, 0.22516408755493517, 0.22416192224870002, 0.22319351908839946, 0.22225856746866834, 0.22135676079967048, 0.22048779644141669, 0.21965137563950921, 0.21884720346227243, 0.21807498873923276, 0.21733444400090945, 0.21662528541988141, 0.21594723275309569, 0.21530000928538318, 0.21468334177415188, 0.2140969603952228, 0.21354059868978126, 0.21301399351241346, 0.21251688498019916, 0.2120490164228353, 0.2116101343337608, 0.21119998832226011, 0.21081833106651843, 0.21046491826760555, 0.21013950860436417, 0.20984186368918123, 0.20957174802461875, 0.20932892896088456, 0.20911317665412033, 0.20892426402548914, 0.20876196672104078, 0.20862606307233827, 0.2085163340578251, 0.20843256326491719, 0.208374536852801, 0.20834204351592264, 0.20833487444814933, 0.20835282330758997, 0.20839568618205778, 0.20846326155516087, 0.20855535027300581, 0.20867175551150083, 0.20881228274424365, 0.20897673971098257, 0.20916493638663575, 0.20937668495085771, 0.20961179975814043, 0.20987009730843637, 0.21015139621829321, 0.21045551719248723, 0.2107822829961466, 0.21113151842735206, 0.21150305029020508, 0.2118967073683542, 0.21231232039896891, 0.21274972204715109, 0.21320874688077607, 0.21368923134575296, 0.21419101374169583, 0.21471393419799717, 0.21525783465029552, 0.21582255881732795, 0.2164079521781605, 0.21701386194978911, 0.21764013706510171, 0.21828662815119593, 0.21895318750804418, 0.21963966908749893, 0.22034592847263273, 0.22107182285740423, 0.22181721102664514, 0.22258195333636116, 0.22336591169434125, 0.224168949541068, 0.22499093183092442, 0.22583172501369073, 0.22669119701632551, 0.22756921722502607, 0.22846565646756192, 0.22938038699587707, 0.23031328246895527, 0.2312642179359434, 0.23223306981952829, 0.23321971589956159, 0.23422403529692931, 0.23524590845765958, 0.23628521713726602, 0.23734184438532085, 0.23841567453025492, 0.23950659316437922, 0.24061448712912381, 0.24173924450049189, 0.24288075457472311, 0.24403890785416299, 0.24521359603333537, 0.24640471198521308, 0.24761214974768453, 0.24883580451021187, 0.25007557260067692, 0.2513313514724132, 0.25260303969141906, 0.25389053692374958, 0.25519374392308392, 0.25651256251846477, 0.25784689560220803, 0.25919664711797813, 0.26056172204902694, 0.26194202640659414, 0.26333746721846518, 0.26474795251768446, 0.26617339133142154, 0.267613693669987, 0.26906877051599642, 0.27053853381367937, 0.27202289645833017, 0.27352177228590036, 0.27503507606272803, 0.27656272347540362, 0.27810463112076811, 0.27966071649604324, 0.28123089798909101, 0.28281509486879947, 0.28441322727559337, 0.28602521621206833, 0.28765098353374596, 0.28929045193994696, 0.29094354496478186, 0.29261018696825714, 0.29429030312749421, 0.29598381942806079, 0.29769066265541039, 0.299410760386431, 0.30114404098110081, 0.30289043357424689, 0.30464986806740757, 0.30642227512079684, 0.30820758614536797, 0.31000573329497577, 0.31181664945863474, 0.31364026825287378, 0.3154765240141843, 0.31732535179156041, 0.31918668733912992, 0.3210604671088757, 0.32294662824344522, 0.32484510856904619, 0.3267558465884286, 0.32867878147395074, 0.33061385306072866, 0.33256100183986714, 0.33452016895177134, 0.33649129617953771, 0.33847432594242383, 0.34046920128939495, 0.34247586589274565, 0.34449426404179839, 0.34652434063667364, 0.3485660411821348, 0.35061931178150235, 0.35268409913064119, 0.35476035051201577, 0.35684801378881492, 0.35894703739914363, 0.36105737035028079, 0.36317896221300522, 0.36531176311598373, 0.36745572374022434, 0.36961079531359203, 0.37177692960538739, 0.37395407892098559, 0.37614219609653576, 0.37834123449372004, 0.3805511479945719, 0.38277189099635184, 0.38500341840647956, 0.38724568563752321, 0.38949864860224431, 0.39176226370869699, 0.3940364878553807, 0.39632127842644749, 0.3986165932869607, 0.40092239077820646, 0.40323862971305507, 0.40556526937137377, 0.40790226949548958, 0.41024959028570007, 0.41260719239583332, 0.41497503692885546, 0.41735308543252597, 0.41974129989509867, 0.42213964274106863, 0.4245480768269651, 0.42696656543718919, 0.42939507227989399, 0.43183356148291152, 0.43428199758971864, 0.43674034555544827, 0.43920857074294217, 0.44168663891884402, 0.44417451624973286, 0.44667216929829973, 0.44917956501956058, 0.45169667075711012, 0.45422345423941435, 0.45675988357614161, 0.45930592725453051, 0.46186155413579533, 0.46442673345156893, 0.4670014348003817, 0.46958562814417609, 0.47217928380485635, 0.47478237246087451, 0.47739486514384927, 0.48001673323522004, 0.48264794846293485, 0.48528848289817095, 0.48793830895208773, 0.49059739937261415, 0.49326572724126588, 0.49594326596999516, 0.49862998929807284, 0.50132587128899952, 0.50403088632744808, 0.50674500911623721, 0.50946821467333214, 0.51220047832887883, 0.51494177572226296, 0.51769208279919998, 0.52045137580885392, 0.52321963130098292, 0.52599682612311238, 0.5287829374177363, 0.53157794261954616, 0.53438181945268481, 0.53719454592802762, 0.54001610034049019, 0.54284646126636094, 0.54568560756066009, 0.54853351835452291, 0.55139017305260773, 0.55425555133052995, 0.55712963313231922, 0.56001239866789954, 0.5629038284105965, 0.56580390309466322, 0.56871260371283472, 0.57162991151390008, 0.57455580800030093, 0.57749027492575089, 0.58043329429287749, 0.58338484835088511, 0.58634491959324042, 0.58931349075537864, 0.59229054481243248, 0.59527606497697905, 0.59827003469680962, 0.60127243765271954, 0.60428325775631808, 0.6073024791478574, 0.61033008619408224, 0.61336606348609934, 0.61641039583726576, 0.61946306828109488, 0.62252406606918365, 0.62559337466915732, 0.62867097976263253, 0.63175686724319746, 0.63485102321441367, 0.63795343398783189, 0.64106408608102605, 0.64418296621564797, 0.64731006131549451, 0.65044535850459595, 0.65358884510531856, 0.65674050863648481, 0.65990033681151028, 0.66306831753655604, 0.66624443890869889, 0.66942868921411491, 0.67262105692628182, 0.67582153070419382, 0.67903009939059544, 0.68224675201022644, 0.68547147776808581, 0.68870426604770907, 0.69194510640945928, 0.69519398858883441, 0.69845090249478792, 0.7017158382080656, 0.70498878597955406, 0.70826973622864475, 0.71155867954161145, 0.71485560667000259, 0.71816050852904456, 0.72147337619606189, 0.72479420090890823, 0.72812297406440962, 0.73145968721682653, 0.7348043320763199, 0.73815690050743843, 0.74151738452761384, 0.74488577630566866, 0.74826206816033913, 0.75164625255880746, 0.75503832211524835, 0.75843826958938665, 0.76184608788506691, 0.76526177004883456, 0.76868530926852996, 0.7721166988718926, 0.77555593232517717, 0.77900300323178306, 0.78245790533089066, 0.7859206324961141, 0.78939117873416109, 0.79286953818350558, 0.79635570511307163, 0.79984967392092698, 0.80335143913298779, 0.80686099540173428, 0.81037833750493782, 0.81390346034439665, 0.81743635894468269, 0.82097702845190079, 0.82452546413245487, 0.82808166137182759, 0.83164561567336814, 0.83521732265709181, 0.8387967780584874, 0.84238397772733897, 0.84597891762655242, 0.84958159383099752, 0.85319200252635596, 0.85681014000798206, 0.86043600267977327, 0.86406958705305037, 0.86771088974544786, 0.87135990747981706, 0.87501663708313582, 0.87868107548543339, 0.88235321971872249, 0.88603306691594508, 0.8897206143099281, 0.89341585923235067, 0.89711879911272396, 0.90082943147738426, 0.9045477539484964, 0.90827376424307338, 0.9120074601720074, 0.91574883963911857, 0.91949790064021675, 0.9232546412621826, 0.92701905968206499, 0.93079115416619973, 0.93457092306934897, 0.93835836483386659, 0.94215347798888771, 0.94595626114955267, 0.94976671301626303, 0.95358483237398151, 0.95741061809157779, 0.96124406912123594, 0.96508518449792924, 0.96893396333898918, 0.9727904048437841, 0.97665450829355205, 0.98052627305143758, 0.98440569856282378, 0.98829278435610868, 0.99218753004421767, 0.99608993532749601, 1, 1)), class = "data.frame", row.names = c(NA, -514L)) pROC/tests/testthat/test-ci.se.R0000644000176200001440000000264614114130125016160 0ustar liggesuserslibrary(pROC) data(aSAH) context("ci.se") # Only test whether ci.se runs and returns without error. # Uses a very small number of iterations for speed # Doesn't test whether the results are correct. # Silence progress bars options(pROCProgress = list(name = "none")) for (stratified in c(TRUE, FALSE)) { for (test.roc in list(r.s100b, smooth(r.s100b))) { test_that("ci.se with default specificities", { n <- round(runif(1, 3, 9)) # keep boot.n small obtained <- ci.se(test.roc, boot.n = n, boot.stratified = stratified, conf.level = .91) expect_is(obtained, "ci.se") expect_is(obtained, "ci") expect_equal(dim(obtained), c(11, 3)) expect_equal(attr(obtained, "conf.level"), .91) expect_equal(attr(obtained, "boot.n"), n) expect_equal(colnames(obtained), c("4.5%", "50%", "95.5%")) expect_equal(attr(obtained, "boot.stratified"), stratified) }) test_that("ci.se accepts one specificity", { n <- round(runif(1, 3, 9)) # keep boot.n small obtained <- ci.se(test.roc, specificities = 0.9, boot.n = n, boot.stratified = stratified, conf.level = .91) expect_is(obtained, "ci.se") expect_is(obtained, "ci") expect_equal(dim(obtained), c(1, 3)) expect_equal(attr(obtained, "conf.level"), .91) expect_equal(attr(obtained, "boot.n"), n) expect_equal(colnames(obtained), c("4.5%", "50%", "95.5%")) expect_equal(attr(obtained, "boot.stratified"), stratified) }) } } pROC/tests/testthat/helper-roc.utils-expected.R0000644000176200001440000000444613772575475021236 0ustar liggesusersexpected_roc.utils.calc.coords <- structure(c(-1, -2, -3, -4, 1, 0.5, 0.1, 0, 0, 0.5, 0.9, 1, 0.36283185840708, 0.5, 0.609734513274336, 0.63716814159292, 0, 36, 64.8, 72, 41, 20.5, 4.1, 0, 0, 20.5, 36.9, 41, 72, 36, 7.2, 0, NaN, 0.63716814159292, 0.63716814159292, 0.63716814159292, 0.36283185840708, 0.36283185840708, 0.36283185840708, NaN, 1, 0.5, 0.1, 0, 0, 0.5, 0.9, 1, 1, 0.5, 0.1, 0, 0, 0.5, 0.9, 1, 0.63716814159292, 0.63716814159292, 0.63716814159292, NaN, 1, 0.5, 0.1, 0, 0, 0.5, 0.9, 1, 0.63716814159292, 0.5, 0.390265486725664, 0.36283185840708, NaN, 0.36283185840708, 0.36283185840708, 0.36283185840708, 0.63716814159292, 0.63716814159292, 0.63716814159292, NaN, 0.36283185840708, 0.36283185840708, 0.36283185840708, NaN, 1, 0.5, 0.1, 0, 1, 0.50462962962963, 0.108333333333333, 0.00925925925925926, 0.00925925925925926, 0.252314814814815, 0.810092592592593, 1), .Dim = c(4L, 24L), .Dimnames = list( NULL, c("threshold", "sensitivity", "specificity", "accuracy", "tn", "tp", "fn", "fp", "npv", "ppv", "tpr", "tnr", "fpr", "fnr", "fdr", "1-specificity", "1-sensitivity", "1-accuracy", "1-npv", "1-ppv", "precision", "recall", "youden", "closest.topleft" ))) expected_roc.utils.calc.coords.percent <- structure(c(-1, -2, -3, -4, 100, 50, 10, 0, 0, 50, 90, 100, 36.283185840708, 50, 60.9734513274336, 63.716814159292, 0, 36, 64.8, 72, 41, 20.5, 4.1, 0, 0, 20.5, 36.9, 41, 72, 36, 7.2, 0, NaN, 63.716814159292, 63.716814159292, 63.716814159292, 36.283185840708, 36.283185840708, 36.283185840708, NaN, 100, 50, 10, 0, 0, 50, 90, 100, 100, 50, 10, 0, 0, 50, 90, 100, 63.716814159292, 63.716814159292, 63.716814159292, NaN, 100, 50, 10, 0, 0, 50, 90, 100, 63.716814159292, 50, 39.0265486725664, 36.283185840708, NaN, 36.283185840708, 36.283185840708, 36.283185840708, 63.716814159292, 63.716814159292, 63.716814159292, NaN, 36.283185840708, 36.283185840708, 36.283185840708, NaN, 100, 50, 10, 0, 100, 50.462962962963, 10.8333333333333, 0.925925925925926, 0.925925925925926, 25.2314814814815, 81.0092592592593, 100), .Dim = c(4L, 24L), .Dimnames = list(NULL, c("threshold", "sensitivity", "specificity", "accuracy", "tn", "tp", "fn", "fp", "npv", "ppv", "tpr", "tnr", "fpr", "fnr", "fdr", "1-specificity", "1-sensitivity", "1-accuracy", "1-npv", "1-ppv", "precision", "recall", "youden", "closest.topleft" )))pROC/tests/figs/0000755000176200001440000000000014114130125013137 5ustar liggesuserspROC/tests/figs/plot/0000755000176200001440000000000014114130125014115 5ustar liggesuserspROC/tests/figs/plot/advanced-screenshot-3.svg0000644000176200001440000007062414114130125020727 0ustar liggesusers Smoothing Specificity (%) Sensitivity (%) 100 80 60 40 20 0 0 20 40 60 80 100 Empirical Binormal Density Fitdistr (Log-normal) pROC/tests/figs/plot/advanced-screenshot-4.svg0000644000176200001440000003535214114130125020727 0ustar liggesusers Confidence intervals of specificity/sensitivity Specificity (%) Sensitivity (%) 100 80 60 40 20 0 0 20 40 60 80 100 pROC/tests/figs/plot/advanced-screenshot-5.svg0000644000176200001440000001472514114130125020731 0ustar liggesusers Confidence interval of a threshold Specificity (%) Sensitivity (%) 100 80 60 40 20 0 0 20 40 60 80 100 0.2 (80.6%, 63.4%) pROC/tests/figs/plot/legacy-axes.svg0000644000176200001440000001211314114130125017036 0ustar liggesusers 1 - Specificity Sensitivity 0.0 0.2 0.4 0.6 0.8 1.0 0.0 0.2 0.4 0.6 0.8 1.0 pROC/tests/figs/plot/plot-formula.svg0000644000176200001440000001723214114130125017264 0ustar liggesusers Specificity Sensitivity 1.0 0.8 0.6 0.4 0.2 0.0 0.0 0.2 0.4 0.6 0.8 1.0 pROC/tests/figs/plot/advanced-screenshot-6.svg0000644000176200001440000001775614114130125020741 0ustar liggesusers Statistical comparison Specificity (%) Sensitivity (%) 100 80 60 40 20 0 0 20 40 60 80 100 p-value = 0.1643 S100B NDKA pROC/tests/figs/plot/basic-s100b.svg0000644000176200001440000001210714114130125016543 0ustar liggesusers Specificity Sensitivity 1.0 0.8 0.6 0.4 0.2 0.0 0.0 0.2 0.4 0.6 0.8 1.0 pROC/tests/figs/plot/basic-wfns.svg0000644000176200001440000001072514114130125016677 0ustar liggesusers Specificity Sensitivity 1.0 0.8 0.6 0.4 0.2 0.0 0.0 0.2 0.4 0.6 0.8 1.0 pROC/tests/figs/plot/advanced-screenshot-1.svg0000644000176200001440000001635014114130125020721 0ustar liggesusers Partial AUC (pAUC) Specificity (%) Sensitivity (%) 100 80 60 40 20 0 0 20 40 60 80 100 Corrected pAUC (100-90% SP): 64.6% Corrected pAUC (100-90% SE): 54.6% pROC/tests/figs/plot/advanced-screenshot-2.svg0000644000176200001440000002011714114130125020716 0ustar liggesusers Confidence intervals Specificity (%) Sensitivity (%) 100 80 60 40 20 0 0 20 40 60 80 100 AUC: 73.1% (63.0%–83.3%) AUC: 73.1% (63.0%–83.3%) pROC/tests/figs/plot/basic-ndka.svg0000644000176200001440000001356614114130125016645 0ustar liggesusers Specificity Sensitivity 1.0 0.8 0.6 0.4 0.2 0.0 0.0 0.2 0.4 0.6 0.8 1.0 pROC/tests/figs/deps.txt0000644000176200001440000000010314114130125014625 0ustar liggesusers- vdiffr-svg-engine: 1.0 - vdiffr: 0.3.1 - freetypeharfbuzz: 0.2.5 pROC/tests/figs/ggroc/0000755000176200001440000000000014114130125014240 5ustar liggesuserspROC/tests/figs/ggroc/ggroc-screenshot.svg0000644000176200001440000002222513607143106020251 0ustar liggesusers 0 25 50 75 100 0 25 50 75 100 specificity sensitivity pROC/tests/figs/ggroc/ggroc-list-multi-aes.svg0000644000176200001440000003212014114130125020727 0ustar liggesusers 0.00 0.25 0.50 0.75 1.00 0.00 0.25 0.50 0.75 1.00 specificity sensitivity name s100b wfns ndka pROC/tests/figs/ggroc/ggroc-list-group-facet-screenshot.svg0000644000176200001440000005764513607143106023452 0ustar liggesusers s100b wfns ndka 0.00 0.25 0.50 0.75 1.00 0.00 0.25 0.50 0.75 1.00 0.00 0.25 0.50 0.75 1.00 0.00 0.25 0.50 0.75 1.00 specificity sensitivity pROC/tests/figs/ggroc/ggroc-smooth-list-screenshot.svg0000644000176200001440000007625614114130125022535 0ustar liggesusers 0.00 0.25 0.50 0.75 1.00 0.00 0.25 0.50 0.75 1.00 specificity sensitivity name s100b wfns ndka pROC/tests/figs/ggroc/ggroc-smooth-screenshot.svg0000644000176200001440000003646714114130125021564 0ustar liggesusers 0.00 0.25 0.50 0.75 1.00 0.00 0.25 0.50 0.75 1.00 specificity sensitivity pROC/tests/figs/ggroc/ggroc-list-screenshot.svg0000644000176200001440000003172214114130125021213 0ustar liggesusers 0.00 0.25 0.50 0.75 1.00 0.00 0.25 0.50 0.75 1.00 specificity sensitivity name s100b wfns ndka pROC/tests/figs/ggroc/ggroc-list-extra-aes-screenshot.svg0000644000176200001440000003210614114130125023077 0ustar liggesusers 0.00 0.25 0.50 0.75 1.00 0.00 0.25 0.50 0.75 1.00 specificity sensitivity name s100b wfns ndka pROC/tests/figs/ggroc/ggroc-list-scale-colour-manual.svg0000644000176200001440000003210614114130125022676 0ustar liggesusers 0.00 0.25 0.50 0.75 1.00 0.00 0.25 0.50 0.75 1.00 specificity sensitivity name s100b wfns ndka pROC/tests/testthat.R0000644000176200001440000000030413607143106014200 0ustar liggesuserslibrary(testthat) library(pROC) data(aSAH) # Set environment variable RUN_SLOW_TESTS to run the slower tests run_slow_tests <- identical(Sys.getenv("RUN_SLOW_TESTS"), "true") test_check("pROC") pROC/src/0000755000176200001440000000000014114132432011637 5ustar liggesuserspROC/src/perfsAll.cpp0000644000176200001440000000432113607143106014121 0ustar liggesusers/* pROC: Tools Receiver operating characteristic (ROC curves) with (partial) area under the curve, confidence intervals and comparison. Copyright (C) 2014 Xavier Robin This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . */ #include using namespace Rcpp; // [[Rcpp::export]] List rocUtilsPerfsAllC(NumericVector thresholds, NumericVector controls, NumericVector cases, std::string direction) { NumericVector se(thresholds.size()); NumericVector sp(thresholds.size()); long tp, tn; long i; // iterator over cases & controls if (direction == ">") { for (long t = 0; t < thresholds.size(); t++) { if (t % 100 == 0) Rcpp::checkUserInterrupt(); double threshold = thresholds(t); tp = 0; for (i = 0; i < cases.size(); i++) { if (cases(i) <= threshold) { tp++; } } se(t) = (double)tp / cases.size(); tn = 0; for (i = 0; i < controls.size(); i++) { if (controls(i) > threshold) { tn++; } } sp(t) = (double)tn / controls.size(); } } else { for (long t = 0; t < thresholds.size(); t++) { if (t % 100 == 0) Rcpp::checkUserInterrupt(); double threshold = thresholds(t); tp = 0; for (i = 0; i < cases.size(); i++) { if (cases(i) >= threshold) { tp++; } } se(t) = (double)tp / cases.size(); long tn = 0; for (i = 0; i < controls.size(); i++) { if (controls(i) < threshold) { tn++; } } sp(t) = (double)tn / controls.size(); } } List ret; ret["se"] = se; ret["sp"] = sp; return(ret); } pROC/src/RcppVersion.cpp0000644000176200001440000000166713607143106014635 0ustar liggesusers/* pROC: Tools Receiver operating characteristic (ROC curves) with (partial) area under the curve, confidence intervals and comparison. Copyright (C) 2016 Xavier Robin, Stefan Siegert This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . */ #include using namespace Rcpp; // [[Rcpp::export]] String RcppVersion() { return RCPP_VERSION; } pROC/src/delong.cpp0000644000176200001440000000704513607143106013627 0ustar liggesusers/* pROC: Tools Receiver operating characteristic (ROC curves) with (partial) area under the curve, confidence intervals and comparison. Copyright (C) 2016 Xavier Robin, Stefan Siegert This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . */ #include using namespace Rcpp; bool _cmp(std::pair l, std::pair r) { return l.second < r.second; } // [[Rcpp::export]] List delongPlacementsCpp(List roc) { int i, j, k, m, n, mdupl, ndupl, L; std::vector cases = roc["cases"]; std::vector controls = roc["controls"]; std::string direction = roc["direction"]; m = cases.size(); n = controls.size(); L = m + n; // For direction ">" we must reverse the data if (direction == ">") { for (i = 0; i < m; i++) { cases[i] = -cases[i]; } for (i = 0; i < n; i++) { controls[i] = -controls[i]; } } // concatenate cases and controls into a vector of L pairs of the form // (index, value), also save class labels (1 for cases, 0 for controls) std::vector< std::pair > Z; std::vector< bool > labels; for (i = 0; i < m; i++) { Z.push_back(std::pair(i, cases.at(i))); labels.push_back(true); } Rcpp::checkUserInterrupt(); for (j = 0; j < n; j++) { Z.push_back(std::pair(m+j, controls.at(j))); labels.push_back(false); } Rcpp::checkUserInterrupt(); // sort Z from smallest to largest value, so Z holds the order indices and // order statistics of all classifiers std::sort(Z.begin(), Z.end(), _cmp); Rcpp::checkUserInterrupt(); // the following calculates the "Delong-placements" X and Y in a single pass // over the vector Z, instead of having to double loop over all pairs of // (X_i, Y_j) std::vector< double > XY(L, 0.0); // vector to hold the unnormalised X and Y values std::vector< int > X_inds, Y_inds; // temporary vectors to save indices of duplicates m = n = i = 0; // initialisation while (i < L) { X_inds.clear(); Y_inds.clear(); mdupl = ndupl = 0; if (i % 10000 == 0) Rcpp::checkUserInterrupt(); while(1) { j = Z.at(i).first; if (labels.at(j)) { mdupl++; X_inds.push_back(j); } else { ndupl++; Y_inds.push_back(j); } if (i == L-1) { break; } if (Z.at(i).second != Z.at(i+1).second) { break; } i++; } for (k = 0; k < mdupl; k++) { XY.at(X_inds.at(k)) = n + ndupl/2.0; } for (k = 0; k < ndupl; k++) { XY.at(Y_inds.at(k)) = m + mdupl/2.0; } n += ndupl; m += mdupl; i++; } double sum = 0.0; std::vector X, Y; Rcpp::checkUserInterrupt(); for (i = 0; i < L; i++) { if (labels.at(i)) { sum += XY.at(i); X.push_back(XY.at(i) / n); } else { Y.push_back(1.0 - XY.at(i) / m); } } List ret; ret["theta"] = sum / m / n; ret["X"] = X; ret["Y"] = Y; return(ret); } pROC/src/RcppExports.cpp0000644000176200001440000000371613607143106014651 0ustar liggesusers// Generated by using Rcpp::compileAttributes() -> do not edit by hand // Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 #include using namespace Rcpp; // RcppVersion String RcppVersion(); RcppExport SEXP _pROC_RcppVersion() { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; rcpp_result_gen = Rcpp::wrap(RcppVersion()); return rcpp_result_gen; END_RCPP } // delongPlacementsCpp List delongPlacementsCpp(List roc); RcppExport SEXP _pROC_delongPlacementsCpp(SEXP rocSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< List >::type roc(rocSEXP); rcpp_result_gen = Rcpp::wrap(delongPlacementsCpp(roc)); return rcpp_result_gen; END_RCPP } // rocUtilsPerfsAllC List rocUtilsPerfsAllC(NumericVector thresholds, NumericVector controls, NumericVector cases, std::string direction); RcppExport SEXP _pROC_rocUtilsPerfsAllC(SEXP thresholdsSEXP, SEXP controlsSEXP, SEXP casesSEXP, SEXP directionSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::RNGScope rcpp_rngScope_gen; Rcpp::traits::input_parameter< NumericVector >::type thresholds(thresholdsSEXP); Rcpp::traits::input_parameter< NumericVector >::type controls(controlsSEXP); Rcpp::traits::input_parameter< NumericVector >::type cases(casesSEXP); Rcpp::traits::input_parameter< std::string >::type direction(directionSEXP); rcpp_result_gen = Rcpp::wrap(rocUtilsPerfsAllC(thresholds, controls, cases, direction)); return rcpp_result_gen; END_RCPP } static const R_CallMethodDef CallEntries[] = { {"_pROC_RcppVersion", (DL_FUNC) &_pROC_RcppVersion, 0}, {"_pROC_delongPlacementsCpp", (DL_FUNC) &_pROC_delongPlacementsCpp, 1}, {"_pROC_rocUtilsPerfsAllC", (DL_FUNC) &_pROC_rocUtilsPerfsAllC, 4}, {NULL, NULL, 0} }; RcppExport void R_init_pROC(DllInfo *dll) { R_registerRoutines(dll, NULL, CallEntries, NULL, NULL); R_useDynamicSymbols(dll, FALSE); } pROC/NEWS0000644000176200001440000003146014114132412011551 0ustar liggesusers1.18.0 (2021-09-02): * Add CI of the estimate for 'roc.test' (DeLong, paired only for now) (code contributed by Zane Billings) (pr #95) * Fix documentation and alternative hypothesis for Venkatraman test (issue #92) 1.17.0.1 (2021-01-07): * Fix CRAN incoming checks as requested by CRAN 1.17.0 (2020-12-29) * Accept more values in 'input' of coords (issue #67) * Accept 'kappa' for the 'power.roc.test' of two ROC curves (issue #82) * The 'input' argument to 'coords' for 'smooth.roc' curves no longer has a default * The 'x' argument to 'coords' for 'smooth.roc' can now be set to 'all' (also the default) * Fix bootstrap roc.test and cov with 'smooth.roc' curves * The 'ggroc' function can now plot 'smooth.roc' curves (issue #86) * Remove warnings with 'warnPartialMatchDollar' option (issue #87) * Make tests depending on vdiffr conditional (issue #88) 1.16.2 (2020-03-19) * Skip test depending on Rcpp version 1.16.1 (2020-01-13) * Skip timing-dependent test failing occasionally on CRAN 1.16.0 (2020-01-12) * BACKWARD INCOMPATIBLE CHANGE: 'transpose' argument to 'coords' switched to FALSE by default (issue #54) * BACKWARD INCOMPATIBLE CHANGE: 'ci.coords' return value is now of list type and easier to use * Fix one-sided DeLong test for curves with 'direction=">"' (issue #64) * Fix an error in 'ci.coords' due to expected NA values in some coords (like "precision") (issue #65) * Ordrered predictors are converted to numeric in a more robust way (issue #63) * Cleaned up 'power.roc.test' code (issue #50) * Fix pairing with 'roc.formula' and warn if 'na.action' is not set to "na.pass" or "na.fail" (issue #68) * Fix 'ci.coords' not working with 'smooth.roc' curves 1.15.3 (2019-07-21) * Fix: previous version accidentally set transpose = FALSE, should only be for next major release 1.15.2 (2019-07-20) * Fix -Inf threshold in coords for curves with 'direction = ">"' (issue #60) * Restore lazy loading of the data and fix an 'R CMD check' warning "Variables with usage in documentation object 'aSAH' not in code" 1.15.1 (2019-07-17) * Fix erroneous error in 'ci.coords' with 'ret="threshold"' (issue #57) * Fix vdiffr unit tests with ggplot2 3.2.0 (issue #53) * Keep list order in 'ggroc' (issue #58) 1.15.0 (2019-06-01) * 'roc' now prints messages when autodetecting 'levels' and 'direction' by default. Turn off with 'quiet = TRUE' or set these values explicitly * Speedup with 'algorithm = 2' (issue #44) and in 'coords' (issue #52) * New 'algorithm = 6' (used by default) uses 'algorithm = 2' for numeric data, and 'algorithm = 3' for ordered vectors * New 'roc.data.frame' method and 'roc_' function for use in pipelines * 'coords' can now returns 'youden' and 'closest.topleft" values (issue #48) * New 'transpose' argument for 'coords', TRUE by default (issue #54) * Use text instead of Tcl/Tk progress bar by default (issue #51) * Fix 'method = "density"' smoothing when called directly from 'roc' (issue #49) * Renamed 'roc' argument 'n' to 'smooth.n' * Fixed 'are.paired' ignoring smoothing arguments of 'roc2' with 'return.paired.rocs' * New 'ret' option "all" in 'coords' (issue #47) * 'drop' in 'coords' now drops the dimension of 'ret' too (#issue 43) 1.14.0 (2019-03-12) * The 'multiclass.roc' function now accepts multivariate decision values (code contributed by Matthias Döring) * 'ggroc' supports multiple aesthetics (issue #42) * Make 'ggplot2' dependency optional * CSuggested packages can be installed interactively when required * Passing both 'cases' and 'controls' or 'response' and 'predictor' arguments is now an error * Many small bug fixes 1.13.0 (2018-09-23) * 'roc' now returns 'NaN' when predictor contains infinite values (issue #30) * Better handling of near-ties near +-Infinity and 0 * 'ggroc' supports aes="group" to allow curves with identical aesthetics 1.12.1 (2018-05-06) * Fix a regression causing the allocation of a very large vector (issue #29) 1.12.0 (2018-05-05) * Fix bug that crashed DeLong calculations when predictor had near-ties close to the floating point precision limit that were rounded back to a predictor value (issue #25) * Fix bug that crashed 'ci.auc' and 'var' if 'direction' was ">" and 'percent=TRUE' (issue #25) * Fix bug causing 'ci' to return 'NaN' values with 'method="delong"' when cases or controls had a single observation (issue #27) * Fix 'power.roc.curve' failed with curves having 'percent=TRUE' * Fix 'ci(..., of="coords")' returned the 'ci' function instead of the CI * C++ code now check for user interrupts regularly with Rcpp::checkUserInterrupt() * Better error message for 'ci.coords' attempting to return 'threshold' * New algorithm = 5 (used by default) chooses the algorithm based on the number of thresholds to avoid worst case with algorithm = 3 1.11.0 (2018-03-24) * Added argument 'legacy.axes' to 'ggroc' * Fix NOTE about 'apparent S3 methods exported but not registered' in 'R CMD check' 1.10.0 (2017-06-10) * Basic ggplot2 support (one and multiple ROC curves) * Implement 'precision' and 'recall' for 'coords' * Fix: properly handle NAs in cases when passing cases/controls to 'roc' (thanks Thomas König for the report) * Fix various minor bugs detected with new unit tests 1.9.1 (2017-02-05) * Fix: 'subset' and 'na.action' arguments now handled properly in 'roc.formula' (thanks Terry Therneau for the report) * Added policies to handle the case where a ROC curve has multiple "best" threshold in 'ci' (thanks Nicola Toschi for the report) * Support 'xlim' and 'ylim' gracefully in 'plot.roc' * Improved validation of input class 'levels' and 'direction'; messages when auto-detecting, use 'quiet' to turn on * Removed extraneous 'name' attribute on the 'p.value' (thanks Paweł Kleka for the report) * Faster DeLong algorithm (code contributed by Stefan Siegert) 1.8 (2015-05-04) * NAMESPACE now properly exports the methods as S3 methods. * Now uses and works with 'requireNamespace' * Add ability to supply two ordered factors with identical levels as control / cases * Deprecate dangerous use of a matrix as response / predictor with a warning * Forward 'best.method' and 'best.weights' arguments to 'coords' in 'ci.thresholds' * Fix CITATION file as per CRAN request * pAUC correction is undefined for partial AUC below the diagonal (result < 0.5) and now returns NA (with a warning). Thanks Vincenzo Lagani for the report. 1.7.3 (2014-06-14) * Fixed AUC of binomial-smoothed ROC off by 100^2 (thanks Bao-Li Chang for the report) * Fix print of logcondens-smoothed ROC 1.7.2 (2014-04-05) * Fixed bug where 'ci.coords' with 'x="best"' would fail if one or more resampled ROC curve had multiple "best" thresholds * Fixed bug in 'ci.coords': passing more than one value in 'x' now works * Fixed typo in documentation of 'direction' argument to 'roc' (thanks Le Kang for the report) * Add a warning when computing statistics of ROC curve with AUC = 1 * Require latest version of Rcpp to avoid weird errors (thanks Tom Liptrot for the report) 1.7.1 (2014-02-20) * Close SOCK cluster on Windows with parallel=TRUE * Fixed really use algorithm 1 when microbenchmark fails 1.7 (2014-02-19) * Faster algorithm for DeLong 'roc.test', 'power.roc.test', 'ci.auc', 'var' and 'cov' function (no large matrix allocation) * Handling Math and Operations correctly on 'auc' and 'ci' objects (see '?groupGeneric.pROC') * The 'formula' for 'roc.formula' can now provide several predictors and a list of ROC curves will be returned * Fixed documentation of 'ci.coords' with examples * Fixed binormal AUC computed with triangulation despite the claim in the documentation * Fixed unstated requirement on Rcpp >= 0.10.5 1.6.0.1 (2013-12-28) * Removed erroneous error message displayed when predictors and responses were not vectors 1.6 (2013-12-26) * New 'power.roc.test' function for sample size and power computations * New 'cov' and 'var' functions supports new "obuchowski" method * New 'ci.coords' function to compute CI of arbitrary coords * 'coords' accepts new 'ret' value "1-accuracy" * Introducing various algorithms to compute sensitivities and specificites, with a more vectorized code or Rcpp. See 'algorithm' in ?roc for more details on the trade-offs of the different methods. * Faster algorithm for DeLong 'roc.test', 'ci', 'var' and 'cov' function (thanks Kazuki Yoshida). * 'are.paired' now also checks for identical 'levels' * Fixed a warning generated in the examples * Fixed several bugs related with 'smooth.roc' curves * Additional input data sanity checks * Now requires R >= 2.13 (in fact, since 1.5.1, thanks Emmanuel Curis for the report) * Progress bars now defaults to text on Macs where 'tcltk' seems broken (thanks Gerard Smits for the report) 1.5.4 (2012-08-31) * Running less smooth.roc examples with logcondens because they take too much time (requested by Uwe Ligges) 1.5.3 (2012-08-31) * AUC specification was lost when roc.test, cov or var was passed an 'auc' object. * Correct computation of "accuracy" in 'coords' (thanks to Kosuke Yoshihara for the report) 1.5.1 (2012-03-09) * Faster loading of the package (thanks to Prof Brian Ripley and Glenn Lawyer for the report) 1.5 (2011-12-11) * New 'cov' and 'var' functions * 'coords' accepts new 'ret' values: "accuracy", "tn", "tp", "fn", "fp", "npv", "ppv", "1-specificity", "1-sensitivity", "1-npv", "1-ppv", "npe" and "ppe" * New 'legacy.axes' argument to 'plot' 1-specificity rather than specificity * New 'axes' argument to turn off the plotting of the axis * New 'logcondens' and 'logcondens.smooth' (Univariate Log-Concave Density Estimation) smoothing methods * New function 'has.partial.auc' to determine if an AUC is full or partial * New argument 'drop' for 'coords' * 'auc' and 'multiclass.auc' objects now also have secondary class 'numeric' * Updated load call * Delong's CI reversed in ROC curves with direction=">" * Delong's CI AUC returned values > 1 or < 0 in some rare cases * Minor improvements in documentation 1.4.4 (2011-08-09) * Fixed alternative for one-tailed tests (thanks to Lisa Koch for the report) * Removed COPYING file to fix a warning in r-devel. 1.4.3 (2011-03-17) * Updated citation 1.4.2 (2011-03-03) * Fixed bootstrap 'roc.test' generating NAs when 'smooth.roc's were used with 'reuse.auc=FALSE' (thanks to Buddy for the report) * Documented a warning that was missing in roc.test * Updated citation 1.4.1 (2011-01-27) * 'venkatraman''s test for unpaired ROC curves 1.4 (2011-01-21) * 'smooth' does not apply on 'ordered' factors anymore * Multi-class AUC support * Can choose how 'best' thresold is determined ('best.method' and 'best.weights' in 'coords' and 'print.thres.best.method' and 'print.thres.best.weights' in 'plot.roc') * Minor fixes in documentation * 'print' now prints the response instead of "response" and more informative data in 'htest's * Bootstrap with 'ci.auc' consumes much less memory * Unpaired bootstrap and DeLong's test * Specificity and sensitivity tests (in 'roc.test') 1.3.2 (2010-08-24) * 'print.auc' printed incorrect CI in 'plot.roc' (thanks to Alexander B. Leichtle for the report) * Failed to detect local maximas in 'coords' when 2 or less points were selected * Don't consider ROC extremities (+-Inf at 1.0/0.0 SE<->SP) as local maximas 1.3.1 (2010-08-18) * Sensitivity and specificity were inverted in coords when results were reported as list * Faster checks with '\dontrun{}' in 'roc.test' 1.3 (2010-08-13) * '...' not passed correctly in 'plot.ci.se' with 'type="bars"' resulting in an error * CI is not re-computed by default in 'smooth.roc'. You can still turn it on with 'reuse.ci=TRUE' * New function 'are.paired' * Local maximas could be incorrectly detected in 'coords' (and 'plot.roc') with 'predictor's containing more than 2 levels. * New method 'venkatraman' for 'roc.test' * MASS and tcltk packages are now only suggested instead of required 1.2.1 (2010-05-11) * Handle 'method' arguments for 'smooth.roc' and 'ci.auc' separately in 'roc.default' * Added 'auc.polygon.*' and 'max.auc.polygon.*' arguments for 'polygon' in 'plot.roc' 1.2 (2010-05-09) * Added DeLong method in 'ci.auc' * Return value of 'ci.auc' does not contain an 'aucs' item anymore * Put most examples with bootstrap within '\dontrun{}' blocks for faster (but less useful) checks execution 1.1 (2010-05-05) * Added 'lines.roc' functions for ROC * Added 'type' argument for both 'lines.roc' and 'plot.roc' * Added 'print.auc.col' argument to 'plot.roc' * Fixed a warning in 'roc.test.default' when the class of 'predictor1' had several elements * Fixed an encoding failure during the checks on MacOS X 1.0.1 (2010-04-28) * Reduced examples execution time. Added low 'boot.n' in the slowest examples and 'reuse.auc' and 'reuse.ci' arguments in smooth.roc.roc 1.0 (2010-04-27) * First public release pROC/R/0000755000176200001440000000000014114130125011246 5ustar liggesuserspROC/R/print.R0000644000176200001440000002456313607143106012550 0ustar liggesusers# pROC: Tools Receiver operating characteristic (ROC curves) with # (partial) area under the curve, confidence intervals and comparison. # Copyright (C) 2010-2014 Xavier Robin, Alexandre Hainard, Natacha Turck, # Natalia Tiberti, Frédérique Lisacek, Jean-Charles Sanchez # and Markus Müller # # This program is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, either version 3 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program. If not, see . print.smooth.roc <- function(x, digits=max(3, getOption("digits") - 3), call=TRUE, ...) { # do we print the call? if (call) cat("\nCall:\n", deparse(x$call), "\n\n", sep="") # Always print number of patients, controls, thresholds, levels? print.dataline(attr(x, "roc")) # take this from original roc # Smoothing cat("Smoothing: ") if (is.null(x$smoothing.args)) { cat("density with controls: ", as.character(x$call[match("density.controls", names(x$call))]), "; and cases: ", as.character(x$call[match("density.cases", names(x$call))]), "\n", sep="") } else if (x$smoothing.args$method == "density") cat("density (bandwidth: ", x$smoothing.args$bw, "; adjust: ", ifelse(is.null(x$smoothing.args$adjust), 1, x$smoothing.args$adjust), ")\n", sep="") else if (x$smoothing.args$method == "density") { cat("fitting ", x$fit.controls$densfun, " distribution for controls:\n", sep="") print(x$fit.controls$estimate) cat("fitting ", x$fit.cases$densfun, " distribution for cases:\n", sep="") print(x$fit.cases$estimate) } else cat(x$smoothing.args$method, "\n") # AUC if exists if (!is.null(x$auc)) { print(x$auc, digits=digits, ...) } else cat("Area under the curve not computed.\n") # CI if exists, print it if(!is.null(x$ci)) { print(x$ci, digits=digits, ...) } invisible(x) } print.multiclass.roc <- function(x, digits=max(3, getOption("digits") - 3), call=TRUE, ...) { # do we print the call? if (call) cat("\nCall:\n", deparse(x$call), "\n\n", sep="") # get predictor name if ("predictor" %in% names(x$call)) predictor.name <- as.character(x$call[match("predictor", names(x$call))]) else if (!is.null(x$call$formula)) predictor.name <- attr(terms(as.formula(x$call$formula), data=x$data), "term.labels") # Get response if ("response" %in% names(x$call)) response.name <- as.character(x$call[match("response", names(x$call))]) else if (!is.null(x$call$formula)) { formula.attrs <- attributes(terms(as.formula(x$call$formula), data=x$data)) response.name <- rownames(formula.attrs$factors)[formula.attrs$response] } cat("Data: ", predictor.name, " with ", length(x$levels), " levels of ", response.name, ": ", paste(x$levels, collapse=", "), ".\n", sep="") # AUC if exists if (!is.null(x$auc)) { print(x$auc, digits=digits, ...) } else cat("Multi-class area under the curve not computed.\n") # CI if exists, print it if(!is.null(x$ci)) { print(x$ci, digits=digits, ...) } invisible(x) } print.mv.multiclass.roc <- function(x, digits=max(3, getOption("digits") - 3), call=TRUE, ...) { # do we print the call? if (call) cat("\nCall:\n", deparse(x$call), "\n\n", sep="") # get predictor name if ("predictor" %in% names(x$call)) predictor.name <- as.character(x$call[match("predictor", names(x$call))]) else if (!is.null(x$call$formula)) predictor.name <- attr(terms(as.formula(x$call$formula), data=x$data), "term.labels") # Get response if ("response" %in% names(x$call)) response.name <- as.character(x$call[match("response", names(x$call))]) else if (!is.null(x$call$formula)) { formula.attrs <- attributes(terms(as.formula(x$call$formula), data=x$data)) response.name <- rownames(formula.attrs$factors)[formula.attrs$response] } cat("Data: multivariate predictor ", predictor.name, " with ", length(x$levels), " levels of ", response.name, ": ", paste(x$levels, collapse=", "), ".\n", sep="") # AUC if exists if (!is.null(x$auc)) { print(x$auc, digits=digits, ...) } else cat("Multi-class area under the curve not computed.\n") # CI if exists, print it if(!is.null(x$ci)) { print(x$ci, digits=digits, ...) } invisible(x) } print.roc <- function(x, digits=max(3, getOption("digits") - 3), call=TRUE, ...) { # do we print the call? if (call) cat("\nCall:\n", deparse(x$call), "\n\n", sep="") # Always print number of patients, controls, thresholds, levels? print.dataline(x) # AUC if exists if (!is.null(x$auc)) { print(x$auc, digits=digits, ...) } else cat("Area under the curve not computed.\n") # CI if exists, print it if(!is.null(x$ci)) { print(x$ci, digits=digits, ...) } invisible(x) } print.auc <- function(x, digits=max(3, getOption("digits") - 3), ...) { if (identical(attr(x, "partial.auc"), FALSE)) cat("Area under the curve: ", signif(x, digits=digits), ifelse(attr(x, "percent"), "%", ""), "\n", sep="") else { cat(ifelse(identical(attr(x, "partial.auc.correct"), TRUE), "Corrected p", "P"), "artial area under the curve", sep="") cat(" (", attr(x, "partial.auc.focus"), " ", attr(x, "partial.auc")[1], ifelse(attr(x, "percent"), "%", ""), "-", attr(x, "partial.auc")[2], ifelse(attr(x, "percent"), "%", ""), ")", sep="") cat(": ", signif(x, digits=digits), ifelse(attr(x, "percent"), "%", ""), "\n", sep="") } invisible(x) } print.multiclass.auc <- function(x, digits=max(3, getOption("digits") - 3), ...) { if (identical(attr(x, "partial.auc"), FALSE)) cat("Multi-class area under the curve: ", signif(x, digits=digits), ifelse(attr(x, "percent"), "%", ""), "\n", sep="") else { cat("Multi-class ", ifelse(identical(attr(x, "partial.auc.correct"), TRUE), "corrected ", ""), "partial area under the curve", sep="") cat(" (", attr(x, "partial.auc.focus"), " ", attr(x, "partial.auc")[1], ifelse(attr(x, "percent"), "%", ""), "-", attr(x, "partial.auc")[2], ifelse(attr(x, "percent"), "%", ""), ")", sep="") cat(": ", signif(x, digits=digits), ifelse(attr(x, "percent"), "%", ""), "\n", sep="") } invisible(x) } print.mv.multiclass.auc <- print.multiclass.auc print.ci.auc <- function(x, digits=max(3, getOption("digits") - 3), ...) { signif.ci <- signif(x, digits=digits) cat(attr(x, "conf.level")*100, "% CI: ", sep="") cat(signif.ci[1], ifelse(attr(attr(x, "auc"), "percent"), "%", ""), "-", signif.ci[3], ifelse(attr(attr(x, "auc"), "percent"), "%", ""), sep="") if (attr(x, "method") == "delong") cat(" (DeLong)\n", sep="") else cat(" (", attr(x, "boot.n"), " ", ifelse(attr(x, "boot.stratified"), "stratified", "non-stratified"), " bootstrap replicates)\n", sep="") invisible(x) } print.ci.thresholds <- function(x, digits=max(3, getOption("digits") - 3), ...) { cat(attr(x, "conf.level")*100, "% CI", sep="") cat(" (", attr(x, "boot.n"), " ", ifelse(attr(x, "boot.stratified"), "stratified", "non-stratified"), " bootstrap replicates):\n", sep="") signif.sp <- signif(x$sp, digits=digits) signif.se <- signif(x$se, digits=digits) print(data.frame(thresholds=attr(x, "thresholds"), sp.low=signif.sp[,1], sp.median=signif.sp[,2], sp.high=signif.sp[,3], se.low=signif.se[,1], se.median=signif.se[,2], se.high=signif.se[,3]), row.names=FALSE) invisible(x) } print.ci.sp <- function(x, digits=max(3, getOption("digits") - 3), ...) { cat(attr(x, "conf.level")*100, "% CI", sep="") cat(" (", attr(x, "boot.n"), " ", ifelse(attr(x, "boot.stratified"), "stratified", "non-stratified"), " bootstrap replicates):\n", sep="") signif.sp <- signif(x, digits=digits) print(data.frame(se=attr(x, "sensitivities"), sp.low=signif.sp[,1], sp.median=signif.sp[,2], sp.high=signif.sp[,3]), row.names=FALSE) invisible(x) } print.ci.se <- function(x, digits=max(3, getOption("digits") - 3), ...) { cat(attr(x, "conf.level")*100, "% CI", sep="") cat(" (", attr(x, "boot.n"), " ", ifelse(attr(x, "boot.stratified"), "stratified", "non-stratified"), " bootstrap replicates):\n", sep="") signif.se <- signif(x, digits=digits) print(data.frame(sp=attr(x, "specificities"), se.low=signif.se[,1], se.median=signif.se[,2], se.high=signif.se[,3]), row.names=FALSE) invisible(x) } print.ci.coords <- function(x, digits=max(3, getOption("digits") - 3), ...) { cat(attr(x, "conf.level")*100, "% CI", sep="") cat(" (", attr(x, "boot.n"), " ", ifelse(attr(x, "boot.stratified"), "stratified", "non-stratified"), " bootstrap replicates):\n", sep="") table <- do.call(cbind, x) table <- signif(table, digits = digits) table <- cbind(x = attr(x, "x"), as.data.frame(table)) colnames.grid <- expand.grid(c("low", "median", "high"), attr(x, "ret")) colnames.vec <- paste(colnames.grid$Var2, colnames.grid$Var1, sep=".") colnames(table) <- c(attr(x, "input"), colnames.vec) rownames(table) <- attr(x, "x") print(table, row.names=length(attr(x, "ret")) > 1) invisible(x) } print.dataline <- function(x) { # Case / Controls call if ("cases" %in% names(x$call) && "controls" %in% names(x$call)) { cat("Data: ", length(x$controls), " controls ", x$direction, " ", length(x$cases), " cases.\n", sep="") } else { # get predictor name if ("predictor" %in% names(x$call)) predictor.name <- as.character(x$call[match("predictor", names(x$call))]) else if (!is.null(x$call$formula)) predictor.name <- attr(terms(as.formula(x$call$formula), data=x$data), "term.labels") else return() # Get response if ("response" %in% names(x$call)) response.name <- as.character(x$call[match("response", names(x$call))]) else if (!is.null(x$call$formula)) { formula.attrs <- attributes(terms(as.formula(x$call$formula), data=x$data)) response.name <- rownames(formula.attrs$factors)[formula.attrs$response] } else if ("x" %in% names(x$call)) response.name <- as.character(x$call[match("x", names(x$call))]) else return() cat("Data: ", predictor.name, " in ", length(x$controls), " controls (", response.name, " ", x$levels[1], ") ", x$direction, " ", length(x$cases), " cases (", response.name, " ", x$levels[2], ").\n", sep="") } } pROC/R/lines.roc.R0000644000176200001440000000374114114130125013272 0ustar liggesusers# pROC: Tools Receiver operating characteristic (ROC curves) with # (partial) area under the curve, confidence intervals and comparison. # Copyright (C) 2010-2014 Xavier Robin, Alexandre Hainard, Natacha Turck, # Natalia Tiberti, Frédérique Lisacek, Jean-Charles Sanchez # and Markus Müller # # This program is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, either version 3 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program. If not, see . lines.roc <- function(x, ...) { UseMethod("lines.roc") } lines.roc.formula <- function(x, data, subset, na.action, ...) { data.missing <- missing(data) call <- match.call() names(call)[2] <- "formula" # forced to be x by definition of lines roc.data <- roc.utils.extract.formula(formula=x, data, subset, na.action, ..., data.missing = data.missing, call = call) if (length(roc.data$predictor.name) > 1) { stop("Only one predictor supported in 'lines.roc'.") } response <- roc.data$response predictor <- roc.data$predictors[, 1] roc <- roc(response, predictor, ...) lines.roc.roc(roc, ...) roc$call <- match.call() invisible(roc) } lines.roc.default <- function(x, predictor, ...) { roc <- roc(x, predictor, ...) lines.roc.roc(roc, ...) roc$call <- match.call() invisible(roc) } lines.roc.smooth.roc <- lines.smooth.roc <- function(x, ...) { lines.roc.roc(x, ...) # force usage of lines.roc.roc } lines.roc.roc <- function(x, lwd=2, ...) { suppressWarnings(lines(x$specificities, x$sensitivities, lwd=lwd, ...)) invisible(x) } pROC/R/groupGeneric.R0000644000176200001440000000314613607143106014037 0ustar liggesusers# pROC: Tools Receiver operating characteristic (ROC curves) with # (partial) area under the curve, confidence intervals and comparison. # Copyright (C) 2014 Xavier Robin # # This program is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, either version 3 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program. If not, see . Ops.auc <- function(e1, e2) { if (methods::is(e1, "auc")) attributes(e1) <- NULL if (methods::is(e2, "auc")) attributes(e2) <- NULL NextMethod() } Math.auc <- function(x, ...) { attributes(x) <- NULL NextMethod() } Ops.ci.se <- Ops.ci.sp <- Ops.ci.auc <- function(e1, e2) { e1 <- remove.ci.attributes(e1) e2 <- remove.ci.attributes(e2) NextMethod() } Math.ci.se <- Math.ci.sp <- Math.ci.auc <- function(x, ...) { x <- remove.ci.attributes(x) NextMethod() } remove.ci.attributes <- function(ci) { attr(ci, "conf.level") <- NULL attr(ci, "boot.n") <- NULL attr(ci, "boot.stratified") <- NULL attr(ci, "specificities") <- NULL attr(ci, "sensitivities") <- NULL attr(ci, "roc") <- NULL attr(ci, "method") <- NULL attr(ci, "auc") <- NULL class(ci) <- class(ci)[-(1:2)] return(ci) } pROC/R/roc.test.R0000644000176200001440000004207714114130125013144 0ustar liggesusers# pROC: Tools Receiver operating characteristic (ROC curves) with # (partial) area under the curve, confidence intervals and comparison. # Copyright (C) 2010-2014 Xavier Robin, Alexandre Hainard, Natacha Turck, # Natalia Tiberti, Frédérique Lisacek, Jean-Charles Sanchez # and Markus Müller # # This program is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, either version 3 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program. If not, see . roc.test <- function(...) { UseMethod("roc.test") } roc.test.formula <- function (formula, data, ...) { data.missing <- missing(data) call <- match.call() roc.data <- roc.utils.extract.formula(formula, data, ..., data.missing = data.missing, call = call) if (length(roc.data$predictor.name) != 2) { stop("Invalid formula: exactly 2 predictors are required in a formula of type response~predictor1+predictor2.") } response <- roc.data$response predictors <- roc.data$predictors testres <- roc.test.default(response, predictors, ...) testres$call <- call # data.names for pretty print()ing if (data.missing) { testres$data.names <- sprintf("%s and %s by %s (%s, %s)", roc.data$predictor.names[1], roc.data$predictor.names[2], roc.data$response.name, testres$roc1$levels[1], testres$roc1$levels[2]) } else { testres$data.names <- sprintf("%s and %s in %s by %s (%s, %s)", roc.data$predictor.names[1], roc.data$predictor.names[2], deparse(substitute(data)), roc.data$response.name, testres$roc1$levels[1], testres$roc1$levels[2]) } return(testres) } roc.test.default <- function(response, predictor1, predictor2=NULL, na.rm=TRUE, method=NULL, ...) { if (is.matrix(predictor1) | is.data.frame(predictor1)) { if (!is.null(predictor2)) stop("Predictor2 must not be specified if predictor1 is a matrix or a data.frame.") if (dim(predictor1)[2] == 2 & length(response) == dim(predictor1)[1]) { roc1 <- roc(response, predictor1[,1], ...) roc2 <- roc(response, predictor1[,2], ...) if (!is.null(names(predictor1))) data.names <- sprintf("%s and %s in %s by %s (%s, %s)", names(predictor1)[1], names(predictor1)[2], deparse(substitute(predictor1)), deparse(substitute(response)), roc1$levels[1], roc1$levels[2]) else if (!is.null(colnames(predictor1))) data.names <- sprintf("%s and %s in %s by %s (%s, %s)", colnames(predictor1)[1], colnames(predictor1)[2], deparse(substitute(predictor1)), deparse(substitute(response)), roc1$levels[1], roc1$levels[2]) else data.names <- sprintf("%s by %s (%s, %s)", deparse(substitute(predictor1)), deparse(substitute(response)), roc1$levels[1], roc1$levels[2]) } else { stop("Wrong dimension for predictor1 as a matrix or a data.frame.") } } else { if (missing(predictor2)) stop("Missing argument predictor2 with predictor1 as a vector.") # Need to remove NAs if (na.rm) { nas <- is.na(response) | is.na(predictor1) | is.na(predictor2) response <- response[!nas] predictor1 <- predictor1[!nas] predictor2 <- predictor2[!nas] } roc1 <- roc(response, predictor1, ...) roc2 <- roc(response, predictor2, ...) call <- match.call() data.names <- sprintf("%s and %s by %s (%s, %s)", deparse(call$predictor1), deparse(call$predictor2), deparse(call$response), roc1$levels[1], roc1$levels[2]) } test <- roc.test.roc(roc1, roc2, method=method, ...) test$data.names <- data.names return(test) } roc.test.auc <- function(roc1, roc2, ...) { # First save the names data.names <- paste(deparse(substitute(roc1)), "and", deparse(substitute(roc2))) # Change roc1 from an auc to a roc object but keep the auc specifications auc1 <- roc1 attr(auc1, "roc") <- NULL roc1 <- attr(roc1, "roc") roc1$auc <- auc1 # Pass to roc.test.roc testres <- roc.test.roc(roc1, roc2, ...) testres$call <- match.call() testres$data.names <- data.names return(testres) } roc.test.smooth.roc <- function(roc1, roc2, ...) { testres <- roc.test.roc(roc1, roc2, ...) testres$call <- match.call() testres$data.names <- paste(deparse(substitute(roc1)), "and", deparse(substitute(roc2))) return(testres) } roc.test.roc <- function(roc1, roc2, method=c("delong", "bootstrap", "venkatraman", "sensitivity", "specificity"), sensitivity=NULL, specificity=NULL, alternative = c("two.sided", "less", "greater"), paired=NULL, reuse.auc=TRUE, boot.n=2000, boot.stratified=TRUE, ties.method="first", progress=getOption("pROCProgress")$name, parallel=FALSE, conf.level=0.95, ...) { alternative <- match.arg(alternative) data.names <- paste(deparse(substitute(roc1)), "and", deparse(substitute(roc2))) # If roc2 is an auc, take the roc but keep the auc specifications if (methods::is(roc2, "auc")) { auc2 <- roc2 attr(auc2, "roc") <- NULL roc2 <- attr(roc2, "roc") roc2$auc <- auc2 } if (roc.utils.is.perfect.curve(roc1) && roc.utils.is.perfect.curve(roc2)) { warning("roc.test() of two ROC curves with AUC == 1 has always p.value = 1 and can be misleading.") } # store which objects are smoothed, and how smoothing.args <- list() if (methods::is(roc1, "smooth.roc")) { smoothing.args$roc1 <- roc1$smoothing.args smoothing.args$roc1$smooth <- TRUE roc1 <- attr(roc1, "roc") } else { smoothing.args$roc1 <- list(smooth=FALSE) } if (methods::is(roc2, "smooth.roc")) { smoothing.args$roc2 <- roc2$smoothing.args smoothing.args$roc2$smooth <- TRUE roc2 <- attr(roc2, "roc") } else { smoothing.args$roc2 <- list(smooth=FALSE) } # Check if we do a paired or unpaired roc.test if (is.null(paired)) { # then determine whether the rocs are paired or not rocs.are.paired <- are.paired(roc1, roc2, return.paired.rocs=TRUE, reuse.auc=TRUE, reuse.ci=FALSE, reuse.smooth=TRUE) if (rocs.are.paired) { paired <- TRUE roc1 <- attr(rocs.are.paired, "roc1") roc2 <- attr(rocs.are.paired, "roc2") } else { paired <- FALSE roc1 <- roc1 roc2 <- roc2 } } else if (paired) { # make sure the rocs are really paired rocs.are.paired <- rocs.are.paired <- are.paired(roc1, roc2, return.paired.rocs=TRUE, reuse.auc=TRUE, reuse.ci=FALSE, reuse.smooth=TRUE) if (! rocs.are.paired) stop("The paired ROC test cannot be applied to unpaired curves.") roc1 <- attr(rocs.are.paired, "roc1") roc2 <- attr(rocs.are.paired, "roc2") } else { # assume unpaired rocs.are.paired <- are.paired(roc1, roc2, return.paired.rocs=FALSE) if (rocs.are.paired) warning("The ROC curves seem to be paired. Consider performing a paired roc.test.") roc1 <- roc1 roc2 <- roc2 } # check that the AUC was computed, or do it now if (is.null(roc1$auc) | !reuse.auc) { if (smoothing.args$roc1$smooth) { roc1$auc <- auc(smooth.roc=do.call("smooth.roc", c(list(roc=roc1), smoothing.args$roc1)), ...) # remove partial.auc.* arguments that are now in roc1$auc and that will mess later processing # (formal argument "partial.auc(.*)" matched by multiple actual arguments) # This removal should be safe because we always use smoothing.args with roc1 in the following processing, # however it is a potential source of bugs. smoothing.args$roc1$partial.auc <- NULL smoothing.args$roc1$partial.auc.correct <- NULL smoothing.args$roc1$partial.auc.focus <- NULL } else roc1$auc <- auc(roc1, ...) } if (is.null(roc2$auc) | !reuse.auc) { if (smoothing.args$roc2$smooth) { roc2$auc <- auc(smooth.roc=do.call("smooth.roc", c(list(roc=roc2), smoothing.args$roc2)), ...) # remove partial.auc.* arguments that are now in roc1$auc and that will mess later processing # (formal argument "partial.auc(.*)" matched by multiple actual arguments) # This removal should be safe because we always use smoothing.args with roc2 in the following processing, # however it is a potential source of bugs. smoothing.args$roc2$partial.auc <- NULL smoothing.args$roc2$partial.auc.correct <- NULL smoothing.args$roc2$partial.auc.focus <- NULL } else roc2$auc <- auc(roc2, ...) } # check that the same region was requested in auc. Otherwise, issue a warning if (!identical(attributes(roc1$auc)[names(attributes(roc1$auc))!="roc"], attributes(roc2$auc)[names(attributes(roc2$auc))!="roc"])) warning("Different AUC specifications in the ROC curves. Enforcing the inconsistency, but unexpected results may be produced.") # check that the same smoothing params were requested in auc. Otherwise, issue a warning if (!identical(smoothing.args$roc1, smoothing.args$roc2)) warning("Different smoothing parameters in the ROC curves. Enforcing the inconsistency, but unexpected results may be produced.") # Check the method if (missing(method) | is.null(method)) { # determine method if missing if (has.partial.auc(roc1)) { # partial auc: go for bootstrap method <- "bootstrap" } else if (smoothing.args$roc1$smooth || smoothing.args$roc2$smooth) { # smoothing in one or both: bootstrap method <- "bootstrap" } else if (roc1$direction != roc2$direction) { # delong doesn't work well with opposite directions (will report high significance if roc1$auc and roc2$auc are similar and high) method <- "bootstrap" } else { method <- "delong" } } else { method <- match.arg(method) if (method == "delong") { # delong NA to pAUC: warn + change if (has.partial.auc(roc1) || has.partial.auc(roc2)) { stop("DeLong's test is not supported for partial AUC. Use method=\"bootstrap\" instead.") } if (smoothing.args$roc1$smooth || smoothing.args$roc2$smooth) { stop("DeLong's test is not supported for smoothed ROCs. Use method=\"bootstrap\" instead.") } if (roc1$direction != roc2$direction) warning("DeLong's test should not be applied to ROC curves with a different direction.") # Check if conf.level is specified correctly. This is currently # only used for the delong paired method, which is why it lives # here for now. if (!is.numeric(conf.level)) { stop("conf.level must be numeric between 0 and 1.") } else if (0 > conf.level | 1 < conf.level) { stop("conf.level must be between 0 and 1.") } } else if (method == "venkatraman") { if (has.partial.auc(roc1)) stop("Partial AUC is not supported for Venkatraman's test.") if (smoothing.args$roc1$smooth || smoothing.args$roc2$smooth) stop("Venkatraman's test is not supported for smoothed ROCs") if (roc1$direction != roc2$direction) warning("Venkatraman's test should not be applied to ROC curves with different directions.") if (alternative != "two.sided") { stop("Only two-sided tests are available for Venkatraman.") } } } # Prepare the return value htest if (smoothing.args$roc1$smooth) estimate <- do.call("smooth.roc", c(list(roc=roc1), smoothing.args$roc1))$auc else estimate <- roc1$auc if (smoothing.args$roc2$smooth) estimate <- c(estimate, do.call("smooth.roc", c(list(roc=roc2), smoothing.args$roc2))$auc) else estimate <- c(estimate, roc2$auc) if (identical(attr(roc1$auc, "partial.auc"), FALSE)) { nest <- paste(ifelse(smoothing.args$roc1$smooth, "Smoothed ", ""), "AUC of roc1", sep="") } else { nest <- paste(ifelse (attr(roc1$auc, "partial.auc.correct"), "Corrected ", ""), ifelse (smoothing.args$roc1$smooth, "Smoothed ", ""), "pAUC (", attr(roc1$auc, "partial.auc")[1], "-", attr(roc1$auc, "partial.auc")[2], " ", attr(roc1$auc, "partial.auc.focus"), ") of roc1", sep="") } if (identical(attr(roc2$auc, "partial.auc"), FALSE)) { nest <- c(nest, paste(ifelse(smoothing.args$roc2$smooth, "Smoothed ", ""), "AUC of roc2", sep="")) } else { nest <- c(nest, paste(ifelse (attr(roc2$auc, "partial.auc.correct"), "Corrected ", ""), ifelse (smoothing.args$roc2$smooth, "Smoothed ", ""), "pAUC (", attr(roc2$auc, "partial.auc")[1], "-", attr(roc2$auc, "partial.auc")[2], " ", attr(roc2$auc, "partial.auc.focus"), ") of roc2", sep="")) } nest <- sub("Corrected Smoothed", "Corrected smoothed", nest) # no upper on smoothed if corrected. names(estimate) <- nest null.value <- 0 names(null.value) <- "difference in AUC" htest <- list( alternative = alternative, data.names = data.names, estimate = estimate, null.value = null.value ) class(htest) <- "htest" if (method == "delong") { if (paired) { delong.calcs <- delong.paired.calculations(roc1, roc2) stat <- delong.paired.test(delong.calcs) stat.ci <- ci.delong.paired(delong.calcs, conf.level) names(stat) <- "Z" htest$statistic <- stat htest$method <- "DeLong's test for two correlated ROC curves" htest$conf.int <- c(stat.ci$lower, stat.ci$upper) attr(htest$conf.int, "conf.level") <- stat.ci$level if (alternative == "two.sided") pval <- 2*pnorm(-abs(stat)) else if (alternative == "greater") pval <- pnorm(-stat) else pval <- pnorm(stat) htest$p.value <- pval } else { stats <- delong.unpaired.test(roc1, roc2) stat <- stats[1] df <- stats[2] htest$statistic <- c("D"=stat) htest$parameter <- c("df"=df) htest$method <- "DeLong's test for two ROC curves" if (alternative == "two.sided") pval <- 2*pt(-abs(stat), df=df) else if (alternative == "greater") pval <- pt(-stat, df=df) else pval <- pt(stat, df=df) htest$p.value <- pval } } else if (method == "venkatraman") { if(class(progress) != "list") progress <- roc.utils.get.progress.bar(progress, title="Venkatraman ROC test", label="Permutations in progress...", ...) if (paired) { stats <- venkatraman.paired.test(roc1, roc2, boot.n, ties.method, progress, parallel) htest$method <- "Venkatraman's test for two paired ROC curves" } else { stats <- venkatraman.unpaired.test(roc1, roc2, boot.n, ties.method, progress, parallel) htest$method <- "Venkatraman's test for two unpaired ROC curves" } stat <- stats[[1]] names(stat) <- "E" htest$statistic <- stat parameter <- c(boot.n) names(parameter) <- "boot.n" htest$parameter <- parameter pval <- sum(stats[[2]]>=stats[[1]])/boot.n htest$p.value <- pval names(htest$null.value) <- "difference in at least one ROC operating point" htest$estimate <- NULL # AUC not relevant in venkatraman } else { # method == "bootstrap" or "sensitivity" or "specificity" # Check if called with density.cases or density.controls if (is.null(smoothing.args) || is.numeric(smoothing.args$density.cases) || is.numeric(smoothing.args$density.controls)) stop("Cannot compute the statistic on ROC curves smoothed with numeric density.controls and density.cases.") if(class(progress) != "list") progress <- roc.utils.get.progress.bar(progress, title="Bootstrap ROC test", label="Bootstrap in progress...", ...) if (method == "specificity") { if (! is.numeric(specificity) || length(specificity) != 1) { stop("Argument 'specificity' must be numeric of length 1 for a specificity test.") } stat <- bootstrap.test(roc1, roc2, "sp", specificity, paired, boot.n, boot.stratified, smoothing.args, progress, parallel) if (paired) htest$method <- "Specificity test for two correlated ROC curves" else htest$method <- "Specificity test for two ROC curves" names(htest$null.value) <- sprintf("difference in sensitivity at %s specificity", specificity) } else if (method == "sensitivity") { if (! is.numeric(sensitivity) || length(sensitivity) != 1) { stop("Argument 'sensitivity' must be numeric of length 1 for a sensitivity test.") } stat <- bootstrap.test(roc1, roc2, "se", sensitivity, paired, boot.n, boot.stratified, smoothing.args, progress, parallel) if (paired) htest$method <- "Sensitivity test for two correlated ROC curves" else htest$method <- "Sensitivity test for two ROC curves" names(htest$null.value) <- sprintf("difference in specificity at %s sensitivity", sensitivity) } else { stat <- bootstrap.test(roc1, roc2, "boot", NULL, paired, boot.n, boot.stratified, smoothing.args, progress, parallel) if (paired) htest$method <- "Bootstrap test for two correlated ROC curves" else htest$method <- "Bootstrap test for two ROC curves" } stat <- as.vector(stat) # remove auc attributes names(stat) <- "D" htest$statistic <- stat parameter <- c(boot.n, boot.stratified) names(parameter) <- c("boot.n", "boot.stratified") htest$parameter <- parameter if (alternative == "two.sided") pval <- 2*pnorm(-abs(stat)) else if (alternative == "greater") pval <- pnorm(-stat) else pval <- pnorm(stat) htest$p.value <- pval } htest$roc1 <- roc1 htest$roc2 <- roc2 # Remove name from p value htest$p.value <- unname(htest$p.value) # Restore smoothing if necessary if (smoothing.args$roc1$smooth) htest$roc1 <- do.call("smooth.roc", c(list(roc=roc1), smoothing.args$roc1)) if (smoothing.args$roc2$smooth) htest$roc2 <- do.call("smooth.roc", c(list(roc=roc2), smoothing.args$roc2)) return(htest) } pROC/R/plot.roc.R0000644000176200001440000003445114114130125013140 0ustar liggesusers# pROC: Tools Receiver operating characteristic (ROC curves) with # (partial) area under the curve, confidence intervals and comparison. # Copyright (C) 2010-2014 Xavier Robin, Alexandre Hainard, Natacha Turck, # Natalia Tiberti, Frédérique Lisacek, Jean-Charles Sanchez # and Markus Müller # # This program is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, either version 3 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program. If not, see . plot.roc <- function(x, ...) { UseMethod("plot.roc") } plot.roc.formula <- function(x, data, subset, na.action, ...) { data.missing <- missing(data) call <- match.call() names(call)[2] <- "formula" # forced to be x by definition of plot roc.data <- roc.utils.extract.formula(formula=x, data, subset, na.action, ..., data.missing = data.missing, call = call) if (length(roc.data$predictor.name) > 1) { stop("Only one predictor supported in 'plot.roc'.") } response <- roc.data$response predictor <- roc.data$predictors[, 1] roc <- roc(response, predictor, plot=TRUE, ...) roc$call <- match.call() invisible(roc) } plot.roc.default <- function(x, predictor, ...) { roc <- roc(x, predictor, plot=TRUE, ...) roc$call <- match.call() invisible(roc) } plot.roc.smooth.roc <- plot.smooth.roc <- function(x, ...) { invisible(plot.roc.roc(x, ...)) # force usage of plot.roc.roc: only print.thres not working } plot.roc.roc <- function(x, add=FALSE, reuse.auc=TRUE, axes=TRUE, legacy.axes=FALSE, xlim=if(x$percent){c(100, 0)} else{c(1, 0)}, ylim=if(x$percent){c(0, 100)} else{c(0, 1)}, xlab=ifelse(x$percent, ifelse(legacy.axes, "100 - Specificity (%)", "Specificity (%)"), ifelse(legacy.axes, "1 - Specificity", "Specificity")), ylab=ifelse(x$percent, "Sensitivity (%)", "Sensitivity"), asp=1, mar=c(4, 4, 2, 2)+.1, mgp=c(2.5, 1, 0), # col, lty and lwd for the ROC line only col=par("col"), lty=par("lty"), lwd=2, type="l", # Identity line identity=!add, identity.col="darkgrey", identity.lty=1, identity.lwd=1, # Print the thresholds on the plot print.thres=FALSE, print.thres.pch=20, print.thres.adj=c(-.05,1.25), print.thres.col="black", print.thres.pattern=ifelse(x$percent, "%.1f (%.1f%%, %.1f%%)", "%.3f (%.3f, %.3f)"), print.thres.cex=par("cex"), print.thres.pattern.cex=print.thres.cex, print.thres.best.method=NULL, print.thres.best.weights=c(1, 0.5), # Print the AUC on the plot print.auc=FALSE, print.auc.pattern=NULL, print.auc.x=ifelse(x$percent, 50, .5), print.auc.y=ifelse(x$percent, 50, .5), print.auc.adj=c(0,1), print.auc.col=col, print.auc.cex=par("cex"), # Grid grid=FALSE, grid.v={ if(is.logical(grid) && grid[1]==TRUE){seq(0, 1, 0.1) * ifelse(x$percent, 100, 1)} else if(is.numeric(grid)) {seq(0, ifelse(x$percent, 100, 1), grid[1])} else {NULL} }, grid.h={ if (length(grid) == 1) {grid.v} else if (is.logical(grid) && grid[2]==TRUE){seq(0, 1, 0.1) * ifelse(x$percent, 100, 1)} else if(is.numeric(grid)) {seq(0, ifelse(x$percent, 100, 1), grid[2])} else {NULL} }, # for grid.lty, grid.lwd and grid.col, a length 2 value specifies both values for vertical (1) and horizontal (2) grid grid.lty=3, grid.lwd=1, grid.col="#DDDDDD", # Polygon for the auc auc.polygon=FALSE, auc.polygon.col="gainsboro", # Other arguments can be passed to polygon() using "..." (for these two we cannot) auc.polygon.lty=par("lty"), auc.polygon.density=NULL, auc.polygon.angle=45, auc.polygon.border=NULL, # Should we show the maximum possible area as another polygon? max.auc.polygon=FALSE, max.auc.polygon.col="#EEEEEE", # Other arguments can be passed to polygon() using "..." (for these two we cannot) max.auc.polygon.lty=par("lty"), max.auc.polygon.density=NULL, max.auc.polygon.angle=45, max.auc.polygon.border=NULL, # Confidence interval ci=!is.null(x$ci), ci.type=c("bars", "shape", "no"), ci.col=ifelse(ci.type=="bars", par("fg"), "gainsboro"), ... ) { percent <- x$percent if (max.auc.polygon | auc.polygon | print.auc) {# we need the auc here if (is.null(x$auc) | !reuse.auc) x$auc <- auc(x, ...) partial.auc <- attr(x$auc, "partial.auc") partial.auc.focus <- attr(x$auc, "partial.auc.focus") } # compute a reasonable default for print.auc.pattern if required if (print.auc & is.null(print.auc.pattern)) { print.auc.pattern <- ifelse(identical(partial.auc, FALSE), "AUC: ", "Partial AUC: ") print.auc.pattern <- paste(print.auc.pattern, ifelse(percent, "%.1f%%", "%.3f"), sep="") if (ci && methods::is(x$ci, "ci.auc")) print.auc.pattern <- paste(print.auc.pattern, " (", ifelse(percent, "%.1f%%", "%.3f"), "\u2013", ifelse(percent, "%.1f%%", "%.3f"), ")",sep="") } # get and sort the sensitivities and specificities se <- sort(x$sensitivities, decreasing=TRUE) sp <- sort(x$specificities, decreasing=FALSE) if (!add) { opar <- par(mar=mar, mgp=mgp) on.exit(par(opar)) # type="n" to plot background lines and polygon shapes first. We will add the line later. axes=FALSE, we'll add them later according to legacy.axis suppressWarnings(plot(x$specificities, x$sensitivities, xlab=xlab, ylab=ylab, type="n", axes=FALSE, xlim=xlim, ylim=ylim, lwd=lwd, asp=asp, ...)) # As we had axes=FALSE we need to add them again unless axes=FALSE if (axes) { box() # axis behave differently when at and labels are passed (no decimals on 1 and 0), # so handle each case separately and consistently across axes if (legacy.axes) { lab.at <- axTicks(side=1) lab.labels <- format(ifelse(x$percent, 100, 1) - lab.at) suppressWarnings(axis(side=1, at=lab.at, labels=lab.labels, ...)) lab.at <- axTicks(side=2) suppressWarnings(axis(side=2, at=lab.at, labels=format(lab.at), ...)) } else { suppressWarnings(axis(side=1, ...)) suppressWarnings(axis(side=2, ...)) } } } # Plot the grid # make sure grid.lty, grid.lwd and grid.col are at least of length 2 grid.lty <- rep(grid.lty, length.out=2) grid.lwd <- rep(grid.lwd, length.out=2) grid.col <- rep(grid.col, length.out=2) if (!is.null(grid.v)) { suppressWarnings(abline(v=grid.v, lty=grid.lty[1], col=grid.col[1], lwd=grid.lwd[1], ...)) } if (!is.null(grid.h)) { suppressWarnings(abline(h=grid.h, lty=grid.lty[2], col=grid.col[2], lwd=grid.lwd[2], ...)) } # Plot the polygon displaying the maximal area if (max.auc.polygon) { if (identical(partial.auc, FALSE)) { map.y <- c(0, 1, 1, 0) * ifelse(percent, 100, 1) map.x <- c(1, 1, 0, 0) * ifelse(percent, 100, 1) } else { if (partial.auc.focus=="sensitivity") { map.y <- c(partial.auc[2], partial.auc[2], partial.auc[1], partial.auc[1]) map.x <- c(0, 1, 1, 0) * ifelse(percent, 100, 1) } else { map.y <- c(0, 1, 1, 0) * ifelse(percent, 100, 1) map.x <- c(partial.auc[2], partial.auc[2], partial.auc[1], partial.auc[1]) } } suppressWarnings(polygon(map.x, map.y, col=max.auc.polygon.col, lty=max.auc.polygon.lty, border=max.auc.polygon.border, density=max.auc.polygon.density, angle=max.auc.polygon.angle, ...)) } # Plot the ci shape if (ci && ! methods::is(x$ci, "ci.auc")) { ci.type <- match.arg(ci.type) if (ci.type=="shape") plot(x$ci, type="shape", col=ci.col, no.roc=TRUE, ...) } # Plot the polygon displaying the actual area if (auc.polygon) { if (identical(partial.auc, FALSE)) { suppressWarnings(polygon(c(sp, 0), c(se, 0), col=auc.polygon.col, lty=auc.polygon.lty, border=auc.polygon.border, density=auc.polygon.density, angle=auc.polygon.angle, ...)) } else { if (partial.auc.focus == "sensitivity") { x.all <- rev(se) y.all <- rev(sp) } else { x.all <- sp y.all <- se } # find the SEs and SPs in the interval x.int <- x.all[x.all <= partial.auc[1] & x.all >= partial.auc[2]] y.int <- y.all[x.all <= partial.auc[1] & x.all >= partial.auc[2]] # if the upper limit is not exactly present in SPs, interpolate if (!(partial.auc[1] %in% x.int)) { x.int <- c(x.int, partial.auc[1]) # find the limit indices idx.out <- match(FALSE, x.all < partial.auc[1]) idx.in <- idx.out - 1 # interpolate y proportion.start <- (partial.auc[1] - x.all[idx.out]) / (x.all[idx.in] - x.all[idx.out]) y.start <- y.all[idx.out] - proportion.start * (y.all[idx.out] - y.all[idx.in]) y.int <- c(y.int, y.start) } # if the lower limit is not exactly present in SPs, interpolate if (!(partial.auc[2] %in% x.int)) { x.int <- c(partial.auc[2], x.int) # find the limit indices idx.out <- length(x.all) - match(TRUE, rev(x.all) < partial.auc[2]) + 1 idx.in <- idx.out + 1 # interpolate y proportion.end <- (x.all[idx.in] - partial.auc[2]) / (x.all[idx.in] - x.all[idx.out]) y.end <- y.all[idx.in] + proportion.end * (y.all[idx.out] - y.all[idx.in]) y.int <- c(y.end, y.int) } # anchor to baseline x.int <- c(partial.auc[2], x.int, partial.auc[1]) y.int <- c(0, y.int, 0) if (partial.auc.focus == "sensitivity") { # for SE, invert x and y again suppressWarnings(polygon(y.int, x.int, col=auc.polygon.col, lty=auc.polygon.lty, border=auc.polygon.border, density=auc.polygon.density, angle=auc.polygon.angle, ...)) } else { suppressWarnings(polygon(x.int, y.int, col=auc.polygon.col, lty=auc.polygon.lty, border=auc.polygon.border, density=auc.polygon.density, angle=auc.polygon.angle, ...)) } } } # Identity line if (identity) suppressWarnings(abline(ifelse(percent, 100, 1), -1, col=identity.col, lwd=identity.lwd, lty=identity.lty, ...)) # Actually plot the ROC curve suppressWarnings(lines(sp, se, type=type, lwd=lwd, col=col, lty=lty, ...)) # Plot the ci bars if (ci && !methods::is(x$ci, "ci.auc")) { if (ci.type=="bars") plot(x$ci, type="bars", col=ci.col, ...) } # Print the thresholds on the curve if print.thres is TRUE if (isTRUE(print.thres)) print.thres <- "best" if (is.character(print.thres)) print.thres <- match.arg(print.thres, c("no", "all", "local maximas", "best")) if (methods::is(x, "smooth.roc")) { if (is.numeric(print.thres)) stop("Numeric 'print.thres' unsupported on a smoothed ROC plot.") else if (print.thres == "all" || print.thres == "local maximas") stop("'all' and 'local maximas' 'print.thres' unsupported on a smoothed ROC plot.") else if (print.thres == "best") { co <- coords(x, print.thres, best.method=print.thres.best.method, best.weights=print.thres.best.weights, transpose=FALSE) suppressWarnings(points(co$specificity, co$sensitivity, pch=print.thres.pch, cex=print.thres.cex, col=print.thres.col, ...)) suppressWarnings(text(co$specificity, co$sensitivity, sprintf(print.thres.pattern, NA, co$specificity, co$sensitivity), adj=print.thres.adj, cex=print.thres.pattern.cex, col=print.thres.col, ...)) } # else print.thres == no > do nothing } else if (is.numeric(print.thres) || is.character(print.thres)) { if (is.character(print.thres) && print.thres == "no") {} # do nothing else { co <- coords(x, print.thres, best.method=print.thres.best.method, best.weights=print.thres.best.weights, transpose=FALSE) suppressWarnings(points(co$specificity, co$sensitivity, pch=print.thres.pch, cex=print.thres.cex, col=print.thres.col, ...)) suppressWarnings(text(co$specificity, co$sensitivity, sprintf(print.thres.pattern, co$threshold, co$specificity, co$sensitivity), adj=print.thres.adj, cex=print.thres.pattern.cex, col=print.thres.col, ...)) } } # Print the AUC on the plot if (print.auc) { if (ci && methods::is(x$ci, "ci.auc")) { labels <- sprintf(print.auc.pattern, x$auc, x$ci[1], x$ci[3]) suppressWarnings(text(print.auc.x, print.auc.y, labels, adj=print.auc.adj, cex=print.auc.cex, col=print.auc.col, ...)) } else labels <- sprintf(print.auc.pattern, x$auc) suppressWarnings(text(print.auc.x, print.auc.y, labels, adj=print.auc.adj, cex=print.auc.cex, col=print.auc.col, ...)) } invisible(x) } pROC/R/coords.R0000644000176200001440000004237114114130125012671 0ustar liggesusers# pROC: Tools Receiver operating characteristic (ROC curves) with # (partial) area under the curve, confidence intervals and comparison. # Copyright (C) 2010-2014 Xavier Robin, Alexandre Hainard, Natacha Turck, # Natalia Tiberti, Frédérique Lisacek, Jean-Charles Sanchez # and Markus Müller # # This program is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, either version 3 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program. If not, see . coords <- function(...) UseMethod("coords") coords.smooth.roc <- function(smooth.roc, x, input, ret=c("specificity", "sensitivity"), as.list=FALSE, drop=TRUE, best.method=c("youden", "closest.topleft"), best.weights=c(1, 0.5), transpose = FALSE, as.matrix = FALSE, ...) { # make sure x was provided if (missing(x) || is.null(x) || (length(x) == 0 && !is.numeric(x))) { x <- "all" } else if (length(x) == 0 && is.numeric(x)) { stop("Numeric 'x' has length 0") } # match return ret <- roc.utils.match.coords.ret.args(ret, threshold = FALSE) if (is.character(x)) { x <- match.arg(x, c("all", "best")) # no thresholds in smoothed roc: only best or all are possible partial.auc <- attr(smooth.roc$auc, "partial.auc") if (x == "all") { # Pre-filter thresholds based on partial.auc if (is.null(smooth.roc$auc) || identical(partial.auc, FALSE)) { se <- smooth.roc$sensitivities sp <- smooth.roc$specificities } else { if (attr(smooth.roc$auc, "partial.auc.focus") == "sensitivity") { se <- smooth.roc$sensitivities[smooth.roc$sensitivities <= partial.auc[1] & smooth.roc$sensitivities >= partial.auc[2]] sp <- smooth.roc$specificities[smooth.roc$sensitivities <= partial.auc[1] & smooth.roc$sensitivities >= partial.auc[2]] } else { se <- smooth.roc$sensitivities[smooth.roc$specificities <= partial.auc[1] & smooth.roc$specificities >= partial.auc[2]] sp <- smooth.roc$specificities[smooth.roc$specificities <= partial.auc[1] & smooth.roc$specificities >= partial.auc[2]] } } if (length(se) == 0) { warning("No coordinates found, returning NULL. This is possibly cased by a too small partial AUC interval.") return(NULL) } if (any(! ret %in% c("specificity", "sensitivity"))) { # Deduce additional tn, tp, fn, fp, npv, ppv res <- roc.utils.calc.coords(smooth.roc, NA, se, sp, best.weights) } else { res <- cbind( specificity = sp, sensitivity = se ) } } else { # cheat: allow the user to pass "topleft" best.method <- match.arg(best.method[1], c("youden", "closest.topleft", "topleft")) if (best.method == "topleft") { best.method <- "closest.topleft" } optim.crit <- roc.utils.optim.crit(smooth.roc$sensitivities, smooth.roc$specificities, ifelse(smooth.roc$percent, 100, 1), best.weights, best.method) if (is.null(smooth.roc$auc) || identical(partial.auc, FALSE)) { se <- smooth.roc$sensitivities[optim.crit==max(optim.crit)] sp <- smooth.roc$specificities[optim.crit==max(optim.crit)] optim.crit <- optim.crit[optim.crit==max(optim.crit)] } else { if (attr(smooth.roc$auc, "partial.auc.focus") == "sensitivity") { optim.crit.partial <- (optim.crit)[smooth.roc$sensitivities <= partial.auc[1] & smooth.roc$sensitivities >= partial.auc[2]] se <- smooth.roc$sensitivities[smooth.roc$sensitivities <= partial.auc[1] & smooth.roc$sensitivities >= partial.auc[2]][optim.crit.partial==max(optim.crit.partial)] sp <- smooth.roc$specificities[smooth.roc$sensitivities <= partial.auc[1] & smooth.roc$sensitivities >= partial.auc[2]][optim.crit.partial==max(optim.crit.partial)] optim.crit <- optim.crit[smooth.roc$sensitivities <= partial.auc[1] & smooth.roc$sensitivities >= partial.auc[2]][optim.crit.partial==max(optim.crit.partial)] } else { optim.crit.partial <- (optim.crit)[smooth.roc$specificities <= partial.auc[1] & smooth.roc$specificities >= partial.auc[2]] se <- smooth.roc$sensitivities[smooth.roc$specificities <= partial.auc[1] & smooth.roc$specificities >= partial.auc[2]][optim.crit.partial==max(optim.crit.partial)] sp <- smooth.roc$specificities[smooth.roc$specificities <= partial.auc[1] & smooth.roc$specificities >= partial.auc[2]][optim.crit.partial==max(optim.crit.partial)] optim.crit <- optim.crit[smooth.roc$specificities <= partial.auc[1] & smooth.roc$specificities >= partial.auc[2]][optim.crit.partial==max(optim.crit.partial)] } } if (any(! ret %in% c("specificity", "sensitivity", best.method))) { # Deduce additional tn, tp, fn, fp, npv, ppv res <- roc.utils.calc.coords(smooth.roc, NA, se, sp, best.weights) } else { res <- cbind( specificity = sp, sensitivity = se, best.method = ifelse(best.method == "youden", 1, -1) * optim.crit ) colnames(res)[3] <- best.method } } if (as.list) { warning("'as.list' is deprecated and will be removed in a future version.") list <- apply(t(res)[ret, , drop=FALSE], 2, as.list) if (drop == TRUE && length(x) == 1) { return(list[[1]]) } return(list) } else if (transpose) { rownames(res) <- NULL return(t(res)[ret,, drop=drop]) } else { if (missing(drop) ) { drop = FALSE } if (! as.matrix) { res <- as.data.frame(res) } return(res[, ret, drop=drop]) } } # Adjust drop for downstream call if (missing(drop) && ! transpose) { drop = FALSE } # match input input <- roc.utils.match.coords.input.args(input, threshold = FALSE) # use coords.roc smooth.roc$thresholds <- rep(NA, length(smooth.roc$specificities)) return(coords.roc(smooth.roc, x, input, ret, as.list, drop, transpose = transpose, as.matrix = as.matrix, ...)) } coords.roc <- function(roc, x, input="threshold", ret=c("threshold", "specificity", "sensitivity"), as.list=FALSE, drop=TRUE, best.method=c("youden", "closest.topleft"), best.weights=c(1, 0.5), transpose = FALSE, as.matrix = FALSE, ...) { # make sure x was provided if (missing(x) || is.null(x) || (length(x) == 0 && !is.numeric(x))) { x <- "all" } else if (length(x) == 0 && is.numeric(x)) { stop("Numeric 'x' has length 0") } # match input input <- roc.utils.match.coords.input.args(input) # match return ret <- roc.utils.match.coords.ret.args(ret) # make sure the sort of roc is correct roc <- sort(roc) if (is.character(x)) { x <- match.arg(x, c("all", "local maximas", "best")) partial.auc <- attr(roc$auc, "partial.auc") if (x == "all") { # Pre-filter thresholds based on partial.auc if (is.null(roc$auc) || identical(partial.auc, FALSE)) { se <- roc$sensitivities sp <- roc$specificities thres <- roc$thresholds } else { if (attr(roc$auc, "partial.auc.focus") == "sensitivity") { se <- roc$sensitivities[roc$sensitivities <= partial.auc[1] & roc$sensitivities >= partial.auc[2]] sp <- roc$specificities[roc$sensitivities <= partial.auc[1] & roc$sensitivities >= partial.auc[2]] thres <- roc$thresholds[roc$sensitivities <= partial.auc[1] & roc$sensitivities >= partial.auc[2]] } else { se <- roc$sensitivities[roc$specificities <= partial.auc[1] & roc$specificities >= partial.auc[2]] sp <- roc$specificities[roc$specificities <= partial.auc[1] & roc$specificities >= partial.auc[2]] thres <- roc$thresholds[roc$specificities <= partial.auc[1] & roc$specificities >= partial.auc[2]] } } if (length(thres) == 0) { warning("No coordinates found, returning NULL. This is possibly cased by a too small partial AUC interval.") return(NULL) } res <- cbind( threshold = thres, specificity = sp, sensitivity = se ) } else if (x == "local maximas") { # Pre-filter thresholds based on partial.auc if (is.null(roc$auc) || identical(partial.auc, FALSE)) { se <- roc$sensitivities sp <- roc$specificities thres <- roc$thresholds } else { if (attr(roc$auc, "partial.auc.focus") == "sensitivity") { se <- roc$sensitivities[roc$sensitivities <= partial.auc[1] & roc$sensitivities >= partial.auc[2]] sp <- roc$specificities[roc$sensitivities <= partial.auc[1] & roc$sensitivities >= partial.auc[2]] thres <- roc$thresholds[roc$sensitivities <= partial.auc[1] & roc$sensitivities >= partial.auc[2]] } else { se <- roc$sensitivities[roc$specificities <= partial.auc[1] & roc$specificities >= partial.auc[2]] sp <- roc$specificities[roc$specificities <= partial.auc[1] & roc$specificities >= partial.auc[2]] thres <- roc$thresholds[roc$specificities <= partial.auc[1] & roc$specificities >= partial.auc[2]] } } if (length(thres) == 0) { warning("No coordinates found, returning NULL. This is possibly cased by a too small partial AUC interval.") return(NULL) } lm.idx <- roc.utils.max.thresholds.idx(thres, sp=sp, se=se) res <- cbind( threshold = thres[lm.idx], specificity = sp[lm.idx], sensitivity = se[lm.idx] ) } else { # x == "best" # cheat: allow the user to pass "topleft" best.method <- match.arg(best.method[1], c("youden", "closest.topleft", "topleft")) if (best.method == "topleft") { best.method <- "closest.topleft" } optim.crit <- roc.utils.optim.crit(roc$sensitivities, roc$specificities, ifelse(roc$percent, 100, 1), best.weights, best.method) # Filter thresholds based on partial.auc if (is.null(roc$auc) || identical(partial.auc, FALSE)) { se <- roc$sensitivities[optim.crit==max(optim.crit)] sp <- roc$specificities[optim.crit==max(optim.crit)] thres <- roc$thresholds[optim.crit==max(optim.crit)] optim.crit <- optim.crit[optim.crit==max(optim.crit)] } else { if (attr(roc$auc, "partial.auc.focus") == "sensitivity") { optim.crit <- (optim.crit)[roc$sensitivities <= partial.auc[1] & roc$sensitivities >= partial.auc[2]] se <- roc$sensitivities[roc$sensitivities <= partial.auc[1] & roc$sensitivities >= partial.auc[2]][optim.crit==max(optim.crit)] sp <- roc$specificities[roc$sensitivities <= partial.auc[1] & roc$sensitivities >= partial.auc[2]][optim.crit==max(optim.crit)] thres <- roc$thresholds[roc$sensitivities <= partial.auc[1] & roc$sensitivities >= partial.auc[2]][optim.crit==max(optim.crit)] optim.crit <- optim.crit[roc$sensitivities <= partial.auc[1] & roc$sensitivities >= partial.auc[2]][optim.crit==max(optim.crit)] } else { optim.crit <- (optim.crit)[roc$specificities <= partial.auc[1] & roc$specificities >= partial.auc[2]] se <- roc$sensitivities[roc$specificities <= partial.auc[1] & roc$specificities >= partial.auc[2]][optim.crit==max(optim.crit)] sp <- roc$specificities[roc$specificities <= partial.auc[1] & roc$specificities >= partial.auc[2]][optim.crit==max(optim.crit)] thres <- roc$thresholds[roc$specificities <= partial.auc[1] & roc$specificities >= partial.auc[2]][optim.crit==max(optim.crit)] optim.crit <- optim.crit[roc$specificities <= partial.auc[1] & roc$specificities >= partial.auc[2]][optim.crit==max(optim.crit)] } } if (length(thres) == 0) { warning("No coordinates found, returning NULL. This is possibly cased by a too small partial AUC interval.") return(NULL) } res <- cbind( threshold = thres, specificity = sp, sensitivity = se, best.method = ifelse(best.method == "youden", 1, -1) * optim.crit ) colnames(res)[4] <- best.method } } else if (is.numeric(x)) { if (input == "threshold") { thr_idx <- roc.utils.thr.idx(roc, x) res <- cbind( threshold = x, # roc$thresholds[thr_idx], # user-supplied vs ours. specificity = roc$specificities[thr_idx], sensitivity = roc$sensitivities[thr_idx] ) } else { # Arbitrary coord given in input. # We could be tempted to use all_coords directly. # However any non monotone coordinate in ret will be inaccurate # when interpolated. Therefore it is safer to only interpolate # se and sp and re-calculate the remaining coords later. res <- cbind(threshold = rep(NA, length(x)), sensitivity = rep(NA, length(x)), specificity = rep(NA, length(x)) ) if (input %in% c("sensitivity", "specificity")) { # Shortcut slow roc.utils.calc.coords se <- roc$sensitivities sp <- roc$specificities if (methods::is(roc, "smooth.roc")) { thr <- rep(NA, length(roc$sensitivities)) } else { thr <- roc$thresholds } if (input == "sensitivity") { input_values <- se } else { input_values <- sp } } else { all_coords <- roc.utils.calc.coords(roc, rep(NA, length(roc$sensitivities)), roc$sensitivities, roc$specificities, best.weights) input_values <- all_coords[, input] se <- all_coords[, "sensitivity"] sp <- all_coords[, "specificity"] thr <- all_coords[, "threshold"] } for (i in seq_along(x)) { value <- x[i] if (value < min(input_values) || value > max(input_values)) { stop(sprintf("Input %s (%s) not in range (%s-%s)", input, value, min(input_values), max(input_values))) } idx <- which(input_values == value) if (length(idx) > 1) { # More than one to pick from. Need to take best # according to sorting if (coord.is.decreasing[input]) { idx <- idx[length(idx)] # last } else { idx <- idx[1] # first } } if (length(idx) == 1) { # Exactly one to pick from res[i,] <- c(thr[idx], se[idx], sp[idx]) } else { # Need to interpolate if (coord.is.decreasing[input]) { idx.next <- match(TRUE, input_values < value) } else { idx.next <- match(TRUE, input_values > value) } proportion <- (value - input_values[idx.next]) / (input_values[idx.next - 1] - input_values[idx.next]) int.se <- se[idx.next] + proportion * (se[idx.next - 1] - se[idx.next]) int.sp <- sp[idx.next] + proportion * (sp[idx.next - 1] - sp[idx.next]) res[i, 2:3] <- c(int.se, int.sp) } } } } else { stop("'x' must be a numeric or character vector.") } if (any(! ret %in% colnames(res))) { # Deduce additional tn, tp, fn, fp, npv, ppv res <- roc.utils.calc.coords(roc, res[, "threshold"], res[, "sensitivity"], res[, "specificity"], best.weights) } if (as.list) { warning("'as.list' is deprecated and will be removed in a future version.") list <- apply(t(res)[ret, , drop=FALSE], 2, as.list) if (drop == TRUE && length(x) == 1) { return(list[[1]]) } return(list) } else if (transpose) { rownames(res) <- NULL return(t(res)[ret,, drop=drop]) } else { # HACK: # We need an exception for r4lineups that will keep the old drop = TRUE # behavior, until r4lineups gets updated. This is an ugly hack but allows # us to switch to a better drop = FALSE for everyone else if (missing(drop)) { if (sys.nframe() > 2 && length(deparse(sys.call(-2))) == 1 && deparse(sys.call(-2)) == 'make_rocdata(df_confacc)' && length(deparse(sys.call(-1))) == 1 && ( deparse(sys.call(-1)) == 'coords(rocobj, "all", ret = c("tp"))' || deparse(sys.call(-1)) == 'coords(rocobj, "all", ret = "fp")' )) { # We're in r4lineups drop = TRUE } else { drop = FALSE } } if (! as.matrix) { res <- as.data.frame(res) } return(res[, ret, drop=drop]) } } pROC/R/multiclass.R0000644000176200001440000002200514114130125013550 0ustar liggesusers# pROC: Tools Receiver operating characteristic (ROC curves) with # (partial) area under the curve, confidence intervals and comparison. # Copyright (C) 2010-2019 Xavier Robin, Matthias Doering, # Alexandre Hainard, Natacha Turck, Natalia Tiberti, # Frédérique Lisacek, Jean-Charles Sanchez and Markus Müller # # This program is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, either version 3 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program. If not, see . multiclass.roc <- function(...) UseMethod("multiclass.roc") multiclass.roc.formula <- function(formula, data, ...) { data.missing <- missing(data) call <- match.call() roc.data <- roc.utils.extract.formula(formula, data, ..., data.missing = data.missing, call = call) response <- roc.data$response predictors <- roc.data$predictors if (ncol(predictors) == 1) { predictors <- predictors[, 1] } multiclass.roc <- multiclass.roc.default(response, predictors, ...) multiclass.roc$call <- call if (! data.missing) { multiclass.roc$data <- data } return(multiclass.roc) } multiclass.roc.univariate <- function(response, predictor, levels=base::levels(as.factor(response)), percent=FALSE, # Must sensitivities, specificities and AUC be reported in percent? Note that if TRUE, and you want a partial area, you must pass it in percent also (partial.area=c(100, 80)) direction, # what computation must be done #auc=TRUE, # call auc.roc on the current object #ci=FALSE, # call ci.roc on the current object ...) { multiclass.roc <- list( response = response, predictor = predictor, percent = percent) class(multiclass.roc) <- "multiclass.roc" if (is.factor(response) && any(names(table(response))[table(response) == 0] %in% levels)) { missing.levels <- names(table(response))[table(response) == 0] missing.levels.requested <- missing.levels[missing.levels %in% levels] warning(paste("No observation for response level(s):", paste(missing.levels.requested, collapse=", "))) levels <- levels[!(levels %in% missing.levels.requested)] } multiclass.roc$levels <- levels rocs <- utils::combn(levels, 2, function(X, response, predictor, percent, ...) { roc(response, predictor, levels=X, percent=percent, auc=FALSE, ci=FALSE, ...) }, simplify=FALSE, response=response, predictor=predictor, percent=percent, direction=direction, ...) multiclass.roc$rocs <- rocs # Makes no sense to turn auc off, so remove this option #if (auc) multiclass.roc$auc <- auc.multiclass.roc(multiclass.roc, ...) # CI is not implemented yet. #if (ci) # multiclass.roc$ci <- ci.multiclass.roc(multiclass.roc, ...) return(multiclass.roc) } compute.pair.AUC <- function(pred.matrix, i, j, ref.outcome, levels, percent, direction, ... ) { # computes A(i|j), the probability that a randomly # chosen member of class j has a lower estimated probability (or score) # of belonging to class i than a randomly chosen member of class i pred.i <- pred.matrix[which(ref.outcome == i), i] # p(G = i) assigned to class i observations pred.j <- pred.matrix[which(ref.outcome == j), i] # p(G = i) assigned to class j observations classes <- factor(c(rep(i, length(pred.i)), rep(j, length(pred.j)))) # override levels argument by new levels levels <- unique(classes) predictor <- c(pred.i, pred.j) auc <- roc(classes, predictor, levels = levels, percent = percent, auc = FALSE, ci = FALSE, direction = direction, ...) return(auc) } multiclass.roc.multivariate <- function(response, predictor, levels, percent, direction, ...) { # Reference: "A Simple Generalisation of the Area Under the ROC # Curve for Multiple Class Classification Problems" (Hand and Till, 2001) if (!methods::is(predictor, "matrix") && !methods::is(predictor, "data.frame")) { stop("Please provide a matrix or data frame via 'predictor'.") } if (nrow(predictor) != length(response)) { stop("Number of rows in 'predictor' does not agree with 'response'"); } if (direction == "auto") { stop("'direction=\"auto\"' not available for multivariate multiclass.roc") } if (is.factor(response) && any(names(table(response))[table(response) == 0] %in% levels)) { missing.levels <- names(table(response))[table(response) == 0] missing.levels.requested <- missing.levels[missing.levels %in% levels] warning(paste("No observation for response level(s):", paste(missing.levels.requested, collapse=", "))) levels <- levels[!(levels %in% missing.levels.requested)] } # check whether the columns of the prediction matrix agree with the factors in 'response' m <- match(colnames(predictor), levels) missing.classes <- levels[setdiff(seq_along(levels), m)] levels <- colnames(predictor)[!is.na(m)] if (length(levels) == 1) { stop("For a single decision value, please provide 'predictor' as a vector.") } else if (length(levels) == 0) { stop("The column names of 'predictor' could not be matched to the levels of 'response'.") } if (length(missing.classes) != 0) { out.classes <- paste0(missing.classes, collapse = ",") if (length(missing.classes) == length(levels)) { # no decision values found stop(paste0("Could not find any decision values in 'predictor' matching the 'response' levels.", " Could not find the following classes: ", out.classes, ". Check your column names!")) } else { # some decision values not found warning("You did not provide decision values for the following classes: ", out.classes, ".") } } additional.classes <- colnames(predictor)[which(is.na(m))] if (length(additional.classes) != 0) { out.classes <- paste0(additional.classes, collapse = ",") warning("The following classes were not found in 'response': ", out.classes, ".") } multiclass.roc <- list( response = response, predictor = predictor, percent = percent) class(multiclass.roc) <- "mv.multiclass.roc" multiclass.roc$levels <- levels rocs <- utils::combn(levels, 2, function(x, predictor, response, levels, percent, direction, ...) { A1 <- compute.pair.AUC(predictor, x[1], x[2], response, levels, percent, direction, ...) A2 <- compute.pair.AUC(predictor, x[2], x[1], response, levels, percent, direction, ...) # merging A1 and A2 is infeasible as auc() would not be well-defined A <- list(A1, A2) return(A) }, simplify = FALSE, predictor = predictor, response = response, levels = levels, percent = percent, direction, ...) pairs <- unlist(lapply(utils::combn(levels, 2, simplify = FALSE), function(x) paste(x, collapse = "/"))) names(rocs) <- pairs multiclass.roc$rocs <- rocs multiclass.roc$auc <- auc.mv.multiclass.roc(multiclass.roc, ...) return(multiclass.roc) } multiclass.roc.default <- function(response, predictor, levels = base::levels(as.factor(response)), percent = FALSE, # Must sensitivities, specificities and AUC be reported in percent? Note that if TRUE, and you want a partial area, you must pass it in percent also (partial.area=c(100, 80)), direction = c("auto", "<", ">"), ...) { # We need at least two levels in response if (length(unique(response)) < 2) { stop("'response' must have at least two levels") } # implements the approach from Hand & Till (2001) if (methods::is(predictor, "matrix") || methods::is(predictor, "data.frame")) { # for decision values for multiple classes (e.g. probabilities of individual classes) if (missing("direction")) { # need to have uni-directional decision values for consistency direction <- ">" } else { direction <- match.arg(direction) } mc.roc <- multiclass.roc.multivariate(response, predictor, levels, percent, direction, ...) } else { # for a single decision value for separating the classes direction <- match.arg(direction) mc.roc <- multiclass.roc.univariate(response, predictor, levels, percent, direction, ...) } mc.roc$call <- match.call() return(mc.roc) } pROC/R/are.paired.R0000644000176200001440000001101513607143106013412 0ustar liggesusers# pROC: Tools Receiver operating characteristic (ROC curves) with # (partial) area under the curve, confidence intervals and comparison. # Copyright (C) 2010-2014 Xavier Robin, Alexandre Hainard, Natacha Turck, # Natalia Tiberti, Frédérique Lisacek, Jean-Charles Sanchez # and Markus Müller # # This program is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, either version 3 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program. If not, see . are.paired <- function(...) { UseMethod("are.paired") } are.paired.auc <- function(roc1, roc2, ...) { return(are.paired.roc(roc1, roc2, ...)) } are.paired.smooth.roc <- function(roc1, roc2, ...) { return(are.paired.roc(roc1, roc2, ...)) } are.paired.roc <- function(roc1, roc2, return.paired.rocs=FALSE, reuse.auc = TRUE, reuse.ci = FALSE, reuse.smooth=TRUE, ...) { # check return.paired.rocs if (! is.logical(return.paired.rocs) || length(return.paired.rocs) != 1) stop("'return.paired.rocs' must be either TRUE or FALSE.") # Recover base ROC curves (not auc or smoothed) if ("auc" %in% class(roc1)) roc1 <- attr(roc1, "roc") if ("auc" %in% class(roc2)) roc2 <- attr(roc2, "roc") if ("smooth.roc" %in% class(roc1)) { oroc1 <- roc1 roc1 <- attr(roc1, "roc") } if ("smooth.roc" %in% class(roc2)) { oroc2 <- roc2 roc2 <- attr(roc2, "roc") } # Check if the levels are the same. Otherwise it is not paired. if (!identical(roc1$levels, roc2$levels)) return(FALSE) # check if responses of roc 1 and 2 are identical if (identical(roc1$response, roc2$response)) { retval <- TRUE if (return.paired.rocs) { attr(retval, "roc1") <- roc1 attr(retval, "roc2") <- roc2 } return(retval) } else { # Make sure the difference is not only due to missing values # compare original response (with NAs and response not in levels) if (identical(roc1$original.response, roc2$original.response)) { retval <- TRUE if (! return.paired.rocs) return(retval) # else prepare paired ROCs idx.exclude <- is.na(roc1$original.predictor) | is.na(roc2$original.predictor) | is.na(roc1$original.response) | ! roc1$original.response %in% roc1$levels roc1.paired <- roc(roc1$original.response[!idx.exclude], roc1$original.predictor[!idx.exclude], levels=roc1$levels, percent=roc1$percent, na.rm=FALSE, direction=roc1$direction, auc=FALSE) roc2.paired <- roc(roc2$original.response[!idx.exclude], roc2$original.predictor[!idx.exclude], levels=roc2$levels, percent=roc2$percent, na.rm=FALSE, direction=roc2$direction, auc=FALSE) # Re-use auc/ci/smooth for roc1 if (exists("oroc1") && reuse.smooth) { args <- oroc1$smoothing.args args$roc <- roc1.paired roc1.paired <- do.call("smooth.roc", args) roc1.paired$call$roc <- as.name("roc1.paired") } if (!is.null(roc1$auc) && reuse.auc) { args <- attributes(roc1$auc) args$roc <- roc1.paired roc1.paired$auc <- do.call("auc.roc", args) } if (!is.null(roc1$ci) && reuse.ci) { args <- attributes(roc1$ci) args$roc <- NULL roc1.paired$ci <- do.call(class(roc1$ci)[1], c(roc=list(roc1.paired), args)) } # Re-use auc/ci/smooth for roc2 if (exists("oroc2") && reuse.smooth) { args <- oroc2$smoothing.args args$roc <- roc2.paired roc2.paired <- do.call("smooth.roc", args) roc2.paired$call$roc <- as.name("roc2.paired") } if (!is.null(roc2$auc) && reuse.auc) { args <- attributes(roc2$auc) args$roc <- roc2.paired roc2.paired$auc <- do.call("auc.roc", args) } if (!is.null(roc2$ci) && reuse.ci) { args <- attributes(roc2$ci) args$roc <- NULL roc2.paired$ci <- do.call(class(roc2$ci)[1], c(roc=list(roc2.paired), args)) } # Attach ROCs and return value attr(retval, "roc1") <- roc1.paired attr(retval, "roc2") <- roc2.paired return(retval) } else { return(FALSE) } } } pROC/R/venkatraman.R0000644000176200001440000001150413607143106013712 0ustar liggesusers# pROC: Tools Receiver operating characteristic (ROC curves) with # (partial) area under the curve, confidence intervals and comparison. # Copyright (C) 2010-2014 Xavier Robin, Alexandre Hainard, Natacha Turck, # Natalia Tiberti, Frédérique Lisacek, Jean-Charles Sanchez # and Markus Müller # # This program is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, either version 3 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program. If not, see . venkatraman.paired.test <- function(roc1, roc2, boot.n, ties.method="first", progress, parallel) { X <- roc1$predictor Y <- roc2$predictor R <- rank(X, ties.method = ties.method) S <- rank(Y, ties.method = ties.method) D <- roc1$response # because roc1&roc2 are paired E <- venkatraman.paired.stat(R, S, D, roc1$levels) EP <- laply(seq_len(boot.n), venkatraman.paired.permutation, R=R, S=S, D=D, levels=roc1$levels, ties.method=ties.method, .progress=progress, .parallel=parallel) return(list(E, EP)) } venkatraman.unpaired.test <- function(roc1, roc2, boot.n, ties.method="first", progress, parallel) { X <- roc1$predictor Y <- roc2$predictor R <- rank(X, ties.method = ties.method) S <- rank(Y, ties.method = ties.method) D1<- roc1$response D2 <- roc2$response mp <- (sum(D1 == roc1$levels[2]) + sum(D2 == roc2$levels[2]))/(length(D1) + length(D1)) # mixing proportion, kappa E <- venkatraman.unpaired.stat(R, S, D1, D2, roc1$levels, roc2$levels, mp) EP <- laply(seq_len(boot.n), venkatraman.unpaired.permutation, R=R, S=S, D1=D1, D2=D2, levels1=roc1$levels, levels2=roc2$levels, mp=mp, ties.method=ties.method, .progress=progress, .parallel=parallel) return(list(E, EP)) } venkatraman.paired.permutation <- function(n, R, S, D, levels, ties.method) { # Break ties R2 <- R + runif(length(D)) - 0.5 # Add small amount of random but keep same mean S2 <- S + runif(length(D)) - 0.5 # Permutation q <- 1 - round(runif(length(D))) R3 <- R2 * q + (1 - q) * S S3 <- S2 * q + (1 - q) * R return(venkatraman.paired.stat(rank(R3, ties.method=ties.method), rank(S3, ties.method=ties.method), D, levels)) } venkatraman.unpaired.permutation <- function(n, R, S, D1, D2, levels1, levels2, mp, ties.method) { # Break ties R <- R + runif(length(D1)) - 0.5 # Add small amount of random but keep same mean S <- S + runif(length(D2)) - 0.5 R.controls <- R[D1==levels1[1]] R.cases <- R[D1==levels1[2]] S.controls <- S[D2==levels2[1]] S.cases <- S[D2==levels2[2]] # Permutation controls <- sample(c(R.controls, S.controls)) cases <- sample(c(R.cases, S.cases)) R[D1==levels1[1]] <- controls[1:length(R.controls)] S[D2==levels2[1]] <- controls[(length(R.controls)+1):length(controls)] R[D1==levels1[2]] <- cases[1:length(R.cases)] S[D2==levels2[2]] <- cases[(length(R.cases)+1):length(cases)] return(venkatraman.unpaired.stat(rank(R, ties.method=ties.method), rank(S, ties.method=ties.method), D1, D2, levels1, levels2, mp)) } venkatraman.paired.stat <- function(R, S, D, levels) { R.controls <- R[D==levels[1]] R.cases <- R[D==levels[2]] S.controls <- S[D==levels[1]] S.cases <- S[D==levels[2]] n <- length(D) R.fn <- sapply(1:n, function(x) sum(R.cases <= x)) R.fp <- sapply(1:n, function(x) sum(R.controls > x)) S.fn <- sapply(1:n, function(x) sum(S.cases <= x)) S.fp <- sapply(1:n, function(x) sum(S.controls > x)) return(sum(abs((S.fn + S.fp) - (R.fn + R.fp)))) } venkatraman.unpaired.stat <- function(R, S, D1, D2, levels1, levels2, mp) { R.controls <- R[D1==levels1[1]] R.cases <- R[D1==levels1[2]] S.controls <- S[D2==levels2[1]] S.cases <- S[D2==levels2[2]] n <- length(D1) m <- length(D2) R.fx <- sapply(1:n, function(x) sum(R.cases <= x)) / length(R.cases) R.gx <- sapply(1:n, function(x) sum(R.controls <= x)) / length(R.controls) S.fx <- sapply(1:m, function(x) sum(S.cases <= x)) / length(S.cases) S.gx <- sapply(1:m, function(x) sum(S.controls <= x)) / length(S.controls) R.p <- mp*R.fx + (1 - mp)*R.gx S.p <- mp*S.fx + (1 - mp)*S.gx R.exp <- mp*R.fx + (1 - mp)*(1-R.gx) S.exp <- mp*S.fx + (1 - mp)*(1-S.gx) # Do the integration x <- sort(c(R.p, S.p)) R.f <- approxfun(R.p, R.exp) S.f <- approxfun(S.p, S.exp) f <- function(x) abs(R.f(x)-S.f(x)) y <- f(x) #trapezoid integration: idx <- 2:length(x) integral <- sum(((y[idx] + y[idx-1]) * (x[idx] - x[idx-1])) / 2, na.rm=TRUE) # remove NA that can appear in the borders return(integral) } pROC/R/roc.R0000644000176200001440000004411214114130125012156 0ustar liggesusers# pROC: Tools Receiver operating characteristic (ROC curves) with # (partial) area under the curve, confidence intervals and comparison. # Copyright (C) 2010-2014 Xavier Robin, Alexandre Hainard, Natacha Turck, # Natalia Tiberti, Frédérique Lisacek, Jean-Charles Sanchez # and Markus Müller # # This program is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, either version 3 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program. If not, see . roc <- function(...) { UseMethod("roc") } roc.formula <- function (formula, data, ...) { data.missing <- missing(data) roc.data <- roc.utils.extract.formula(formula, data, ..., data.missing = data.missing, call = match.call()) response <- roc.data$response predictors <- roc.data$predictors if (length(response) == 0) { stop("Error in the formula: a response is required in a formula of type response~predictor.") } if (ncol(predictors) == 1) { roc <- roc.default(response, predictors[, 1], ...) roc$call <- match.call() if (!is.null(roc$smooth)) attr(roc, "roc")$call <- roc$call return(roc) } else if (ncol(predictors) > 1) { roclist <- lapply(roc.data$predictor.names, function(predictor, formula, m.data, call, ...) { # Get one ROC roc <- roc.default(response, m.data[[predictor]], ...) # Update the call to reflect the parents formula[3] <- call(predictor) # replace the predictor in formula call$formula <- formula # Replace modified formula roc$call <- call return(roc) }, formula = formula, m.data = predictors, call = match.call(), ...) # Set the list names names(roclist) <- roc.data$predictor.names return(roclist) } else { stop("Invalid formula:at least 1 predictor is required in a formula of type response~predictor.") } } roc.data.frame <- function(data, response, predictor, ret = c("roc", "coords", "all_coords"), ...) { ret <- match.arg(ret) if (is.character(substitute(response))) { response_name <- response } else { response_name <- deparse(substitute(response)) } if (is.character(substitute(predictor))) { predictor_name <- predictor } else { predictor_name <- deparse(substitute(predictor)) } if (any(! c(response_name, predictor_name) %in% colnames(data))) { # Some column is not in data. This could be a genuine error or the user not aware or NSE and wants to use roc_ instead warning("This method uses non-standard evaluation (NSE). Did you want to use the `roc_` function instead?") } r <- roc_(data, response_name, predictor_name, ret = ret, ...) if (ret == "roc") { r$call <- match.call() } return(r) } roc_ <- function(data, response, predictor, ret = c("roc", "coords", "all_coords"), ...) { ret <- match.arg(ret) # Ensure the data contains the columns we need # In case of an error we want to show the name of the data. If the function # was called from roc.data.frame we want to deparse in that environment instead if (sys.nframe() > 1 && deparse(sys.calls()[[sys.nframe()-1]][[1]]) == "roc.data.frame") { data_name <- deparse(substitute(data, parent.frame(n = 1))) } else { data_name <- deparse(substitute(data)) } if (! response %in% colnames(data)) { stop(sprintf("Column %s not present in data %s", response, data_name)) } if (! predictor %in% colnames(data)) { stop(sprintf("Column '%s' not present in data %s", predictor, data_name)) } r <- roc(data[[response]], data[[predictor]], ...) if (ret == "roc") { r$call <- match.call() return(r) } else if (ret == "coords") { co <- coords(r, x = "all", transpose = FALSE) rownames(co) <- NULL return(co) } else if (ret == "all_coords") { co <- coords(r, x = "all", ret="all", transpose = FALSE) rownames(co) <- NULL return(co) } } roc.default <- function(response, predictor, controls, cases, density.controls, density.cases, # data interpretation levels=base::levels(as.factor(response)), # precise the levels of the responses as c("control group", "positive group"). Can be used to ignore some response levels. percent=FALSE, # Must sensitivities, specificities and AUC be reported in percent? Note that if TRUE, and you want a partial area, you must pass it in percent also (partial.area=c(100, 80)) na.rm=TRUE, direction=c("auto", "<", ">"), # direction of the comparison. Auto: automatically define in which group the median is higher and take the good direction to have an AUC >= 0.5 algorithm=6, quiet = FALSE, # what computation must be done smooth=FALSE, # call smooth.roc on the current object auc=TRUE, # call auc.roc on the current object ci=FALSE, # call ci.roc on the current object plot=FALSE, # call plot.roc on the current object # disambiguate method/n for ci and smooth smooth.method="binormal", smooth.n=512, ci.method=NULL, # capture density for smooth.roc here (do not pass to graphical functions) density=NULL, # further arguments passed to plot, auc, ci, smooth. ... ) { # Check arguments direction <- match.arg(direction) # Response / Predictor if (!missing(response) && !is.null(response) && !missing(predictor) && !is.null(predictor)) { # Forbid case/controls if ((!missing(cases) && !is.null(cases)) || (!missing(controls) && !is.null(controls))) { stop("'cases/controls' argument incompatible with 'response/predictor'.") } # Forbid density if ((!missing(density.cases) && !is.null(density.cases)) || (!missing(density.controls) && !is.null(density.controls))) { stop("'density.*' arguments incompatible with 'response/predictor'.") } original.predictor <- predictor # store a copy of the original predictor (before converting ordered to numeric and removing NA) original.response <- response # store a copy of the original predictor (before converting ordered to numeric) # Validate levels if (missing(levels)) { if (length(levels) > 2) { warning("'response' has more than two levels. Consider setting 'levels' explicitly or using 'multiclass.roc' instead") levels <- levels[1:2] } else if (length(levels) < 2) { stop("'response' must have two levels") } ifelse(quiet, invisible, message)(sprintf("Setting levels: control = %s, case = %s", levels[1], levels[2])) } else if (length(levels) != 2) { stop("'levels' argument must have length 2") } # ensure predictor is numeric or ordered if (!is.numeric(predictor)) { if (is.ordered(predictor)) { predictor <- tryCatch( { as.numeric(as.character(predictor)) }, warning = function(warn) { warning("Ordered predictor converted to numeric vector. Threshold values will not correspond to values in predictor.") return(as.numeric(predictor)) } ) } else { stop("Predictor must be numeric or ordered.") } } if (is.matrix(predictor)) { warning("Deprecated use a matrix as predictor. Unexpected results may be produced, please pass a numeric vector.") } if (is.matrix(response)) { warning("Deprecated use a matrix as response. Unexpected results may be produced, please pass a vector or factor.") } # also make sure response and predictor are vectors of the same length if (length(predictor) != length(response)) { stop("Response and predictor must be vectors of the same length.") } # remove NAs if requested if (na.rm) { nas <- is.na(response) | is.na(predictor) if (any(nas)) { na.action <- grep(TRUE, nas) class(na.action) <- "omit" response <- response[!nas] attr(response, "na.action") <- na.action predictor <- predictor[!nas] attr(predictor, "na.action") <- na.action } } else if(any(is.na(c(predictor[response==levels[1]], predictor[response==levels[2]], response)))) # Unable to compute anything if there is any NA in the response or in the predictor data we want to consider ! return(NA) splitted <- split(predictor, response) controls <- splitted[[as.character(levels[1])]] if (length(controls) == 0) stop("No control observation.") cases <- splitted[[as.character(levels[2])]] if (length(cases) == 0) stop("No case observation.") # Remove patients not in levels patients.in.levels <- response %in% levels if (!all(patients.in.levels)) { response <- response[patients.in.levels] predictor <- predictor[patients.in.levels] } # Check infinities if (any(which <- is.infinite(predictor))) { warning("Infinite values(s) in predictor, cannot build a valid ROC curve. NaN returned instead.") return(NaN) } } # Cases / Controls else if (!missing(cases) && !is.null(cases) && !missing(controls) && !is.null(controls)) { # Forbid density if ((!missing(density.cases) && !is.null(density.cases)) || (!missing(density.controls) && !is.null(density.controls))) { stop("'density.*' arguments incompatible with 'response/predictor'.") } # remove nas if (na.rm) { if (any(is.na(controls))) controls <- na.omit(controls) if (any(is.na(cases))) cases <- na.omit(cases) } else if (any(is.na(c(controls, cases)))) # Unable to compute anything if there is any NA in the data we want to consider ! return(NA) # are there empty cats? if (length(controls) == 0) stop("No control observation.") if (length(cases) == 0) stop("No case observation.") # check data consistency if (is.ordered(cases)) { if (is.ordered(controls)) { if (identical(attr(cases, "levels"), attr(controls, "levels"))) { # merge original.predictor <- ordered(c(as.character(cases), as.character(controls)), levels = attr(controls, "levels")) # Predictor, control and cases must be numeric from now on predictor <- as.numeric(original.predictor) controls <- as.numeric(controls) cases <- as.numeric(cases) } else { stop("Levels of cases and controls differ.") } } else { stop("Cases are of ordered type but controls are not.") } } else if (is.numeric(cases)) { if (is.numeric(controls)) { # build response/predictor predictor <- c(controls, cases) original.predictor <- predictor } else { stop("Cases are of numeric type but controls are not.") } } else { stop("Cases and controls must be numeric or ordered.") } # Check infinities if (any(which <- is.infinite(predictor))) { warning("Infinite values(s) in predictor, cannot build a valid ROC curve. NaN returned instead.") return(NaN) } response <- c(rep(0, length(controls)), rep(1, length(cases))) original.response <- response levels <- c(0, 1) } else if (!missing(density.cases) && !is.null(density.cases) && !missing(density.controls) && !is.null(density.controls)) { if (!is.numeric(density.cases) || !is.numeric(density.controls)) stop("'density.cases' and 'density.controls' must be numeric values of density (over the y axis).") if (direction == "auto") dir <- "<" else dir <- direction smooth.roc <- smooth.roc.density(density.controls=density.controls, density.cases=density.cases, percent=percent, direction=dir) class(smooth.roc) <- "smooth.roc" smooth.roc <- sort(smooth.roc) # sort se and sp # anchor SE/SP at 0/100 smooth.roc$specificities <- c(0, as.vector(smooth.roc$specificities), ifelse(percent, 100, 1)) smooth.roc$sensitivities <- c(ifelse(percent, 100, 1), as.vector(smooth.roc$sensitivities), 0) smooth.roc$percent <- percent # keep some basic roc specifications smooth.roc$direction <- direction smooth.roc$call <- match.call() if (auc) { smooth.roc$auc <- auc(smooth.roc, ...) if (direction == "auto" && smooth.roc$auc < roc.utils.min.partial.auc.auc(smooth.roc$auc)) { smooth.roc <- roc.default(density.controls=density.controls, density.cases=density.cases, levels=levels, percent=percent, direction=">", auc=auc, ci=ci, plot=plot, ...) smooth.roc$call <- match.call() return(smooth.roc) } } if (ci) warning("CI can not be computed with densities.") if (plot) plot.roc(smooth.roc, ...) return(smooth.roc) } else { stop("No valid data provided.") } if (direction == "auto" && median(controls) <= median(cases)) { direction <- "<" ifelse(quiet, invisible, message)("Setting direction: controls < cases") } else if (direction == "auto" && median(controls) > median(cases)) { direction <- ">" ifelse(quiet, invisible, message)("Setting direction: controls > cases") } # smooth with densities, but only density was provided, not density.controls/cases if (smooth) { if (missing(density.controls)) density.controls <- density if (missing(density.cases)) density.cases <- density } # Choose algorithm if (isTRUE(algorithm == 6)) { if (is.numeric(predictor)) { algorithm <- 2 } else { algorithm <- 3 } } else if (isTRUE(algorithm == 0)) { load.suggested.package("microbenchmark") cat("Starting benchmark of algorithms 2 and 3, 10 iterations...\n") thresholds <- roc.utils.thresholds(c(controls, cases), direction) benchmark <- microbenchmark::microbenchmark( # "1" = roc.utils.perfs.all.safe(thresholds=thresholds, controls=controls, cases=cases, direction=direction), "2" = roc.utils.perfs.all.fast(thresholds=thresholds, controls=controls, cases=cases, direction=direction), "3" = rocUtilsPerfsAllC(thresholds=thresholds, controls=controls, cases=cases, direction=direction), times = 10 ) print(summary(benchmark)) if (any(is.na(benchmark))) { warning("Microbenchmark returned NA. Using default algorithm 1.") algorithm <- 2 } algorithm <- as.integer(names(which.min(tapply(benchmark$time, benchmark$expr, sum)))) cat(sprintf("Selecting algorithm %s.\n", algorithm)) } else if (isTRUE(algorithm == 5)) { thresholds <- length(roc.utils.thresholds(c(controls, cases), direction)) if (thresholds > 55) { # critical number determined in inst/extra/algorithms.speed.test.R algorithm <- 2 } else { algorithm <- 3 } } if (isTRUE(algorithm == 2)) { fun.sesp <- roc.utils.perfs.all.fast } else if (isTRUE(algorithm == 3)) { fun.sesp <- rocUtilsPerfsAllC } else if (isTRUE(algorithm == 1)) { fun.sesp <- roc.utils.perfs.all.safe } else if (isTRUE(algorithm == 4)) { fun.sesp <- roc.utils.perfs.all.test } else { stop("Unknown algorithm (must be 0, 1, 2, 3, 4 or 5).") } roc <- roc.cc.nochecks(controls, cases, percent=percent, direction=direction, fun.sesp=fun.sesp, smooth = smooth, density.cases = density.cases, density.controls = density.controls, smooth.method = smooth.method, smooth.n = smooth.n, auc, ...) roc$call <- match.call() if (smooth) { attr(roc, "roc")$call <- roc$call attr(roc, "roc")$original.predictor <- original.predictor attr(roc, "roc")$original.response <- original.response attr(roc, "roc")$predictor <- predictor attr(roc, "roc")$response <- response attr(roc, "roc")$levels <- levels } roc$original.predictor <- original.predictor roc$original.response <- original.response roc$predictor <- predictor roc$response <- response roc$levels <- levels if (auc) { attr(roc$auc, "roc") <- roc } # compute CI if (ci) roc$ci <- ci(roc, method=ci.method, ...) # plot if (plot) plot.roc(roc, ...) # return roc return(roc) } #' Creates a ROC object from response, predictor, ... without argument checking. Not to be exposed to the end user roc.rp.nochecks <- function(response, predictor, levels, ...) { splitted <- split(predictor, response) controls <- splitted[[as.character(levels[1])]] if (length(controls) == 0) stop("No control observation.") cases <- splitted[[as.character(levels[2])]] if (length(cases) == 0) stop("No case observation.") roc.cc.nochecks(controls, cases, ...) } #' Creates a ROC object from controls, cases, ... without argument checking. Not to be exposed to the end user roc.cc.nochecks <- function(controls, cases, percent, direction, fun.sesp, smooth, smooth.method, smooth.n, auc, ...) { # create the roc object roc <- list() class(roc) <- "roc" roc$percent <- percent # compute SE / SP thresholds <- roc.utils.thresholds(c(controls, cases), direction) perfs <- fun.sesp(thresholds=thresholds, controls=controls, cases=cases, direction=direction) se <- perfs$se sp <- perfs$sp if (percent) { se <- se*100 sp <- sp*100 } # store the computations in the roc object roc$sensitivities <- se roc$specificities <- sp roc$thresholds <- thresholds roc <- sort(roc) roc$direction <- direction roc$cases <- cases roc$controls <- controls roc$fun.sesp <- fun.sesp if (smooth) { roc <- smooth.roc(roc, method=smooth.method, n=smooth.n, ...) } # compute AUC if (auc) roc$auc <- auc.roc(roc, ...) return(roc) } pROC/R/ci.coords.R0000644000176200001440000001775013607143106013277 0ustar liggesusers# pROC: Tools Receiver operating characteristic (ROC curves) with # (partial) area under the curve, confidence intervals and comparison. # Copyright (C) 2010-2014 Xavier Robin, Alexandre Hainard, Natacha Turck, # Natalia Tiberti, Frédérique Lisacek, Jean-Charles Sanchez # and Markus Müller # # This program is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, either version 3 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program. If not, see . ci.coords <- function(...) { UseMethod("ci.coords") } ci.coords.formula <- function(formula, data, ...) { data.missing <- missing(data) roc.data <- roc.utils.extract.formula(formula, data, ..., data.missing = data.missing, call = match.call()) if (length(roc.data$predictor.name) > 1) { stop("Only one predictor supported in 'ci.coords'.") } response <- roc.data$response predictor <- roc.data$predictors[, 1] ci.coords(roc(response, predictor, ci=FALSE, ...), ...) } ci.coords.default <- function(response, predictor, ...) { if (methods::is(response, "multiclass.roc") || methods::is(response, "multiclass.auc")) { stop("'ci.coords' not available for multiclass ROC curves.") } roc <- roc.default(response, predictor, ci = FALSE, ...) if (methods::is(roc, "smooth.roc")) { return(ci.coords(smooth.roc = roc, ...)) } else { return(ci.coords(roc = roc, ...)) } } ci.coords.smooth.roc <- function(smooth.roc, x, input=c("specificity", "sensitivity"), ret=c("specificity", "sensitivity"), best.method=c("youden", "closest.topleft"), best.weights=c(1, 0.5), best.policy = c("stop", "omit", "random"), conf.level = 0.95, boot.n = 2000, boot.stratified = TRUE, progress = getOption("pROCProgress")$name, ... ) { if (conf.level > 1 | conf.level < 0) stop("'conf.level' must be within the interval [0,1].") if (roc.utils.is.perfect.curve(smooth.roc)) { warning("ci.coords() of a ROC curve with AUC == 1 is always a null interval and can be misleading.") } input <- match.arg(input) ret <- roc.utils.match.coords.ret.args(ret) best.policy <- match.arg(best.policy) if (is.character(x)) { x <- match.arg(x, c("all", "local maximas", "best")) if (x == "all" || x == "local maximas") { stop("'all' and 'local maximas' are not available for confidence intervals.") } } # Check if called with density.cases or density.controls if (is.null(smooth.roc$smoothing.args) || is.numeric(smooth.roc$smoothing.args$density.cases) || is.numeric(smooth.roc$smoothing.args$density.controls)) stop("Cannot compute CI of ROC curves smoothed with numeric density.controls and density.cases.") # Get the non smoothed roc. roc <- attr(smooth.roc, "roc") roc$ci <- NULL # remove potential ci in roc to avoid infinite loop with smooth.roc() # prepare the calls smooth.roc.call <- as.call(c(utils::getS3method("smooth", "roc"), smooth.roc$smoothing.args)) if(class(progress) != "list") progress <- roc.utils.get.progress.bar(progress, title="Coords confidence interval", label="Bootstrap in progress...", ...) if (boot.stratified) { perfs <- raply(boot.n, stratified.ci.smooth.coords(roc, x, input, ret, best.method, best.weights, smooth.roc.call, best.policy), .progress=progress, .drop=FALSE) } else { perfs <- raply(boot.n, nonstratified.ci.smooth.coords(roc, x, input, ret, best.method, best.weights,smooth.roc.call, best.policy), .progress=progress, .drop=FALSE) } if (any(which.ones <- apply(perfs, 1, function(x) all(is.na(x))))) { if (all(which.ones)) { warning("All bootstrap iterations produced NA values only.") } else { how.many <- sum(which.ones) warning(sprintf("%s NA value(s) produced during bootstrap were ignored.", how.many)) } } summarized.perfs <- apply(perfs, c(2, 3), quantile, probs=c(0+(1-conf.level)/2, .5, 1-(1-conf.level)/2), na.rm=TRUE) ci <- sapply(ret, function(x) t(summarized.perfs[,,x]), simplify = FALSE) class(ci) <- c("ci.coords", "ci", class(ci)) attr(ci, "input") <- input attr(ci, "x") <- x attr(ci, "ret") <- ret attr(ci, "conf.level") <- conf.level attr(ci, "boot.n") <- boot.n attr(ci, "boot.stratified") <- boot.stratified attr(ci, "roc") <- smooth.roc return(ci) } ci.coords.roc <- function(roc, x, input=c("threshold", "specificity", "sensitivity"), ret=c("threshold", "specificity", "sensitivity"), best.method=c("youden", "closest.topleft"), best.weights=c(1, 0.5), best.policy = c("stop", "omit", "random"), conf.level = 0.95, boot.n = 2000, boot.stratified = TRUE, progress = getOption("pROCProgress")$name, ... ) { if (conf.level > 1 | conf.level < 0) stop("'conf.level' must be within the interval [0,1].") if (roc.utils.is.perfect.curve(roc)) { warning("ci.coords() of a ROC curve with AUC == 1 is always a null interval and can be misleading.") } input <- match.arg(input) if (missing(ret) && input != "threshold") { # Don't show NA thresholds by default ret <- roc.utils.match.coords.ret.args(ret, threshold = FALSE) } else { ret <- roc.utils.match.coords.ret.args(ret) } best.policy <- match.arg(best.policy) if (is.character(x)) { x <- match.arg(x, c("all", "local maximas", "best")) if (x == "all" || x == "local maximas") { stop("'all' and 'local maximas' are not available for confidence intervals.") } } if ("threshold" %in% ret && ! (identical(x, "best") || input == "threshold")) { stop("'threshold' output is only supported for best ROC point ('x = \"best\"') or if \"threshold\" was given as input.") } if(class(progress) != "list") progress <- roc.utils.get.progress.bar(progress, title="Coords confidence interval", label="Bootstrap in progress...", ...) if (boot.stratified) { perfs <- raply(boot.n, stratified.ci.coords(roc, x, input, ret, best.method, best.weights, best.policy), .progress=progress, .drop = FALSE) } else { perfs <- raply(boot.n, nonstratified.ci.coords(roc, x, input, ret, best.method, best.weights, best.policy), .progress=progress, .drop = FALSE) } if (any(which.ones <- apply(perfs, 1, function(x) all(is.na(x))))) { if (all(which.ones)) { warning("All bootstrap iterations produced NA values only.") } else { how.many <- sum(which.ones) warning(sprintf("%s NA value(s) produced during bootstrap were ignored.", how.many)) } } summarized.perfs <- apply(perfs, c(2, 3), quantile, probs=c(0+(1-conf.level)/2, .5, 1-(1-conf.level)/2), na.rm=TRUE) ci <- sapply(ret, function(x) t(summarized.perfs[,,x]), simplify = FALSE) class(ci) <- c("ci.coords", "ci", class(ci)) attr(ci, "input") <- input attr(ci, "x") <- x attr(ci, "ret") <- ret attr(ci, "conf.level") <- conf.level attr(ci, "boot.n") <- boot.n attr(ci, "boot.stratified") <- boot.stratified attr(ci, "roc") <- roc return(ci) } # Function to be called when "best" threshold returned more than 1 column # Will follow the action defined by best.policy # For instance: # if (x == "best" && nrow(res) != 1) { # return(enforce.best.policy(res, best.policy)) # } enforce.best.policy <- function(res, best.policy) { if (best.policy == "stop") { stop("More than one \"best\" threshold was found, aborting. Change 'best.policy' to alter this behavior.") } else if (best.policy == "omit") { res[1, ] <- NA return(res[1, drop = FALSE]) } else { return(res[sample(seq_len(nrow(res)), size = 1), , drop = FALSE]) } } pROC/R/smooth.R0000644000176200001440000002572014114130125012710 0ustar liggesusers# pROC: Tools Receiver operating characteristic (ROC curves) with # (partial) area under the curve, confidence intervals and comparison. # Copyright (C) 2010-2014 Xavier Robin, Alexandre Hainard, Natacha Turck, # Natalia Tiberti, Frédérique Lisacek, Jean-Charles Sanchez # and Markus Müller # # This program is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, either version 3 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program. If not, see . smooth <- function(...) UseMethod("smooth") smooth.default <- function(...) { stats::smooth(...) } smooth.smooth.roc <- function(smooth.roc, ...) { roc <- attr(smooth.roc, "roc") if (is.null(roc)) stop("Cannot smooth a ROC curve generated directly with numeric 'density.controls' and 'density.cases'.") smooth.roc(roc, ...) } smooth.roc <- function(roc, method = c("binormal", "density", "fitdistr", "logcondens", "logcondens.smooth"), n = 512, bw = "nrd0", density = NULL, density.controls = density, density.cases = density, start = NULL, start.controls = start, start.cases = start, reuse.auc = TRUE, reuse.ci = FALSE, ...) { method <- match.arg(method) if (is.ordered(roc$original.predictor) && (method == "density" || method =="fitidstr")) stop("ROC curves of ordered predictors can be smoothed only with binormal smoothing.") if (method == "binormal") { sesp <- smooth.roc.binormal(roc, n) } else if (method == "fitdistr") { sesp <- smooth.roc.fitdistr(roc, n, density.controls, density.cases, start.controls, start.cases, ...) } else if (method == "density") { sesp <- smooth.roc.density(roc, n, density.controls, density.cases, bw, ...) } else if (method == "logcondens") { sesp <- smooth.roc.logcondens(roc, n) } else if (method == "logcondens.smooth") { sesp <- smooth.roc.logcondens.smooth(roc, n) } else { stop(sprintf("Impossible smooth method value '%s'. Please report this bug to <%s>.", method, utils::packageDescription("pROC")$BugReports)) } class(sesp) <- "smooth.roc" sesp <- sort(sesp) # sort se and sp # anchor SE/SP at 0/100 sesp$specificities <- c(0, as.vector(sesp$specificities), ifelse(roc$percent, 100, 1)) sesp$sensitivities <- c(ifelse(roc$percent, 100, 1), as.vector(sesp$sensitivities), 0) attr(sesp, "roc") <- roc # keep the original roc. May be useful in CI. sesp$percent <- roc$percent # keep some basic roc specifications sesp$direction <- roc$direction sesp$call <- match.call() # keep smoothing arguments (for print and bootstrap) sesp$smoothing.args <- list(...) sesp$smoothing.args$method <- method sesp$smoothing.args$n <- n sesp$smoothing.args$start.controls <- start.controls sesp$smoothing.args$start.cases <- start.cases sesp$smoothing.args$density.controls <- density.controls sesp$smoothing.args$density.cases <- density.cases sesp$smoothing.args$bw <- bw # complete fit.controls/cases if a function was passed as densfun if (method == "fitdistr") { if (is.null(sesp$fit.controls$densfun)) { if (missing(density.controls)) sesp$fit.controls$densfun <- deparse(substitute(density)) else sesp$fit.controls$densfun <- deparse(substitute(density.controls)) } if (is.null(sesp$fit.cases$densfun)) { if (missing(density.cases)) sesp$fit.cases$densfun <- deparse(substitute(density)) else sesp$fit.cases$densfun <- deparse(substitute(density.cases)) } } # if there was an auc and a ci, re-do them if (!is.null(roc$auc) && reuse.auc) { args <- attributes(roc$auc) args$roc <- NULL args$smooth.roc <- sesp sesp$auc <- do.call("auc.smooth.roc", args) } if (!is.null(roc$ci) && reuse.ci){ args <- attributes(roc$ci) args$roc <- NULL args$smooth.roc <- sesp sesp$ci <- do.call(paste(class(roc$ci), "smooth.roc", sep="."), args) } return(sesp) } smooth.roc.density <- function(roc, n, density.controls, density.cases, bw, # catch args for density cut = 3, adjust = 1, kernel = window, window = "gaussian", percent = roc$percent, direction = roc$direction, ...) { if (!is.numeric(density.controls) || !is.numeric(density.cases)) { predictor <- c(roc$controls, roc$cases) if (is.character(bw)) { bw <- match.fun(paste("bw", bw, sep="."))(predictor) } bw <- bw * adjust from <- min(predictor) - (cut * bw) to <- max(predictor) + (cut * bw) } if (mode(density.controls) == "function") { density.controls <- density.controls(roc$controls, n=n, from=from, to=to, bw=bw, kernel=kernel, ...) if (! is.numeric(density.controls)) { if (is.list(density.controls) && !is.null(density.controls$y) && is.numeric(density.controls$y)) density.controls <- density.controls$y else stop("The 'density' function must return a numeric vector or a list with a 'y' item.") } } else if (is.null(density.controls)) density.controls <- suppressWarnings(density(roc$controls, n=n, from=from, to=to, bw=bw, kernel=kernel, ...))$y else if (! is.numeric(density.controls)) stop("'density.controls' must be either NULL, a function or numeric values of density (over the y axis).") if (mode(density.cases) == "function") { density.cases <- density.cases(roc$cases, n=n, from=from, to=to, bw=bw, kernel=kernel, ...) if (! is.numeric(density.cases)) { if (is.list(density.cases) && !is.null(density.cases$y) && is.numeric(density.cases$y)) density.cases <- density.cases$y else stop("The 'density' function must return a numeric vector or a list with a 'y' item.") } } else if (is.null(density.cases)) density.cases <- suppressWarnings(density(roc$cases, n=n, from=from, to=to, bw=bw, kernel=kernel, ...))$y else if (! is.numeric(density.cases)) stop("'density.cases' must be either NULL, a function or numeric values of density (over the y axis).") if (length(density.controls) != length(density.cases)) stop("Length of 'density.controls' and 'density.cases' differ.") perfs <- sapply((1:length(density.controls))+.5, roc.utils.perfs.dens, x=(1:length(density.controls))+.5, dens.controls=density.controls, dens.cases=density.cases, direction=direction) return(list(sensitivities = perfs[2,] * ifelse(percent, 100, 1), specificities = perfs[1,] * ifelse(percent, 100, 1))) } smooth.roc.binormal <- function(roc, n) { df <- data.frame(sp=qnorm(roc$sp * ifelse(roc$percent, 1/100, 1)), se=qnorm(roc$se * ifelse(roc$percent, 1/100, 1))) df <- df[apply(df, 1, function(x) all(is.finite(x))),] if (dim(df)[1] <= 1) # ROC curve or with only 1 point stop("ROC curve not smoothable (not enough points).") model <- lm(sp~se, df) if(any(is.na(model$coefficients[2]))) stop("ROC curve not smoothable (not enough points).") se <- qnorm(seq(0, 1, 1/(n-1))) sp <- predict(model, data.frame(se)) return(list(sensitivities = pnorm(se) * ifelse(roc$percent, 100, 1), specificities = pnorm(sp) * ifelse(roc$percent, 100, 1), model = model)) } smooth.roc.fitdistr <- function(roc, n, densfun.controls, densfun.cases, start.controls, start.cases, ...) { load.suggested.package("MASS") densfuns.list <- list(beta = "dbeta", cauchy = "dcauchy", "chi-squared" = "dchisq", exponential = "dexp", f = "df", gamma = "dgamma", geometric = "dgeom", "log-normal" = "dlnorm", lognormal = "dlnorm", logistic = "dlogis", "negative binomial" = "dnbinom", normal = "dnorm", poisson = "dpois", t = "dt", weibull = "dweibull") if (is.null(densfun.controls)) densfun.controls <- "normal" else if (is.character(densfun.controls)) densfun.controls <- match.arg(densfun.controls, names(densfuns.list)) if (is.null(densfun.cases)) densfun.cases <- "normal" else if (is.character(densfun.cases)) densfun.cases <- match.arg(densfun.cases, names(densfuns.list)) fit.controls <- MASS::fitdistr(roc$controls, densfun.controls, start.controls, ...) fit.cases <- MASS::fitdistr(roc$cases, densfun.cases, start.cases, ...) # store function name in fitting results if (mode(densfun.controls) != "function") fit.controls$densfun <- densfun.controls if (mode(densfun.cases) != "function") fit.cases$densfun <- densfun.cases x <- seq(min(c(roc$controls, roc$cases)), max(c(roc$controls, roc$cases)), length.out=n) # get the actual function name for do.call if (is.character(densfun.controls)) densfun.controls <- match.fun(densfuns.list[[densfun.controls]]) if (is.character(densfun.cases)) densfun.cases <- match.fun(densfuns.list[[densfun.cases]]) # ... that should be passed to densfun if (length(list(...)) > 0 && any(names(list(...)) %in% names(formals(densfun.controls)))) dots.controls <- list(...)[names(formals(densfun.controls))[match(names(list(...)), names(formals(densfun.controls)))]] else dots.controls <- list() if (length(list(...)) > 0 && any(names(list(...)) %in% names(formals(densfun.cases)))) dots.cases <- list(...)[names(formals(densfun.cases))[match(names(list(...)), names(formals(densfun.cases)))]] else dots.cases <- list() density.controls <- do.call(densfun.controls, c(list(x=x), fit.controls$estimate, dots.controls)) density.cases <- do.call(densfun.cases, c(list(x=x), fit.cases$estimate, dots.cases)) perfs <- sapply(x, roc.utils.perfs.dens, x=x, dens.controls=density.controls, dens.cases=density.cases, direction=roc$direction) return(list(sensitivities = perfs[2,] * ifelse(roc$percent, 100, 1), specificities = perfs[1,] * ifelse(roc$percent, 100, 1), fit.controls=fit.controls, fit.cases=fit.cases)) } smooth.roc.logcondens <- function(roc, n) { load.suggested.package("logcondens") sp <- seq(0, 1, 1/(n-1)) logcondens <- logcondens::logConROC(roc$cases, roc$controls, sp) se <- logcondens$fROC return(list(sensitivities = se * ifelse(roc$percent, 100, 1), specificities = (1 - sp) * ifelse(roc$percent, 100, 1), logcondens = logcondens)) } smooth.roc.logcondens.smooth <- function(roc, n) { load.suggested.package("logcondens") sp <- seq(0, 1, 1/(n-1)) logcondens <- logcondens::logConROC(roc$cases, roc$controls, sp) se <- logcondens$fROC.smooth return(list(sensitivities = se * ifelse(roc$percent, 100, 1), specificities = (1 - sp) * ifelse(roc$percent, 100, 1), logcondens = logcondens)) } pROC/R/ggroc.R0000644000176200001440000000566714114130125012510 0ustar liggesusers #' Returns the coords as a data.frame in the right ordering for ggplot2 get.coords.for.ggplot <- function(roc) { df <- coords(roc, "all", transpose = FALSE) return(df[rev(seq(nrow(df))),]) } get.aes.for.ggplot <- function(roc, legacy.axes, extra_aes = c()) { # Prepare the aesthetics if(roc$percent) { if (legacy.axes) { aes_list <- list(x = "1-specificity", y = "sensitivity") xlims <- ggplot2::scale_x_continuous(lim=c(0, 100)) } else { aes_list <- list(x = "specificity", y = "sensitivity") xlims <- ggplot2::scale_x_reverse(lim=c(100, 0)) } } else { if (legacy.axes) { aes_list <- list(x = "1-specificity", y = "sensitivity") xlims <- ggplot2::scale_x_continuous(lim=c(0, 1)) } else { aes_list <- list(x = "specificity", y = "sensitivity") xlims <- ggplot2::scale_x_reverse(lim=c(1, 0)) } } # Add extra aes for (ae in extra_aes) { aes_list[[ae]] <- "name" } aes <- do.call(ggplot2::aes_string, aes_list) return(list(aes=aes, xlims=xlims)) } load.ggplot2 <- function() { if (! isNamespaceLoaded("ggplot2")) { message('You may need to call library(ggplot2) if you want to add layers, etc.') } load.suggested.package("ggplot2") } ggroc <- function(data, ...) { UseMethod("ggroc") } ggroc.roc <- function(data, legacy.axes = FALSE, ...) { load.ggplot2() # Get the roc data with coords df <- get.coords.for.ggplot(data) # Prepare the aesthetics aes <- get.aes.for.ggplot(data, legacy.axes) # Do the plotting ggplot2::ggplot(df) + ggplot2::geom_line(aes$aes, ...) + aes$xlims } ggroc.smooth.roc <- ggroc.roc ggroc.list <- function(data, aes = c("colour", "alpha", "linetype", "size", "group"), legacy.axes = FALSE, ...) { load.ggplot2() if (missing(aes)) { aes <- "colour" } aes <- sub("color", "colour", aes) aes <- match.arg(aes, several.ok = TRUE) # Make sure data is a list and every element is a roc object if (! all(sapply(data, methods::is, "roc") | sapply(data, methods::is, "smooth.roc"))) { stop("All elements in 'data' must be 'roc' objects.") } # Make sure percent is consistent percents <- sapply(data, `[[`, "percent") if (!(all(percents) || all(!percents))) { stop("ROC curves use percent inconsistently and cannot be plotted together") } # Make sure the data is a named list if (is.null(names(data))) { names(data) <- seq(data) } # Make sure names are unique: if (any(duplicated(names(data)))) { stop("Names of 'data' must be unique") } # Get the coords coord.dfs <- sapply(data, get.coords.for.ggplot, simplify = FALSE) # Add a "name" colummn for (i in seq_along(coord.dfs)) { coord.dfs[[i]]$name <- names(coord.dfs)[i] } # Make a big data.frame coord.dfs <- do.call(rbind, coord.dfs) coord.dfs$name <- factor(coord.dfs$name, as.vector(names(data))) # Prepare the aesthetics aes.ggplot <- get.aes.for.ggplot(data[[1]], legacy.axes, aes) # Do the plotting ggplot2::ggplot(coord.dfs, aes.ggplot$aes) + ggplot2::geom_line(...) + aes.ggplot$xlims } pROC/R/ci.auc.R0000644000176200001440000001605013607143106012546 0ustar liggesusers# pROC: Tools Receiver operating characteristic (ROC curves) with # (partial) area under the curve, confidence intervals and comparison. # Copyright (C) 2010-2014 Xavier Robin, Alexandre Hainard, Natacha Turck, # Natalia Tiberti, Frédérique Lisacek, Jean-Charles Sanchez # and Markus Müller # # This program is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, either version 3 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program. If not, see . ci.auc <- function(...) { UseMethod("ci.auc") } ci.auc.formula <- function(formula, data, ...) { data.missing <- missing(data) roc.data <- roc.utils.extract.formula(formula, data, ..., data.missing = data.missing, call = match.call()) if (length(roc.data$predictor.name) > 1) { stop("Only one predictor supported in 'ci.auc'.") } response <- roc.data$response predictor <- roc.data$predictors[, 1] ci.auc.roc(roc.default(response, predictor, ci=FALSE, ...), ...) } ci.auc.default <- function(response, predictor, ...) { roc <- roc.default(response, predictor, ci = FALSE, ...) if (methods::is(roc, "smooth.roc")) { return(ci.auc(smooth.roc = roc, ...)) } else { return(ci.auc(roc = roc, ...)) } } ci.auc.auc <- function(auc, ...) { roc <- attr(auc, "roc") roc$auc <- auc ci.auc(roc, reuse.auc = TRUE, ...) } ci.auc.smooth.roc <- function(smooth.roc, conf.level = 0.95, boot.n = 2000, boot.stratified = TRUE, reuse.auc=TRUE, progress = getOption("pROCProgress")$name, parallel = FALSE, ... ) { if (conf.level > 1 | conf.level < 0) stop("conf.level must be within the interval [0,1].") if (roc.utils.is.perfect.curve(smooth.roc)) { warning("ci.auc() of a ROC curve with AUC == 1 is always 1-1 and can be misleading.") } # We need an auc if (is.null(smooth.roc$auc) | !reuse.auc) smooth.roc$auc <- auc(smooth.roc, ...) # Check if called with density.cases or density.controls if (is.null(smooth.roc$smoothing.args) || is.numeric(smooth.roc$smoothing.args$density.cases) || is.numeric(smooth.roc$smoothing.args$density.controls)) stop("Cannot compute CI of ROC curves smoothed with numeric density.controls and density.cases.") # Get the non smoothed roc. roc <- attr(smooth.roc, "roc") roc$ci <- NULL # remove potential ci in roc to avoid infinite loop with smooth.roc() # do all the computations in fraction, re-transform in percent later if necessary percent <- smooth.roc$percent smooth.roc$percent <- FALSE roc$percent <- FALSE oldauc <- smooth.roc$auc if (percent) { attr(smooth.roc$auc, "percent") <- FALSE if (! identical(attr(smooth.roc$auc, "partial.auc"), FALSE)) { attr(smooth.roc$auc, "partial.auc") <- attr(smooth.roc$auc, "partial.auc") / 100 } } # prepare the calls smooth.roc.call <- as.call(c(utils::getS3method("smooth", "roc"), smooth.roc$smoothing.args)) auc.args <- attributes(smooth.roc$auc)[grep("partial.auc", names(attributes(smooth.roc$auc)))] auc.args$allow.invalid.partial.auc.correct <- TRUE auc.call <- as.call(c(utils::getS3method("auc", "smooth.roc"), auc.args)) if(class(progress) != "list") progress <- roc.utils.get.progress.bar(progress, title="AUC confidence interval", label="Bootstrap in progress...", ...) if (boot.stratified) { aucs <- unlist(llply(1:boot.n, stratified.ci.smooth.auc, roc=roc, smooth.roc.call=smooth.roc.call, auc.call=auc.call, .progress=progress, .parallel=parallel)) } else { aucs <- unlist(llply(1:boot.n, nonstratified.ci.smooth.auc, roc=roc, smooth.roc.call=smooth.roc.call, auc.call=auc.call, .progress=progress, .parallel=parallel)) } if (sum(is.na(aucs)) > 0) { warning("NA value(s) produced during bootstrap were ignored.") aucs <- aucs[!is.na(aucs)] } # TODO: Maybe apply a correction (it's in the Tibshirani?) What do Carpenter-Bithell say about that? # Prepare the return value ci <- quantile(aucs, c(0+(1-conf.level)/2, .5, 1-(1-conf.level)/2)) if (percent) { ci <- ci * 100 aucs <- aucs * 100 } attr(ci, "conf.level") <- conf.level attr(ci, "method") <- "bootstrap" attr(ci, "boot.n") <- boot.n attr(ci, "boot.stratified") <- boot.stratified attr(ci, "auc") <- oldauc class(ci) <- c("ci.auc", "ci", class(ci)) return(ci) } ci.auc.roc <- function(roc, conf.level = 0.95, method=c("delong", "bootstrap"), boot.n = 2000, boot.stratified = TRUE, reuse.auc=TRUE, progress = getOption("pROCProgress")$name, parallel = FALSE, ... ) { if (conf.level > 1 | conf.level < 0) stop("conf.level must be within the interval [0,1].") if (roc.utils.is.perfect.curve(roc)) { warning("ci.auc() of a ROC curve with AUC == 1 is always 1-1 and can be misleading.") } # We need an auc if (is.null(roc$auc) | !reuse.auc) roc$auc <- auc(roc, ...) # do all the computations in fraction, re-transform in percent later if necessary percent <- roc$percent oldauc <- roc$auc if (percent) { roc <- roc.utils.unpercent(roc) } # Check the method if (missing(method) | is.null(method)) { # determine method if missing if (has.partial.auc(roc)) { # partial auc: go for bootstrap method <- "bootstrap" } else if ("smooth.roc" %in% class(roc)) { # smoothing: bootstrap method <- "bootstrap" } else { method <- "delong" } } else { method <- match.arg(method, c("delong", "bootstrap")) # delong NA to pAUC: warn + change if (has.partial.auc(roc) && method == "delong") { stop("DeLong method is not supported for partial AUC. Use method=\"bootstrap\" instead.") } else if ("smooth.roc" %in% class(roc)) { stop("DeLong method is not supported for smoothed ROCs. Use method=\"bootstrap\" instead.") } } if (method == "delong") ci <- ci.auc.delong(roc, conf.level) else ci <- ci.auc.bootstrap(roc, conf.level, boot.n, boot.stratified, progress, parallel, ...) if (percent) { ci <- ci * 100 } attr(ci, "conf.level") <- conf.level attr(ci, "method") <- method attr(ci, "boot.n") <- boot.n attr(ci, "boot.stratified") <- boot.stratified attr(ci, "auc") <- oldauc class(ci) <- c("ci.auc", "ci", class(ci)) return(ci) } ci.auc.multiclass.roc <- function(multiclass.roc, ...) { stop("CI of a multiclass ROC curve not implemented") } ci.auc.multiclass.auc <- function(multiclass.auc, ...) { stop("CI of a multiclass AUC not implemented") } pROC/R/roc.utils.percent.R0000644000176200001440000001164013607143106014765 0ustar liggesusers# pROC: Tools Receiver operating characteristic (ROC curves) with # (partial) area under the curve, confidence intervals and comparison. # Copyright (C) 2010-2014 Xavier Robin, Alexandre Hainard, Natacha Turck, # Natalia Tiberti, Frédérique Lisacek, Jean-Charles Sanchez # and Markus Müller # # This program is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, either version 3 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program. If not, see . # Helper functions to safely convert ROC objects from percent=TRUE to percent=FALSE # and inversely. These are internal and experimental. They shouldn't be exposed # to the end user. # Returns a ROC curve with percent=FALSE roc.utils.unpercent <- function(x) { UseMethod("roc.utils.unpercent") } roc.utils.unpercent.roc <- function(x) { if (x$percent) { if (! is.null(x$auc)) { x$auc <- roc.utils.unpercent(x$auc) } x$sensitivities <- x$sensitivities / 100 x$specificities <- x$specificities / 100 x$percent <- FALSE if (!is.null(x$call)) { x$call$percent <- FALSE } if (!is.null(x$ci)) { x$ci <- roc.utils.unpercent(x$ci) } } return(x) } roc.utils.unpercent.auc <- function(x) { if (attr(x, "percent")) { newx <- x / 100 attributes(newx) <- attributes(x) x <- newx attr(x, "percent") <- FALSE if (is.numeric(attr(x, "partial.auc"))) { attr(x, "partial.auc") <- attr(x, "partial.auc") / 100 } if (! is.null(attr(x, "roc"))) { attr(x, "roc") <- roc.utils.unpercent(attr(x, "roc")) } } return(x) } roc.utils.unpercent.ci.auc <- function(x) { if (attr(attr(x, "auc"), "percent")) { x[] <- x / 100 attr(x, "auc") <- roc.utils.unpercent(attr(x, "auc")) } return(x) } roc.utils.unpercent.ci.thresholds <- function(x) { if (attr(x, "roc")$percent) { x$sensitivity[] <- x$sensitivity / 100 x$specificity[] <- x$specificity / 100 attr(x, "roc") <- roc.utils.unpercent(attr(x, "roc")) } return(x) } roc.utils.unpercent.ci.sp <- function(x) { if (attr(x, "roc")$percent) { x[] <- x / 100 attr(x, "sensitivities") <- attr(x, "sensitivities") / 100 rownames(x) <- attr(x, "sensitivities") attr(x, "roc") <- roc.utils.unpercent(attr(x, "roc")) } return(x) } roc.utils.unpercent.ci.se <- function(x) { if (attr(x, "roc")$percent) { x[] <- x / 100 attr(x, "specificities") <- attr(x, "specificities") / 100 rownames(x) <- attr(x, "specificities") attr(x, "roc") <- roc.utils.unpercent(attr(x, "roc")) } return(x) } roc.utils.unpercent.ci.coords <- function(x) { stop("Cannot convert ci.coords object to percent = FALSE") } # Returns a ROC curve with percent=TRUE roc.utils.topercent <- function(x) { UseMethod("roc.utils.topercent") } roc.utils.topercent.roc <- function(x) { if (! x$percent) { if (! is.null(x$auc)) { x$auc <- roc.utils.topercent(x$auc) } x$sensitivities <- x$sensitivities * 100 x$specificities <- x$specificities * 100 x$percent <- TRUE if (!is.null(x$call)) { x$call$percent <- TRUE } if (!is.null(x$ci)) { x$ci <- roc.utils.topercent(x$ci) } } return(x) } roc.utils.topercent.auc <- function(x) { if (! attr(x, "percent")) { newx <- x * 100 attributes(newx) <- attributes(x) x <- newx attr(x, "percent") <- TRUE if (is.numeric(attr(x, "partial.auc"))) { attr(x, "partial.auc") <- attr(x, "partial.auc") * 100 } if (! is.null(attr(x, "roc"))) { attr(x, "roc") <- roc.utils.topercent(attr(x, "roc")) } } return(x) } roc.utils.topercent.ci.auc <- function(x) { if (! attr(attr(x, "auc"), "percent")) { x[] <- x * 100 attr(x, "auc") <- roc.utils.topercent(attr(x, "auc")) } return(x) } roc.utils.topercent.ci.thresholds <- function(x) { if (! attr(x, "roc")$percent) { x$sensitivity[] <- x$sensitivity * 100 x$specificity[] <- x$specificity * 100 attr(x, "roc") <- roc.utils.topercent(attr(x, "roc")) } return(x) } roc.utils.topercent.ci.sp <- function(x) { if (! attr(x, "roc")$percent) { x[] <- x * 100 attr(x, "sensitivities") <- attr(x, "sensitivities") * 100 rownames(x) <- paste(attr(x, "sensitivities"), "%", sep="") attr(x, "roc") <- roc.utils.topercent(attr(x, "roc")) } return(x) } roc.utils.topercent.ci.se <- function(x) { if (! attr(x, "roc")$percent) { x[] <- x * 100 attr(x, "specificities") <- attr(x, "specificities") * 100 rownames(x) <- paste(attr(x, "specificities"), "%", sep="") attr(x, "roc") <- roc.utils.topercent(attr(x, "roc")) } return(x) } roc.utils.topercent.ci.coords <- function(x) { stop("Cannot convert ci.coords object to percent = TRUE") }pROC/R/power.roc.test.R0000644000176200001440000004662414114130125014301 0ustar liggesusers# pROC: Tools Receiver operating characteristic (ROC curves) with # (partial) area under the curve, confidence intervals and comparison. # Copyright (C) 2011-2014 Xavier Robin, Alexandre Hainard, Natacha Turck, # Natalia Tiberti, Frédérique Lisacek, Jean-Charles Sanchez # and Markus Müller # # This program is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, either version 3 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program. If not, see . power.roc.test <- function(...) UseMethod("power.roc.test") power.roc.test.roc <- function(roc1, roc2, sig.level = 0.05, power = NULL, kappa = NULL, alternative = c("two.sided", "one.sided"), reuse.auc=TRUE, method=c("delong", "bootstrap", "obuchowski"), ...) { # Basic sanity checks if (!is.null(power) && (power < 0 || power > 1)) stop("'power' must range from 0 to 1") if (!is.null(sig.level) && (sig.level < 0 || sig.level > 1)) stop("'sig.level' must range from 0 to 1") # check that the AUC of roc1 was computed, or do it now if (is.null(roc1$auc) | !reuse.auc) { roc1$auc <- auc(roc1, ...) } if (!is.null(attr(roc1$auc, "partial.auc.correct")) && attr(roc1$auc, "partial.auc.correct")) { stop("Cannot compute power with corrected partial AUCs") } roc1 <- roc.utils.unpercent(roc1) if (!missing(roc2) && !is.null(roc2)) { alternative <- match.arg(alternative) if (!is.null(sig.level) && alternative == "two.sided") { sig.level <- sig.level / 2 } if ("roc" %in% class(roc2)) { # check that the AUC of roc2 was computed, or do it now if (is.null(roc2$auc) | !reuse.auc) { roc2$auc <- auc(roc2, ...) } if (!is.null(attr(roc2$auc, "partial.auc.correct")) && attr(roc2$auc, "partial.auc.correct")) { stop("Cannot compute power with corrected partial AUCs") } roc2 <- roc.utils.unpercent(roc2) # Make sure the ROC curves are paired rocs.are.paired <- are.paired(roc1, roc2) if (!rocs.are.paired) { stop("The sample size for a difference in AUC cannot be applied to unpaired ROC curves yet.") } # Make sure the AUC specifications are identical attr1 <- attributes(roc1$auc); attr1$roc <- NULL attr2 <- attributes(roc2$auc); attr2$roc <- NULL if (!identical(attr1, attr2)) { stop("Different AUC specifications in the ROC curves.") } # check that the same region was requested in auc. Otherwise, issue a warning if (!identical(attributes(roc1$auc)[names(attributes(roc1$auc))!="roc"], attributes(roc2$auc)[names(attributes(roc2$auc))!="roc"])) warning("Different AUC specifications in the ROC curves. Enforcing the inconsistency, but unexpected results may be produced.") ncontrols <- length(roc1$controls) ncases <- length(roc1$cases) if (is.null(kappa)) { kappa <- ncontrols / ncases } # Power test if (is.null(power)) { if (is.null(sig.level)) stop("'sig.level' or 'power' must be provided.") zalpha <- qnorm(1 - sig.level) zbeta <- zbeta.obuchowski(roc1, roc2, zalpha, method=method, ...) power <- pnorm(zbeta) } # sig.level else if (is.null(sig.level)) { zbeta <- qnorm(power) zalpha <- zalpha.obuchowski(roc1, roc2, zbeta, method=method, ...) sig.level <- 1 - pnorm(zalpha) } # Sample size else { zalpha <- qnorm(1 - sig.level) zbeta <- qnorm(power) ncases <- ncases.obuchowski(roc1, roc2, zalpha, zbeta, method=method, ...) ncontrols <- kappa * ncases } # Restore sig.level if two.sided if (alternative == "two.sided") { sig.level <- sig.level * 2 } return(structure(list(ncases=ncases, ncontrols=ncontrols, auc1=roc1$auc, auc2=roc2$auc, sig.level=sig.level, power=power, alternative=alternative, method="Two ROC curves power calculation"), class="power.htest")) } else { stop("'roc2' must be an object of class 'roc'.") } } else { ncontrols <- length(roc1$controls) ncases <- length(roc1$cases) if (! is.null(sig.level) && ! is.null(power)) { if (is.null(kappa)) { kappa <- ncontrols / ncases } ncontrols <- ncases <- NULL } auc <- auc(roc1) # TODO: implement this with var() and cov() for the given ROC curve return(power.roc.test.numeric(ncontrols = ncontrols, ncases = ncases, auc = auc, sig.level = sig.level, power = power, alternative = alternative, kappa = kappa, ...)) } } power.roc.test.numeric <- function(auc = NULL, ncontrols = NULL, ncases = NULL, sig.level = 0.05, power = NULL, kappa = 1, alternative = c("two.sided", "one.sided"), ...) { # basic sanity checks if (!is.null(ncases) && ncases < 0) stop("'ncases' must be positive") if (!is.null(ncontrols) && ncontrols < 0) stop("'ncontrols' must be positive") if (!is.null(kappa) && kappa < 0) stop("'kappa' must be positive") if (!is.null(power) && (power < 0 || power > 1)) stop("'power' must range from 0 to 1") if (!is.null(sig.level) && (sig.level < 0 || sig.level > 1)) stop("'sig.level' must range from 0 to 1") # Complete ncontrols and ncases with kappa if (is.null(ncontrols) && ! is.null(ncases) && !is.null(kappa)) ncontrols <- kappa * ncases else if (is.null(ncases) && ! is.null(ncontrols) && !is.null(kappa)) ncases <- ncontrols / kappa alternative <- match.arg(alternative) if (alternative == "two.sided" && !is.null(sig.level)) { sig.level <- sig.level / 2 } # determine AUC if (is.null(auc)) { if (is.null(ncontrols) || is.null(ncases)) stop("'ncontrols' and 'ncases' (or one of these with 'kappa') or 'auc' must be provided.") else if (is.null(power)) stop("'power' or 'auc' must be provided.") else if (is.null(sig.level)) stop("'sig.level' or 'auc' must be provided.") kappa <- ncontrols / ncases zalpha <- qnorm(1 - sig.level) zbeta <- qnorm(power) tryCatch( root <- uniroot(power.roc.test.optimize.auc.function, interval=c(0.5, 1-1e-16), ncontrols=ncontrols, ncases=ncases, zalpha=zalpha, zbeta=zbeta), error=function(e) {stop(sprintf("AUC could not be solved:\n%s", e))} ) auc <- root$root } # Determine number of patients (sample size) else if (is.null(ncases) && is.null(ncontrols)) { if (is.null(power)) stop("'ncontrols' and 'ncases' (or one of these with 'kappa') or 'auc' must be provided.") else if (is.null(kappa)) stop("'kappa' must be provided.") else if (is.null(auc)) stop("'auc' or 'ncases' and 'ncontrols' must be provided.") else if (is.null(sig.level)) stop("'sig.level' or 'ncases' and 'ncontrols' must be provided.") theta <- as.numeric(auc) Vtheta <- var.theta.obuchowski(theta, kappa) ncases <- solve.nd(zalpha = qnorm(1 - sig.level), zbeta = qnorm(power), v0 = 0.0792 * (1 + 1 / kappa), va = Vtheta, delta = theta - 0.5) ncontrols <- kappa * ncases } # Determine power else if (is.null(power)) { if (is.null(ncontrols) || is.null(ncases)) stop("'ncontrols' and 'ncases' (or one of these with 'kappa') or 'auc' must be provided.") else if (is.null(auc)) stop("'auc' or 'power' must be provided.") else if (is.null(sig.level)) stop("'sig.level' or 'power' must be provided.") kappa <- ncontrols / ncases theta <- as.numeric(auc) Vtheta <- var.theta.obuchowski(theta, kappa) zbeta <- solve.zbeta(nd = ncases, zalpha = qnorm(1 - sig.level), v0 = 0.0792 * (1 + 1 / kappa), va = Vtheta, delta = theta - 0.5) power <- pnorm(zbeta) } # Determine sig.level else if (is.null(sig.level)) { if (is.null(ncontrols) || is.null(ncases)) stop("'ncontrols' and 'ncases' (or one of these with 'kappa') or 'auc' must be provided.") else if (is.null(auc)) stop("'auc' or 'sig.level' must be provided.") else if (is.null(power)) stop("'power' or 'sig.level' must be provided.") kappa <- ncontrols / ncases theta <- as.numeric(auc) Vtheta <- var.theta.obuchowski(theta, kappa) zalpha <- solve.zalpha(nd = ncases, zbeta = qnorm(power), v0 = 0.0792 * (1 + 1 / kappa), va = Vtheta, delta = theta - 0.5) sig.level <- 1 - pnorm(zalpha) } else { stop("One of 'power', 'sig.level', 'auc', or both 'ncases' and 'ncontrols' must be NULL.") } # Restore sig.level if two.sided if (alternative == "two.sided") { sig.level <- sig.level * 2 } return(structure(list(ncases=ncases, ncontrols=ncontrols, auc=auc, sig.level=sig.level, power=power, method="One ROC curve power calculation"), class="power.htest")) } power.roc.test.list <- function(parslist, ncontrols = NULL, ncases = NULL, sig.level = 0.05, power = NULL, kappa = 1, alternative = c("two.sided", "one.sided"), ...) { # basic sanity checks if (!is.null(ncases) && ncases < 0) stop("'ncases' must be positive") if (!is.null(ncontrols) && ncontrols < 0) stop("'ncontrols' must be positive") if (!is.null(kappa) && kappa < 0) stop("'kappa' must be positive") if (!is.null(power) && (power < 0 || power > 1)) stop("'power' must range from 0 to 1") if (!is.null(sig.level) && (sig.level < 0 || sig.level > 1)) stop("'sig.level' must range from 0 to 1") # Complete ncontrols and ncases with kappa if (is.null(ncontrols) && ! is.null(ncases) && !is.null(kappa)) ncontrols <- kappa * ncases else if (is.null(ncases) && ! is.null(ncontrols) && !is.null(kappa)) ncases <- ncontrols / kappa # Warn if anything is passed with ... if (length(list(...)) > 0) { warning(paste("The following arguments were ignored:", paste(names(list(...)), collapse=", "))) } alternative <- match.arg(alternative) if (alternative == "two.sided" && !is.null(sig.level)) { sig.level <- sig.level / 2 } # Check required elements of parslist required <- c("A1", "B1", "A2", "B2", "rn", "ra", "delta") if (any(! required %in% names(parslist))) { stop(paste("Missing parameter(s):", paste(required[! required %in% names(parslist) ], collapse=", "))) } # Determine number of patients (sample size) if (is.null(ncases) && is.null(ncontrols)) { if (is.null(power)) stop("'ncontrols' and 'ncases' (or one of these with 'kappa') or 'auc' must be provided.") else if (is.null(kappa)) stop("'kappa' must be provided.") else if (is.null(sig.level)) stop("'sig.level' or 'ncases' and 'ncontrols' must be provided.") zalpha <- qnorm(1 - sig.level) zbeta <- qnorm(power) ncases <- ncases.obuchowski.params(parslist, zalpha, zbeta, kappa) ncontrols <- kappa * ncases } # Determine power else if (is.null(power)) { if (is.null(ncontrols) || is.null(ncases)) stop("'ncontrols' and 'ncases' (or one of these with 'kappa') or 'auc' must be provided.") else if (is.null(sig.level)) stop("'sig.level' or 'power' must be provided.") kappa <- ncontrols / ncases zalpha <- qnorm(1 - sig.level) zbeta <- zbeta.obuchowski.params(parslist, zalpha, ncases, kappa) power <- pnorm(zbeta) } # Determine sig.level else if (is.null(sig.level)) { if (is.null(ncontrols) || is.null(ncases)) stop("'ncontrols' and 'ncases' (or one of these with 'kappa') or 'auc' must be provided.") else if (is.null(power)) stop("'power' or 'sig.level' must be provided.") kappa <- ncontrols / ncases zbeta <- qnorm(power) zalpha <- zalpha.obuchowski.params(parslist, zbeta, ncases, kappa) sig.level <- 1 - pnorm(zalpha) } else { stop("One of 'power', 'sig.level', 'auc', or both 'ncases' and 'ncontrols' must be NULL.") } # Restore sig.level if two.sided if (alternative == "two.sided") { sig.level <- sig.level * 2 } return(structure(list(ncases=ncases, ncontrols=ncontrols, sig.level=sig.level, power=power, method="Two ROC curves power calculation"), class="power.htest")) } #### HIDDEN FUNCTIONS #### # A function to 'optimize' auc power.roc.test.optimize.auc.function <- function(x, ncontrols, ncases, zalpha, zbeta) { kappa <- ncontrols / ncases Vtheta <- var.theta.obuchowski(x, kappa) (zalpha * sqrt(0.0792 * (1 + 1/kappa)) + zbeta * sqrt(Vtheta))^2 / (x - 0.5)^2 - ncases } # Compute variance of a delta from a 'covvar' list (see 'covvar' below) var.delta.covvar <- function(covvar) { covvar$var1 + covvar$var2 - 2 * covvar$cov12 } # Compute variance of a delta from a 'covvar' list (see 'covvar' below) # under the null hypothesis # roc1 taken as reference. var0.delta.covvar <- function(covvar) { 2 * covvar$var1 - 2 * covvar$cov12 } # Compute the number of cases with Obuchowski formula and var(... method=method) ncases.obuchowski <- function(roc1, roc2, zalpha, zbeta, method, ...) { delta <- roc1$auc - roc2$auc covvar <- covvar(roc1, roc2, method, ...) v0 <- var0.delta.covvar(covvar) va <- var.delta.covvar(covvar) nd <- solve.nd(zalpha = zalpha, zbeta = zbeta, v0 = v0, va = va, delta = delta) return(nd) } # Compute the number of cases with Obuchowski formula from params ncases.obuchowski.params <- function(parslist, zalpha, zbeta, kappa) { covvar <- list( var1 = var.params.obuchowski(parslist$A1, parslist$B1, kappa, parslist$FPR11, parslist$FPR12), var2 = var.params.obuchowski(parslist$A2, parslist$B2, kappa, parslist$FPR21, parslist$FPR22), cov12 = cov.params.obuchowski(parslist$A1, parslist$B1, parslist$A2, parslist$B2, parslist$rn, parslist$ra, kappa, parslist$FPR11, parslist$FPR12, parslist$FPR21, parslist$FPR22) ) v0 <- var0.delta.covvar(covvar) va <- var.delta.covvar(covvar) nd <- solve.nd(zalpha = zalpha, zbeta = zbeta, v0 = v0, va = va, delta = parslist$delta) return(nd) } # Compute the z alpha with Obuchowski formula and var(... method=method) zalpha.obuchowski <- function(roc1, roc2, zbeta, method, ...) { delta <- roc1$auc - roc2$auc ncases <- length(roc1$cases) covvar <- covvar(roc1, roc2, method, ...) v0 <- var0.delta.covvar(covvar) va <- var.delta.covvar(covvar) zalpha <- solve.zalpha(nd=ncases, zbeta = zbeta, v0 = v0, va = va, delta = delta) return(zalpha) } # Compute the z alpha with Obuchowski formula from params zalpha.obuchowski.params <- function(parslist, zbeta, ncases, kappa) { covvar <- list( var1 = var.params.obuchowski(parslist$A1, parslist$B1, kappa, parslist$FPR11, parslist$FPR12), var2 = var.params.obuchowski(parslist$A2, parslist$B2, kappa, parslist$FPR21, parslist$FPR22), cov12 = cov.params.obuchowski(parslist$A1, parslist$B1, parslist$A2, parslist$B2, parslist$rn, parslist$ra, kappa, parslist$FPR11, parslist$FPR12, parslist$FPR21, parslist$FPR22) ) v0 <- var0.delta.covvar(covvar) va <- var.delta.covvar(covvar) zalpha <- solve.zalpha(nd=ncases, zbeta = zbeta, v0 = v0, va = va, delta = parslist$delta) return(zalpha) } # Compute the z beta with Obuchowski formula and var(... method=method) zbeta.obuchowski <- function(roc1, roc2, zalpha, method, ...) { delta <- roc1$auc - roc2$auc ncases <- length(roc1$cases) covvar <- covvar(roc1, roc2, method, ...) v0 <- var0.delta.covvar(covvar) va <- var.delta.covvar(covvar) zbeta <- solve.zbeta(nd=ncases, zalpha = zalpha, v0 = v0, va = va, delta = delta) return(zbeta) } # Compute the z beta with Obuchowski formula from params zbeta.obuchowski.params <- function(parslist, zalpha, ncases, kappa) { covvar <- list( var1 = var.params.obuchowski(parslist$A1, parslist$B1, kappa, parslist$FPR11, parslist$FPR12), var2 = var.params.obuchowski(parslist$A2, parslist$B2, kappa, parslist$FPR21, parslist$FPR22), cov12 = cov.params.obuchowski(parslist$A1, parslist$B1, parslist$A2, parslist$B2, parslist$rn, parslist$ra, kappa, parslist$FPR11, parslist$FPR12, parslist$FPR21, parslist$FPR22) ) v0 <- var0.delta.covvar(covvar) va <- var.delta.covvar(covvar) a <- va zbeta <- solve.zbeta(nd=ncases, zalpha = zalpha, v0 = v0, va = va, delta = parslist$delta) return(zbeta) } solve.zbeta <- function(nd, zalpha, v0, va, delta) { # Solve for z_\beta in Obuchowski formula: # See formula 2 in Obuchowsk & McClish 1997 (2 ROC curves) # or formula 2 in Obuchowski et al 2004 (1 ROC curve) # The formula is of the form: # nd = (z_alpha * sqrt(v0) - z_beta * sqrt(va)) / delta ^ 2 # Re-organized: # z_beta = (sqrt(nd * delta ^ 2) - z_alpha * sqrt(v0)) / sqrt(va) # @param nd: number of diseased patients (or abornmal, N_A in Obuchowsk & McClish 1997) # @param zalpha: upper \alpha (sig.level) percentile of the standard normal distribution # @param v0 the null variance associated with z_alpha # @param va: the alternative variance associated with z_beta # @param delta: the difference in AUC return((sqrt(nd * delta ^ 2) - zalpha * sqrt(v0)) / sqrt(va)) } solve.nd <- function(zalpha, zbeta, v0, va, delta) { # Solve for number of diseased (abnormal) patients in Obuchowski formula: # See formula 2 in Obuchowsk & McClish 1997 (2 ROC curves) # or formula 2 in Obuchowski et al 2004 (1 ROC curve) # nd = (z_alpha * sqrt(v0) - z_beta * sqrt(va)) / delta ^ 2 # @param zalpha: upper \alpha (sig.level) percentile of the standard normal distribution # @param zbeta: upper \beta (power) percentile of the standard normal distribution # @param v0 the null variance associated with z_alpha # @param va: the alternative variance associated with z_beta # @param delta: the difference in AUC return((zalpha * sqrt(v0) + zbeta * sqrt(va)) ^ 2 / delta ^ 2) } solve.zalpha <- function(nd, zbeta, v0, va, delta) { # Solve for z_\alpha in Obuchowski formula: # See formula 2 in Obuchowsk & McClish 1997 (2 ROC curves) # or formula 2 in Obuchowski et al 2004 (1 ROC curve) # The formula is of the form: # nd = (z_alpha * sqrt(v0) - z_beta * sqrt(va)) / delta ^ 2 # Re-organized: # z_alpha = (sqrt(nd * delta ^ 2) - z_beta * sqrt(va)) / sqrt(v0) # @param nd: number of diseased patients (or abornmal, N_A in Obuchowsk & McClish 1997) # @param zbeta: upper \beta (power) percentile of the standard normal distribution # @param v0 the null variance associated with z_alpha # @param va: the alternative variance associated with z_beta # @param delta: the difference in AUC return((sqrt(nd * delta ^ 2) - zbeta * sqrt(va)) / sqrt(v0)) } # Compute var and cov of two ROC curves by bootstrap in a single bootstrap run covvar <- function(roc1, roc2, method, ...) { cov12 <- cov(roc1, roc2, boot.return=TRUE, method=method, ...) if (!is.null(attr(cov12, "resampled.values"))) { var1 <- var(attr(cov12, "resampled.values")[,1]) var2 <- var(attr(cov12, "resampled.values")[,2]) attr(cov12, "resampled.values") <- NULL } else { var1 <- var(roc1, method=method, ...) var2 <- var(roc2, method=method, ...) } ncases <- length(roc1$cases) return(list(var1 = var1 * ncases, var2 = var2 * ncases, cov12 = cov12 * ncases)) } pROC/R/ci.se.R0000644000176200001440000001326413607143106012411 0ustar liggesusers# pROC: Tools Receiver operating characteristic (ROC curves) with # (partial) area under the curve, confidence intervals and comparison. # Copyright (C) 2010-2014 Xavier Robin, Alexandre Hainard, Natacha Turck, # Natalia Tiberti, Frédérique Lisacek, Jean-Charles Sanchez # and Markus Müller # # This program is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, either version 3 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program. If not, see . ci.se <- function(...) { UseMethod("ci.se") } ci.se.formula <- function(formula, data, ...) { data.missing <- missing(data) roc.data <- roc.utils.extract.formula(formula, data, ..., data.missing = data.missing, call = match.call()) if (length(roc.data$predictor.name) > 1) { stop("Only one predictor supported in 'ci.se'.") } response <- roc.data$response predictor <- roc.data$predictors[, 1] ci.se(roc(response, predictor, ci=FALSE, ...), ...) } ci.se.default <- function(response, predictor, ...) { if (methods::is(response, "multiclass.roc") || methods::is(response, "multiclass.auc")) { stop("'ci.sp' not available for multiclass ROC curves.") } roc <- roc.default(response, predictor, ci = FALSE, ...) if (methods::is(roc, "smooth.roc")) { return(ci.se(smooth.roc = roc, ...)) } else { return(ci.se(roc = roc, ...)) } } ci.se.smooth.roc <- function(smooth.roc, specificities = seq(0, 1, .1) * ifelse(smooth.roc$percent, 100, 1), conf.level = 0.95, boot.n = 2000, boot.stratified = TRUE, progress = getOption("pROCProgress")$name, parallel = FALSE, ... ) { if (conf.level > 1 | conf.level < 0) stop("'conf.level' must be within the interval [0,1].") if (roc.utils.is.perfect.curve(smooth.roc)) { warning("ci.se() of a ROC curve with AUC == 1 is always a null interval and can be misleading.") } # Check if called with density.cases or density.controls if (is.null(smooth.roc$smoothing.args) || is.numeric(smooth.roc$smoothing.args$density.cases) || is.numeric(smooth.roc$smoothing.args$density.controls)) stop("Cannot compute CI of ROC curves smoothed with numeric density.controls and density.cases.") # Get the non smoothed roc. roc <- attr(smooth.roc, "roc") roc$ci <- NULL # remove potential ci in roc to avoid infinite loop with smooth.roc() # prepare the calls smooth.roc.call <- as.call(c(utils::getS3method("smooth", "roc"), smooth.roc$smoothing.args)) if(class(progress) != "list") progress <- roc.utils.get.progress.bar(progress, title="SE confidence interval", label="Bootstrap in progress...", ...) if (boot.stratified) { perfs <- ldply(1:boot.n, stratified.ci.smooth.se, roc=roc, sp=specificities, smooth.roc.call=smooth.roc.call, .progress=progress, .parallel=parallel) } else { perfs <- ldply(1:boot.n, nonstratified.ci.smooth.se, roc=roc, sp=specificities, smooth.roc.call=smooth.roc.call, .progress=progress, .parallel=parallel) } if (any(is.na(perfs))) { warning("NA value(s) produced during bootstrap were ignored.") perfs <- perfs[!apply(perfs, 1, function(x) any(is.na(x))),] } ci <- t(apply(perfs, 2, quantile, probs=c(0+(1-conf.level)/2, .5, 1-(1-conf.level)/2))) rownames(ci) <- paste(specificities, ifelse(roc$percent, "%", ""), sep="") class(ci) <- c("ci.se", "ci", class(ci)) attr(ci, "conf.level") <- conf.level attr(ci, "boot.n") <- boot.n attr(ci, "boot.stratified") <- boot.stratified attr(ci, "specificities") <- specificities attr(ci, "roc") <- smooth.roc return(ci) } ci.se.roc <- function(roc, specificities = seq(0, 1, .1) * ifelse(roc$percent, 100, 1), conf.level = 0.95, boot.n = 2000, boot.stratified = TRUE, progress = getOption("pROCProgress")$name, parallel = FALSE, ... ) { if (conf.level > 1 | conf.level < 0) stop("'conf.level' must be within the interval [0,1].") if (roc.utils.is.perfect.curve(roc)) { warning("ci.se() of a ROC curve with AUC == 1 is always a null interval and can be misleading.") } if(class(progress) != "list") progress <- roc.utils.get.progress.bar(progress, title="SE confidence interval", label="Bootstrap in progress...", ...) if (boot.stratified) { perfs <- ldply(1:boot.n, stratified.ci.se, roc=roc, sp=specificities, .progress=progress, .parallel=parallel) } else { perfs <- ldply(1:boot.n, nonstratified.ci.se, roc=roc, sp=specificities, .progress=progress, .parallel=parallel) } if (any(is.na(perfs))) { warning("NA value(s) produced during bootstrap were ignored.") perfs <- perfs[!apply(perfs, 1, function(x) any(is.na(x))),] } ci <- t(apply(perfs, 2, quantile, probs=c(0+(1-conf.level)/2, .5, 1-(1-conf.level)/2))) rownames(ci) <- paste(specificities, ifelse(roc$percent, "%", ""), sep="") class(ci) <- c("ci.se", "ci", class(ci)) attr(ci, "conf.level") <- conf.level attr(ci, "boot.n") <- boot.n attr(ci, "boot.stratified") <- boot.stratified attr(ci, "specificities") <- specificities attr(ci, "roc") <- roc return(ci) } pROC/R/RcppExports.R0000644000176200001440000000065313607143106013677 0ustar liggesusers# Generated by using Rcpp::compileAttributes() -> do not edit by hand # Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 RcppVersion <- function() { .Call(`_pROC_RcppVersion`) } delongPlacementsCpp <- function(roc) { .Call(`_pROC_delongPlacementsCpp`, roc) } rocUtilsPerfsAllC <- function(thresholds, controls, cases, direction) { .Call(`_pROC_rocUtilsPerfsAllC`, thresholds, controls, cases, direction) } pROC/R/roc.utils.R0000644000176200001440000005425714114130125013330 0ustar liggesusers# pROC: Tools Receiver operating characteristic (ROC curves) with # (partial) area under the curve, confidence intervals and comparison. # Copyright (C) 2010-2014 Xavier Robin, Alexandre Hainard, Natacha Turck, # Natalia Tiberti, Frédérique Lisacek, Jean-Charles Sanchez # and Markus Müller # # This program is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, either version 3 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program. If not, see . # Helper functions for the ROC curves. These functions should not be called directly as they peform very specific tasks and do nearly no argument validity checks. Not documented in RD and not exported. # returns a list of sensitivities (se) and specificities (sp) for the given data. Robust algorithm roc.utils.perfs.all.safe <- function(thresholds, controls, cases, direction) { perf.matrix <- sapply(thresholds, roc.utils.perfs, controls=controls, cases=cases, direction=direction) #stopifnot(identical(roc.utils.perfs.all.fast(thresholds, controls, cases, direction), list(se=perf.matrix[2,], sp=perf.matrix[1,]))) return(list(se=perf.matrix[2,], sp=perf.matrix[1,])) } roc.utils.perfs.all.test <- function(thresholds, controls, cases, direction) { perfs.safe <- roc.utils.perfs.all.safe(thresholds=thresholds, controls=controls, cases=cases, direction=direction) perfs.fast <- roc.utils.perfs.all.fast(thresholds=thresholds, controls=controls, cases=cases, direction=direction) perfs.C <- rocUtilsPerfsAllC(thresholds=thresholds, controls=controls, cases=cases, direction=direction) if (! (identical(perfs.safe, perfs.fast) && identical(perfs.safe, perfs.C))) { sessionInfo <- sessionInfo() save(thresholds, controls, cases, direction, sessionInfo, file="pROC_bug.RData") stop(sprintf("pROC: algorithms returned different values. Diagnostic data saved in pROC_bug.RData. Please report this bug to <%s>.", utils::packageDescription("pROC")$BugReports)) } return(perfs.safe) } # returns a list of sensitivities (se) and specificities (sp) for the given data. Fast algorithm roc.utils.perfs.all.fast <- function(thresholds, controls, cases, direction) { ncontrols <- length(controls) ncases <- length(cases) predictor <- c(controls, cases) response <- c(rep(0, length(controls)), rep(1, length(cases))) decr <- direction=="<" predictor.order <- order(predictor, decreasing=decr) predictor.sorted <- predictor[predictor.order] response.sorted <- response[predictor.order] tp <- cumsum(response.sorted==1) fp <- cumsum(response.sorted==0) se <- tp / ncases sp <- (ncontrols - fp) / ncontrols # filter duplicate thresholds dups.pred <- rev(duplicated(rev(predictor.sorted))) dups.sesp <- duplicated(se) & duplicated(sp) dups <- dups.pred | dups.sesp # Make sure we have the right length if (sum(!dups) != length(thresholds) - 1) { sessionInfo <- sessionInfo() save(thresholds, controls, cases, direction, sessionInfo, file="pROC_bug.RData") stop(sprintf("pROC: fast algorithm computed an incorrect number of sensitivities and specificities. Diagnostic data saved in pROC_bug.RData. Please report this bug to <%s>.", utils::packageDescription("pROC")$BugReports)) } if (direction == "<") { se <- rev(c(0, se[!dups])) sp <- rev(c(1, sp[!dups])) } else { se <- c(0, se[!dups]) sp <- c(1, sp[!dups]) } return(list(se=se, sp=sp)) } # As roc.utils.perfs.all but returns an "old-style" matrix (pre-fast-algo-compatible) #roc.utils.perfs.all.matrix <- function(...) { # perfs <- roc.utils.perfs.all(...) # return(matrix(c(perfs$sp, perfs$se), nrow=2, byrow=TRUE)) #} # returns a vector with two elements, sensitivity and specificity, given the threshold at which to evaluate the performance, the values of controls and cases and the direction of the comparison, a character '>' or '<' as controls CMP cases # sp <- roc.utils.perfs(...)[1,] # se <- roc.utils.perfs(...)[2,] roc.utils.perfs <- function(threshold, controls, cases, direction) { if (direction == '>') { tp <- sum(cases <= threshold) tn <- sum(controls > threshold) } else if (direction == '<') { tp <- sum(cases >= threshold) tn <- sum(controls < threshold) } # return(c(sp, se)) return(c(sp=tn/length(controls), se=tp/length(cases))) } # as roc.utils.perfs, but for densities roc.utils.perfs.dens <- function(threshold, x, dens.controls, dens.cases, direction) { if (direction == '>') { tp <- sum(dens.cases[x <= threshold]) tn <- sum(dens.controls[x > threshold]) } else if (direction == '<') { tp <- sum(dens.cases[x >= threshold]) tn <- sum(dens.controls[x < threshold]) } # return(c(sp, se)) return(c(sp=tn/sum(dens.controls), se=tp/sum(dens.cases))) } # return the thresholds to evaluate in the ROC curve, given the 'predictor' values. Returns all unique values of 'predictor' plus 2 extreme values roc.utils.thresholds <- function(predictor, direction) { unique.candidates <- sort(unique(predictor)) thresholds1 <- (c(-Inf, unique.candidates) + c(unique.candidates, +Inf))/2 thresholds2 <- (c(-Inf, unique.candidates)/2 + c(unique.candidates, +Inf)/2) thresholds <- ifelse(abs(thresholds1) > 1e100, thresholds2, thresholds1) if (any(ties <- thresholds %in% predictor)) { # If we get here, some thresholds are identical to the predictor # This is caused by near numeric ties that caused the mean to equal # one of the candidate # We need to make sure we select the right threshold more carefully if (direction == '>') { # We have: # tp <- sum(cases <= threshold) # tn <- sum(controls > threshold) # We need to make sure the selected threshold # Corresponds to the lowest observation of the predictor # Identify problematic thresholds # rows <- which(ties) for (tie.idx in which(ties)) { if (thresholds[tie.idx] == unique.candidates[tie.idx - 1]) { # We're already good, nothing to do } else if (thresholds[tie.idx] == unique.candidates[tie.idx]) { thresholds[tie.idx] <- unique.candidates[tie.idx - 1] } else { sessionInfo <- sessionInfo() save(predictor, direction, sessionInfo, file="pROC_bug.RData") stop(sprintf("Couldn't fix near ties in thresholds: %s, %s, %s, %s. Diagnostic data saved in pROC_bug.RData. Please report this bug to <%s>.", thresholds[tie.idx], unique.candidates[tie.idx - 1], unique.candidates[tie.idx], direction, utils::packageDescription("pROC")$BugReports)) } } } else if (direction == '<') { # We have: # tp <- sum(cases >= threshold) # tn <- sum(controls < threshold) # We need to make sure the selected threshold # Corresponds to the highest observation of the predictor # Identify the problematic thresholds: # rows <- which(apply(o, 1, any)) for (tie.idx in which(ties)) { if (thresholds[tie.idx] == unique.candidates[tie.idx - 1]) { # Easy to fix: should be unique.candidates[tie.idx] thresholds[tie.idx] <- unique.candidates[tie.idx] } else if (thresholds[tie.idx] == unique.candidates[tie.idx]) { # We're already good, nothing to do } else { sessionInfo <- sessionInfo() save(predictor, direction, sessionInfo, file="pROC_bug.RData") stop(sprintf("Couldn't fix near ties in thresholds: %s, %s, %s, %s. Diagnostic data saved in pROC_bug.RData. Please report this bug to <%s>.", thresholds[tie.idx], unique.candidates[tie.idx - 1], unique.candidates[tie.idx], direction, utils::packageDescription("pROC")$BugReports)) } } } } return(thresholds) } # Find all the local maximas of the ROC curve. Returns a logical vector roc.utils.max.thresholds.idx <- function(thresholds, sp, se) { reversed <- FALSE if (is.unsorted(sp)) { # make sure SP is sorted increasingly, and sort thresholds accordingly thresholds <- rev(thresholds) sp <- rev(sp) se <- rev(se) reversed <- TRUE } # TODO: find whether the duplicate check is still needed. # Should have been fixed by passing only c(controls, cases) # instead of whole 'predictor' to roc.utils.thresholds in roc.default # but are there other potential issues like that? dup <- duplicated(data.frame(sp, se)) thresholds <- thresholds[!dup] sp <- sp[!dup] se <- se[!dup] # Find the local maximas if (length(thresholds) == 1) { local.maximas <- TRUE # let's consider that if there is only 1 point, we should print it. } else if (length(thresholds) == 2) { local.maximas <- c(se[1] > se[2], sp[2] > sp[1]) } else { local.maximas <- se[1] > se[2] for (i in 2:(length(thresholds)-1)) { if (sp[i] > sp[i-1] & se[i] > se[i+1]) local.maximas <- c(local.maximas, TRUE) else if (sp[i] > sp[i-1] & se[i] == 0) local.maximas <- c(local.maximas, TRUE) else if (se[i] > se[i-1] & sp[i] == 1) local.maximas <- c(local.maximas, TRUE) else local.maximas <- c(local.maximas, FALSE) } local.maximas <- c(local.maximas, sp[length(thresholds)] > sp[length(thresholds)-1]) } if (any(dup)) { lms <- rep(FALSE, length(dup)) lms[!dup] <- local.maximas local.maximas <- lms } if (reversed) rev(local.maximas) # Remove +-Inf at the limits of the curve #local.maximas <- local.maximas & is.finite(thresholds) # Question: why did I do that? It breaks coords.roc when partial.auc contains only the extreme point return(local.maximas) } detect.env.true <- function(x) { value <- Sys.getenv(x) if (value == "T" || value == "True" || value == "TRUE" || value == "true") { return(TRUE) } else { return(FALSE) } } # Detect if _R_CHECK_LENGTH_1_CONDITION_ or _R_CHECK_LENGTH_1_LOGIC2_ are set # to "True" values, which would break some progress bars. # See https://cran.r-project.org/doc/manuals/r-devel/R-ints.html and #97 # Return True or False accordingly roc.utils.dumb.progress.bar <- function() { if (detect.env.true("_R_CHECK_LENGTH_1_CONDITION_") || detect.env.true("_R_CHECK_LENGTH_1_LOGIC2_")) { return(TRUE) } else { return(FALSE) } } # Define which progress bar to use roc.utils.get.progress.bar <- function(name = getOption("pROCProgress")$name, title = "Bootstrap", label = "", width = getOption("pROCProgress")$width, char = getOption("pROCProgress")$char, style = getOption("pROCProgress")$style, ...) { if (roc.utils.dumb.progress.bar()) { # If the length 1 checks are on, we need to return only # the progress bar name return(getOption("pROCProgress")$name) } # Otherwise proceed normally if (name == "tk") { # load tcltk if possible if (!requireNamespace("tcltk")) { # If tcltk cannot be loaded fall back to default text progress bar name <- "text" style <- 3 char <- "=" width <- NA warning("Package tcltk required with progress='tk' but could not be loaded. Falling back to text progress bar.") } } if (name == "none") progress_none() else if (name == "text") { # Put some default values if user only passed a name if (missing(style) && missing(char) && missing(width) && getOption("pROCProgress")$name != "text") { style <- 3 char <- "=" width <- NA } progress_text(char=char, style=style, width=width) } else if (name == "tk" || name == "win") match.fun(paste("progress", name, sep = "_"))(title=title, label=label, width=width) else # in the special case someone made a progress_other function match.fun(paste("progress", name, sep = "_"))(title=title, label=label, width=width, char=char, style=style) } # sort roc curve. Make sure specificities are increasing. sort.roc <- function(roc) { if (is.unsorted(roc$specificities)) { roc$sensitivities <- rev(roc$sensitivities) roc$specificities <- rev(roc$specificities) roc$thresholds <- rev(roc$thresholds) } return(roc) } # sort smoothed roc curve. Make sure specificities are increasing. sort.smooth.roc <- function(roc) { if (is.unsorted(roc$specificities)) { roc$sensitivities <- rev(roc$sensitivities) roc$specificities <- rev(roc$specificities) } return(roc) } # The list of valid coordinate arguments, without 'thresholds' roc.utils.valid.coords <- c("specificity", "sensitivity", "accuracy", "tn", "tp", "fn", "fp", "npv", "ppv", "fdr", "fpr", "tpr", "tnr", "fnr", "1-specificity", "1-sensitivity", "1-accuracy", "1-npv", "1-ppv", "precision", "recall", "youden", "closest.topleft") # Arguments which can be returned by coords # @param threshold: FALSE for smooth.roc where threshold isn't valid roc.utils.match.coords.ret.args <- function(x, threshold = TRUE) { valid.ret.args <- roc.utils.valid.coords if (threshold) { valid.ret.args <- c("threshold", valid.ret.args) } if ("all" %in% x) { if (length(x) > 1) { stop("ret='all' can't be used with other 'ret' options.") } x <- valid.ret.args } x <- replace(x, x=="topleft", "closest.topleft") x <- replace(x, x=="t", "threshold") x <- replace(x, x=="npe", "1-npv") x <- replace(x, x=="ppe", "1-ppv") return(match.arg(x, valid.ret.args, several.ok=TRUE)) } # Arguments which can be used as input for coords # @param threshold: FALSE for smooth.roc where threshold isn't valid roc.utils.match.coords.input.args <- function(x, threshold = TRUE) { valid.args <- roc.utils.valid.coords if (threshold) { valid.args <- c("threshold", valid.args) } x <- replace(x, x=="topleft", "closest.topleft") x <- replace(x, x=="t", "threshold") x <- replace(x, x=="npe", "1-npv") x <- replace(x, x=="ppe", "1-ppv") matched <- match.arg(x, valid.args, several.ok=FALSE) # We only handle monotone coords if (! coord.is.monotone[matched]) { stop(sprintf("Coordinate '%s' is not monotone and cannot be used as input.", matched)) } return(matched) } # Compute the min/max for partial AUC # ... with an auc roc.utils.min.partial.auc.auc <- function(auc) { roc.utils.min.partial.auc(attr(auc, "partial.auc"), attr(auc, "percent")) } roc.utils.max.partial.auc.auc <- function(roc) { roc.utils.max.partial.auc(attr(auc, "partial.auc"), attr(auc, "percent")) } # ... with partial.auc/percent roc.utils.min.partial.auc <- function(partial.auc, percent) { if (!identical(partial.auc, FALSE)) { min <- sum(ifelse(percent, 100, 1)-partial.auc)*abs(diff(partial.auc))/2/ifelse(percent, 100, 1) } else { min <- 0.5 * ifelse(percent, 100, 1) } return(min) } roc.utils.max.partial.auc <- function(partial.auc, percent) { if (!identical(partial.auc, FALSE)) { max <- abs(diff(partial.auc)) } else { max <- 1 * ifelse(percent, 100, 1) } return(max) } # Checks if the # Input: roc object # Output: boolean, true the curve reaches 100%/100%, false otherwise roc.utils.is.perfect.curve <- function(roc) { best.point <- max(roc$sensitivities + roc$specificities) / ifelse(roc$percent, 100, 1) return(abs(best.point - 2) < .Machine$double.eps ^ 0.5) # or best.point == 2, with numerical tolerance } # Load package namespace 'pkg'. # Input: package name # Returns: TRUE upon success (or if the package was already loaded) # Stops if the package can't be loaded load.suggested.package <- function(pkg) { if (requireNamespace(pkg)) { return(TRUE) } else if (interactive()) { if (getRversion() < "3.5.0") { # utils::askYesNo not available message(sprintf("Package %s not available, do you want to install it now?", pkg)) auto.install <- utils::menu(c("Yes", "No")) == 1 } else { auto.install <- utils::askYesNo(sprintf("Package %s not available, do you want to install it now?", pkg)) } if (isTRUE(auto.install)) { utils::install.packages(pkg) if (requireNamespace(pkg)) { return(TRUE) } else { stop(sprintf("Installation of %s failed!", pkg)) } } } stop(sprintf("Package '%s' not available.", pkg)) } # Calculate coordinates # @param roc: the roc curve, used to guess if data is in percent and number of cases and controls. # @param thr, se, sp # @param best.weights: see coords # @return data.frame roc.utils.calc.coords <- function(roc, thr, se, sp, best.weights) { ncases <- ifelse(methods::is(roc, "smooth.roc"), length(attr(roc, "roc")$cases), length(roc$cases)) ncontrols <- ifelse(methods::is(roc, "smooth.roc"), length(attr(roc, "roc")$controls), length(roc$controls)) substr.percent <- ifelse(roc$percent, 100, 1) tp <- se * ncases / substr.percent fn <- ncases - tp tn <- sp * ncontrols / substr.percent fp <- ncontrols - tn npv <- substr.percent * tn / (tn + fn) ppv <- substr.percent * tp / (tp + fp) #res <- matrix(NA, nrow = length(ret), ncol = length(se)) #if ("tp" %in% ret) {} accuracy <- substr.percent * (tp + tn) / (ncases + ncontrols) precision <- ppv recall <- tpr <- se fpr <- substr.percent - sp tnr <- sp fnr <- substr.percent * fn / (tp + fn) fdr <- substr.percent * fp / (tp + fp) youden <- roc.utils.optim.crit(se, sp, substr.percent, best.weights, "youden") closest.topleft <- - roc.utils.optim.crit(se, sp, substr.percent, best.weights, "closest.topleft") / substr.percent return(cbind( threshold=thr, sensitivity=se, specificity=sp, accuracy=accuracy, tn=tn, tp=tp, fn=fn, fp=fp, npv=npv, ppv=ppv, tpr=tpr, tnr=tnr, fpr=fpr, fnr=fnr, fdr=fdr, "1-specificity"=substr.percent-sp, "1-sensitivity"=substr.percent-se, "1-accuracy"=substr.percent-accuracy, "1-npv"=substr.percent-npv, "1-ppv"=substr.percent-ppv, precision=precision, recall=recall, youden=youden, closest.topleft=closest.topleft )) } # Match arbitrary user-supplied thresholds to the threshold of the ROC curve. # We need to be careful to assign x to the right thresholds around exact data point # values. This means this function cannot look at the ROC thresholds themselves # but must instead use the predictor values to assess the thresholds exactly. # Returns the indices of the thresholds x. # @param roc: the roc curve # @param x: the threshold to determine indices # @return integer vector of indices along roc$thresholds/roc$se/roc$sp. roc.utils.thr.idx <- function(roc, x) { cut_points <- sort(unique(roc$predictor)) thr_idx <- rep(NA_integer_, length(x)) if (roc$direction == "<") { cut_points <- c(cut_points, Inf) j <- 1 o <- order(x) for (i in seq_along(x)) { t <- x[o[i]] while (cut_points[j] < t) { j <- j + 1 } thr_idx[o[i]] <- j } } else { cut_points <- c(rev(cut_points), -Inf) j <- 1 o <- order(x, decreasing = TRUE) for (i in seq_along(x)) { t <- x[o[i]] while (cut_points[j] > t) { j <- j + 1 } thr_idx[o[i]] <- j } } return(thr_idx) } # Get optimal criteria Youden or Closest Topleft # @param se, sp: the roc curve # @param max: the maximum value, 1 or 100, based on percent. Namely ifelse(percent, 100, 1) # @param weights: see coords(best.weights=) # @param method: youden or closest.topleft coords(best.method=) # @return numeric vector along roc$thresholds/roc$se/roc$sp. roc.utils.optim.crit <- function(se, sp, max, weights, method) { if (is.numeric(weights) && length(weights) == 2) { r <- (1 - weights[2]) / (weights[1] * weights[2]) # r should be 1 by default } else { stop("'best.weights' must be a numeric vector of length 2") } if (weights[2] <= 0 || weights[2] >= 1) { stop("prevalence ('best.weights[2]') must be in the interval ]0,1[.") } if (method == "youden") { optim.crit <- se + r * sp } else if (method == "closest.topleft" || method == "topleft") { optim.crit <- - ((max - se)^2 + r * (max - sp)^2) } return(optim.crit) } coord.is.monotone <- c( "threshold"=TRUE, "sensitivity"=TRUE, "specificity"=TRUE, "accuracy"=FALSE, "tn"=TRUE, "tp"=TRUE, "fn"=TRUE, "fp"=TRUE, "npv"=FALSE, "ppv"=FALSE, "tpr"=TRUE, "tnr"=TRUE, "fpr"=TRUE, "fnr"=TRUE, "fdr"=FALSE, "1-specificity"=TRUE, "1-sensitivity"=TRUE, "1-accuracy"=FALSE, "1-npv"=FALSE, "1-ppv"=FALSE, "precision"=FALSE, "recall"=TRUE, "youden"=FALSE, "closest.topleft"=FALSE ) coord.is.decreasing <- c( "threshold"=NA, # Depends on direction "sensitivity"=TRUE, "specificity"=FALSE, "accuracy"=NA, "tn"=FALSE, "tp"=TRUE, "fn"=FALSE, "fp"=TRUE, "npv"=NA, "ppv"=NA, "tpr"=TRUE, "tnr"=FALSE, "fpr"=TRUE, "fnr"=FALSE, "fdr"=NA, "1-specificity"=TRUE, "1-sensitivity"=FALSE, "1-accuracy"=NA, "1-npv"=NA, "1-ppv"=NA, "precision"=NA, "recall"=TRUE, "youden"=NA, "closest.topleft"=NA ) # Get response and predictor(s) from a formula. # This function takes care of all the logic to handle # weights, subset, na.action etc. It handles formulas with # and without data. It rejects weights and certain na.actions. # @param formula # @param data # @param data.missing # @param call the call from the parent function # @param ... the ... from the parent function # @return a list with 3 elements: response (vector), predictor.names (character), # predictors (data.frame). roc.utils.extract.formula <- function(formula, data, data.missing, call, ...) { # Get predictors (easy) if (data.missing) { predictors <- attr(terms(formula), "term.labels") } else { predictors <- attr(terms(formula, data = data), "term.labels") } indx <- match(c("formula", "data", "weights", "subset", "na.action"), names(call), nomatch=0) if (indx[1] == 0) { stop("A formula argument is required") } # Keep the standard arguments and run them in model.frame temp <- call[c(1,indx)] temp[[1]] <- as.name("model.frame") # Only na.pass and na.fail should be used if (indx[5] != 0) { na.action.value = as.character(call[indx[5]]) if (! na.action.value %in% c("na.pass", "na.fail")) { warning(paste0(sprintf("Value %s of na.action is not supported ", na.action.value), "and will break pairing in roc.test and are.paired. ", "Please use 'na.rm = TRUE' instead.")) } } else { temp$na.action = "na.pass" } # Adjust call with data from caller if (data.missing) { temp$data <- NULL } # Run model.frame in the parent m <- eval.parent(temp, n = 2) if (!is.null(model.weights(m))) stop("weights are not supported") return(list(response.name = names(m)[1], response = model.response(m), predictor.names = predictors, predictors = m[predictors])) } pROC/R/var.R0000644000176200001440000001252713607143106012201 0ustar liggesusers# pROC: Tools Receiver operating characteristic (ROC curves) with # (partial) area under the curve, confidence intervals and comparison. # Copyright (C) 2010-2014 Xavier Robin, Alexandre Hainard, Natacha Turck, # Natalia Tiberti, Frédérique Lisacek, Jean-Charles Sanchez # and Markus Müller # # This program is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, either version 3 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program. If not, see . var <- function(...) UseMethod("var") var.default <- function(...) { stats::var(...) } var.auc <- function(auc, ...) { # Change roc from an auc to a roc object but keep the auc specifications roc <- auc attr(auc, "roc") <- NULL roc <- attr(roc, "roc") roc$auc <- auc # Pass to var.roc var.roc(roc, ...) } var.smooth.roc <- function(smooth.roc, ...) { var.roc(smooth.roc, ...) # just pass to var.roc that will do the job } var.roc <- function(roc, method=c("delong", "bootstrap", "obuchowski"), boot.n = 2000, boot.stratified = TRUE, reuse.auc=TRUE, progress = getOption("pROCProgress")$name, parallel = FALSE, ...) { # We need an auc if (is.null(roc$auc) | !reuse.auc) roc$auc <- auc(roc, ...) if (roc.utils.is.perfect.curve(roc)) { warning("var() of a ROC curve with AUC == 1 is always 0 and can be misleading.") } # do all the computations in fraction, re-transform in percent later percent <- roc$percent if (percent) { roc <- roc.utils.unpercent(roc) } # Check the method if (missing(method) | is.null(method)) { # determine method if missing if (has.partial.auc(roc)) { # partial auc: go for bootstrap method <- "bootstrap" } else if (class(roc) == "smooth.roc") { # smoothing: bootstrap method <- "bootstrap" } else { method <- "delong" } } else { method <- match.arg(method) # delong NA to pAUC: warn + change if (method == "delong") { if (has.partial.auc(roc)) { stop("DeLong method is not supported for partial AUC. Use method=\"bootstrap\" instead.") } else if ("smooth.roc" %in% class(roc)) { stop("DeLong method is not supported for smoothed ROCs. Use method=\"bootstrap\" instead.") } } else if (method == "obuchowski") { if ("smooth.roc" %in% class(roc)) { stop("Using Obuchowski for smoothed ROCs is not supported. Using bootstrap instead.") } if (has.partial.auc(roc) && attr(roc$auc, "partial.auc.focus") == "sensitivity") { stop("Using Obuchowski for partial AUC on sensitivity region is not supported. Using bootstrap instead.") } } } if (method == "delong") { n <- length(roc$controls) m <- length(roc$cases) V <- delongPlacements(roc) var <- var(V$Y) / n + var(V$X) / m } else if (method == "obuchowski") { var <- var.roc.obuchowski(roc) / length(roc$cases) } else { var <- var.roc.bootstrap(roc, boot.n, boot.stratified, progress, parallel, ...) } if (percent) { var <- var * (100^2) } return(var) } var.roc.bootstrap <- function(roc, boot.n, boot.stratified, progress, parallel, ...) { if(class(progress) != "list") progress <- roc.utils.get.progress.bar(progress, title="AUC variance", label="Bootstrap in progress...", ...) ## Smoothed ROC curve variance if (class(roc) == "smooth.roc") { smoothing.args <- roc$smoothing.args smoothing.args$smooth <- TRUE non.smoothed.roc <- attr(roc, "roc") non.smoothed.roc$percent <- FALSE # as we did earlier for the smoothed.roc smooth.roc.call <- as.call(c(utils::getS3method("smooth", "roc"), roc$smoothing.args)) auc.args <- attributes(roc$auc)[grep("partial.auc", names(attributes(roc$auc)))] auc.args$allow.invalid.partial.auc.correct <- TRUE auc.call <- as.call(c(utils::getS3method("auc", "smooth.roc"), auc.args)) if (boot.stratified) { aucs <- unlist(llply(1:boot.n, stratified.ci.smooth.auc, roc=non.smoothed.roc, smooth.roc.call=smooth.roc.call, auc.call=auc.call, .progress=progress, .parallel=parallel)) } else { aucs <- unlist(llply(1:boot.n, nonstratified.ci.smooth.auc, roc=non.smoothed.roc, smooth.roc.call=smooth.roc.call, auc.call=auc.call, .progress=progress, .parallel=parallel)) } } ## Non smoothed ROC curves variance else { if (boot.stratified) { aucs <- unlist(llply(1:boot.n, stratified.ci.auc, roc=roc, .progress=progress, .parallel=parallel)) # ci.auc: returns aucs just as we need for var, so re-use it! } else { aucs <- unlist(llply(1:boot.n, nonstratified.ci.auc, roc=roc, .progress=progress, .parallel=parallel)) } } if ((num.NAs <- sum(is.na(aucs))) > 0) { warning(sprintf("%i NA value(s) produced during bootstrap were ignored.", num.NAs)) aucs <- aucs[!is.na(aucs)] } return(var(aucs)) } pROC/R/null.roc.R0000644000176200001440000000021313607143106013132 0ustar liggesusers# null.roc <- structure(list(percent = FALSE, sensitivities = c(1, 0), specificities = c(0, 1), auc = NULL, class = "auc"), class = "roc") pROC/R/plot.ci.R0000644000176200001440000000700513607143106012754 0ustar liggesusers# pROC: Tools Receiver operating characteristic (ROC curves) with # (partial) area under the curve, confidence intervals and comparison. # Copyright (C) 2010-2014 Xavier Robin, Alexandre Hainard, Natacha Turck, # Natalia Tiberti, Frédérique Lisacek, Jean-Charles Sanchez # and Markus Müller # # This program is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, either version 3 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program. If not, see . plot.ci.thresholds <- function(x, length=.01*ifelse(attr(x, "roc")$percent, 100, 1), col=par("fg"), ...) { bounds <- cbind(x$sp, x$se) apply(bounds, 1, function(x, ...) { suppressWarnings(segments(x[2], x[4], x[2], x[6], col=col, ...)) suppressWarnings(segments(x[2] - length, x[4], x[2] + length, x[4], col=col, ...)) suppressWarnings(segments(x[2] - length, x[6], x[2] + length, x[6], col=col, ...)) suppressWarnings(segments(x[1], x[5], x[3], x[5], col=col, ...)) suppressWarnings(segments(x[1], x[5] + length, x[1], x[5] - length, col=col, ...)) suppressWarnings(segments(x[3], x[5] + length, x[3], x[5] - length, col=col, ...)) }, ...) invisible(x) } plot.ci.sp <- function(x, type=c("bars", "shape"), length=.01*ifelse(attr(x, "roc")$percent, 100, 1), col=ifelse(type=="bars", par("fg"), "gainsboro"), no.roc=FALSE, ...) { type <- match.arg(type) if (type == "bars") { sapply(1:dim(x)[1], function(n, ...) { se <- attr(x, "sensitivities")[n] suppressWarnings(segments(x[n,1], se, x[n,3], se, col=col, ...)) suppressWarnings(segments(x[n,1], se - length, x[n,1], se + length, col=col, ...)) suppressWarnings(segments(x[n,3], se - length, x[n,3], se + length, col=col, ...)) }, ...) } else { if (length(x[,1]) < 15) warning("Low definition shape.") suppressWarnings(polygon(c(1*ifelse(attr(x, "roc")$percent, 100, 1), x[,1], 0, rev(x[,3]), 1*ifelse(attr(x, "roc")$percent, 100, 1)), c(0, attr(x, "sensitivities"), 1*ifelse(attr(x, "roc")$percent, 100, 1), rev(attr(x, "sensitivities")), 0), col=col, ...)) if (!no.roc) plot(attr(x, "roc"), add=TRUE) } invisible(x) } plot.ci.se <- function(x, type=c("bars", "shape"), length=.01*ifelse(attr(x, "roc")$percent, 100, 1), col=ifelse(type=="bars", par("fg"), "gainsboro"), no.roc=FALSE, ...) { type <- match.arg(type) if (type == "bars") { sapply(1:dim(x)[1], function(n, ...) { sp <- attr(x, "specificities")[n] suppressWarnings(segments(sp, x[n,1], sp, x[n,3], col=col, ...)) suppressWarnings(segments(sp - length, x[n,1], sp + length, x[n,1], col=col, ...)) suppressWarnings(segments(sp - length, x[n,3], sp + length, x[n,3], col=col, ...)) }, ...) } else { if (length(x[,1]) < 15) warning("Low definition shape.") suppressWarnings(polygon(c(0, attr(x, "specificities"), 1*ifelse(attr(x, "roc")$percent, 100, 1), rev(attr(x, "specificities")), 0), c(1*ifelse(attr(x, "roc")$percent, 100, 1), x[,1], 0, rev(x[,3]), 1*ifelse(attr(x, "roc")$percent, 100, 1)), col=col, ...)) if (!no.roc) plot(attr(x, "roc"), add=TRUE) } invisible(x) } pROC/R/obuchowski.R0000644000176200001440000001741213607143106013564 0ustar liggesusers# pROC: Tools Receiver operating characteristic (ROC curves) with # (partial) area under the curve, confidence intervals and comparison. # Copyright (C) 2011-2014 Xavier Robin, Alexandre Hainard, Natacha Turck, # Natalia Tiberti, Frédérique Lisacek, Jean-Charles Sanchez # and Markus Müller # # This program is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, either version 3 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program. If not, see . # Formula 3 from Obuchowski 2004, p. 1123 # Variance of an AUC given kappa var.theta.obuchowski <- function(theta, kappa) { A <- qnorm(theta) * 1.414 (0.0099 * exp(-A^2/2)) * ((5 * A^2 + 8) + (A^2 + 8)/kappa) } # Formulas from Obuchowski 1997, table 1 p. 1531 expr1 <- function(A, B) { exp(-A^2/(2 * (1 + B^2))) } expr2 <- function(B) { 1 + B^2 } expr3 <- function(cdagger1, cdagger2) { pnorm(cdagger1) - pnorm(cdagger2) } expr4 <- function(cddagger1, cddagger2) { exp(-cddagger1) - exp(- cddagger2) } cdagger <- function (A, B, FPRi) { (qnorm(FPRi) + A * B * (1 + B^2)^(-1) ) * (1 + B^2)^(1/2) } cddagger <- function(cdagger) { cdagger^2 / 2 } f.full <- function(A, B) { expr1 <- expr1(A, B) expr2 <- expr2(B) expr1 * (2 * pi * expr2) ^ (-1/2) } f.partial <- function(A, B, FPR1, FPR2) { cdagger1 <- cdagger(A, B, FPR1) cdagger2 <- cdagger(A, B, FPR2) expr1 <- expr1(A, B) expr2 <- expr2(B) expr3 <- expr3(cdagger1, cdagger2) expr1 * (2 * pi * expr2) ^ (-1/2) * expr3 } g.full <- function(A, B) { expr1 <- expr1(A, B) expr2 <- expr2(B) - expr1 * A * B * (2 * pi * expr2^3) ^ (-1/2) } g.partial <- function(A, B, FPR1, FPR2) { cdagger1 <- cdagger(A, B, FPR1) cdagger2 <- cdagger(A, B, FPR2) cddagger1 <- cddagger(cdagger1) cddagger2 <- cddagger(cdagger2) expr1 <- expr1(A, B) expr2 <- expr2(B) expr3 <- expr3(cdagger1, cdagger2) expr4 <- expr4(cddagger1, cddagger2) # WARNING: we have set (-expr4), in contradiction with Obuchowski paper expr1 * (2 * pi * expr2) ^ (-1) * (-expr4) - A * B * expr1 * (2 * pi * expr2^3) ^ (-1/2) * expr3 } # Variance of a ROC curve given a 'roc' object var.roc.obuchowski <- function(roc) { binormal <- smooth(roc, method="binormal")$model A <- unname(coefficients(binormal)[1]) B <- unname(coefficients(binormal)[2]) kappa <- length(roc$controls) / length(roc$cases) if (!identical(attr(roc$auc, "partial.auc"), FALSE)) { FPR1 <- 1 - attr(roc$auc, "partial.auc")[2] FPR2 <- 1 - attr(roc$auc, "partial.auc")[1] va <- var.params.obuchowski(A, B, kappa, FPR1, FPR2) } else { va <- var.params.obuchowski(A, B, kappa) } return(va) } # Variance of a ROC curve given the parameters # Obuchowski 1997, formula 4 p. 1530 # A and B: params of the binormal ROC curve # kappa: proportion controls / cases # FPR1, FPR2: the bottom (1) or top (2) bounds of the pAUC interval var.params.obuchowski <- function(A, B, kappa, FPR1, FPR2) { if (!missing(FPR1) && !is.null(FPR1) && !missing(FPR1) && !is.null(FPR2)) { f.partial(A, B, FPR1, FPR2)^2 * (1 + B^2 / kappa + A^2/2) + g.partial(A, B, FPR1, FPR2)^2 * B^2 * (1 + kappa) / (2*kappa) } else { f.full(A, B)^2 * (1 + B^2 / kappa + A^2/2) + g.full(A, B)^2 * B^2 * (1 + kappa) / (2*kappa) } } # Covariance of 2 given 'roc' objects (under the alternative hypothesis) cov.roc.obuchowski <- function(roc1, roc2) { binormal1 <- smooth(roc1, method="binormal")$model A1 <- unname(coefficients(binormal1)[1]) B1 <- unname(coefficients(binormal1)[2]) binormal2 <- smooth(roc2, method="binormal")$model A2 <-unname(coefficients(binormal2)[1]) B2 <- unname(coefficients(binormal2)[2]) kappa <- length(roc1$controls) / length(roc1$cases) ra <- cor(roc1$cases, roc2$cases) rn <- cor(roc1$controls, roc2$controls) if (!identical(attr(roc1$auc, "partial.auc"), FALSE)) { FPR11 <- 1 - attr(roc1$auc, "partial.auc")[2] FPR12 <- 1 - attr(roc1$auc, "partial.auc")[1] FPR21 <- 1 - attr(roc2$auc, "partial.auc")[2] FPR22 <- 1 - attr(roc2$auc, "partial.auc")[1] co <- cov.params.obuchowski(A1, B1, A2, B2, rn, ra, kappa, FPR11, FPR12, FPR21, FPR22) } else { co <- cov.params.obuchowski(A1, B1, A2, B2, rn, ra, kappa) } return(co) } # Covariance under the null hypothesis # roc1 is taken as null cov0.roc.obuchowski <- function(roc1, roc2) { binormal <- smooth(roc, method="binormal")$model A <- unname(coefficients(binormal)[1]) B <- unname(coefficients(binormal)[2]) R <- length(roc1$controls) / length(roc1$cases) ra <- cor(roc1$cases, roc2$cases) rn <- cor(roc1$controls, roc2$controls) if (!identical(attr(roc1$auc, "partial.auc"), FALSE)) { FPR1 <- attr(roc1$auc, "partial.auc")[2] FPR2 <- attr(roc1$auc, "partial.auc")[1] co <- cov.params.obuchowski(A, B, A, B, rn, ra, kappa, FPR1, FPR2, FPR1, FPR2) } else { co <- cov.params.obuchowski(A, B, A, B, rn, ra, kappa) } return(co) } # Covariance of a ROC curve given the parameters # Obuchowski 1997, formula 5 p. 1531 # (A|B)(1|2): A and B params of the binormal ROC curve # rn, ra: correlation of the results in ROC curves 1 and 2 in controls (n) and cases (a) patients # kappa: proportion controls / cases # FPR(1|2)(1|2): the bounds of the pAUC interval: # ***** ROC curve 1 or 2 # ***** bottom (1) or top (2) of the interval cov.params.obuchowski <- function(A1, B1, A2, B2, rn, ra, kappa, FPR11, FPR12, FPR21, FPR22) { if (!missing(FPR11) && !is.null(FPR11) && !missing(FPR12) && !is.null(FPR12) && !missing(FPR21) && !is.null(FPR21) && !missing(FPR22) && !is.null(FPR22)) { f1 <- f.partial(A1, B1, FPR11, FPR12) f2 <- f.partial(A2, B2, FPR21, FPR22) g1 <- g.partial(A1, B1, FPR11, FPR12) g2 <- g.partial(A2, B2, FPR21, FPR22) } else { f1 <- f.full(A1, B1) f2 <- f.full(A2, B2) g1 <- g.full(A1, B1) g2 <- g.full(A2, B2) } f1 * f2 * (ra + rn * B1 * B2 / kappa + ra^2 * A1 * A2 / 2) + g1 * g2 * (B1 * B2 * (rn^2 + kappa * ra^2) / (2 * kappa)) + f1 * g2 * (ra^2 * A1 * B2 / 2) + f2 * g1 * (ra^2 * A2 * B1 / 2) } # Variance of a difference between two ROC curves given the parameters # Obuchowski 1997, formula 4 and 5 p. 1530--1531 # (A|B)(1|2): A and B params of the binormal ROC curve # rn, ra: correlation of the results in ROC curves 1 and 2 in controls (n) and cases (a) patients # kappa: proportion controls / cases # FPR(1|2)(1|2): the bounds of the pAUC interval: # ***** ROC curve 1 or 2 # ***** bottom (1) or top (2) of the interval vardiff.params.obuchowski <- function(A1, B1, A2, B2, rn, ra, kappa, FPR11, FPR12, FPR21, FPR22) { var(A1, B1, kappa, FPR11, FPR12) + var(A2, B2, kappa, FPR21, FPR22) + 2 * cov(A1, B1, A2, B2, rn, ra, kappa, FPR11, FPR12, FPR21, FPR22) } # Variance of a difference between two ROC curves given the parameters # under the null hypothesis. ROC curve 1 is taken as null # Obuchowski 1997, formula 4 and 5 p. 1530--1531 # (A|B)(1|2): A and B params of the binormal ROC curve # rn, ra: correlation of the results in ROC curves 1 and 2 in controls (n) and cases (a) patients # kappa: proportion controls / cases # FPR(1|2)(1|2): the bounds of the pAUC interval: # ***** ROC curve 1 or 2 # ***** bottom (1) or top (2) of the interval vardiff0.params.obuchowski <- function(A1, B1, A2, B2, rn, ra, kappa, FPR11, FPR12, FPR21, FPR22) { 2 * var(A1, B1, kappa, FPR11, FPR12) + 2 * cov(A1, B1, A2, B2, rn, ra, kappa, FPR11, FPR12, FPR21, FPR22) } pROC/R/cov.R0000644000176200001440000001773113607143106012202 0ustar liggesusers# pROC: Tools Receiver operating characteristic (ROC curves) with # (partial) area under the curve, confidence intervals and comparison. # Copyright (C) 2010-2014 Xavier Robin, Alexandre Hainard, Natacha Turck, # Natalia Tiberti, Frédérique Lisacek, Jean-Charles Sanchez # and Markus Müller # # This program is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, either version 3 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program. If not, see . cov <- function(...) { UseMethod("cov") } cov.default <- function(...) { stats::cov(...) } cov.auc <- function(roc1, roc2, ...) { # Change roc1 from an auc to a roc object but keep the auc specifications auc1 <- roc1 attr(auc1, "roc") <- NULL roc1 <- attr(roc1, "roc") roc1$auc <- auc1 # Pass to cov.roc return(cov.roc(roc1, roc2, ...)) } cov.smooth.roc <- function(roc1, roc2, ...) { cov.roc(roc1, roc2, ...) } cov.roc <- function(roc1, roc2, method=c("delong", "bootstrap", "obuchowski"), reuse.auc=TRUE, boot.n=2000, boot.stratified=TRUE, boot.return=FALSE, progress=getOption("pROCProgress")$name, parallel = FALSE, ...) { # If roc2 is an auc, take the roc but keep the auc specifications if (methods::is(roc2, "auc")) { auc2 <- roc2 attr(auc2, "roc") <- NULL roc2 <- attr(roc2, "roc") roc2$auc <- auc2 } if (roc.utils.is.perfect.curve(roc1) && roc.utils.is.perfect.curve(roc2)) { warning("cov() of two ROC curves with AUC == 1 is always 0 and can be misleading.") } # store which objects are smoothed, and how smoothing.args <- list() if ("smooth.roc" %in% class(roc1)) { smoothing.args$roc1 <- roc1$smoothing.args smoothing.args$roc1$smooth <- TRUE roc1 <- attr(roc1, "roc") #oroc1$auc <- roc1$auc } else { smoothing.args$roc1 <- list(smooth=FALSE) } if ("smooth.roc" %in% class(roc2)) { smoothing.args$roc2 <- roc2$smoothing.args smoothing.args$roc2$smooth <- TRUE roc2 <- attr(roc2, "roc") #oroc2$auc <- roc2$auc } else { smoothing.args$roc2 <- list(smooth=FALSE) } # then determine whether the rocs are paired or not rocs.are.paired <- are.paired(roc1, roc2, return.paired.rocs=FALSE, reuse.auc=TRUE, reuse.ci=FALSE, reuse.smooth=TRUE) if (! rocs.are.paired) { message("ROC curves are unpaired.") return(0) } # check that the AUC was computed, or do it now if (is.null(roc1$auc) | !reuse.auc) { if (smoothing.args$roc1$smooth) { roc1$auc <- auc(smooth.roc=do.call("smooth.roc", c(list(roc=roc1), smoothing.args$roc1)), ...) # remove partial.auc.* arguments that are now in roc1$auc and that will mess later processing # (formal argument "partial.auc(.*)" matched by multiple actual arguments) # This removal should be safe because we always use smoothing.args with roc1 in the following processing, # however it is a potential source of bugs. smoothing.args$roc1$partial.auc <- NULL smoothing.args$roc1$partial.auc.correct <- NULL smoothing.args$roc1$partial.auc.focus <- NULL } else roc1$auc <- auc(roc1, ...) } if (is.null(roc2$auc) | !reuse.auc) { if (smoothing.args$roc2$smooth) { roc2$auc <- auc(smooth.roc=do.call("smooth.roc", c(list(roc=roc2), smoothing.args$roc2)), ...) # remove partial.auc.* arguments that are now in roc1$auc and that will mess later processing # (formal argument "partial.auc(.*)" matched by multiple actual arguments) # This removal should be safe because we always use smoothing.args with roc2 in the following processing, # however it is a potential source of bugs. smoothing.args$roc2$partial.auc <- NULL smoothing.args$roc2$partial.auc.correct <- NULL smoothing.args$roc2$partial.auc.focus <- NULL } else roc2$auc <- auc(roc2, ...) } # check that the same region was requested in auc. Otherwise, issue a warning if (!identical(attributes(roc1$auc)[names(attributes(roc1$auc))!="roc"], attributes(roc2$auc)[names(attributes(roc2$auc))!="roc"])) warning("Different AUC specifications in the ROC curves. Enforcing the inconsistency, but unexpected results may be produced.") # check that the same smoothing params were requested in auc. Otherwise, issue a warning if (!identical(smoothing.args$roc1, smoothing.args$roc2)) warning("Different smoothing parameters in the ROC curves. Enforcing the inconsistency, but unexpected results may be produced.") # Check the method if (missing(method) | is.null(method)) { # determine method if missing if (has.partial.auc(roc1)) { # partial auc: go for bootstrap method <- "bootstrap" } else if (smoothing.args$roc1$smooth || smoothing.args$roc2$smooth) { # smoothing in one or both: bootstrap method <- "bootstrap" } else if (roc1$direction != roc2$direction) { # delong doesn't work well with opposite directions (will report high significance if roc1$auc and roc2$auc are similar and high) method <- "bootstrap" } else { method <- "delong" } } else { method <- match.arg(method) if (method == "delong") { # delong NA to pAUC: warn + change if (has.partial.auc(roc1) || has.partial.auc(roc2)) { stop("DeLong method is not supported for partial AUC. Use method=\"bootstrap\" instead.") } if (smoothing.args$roc1$smooth || smoothing.args$roc2$smooth) { stop("DeLong method is not supported for smoothed ROCs. Use method=\"bootstrap\" instead.") } if (roc1$direction != roc2$direction) warning("DeLong method should not be applied to ROC curves with a different direction.") } else if (method == "obuchowski") { if (smoothing.args$roc1$smooth || smoothing.args$roc2$smooth) { stop("Obuchowski method is not supported for smoothed ROCs. Use method=\"bootstrap\" instead.") } if ((has.partial.auc(roc1) && attr(roc1$auc, "partial.auc.focus") == "sensitivity") || (has.partial.auc(roc2) && attr(roc2$auc, "partial.auc.focus") == "sensitivity")) { stop("Obuchowski method is not supported for partial AUC on sensitivity region. Use method=\"bootstrap\" instead.") } if (roc1$direction != roc2$direction) warning("Obuchowski method should not be applied to ROC curves with a different direction.") } } if (method == "delong") { n <- length(roc1$controls) m <- length(roc1$cases) V1 <- delongPlacements(roc1) var1 <- var(V1$Y) / n + var(V1$X) / m V2 <- delongPlacements(roc2) var2 <- var(V2$Y) / n + var(V2$X) / m cov <- cov(V2$X, V1$X) / m + cov(V2$Y, V1$Y) / n if (roc1$percent) { cov <- cov * (100^2) } } else if (method == "obuchowski") { cov <- cov.roc.obuchowski(roc1, roc2) / length(roc1$cases) if (roc1$percent) { cov <- cov * (100^2) } } else { # method == "bootstrap" # Check if called with density.cases or density.controls if (is.null(smoothing.args) || is.numeric(smoothing.args$density.cases) || is.numeric(smoothing.args$density.controls)) stop("Cannot compute the covariance of ROC curves smoothed with numeric density.controls and density.cases.") if(class(progress) != "list") { progress <- roc.utils.get.progress.bar(progress, title="Bootstrap covariance", label="Bootstrap in progress...", ...) } cov <- bootstrap.cov(roc1, roc2, boot.n, boot.stratified, boot.return, smoothing.args, progress, parallel) } return(cov) } pROC/R/ci.thresholds.R0000644000176200001440000001162013607143106014153 0ustar liggesusers# pROC: Tools Receiver operating characteristic (ROC curves) with # (partial) area under the curve, confidence intervals and comparison. # Copyright (C) 2010-2014 Xavier Robin, Alexandre Hainard, Natacha Turck, # Natalia Tiberti, Frédérique Lisacek, Jean-Charles Sanchez # and Markus Müller # # This program is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, either version 3 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program. If not, see . ci.thresholds <- function(...) { UseMethod("ci.thresholds") } ci.thresholds.formula <- function(formula, data, ...) { data.missing <- missing(data) roc.data <- roc.utils.extract.formula(formula, data, ..., data.missing = data.missing, call = match.call()) if (length(roc.data$predictor.name) > 1) { stop("Only one predictor supported in 'ci.thresholds'.") } response <- roc.data$response predictor <- roc.data$predictors[, 1] ci.thresholds(roc(response, predictor, ci=FALSE, ...), ...) } ci.thresholds.default <- function(response, predictor, ...) { if (methods::is(response, "multiclass.roc") || methods::is(response, "multiclass.auc")) { stop("'ci.thresholds' not available for multiclass ROC curves.") } ci.thresholds(roc.default(response, predictor, ci=FALSE, ...), ...) } ci.thresholds.smooth.roc <- function(smooth.roc, ...) stop("'ci.thresholds' is not available for smoothed ROC curves.") ci.thresholds.roc <- function(roc, conf.level = 0.95, boot.n = 2000, boot.stratified = TRUE, thresholds = "local maximas", progress = getOption("pROCProgress")$name, parallel = FALSE, ... ) { if (conf.level > 1 | conf.level < 0) stop("'conf.level' must be within the interval [0,1].") if (roc.utils.is.perfect.curve(roc)) { warning("ci.thresholds() of a ROC curve with AUC == 1 is always a null interval and can be misleading.") } # Check and prepare thresholds if (is.character(thresholds)) { if (length(thresholds) != 1) stop("'thresholds' of class character must be of length 1.") thresholds <- match.arg(thresholds, c("all", "best", "local maximas")) thresholds.num <- coords(roc, x=thresholds, input="threshold", ret="threshold", as.matrix = TRUE, transpose = FALSE, ...)[, 1] attr(thresholds.num, "coords") <- thresholds } else if (is.logical(thresholds)) { thresholds.num <- roc$thresholds[thresholds] attr(thresholds.num, "logical") <- thresholds } else if (! is.numeric(thresholds)) { stop("'thresholds' is not character, logical or numeric.") } else { thresholds.num <- thresholds } if(class(progress) != "list") progress <- roc.utils.get.progress.bar(progress, title="Thresholds confidence interval", label="Bootstrap in progress...", ...) if (boot.stratified) { perfs <- laply(1:boot.n, stratified.ci.thresholds, roc=roc, thresholds=thresholds.num, .progress=progress, .parallel=parallel) } else { perfs <- laply(1:boot.n, nonstratified.ci.thresholds, roc=roc, thresholds=thresholds.num, .progress=progress, .parallel=parallel) } if (length(thresholds.num) > 1) { if (any(is.na(perfs))) { warning("NA value(s) produced during bootstrap were ignored.") perfs <- perfs[!apply(perfs, 1, function(x) any(is.na(x))),] } # laply returns a 3d matrix, with dim 1 = bootstrap replicates, dim 2 = SE/SP and dim 3 = thresholds # [,1,] = SP and [,2,] = SE sp <- t(apply(perfs[,1,], 2, quantile, probs=c(0+(1-conf.level)/2, .5, 1-(1-conf.level)/2))) se <- t(apply(perfs[,2,], 2, quantile, probs=c(0+(1-conf.level)/2, .5, 1-(1-conf.level)/2))) } else { if (any(is.na(perfs))) { warning("NaN value(s) in bootstrap ignored in confidence interval.") perfs <- perfs[!apply(perfs, 1, function(x) any(is.na(x))),] } sp <- as.matrix(t(quantile(perfs[,1], probs=c(0+(1-conf.level)/2, .5, 1-(1-conf.level)/2)))) se <- as.matrix(t(quantile(perfs[,2], probs=c(0+(1-conf.level)/2, .5, 1-(1-conf.level)/2)))) } rownames(se) <- rownames(sp) <- thresholds.num if (roc$percent) { se <- se * 100 sp <- sp * 100 } ci <- list(specificity = sp, sensitivity = se) class(ci) <- c("ci.thresholds", "ci", "list") attr(ci, "conf.level") <- conf.level attr(ci, "boot.n") <- boot.n attr(ci, "boot.stratified") <- boot.stratified attr(ci, "thresholds") <- thresholds.num attr(ci, "roc") <- roc return(ci) } pROC/R/ci.sp.R0000644000176200001440000001326513607143106012425 0ustar liggesusers# pROC: Tools Receiver operating characteristic (ROC curves) with # (partial) area under the curve, confidence intervals and comparison. # Copyright (C) 2010-2014 Xavier Robin, Alexandre Hainard, Natacha Turck, # Natalia Tiberti, Frédérique Lisacek, Jean-Charles Sanchez # and Markus Müller # # This program is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, either version 3 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program. If not, see . ci.sp <- function(...) { UseMethod("ci.sp") } ci.sp.formula <- function(formula, data, ...) { data.missing <- missing(data) roc.data <- roc.utils.extract.formula(formula, data, ..., data.missing = data.missing, call = match.call()) if (length(roc.data$predictor.name) > 1) { stop("Only one predictor supported in 'ci.sp'.") } response <- roc.data$response predictor <- roc.data$predictors[, 1] ci.sp(roc(response, predictor, ci=FALSE, ...), ...) } ci.sp.default <- function(response, predictor, ...) { if (methods::is(response, "multiclass.roc") || methods::is(response, "multiclass.auc")) { stop("'ci.sp' not available for multiclass ROC curves.") } roc <- roc.default(response, predictor, ci = FALSE, ...) if (methods::is(roc, "smooth.roc")) { return(ci.sp(smooth.roc = roc, ...)) } else { return(ci.sp(roc = roc, ...)) } } ci.sp.smooth.roc <- function(smooth.roc, sensitivities = seq(0, 1, .1) * ifelse(smooth.roc$percent, 100, 1), conf.level = 0.95, boot.n = 2000, boot.stratified = TRUE, progress = getOption("pROCProgress")$name, parallel = FALSE, ... ) { if (conf.level > 1 | conf.level < 0) stop("'conf.level' must be within the interval [0,1].") if (roc.utils.is.perfect.curve(smooth.roc)) { warning("ci.sp() of a ROC curve with AUC == 1 is always a null interval and can be misleading.") } # Check if called with density.cases or density.controls if (is.null(smooth.roc$smoothing.args) || is.numeric(smooth.roc$smoothing.args$density.cases) || is.numeric(smooth.roc$smoothing.args$density.controls)) stop("Cannot compute CI of ROC curves smoothed with numeric density.controls and density.cases.") # Get the non smoothed roc. roc <- attr(smooth.roc, "roc") roc$ci <- NULL # remove potential ci in roc to avoid infinite loop with smooth.roc() # prepare the calls smooth.roc.call <- as.call(c(utils::getS3method("smooth", "roc"), smooth.roc$smoothing.args)) if(class(progress) != "list") progress <- roc.utils.get.progress.bar(progress, title="SP confidence interval", label="Bootstrap in progress...", ...) if (boot.stratified) { perfs <- ldply(1:boot.n, stratified.ci.smooth.sp, roc=roc, se=sensitivities, smooth.roc.call=smooth.roc.call, .progress=progress, .parallel=parallel) } else { perfs <- ldply(1:boot.n, nonstratified.ci.smooth.sp, roc=roc, se=sensitivities, smooth.roc.call=smooth.roc.call, .progress=progress, .parallel=parallel) } if (any(is.na(perfs))) { warning("NA value(s) produced during bootstrap were ignored.") perfs <- perfs[!apply(perfs, 1, function(x) any(is.na(x))),] } ci <- t(apply(perfs, 2, quantile, probs=c(0+(1-conf.level)/2, .5, 1-(1-conf.level)/2))) rownames(ci) <- paste(sensitivities, ifelse(roc$percent, "%", ""), sep="") class(ci) <- c("ci.sp", "ci", class(ci)) attr(ci, "conf.level") <- conf.level attr(ci, "boot.n") <- boot.n attr(ci, "boot.stratified") <- boot.stratified attr(ci, "sensitivities") <- sensitivities attr(ci, "roc") <- smooth.roc return(ci) } ci.sp.roc <- function(roc, sensitivities = seq(0, 1, .1) * ifelse(roc$percent, 100, 1), conf.level = 0.95, boot.n = 2000, boot.stratified = TRUE, progress = getOption("pROCProgress")$name, parallel = FALSE, ... ) { if (conf.level > 1 | conf.level < 0) stop("'conf.level' must be within the interval [0,1].") if (roc.utils.is.perfect.curve(roc)) { warning("ci.sp() of a ROC curve with AUC == 1 is always a null interval and can be misleading.") } if(class(progress) != "list") progress <- roc.utils.get.progress.bar(progress, title="SP confidence interval", label="Bootstrap in progress...", ...) if (boot.stratified) { perfs <- ldply(1:boot.n, stratified.ci.sp, roc=roc, se=sensitivities, .progress=progress, .parallel=parallel) } else { perfs <- ldply(1:boot.n, nonstratified.ci.sp, roc=roc, se=sensitivities, .progress=progress, .parallel=parallel) } if (any(is.na(perfs))) { warning("NA value(s) produced during bootstrap were ignored.") perfs <- perfs[!apply(perfs, 1, function(x) any(is.na(x))),] } ci <- t(apply(perfs, 2, quantile, probs=c(0+(1-conf.level)/2, .5, 1-(1-conf.level)/2))) rownames(ci) <- paste(sensitivities, ifelse(roc$percent, "%", ""), sep="") class(ci) <- c("ci.sp", "ci", class(ci)) attr(ci, "conf.level") <- conf.level attr(ci, "boot.n") <- boot.n attr(ci, "boot.stratified") <- boot.stratified attr(ci, "sensitivities") <- sensitivities attr(ci, "roc") <- roc return(ci) } pROC/R/delong.R0000644000176200001440000001245614114130125012651 0ustar liggesusers# pROC: Tools Receiver operating characteristic (ROC curves) with # (partial) area under the curve, confidence intervals and comparison. # Copyright (C) 2010-2014 Xavier Robin, Alexandre Hainard, Natacha Turck, # Natalia Tiberti, Frédérique Lisacek, Jean-Charles Sanchez, # Markus Müller # # This program is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, either version 3 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program. If not, see . # Delong's test paired, used by roc.test.roc delong.paired.test <- function(calcs) { # Input calcs is a list returned by delong.paired.calculations(). zscore <- with(calcs, d/sig) if (is.nan(zscore) && calcs$d == 0 && calcs$sig == 0) zscore <- 0 # special case: no difference between theta's produces a NaN return(zscore) } # Delong's test unpaired, used by roc.test.roc delong.unpaired.test <- function(roc1, roc2) { nR <- length(roc1$controls) mR <- length(roc1$cases) nS <- length(roc2$controls) mS <- length(roc2$cases) VR <- delongPlacements(roc1) VS <- delongPlacements(roc2) SRX <- sum((VR$X - VR$theta) * (VR$X - VR$theta))/(mR-1) SSX <- sum((VS$X - VS$theta) * (VS$X - VS$theta))/(mS-1) SRY <- sum((VR$Y - VR$theta) * (VR$Y - VR$theta))/(nR-1) SSY <- sum((VS$Y - VS$theta) * (VS$Y - VS$theta))/(nS-1) SR <- SRX/mR + SRY/nR SS <- SSX/mS + SSY/nS ntotR <- nR + mR ntotS <- nS + mS SSR <- sqrt((SR) + (SS)) t <- (VR$theta - VS$theta) / SSR df <- ((SR) + (SS))^2 / (((SR)^2 / (ntotR-1)) + ((SS)^2 / (ntotS -1 ))) return(c(t, df)) } ci.auc.delong <- function(roc, conf.level) { YR <- roc$controls # = C2, n, YRj XR <- roc$cases # = C1, m, XRi n <- length(YR) m <- length(XR) # If controls or cases have a single observation, we would produce NaNs in SX and SY if (m <= 1 || n <= 1) { return(rep(NA, 3)) } V <- delongPlacements(roc) SX <- sum((V$X - V$theta) * (V$X - V$theta))/(m-1) SY <- sum((V$Y - V$theta) * (V$Y - V$theta))/(n-1) S <- SX/m + SY/n ci <- qnorm(c(0+(1-conf.level)/2, .5, 1-(1-conf.level)/2), mean = V$theta, sd = sqrt(S)) # In some rare cases we have ci[3] > 1 or ci[1] < 0 ci[ci > 1] <- 1 ci[ci < 0] <- 0 # According to Pepe (p. 107), we should probably be doing something like # log(roc$auc / (1 - roc$auc)) + pnorm( 1-conf.level/2) * (S / (roc$auc * (1 - roc$auc))) # log(roc$auc / (1 - roc$auc)) - pnorm( 1-conf.level/2) * (S / (roc$auc * (1 - roc$auc))) # for logit AUC, so that for AUC: # exp(log(roc$auc / (1 - roc$auc)) + pnorm( 1-conf.level/2) * (S / (roc$auc * (1 - roc$auc)))) * (1 - roc$auc) # exp(log(roc$auc / (1 - roc$auc)) - pnorm( 1-conf.level/2) * (S / (roc$auc * (1 - roc$auc)))) * (1 - roc$auc) # However the bounds are very very much smaller (about 10 times) than bootstrap, which seems unrealistic # Stay with normal conf interval for now. return(ci) } # function to calculate the CI ci.delong.paired <- function(calcs, conf.level) { # Input calcs is a list generated by delong.paired.calculations(). # CI is calculated using the normally distributed pivot given in # DeLong's 1988 paper. crit_z <- qnorm(1 - ((1 - conf.level)/2)) out <- list() out$upper <- with(calcs, d + crit_z * sig) out$lower <- with(calcs, d - crit_z * sig) out$level <- conf.level return(out) } # Runs the placements and main calculations for the paired DeLong's test # so that they can be easily used by both the test and CI functions. delong.paired.calculations <- function(roc1, roc2) { n <- length(roc1$controls) m <- length(roc1$cases) VR <- delongPlacements(roc1) VS <- delongPlacements(roc2) SX <- matrix(NA, ncol=2, nrow=2) SX[1,1] <- sum((VR$X - VR$theta) * (VR$X - VR$theta))/(m-1) SX[1,2] <- sum((VR$X - VR$theta) * (VS$X - VS$theta))/(m-1) SX[2,1] <- sum((VS$X - VS$theta) * (VR$X - VR$theta))/(m-1) SX[2,2] <- sum((VS$X - VS$theta) * (VS$X - VS$theta))/(m-1) SY <- matrix(NA, ncol=2, nrow=2) SY[1,1] <- sum((VR$Y - VR$theta) * (VR$Y - VR$theta))/(n-1) SY[1,2] <- sum((VR$Y - VR$theta) * (VS$Y - VS$theta))/(n-1) SY[2,1] <- sum((VS$Y - VS$theta) * (VR$Y - VR$theta))/(n-1) SY[2,2] <- sum((VS$Y - VS$theta) * (VS$Y - VS$theta))/(n-1) S <- SX/m + SY/n L <- c(1,-1) sig <- sqrt(L%*%S%*%L) d <- VR$theta - VS$theta return(list("d" = d, "sig" = sig[[1]])) } # Calls delongPlacementsCpp safely # Ensures that the theta value calculated is correct delongPlacements <- function(roc) { placements <- delongPlacementsCpp(roc) # Ensure theta equals auc auc <- roc$auc / ifelse(roc$percent, 100, 1) if (! isTRUE(all.equal(placements$theta, auc))) { sessionInfo <- sessionInfo() save(roc, placements, sessionInfo, file="pROC_bug.RData") stop(sprintf("pROC: error in calculating DeLong's theta: got %.20f instead of %.20f. Diagnostic data saved in pROC_bug.RData. Please report this bug to <%s>.", placements$theta, auc, utils:: packageDescription("pROC")$BugReports)) } return(placements) } pROC/R/onLoad.R0000644000176200001440000000477713607143106012635 0ustar liggesusers# pROC: Tools Receiver operating characteristic (ROC curves) with # (partial) area under the curve, confidence intervals and comparison. # Copyright (C) 2010-2014 Xavier Robin, Alexandre Hainard, Natacha Turck, # Natalia Tiberti, Frédérique Lisacek, Jean-Charles Sanchez # and Markus Müller # # This program is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, either version 3 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program. If not, see . .onLoad <- function(lib, pkg) { # Generate progressbar option with smart default values if (is.null(getOption("pROCProgress"))) { if (interactive()) { if (!is.null(getOption("STERM")) && getOption("STERM") == "iESS") options("pROCProgress" = list(name = "text", width = NA, char = "=", style = 1)) else if (.Platform$OS.type == "windows") options("pROCProgress" = list(name = "win", width = 300)) else options("pROCProgress" = list(name = "text", width = NA, char = "=", style = 3)) } else { options("pROCProgress" = list(name = "none")) } } } .parseRcppVersion <- function(rcpp.version) { # Parses Rcpp version integer into a string. # Eg "65538" -> "1.0.2" rcpp.version <- as.integer(rcpp.version) major <- rcpp.version %/% 65536 rcpp.version <- rcpp.version - major * 65536 minor <- rcpp.version %/% 256 rcpp.version <- rcpp.version - minor * 256 rev <- rcpp.version return(sprintf("%s.%s.%s", major, minor, rev)) } .checkRcppVersion <- function() { # Check runtime version of Rcpp is the same than we had at compile time runtime_version <- package_version(utils::packageVersion("Rcpp")) build_version <- package_version(.parseRcppVersion(RcppVersion())) if (runtime_version != build_version) { warning(sprintf("It seems pROC was compiled with Rcpp version %s, but %s is available now. Please re-install pROC to avoid problems: install.packages(\"pROC\").", build_version,runtime_version)) } } .onAttach <- function(lib, pkg) { packageStartupMessage("Type 'citation(\"pROC\")' for a citation.") } pROC/R/ci.R0000644000176200001440000000534413607143106012003 0ustar liggesusers# pROC: Tools Receiver operating characteristic (ROC curves) with # (partial) area under the curve, confidence intervals and comparison. # Copyright (C) 2010-2014 Xavier Robin, Alexandre Hainard, Natacha Turck, # Natalia Tiberti, Frédérique Lisacek, Jean-Charles Sanchez # and Markus Müller # # This program is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, either version 3 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program. If not, see . ci <- function(...) { UseMethod("ci") } ci.formula <- function(formula, data, ...) { data.missing <- missing(data) roc.data <- roc.utils.extract.formula(formula, data, ..., data.missing = data.missing, call = match.call()) if (length(roc.data$predictor.name) > 1) { stop("Only one predictor supported in 'ci'.") } response <- roc.data$response predictor <- roc.data$predictors[, 1] ci.roc(roc(response, predictor, ...), ...) } ci.default <- function(response, predictor, ...) { roc <- roc.default(response, predictor, ci = FALSE, ...) if (methods::is(roc, "smooth.roc")) { return(ci.roc(smooth.roc = roc, ...)) } else { return(ci.roc(roc = roc, ...)) } } ci.smooth.roc <- function(smooth.roc, of = c("auc", "sp", "se", "coords"), ...) { of <- match.arg(of) if (of == "auc") ci <- ci.auc.smooth.roc(smooth.roc, ...) else if (of == "sp") ci <- ci.sp.smooth.roc(smooth.roc, ...) else if (of == "se") ci <- ci.se.smooth.roc(smooth.roc, ...) else if (of == "coords") ci <- ci.coords.smooth.roc(smooth.roc, ...) else stop(sprintf("Unknown 'of' for CI: %s", of)) return(ci) } ci.roc <- function(roc, of = c("auc", "thresholds", "sp", "se", "coords"), ...) { of <- match.arg(of) if (of == "auc") ci <- ci.auc.roc(roc, ...) else if (of == "thresholds") ci <- ci.thresholds.roc(roc, ...) else if (of == "sp") ci <- ci.sp.roc(roc, ...) else if (of == "se") ci <- ci.se.roc(roc, ...) else if (of == "coords") ci <- ci.coords.roc(roc, ...) else stop(sprintf("Unknown 'of' for CI: %s", of)) return(ci) } ci.multiclass.roc <- function(multiclass.roc, of = "auc", ...) { stop("CI of a multiclass ROC curve not implemented") } ci.multiclass.auc <- function(multiclass.auc, of = "auc", ...) { stop("CI of a multiclass AUC not implemented") } pROC/R/auc.R0000644000176200001440000002104714114130125012145 0ustar liggesusers# pROC: Tools Receiver operating characteristic (ROC curves) with # (partial) area under the curve, confidence intervals and comparison. # Copyright (C) 2010-2014 Xavier Robin, Alexandre Hainard, Natacha Turck, # Natalia Tiberti, Frédérique Lisacek, Jean-Charles Sanchez # and Markus Müller # # This program is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, either version 3 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program. If not, see . auc <- function(...) { UseMethod("auc") } auc.formula <- function(formula, data, ...) { data.missing <- missing(data) roc.data <- roc.utils.extract.formula(formula, data, ..., data.missing = data.missing, call = match.call()) if (length(roc.data$predictor.name) > 1) { stop("Only one predictor supported in 'auc'.") } response <- roc.data$response predictor <- roc.data$predictors[, 1] roc(response, predictor, auc = TRUE, ...)$auc } auc.default <- function(response, predictor, ...) { roc.default(response, predictor, auc=TRUE, ...)$auc } auc.smooth.roc <- function(smooth.roc, ...) { auc.roc(smooth.roc, ...) # force usage of auc.roc: compatible } auc.multiclass.roc <- function(multiclass.roc, ...) { sum <- sum(sapply(multiclass.roc$rocs, auc, ...)) count <- length(multiclass.roc$levels) # Hand & Till formula: auc <- (2 * sum) / (count * (count - 1)) # Prepare auc object auc <- as.vector(auc) # remove potential pre-existing attributes attr(auc, "percent") <- multiclass.roc$percent attr(auc, "roc") <- multiclass.roc # Get partial auc details from first computed auc # TODO: find a better way to recover partial.auc! aucs <- lapply(multiclass.roc$rocs, auc, ...) # keep individual AUCs in a list for later attr(auc, "partial.auc") <- attr(aucs[[1]], "partial.auc") if (!identical(attr(aucs[[1]], "partial.auc"), FALSE)) { attr(auc, "partial.auc.focus") <- attr(aucs[[1]], "partial.auc.focus") attr(auc, "partial.auc.correct") <- attr(aucs[[1]], "partial.auc.correct") } class(auc) <- c("multiclass.auc", "numeric") return(auc) } auc.mv.multiclass.roc <- function(mv.multiclass.roc, ...) { aucs <- lapply(mv.multiclass.roc$rocs, function(x) list(auc(x[[1]], ...), auc(x[[2]], ...))) A.ij.total <- sum(sapply(aucs, function(x) mean(unlist(x)))) c <- length(mv.multiclass.roc$levels) auc <- 2 / (c * (c-1)) * A.ij.total # Prepare auc object auc <- as.vector(auc) # remove potential pre-existing attributes attr(auc, "percent") <- mv.multiclass.roc$percent attr(auc, "roc") <- mv.multiclass.roc # Get partial auc details from first computed auc attr(auc, "partial.auc") <- attr(aucs[[1]][[1]], "partial.auc") if (!identical(attr(aucs[[1]], "partial.auc"), FALSE)) { attr(auc, "partial.auc.focus") <- attr(aucs[[1]][[1]], "partial.auc.focus") attr(auc, "partial.auc.correct") <- attr(aucs[[1]][[1]], "partial.auc.correct") } class(auc) <- c("mv.multiclass.auc", "numeric") return(auc) } auc.roc <- function(roc, # Partial auc definition partial.auc=FALSE, # false (consider total area) or numeric length 2: boundaries of the AUC to consider, between 0 and 1, or 0 and 100 if percent is TRUE partial.auc.focus=c("specificity", "sensitivity"), # if partial.auc is not FALSE: do the boundaries partial.auc.correct=FALSE, allow.invalid.partial.auc.correct = FALSE, ... # unused required to allow roc passing arguments to plot or ci. ) { if (!identical(partial.auc, FALSE)) { partial.auc.focus <- match.arg(partial.auc.focus) } percent <- roc$percent # Validate partial.auc if (! identical(partial.auc, FALSE) & !(is.numeric(partial.auc) && length(partial.auc)==2)) stop("partial.auc must be either FALSE or a numeric vector of length 2") # Ensure partial.auc is sorted with partial.auc[1] >= partial.auc[2] partial.auc <- sort(partial.auc, decreasing=TRUE) # Get and sort the sensitivities and specificities roc <- sort(roc) se <- roc$sensitivities sp <- roc$specificities # Full area if partial.auc is FALSE if (identical(partial.auc, FALSE)) { if (methods::is(roc, "smooth.roc") && ! is.null(roc$smoothing.args) && roc$smoothing.args$method == "binormal") { coefs <- coefficients(roc$model) auc <- unname(pnorm(coefs[1] / sqrt(1+coefs[2]^2)) * ifelse(percent, 100^2, 1)) } else { diffs.x <- sp[-1] - sp[-length(sp)] means.vert <- (se[-1] + se[-length(se)])/2 auc <- sum(means.vert * diffs.x) } } # Partial area else { if (partial.auc.focus == "sensitivity") { # if we focus on SE, just swap and invert x and y and the computations for SP will work x <- rev(se) y <- rev(sp) } else { x <- sp y <- se } # find the SEs and SPs in the interval x.inc <- x[x <= partial.auc[1] & x >= partial.auc[2]] y.inc <- y[x <= partial.auc[1] & x >= partial.auc[2]] # compute the AUC strictly in the interval diffs.x <- x.inc[-1] - x.inc[-length(x.inc)] means.vert <- (y.inc[-1] + y.inc[-length(y.inc)])/2 auc <- sum(means.vert * diffs.x) # add the borders: if (length(x.inc) == 0) { # special case: the whole AUC is between 2 se/sp points. Need to interpolate from both diff.horiz <- partial.auc[1] - partial.auc[2] # determine indices idx.hi <- match(FALSE, x < partial.auc[1]) idx.lo <- idx.hi - 1 # proportions proportion.hi <- (x[idx.hi] - partial.auc[1]) / (x[idx.hi] - x[idx.lo]) proportion.lo <- (partial.auc[2] - x[idx.lo]) / (x[idx.hi] - x[idx.lo]) # interpolated y's y.hi <- y[idx.hi] + proportion.hi * (y[idx.lo] - y[idx.hi]) y.lo <- y[idx.lo] - proportion.lo * (y[idx.lo] - y[idx.hi]) # compute AUC mean.vert <- (y.hi + y.lo)/2 auc <- mean.vert*diff.horiz } else { # if the upper limit is not exactly present in SPs, interpolate if (!(partial.auc[1] %in% x.inc)) { # find the limit indices idx.out <- match(FALSE, x < partial.auc[1]) idx.in <- idx.out - 1 # interpolate y proportion <- (partial.auc[1] - x[idx.out]) / (x[idx.in] - x[idx.out]) y.interpolated <- y[idx.out] + proportion * (y[idx.in] - y[idx.out]) # add to AUC auc <- auc + (partial.auc[1] - x[idx.in]) * (y[idx.in] + y.interpolated)/2 } if (!(partial.auc[2] %in% x.inc)) { # if the lower limit is not exactly present in SPs, interpolate # find the limit indices in and out #idx.out <- length(x) - match(TRUE, rev(x) < partial.auc[2]) + 1 idx.out <- match(TRUE, x > partial.auc[2]) - 1 idx.in <- idx.out + 1 # interpolate y proportion <- (x[idx.in] - partial.auc[2]) / (x[idx.in] - x[idx.out]) y.interpolated <- y[idx.in] + proportion * (y[idx.out] - y[idx.in]) # add to AUC auc <- auc + (x[idx.in] - partial.auc[2]) * (y[idx.in] + y.interpolated)/2 } } } # In percent, we have 100*100 = 10,000 as maximum area, so we need to divide by a factor 100 if (percent) auc <- auc/100 # Correction according to McClish DC, 1989 if (all(!identical(partial.auc, FALSE), partial.auc.correct)) { # only for pAUC min <- roc.utils.min.partial.auc(partial.auc, percent) max <- roc.utils.max.partial.auc(partial.auc, percent) # The correction is defined only when auc >= min if (!allow.invalid.partial.auc.correct && auc < min) { warning("Partial AUC correction not defined for ROC curves below the diagonal.") auc <- NA } else if (percent) { auc <- (100+((auc-min)*100/(max-min)))/2 # McClish formula adapted for % } else { auc <- (1+((auc-min)/(max-min)))/2 # original formula by McClish } } # Prepare the AUC to return with attributes auc <- as.vector(auc) # remove potential pre-existing attributes attr(auc, "partial.auc") <- partial.auc attr(auc, "percent") <- percent attr(auc, "roc") <- roc if (!identical(partial.auc, FALSE)) { attr(auc, "partial.auc.focus") <- partial.auc.focus attr(auc, "partial.auc.correct") <- partial.auc.correct } class(auc) <- c("auc", class(auc)) return(auc) } pROC/R/ci.multiclass.auc.R0000644000176200001440000000455613607143106014735 0ustar liggesusers# # pROC: Tools Receiver operating characteristic (ROC curves) with # # (partial) area under the curve, confidence intervals and comparison. # # Copyright (C) 2010-2014 Xavier Robin, Alexandre Hainard, Natacha Turck, # # Natalia Tiberti, Frédérique Lisacek, Jean-Charles Sanchez # # and Markus Müller # # # # This program is free software: you can redistribute it and/or modify # # it under the terms of the GNU General Public License as published by # # the Free Software Foundation, either version 3 of the License, or # # (at your option) any later version. # # # # This program is distributed in the hope that it will be useful, # # but WITHOUT ANY WARRANTY; without even the implied warranty of # # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # # GNU General Public License for more details. # # # # You should have received a copy of the GNU General Public License # # along with this program. If not, see . # # ci.multiclass.auc <- function(multiclass.auc, ...) { # stop("CI of a multiclass AUC not implemented") # ci.multiclass.roc(attr(multiclass.auc, "roc"), ...) # } # # ci.multiclass.roc <- function(multiclass.roc, # conf.level = 0.95, # boot.n = 2000, # boot.stratified = TRUE, # reuse.auc=TRUE, # progress = getOption("pROCProgress")$name, # parallel = FALSE, # ... # ) { # stop("ci of a multiclass ROC curve not implemented") # if (conf.level > 1 | conf.level < 0) # stop("conf.level must be within the interval [0,1].") # # # We need an auc # if (is.null(multiclass.roc$auc) | !reuse.auc) # multiclass.roc$auc <- auc(multiclass.roc, ...) # # # do all the computations in fraction, re-transform in percent later if necessary # percent <- multiclass.roc$percent # oldauc <- multiclass.roc$auc # if (percent) { # multiclass.roc <- roc.utils.unpercent(multiclass.roc) # } # # ci <- ci.multiclass.auc.bootstrap(multiclass.roc, conf.level, boot.n, boot.stratified, progress, parallel, ...) # # if (percent) { # ci <- ci * 100 # } # attr(ci, "conf.level") <- conf.level # attr(ci, "boot.n") <- boot.n # attr(ci, "boot.stratified") <- boot.stratified # attr(ci, "multiclass.auc") <- oldauc # class(ci) <- "ci.multiclass.auc" # return(ci) # } pROC/R/has.partial.auc.R0000644000176200001440000000246313607143106014364 0ustar liggesusers# pROC: Tools Receiver operating characteristic (ROC curves) with # (partial) area under the curve, confidence intervals and comparison. # Copyright (C) 2011-2014 Xavier Robin, Alexandre Hainard, Natacha Turck, # Natalia Tiberti, Frédérique Lisacek, Jean-Charles Sanchez # and Markus Müller # # This program is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, either version 3 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program. If not, see . has.partial.auc <- function(roc) { UseMethod("has.partial.auc") } has.partial.auc.auc <- function(roc) { if (is.null(roc)) { return(NULL) } is.numeric(attr(roc, "partial.auc")) && length(attr(roc, "partial.auc") == 2) } has.partial.auc.smooth.roc <- function(roc) { return(has.partial.auc.roc(roc)) } has.partial.auc.roc <- function(roc) { return(has.partial.auc.auc(roc$auc)) } pROC/R/bootstrap.R0000644000176200001440000010206014114130125013405 0ustar liggesusers# pROC: Tools Receiver operating characteristic (ROC curves) with # (partial) area under the curve, confidence intervals and comparison. # Copyright (C) 2010-2014 Xavier Robin, Alexandre Hainard, Natacha Turck, # Natalia Tiberti, Frédérique Lisacek, Jean-Charles Sanchez # and Markus Müller # # This program is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, either version 3 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program. If not, see . ########## AUC of two ROC curves (roc.test, cov) ########## bootstrap.cov <- function(roc1, roc2, boot.n, boot.stratified, boot.return, smoothing.args, progress, parallel) { # rename method into smooth.method for roc smoothing.args$roc1$smooth.method <- smoothing.args$roc1$method smoothing.args$roc1$method <- NULL smoothing.args$roc2$smooth.method <- smoothing.args$roc2$method smoothing.args$roc2$method <- NULL # Prepare arguments for later calls to roc auc1skeleton <- attributes(roc1$auc) auc1skeleton$roc <- NULL auc1skeleton$direction <- roc1$direction auc1skeleton$class <- NULL auc1skeleton$fun.sesp <- roc1$fun.sesp auc1skeleton$allow.invalid.partial.auc.correct <- TRUE auc1skeleton <- c(auc1skeleton, smoothing.args$roc1) names(auc1skeleton)[which(names(auc1skeleton) == "n")] <- "smooth.n" auc2skeleton <- attributes(roc2$auc) auc2skeleton$roc <- NULL auc2skeleton$direction <- roc2$direction auc2skeleton$class <- NULL auc2skeleton$fun.sesp <- roc2$fun.sesp auc2skeleton$allow.invalid.partial.auc.correct <- TRUE auc2skeleton <- c(auc2skeleton, smoothing.args$roc2) names(auc2skeleton)[which(names(auc2skeleton) == "n")] <- "smooth.n" auc1skeleton$auc <- auc2skeleton$auc <- TRUE # Some attributes may be duplicated in AUC skeletons and will mess the boostrap later on when we do.call(). # If this condition happen, it probably means we have a bug elsewhere. # Rather than making a complicated processing to remove the duplicates, # just throw an error and let us solve the bug when a user reports it. duplicated.auc1skeleton <- duplicated(names(auc1skeleton)) duplicated.auc2skeleton <- duplicated(names(auc2skeleton)) if (any(duplicated.auc1skeleton)) { sessionInfo <- sessionInfo() save(roc1, roc2, boot.n, boot.stratified, boot.return, smoothing.args, progress, parallel, sessionInfo, file="pROC_bug.RData") stop(sprintf("pROC: duplicated argument(s) in AUC1 skeleton: \"%s\". Diagnostic data saved in pROC_bug.RData. Please report this bug to <%s>.", paste(names(auc1skeleton)[duplicated(names(auc1skeleton))], collapse=", "), utils::packageDescription("pROC")$BugReports)) } if (any(duplicated.auc2skeleton)) { sessionInfo <- sessionInfo() save(roc1, roc2, boot.n, boot.stratified, boot.return, smoothing.args, progress, parallel, sessionInfo, file="pROC_bug.RData") stop(sprintf("duplicated argument(s) in AUC2 skeleton: \"%s\". Diagnostic data saved in pROC_bug.RData. Please report this bug to <%s>.", paste(names(auc2skeleton)[duplicated(names(auc2skeleton))], collapse=", "), utils::packageDescription("pROC")$BugReports)) } if (boot.stratified) { # precompute sorted responses if stratified #response.roc1 <- factor(c(rep(roc1$levels[1], length(roc1$controls)), rep(roc1$levels[2], length(roc1$cases))), levels=roc1$levels) #response.roc2 <- factor(c(rep(roc2$levels[1], length(roc2$controls)), rep(roc2$levels[2], length(roc2$cases))), levels=roc2$levels) #auc1skeleton$response <- response.roc1 #auc2skeleton$response <- response.roc2 resampled.values <- laply(1:boot.n, stratified.bootstrap.test, roc1=roc1, roc2=roc2, test="boot", x=NULL, paired=TRUE, auc1skeleton=auc1skeleton, auc2skeleton=auc2skeleton, .progress=progress, .parallel=parallel) } else { auc1skeleton$levels <- roc1$levels auc1skeleton$direction <- roc1$direction auc2skeleton$levels <- roc2$levels auc2skeleton$direction <- roc2$direction resampled.values <- laply(1:boot.n, nonstratified.bootstrap.test, roc1=roc1, roc2=roc2, test="boot", x=NULL, paired=TRUE, auc1skeleton=auc1skeleton, auc2skeleton=auc2skeleton, .progress=progress, .parallel=parallel) } # are there NA values? if ((num.NAs <- sum(apply(resampled.values, 1, is.na))) > 0) { warning(sprintf("%i NA value(s) produced during bootstrap were ignored.", num.NAs)) resampled.values <- resampled.values[!apply(resampled.values, 1, function(x) any(is.na(x))),] } cov <- stats::cov(resampled.values[,1], resampled.values[,2]) if (boot.return) { attr(cov, "resampled.values") <- resampled.values } return(cov) } # Bootstrap test, used by roc.test.roc bootstrap.test <- function(roc1, roc2, test, x, paired, boot.n, boot.stratified, smoothing.args, progress, parallel) { # rename method into smooth.method for roc smoothing.args$roc1$smooth.method <- smoothing.args$roc1$method smoothing.args$roc1$method <- NULL smoothing.args$roc2$smooth.method <- smoothing.args$roc2$method smoothing.args$roc2$method <- NULL # Prepare arguments for later calls to roc auc1skeleton <- attributes(roc1$auc) auc1skeleton$roc <- NULL auc1skeleton$direction <- roc1$direction auc1skeleton$class <- NULL auc1skeleton$fun.sesp <- roc1$fun.sesp auc1skeleton$allow.invalid.partial.auc.correct <- TRUE auc1skeleton <- c(auc1skeleton, smoothing.args$roc1) names(auc1skeleton)[which(names(auc1skeleton) == "n")] <- "smooth.n" auc2skeleton <- attributes(roc2$auc) auc2skeleton$roc <- NULL auc2skeleton$direction <- roc2$direction auc2skeleton$class <- NULL auc2skeleton$fun.sesp <- roc2$fun.sesp auc2skeleton$allow.invalid.partial.auc.correct <- TRUE auc2skeleton <- c(auc2skeleton, smoothing.args$roc2) names(auc2skeleton)[which(names(auc2skeleton) == "n")] <- "smooth.n" auc1skeleton$auc <- auc2skeleton$auc <- test == "boot" # Some attributes may be duplicated in AUC skeletons and will mess the boostrap later on when we do.call(). # If this condition happen, it probably means we have a bug elsewhere. # Rather than making a complicated processing to remove the duplicates, # just throw an error and let us solve the bug when a user reports it. duplicated.auc1skeleton <- duplicated(names(auc1skeleton)) duplicated.auc2skeleton <- duplicated(names(auc2skeleton)) if (any(duplicated.auc1skeleton)) { sessionInfo <- sessionInfo() save(roc1, roc2, test, x, paired, boot.n, boot.stratified, smoothing.args, progress, parallel, sessionInfo, file="pROC_bug.RData") stop(sprintf("pROC: duplicated argument(s) in AUC1 skeleton: \"%s\". Diagnostic data saved in pROC_bug.RData. Please report this bug to <%s>.", paste(names(auc1skeleton)[duplicated(names(auc1skeleton))], collapse=", "), utils:: packageDescription("pROC")$BugReports)) } if (any(duplicated.auc2skeleton)) { sessionInfo <- sessionInfo() save(roc1, roc2, test, x, paired, boot.n, boot.stratified, smoothing.args, progress, parallel, sessionInfo, file="pROC_bug.RData") stop(sprintf("duplicated argument(s) in AUC2 skeleton: \"%s\". Diagnostic data saved in pROC_bug.RData. Please report this bug to <%s>.", paste(names(auc2skeleton)[duplicated(names(auc2skeleton))], collapse=", "), utils:: packageDescription("pROC")$BugReports)) } if (boot.stratified) { # precompute sorted responses if stratified #response.roc1 <- factor(c(rep(roc1$levels[1], length(roc1$controls)), rep(roc1$levels[2], length(roc1$cases))), levels=roc1$levels) #response.roc2 <- factor(c(rep(roc2$levels[1], length(roc2$controls)), rep(roc2$levels[2], length(roc2$cases))), levels=roc2$levels) #auc1skeleton$response <- response.roc1 #auc2skeleton$response <- response.roc2 resampled.values <- laply(1:boot.n, stratified.bootstrap.test, roc1=roc1, roc2=roc2, test=test, x=x, paired=paired, auc1skeleton=auc1skeleton, auc2skeleton=auc2skeleton, .progress=progress, .parallel=parallel) } else { auc1skeleton$levels <- roc1$levels auc1skeleton$direction <- roc1$direction auc2skeleton$levels <- roc2$levels auc2skeleton$direction <- roc2$direction resampled.values <- laply(1:boot.n, nonstratified.bootstrap.test, roc1=roc1, roc2=roc2, test=test, x=x, paired=paired, auc1skeleton=auc1skeleton, auc2skeleton=auc2skeleton, .progress=progress, .parallel=parallel) } # compute the statistics diffs <- resampled.values[,1] - resampled.values[,2] # are there NA values? if ((num.NAs <- sum(is.na(diffs))) > 0) { warning(sprintf("%i NA value(s) produced during bootstrap were ignored.", num.NAs)) diffs <- diffs[!is.na(diffs)] } # Restore smoothing if necessary if (smoothing.args$roc1$smooth) { smoothing.args$roc1$method <- smoothing.args$roc1$smooth.method roc1 <- do.call("smooth.roc", c(list(roc=roc1), smoothing.args$roc1)) } if (smoothing.args$roc2$smooth) { smoothing.args$roc2$method <- smoothing.args$roc2$smooth.method roc2 <- do.call("smooth.roc", c(list(roc=roc2), smoothing.args$roc2)) } if (test == "sp") { coord1 <- coords(roc1, x=x, input=c("specificity"), ret=c("sensitivity"), as.matrix=TRUE, transpose=FALSE)[1] coord2 <- coords(roc2, x=x, input=c("specificity"), ret=c("sensitivity"), as.matrix=TRUE, transpose=FALSE)[1] D <- (coord1 - coord2) / sd(diffs) } else if (test == "se") { coord1 <- coords(roc1, x=x, input=c("sensitivity"), ret=c("specificity"), as.matrix=TRUE, transpose=FALSE)[1] coord2 <- coords(roc2, x=x, input=c("sensitivity"), ret=c("specificity"), as.matrix=TRUE, transpose=FALSE)[1] D <- (coord1 - coord2) / sd(diffs) } else { D <- (roc1$auc - roc2$auc) / sd(diffs) } if (is.nan(D) && all(diffs == 0) && roc1$auc == roc2$auc) D <- 0 # special case: no difference between AUCs produces a NaN return(D) } stratified.bootstrap.test <- function(n, roc1, roc2, test, x, paired, auc1skeleton, auc2skeleton) { # sample control and cases separately for a stratified bootstrap idx.controls.roc1 <- sample(1:length(roc1$controls), replace=TRUE) idx.cases.roc1 <- sample(1:length(roc1$cases), replace=TRUE) # finish roc skeletons auc1skeleton$controls <- roc1$controls[idx.controls.roc1] auc1skeleton$cases <- roc1$cases[idx.cases.roc1] if (paired) { auc2skeleton$controls <- roc2$controls[idx.controls.roc1] auc2skeleton$cases <- roc2$cases[idx.cases.roc1] } else { # for unpaired, resample roc2 separately idx.controls.roc2 <- sample(1:length(roc2$controls), replace=TRUE) idx.cases.roc2 <- sample(1:length(roc2$cases), replace=TRUE) auc2skeleton$controls <- roc2$controls[idx.controls.roc2] auc2skeleton$cases <- roc2$cases[idx.cases.roc2] } # re-compute the resampled ROC curves roc1 <- try(do.call("roc.cc.nochecks", auc1skeleton), silent=TRUE) roc2 <- try(do.call("roc.cc.nochecks", auc2skeleton), silent=TRUE) # resampled ROCs might not be smoothable: return NA if (methods::is(roc1, "try-error") || methods::is(roc2, "try-error")) { return(c(NA, NA)) } else { if (test == "sp") { coord1 <- coords(roc1, x=x, input=c("specificity"), ret=c("sensitivity"), as.matrix=TRUE, transpose=FALSE)[1] coord2 <- coords(roc2, x=x, input=c("specificity"), ret=c("sensitivity"), as.matrix=TRUE, transpose=FALSE)[1] return(c(coord1, coord2)) } else if (test == "se") { coord1 <- coords(roc1, x=x, input=c("sensitivity"), ret=c("specificity"), as.matrix=TRUE, transpose=FALSE)[1] coord2 <- coords(roc2, x=x, input=c("sensitivity"), ret=c("specificity"), as.matrix=TRUE, transpose=FALSE)[1] return(c(coord1, coord2)) } else { return(c(roc1$auc, roc2$auc)) } } } nonstratified.bootstrap.test <- function(n, roc1, roc2, test, x, paired, auc1skeleton, auc2skeleton) { # sample all patients idx.all.roc1 <- sample(1:length(roc1$response), replace=TRUE) # finish roc skeletons auc1skeleton$response <- roc1$response[idx.all.roc1] auc1skeleton$predictor <- roc1$predictor[idx.all.roc1] if (paired) { # if paired, resample roc2 as roc1 auc2skeleton$response <- roc2$response[idx.all.roc1] auc2skeleton$predictor <- roc2$predictor[idx.all.roc1] } else { # if unpaired, resample roc2 separately idx.all.roc2 <- sample(1:length(roc2$response), replace=TRUE) auc2skeleton$response <- roc2$response[idx.all.roc2] auc2skeleton$predictor <- roc2$predictor[idx.all.roc2] } # re-compute the resampled ROC curves roc1 <- try(do.call("roc.rp.nochecks", auc1skeleton), silent=TRUE) roc2 <- try(do.call("roc.rp.nochecks", auc2skeleton), silent=TRUE) # resampled ROCs might not be smoothable: return NA if (methods::is(roc1, "try-error") || methods::is(roc2, "try-error")) { return(c(NA, NA)) } else { if (test == "sp") { coord1 <- coords(roc1, x=x, input=c("specificity"), ret=c("sensitivity"), as.matrix=TRUE, transpose=FALSE)[1] coord2 <- coords(roc2, x=x, input=c("specificity"), ret=c("sensitivity"), as.matrix=TRUE, transpose=FALSE)[1] return(c(coord1, coord2)) } else if (test == "se") { coord1 <- coords(roc1, x=x, input=c("sensitivity"), ret=c("specificity"), as.matrix=TRUE, transpose=FALSE)[1] coord2 <- coords(roc2, x=x, input=c("sensitivity"), ret=c("specificity"), as.matrix=TRUE, transpose=FALSE)[1] return(c(coord1, coord2)) } else { return(c(roc1$auc, roc2$auc)) } } } ########## AUC of one ROC curves (ci.auc, var) ########## ci.auc.bootstrap <- function(roc, conf.level, boot.n, boot.stratified, progress, parallel, ...) { if(class(progress) != "list") progress <- roc.utils.get.progress.bar(progress, title="AUC confidence interval", label="Bootstrap in progress...", ...) if (boot.stratified) { aucs <- unlist(llply(1:boot.n, .fun=stratified.ci.auc, roc=roc, .progress=progress, .parallel=parallel)) } else { aucs <- unlist(llply(1:boot.n, .fun=nonstratified.ci.auc, roc=roc, .progress=progress, .parallel=parallel)) } if (sum(is.na(aucs)) > 0) { warning("NA value(s) produced during bootstrap were ignored.") aucs <- aucs[!is.na(aucs)] } # TODO: Maybe apply a correction (it's in the Tibshirani?) What do Carpenter-Bithell say about that? # Prepare the return value return(quantile(aucs, c(0+(1-conf.level)/2, .5, 1-(1-conf.level)/2))) } stratified.ci.auc <- function(n, roc) { controls <- sample(roc$controls, replace=TRUE) cases <- sample(roc$cases, replace=TRUE) thresholds <- roc.utils.thresholds(c(cases, controls), roc$direction) perfs <- roc$fun.sesp(thresholds=thresholds, controls=controls, cases=cases, direction=roc$direction) roc$sensitivities <- perfs$se roc$specificities <- perfs$sp auc.roc(roc, partial.auc=attr(roc$auc, "partial.auc"), partial.auc.focus=attr(roc$auc, "partial.auc.focus"), partial.auc.correct=attr(roc$auc, "partial.auc.correct"), allow.invalid.partial.auc.correct = TRUE) } nonstratified.ci.auc <- function(n, roc) { tmp.idx <- sample(1:length(roc$predictor), replace=TRUE) predictor <- roc$predictor[tmp.idx] response <- roc$response[tmp.idx] splitted <- split(predictor, response) controls <- splitted[[as.character(roc$levels[1])]] cases <- splitted[[as.character(roc$levels[2])]] thresholds <- roc.utils.thresholds(c(controls, cases), roc$direction) perfs <- roc$fun.sesp(thresholds=thresholds, controls=controls, cases=cases, direction=roc$direction) roc$sensitivities <- perfs$se roc$specificities <- perfs$sp auc.roc(roc, partial.auc=attr(roc$auc, "partial.auc"), partial.auc.focus=attr(roc$auc, "partial.auc.focus"), partial.auc.correct=attr(roc$auc, "partial.auc.correct"), allow.invalid.partial.auc.correct = TRUE) } ########## AUC of a smooth ROC curve (ci.smooth.auc) ########## # Returns a smoothed auc in a stratified manner stratified.ci.smooth.auc <- function(n, roc, smooth.roc.call, auc.call) { controls <- sample(roc$controls, replace=TRUE) cases <- sample(roc$cases, replace=TRUE) # need to rebuild a ROC and smooth it thresholds <- roc.utils.thresholds(c(cases, controls), roc$direction) perfs <- roc$fun.sesp(thresholds=thresholds, controls=controls, cases=cases, direction=roc$direction) # update ROC roc$sensitivities <- perfs$se roc$specificities <- perfs$sp roc$cases <- cases roc$controls <- controls roc$predictor <- c(controls, cases) roc$response <- c(rep(roc$levels[1], length(controls)), rep(roc$levels[2], length(cases))) roc$thresholds <- thresholds # call smooth.roc and auc.smooth.roc smooth.roc.call$roc <- roc auc.call$smooth.roc <- try(eval(smooth.roc.call), silent=TRUE) if (methods::is(auc.call$smooth.roc, "try-error")) { return(NA) } return(eval(auc.call)) } # Returns a smoothed auc in a non stratified manner nonstratified.ci.smooth.auc <- function(n, roc, smooth.roc.call, auc.call) { tmp.idx <- sample(1:length(roc$predictor), replace=TRUE) predictor <- roc$predictor[tmp.idx] response <- roc$response[tmp.idx] splitted <- split(predictor, response) controls <- splitted[[as.character(roc$levels[1])]] cases <- splitted[[as.character(roc$levels[2])]] thresholds <- roc.utils.thresholds(c(controls, cases), roc$direction) perfs <- roc$fun.sesp(thresholds=thresholds, controls=controls, cases=cases, direction=roc$direction) # update ROC roc$sensitivities <- perfs$se roc$specificities <- perfs$sp roc$cases <- cases roc$controls <- controls roc$predictor <- predictor roc$response <- response roc$thresholds <- thresholds # call smooth.roc and auc.smooth.roc smooth.roc.call$roc <- roc auc.call$smooth.roc <- try(eval(smooth.roc.call), silent=TRUE) if (methods::is(auc.call$smooth.roc, "try-error")) { return(NA) } return(eval(auc.call)) } # ########## AUC of a multiclass ROC (ci.multiclass.auc) ########## # # ci.multiclass.auc.bootstrap <- function(roc, conf.level, boot.n, boot.stratified, progress, parallel, ...) { # if(class(progress) != "list") # progress <- roc.utils.get.progress.bar(progress, title="Multi-class AUC confidence interval", label="Bootstrap in progress...", ...) # # if (boot.stratified) { # aucs <- unlist(llply(1:boot.n, stratified.ci.multiclass.auc, roc=roc, .progress=progress, .parallel=parallel)) # } # else { # aucs <- unlist(llply(1:boot.n, nonstratified.ci.multiclass.auc, roc=roc, .progress=progress, .parallel=parallel)) # } # # if (sum(is.na(aucs)) > 0) { # warning("NA value(s) produced during bootstrap were ignored.") # aucs <- aucs[!is.na(aucs)] # } # # TODO: Maybe apply a correction (it's in the Tibshirani?) What do Carpenter-Bithell say about that? # # Prepare the return value # return(quantile(aucs, c(0+(1-conf.level)/2, .5, 1-(1-conf.level)/2))) # # } # # # Returns an auc in a stratified manner # stratified.ci.multiclass.auc <- function(n, roc) { # controls <- sample(roc$controls, replace=TRUE) # cases <- sample(roc$cases, replace=TRUE) # thresholds <- roc.utils.thresholds(c(cases, controls), roc$direction) # # perfs <- roc$fun.sesp(thresholds=thresholds, controls=controls, cases=cases, direction=roc$direction) # roc$sensitivities <- perfs$se # roc$specificities <- perfs$sp # # auc.roc(roc, partial.auc=attr(roc$auc, "partial.auc"), partial.auc.focus=attr(roc$auc, "partial.auc.focus"), partial.auc.correct=attr(roc$auc, "partial.auc.correct")) # } # # # # Returns an auc in a non stratified manner # nonstratified.ci.multiclass.auc <- function(n, roc) { # tmp.idx <- sample(1:length(roc$predictor), replace=TRUE) # predictor <- roc$predictor[tmp.idx] # response <- roc$response[tmp.idx] # splitted <- split(predictor, response) # controls <- splitted[[as.character(roc$levels[1])]] # cases <- splitted[[as.character(roc$levels[2])]] # thresholds <- roc.utils.thresholds(c(controls, cases), roc$direction) # # perfs <- roc$fun.sesp(thresholds=thresholds, controls=controls, cases=cases, direction=roc$direction) # roc$sensitivities <- perfs$se # roc$specificities <- perfs$sp # # auc.roc(roc, partial.auc=attr(roc$auc, "partial.auc"), partial.auc.focus=attr(roc$auc, "partial.auc.focus"), partial.auc.correct=attr(roc$auc, "partial.auc.correct")) # } ########## SE of a ROC curve (ci.se) ########## stratified.ci.se <- function(n, roc, sp) { controls <- sample(roc$controls, replace=TRUE) cases <- sample(roc$cases, replace=TRUE) thresholds <- roc.utils.thresholds(c(cases, controls), roc$direction) perfs <- roc$fun.sesp(thresholds=thresholds, controls=controls, cases=cases, direction=roc$direction) roc$sensitivities <- perfs$se * ifelse(roc$percent, 100, 1) roc$specificities <- perfs$sp * ifelse(roc$percent, 100, 1) roc$thresholds <- thresholds return(coords.roc(roc, sp, input = "specificity", ret = "sensitivity", transpose = FALSE, as.matrix = TRUE)[,1]) } nonstratified.ci.se <- function(n, roc, sp) { tmp.idx <- sample(1:length(roc$predictor), replace=TRUE) predictor <- roc$predictor[tmp.idx] response <- roc$response[tmp.idx] splitted <- split(predictor, response) controls <- splitted[[as.character(roc$levels[1])]] cases <- splitted[[as.character(roc$levels[2])]] thresholds <- roc.utils.thresholds(c(cases, controls), roc$direction) perfs <- roc$fun.sesp(thresholds=thresholds, controls=controls, cases=cases, direction=roc$direction) roc$sensitivities <- perfs$se * ifelse(roc$percent, 100, 1) roc$specificities <- perfs$sp * ifelse(roc$percent, 100, 1) roc$thresholds <- thresholds return(coords.roc(roc, sp, input = "specificity", ret = "sensitivity", transpose = FALSE, as.matrix = TRUE)[, 1]) } ########## SE of a smooth ROC curve (ci.se) ########## stratified.ci.smooth.se <- function(n, roc, sp, smooth.roc.call) { controls <- sample(roc$controls, replace=TRUE) cases <- sample(roc$cases, replace=TRUE) thresholds <- roc.utils.thresholds(c(cases, controls), roc$direction) perfs <- roc$fun.sesp(thresholds=thresholds, controls=controls, cases=cases, direction=roc$direction) # update ROC roc$sensitivities <- perfs$se * ifelse(roc$percent, 100, 1) roc$specificities <- perfs$sp * ifelse(roc$percent, 100, 1) roc$cases <- cases roc$controls <- controls roc$predictor <- c(controls, cases) roc$response <- c(rep(roc$levels[1], length(controls)), rep(roc$levels[2], length(cases))) roc$thresholds <- thresholds # call smooth.roc and auc.smooth.roc smooth.roc.call$roc <- roc smooth.roc <- try(eval(smooth.roc.call), silent=TRUE) if (methods::is(smooth.roc, "try-error")) return(NA) return(coords.smooth.roc(smooth.roc, sp, input = "specificity", ret = "sensitivity", transpose = FALSE, as.matrix = TRUE)[, 1]) } nonstratified.ci.smooth.se <- function(n, roc, sp, smooth.roc.call) { tmp.idx <- sample(1:length(roc$predictor), replace=TRUE) predictor <- roc$predictor[tmp.idx] response <- roc$response[tmp.idx] splitted <- split(predictor, response) controls <- splitted[[as.character(roc$levels[1])]] cases <- splitted[[as.character(roc$levels[2])]] thresholds <- roc.utils.thresholds(c(cases, controls), roc$direction) perfs <- roc$fun.sesp(thresholds=thresholds, controls=controls, cases=cases, direction=roc$direction) # update ROC roc$sensitivities <- perfs$se * ifelse(roc$percent, 100, 1) roc$specificities <- perfs$sp * ifelse(roc$percent, 100, 1) roc$cases <- cases roc$controls <- controls roc$predictor <- predictor roc$response <- response roc$thresholds <- thresholds # call smooth.roc and auc.smooth.roc smooth.roc.call$roc <- roc smooth.roc <- try(eval(smooth.roc.call), silent=TRUE) if (methods::is(smooth.roc, "try-error")) return(NA) return(coords.smooth.roc(smooth.roc, sp, input = "specificity", ret = "sensitivity", transpose = FALSE, as.matrix = TRUE)[, 1]) } ########## SP of a ROC curve (ci.sp) ########## stratified.ci.sp <- function(n, roc, se) { controls <- sample(roc$controls, replace=TRUE) cases <- sample(roc$cases, replace=TRUE) thresholds <- roc.utils.thresholds(c(cases, controls), roc$direction) perfs <- roc$fun.sesp(thresholds=thresholds, controls=controls, cases=cases, direction=roc$direction) roc$sensitivities <- perfs$se * ifelse(roc$percent, 100, 1) roc$specificities <- perfs$sp * ifelse(roc$percent, 100, 1) roc$thresholds <- thresholds return(coords.roc(roc, se, input = "sensitivity", ret = "specificity", transpose = FALSE, as.matrix = TRUE)[, 1]) } nonstratified.ci.sp <- function(n, roc, se) { tmp.idx <- sample(1:length(roc$predictor), replace=TRUE) predictor <- roc$predictor[tmp.idx] response <- roc$response[tmp.idx] splitted <- split(predictor, response) controls <- splitted[[as.character(roc$levels[1])]] cases <- splitted[[as.character(roc$levels[2])]] thresholds <- roc.utils.thresholds(c(cases, controls), roc$direction) perfs <- roc$fun.sesp(thresholds=thresholds, controls=controls, cases=cases, direction=roc$direction) roc$sensitivities <- perfs$se * ifelse(roc$percent, 100, 1) roc$specificities <- perfs$sp * ifelse(roc$percent, 100, 1) roc$thresholds <- thresholds return(coords.roc(roc, se, input = "sensitivity", ret = "specificity", transpose = FALSE, as.matrix = TRUE)[, 1]) } ########## SP of a smooth ROC curve (ci.sp) ########## stratified.ci.smooth.sp <- function(n, roc, se, smooth.roc.call) { controls <- sample(roc$controls, replace=TRUE) cases <- sample(roc$cases, replace=TRUE) thresholds <- roc.utils.thresholds(c(cases, controls), roc$direction) perfs <- roc$fun.sesp(thresholds=thresholds, controls=controls, cases=cases, direction=roc$direction) # update ROC roc$sensitivities <- perfs$se * ifelse(roc$percent, 100, 1) roc$specificities <- perfs$sp * ifelse(roc$percent, 100, 1) roc$cases <- cases roc$controls <- controls roc$predictor <- c(controls, cases) roc$response <- c(rep(roc$levels[1], length(controls)), rep(roc$levels[2], length(cases))) roc$thresholds <- thresholds # call smooth.roc and auc.smooth.roc smooth.roc.call$roc <- roc smooth.roc <- try(eval(smooth.roc.call), silent=TRUE) if (methods::is(smooth.roc, "try-error")) return(NA) return(coords.smooth.roc(smooth.roc, se, input = "sensitivity", ret = "specificity", transpose = FALSE, as.matrix = TRUE)[, 1]) } nonstratified.ci.smooth.sp <- function(n, roc, se, smooth.roc.call) { tmp.idx <- sample(1:length(roc$predictor), replace=TRUE) predictor <- roc$predictor[tmp.idx] response <- roc$response[tmp.idx] splitted <- split(predictor, response) controls <- splitted[[as.character(roc$levels[1])]] cases <- splitted[[as.character(roc$levels[2])]] thresholds <- roc.utils.thresholds(c(cases, controls), roc$direction) perfs <- roc$fun.sesp(thresholds=thresholds, controls=controls, cases=cases, direction=roc$direction) # update ROC roc$sensitivities <- perfs$se * ifelse(roc$percent, 100, 1) roc$specificities <- perfs$sp * ifelse(roc$percent, 100, 1) roc$cases <- cases roc$controls <- controls roc$predictor <- predictor roc$response <- response roc$thresholds <- thresholds # call smooth.roc and auc.smooth.roc smooth.roc.call$roc <- roc smooth.roc <- try(eval(smooth.roc.call), silent=TRUE) if (methods::is(smooth.roc, "try-error")) return(NA) return(coords.smooth.roc(smooth.roc, se, input = "sensitivity", ret = "specificity", transpose = FALSE, as.matrix = TRUE)[, 1]) } ########## Threshold of a ROC curve (ci.thresholds) ########## stratified.ci.thresholds <- function(n, roc, thresholds) { controls <- sample(roc$controls, replace=TRUE) cases <- sample(roc$cases, replace=TRUE) return(sapply(thresholds, roc.utils.perfs, controls=controls, cases=cases, direction=roc$direction)) } # Returns an auc in a non stratified manner nonstratified.ci.thresholds <- function(n, roc, thresholds) { tmp.idx <- sample(1:length(roc$predictor), replace=TRUE) predictor <- roc$predictor[tmp.idx] response <- roc$response[tmp.idx] splitted <- split(predictor, response) controls <- splitted[[as.character(roc$levels[1])]] cases <- splitted[[as.character(roc$levels[2])]] return(sapply(thresholds, roc.utils.perfs, controls=controls, cases=cases, direction=roc$direction)) } ########## Coords of one ROC curves (ci.coords) ########## stratified.ci.coords <- function(roc, x, input, ret, best.method, best.weights, best.policy) { controls <- sample(roc$controls, replace=TRUE) cases <- sample(roc$cases, replace=TRUE) thresholds <- roc.utils.thresholds(c(cases, controls), roc$direction) perfs <- roc$fun.sesp(thresholds=thresholds, controls=controls, cases=cases, direction=roc$direction) # update ROC roc$sensitivities <- perfs$se roc$specificities <- perfs$sp roc$cases <- cases roc$controls <- controls roc$predictor <- c(controls, cases) roc$response <- c(rep(roc$levels[1], length(controls)), rep(roc$levels[2], length(cases))) roc$thresholds <- thresholds res <- coords.roc(roc, x = x, input = input, ret = ret, best.method = best.method, best.weights = best.weights, drop = FALSE, transpose = FALSE, as.matrix = TRUE) # Return a random column with "best" if (length(x) == 1 && x == "best" && nrow(res) != 1) { return(enforce.best.policy(res, best.policy)) } else { return(res) } } nonstratified.ci.coords <- function(roc, x, input, ret, best.method, best.weights, best.policy) { tmp.idx <- sample(1:length(roc$predictor), replace=TRUE) predictor <- roc$predictor[tmp.idx] response <- roc$response[tmp.idx] splitted <- split(predictor, response) controls <- splitted[[as.character(roc$levels[1])]] cases <- splitted[[as.character(roc$levels[2])]] thresholds <- roc.utils.thresholds(c(controls, cases), roc$direction) perfs <- roc$fun.sesp(thresholds=thresholds, controls=controls, cases=cases, direction=roc$direction) # update ROC roc$sensitivities <- perfs$se roc$specificities <- perfs$sp roc$cases <- cases roc$controls <- controls roc$predictor <- c(controls, cases) roc$response <- c(rep(roc$levels[1], length(controls)), rep(roc$levels[2], length(cases))) roc$thresholds <- thresholds res <- coords.roc(roc, x = x, input = input, ret = ret, best.method = best.method, best.weights = best.weights, drop = FALSE, transpose = FALSE, as.matrix = TRUE) # Return a random column with "best" if (length(x) == 1 && x == "best" && nrow(res) != 1) { return(enforce.best.policy(res, best.policy)) } else { return(res) } } ########## Coords of a smooth ROC curve (ci.coords) ########## stratified.ci.smooth.coords <- function(roc, x, input, ret, best.method, best.weights, smooth.roc.call, best.policy) { controls <- sample(roc$controls, replace=TRUE) cases <- sample(roc$cases, replace=TRUE) thresholds <- roc.utils.thresholds(c(cases, controls), roc$direction) perfs <- roc$fun.sesp(thresholds=thresholds, controls=controls, cases=cases, direction=roc$direction) # update ROC roc$sensitivities <- perfs$se * ifelse(roc$percent, 100, 1) roc$specificities <- perfs$sp * ifelse(roc$percent, 100, 1) roc$cases <- cases roc$controls <- controls roc$predictor <- c(controls, cases) roc$response <- c(rep(roc$levels[1], length(controls)), rep(roc$levels[2], length(cases))) roc$thresholds <- thresholds # call smooth.roc and auc.smooth.roc smooth.roc.call$roc <- roc smooth.roc <- try(eval(smooth.roc.call), silent=TRUE) if (methods::is(smooth.roc, "try-error")) return(NA) res <- coords.roc(smooth.roc, x = x, input = input, ret = ret, best.method = best.method, best.weights = best.weights, drop = FALSE, transpose = FALSE, as.matrix = TRUE) # Return a random column with "best" if (length(x) == 1 && x == "best" && nrow(res) != 1) { return(enforce.best.policy(res, best.policy)) } else { return(res) } } nonstratified.ci.smooth.coords <- function(roc, x, input, ret, best.method, best.weights, smooth.roc.call, best.policy) { tmp.idx <- sample(1:length(roc$predictor), replace=TRUE) predictor <- roc$predictor[tmp.idx] response <- roc$response[tmp.idx] splitted <- split(predictor, response) controls <- splitted[[as.character(roc$levels[1])]] cases <- splitted[[as.character(roc$levels[2])]] thresholds <- roc.utils.thresholds(c(cases, controls), roc$direction) perfs <- roc$fun.sesp(thresholds=thresholds, controls=controls, cases=cases, direction=roc$direction) # update ROC roc$sensitivities <- perfs$se * ifelse(roc$percent, 100, 1) roc$specificities <- perfs$sp * ifelse(roc$percent, 100, 1) roc$cases <- cases roc$controls <- controls roc$predictor <- predictor roc$response <- response roc$thresholds <- thresholds # call smooth.roc and auc.smooth.roc smooth.roc.call$roc <- roc smooth.roc <- try(eval(smooth.roc.call), silent=TRUE) if (methods::is(smooth.roc, "try-error")) return(NA) res <- coords.roc(smooth.roc, x = x, input = input, ret = ret, best.method = best.method, best.weights = best.weights, drop = FALSE, transpose = FALSE, as.matrix = TRUE) # Return a random column with "best" if (length(x) == 1 && x == "best" && nrow(res) != 1) { return(enforce.best.policy(res, best.policy)) } else { return(res) } } pROC/MD50000644000176200001440000002702614114354132011372 0ustar liggesusers9be9bfe705b14548a63d18ad3a77542d *DESCRIPTION a0ef34a2fdd7d941325a0816e1133d06 *NAMESPACE 1ae72af87cdfb86c61e54b85c8c68fb1 *NEWS 733a035f55579ce3bce8a274fb4bc2ea *R/RcppExports.R 986b425be214866a411c22cde9bbb853 *R/are.paired.R c847635f27f48d053751eca332c16e71 *R/auc.R e68b123aae9e2b78bc3b5cda4db68e01 *R/bootstrap.R 9af281ac2446bb571b8b57a5522e4fa0 *R/ci.R 432686e26127636a99ff2e36cef92e0c *R/ci.auc.R 6db5e02cd1af2936a4feaa6be35372a9 *R/ci.coords.R 878b4e4f3b1b3d2da54441e893c20a4c *R/ci.multiclass.auc.R ab5aa1f6b5bb538637f7d3379f3a6377 *R/ci.se.R 810c093b9fbd932a7140d1d79f47c252 *R/ci.sp.R efb8df061bff28de93c565d7264a9cea *R/ci.thresholds.R 6a08a2d3ee2b47beb4d19a9be9e35dfb *R/coords.R 66af4bba0f254e0545c32db82fbf3547 *R/cov.R 2b7346501255731e6c4ef60eaad88953 *R/delong.R 6201cf939b11ccdf6f22cfe8293dcad2 *R/ggroc.R 36d6466ce122578cb9df5fbbef204e5f *R/groupGeneric.R 9ae5686b982716f005e176c11be79ff8 *R/has.partial.auc.R 98263c07babc079ebd8455abc4dcddd3 *R/lines.roc.R 78515052c4ee24e7ab3c28267f55800a *R/multiclass.R 436a84af90571e541e18d18c13996813 *R/null.roc.R 81a8200ca5982b7890be8ff1808faf29 *R/obuchowski.R c123ca1538e732491edbd0ddb6c4edea *R/onLoad.R 3ce288bf6474bec2eb0f99a67d4f88bc *R/plot.ci.R 2c2c36e1c7b367e9a8dc6941f3ae3761 *R/plot.roc.R ae3711db1e46bfbae8deceabb2ae902d *R/power.roc.test.R cca9017714c27160349732162546d86a *R/print.R a111ae55fc2ff1b64ca75166042f49f0 *R/roc.R 61c9ae3f376f0176dcd2f34a67329e97 *R/roc.test.R 40526610b05546fff76d3db850164f42 *R/roc.utils.R d8ac310a521cfac6e08e507c7c3ae0a3 *R/roc.utils.percent.R d3688c73bf2b8a52ab572384dafd7108 *R/smooth.R db85bde8265820862f8d6f69d43cc31b *R/var.R 4026da78c98725f60fb25c39bcb774af *R/venkatraman.R ef8eebcc070dc0ec508b3ec963bb6807 *README.md 25649ba97b931cc1935d9d22ae8817e0 *build/partial.rdb e33e5e7b38d7ed92fcc33e9b0bea30ff *data/aSAH.RData a1fb75ef4e8cedbf0750fe0f9f30672f *inst/CITATION a504422c763dfae05e32b565257c0bc8 *inst/extra/algorithms.speed.test.R e5368b578a5f3e3ab7cb3d0425622c24 *inst/extra/bench/fig-unnamed-chunk-13-1.png 56b79d4a84df3d49a4074813565293fa *inst/extra/bench/fig-unnamed-chunk-5-1.png 633884dd445cf047b71c8dc1f32d2b11 *inst/extra/bench/fig-unnamed-chunk-9-1.png abdc9962c9d7d0b5455fadb91b9499eb *inst/extra/benchmark.Rmd 264e005a23e243383c0282c3b276143a *inst/extra/benchmark.md 9be90c08a789f9c93188d4317b2a3681 *inst/extra/sos_clashes.R b0feb80ddf533630709b900b5303bbcb *man/aSAH.Rd a9ae4bf26bf6a740bf9dc0129eea6c64 *man/are.paired.Rd 74a315e2be9a0042eee55925ab9628d0 *man/auc.Rd cf13847e27aa66056b7d8cd56ecaf768 *man/ci.Rd 9adfed60c6af78a8778329d5f3c93bab *man/ci.auc.Rd 72d4657be40a9eed7191f50d341b29e6 *man/ci.coords.Rd f8c87c9fc712684c817afc4b67ed6d67 *man/ci.se.Rd 64e711fe66f0a365de38282bb8a33ef4 *man/ci.sp.Rd f1ec2205220ef8a5bc30807b0e717757 *man/ci.thresholds.Rd 63cd0d54f48b43444a611e9e641db664 *man/coords.Rd 16c2d7f8c400c15b3f5a67ab069563cb *man/coords_transpose.Rd 6b94329189285109101df1bee44de663 *man/cov.Rd 56a58dafffe01d394776d4889dd9607b *man/ggroc.Rd 413f7b80f60d02f9406d5148bb599d31 *man/groupGeneric.Rd 048bc5f42aa77f0da8dbf0273d44ca30 *man/has.partial.auc.Rd 84c33e9f954442a44d4294c20827434b *man/lines.roc.Rd f503f5856fb0932df9969985b67a07ea *man/multiclass.Rd 946c777356a7930bbfbe53cfdd0453e2 *man/pROC-package.Rd ac87ca770072140ff56525833da74e00 *man/plot.ci.Rd 6c23cbced2b45db8c753f7d463cc914c *man/plot.roc.Rd e71db6dcf07f8d2372ea0665f1fd666f *man/power.roc.test.Rd 64552950ff21b8eb7f5cc75f37ca4567 *man/print.Rd ae4ff78e6069112fb987bac4e6f0d02d *man/roc.Rd ceee5f081b64d01fc4cd6511ff4b0cdb *man/roc.test.Rd 78a515a0fb0ffce1a39b6e1896ba84cd *man/smooth.Rd 84ec170f04b3ae9d0920da39f0120f26 *man/var.Rd 0ac9375d15c97b52aa6e31f8d809a96b *src/RcppExports.cpp 7770ca48e5f75bfd93282a6708d55701 *src/RcppVersion.cpp 9883349305bdff6faa8bbaea422cdfe7 *src/delong.cpp e0d2a90a5dd220bd4f904f118378dcc1 *src/perfsAll.cpp 37455b724fc4126f1b8305cc5c05f444 *tests/figs/deps.txt 3d4f7a2115ccaa450bb79b2f06283f75 *tests/figs/ggroc/ggroc-list-extra-aes-screenshot.svg 77d4bbb873aa16139acb3d14e7dc8ba1 *tests/figs/ggroc/ggroc-list-group-facet-screenshot.svg ef2f2bca13a6962f760be3111bdc6968 *tests/figs/ggroc/ggroc-list-multi-aes.svg 4ac70d64e1485ad38ee8f98498a872ec *tests/figs/ggroc/ggroc-list-scale-colour-manual.svg 0bff3c0bc7b8d36bfefbbde71445c273 *tests/figs/ggroc/ggroc-list-screenshot.svg f2a2b1c3ed14b7412383ed8e99412066 *tests/figs/ggroc/ggroc-screenshot.svg 1b1b5a435367b944c61fddcfa2af8e7d *tests/figs/ggroc/ggroc-smooth-list-screenshot.svg b512fbd5ba18e15661d22dd096b28e73 *tests/figs/ggroc/ggroc-smooth-screenshot.svg fc9ed608ec7f9bb6d403fa4220aa7d19 *tests/figs/plot/advanced-screenshot-1.svg 6ff8bd9bd0569e43d6afd559cebff718 *tests/figs/plot/advanced-screenshot-2.svg f4cb36b6953de603e90d49ce90e89201 *tests/figs/plot/advanced-screenshot-3.svg 4be3469f2bd7be6a4b30ff7a93160ad5 *tests/figs/plot/advanced-screenshot-4.svg bd588ffa63461fcbd9e5bf322952233a *tests/figs/plot/advanced-screenshot-5.svg c094331338df7b36748a1a197767739b *tests/figs/plot/advanced-screenshot-6.svg 39dcda33652476f177582bec68f2565b *tests/figs/plot/basic-ndka.svg 407b09e25a5fda23506fc0aa9728db2f *tests/figs/plot/basic-s100b.svg 35620625b384619a74047e3137a00b9f *tests/figs/plot/basic-wfns.svg 13347ad1ebc459c4c2b2177be655dd36 *tests/figs/plot/legacy-axes.svg 7d5b1f9acb17ad0ea40853244f775fbd *tests/figs/plot/plot-formula.svg 413b7c1733922a221f4648a4d2d166cf *tests/testthat.R a0fb77d5257111c999dac06f3f48a01b *tests/testthat/helper-coords-expected-smooth.R cd850eca43cf304c7681f1dfe69ab52e *tests/testthat/helper-coords-expected.R 5d35e4bb5b3df35ba4f5ed8f8c95c308 *tests/testthat/helper-deLongPlacementsCpp-expected.R 432a4d5ca3e3c2446f65f345eb24e37e *tests/testthat/helper-expect_equal_roc.R 4df23d17c491b6e9710a11d3126b4b94 *tests/testthat/helper-expectations.R 699d84dfc1d846046ee837be87dbbb5b *tests/testthat/helper-roc-expected.R ad103041b214fb0a5d06f8f4746adc53 *tests/testthat/helper-roc.utils-expected.R 434dd89c8e8d7b358d9849327d7f93c9 *tests/testthat/helper-rocs.R 270db3810fee356e95a81c2afecbec18 *tests/testthat/helper-skip.R 32c9561487c7b5b1707ff39157bc67a7 *tests/testthat/helper-vdiffr.R 2b8602ea23b78a56dd3b29f9fcaa4f51 *tests/testthat/print_output/multiclass 6bc0e1d2ad3376febd8296686d5edefd *tests/testthat/print_output/multiclass_levels 31af3ad2dd3035baf35bcda5eb79317c *tests/testthat/print_output/multiclass_partial a8e4e4d73b76c0b3fc0bec9fbddad331 *tests/testthat/print_output/multiclass_partial_correct 6e1247aa7c490c815a2226d0a2fe445b *tests/testthat/print_output/multiclass_partial_se a8ce6079f350b8a14f13485819503b75 *tests/testthat/print_output/multiclass_percent 3bda4031928d90f76cfc4c89d7e1de98 *tests/testthat/print_output/mv_multiclass 52f008f68c41fd7753cd0afcbcf66d91 *tests/testthat/print_output/mv_multiclass.ndka.formula 66221dee8271f01de6be63bc5ddfbe29 *tests/testthat/print_output/mv_multiclass_levels e6862becc5d3104df16b8f4ea11c2524 *tests/testthat/print_output/mv_multiclass_partial 6ae718b44b2f1c7797590b6793df3b55 *tests/testthat/print_output/mv_multiclass_partial_correct d112684a2b35e3574aaf81bc894b2299 *tests/testthat/print_output/mv_multiclass_partial_se 8b6217a308e31e3ae19c551569ff4f3d *tests/testthat/print_output/mv_multiclass_percent 20e3da54e8241e9d68297d5e43d4eb55 *tests/testthat/print_output/ndka_formula 73c9ec8b06f2d2887001e54bfc603979 *tests/testthat/print_output/r.ndka c3482e12bd9fc0f630fcac4dd11ae67c *tests/testthat/print_output/r.ndka.ci.auc 8921688704cc5296a910aee6653764ec *tests/testthat/print_output/r.ndka.ci.coords a6dcf99aa728059a9998189836f76761 *tests/testthat/print_output/r.ndka.ci.se 443f3116776d1f56eda7157db07b8908 *tests/testthat/print_output/r.ndka.ci.sp 38a613d2ee6d9098b6c8b4521cb3c37a *tests/testthat/print_output/r.ndka.ci.thresholds 20e3da54e8241e9d68297d5e43d4eb55 *tests/testthat/print_output/r.ndka.formula 4f3538d3e8ae303c94cc0a40bb0cb27f *tests/testthat/print_output/r.ndka.formula.ci 09109ef75c67aaaf10ab85f32ab6e2bd *tests/testthat/print_output/r.ndka.formula.no_auc 5965132d3e6f618c029a326c68924060 *tests/testthat/print_output/r.ndka.partial1 36eaeccfc6296c322da47940e22aa01a *tests/testthat/print_output/r.ndka.percent 56321410b6cd60808ae6081ab26797ca *tests/testthat/print_output/r.ndka.percent.partial1 599d32a7c7ea10cbf012e66cd5dd5e9a *tests/testthat/print_output/r.s100b 22dadd712f7973e66997b668ba881894 *tests/testthat/print_output/r.s100b.partial1 648065fec1305aa8ea30a192de184a56 *tests/testthat/print_output/r.s100b.partial2 b7dcfd2a88f46ef319e897ef7ea8765d *tests/testthat/print_output/r.s100b.percent 416f3b5dc6f4e4b35eca621f7eb37c44 *tests/testthat/print_output/r.s100b.percent.partial1 e33cc698639a196bf10c759f55e23d80 *tests/testthat/print_output/r.wfns 6ee5cd4c7d51beebc08b49f3634e50d8 *tests/testthat/print_output/r.wfns.partial1 0501b1ea0951d6a233ca90082c35c706 *tests/testthat/print_output/r.wfns.percent 9d48383eed9176489894b0084a7044f3 *tests/testthat/print_output/r.wfns.percent.partial1 9102a55eb23ed8f566a49c4b33b5218c *tests/testthat/print_output/roc.test-venkatraman.paired 95f3320c74b0d7814093e1eb52033ac8 *tests/testthat/print_output/roc.test-venkatraman.unpaired 810e400cee477f8f99d29889975ac1e5 *tests/testthat/print_output/roc.test-venkatraman.unpaired.unstratified 4739552933356b33bb8754a48dfc06ea *tests/testthat/print_output/roc.test-venkatraman.unstratified 0a9ef7042d272331a0ba9ea3e07a18ca *tests/testthat/print_output/smooth.ndka 878b083364c3cbef619c0d1e31f55487 *tests/testthat/print_output/smooth.s100b.binormal 30141f3564d0dceb73d0b200698fca56 *tests/testthat/print_output/smooth.s100b.density d70e2e82e3876d5c110e7d0cd2a7d86a *tests/testthat/print_output/smooth.s100b.fitdistr 0251d65a00ce5834b6fc55be885d4f06 *tests/testthat/print_output/smooth.s100b.formula 10b169570249e00adad5260d8843822b *tests/testthat/print_output/smooth.s100b.logcondens 51b720a8cb79f1263a54037213925c93 *tests/testthat/print_output/smooth.s100b.logcondens.smooth 0a9ef7042d272331a0ba9ea3e07a18ca *tests/testthat/print_output/smooth.wfns 8895b22e6bd8963d2a5425ab7d91f9c0 *tests/testthat/test-Ops.R 6a1feb00af43e3f3940c646ba7ee1275 *tests/testthat/test-are-paired.R 3b53cffef421a658d3c1094270110c6a *tests/testthat/test-auc.R 5ecc8a452a8f3e15ada6dd69c88489a2 *tests/testthat/test-ci.auc.R 489fc82aee37bfee42bbb8acb19aa8cc *tests/testthat/test-ci.coords.R b1208d20560e1d6f1a5163fd3a862185 *tests/testthat/test-ci.formula.R f37ca3b432ffab933f0e1c81d427cde4 *tests/testthat/test-ci.se.R 3ba89bc97f88af95b8a5077c3dec176d *tests/testthat/test-ci.sp.R 00d717c2150e55f5d1427b052ec22b7f *tests/testthat/test-ci.thresholds.R 3bc8f50e27a9595dbccc95060fdb703b *tests/testthat/test-coords.R 2f55cdbbef57f8a68e7ffa4790a121e2 *tests/testthat/test-cov.R 65b4e98051acd9dabed164bc40cb9aaf *tests/testthat/test-deLongPlacementsCpp.R 9922c17de4161a2865438e690e682929 *tests/testthat/test-ggroc.R 910ea339e78263d181b75328325a9252 *tests/testthat/test-large.R c22b29a0120f4902785107c1e9aafd83 *tests/testthat/test-multiclass.R 252c1e6a9fc983930134e97e06a57e34 *tests/testthat/test-numeric-Inf.R c3da9cd8c86db7e967351fe7e34f3dcf *tests/testthat/test-numeric-accuracy.R 4ba602960ab7829ba5d092b2cc47fb18 *tests/testthat/test-onload.R 0ef160c1483efb7b940c4ddf8a2f7902 *tests/testthat/test-plot.R 253c6170ae833db2b8fc6116c966ba17 *tests/testthat/test-power.roc.test.R e9714b7ef99f8ee019dcbe7d0b923074 *tests/testthat/test-print.R d5d9caf0b8634cf5c51d2890e95a7b1b *tests/testthat/test-roc.R d3f00e390362b4e7256fe20b9c25d8a9 *tests/testthat/test-roc.test-venkatraman.R 8ad3a06b11bde29090a7a86c4b77655d *tests/testthat/test-roc.test.R 3c5b4f2ec25f421ae844bb6c6696a730 *tests/testthat/test-roc.utils.R 3bc16a74ddf12363ba6cefb9a85bf08c *tests/testthat/test-roc.utils.percent.R e06bcd47c8e3d78429cf7e6ad0f00db8 *tests/testthat/test-smooth.R d0e658afb5381f3dd3ba5b226b6bd483 *tests/testthat/test-var.R pROC/inst/0000755000176200001440000000000013607143106012033 5ustar liggesuserspROC/inst/CITATION0000644000176200001440000000204613607143106013172 0ustar liggesuserscitHeader("If you use pROC in published research, please cite the following paper:") citEntry(entry="Article", title = "pROC: an open-source package for R and S+ to analyze and compare ROC curves", author = personList(as.person("Xavier Robin"), as.person("Natacha Turck") , as.person("Alexandre Hainard") , as.person("Natalia Tiberti") , as.person("Frédérique Lisacek") , as.person("Jean-Charles Sanchez"), as.person("Markus Müller")), year = 2011, journal = "BMC Bioinformatics", volume = 12, pages = 77, #doi = "10.1186/1471-2105-12-77", # removed: takes too much space #url = "http://www.biomedcentral.com/1471-2105/12/77/", textVersion = "Xavier Robin, Natacha Turck, Alexandre Hainard, Natalia Tiberti, Frédérique Lisacek, Jean-Charles Sanchez and Markus Müller (2011). pROC: an open-source package for R and S+ to analyze and compare ROC curves. BMC Bioinformatics, 12, p. 77.\n DOI: 10.1186/1471-2105-12-77 " ) pROC/inst/extra/0000755000176200001440000000000013607143106013156 5ustar liggesuserspROC/inst/extra/sos_clashes.R0000644000176200001440000001034313607143106015610 0ustar liggesusers# Need to export R_MAX_NUM_DLLS=1000 before sourcing this script. library(sos) library(htmlTable) library(stringr) library(dplyr) # Get auc functions auc.search <- findFn("auc") auc.functions <- auc.search %>% filter(Function == "auc", Package != "pROC") %>% select(Package, Function, Description, Link) rownames(auc.functions) <- auc.functions$Package ci.search <- findFn("ci") ci.functions <- ci.search %>% filter(Function == "ci", Package != "pROC") %>% select(Package, Function, Description, Link) rownames(ci.functions) <- ci.functions$Package # Get roc functions roc.search <- findFn("roc") roc.functions <- roc.search %>% filter(Function == "roc", Package != "pROC") %>% select(Package, Function, Description, Link) rownames(roc.functions) <- roc.functions$Package # Install missing packages missing.packages <- auc.functions$Package[ ! auc.functions$Package %in% installed.packages()[,"Package"]] if (length(missing.packages) > 0) install.packages(missing.packages) missing.packages <- roc.functions$Package[ ! roc.functions$Package %in% installed.packages()[,"Package"]] if (length(missing.packages) > 0) install.packages(missing.packages) missing.packages <- ci.functions$Package[ ! ci.functions$Package %in% installed.packages()[,"Package"]] if (length(missing.packages) > 0) install.packages(missing.packages) # Filter packages that are still missing available.packages.with.auc <- auc.functions[auc.functions$Package %in% installed.packages()[,"Package"],] available.packages.with.roc <- roc.functions[roc.functions$Package %in% installed.packages()[,"Package"],] available.packages.with.ci <- ci.functions[ci.functions$Package %in% installed.packages()[,"Package"],] #' Check if a function within a package is a generic function #' @param pkg package name as a character string #' @param fun function name as a character string #' @return \code{TRUE} if the function is generic, \code{FALSE} otherwise. #' If the package doesn't contain a function named `fun`, \code{NA} is returned. is.function.in.package.generic <- function(pkg, fun) { old.search.pos <- search()[2] on.exit({ while (attr(parent.env(.GlobalEnv), "name") != old.search.pos) { detach(unload = TRUE) } }) suppressPackageStartupMessages(library(pkg, character.only = TRUE)) # Does the package actually have a roc function t <- try(get(fun), silent=TRUE) if (methods::is(t, "try-error")) { warning(sprintf("Package %s doesn't seem to contain function %s", pkg, fun)) return(NA) } if (utils::isS3stdGeneric(fun)) { return(TRUE) } if (methods::isGeneric(fun)) { return(TRUE) } return(FALSE) } # Test which packages have generic functions generics.auc <- sapply(available.packages.with.auc$Package, is.function.in.package.generic, fun="auc") generics.roc <- sapply(available.packages.with.roc$Package, is.function.in.package.generic, fun="roc") generics.ci <- sapply(available.packages.with.ci$Package, is.function.in.package.generic, fun="ci") # Prepare table available.packages.with.auc$Generic <- c("TRUE"="Generic", "FALSE"="Not Generic")[as.character(generics.auc)] available.packages.with.auc$auc <- sprintf('%s', available.packages.with.auc$Link, available.packages.with.auc$Generic) available.packages.with.roc$Generic <- c("TRUE"="Generic", "FALSE"="Not Generic")[as.character(generics.roc)] available.packages.with.roc$roc <- sprintf('%s', available.packages.with.roc$Link, available.packages.with.roc$Generic) available.packages.with.ci$Generic <- c("TRUE"="Generic", "FALSE"="Not Generic")[as.character(generics.ci)] available.packages.with.ci$ci <- sprintf('%s', available.packages.with.ci$Link, available.packages.with.ci$Generic) # Final table table <- data.frame( Package = union(union(available.packages.with.roc$Package, available.packages.with.auc$Package), available.packages.with.ci$Package)) rownames(table) <- table$Package table[available.packages.with.roc$Package, "roc"] <- available.packages.with.roc$roc table[available.packages.with.auc$Package, "auc"] <- available.packages.with.auc$auc table[available.packages.with.ci$Package, "ci"] <- available.packages.with.ci$ci # Format as HTML table htmlTable(table[order(table$Package), c("Package", "roc", "auc", "ci")], escape.html = FALSE, rnames=FALSE) pROC/inst/extra/benchmark.md0000644000176200001440000000721413607143106015436 0ustar liggesusers # Benchmarks These benchmarks compare pROC with competing ROC analysis packages in R. They can serve as a way to detect performance bottleneck that must be fixed, and possible regressions in performance. The benchmarking are carried out with the **microbenchmark** package and randomly generated data. The values of the `x` predictor variable are drawn from a normal distribution, resulting in every value being essentially unique. Predictor values for positive examples are increased to have a mean of 1, resulting in ROC curves with an AUC of 0.76. The benchmark code is adapted from the [cutpointr vignette by Christian Thiele](https://github.com/Thie1e/cutpointr/blob/master/vignettes/cutpointr.Rmd), released under a GPL-3 license. ## Building the ROC curve This first benchmark looks at the time needed to building the ROC curve only, and getting sensitivities, specificities and thresholds. Only packages allowing turn off the calculation of the AUC, or not computing it by default, were tested. ![](bench/fig-unnamed-chunk-5-1.png) | n | pROC | ROCR | | -------: | -----------: | ----------: | | 1e+03 | 0.6579095 | 2.059954 | | 1e+04 | 3.6905450 | 5.727894 | | 1e+05 | 41.4205780 | 49.021695 | | 1e+06 | 600.3593600 | 643.874491 | | 1e+07 | 8220.1797555 | 9012.922116 | | \#\# AUC | | | This benchmark tests how long it takes to calculate the ROC curve and the area under the ROC curve (AUC). ![](bench/fig-unnamed-chunk-9-1.png) | n | Epi | pROC | PRROC | ROCR | | ----: | ----------: | ----------: | ---------: | ----------: | | 1e+03 | 5.635899 | 0.683097 | 0.33761 | 2.184626 | | 1e+04 | 66.644144 | 5.037177 | 2.21852 | 7.965816 | | 1e+05 | 579.622447 | 35.752837 | 15.31815 | 44.327074 | | 1e+06 | 8352.085559 | 583.754913 | 181.14614 | 757.437651 | | 1e+07 | NA | 8276.516090 | 2899.50254 | 9149.835111 | ## Best threshold Benchmarks packages that extract the “best” threshold. At the moment they all use the Youden index. This includes building the ROC curve first. #> Multiple optimal cutpoints found #> Multiple optimal cutpoints found #> Multiple optimal cutpoints found #> Multiple optimal cutpoints found #> Multiple optimal cutpoints found #> Multiple optimal cutpoints found #> Multiple optimal cutpoints found #> Multiple optimal cutpoints found #> Multiple optimal cutpoints found #> Multiple optimal cutpoints found #> Multiple optimal cutpoints found #> Multiple optimal cutpoints found #> Multiple optimal cutpoints found #> Multiple optimal cutpoints found #> Multiple optimal cutpoints found #> Multiple optimal cutpoints found #> Multiple optimal cutpoints found #> Multiple optimal cutpoints found #> Multiple optimal cutpoints found #> Multiple optimal cutpoints found ![](bench/fig-unnamed-chunk-13-1.png) | n | cutpointr | OptimalCutpoints | pROC | ThresholdROC | | ----: | ----------: | ---------------: | ----------: | -----------: | | 1e+02 | 4.779029 | 1.959683 | 0.569432 | 1.032499 | | 1e+03 | 5.395060 | 30.739701 | 1.034866 | 22.389875 | | 1e+04 | 7.195595 | 2902.387499 | 4.311928 | 2018.123223 | | 1e+05 | 26.105981 | NA | 39.171103 | NA | | 1e+06 | 276.263793 | NA | 579.522941 | NA | | 1e+07 | 4258.031252 | NA | 8329.708682 | NA | pROC/inst/extra/algorithms.speed.test.R0000644000176200001440000001143313607143106017531 0ustar liggesusers# This script tests which algorithm is faster: 2 or 3? # The intuition is that 3 is much better with few thresholds, but behaves horribly # as the number increases. However it seems less affected by the number of data points. # It might change over time so let's make it easier to test again in the future library(pROC) library(dplyr) #devtools::install_github("xrobin/xavamess") library(xavamess) library(ggplot2) library(parallel) # Number of observations to test ns <- as.vector(outer(c(1), c(2:7), function(i, j) i * 10^j)) # Controls how many thresholds we get norm.factors <- as.vector(outer(c(1, 2, 5), c(0:2), function(i, j) i * 10^j)) # Number of cores to execute on # We want the number of physical cores, remove 1 to be sure parallel::detectCores() / 2 - 1 # Loop over all those conditions times.by.alg <- lapply(2:3, function(algorithm) { times <- lapply(rev(norm.factors), function(norm.factor) { #times <- autoParLapply(rev(norm.factors), function(norm.factor) { as.data.frame(t(sapply(ns, function(n) { print(sprintf("a=%s, norm=%s, n=%s", algorithm, norm.factor, n)) # Get some data lab <- rbinom(n, 1, 0.5) d <- round(rnorm(n) * norm.factor) # How many thresholds do we have? nthr <- length(unique(d)) if (nthr > 1000 && algorithm == 3) { # Algorithm 3 is out here anyway, no need to waste time to test it return(c(n=n, norm.factor=norm.factor, nthr=nthr, algorithm=algorithm, rep(NA, 3))) } # Repeat 5 times and take the median time time <- apply(replicate(5, system.time(roc(lab, d, algorithm=algorithm, levels = c(0, 1), direction = "<"))), 1, median) return(c(n=n, norm.factor=norm.factor, nthr=nthr, algorithm=algorithm, time[1:3])) }))) }) # Physical cores, not logical !!! #}, .maxCores = 3) # Physical cores, not logical !!! times.df = bind_rows(times) }) times.by.alg.df <- bind_rows(times.by.alg) times.by.alg.df$algorithm <- as.factor(times.by.alg.df$algorithm) # Plot the data library(ggplot2) ggplot(times.by.alg.df) + geom_point(aes(n, user.self, color=algorithm)) + scale_x_log10() + scale_y_log10() ggplot(times.by.alg.df) + geom_point(aes(n, user.self, color=nthr)) + facet_grid(algorithm ~ .) + scale_x_log10() + scale_y_log10() ggplot(times.by.alg.df) + geom_point(aes(n, user.self, color=log(nthr))) + facet_grid(algorithm ~ .) + scale_x_log10() + scale_y_log10() ggplot(times.by.alg.df) + geom_point(aes(nthr, user.self, color=n)) + facet_grid(algorithm ~ .) + scale_x_log10() + scale_y_log10() ggplot(times.by.alg.df) + geom_point(aes(nthr, n, color=user.self)) + facet_grid(algorithm ~ .) # Algorithm 3 is linear with nthr * n? ggplot(times.by.alg.df) + geom_point(aes(nthr * n, user.self)) + facet_grid(algorithm ~ .) plot(nthr * n ~ user.self, na.omit(times.by.alg.df %>% filter(algorithm==3))) # Test algorithm 2 times.by.alg.df2 <- times.by.alg.df %>% filter(algorithm == 2, n > 200) lm.2 <- lm(user.self ~ n * nthr, times.by.alg.df2) # nthr gives low, barely significant but negative estimates which don't make sense, so remove it... lm.2 <- lm(user.self ~ n + 0, times.by.alg.df2) summary(lm.2) plot(lm.2) times.by.alg.df2$predicted.user.self <- predict(lm.2, times.by.alg.df2) plot(times.by.alg.df2$user.self, times.by.alg.df2$predicted.user.self) plot(times.by.alg.df2$n, times.by.alg.df2$user.self) grid <- expand.grid(n=ns, nthr=ns) grid$prod = grid$n * grid$nthr grid <- grid[order(grid$n),] lines(grid$n, predict(lm.2, grid)) # Test algorithm 3 times.by.alg.df3 <- times.by.alg.df %>% filter(algorithm == 3, n > 200) %>% mutate(prod = nthr * n) lm.3 <- lm(user.self ~ n:nthr + 0, times.by.alg.df3) summary(lm.3) plot(lm.3) times.by.alg.df3$predicted.user.self <- predict(lm.3, times.by.alg.df3) plot(times.by.alg.df3$user.self, times.by.alg.df3$predicted.user.self) plot(times.by.alg.df3$n * times.by.alg.df3$nthr, times.by.alg.df3$user.self) grid <- expand.grid(n=ns, nthr=ns) grid$prod = grid$n * grid$nthr grid <- grid[order(grid$prod),] lines(grid$prod, predict(lm.3, grid)) # Predict time on initial data times.by.alg.df$user.self.predicted.2 <- predict(lm.2, times.by.alg.df) times.by.alg.df$user.self.predicted.3 <- predict(lm.3, times.by.alg.df) times.by.alg.df$predicted.best <- ifelse(times.by.alg.df$user.self.predicted.3 < times.by.alg.df$user.self.predicted.2, 3, 2) ggplot(times.by.alg.df) + geom_point(aes(user.self.predicted.2, user.self.predicted.3, color=n))+ scale_x_log10() + scale_y_log10() ggplot(times.by.alg.df) + geom_point(aes(user.self.predicted.2, user.self.predicted.3, color=predicted.best))+ scale_x_log10() + scale_y_log10() ggplot(times.by.alg.df) + geom_point(aes(n, nthr, color=predicted.best))+ scale_x_log10() + scale_y_log10() ### Final formula: # Algorithm 2: user.self = 2.959e-07 * n # Algorithm 3: user.self = 5.378e-09 * n * nthr # Reduction: # 2.959e-07 * n = 5.378e-09 * n * nthr # 2.959e-07 / 5.378e-09 = nthr # 55 = nthrpROC/inst/extra/bench/0000755000176200001440000000000013607143106014235 5ustar liggesuserspROC/inst/extra/bench/fig-unnamed-chunk-5-1.png0000644000176200001440000010663113607143106020552 0ustar liggesusersPNG  IHDRHc pHYsod IDATxw\SlH[pbQnqB`¶Vցj{m{:VmN\npZ*V6ǹ7T IN_|$y'!9ߜ`E!`~P;CP;CP;do_~$ɐɓ't碢yiӆ;99u}*nOGqƍe04t{ݭ={>|Ky3>F֭omX,˭1|,YѺyLAZ;@s̟~ɓ::p &:t(**jcƌ1{xGGGWWgϞYQ}hÖ3g_>==}x''ӧOwU7Ι3>HMM[RiBBױc_VXѫWɓ'ݼœ,(@,-- c.ס'OWUU8p#M6#G-֭+))駟!|rTzС-+Voɩ_~ЩSp0~n 6DDDD޽{_p&Gumƌ7n2dX,nѢźu sή]}^xgϞ/iAݾ}{Сnnn=d4Ʊcz- -Z$ oz*}kHH{9cƌ~-**J,GGGggg߻wb800c ׯo׮@ puu߿k &%%mڴsٲe/=ﻺS.z^Sm?>ð /۷oG={͛7#9BQZfov=B-[|nZ6++K"zSee%B(444 oYtźz*}-Z|dž!I299;vӋ/FEGGY?r...111>***w}yfQQB'Oo]~=B(&&fÆ $ID4\xfwy͚5_}'Oc ]xQP,\0O>xxxxHH=fJ%BfO>y'RPPpS>|᱃ŸqFaa3Ogԩk֬Q(l6mwNO{xx8;;oBuQ nnn=z qȑX\\2m۶^MMСCWn>O3<^Rݺu_~ڵkB~~~=͍ WWW hcnp6<<\AoO>EmVJ_i:jٲ&.[Ϣ_DB||`x[T1ckK_poD|K}[9::fee]v-##wyoCV}^>Wcܹ}}}ۯ_7{'5E{bճ~d.۪U+ 233|NsNxx8B޿{=%%!(BgHhNoQ/AUKU~^"ׂwbVnxz|}͛2l0;ŋW޸q'|ҳgunXƪUFo߾3g,\>[~=~hlf>wѿ[nJ!rgÓ6mT\\heСKwʺp_r]ٿyyyѳ:''*z>{T*FiѢB"TZC^D 엾=ԉoQBK%K̝;W"l޼yfΜl2''Yft,W6''SNV믿>|ئMy}?4O@3\ <پa ?qDj*g̘Aq^ӹv튋W\.֭[۷/[b~y s7lؠo3랈[n6nܨ?]VVֳg;vѥKXlcϞ=_~}=~XvM!/۶mkȲ5 ӧN=4_`_Eou!o߾?0""bРAᵵ7nܸzjnvޭ/ [n0aBNڶmۊÇ?<999""uK ѣǴit:ݦMH/ziӦ3gҥKgϞoٿ9s!C >۶mk׮]c_gg>l…JrРAǏ 0|=O$99yݺu8q"Bhƍl6;))h X_Ξ=;..nذa999k֬=z4\ZnK$77'N\t ~EZSN>쳄 [ϫѽ{wO>ٳgb߹sرc# ?$)JnګW>+""°tܹzB022rݺuZn8N``СC/] /^ܲeKwz]]]===㋋'LgwѱgϞO^zE^}4Gnڴ)<<9666''u>nݺ5`QFj4޽{BBB/^,J_@WWO?T߉ǁEѻ =[TTA^v[ne˖3f̨ZvmDDıc\(JKKC͟?jܾ}{Ȑ!nnn<e˖_~\.o`sN׮]\ƍ0 5'Νܹ>>>vzw Ao^4_-֬YӦMܤ;wdggudh$I?~&22R n+Tw3LxzzZ; !E!(!(!(!(oJrqq)//׷h4s|Jڭ\syd@/B۷o ?t!b݋2\~ܹPYY}̙>>>G=uTPP߬Z5Wי8qaR'--ͼo۶>w\ttthhF1WEEE>,W['IAAA!!!Wo+Vjӳ'Od%%%mr͕)S Ç?~n֭ڵkoֿN [~=}wyٳgfohԩfjsawO>h4K.rrܔp5Ћ/YRaXZZZcۭ\s(O>{x7}]///[gg瘘''aÆ=|h ޽{!Djsc>}:88XP4|)`;|BBBpp0A&MR(VVzܹsyaa!,vrr*((hl{ck<7nܸzÇ{ݥK]vq岲 sATگ_jsOݻbϡCy=j̙pޠ:̯uV jwNQa/5ǀn+j5[ɓ'O 8B(""cƌ1Kڵkwqrrnjؿ~vΝA7[vXlvuT*kjjBW(6Z5WH\I>>>iXgϞ=ڸqBhѢE?cZZZc |=i֭2eJcc]3q}۶m| +Wѱcƶ76k<YYYlYYY\\ܽ{?/yyyZ2WZqnh4r\k׮ݿ{XS Iʕ+tYYBɓ'tY|IXXXFF۷;t0a„7k߶mۆ ,\s9rdxx/]4xర0Z]UU=hРӧO_|y۷WT꟢g޺uk̘1f쟢su]#yx٦tjaPճfgY7;vr͕G*N:W$_;w 0@(zyy?ȼd)S9;;1ѣGퟢ֭[/Yu]#`EYi@'Nܾ}SA1x?FFFZ;k_R1%*˭0WWWi` CP;dWIҤCۇ8IY;q8cf_bm`䕉8ΠUb kp8<~lNgDM ňO AױǙ0 CLbX(|F訌x 3l#pr9#XaIv1\0ALpj5#2$;woWg<xAx5Ij'O6<&33s鉉6mҟfb#!.]v>55uѢEEEE\rٳgoٲĉ7`֎gr>>>FJNNַddd"bccSRRFab#ݳJ̤B)ߔ3hEfݰX,kivbJZ 8@7X4Y;Esa߾}{<<?)))99YVĘ)NCsycԺF.]ڮ;6әbDJF{cflgHXP(vqvvV*p"IR,3e=`qz8oC`Vˋv]Qo 4v <3PXY']^R}|S]|4Y.a'_W݁@`6_ɑtNzovh(@CQ K>+,$vs>M{Bu :o,p }EfPA`ƈB83%*B Fq$IFD?l6YBsVg2ڿ+. :D"8Ţǁf.U7J1 cĥv/4S^UĨAQi z xa(O5Cjm?#J3}?dVڬU7R,P* qfJT>jdJT>T*qꫬ 5ҏ dgGNN(8t?vTT.(,.otϸ|^J94b @xݝRdCٳ <y~_pM*_:/-մ v4hlj\P3/c&j= x uV:)ЉB>{9uD*{4%Y;xx raaI׍aCc)NEPE%[+9V9;|Nq*s}1==lذ)S 233lR[[5ydz07Jü=K(xG@},4}QQݻ:tСI&!rʕ+gϞe˖'N4w ԐvrϜyz(CcɸD/,,D͚5$,,lԩeee<<<B oӉ3f0=X,6r֎...֎P x/Jq6V$ITj rS4@ h4JA!WTbdh4f_h)jYA񚢒k=x~>yOP7Ojrxig0% WBBB=z!reeejqg 7PV3" $KX;Hp8DZiI0)Q|կ@A}UM+дhih,ߧOӧ#ڵk7sLOJJJNNV702 ǎG<=wJKRX;x!m3}H$dĮ9@P(^ /^X;HjkhgggRɈHd2A#IR,3e=`ƣ _T/,{ϛNC\.~ ҂HvЬi)_%ߕ s9B({EPf͗TWxvBۻ4!a֎L\zl$O=w( IDAT{~s <4Gd , ;֣{ܳ'A#).c#ίU3x_HcTwPD1)u@fBheIʒ8z}$W=XрABM/LvZ kGf|Rw\E1! .c%'J ;_ 5(.J  <عU53 C9]~^!SɬT]}"#}JݪB]ŠCFuv4}tNVpsnC*<~/р%@;T֌ϕ-gϞ͞=ɓl6[j?[8pC@p__KQ|~uC"zR@~֬Y=zxcX,رcǎ{ʕ& ZGyy%!"?W=Di\EoX+++;fн{ !K\bL3wVo;^Z, i?nݺi̙Zxqv?nh t K:^) @dhٌ}$ںukPP]BM?PU率j|d&] 0]tٳB-k``*Ucs%Z?WϱRwPp#^4/ aFqpphH`.&I\⤷GDD1x}GkġC~lVVٳn߉;'tLFBueX!h۷orJd{%s 8jc>Z;7w_pƍDڵ L23/4 ItyMP"fX;Cu݉$۷ooܹVHԚ]ï'GEo0kG[o0 اIyN~˵xi|H]ko8\S쨨\XX@Z݉:okv׻{.BCQ  knqqBu`$k!C4q*`JüROeq_RRHffΜr׮]+[WWUVY&03zhv2Noq_Rub;P݁ق?;֧OgϺ> eu~s$T>4NӦs<:!qeP~.^Kj'Odӧ'&&nڴI6lU#OȈmV>f"Tw`yF |׮]:>|XT^~ .&55uѢEEEE\rٳgoٲĉj[H(tGZOokG͑]ׯ3f\\\R_|5*99YߒF2bĈ7ҝTVVݻw~}<>ψ_$IS8h B$Sbfq&\y q`0 C zeh<~VYϧЅӨ}G,.ՄIdXj$IbƔ}0R[lAQagϞpႣc^z <ÏwYY=QVV֨FVH$tuu͔amZ;E`Ɣ̊qks eܽyJՁ lQ0 klTka{n)*ꫯٱcڴiӥK.koJ!;wg k`X"B3_ jkhgggR)J8$l)86$IXܨ <1Gcn{~UU*b5PUUFE|JňUr\]]͒90so޼y7o޽;=xE`z5lU#sX}`JDMh+kX߷oիLBώ3f7};w~D"(*55F.$IQ;ub'鄏^֎BFwk4`???Ba|~RRRrrZiT#XQNq^ynK}㪺}'ŀ1V||T*ݻwH$B֎;Ç[*a#|ee%#h1/A|S`19*\IJe4SeVعȸc&Gi ۶m[$ϟ?op`knrYvUH VS-KЄY;/3R=<BtPC'@sG[_.}Wou7Ɓ-x@*ջ9np '2R޽R 5Y*z}MP˯[v-- )QQQR$I"l S(YJ~euVw(퀡߽{Ƕm?~]vݼy{~j`vkjcq,UGW%k-p*ҥK7noӳ"h̙/_޼y3 DBK˿).(J=n\?m4TwhF _Ν;!X\QQф HuO$E'jf|Y?sB-{4[JX,hަ)=z|7{qpp@d_]vE޽m۶`iwq~,0FD8Π qd=W>V6yɺrA/ #e;/QA7q~~~~JKK;vaXffH$:w_5f̘G^zBaqgJl$Z-ST*AlJvp8Ztz+յc?ec؁SQ߿Jtp$It:D5z%Os`#4͑#Gju۶mGf)L*++3,K$1eל@ P(Z&`W /^  N JR*Z;q$IlLf ;**D]DGe!#ԭ۽t7f*)Q\v]]z? e| \]]===5'Byxx4}60_XEg R#V>f| 왑_ZZ:dȐ̀ǟ?ޱcǓ'OY&B}?L//霜#ߣ0sF~?k,6ǏgggX$˄Sd) _`hXA>##pѱK.ܹsS'QQ$u*ZU[X0>v[oU<;PQ\IQJegrW'㿒O*[^v7fψHI̓dɕ|<Dzp޾xibXu{kG.p%[:UZۿƠ@N`eu(=vP'GK֎M`-EE|Dor.+Cq8N`GW%3]N2PwP c` <1(Us%/ރYn"?G=X9wiĉ7nl@P5A9:  ѪEۣPFx@}v ***"|lN[<e]?!F6CMp`~ĉ'NDM2q$):PY+OwݿOtСC&M+W={-[O8a6nGE٬!: ov8UPh#[𥥥3g 4ðb\TT8pg}J8;::3###,,,44!2b&JIO{yy BS"$Iψ8bp&q X,4Z;EC1%-AA40>/(|x7'Q~7w2e=@"vF |˖-ŪvqppvD*J.[;qBnw励jtA~5OϧiCTqiG 555&ULYelNNNf)ÇɣGBiii 0}Emذpɒ%]^^^ >G"\\\ܹCߡU A>>>YÍ7@tPŔ:(FDE1(*bNZ ÌF=Z]3#(E@۷ ZK=MzsB2ez!ĈvܹZ~wz[nEFF[n=|8xǯ^zȑe˖3gδk!Թs͛7K$ooTzg>nP/-,Q𣯷PH!sCTjh.qqqiL0 0L ݻw{=~xȑP(ܵkW>}Oj׮̙3B|>?)))99YVĘhtNVpsݕڃT ` ;6k֬M6ð˗/O:uʕp&gX"B`.@fM]b|JbJT.kGiAjɒ%W4hak֬Yteu|Ӝjh_Ё./e%vZ{b$gϞ8996e$QQ$JkmC(.c قkjjگK8# (jhnA{NA~n=%Uᣠ`.F>K}>}~-nl{Sվ+%S|1YIky򡱚6N]1>ݓ'Ov}} {=>op{rG+iu} DY Rk}{c|oABǃ8(1YN0}4ߏEϞr":! _ lV%I?ܹ4cprrjw3Zgaħ:: c_}eMgϞB999N_F.\8I&nyUX"t:A=`6"h…;vv2OQҥK\2R zsV3+?o\NaX#""|~PPкuұczzzz{{7!Rðwҳ>0*22ʕ+~!CbUq^[hq{F [otثҁOsu*H^TwDTS[`5yyyF0`@zz<{aÆ=}4%%e޽O<:th#nݺգGUV:uJXo .LNN~X IDATرcǏo*o.?>>ul6[nW|/CH_֖8N$}<8a&u,qDE6$E? ,wQ80 Cbz EE&Çjzڴi-ZpwwOOO}vvvBh/_~bz7B&MZlD" 1S/#NsʕjuS1a?X2d"p'l%5c11( Utr%{*wsYCb~?C:~,&p`ە),yFEEEFFk...n</---00!Y~%ut{Sff!wtX,ǔ+7T*q poPfkZJ[$J*z'j %KVmۣj5u"I+JFpg*hnܸqʕ={,[lܹ;v/jx7yary=7M)t҃4M6mY Yns%8u0zu?Kھ,bWnO{AQTll-[O3Dy6m^z,UV 魩)𥥥C q;v:~@ pssKNN^|yQQц 8JXL7 ?S#of͚f>}ldpۧ˦:e-DE>̔X,HTYYɈZ@P0@ `][6N(VWW[;E8;;+JTj /4ڏ He]f OGQ||3}7$lL&b"IR,3e=r s܊ quu5K.:C~{9Z/ރB=Eq@fd@tt cH$ /<hHcsH K t:ιS:F 3R׭[hCCC ڵk-`(+-rؘJ;c`wssyfzz)jժU߾}gr4[2nz~n.«*yŪq 0kRꫜ;v  tرo h~$jubnrgX !uv@3~޼y7o֏՗xE5}0m!S ;=X,Twlo߾իWO23fի6dGE!x\DQWiCe'PSGOaggƱZɓ 9}M6]g#4xnAb@?wĴZ#KT"#ޡH_ *#o߾_}UUU=[[[_{cE[rʕ+gϞe˖'N`Zm/xd&$ޕUFFp-Iv6l8po۶mIrww?Y3jԨd}KFFFXXXhh(B(666%%eĈu6%w9RAKKxjY8_&Z*r\[QF ۷On4gΜ&JӹsGI$RSS0g*Z~K<\q aj?0-K.={VZWWE5Q>Vu6Btr~Ǐ!^ ylEKk4/^ڣh̻/ݧF쨨\XXҙJp ^L?V]]8EQ|>С[lOݶmۏ?xѣGϟ?_Ee˖[;9gΜ`f7HA 47Rq-DQQK%K6KͲ]~7 .J"638E|1 gf^s{9|վ}˗O2k+rjŋĴeIG -*&Tw-⢜6;h#/կLׯ_Wݻ.]ڶmBh6mڼysYYΝ;:,_~;v쨬ܶm;s̙־=z{{ ww &lذє h&IBygOC;kcKh#Z{gVWW;vo߾2~~~>޽֭;tp̙7޸q#((!˜C.]ʒH$Lhg<)T/"0${[׳vHR@kׯ_߲e˛oyȑ dgggdd|C a;C$M:ѣJsLug$&&>C_pǧo߾wG)j J:@Bj`8Ņ /; 9zjɒo6ݦ qSY8***<<![o}:$IPdd$á(JR[FZl?}}GO3q~˖-/ҍ7j̙3 Ï?|r_`FT67xsALuee+UAumB@ |׺YbTPH'+**\P(Jד._ܮ]/..)++EE3bbZvm\\Ν;%IJJJJJŋ׭[W؝H/(>}}oO<' - U(w;G&Px9f:Oܐ ۻaS=z :433s˖-+//b~钒6oܣG7o3_Ң[܃///6lBرc#G0,$$Up3>so]SM Y"̙3N(O?4ͭk׮1117o4999qqqaaa111ڵ={ĉ(rʗ_~9ֆ1Q;uꔔ㔔fӧSDrdM~h BQ wS|6]m5j~~~wo]&44[&$$̞==...22r26m0a”)SRkzgh1՟iiii'N}xƍ?׿{}%0D"fEcgHhXы^$$YUUe -"rSVmVT(."6_ 0Ѿ?Q I!Jٲ lE/ |~eec|t&5yi\S޽ԩS} -9dgg!yȑÇ$\Z~tOU w:?oBB! ^U =hhR}ݻ3_ |͛7BA3O j[M;B=S_.uXдiӦMfkϛ7oҥ7nlzjpEyI!Ԑ^?ϯsxSn Shľ Vd˓H$k֬eETUc{?s%^QChg  h_v 5;fW^J0הU|]^'gN#woAZڎ |޽Xc69s!T(J͂ zB.jW){9軛8yFnw@xV\t/KK+PԯA]D̝xU LRMJ0k@amd: <3fpʼ_w LOfwp+VʆslOɽ}_=UZ GL%-zzy,ęs;N^wXr`YxSэ@`V3mfc |>EQbAc3\i ڗ L%aYԠA8NX=.˖3LTV|S513s`0;A,p34$>+7c U&L1uAF8aX}Ȋ-ÖmynsxN?H {)b6EQ4Mb"qD)3S읢 +RŢMb_Yj|IRR|O=aBWg^_~+2„؇|>=!!n?Я_?DңGk?wW,GDD&LuVT"""Zɍn^^K{*g =hp~~~>޽֭;tp̙7޸q#((!EEE5T `{zz.Yo `1jB]v3ggggdd|C a;C$M:ѣJsLug$&&6T `1"---&&UO *EzrϷ==f+U?U4C5r5$B炚Y!p(RTo֨Q-[`Ϸo> Oe2p}& |]V U44Bv61M@=/k%]n[\r%<<!tƍQF͜9]v +..)++EEŋ}>}!L9xlJNaINRo.{fzv~(x=z:thff-[V^^J%%%m޼G7o,**_~%--)O?% |VVVVV[ki?ʵeyA]ū*YYS877Yf_׮]sss,YƜ={ĉwѩSk׮}嗍gUn2=z0֖ю|xMY|OOUw"O;pV0yMK.{KBCC<ںukBBٳ"##,iӦ &L2E*kWmZk~VCmڴiܹ 4U/c2̜s\DR]]B"HѰH$"IAZD,妇X*וW7 yFc 4]*J}A$R4 R)[BPӱ%*ϯ4y<=͝h4Qo B 7s2]@<*tw^3raZ2^\}i(B& <rF%|_HQY9O !TBVxL֒ -\ |aaA9jTۥ`&/=il^G\V9r9s޽޽;gΜ#GZ-lOUMTΣlnWP6Z-HwGjRTw3h|… 7o~嗃CCChɹ{n^^ޢE %GcŮ}N8%E$ѨN4uKHh$t%K8pѣ{-))A3f In/Uxc$O/u[ J"}BaabYrxso$Ǐ?fipV2k]E[|}ھ`:p*=Cx7͈1y @Spo#Ya#S( K4g{#xL?Z3jkw'8(XH}VZ!.¯b* @ZkU ~oz=ݡ3S]jGF\+'NسgJر}||BnNN@ttܹsj)jeIOՑB!M1WW+eڡ#u>$.gϞ}Abb{،?[nصk_zjPIIݻ|>bEf]V.(.x7[xp(<Ք;g8?:'''** ď??8|ppp5Ҕ 6!4bĈe˖!J%㮮\ST]]vZAjΫ3_Ba8 8[6/xjZ]Ph: ,DQat &L m9 HdW^qp^0 CD"4 \.[bƖs0Q k.Odɒ}Y#MϞ={2 kBE͟?חYZ[:qVTM/bZ݊wzsrs5w>?\N/22c0 cŊegʖEabXX|>}p\^:sLllS5?S~OǏϝ;7n8Ǔ333׭[aXizKy0v~ qC30]5tV8Ŷ&%F`pqVgl+V3wM<|w̘1VzuAF8K[)wfsFv8RђW^yeʕ̏/R+WZח(RFF/5ͱc""".x9lU_xgOVM`&ׯ_m0ݫ&La+w^NN΄ b]`PDD… \VvAMfs_/ag9F;Q3l9xƥK$IDDDhh b=8q<$$pDz;JddK;^;!fD4M4Dߺu%K|= i%B0ҵɡxLUUjFeHcZ9 IDATjݺumdr=Uf0$UԎnq#lBܻ?;⪞f؏dD1r!1H:F^l57ler#FHKKM`|I'ES?7jM;{|AXXXDD?6BN/M^~aћ}fKYx?\׌0s 1( sJ[Y=EU??"/]8c RB c@sL,77_ c:V-QѸMffTJ88cL=z?%?UVG Cڇ])x,HMFQ=1`cL ͝;9AY3vY~Xo".Fy|4&QbR@hUԩwZm\`04SZ?LҎhE虨:®^<ko߾{M}noH̯ugaMӬʄtzR^2GԕCF%2o%Rմٔrh+Q_Ĵ[Ҳ(*bi4Y͛tҍ76a𲴺EYZO</;~{!fx4ͅc,d˓H$k֬e@d+܃ϵ!0rū*CGzMH0_IѣG7zĉVNUdku>T6E*9!du'ځuנإ=M6!>ܨSNY;L̓-$Hh;N^0t=C'G4Y 6X77SP|^.T&L^#}^\}i(hQ`& ٳgB ؈q\㻂F~LўBIӌCuW\M,`H,,=+vFjJCQ䅳3T uZԂoLxX*UxЏM^S~U}#rP+b.|=ZMS/HMŒFuT =\n`UPSI׾_XG&R9[3n%iC LxFSXXXCB`p,5FR+ lcZ-H= =5Fw,{Θ1CԿS(*Je2ꫯ?/Vyw}W[[ۯ_9sp`C )VXn6Lw6NY)?e/;[="ؖDK.ZaÆŋwޫQwJ_o{7pJ׮]_!|||>>>2Wr/dnϜ9w1?@yeմf..\MQoxR)v=BDgaZҲrty33`pSY6U$IS iN̢XL_}ҤI]t1|_B|}I6ǫ0U\X,6~DS^PWWWBaVjU* I-Q%IMM`wӄBNcKTWUUexxxX$O[`GEE!Ν;~[qL&bG3u_pX_4&EizKy0{CPW>Es!XZ @>k+Ҳʖ,Xqu& - ySz>|eiu ;no]Lgb:  ׯYsƍ 8VV0Of0ߧ]$;{R׽jt6|qOOϘ.]w^mVNAyjtӻqJ){1F3v>UC2qiҳgϳg"z)$m>0QV+(`O˫;u?|jvo߾_|Enn /oi .@+x`=eCwJu ҶNOK9\=m%ujNpp&oݺ5>>>)))11CT\6@[*WWTAV8+dԽXufTk%0Q;ut51 ;~xzz+ +b.|=Zsw"VOm"XS}o޽{: :f3'ePլ$IGV7yz,oϦk?_>OwMyǂ7a B4fD8f/D"i ܃7oҥK":=" F#+?l 8N:5Fʢe.[۷-G5}%E!# /D!K|hfEgoME"-q-Q,ʢ?.d˓H$k֬e3Yk``GΊ?lLPyDת+(jtw) yS2 DIQc~m[48["l\.r\V|Fĉ~ɓm8brDz^Ǣe%xm0 nVXy#Gx<$ e˖O>6]o!yd+kr+i `ɔL\#=yĚ3!LN%пS3l4F&### BX[[_= 8rr5c'jF-db~widTKQ9EM-P7$"C=9[.#8?ӭj|888&BHT8bzm3|0-*2.ӥbEzay E-E݄DoIn<Bc .+[ĽT{mkaFgxw ӘVlbETv)Z7cˊuMN63fX,޵k2l`߾}6>ݽ,,,l֏1c0gΜ;,UX/[^qFcX?$/I^)`14|W$X92QbSC̙3J?~|ܹq8n:W݃'EP@ jl&O;,W쯖_Vp -JondאKQ رH$2sZBzirḺֲ;d|$[x$R"yhDo`0X3RC~~~'Or1cƤvҥGLf 1F#+),RhrEFðA.ŮbΟ Z(j~)"7wp?"Քƀ@d׭&blrftLl%*МLW^yeʕcffŋcbbo)))V"Iرc|6j: pXcxc11hM;3Qׯ_m0ݫ&Laۄc <8?? FWym pF|Hh0Joǹ>/i Ap}XC.]ʒH$IVð3f̘1ƯiZR#O-5 ..c%.CD"U -3qS !Z5^GQT/"(b~թS:ǤSʣ ABf0sba."h~wG3v"%!3`yΝ;7ǤӵԚC HqqzUu*!AySY0s XU> qqq#GlVc4Vȕ %E)R:7:$51q|qhK.%'''''3fĉG}V1*[Ij8>Ahl&jxz_eEw &Kݺmu [?~B^y6G@NwxlD q ئɄ(-Q9V5y%L4AݸqO<=zĉmkwUUU< WWW\Ί@=`8&MQTi+OJ:X\k׮UUK?qsqqwH$:-nHdKTXP(Xu$IԘ0m&nݺ5dȐ7xc^^^ F{F{e%i"'qYP"7Ajggg3u=33sذaϏq8Dv"GxWĮGkxrܤ]\θ7i4^;uaXW^ڿfϞmt!Fw4#ڤj#^  yO!i)L&^v}~4x`kaӸ={:t`0MwAvuMd%z& ٓH޼J? F}>i?cD$Iy ;kAvV@3߃qnޝ;w9qFWW͛7ݻw֬Ye-uu}`tp^vu+q"o&47;<}ú{gPGۑT*MLL(k2 4tPs^qP(} E'˪TW00000ɓ[nݲeKݯFcaa!s[.`mY5UFdMM*Ra4xӽ='zz$v5a |Y u]~ {\pu+&ŬX{h ؒ]QB8cx)(*[>Nn쮪6 -jt6k*k*tu*ۚ&v9) gA~zlY9xksVm{'N bРAnnnG;&:1EmRN|Oq͛>L&/^Hv}4hX&I_gΜ w)O(GʓJ <'I%!dSͼ;{iu/LdXP 3| út2o<{'j|\Qg^cŮvj,`< afb˥qu#4{DMd[qNi19UFo{' ,(𶄝ʨ dȦkkLsŮbi"r<{孎jxeD (fbCNcEw<ܢ%.l4ikFi y ߤ72Bn7Gtjf1FWbApueu!u 8FR=}#M_U&WT&ɪJzw3J*t.Mu&u3эaQѐ@hLxgfAP[/wm6 9Tc'}M9uzޜcF``:p8E5:qeB>Б({a[61{hÉYl0R.%m;*4Alۃ߃E.g<4htc JэCׯ"i O/ mk0H~Z(w&8ka]tQ(pPY /ϥBTc`< ^)#ϝ޿u#Xw$/ҌCo;`{PY/7$O:%px 8i0H@Aw\l^Qh5(/*>)xbo=hDX c++s,C3vN; L&ϟ&o^E"h$ߟ/C|Qo MݠEq܄A, preaڡ#(pP/*>)xB_A, MUtnvXxjyEZ A $OzAl 5 yvZ8yYCv ().>LSM}خhs[RA0HAwED!#t="a<;o.̠^L^@Q߻dzw(mx34q6̉?L\ @ 3N唗 Ayy;7()):ϣTSg;Vj{w$aC2q84 ?h?\>ZU$#놿`' {+Y1\ߵ; "PQ NbA |8e0HKA;@uz?^ IDATRP'pBP')U qB(XWZ5gΜݻرcΝ/[q,_Ǐܸqŋoy9|@@@\\ézƍ9Ύ;/dɒ׮] %Irܸq!Tr+!d06mo,VJ%㮮\.6+۞zp8gϞ={ދCqRus8%'O]v۷o˗vpLr޽+d]***,,̪jqq1BhѢESN]re=+-[,>>~ŊmT5ݻw=Y)yVQQOsqqifa Ø4M׿pС=z矷o߾h"e3Wٳg Ett'OE\\.wԨQƍq<99y˖-֭vfV0s*ʇ._<(((%%嫯Z~3E6%%%me/J_|Ef`@oڴ !TPP|4ׯ_qQ2!t  6zk83Woܸ`4U*UBB¿o8fZ|={F+>|p;w>tT*ۥ3f(**2 ;vؼys%n+ʄ֮]~Ϝ9[o)J~8 :?3g ;, Փ'O.ZFVٳO?q4\Z?b [Gcy󪫫m޹=xoo9sZSN` k׮ݺu3f Bh9990K.m\Qf/X!pBEwlfX779slٲE.w Vl8;VrQ@pBP'pBP'pBP'[tzdFðk׮7Ν\P__~BӦMjIII)))4M -66?{1HU]]"IcǎǏXUMbvBoƪU ;tP+WL4N>}ƍ@{ٳeee׮]sqqA)_c߿z뭠Ȏ;z{{:t(77*4MO}zƍ ضm[NN΋/wu%33Y_~1bDzz۷3337l0vاuxxxeeeff&L&wcNN%`S{ipСCuꫯ?>##W_}í[޾};55ݻ/رc^?wuuU*ɹg}P( 0a´iϞ=;}0ٽ{X  Ν;ܖd 772cn իWi.--2eO|||YYÇ_~eXK/]v L9ׯ_{=NG'Oƍ\&Vi^rĉx ` M@邂?nrϏ?133o߾Oŷݻwرɓ6~]3CI .kG<7o\ZZ`ӧ۾#> xfPw}ڵk2䒾)))?sHHСCCCC׭[g ddd5/ xfppB8!(8!(8!(8J۫0IENDB`pROC/inst/extra/bench/fig-unnamed-chunk-9-1.png0000644000176200001440000013102513607143106020551 0ustar liggesusersPNG  IHDRHc pHYsod IDATxi\33l$a' ("T}WDEպZ-mݯko{Q{Vm֪[Aʒ}4" I!s29dy29( L C; C; Clق=bϘ1d…:uν{^vZ~?883 P]]ao֭oг}=zGiH+fyW-|PI˗/g 1,]T(2VM̘1#$$~,ɮ\qK.]vǏOHHP(tٳǴ4oooCmgΜa&O\RRo߾۷O0Ճ nnn?+LIII6.={ڵkϜ93l0PiiibbѣG{emϟ6mZzz:]"ɒ:dѰbŊ~͘1cȐ!|HHe^hUUUeee:tk[}C|Cz?޳gqvG{~aFFƁ5k֔㏆˗/dkEXK.΃ Ou!99xga6P3uwؿSN?eYf]|yȑNNN۷_f[nիO>ݷo:4 nܸx}S&8tPE"QPPŋr.\ 6~a߾}g͚oEGG;99 <8'''++kȐ!NNNu֮]6dȐ/G8o޼ 6xzz.[vss۷BxFFyyyrrr`` ܹw}gx-J1 x(yfPhlZo "lǎ{n:.33ŧB:t/>S///$/\@о}w}%,+%%~=vXqdd믿N?^d BhVz\k\\܋߿\"H}PZZڵkBqqq֭2e rttOӧlvTTԪU>s///6%͛7c6bĈu},kԩz{{/_|۶m={Dedd'444)))77뾾gΜ)**JHHq6l@%&&~~a@@H$4wBwIMM5 7"JO?!tAz?D޽8p`tt;wAu>y^/QPP4MXX&&x>@@?nN&!CFx}:;;T*-Za]xlgggJ:w\EEŜ9s {~-{#EEE7nHNNf=zqACa\|x֬Yj*RIovԩwcXbx !@?vwwGxp+āN蓒.J͛7}^}vDDBfgg׻A<<|Tz .l߾ݐ<==7m4ynݺvܹr)))ݻwo}yz X,?O}nذa;{ W ?_|1rѣGggg=...ET*o޼H7|#o$%%eС111SNE_fϛ7dNNN}ܹsǎ;jԨUV?n`h-aaa|IaaÇϞ=w}׾}_w}IIIM ѻwoX<~ߺuĉΑX,L&۴iS~69={ƅeee ,ׯH$ѣǚ5kt:݋fffN2Ϗƞ={R)}%K:vH޽{װCuu[o陘XRR2y;v6tLPO5}0ܾ}W^\.w =v/Tzĉ(ý>>>۶m7nhE_.Zϯ}Vԩӓ'O͛w휜,b!,,,77_v_R%%%>>>LA4v<` v<` v<` v<` V]]]+** %Zv>>>JjY9SmxiM!y=zD!Cܻw߷oz)bvLP8q")) !T^^n(={9Ү]I&V< :uQѺয়~:q;tj[~DndNNNɨ[gX.]JLLl׮]pp͵b ___PSS#vMo3u֊3gDѣG?x.Yz۲z}HHڵk}]T?,Xl'''zf;;;5oZ\|… ߿Ϟ=mFĹs+++q߱c޽{e2٠AjjjZ}v'''Xo߾VHt:SRR8N Ʊ|hZ\9EQ)Uq[+lFC{*yȑ# pGu;55u„ RVx۷ &ܼyYas֭A$&&6ZvlvURjkkB!BHVUUDf3u֊ťA>>>NNNUBׯB-^hno$~ښ5kfΜܰza}lܹ3?uyy "##[ܰ[븭Oeeeff&Y^^>vجԈCJUhh(UUUtVU(7/^V. uyqyy9BÇT> $$7nڵɓ[V?[mx^{'O={vĈ!!!{G=w܈#tV[~w~WN0ۻ(jk* vy<^NN94͜9s}](2$22mxd2Yrrc||<߾}{С"kҤIu3gsqq3f[~–.]PU`0j;hԩ7of:u<^?ؐz|=z`:u<^?gLEE+Q@4v<` v<`d.zNzjr/ ,xxԨQ,7oܸqT*1cA*@CZ >==}ĸP"l߾}߾}>}:BHP\rܹ7n,))9|p ЈO>>> 2 qPHB?u: .4VKt2N9s攖$''{zzbzXL/ BZee{G?2eʬYZ$9bĈx۷jժ˗#0 wŧ7!uVc*- 5pppdLGa@ (&BS*4B`:prr@Lsrrj@L`X,KT2 ABTjͩ@:,ོHD_*2innnR黐XAƜz{cALv+xJeY,?!D-Yi+Dl6VFaq"8VtLbYlFͩVH/-K[wM6qH$8&zVNZ&VpJ%4ѷ l\.73$xA=` hMw~@YuXh593V(*]6əp&4W_ӫɥJ !w9f3 kkk7oL?֭9ӣ̩28)Pm"N HP1 cX'X 6 ð\%eg\8 '&&Ɯ%m\9Xa'Sڪiوf+q0EJl6ߞYbq &qI&dgm`&V3ٵ:777Lɵ5B<[fN=0,\8ń+!T!j~lH6G[>wNfʟ夣tYz%n3s8XMޔBE!Y5yoW#s 69?% ]f+x3 yk߉K*"dkfC=0]E}[Fն[s^lퟬ[7|0SWQYsoN21wq+T);) jx2x\^B5+I :85")px@ շv[u!9"Te 9+lxY`:-a2kw¯0~{=kި&]5%5*GFԙr6s=x`>Eo]z>jZS(LGaǣ(CsJ4Zf:0 c*@TlJ%cJlDA~z5Vb9k}4Nݒ]}_'_7P( ]}m$M'Z)ꗗ]]ʏSg^+g)P5ʼn=%f;/z>00/8JqJ箚*E[*rFu/MRgW $1 kp8Re)uppt*,J$o=qD魈OBVPA$2\dsNIw|U{Or"$K!j0F1QD(ή<tZ42&ldu;Wc'ackk/}4`D︤3A'w`^*Qt86IUƒjeR˚p߬%8k Qw`qS޾Lc }WqtUԬ5ذۻf::`$xN .,\FT;v,<<!uB{ݬB 釠ӽjL&,=!|I']< ?#3\!LZ% #gϞKIIh4tWz /!p7.)VMU*NꕸxD !Tߛ n0{Z&z@bZ+#jjj4GGGl"T[9...*J&1 tGbxv^ ljܤR4ѷ|o;]jIGBLzgZ_;[%N lA f؀gnIFh7^= B^ٯuKtAX5LO#GV(KX4^{BzJ{)? q;$d wz¤{pItYUZ,VeSX}w(Y˜H+et'ي/zˤeMew;`:Fж tfyҽ's浏l ߝ"áӽk7twtmHjnS3NwsX11[t  !Tݝ^T{f:F`9ւ(*7uLcc$MWឱϚKRj1!0Hw{|"t86ŸY>Y糛EC=w:$0i-^:[fyZr8{ZI tA0/؃:yD;ñ)fy7*Y|q͕=N}0 <[ܣnI,z%.Iȟ*fyPӏ6  `qz=) N]TGC{( ɒt^y:,ԧ~tG-L4 H rށDto6 U䕟wi=ck RUʤwodfc<rboF ͥcDfg!\UpClF2rt8H-S%F{ TVBRUQjr!!;'2^Z|fwHH\]]h ߝ&ӽd!ǼG۩1YGaq5AOaS]+<)dcv~<o  +OnF:ݛBO*/9p<#-t Fg{0tr/L+ ͬ28q(&BSaMQ~"w>>U6Lq ʱTnm.!!D!Mڝwol831(_UDo}y8^gBl6 3̮ks<,QAY8G0BSk&>),kH]Cahd' y9@vbefһ^AR{It $C(B֙ĆB򋣃\.g$BRg ZwFR.t{L ?Pm(d~P~0s.T۞VCl$x0wp/Qgc:$@+W\/xD-K7),Pk <E U#MD7W^5⑵,:{U,WL+ء .\Na Nw:9^Q|"'5{J2?6n04H!J%pF.0pl,(_P?Xƽd.%70"4R'8 >''ĉW^H$z˫GC 4ۜT)D4:bJ`H;AFFƐ!C"##7lPSSӵkݻK>22r 0s7u}b4M+ޯUt?5b|?#잫֌yrA&ns禥uWh4wO6mڴgϞ0LK V?M#'Kf5|*fMb~jTٯ9skH8qĉϟ?fQZݿӨӽnшG<,ʩ8z=>C(SA">$CP 8WUU;wÇ aX/Kdv&'YM#Be1paF}N@;n 0.I!V׬>xL݂6/kB$]*a9gPq͕66tSKblz~#oY>jg+xZ/|>oԩSϞ=m<`&'+̺%!}.;.Hg\5׫)ŮB#4L/\~0t{O2e/n-GmMt쌃$UMxbvQx }lbTf,(*C@L\ڵ믿8q"9a.;k֬UV}l(ųKgӽZTp]z,/U~Lz{p{Nf"ƿUt+0DjAAA%~~~0 `Rq~c=oNw }~z_jLS0'tlgݰݴRPQ0'D%@F)U 9OaHh ~?GGGT*mx1i t7!Pu5lT^l7R9?7 ΦгNEn~r`-NJzHAfHf&u ۹sgYg85`=M oN׻aBBN]l*J3SW0ន2!u=?xB;h" ^,߸q#--Ν;f޼ycƌ!ɶX"žrs]{eܫn$BYۥ%Z?WwHTU=\zgH≌iO%+&:iehZ`L/YqN:ťmڴΝ;/5N"u9VZs!Üe՗Ҳqָ=Qt.Kn =I2)&Uϟw^//)Sl޼Y&-_2 +i"TS&QIԆ@irVA^|rssѝbAԨl=Vk&k{!uL$իW$$$lٲ;w.$x,Irً%Koʶؒ4!){&Ez}npន8Íw`H0_VV6x`бcdžaXvJJJ,1J)1i%&O9??wVΡ!ta^Dn qmŽDر޽{8:s挷Eb Tdw(=8++JfsNc|xhP=222j&.ViQ5A&mצ ԁVg69??????q8hJ ÐϸjGLEՐRbgRZ&z0{4(l!p#ݛ¿~Wa@v<,α4+i" >_꛼`xx-ƪ;`3\46W~GT*ed -ÐIΎaHhmELj-2(I8T֊l} bEi4uBuJЯ;($9p8:N 0 cX)=* {|h^\FOYs_I쾛~6c?h4:mV7s5y/4?8Gpj^7.!b6WwܩS㸇 f}?6e29/wpp`XfVb8DAPeZ)(GRƎՆwE!lF `p<:%V*TeN]ϐ]Z7='jҰegq\Zm+zbnAF5gPДbHT(}.z 8R4$xH2*b!lɓSRRedDFJĉl'Tī釈'5;x<@HjN[Ci~a:iݙz/p-*BT읂bgᰛuhO)Av۷o?=zm۶+Ww?a(sz=e2$qtL6CYLtkoR?n?K2oFuBgwfRY5IaaxZ`L\ׯW͠ GGٳg;w~0Q^I?DH4TRG +-zdg8!`$B-E-mx CeH𹹹u&}6Bɩ Ctks. 7uȦP2 !X9\{e?C%/|{ߟjuo])f2 xIH}/v!Br/իBh;wD#0w4PG7"^̶P:.1ROVgvhZpzb^D3Tl0a"w 󋌌0͛'Nؿ'|rAD =Z3쫗t.ntzSH)!=Պת2Sq^ ,zH_C TL$x__߬dffj4wy'!!f;88<~cDA7^S=bͤ" {l5ϷXRUI;nH~w3, ,LvAyzzjZOOO$Bbc`*%qzo_z7ɒ"Ib;םFR{Pd nDh`R7)3Fỳsss###ozt{, )=b@4[M준]KP~xc:mr}k`̜9slvNNΣGJHp\z]ѫӫ?{t_߬ a IDATdRCL$z 0 r(RB$ />$RŽu%&K Y&H C:4 ~}ݻB}-?opNE,R12ق1"V;`\u0kF+^F"4R'aH&&5kbcc1 {qDDի-6z8D<{"'lI%a Xz"n@bB#<]Ð:`]L$xww+W9s&;;ЁZB0Og߸>wqWkwd: V-;%jE?Y4 6l2#'ZݮX׍7BaϞ=B(**#eDI&j0 Zңs7yJRl>`AVHw}c s/r!A0X+`ItLd$]({̮wBSy8+GxOc$BcM~^N0XVp"0qZ|E0łcZN+ŋO Q5uu/eZ_j_>DhCM?kFaZ YK:WX0YED|Us<^`8,GF"40RԽd;v ~wtZ% 6]u۶m|_|H$۷or!B bʕ}Y@@_~y1c06xaJ%q:/٫]ݘU䕝u=ckqs{l'~ < 89%O/t% 0%hѢH1/H6ld8 r: wiH2l޽PsBbX8le l"N)PrJDoHN01}apX,&[i~ݻwbܹs̙*++;w'p4hЪUOd 33s{VUU 2ڵkϟ?~#G꫸Fj#Iܹs_kpOII7n>c@ݻwj;wݻ7B!4gΜҐdOOrbPL&۲e _+l1870VD62SJIkit\CˆW0gKf 0$OgS4rJu*pV<{-=~mL^uqlvw6j)jޣo gx{mߎ!us8C@ sO<9w^zkԨQ8ܹð>(66ʕ+&kzPHQT-ZO?,[lҤIqqqt4nڴk׮={|<ŋn=i$I#Fq|߾}VZ|9+O (2CɓMbUUUSeD0ё(SJK(^0FO gRd2S4|>_*(: ^qd;u#wsXNI]]Ȑ6>nnn2LTlVv~r]k*+4F$I\^AkCsMMFSwvfqs3޽{ ѣG=<<Μ9sƍzݻw;wljׯB()))((!4}e˖mnnn7o&Ҍ:EQk׮MMM]t)SV//$@rrrBh"w;^ljkwX|bVNGI淫{;\d7!#]!DhH}$S3ۘ=zO4_~] 1B? ;;eh0S NSN=vBh̙..-ozjnne<==z^G]pa…555JرcR޲Y4E/(N >Hp u$~oTqܟNO.~~ ]H'u?%STZ? EG ˖-?r^3F~Q( M.]AAAiii6m\x1I;5++)m6`!>{lϟ7o^JJF5vJnz*I94l` 뼊*R܀yN~wfn^ >d*Fz>M~^0̙3W^?ѧO7n?~!TPP۩S:})u66HV?޽{LyfLFwcԩSNSaɓ'O\0"׳^b_8C98MԵhtX AM61ROQ3FU0Ӗ`ב >>ZGq8?~Ν;'O4hPDDWXAQԇ~صkЭ!ww˗K$u*qѣGUUUNNko^&իSRRlx̝;cڈNIREb}ԱKݱlŵWݙLq= =іcہِ:tmCMIIYj… =<<Əd Î92gwaQ\kϔݙ] f(&X5"XKbk z)c7ySLbł]1vET JYRי؄  l{`#e|fO1hݥ"%_܊N]܈JJX[|qƭ]O>>,XvZAWØ)_)2c:L 谐T &Jsެ}C 7 ;jXIIII999ߏ9r_tJl@\AV%Do%x T\T\d" ~C}@Az ݡ$!ի?8qΖ/Z(zʕ8AOØ`I'BʎT f^yZIǺ(FjOGyj-kikԨQ;wtVdOx}A2yV/Z P/N}G[G>!־o?sXXXZZNtǏ 0a !5o]T3m0ۗA=Yh(]Aj燳0!fw}K հr?ܸqСC-_|DEhHcGr<ϖX,Em܉s8qb0CBA e/RKXw :&;acM8xjCkUYI1ۺMvm;+h #w;5п:+,e^8;tmy0 KIIZ=a9zpp\ݿ* 5Ԉӭ|a\*72X'mhXhO9Bh4O)s+0j;$I>*GD3K>Ʃj+"^ҤH$j587}`&T*U#\B$+6_~9`>}\Bę3g[QeE 4q'Aq*TLK 00<w 1!%G0S#,5huʃoʔuXۯlNkO\\ES߆r\J_hт O!wihasUc䔧{qC*]&;#'TUT-+)J)!!l A裏0rWhL\Q@S z@u쏫N;퐈E1JWJ3{ 6JݻwAAAxxSG1p%ž6"%i|#yGEzY%?Y˚h)iiz{hPMCri/j|h)K@Duu}+ >997?~|.]صC< uD ֍ *(D?~2lPf5*/0UcJvOԠsz7G> ux8e9ĶPO^9Zn҂Ν/9xoQ^^JOHHuL&GEAְ!0hgXRޡ%,U h>1a^o:twZW|UԬ"if'Rytvނ_Ν;Ϟ=[]]]XXporr{n+ &rȭ 5q0~9~H"#php!J"*`=1a^dA6]aZ3b_ƒ\Yر####**jӦMo#Gbq||Kaw]0!cMQ09,y~CUĄUgߝNޯ8"F$<3l,PVϋfPɾݔW֯y'vZsgϞΝ$$$DEEf͚pB.ʯDyyK/h~~~=:$HrxfΜyex۶mS3f̰Lw#vj,?ԩ .t,';NO~*tB)/6Op"U~gWP莝?? {-!B TTT4/\̙fBCCJrrO?dNxȑ#h!0׉SG5~)9($˜'\ uGMa-P`R^q pXjHC񆂂RRRiYYm+ ɓwdw@HHڵkǏoc;v͚55[]ٱcGQv5rz7Z^j,###m\·a-;qab{"[jq RA0 s\j 4Зudn'?lϵ_8M dsI[Df{DC Oo/Qk6CV54.O>lٲDמnur???c???z7Z(իW[O:uٶGݠ8AB()C@Ov䀸Sfٍv4o1cgAwG©T&o畤jw 7q>^sJQxGavaC4/w?q8/rzs| Ġjo?0lذUV+111J>>5+rލPD LzK?dl -I{38O,Wޛc9cKy1Ώ0Kdo?9>}/ !bw7g ^"\|̙3 ty[&׫Wo(000--R/ލPiQE5lL ^:g0ңu~1r+o8*@Εɓ'O(a%+VC;ξ筢PN r6xD #DZ!CGEE8%JO< OG0װaK1&_ՊXNMц޿WWg–" 23Upxoe!*l,@GD_~С۷oL#Gz7 9:53#b†1.AiTQ U;=1a^c,M\}ȭ]^qr` *>)-`ud'k{+Jal… ܹ{BV5FM0Gvv~HmP& |b¼\s{)&嘽gwVRtrQ~jp}ǎg!ͳfw%o=\?~aŋG  CyG xb<O>wtW["N] TAQ*Tkx/< ` ee\ :ftՄ܍f:=` )9 P<~"L,e`Ϸ_~N]),huPk"Hp8$I)St:S;v숏 k֬Ol۶o߾ ::z׮]vJ>|\A5++OJJcPBӆgwumYj YJQo]_h^ IDATP'&MgFE3,X!|xLygddt:^K.}W>`Æ 7n,++>˛ OԠ*T`wZ=0]YXB1̮A*Fv5k… F#aFӴV5kְaÖ.]򈈈χ9フ߷M6͝;7%%% `ԩh>3yDQ=ZRl`|&q4}%`J gxNݺ]o:twZW|ۙ\I}I|0BwrR~P;y, m@@A²ʕ+aÆM:588ԩSu.ɂjoxbbbb7k$͛7YfرP(ܷo߾}}!~.y$WRA.6B1,-)9$|?EdA6gRb]aA<:]ugy|K>P_PP`yT*U*T*Aeee=sK.-//H$FcJJƍccc333-O/JVfї<pرC"QZZjcC ĉ4ξTp0;?ĊxJ:qՙ]ׇPGM T>% tpݡV)==4M/[,11Ʋ"[n&MJJJ̤(cǎLJJ 6mڸq㲳irիgΜi \w)%%E"۷/-- p̙, EQX+㔗#{vy3, ΫW Ԏ0K"p7 @M?6욗]/~Nrl_`|A^F4$Pl7@X;C@+p8^} jժW^y%&&￯5;vܽ{~u/rڴi999aaaƍ[x56lذaëÐUVٱ0L#O7d2ŋׯ_`ڵk+;\.qjKd=\ètT|>aW,.<"?-dbhTٲ4.K`& u+DOCٍ;R]hp<ߋ$Iu:H$jK] qTsC Je6a"H.vΝO޶m-;w+Zrrr߿;rȋ/:f^QeE caw.1g3.#&1$ OC0@~]q˫LMFJvGU' w{ IIٶ-"(ʃN)M*B`ozaFdff&#s}YT^94 j] ʯG'+ߞ4ﲣKN )`^P`\ }GCɓ'O(k0-Z~}ϚLqk <y#^NINXUg<]ҠC# cFN5ie3RLPT ӂJPV&!0|~~P(O n8zeѿGNqin_U>aT[aO܈1筹R^̈?pY焧g%ť?V)Fx" ȅO׮]֫W/GE TFߋ#L1=]N XW^VejNrk\zRɺH#(>v,`\ cd(߻w{` NfDb4wcVy!X|Z:XMw9roV^ᾡGnZ/+ fJR((Ioȣ!=qsT~H"ayg3ҒHdZw^Nұ LEK~W&x Jn&jimSO9CVRLOA:}XS(WTheiq?w=ڷ}1^l1= 23Upxo{І G(Jٲ$ݿR#=7ag\&| ƪSQ::S}DY@^HlEU`[E'vA|!=7hL7va0ݝ2<݋d }J:XPvg@ǫXݭir?jMn6_#p8$Ive߾}fX,2ee&C;v숏 k֬&l۶o߾ ::z׮]f,غuܹs܉rGM/%.Sacp Tʋ\ u0i٢mo]$S^O@s/ ~)P^Bh7oԩV'O,|> ###** y5>?^zݻwoٙ\z}ǎ;w>رc_˗g&Mp`Q*8~dE~ ~,Th P繦jj "$-Qћ.=^wS2ldbf.7S egԚ>ޟKYp \;'77G'R$&&yK?!!!Co>===::zׯ_ $$$,Y$55՞ wܹM{d~ڱc!(ǹ&a*ү0ݲ=yQ>.dn\vZgԚY% rq!_~鈈:Oݿܹs+VhhSh^^^'N:VNUqP NU'EsWh;&o9k, bCY3^ܯ<Ժ,,(>P61Ywkwr~lge~kϞ=Q5?P(l0iV;k֬aÆ5}ҥuvqР [Xe^`AdddttTDT 9  -)6K0>Ы#i*{Kq2jglcɹwKuO uNE&ӌ5~g?PӕCkQ^+ Ԕu:uzz+W,گ_>lذSӧNvLWVVV{{EEŋVJ2eJxxxvĉVС̙3{siT&NBj)Uq+d}UƻQVɎ (+ʘi(Ե 9%#"$ '@T_Z_6හy,66vРAYYY{nҥ_kaFcJJƍccc333-O/L"ʒ[n駟>UVJJJviiyaMPfF2pK\C6ۇjJj<:s&oq.t\B$.vJ12̲*x^_HpHB$5ޚ4iRRRnݺ͝;722r[|ڴiƍ۾}{N]z꯾YGcccPKJJ2dҥKEQ:4MJJqtttΝm9:(zz )?#3^QeuzѲs,=-`D1fEhl?U攧G)?YGDq[N#ͼG EZn{b=aX~J̒2>lұcݻw mߺu_~9mڴq-^ 6lذW_}aHHȪUFݬ#w9| y:ff͛3rrr>X\VV9sLJJJFay>^CQѣGQPݻwoVVg}Vr-x8WWW۲Je=B8ƺabĐcM(2 SoS4 Q!Q# `rg~5v_6… -.tc`OJʶUTy;v!\.WV;(vVzbX30L$) [I Y<=[Bqh"0_|L&kfL0rG~gAPy9^0hS'cfZQ"#GpշN..V^ =?:W17 `^Pc0 #rh/˛驉/k+Wg(Z(zܹ}-_f;v,:y,<y#^NI5C38IޱzQe[O5eDkb,F. ?:W^s̱,{۷lrڵk׮1;wVe@P7OXr6^+?c"oSSp8d046p_| H4fsSg֫fn( 11077?}vHH &&СC۷OOO^~ K,IMM$we$Çǿˬ?)).Ƕ;jjez1 0;sLpר00x\g+\=% A7=14@ÁԎ޲tnq-y"ûE`OqߦiCEQRtsέXԩSdw //'=zTtْ-ٕ]׮];zhTj6bqUU/n: (cW]qɤDpUwH4ޱzk,)Kga]jyYUvPauqZ7:O`$CJVK0 iZΚ5kذaK.}zzDDCCC>DԩK.egg ;PmRI݋%IPIh5ƻkc][FZAI !fS ^Et Űrׇ 6uSNyL& +++ŋO>Vb}F߿\E#""l?6d&6h֢mC38ՙ$XmB̴-rבY<4VWzpHFAMc_ޗ Z z.]Z^^.H,OƔ7fffZ_RSS- ]9#oݺuܹuJpܦB(3qvesNa#ϙT&(=T_0 f/k,1-" 7EwB7H$***z뭷&M[nyyys΍L\6mڸqoީSk׮^jhWvJ_|g}6i$)J9?0 j7 mB7\Id IDAT ] >%'kA7x9vW)ʫ( pTP@yt׈b?aC[رݻ?í[~ӦM 7nŋ-ٰaÆ ^}ՇZ55=*n9]tζ0!my;q^4ϺA?c)s.J#/P0}CeLH 6!.zqjvjU.و;t)ʮhuCU҆zJGQjWbZvg,biZWba"HPL(4___#(uK^FId<+!C8Oĉ4 Sd$wX*(AW6{w}ƅ̍ 9Rɼv{Wx`\@AXI ,J:2V sE*+ {uu8Ò+/qOdmE%H3?-]1,: ANJvf%O2%<<C@{m:%Zn~kRb^QZoKci-#v'T4ށ6zh-_⋻{Tje:L JDΉB 'qKj5UaPp!mIj,گ x E\2`@VvBy֋}hP{6&ؚN3NCQ̙37or-[233mۦVg̘m!jJeD%1wp<1O/C9NԜ)N?Rt\O8,[ب֖wT*8EC V{7vwy=AoE3`Or-C'KI|H0 A%_~eslWڧ;v͚55[]i);jԨ]v$xVfytf0 EQN=;RGYh8j t#t( f~(͗m"qĨo'6,COYzAAqV7L(J7=%N X aGRˠ/vPekcp-+ q!ݺuɐ~~~~~~+իW[O:uٶ`fL#c֤7)iM{kME.'"p+' H -I=xcJ_'b+\:KXZJ_،xf=ӶG$NA3!<v &oG 5}gR=jI,=(kKғ'OZQQQaQpW(0 %qJg7ۢWTv߭i21 ;5X; Ǫ.sUl17Td(lɱ*.yTu*;!>NjI z~Ju4U^ CWH0QH$2 _ă h4X^0 V*6qq#V.Zh>k\ܺuX..o@%]@7^گqNK50 ذ0C1j*/q9OK]-.KOﲽHТcSzD^,++1 I% _iSN%Bk0 O?ԙԫW^~mQQQ```ZZ+Pf˯ 2++Ғ[[,2 Ivt7u%KZ,, K/>|ӧ8DC_+WaYNl6<,+S]lިE!fq_-fb\fZw`I{p Q~Swd]\AS%~xA[ b>ƾ~ %a^-PD󀨾A8ƥ](=K6Չ̫F8֧3in*Lbjxk=0JOyq +Bi$xa>裶0_@@5#u<~ tSSR?W{&oI^gPB~N]1I_ A$Yg3;l#m%3@[Rf<0lWy3lS E.1!+2VVVpv}aYZ+ &ս|oc#f5K(nf%D(=O[gl9+y`)KGBw(K+PtCDd.1yZfyҥKSSSMC͛wyǙGo} Uل۲M0XmYf/5ٽF^9noć-"p| J%&bb$HT*]A}YI7nܘ1cF^^^JK/98JJJvI$=V ld!GE섲t/]y AYII7o;w5k(ZlFAQwvqPbց6"\n5ӗ/wAGlRymYOA:`Ǐ&%%1 hѢ={8'>L&̙3,22r̙˧Ony1 bYML uqɲDž(@V  j)u-EI=YJպt .J)%p AqV<4Mzy٤A-Y)b 6lԨQ(ݻwӦM})$_x:cg(j0-ߕS#.V~ӗ8e0"`fp7:KixT(N ) fss` $)rٯ8q8EQfkk[gEqZzL&Kh1$}\2<<{+.\v&L\ 1b5Oٳg|)m9q=ׁaXq>ƫA3Y |zs Jʎ4=v`4h_)u3AL&EQmZQ1 _R^uGf0$I^o;mge֭[ EJJJ~$k:'8s͟?_TcǎEGG;¬Frw8^>2ph `KvzAiz%V;ut5a9~S| 0_ ::s\= ^󂷦(dz@RUP(dhV,+-WS]W^@y7|ӣG:{ΝsfZA^_iG LuTd%f^g=F:{V賛~ 8.e CO2 LEZsgZ%ڈ%YfY'$.wn۷ύ }C\9[f2,VD~^p@6/ ?SgF5Mu`/V;5 Qw =|+X^FiboXq ĉF#TE Eaq/ڻ^ R*]3䏨ԋKefjHW%An AqZiKFsN'T%-8|:V} >wg2%b9. e/2Q~>~>ZaYP35?S omKNi l=e1 l6ST";l{JIwVJ}8%VβMyX]V/'hZYR_! .  #XI_~,Iʕ+A9s)ZqCL!*~G=ͭ4rKy6MypH ٹsgvv6aǏ8q"`0_>l6;7]X)o9hza7=.p9n5&JT^EQo>+B50L&99Ν;oD}֭#G_oܸqϞ=ocIopC>ZK7Vcޝ5u{_H $IeUjUkQDVԩ>E:RTǡV9uhkQ4LۼŠ/%m8G(VT nWoWx > 5Q*J?x>]@ 0 __B|^q@KmlM'&&;wZPsz{{_rXyyyqppMU*բE,SRRRSSmy 6M?%!l$;%~TPJIѸf^'!"TaΣoMF{<RZV^g/~Nאá(mBpfs׿ ӆ])mMcǎ=m|:u*99QnF1##j-oF<#X5\Y@$EX,]OM+k*~w\Gl2 Z[[ rySS6 ÑJ6rJX|/HFPhϒ?~;V*&$$dee9TƯ"hroVA-^rΤs|gXLy~eu&(_a=} I&^o|YTT|)Sؿ?yyy}Ç>uTTTB1uĨ5&9OzϔJ.|vvvrrr``hduuuӧO_~c+++[t)ׯ_zz\LpP$03t[s"4*eN e3lQ~ĉΝvD"aX ,p8"ޔ4Wݳ4uĨ9Z5-D¬AjwkIII/FI1͖o1Xo(^2lV<:~N>|a[WBw}7/)Eol^xO ,`Μ|cMMB8`O|Ϟ=G׿5irw#b,Ҫf^ܽ1͡ I#NjE3;Yp8_lTٻJ#f ;|jZX1#wvHbx<*uZ|毺lt!eX@mOJ):w\nnnnnJJLL1cFBBw(uuuܽ冨Ö5k -JG@ ]=' ˜"5SƦa/ [N5ݒ].⻵;Ő2D".l6[ 06!D*t:.r^F7ݓJt䱺r%Kߺu+!!aƌ'Off2u/egTfQkbaHq~0aN)b*Wo`zaaxX_gp]TQQw>|z̘1v1|, ,8[a5!`///߿/_O/Zhڴi)ń9y]*Ey:RK=3K.MNNwpq6Wݧk*gUm:}XѣG[N&B8 :: EªGplޢ֗~/$p̏b:`BHyyyNNN' !sQe7cuL΅ظ* ЍZ k/;bwV%5QyE,DE޿+˥(dbFq\: )q:yp xaȜ|as*V7^!л !s q0w[X$1 @9f3MZv\¥t. |LYS]Sm4͑J ˹ǗtA;CČw}@#s0dNުOL5= sq|`'xbœ<x0dNTvBU:A$|?$0)#0aNO oȰظ! suF'w>[AO&(jO]:22dB x`œOMkEkBq;'Aӌ sl2}b<6Lo~3xTO<NoCr,#k<VNG0'eB>1`>'߾O̮DBLhNי͛+oFCp|[<}bsl-׷:p!?;M/qhտo߀C[ۜЖNGx49?s'l'Co'ɟlҮPJ[Z' sENҺV7aD-hSxީ>1O ؇GզuBj4=lD]U=yt;OZd'(p0!wSMڿ+TW[Z'B#q ޾  # O#(U*vp<'OMڕ U S!iSw*I>1tx O 0&̄D!T6gI`'y`ܲ漮ywgx+1)Ֆ>1z$Eή>1BCp9E%]|W7IJQ>1Z<=໶WfW/QM;(XׇpCx7pCx7T1}n B.hX- ! ! ! ! ! (rv LT*{9g>[>?i$g>FGG5م ټe˖~:&&ٵ]v%'':Ow_>*ѣG8 /: a6wQZZBG}};]  3? @g>j5͖d.}( XBEQwuv-nh4*J\]C!L!<r7L/tp~mٲe?g}f2,;o޼>b]iqtjt1+nJk!}[ojժ:Zu innnҽ.׏?P(_oZfD"?}H rСC9… .\)Ͷ4%KZ/r̘1vhRb=իuyڇΝ;|>ŊsYj~0g|]v%$$`A}Gw޽~z P(deAQTǏ2dݻnݚajoll(;;53-H EQQG}`~~~#G\e4޽Kܸq#!_6;;ʕ+{j\N9~8;vT*MHHr+a̙3.]JKK3L:.--m˖-iC2sL r aT&DEEB6ʼn'P<@JJVV*ܹc4m̶ۖZ6--l6gee8pSNZl6o߾=;;ۑ/!h67o\xg&4///##y޽k֬q av%%%w^j#_shSgw/^vmSSS߾}`2 LLL$ŕ-]bcWvq<#tܸq˖-#ļK+lRTxM6544CJ/--e>]goت U nnnz~Сjd2Xm?̙3Y 999Cm7UTT=zم#B؝`ؼymqi `wٙ3gݻO>xw}cu\R#--MRYWUU%%%I'xСC"ի'񉌌ܼy`MMͬYBBB222z=!dĉRT,7%IRRRyyYΟ?6Bx[YYYeeesmii:ѣӝɓ'߸q믿޳gOyyI(2< !ȑ#+VXdVoeeeJJJ||ɓ'ӗ/_~YxС={|x>}9RQQqIKnNwfΜ9c Kwܱ4nsܹӧO+JTJٹsgDDD~~)S!.\70VBeuڵkt'_vMP <ؒ8bĈÇ$''?0`%K,Yy~~X` l;b4f飢._# )z[yyyu{Ų:b6lh0g;! Ν;rH$ZvmXXؑ#G k'N;v n޼9mڴ>D" PVl!.88?߾}eUUѿ\|YY={}X,;weF}ݺu\.}^7>C]zuРAIIIiii/^`؀ϖjۻ#FXnFBŋ)R*g 3gNMM7n/ţF*((rj1###|~hh諯)uԩSRe\ss3EQW 1cFyyyrrrbbb2ZҥK{%HNV^D77EQcǎ 0ۓJ3gMf詧jjj)ڵk۶myyy~^륗^jێkE͙3'''GT.[lܹOwBG};yxGxW jugЭ[ݻM>!tA-[`֯_uֽ;$IN<ٲcDDDPPҥKm־}{Б#Gg;w;zG]t)$$$<#vs*\hBh޽ڱc٣GKOF;v!Bĉ066ql}FZ}Mf <0}:8^>ɹ|w}gp4xǏ[^ߪUF)3f`>;m4Nn6krBM6b}ܹsMnٳx|P媚7o}-*** p֭'OWT޷w-HP8pԩS877~iӦ}7~ѣk2Al5FNy睇d .lݺuܸq{ۥK 6̜9k׮N:ve,B$I͛7wڵ:8K;*Æ qF嗥[.1֭[ Vŝ;w޹seNHHhԨ|Vܹs- 4{@ӱyyy.]b7ϝ;ױcGXܤI3fY&..n߾}li 9r!4ߟݸ|r}}}Ba&M>V>U^^ꫯ5*??ĉ?l^ڡC@~(S_5x!H!H!H!H!H!HV \^\\l)1s̉:u^U:*IJJ*x!e˖xTګW۷o;)jM]ZGFYgΜwCEFFN0rWxg<#G8;~xϞ=F;\ݻe2ٯj5*k-$yQFEFF6jԨ:ZlYHH_ĠT*=<|+6mZbbb͏7Lݺuh\h@ jŋùsB^0ȑ#]G0Lݻuvĉԗ_~900{РA^^^}k^7B d2פf[j nx ~QQQA:NPT~d22gΜVKQL&c7)ɱփrT'55ٳw֭[mFӧJJJp駟vڥV_|ERILNNd)))V^MLw}7))Q?iӦHA4mw `VlSuT<7oޤi=m޽{ q!c:xܹWzyy}cǎr?[6nJĨQl7LE9@^_QQ!HBF,$$D*Tv3[d,G1B ,ظq#GlMZv)Sl 7h4L&caApՏaEQ4Ms`vqxv7Md] HB4}$I8VC(l6ʭzHQ^oP=xZmxPCvg [4yUɵmΝ; aÇwԩ=xH4{줤$[j^5e!Vr5r LY.ցaX3n< n< n<Gsp; }YcLMvqg[w!Oղ]o0% ܿ! \ծ / BB^{!$dr켠sۑ {w8vٹ]uF?dK~ a-b[qU!\8߷ \nϭ3ՈD"]2 0ܷKH$2 j@8nB<%+]|K0X->o4nZ,;.@P5x W2A<ަ q5V=xp?z1wGJ 蕁uP"V;24kZ^Pkxձz@WY]_(ձ<EiudzE]= @G'd*Cq559sܽ{}bvkwM.i-q[oPM;O +UBj6l%]^"" bbbMPTTϾ߿!TBVAAAǓ&M1cAD"Hd!*?v\Ү@ pI!\ޠuaiwK^Bj I TEx:t()))W^t)a 5/Dd$qDDDEE}J$^Rr.iW,kZ'Hgg wIBPVs?=ϧiv)(rKB% ]CJ=W^o{yL$fNg_.8E =z4ѠA݋W^e_PTTcS!K ˲Yso ($Ib}Abm zDK$Mq(jwIEqș4=^FEoM,_b(B($x gΛ7OTtGh!Զm;w( a>ܩS' mT2"L:kR2.zݻwʚ>}:BE3gDDٳg'%%4ݪU+Rz =լl}0*̇{`/iwv%S%C JeZ^*p^,d=xP(9n!$JJ%J$ ʸo6^n%e?hi=uNW d ./j9# \fQ^x/7䮹7Hw7r:E˃mڱv n <phGCI8\N ZVN|(*xwn" C }w4H9i펈(u_ 7ctvHa2h4dBPA),VZ2ȿ/0J{[7` / gzOټ$ܻ iKc w 4ˏ{:]+^?gzDB3tA'])h (94:u˺M%H=@c aquG'q+Had8 43;VCXPb_MA!}pc{:C\<DB[ o;lc4pYW-,3B&ygSimq$xΞYN<@Fvv`d=;dsxl!dqBYqbfv3]H307:06n@ 4PqxcX9#蘦h T 98ASr3i!<<\?sإ}&5s/,))1ͮ yG+T[‚ ߶#IhA@3ڬ&o\H.-R;v=id02-Hج7 a6)jWdi>^vN]G@nhwLŘ0CW=ab"N X`ӿ%Э`>Z;{4>,ՁWBg*< |Kx0eyX?၆ɭyzy 0@@QcI88_0H$r>=!@소&oh2pT*eMWA]1 CQA]20Cn)4Nle|H3ۅ"ɞbMKmPU///oG\Zc㱊$I4 h M|^wvCWrUe*DTr?^,zqBP$ TT*oW"!?Y%<86b᯿eqFdc2h4T*=+ӃN7db 7uu,ͭ/*lUdX7:,{A>0-p0U{]\fg̈._G 5ԋȽq҂7u[Ocg8HݘŌr-ܤF9<п?yI[8:[Y9]OG7ifcAF~e -ah,{oD]p i\"$7O(U;>~Ca>Z$p U#>&=;}>h( 3>CQa6'H E1Q{;230-p*H*خg e)aXBI ;pYtC"(3 5F31̘.f_RX\ʂ2 EvNݼ )cw"'[ ճr1ݻM6}}]|ТEGq5 &-sU} WF5tAmjsrGgk1M̐Ň+$ͳ<7Src5;P L2>$aG gx7{0;<<jJ0`\Vxk׮͚5k ҲVHچy(Aևy4C$\m-[3-[^|9'PG%+.WyУ;+.,ĞSxqcxs\?RSSo޼٢Eh iYնm[y2JU nC@1&THNw7sۋ6f]N:G g'vU0NJ\+n)k)Q^x`{M2}I⇰ ʎd~о`g'PdQ^K}v2pTgx[oi4O&r'Madk!hR3Wű,%l]jZ5A(оcֆv2 䯿Сo%۷'m ,˳h˗Ϛ5kӦM4X4Eas1_/cB }vX[X@.";vǔv`A!0-[$3g 5k8lٲ/gŊ6ZEԴDuLgq7ӧO<_6'a˰"R%Je_$ziv$I DZ GqK(s O_Qշ+j57|(xjvBלx>ȧ7Q!Z%q˦a2oCD&I۷;;ެ$:,Y$""u_~g}vygrիWEEEߚD"-;6FW|>l}AD"mB}U\zX|O=bL#ʀyi)zDK` xSA`ְ`]k, qg{g*jɒ%d@ f.SZJlbfд KxH 晶BXypv u'$$y$I^v&8J4w_nFH F>+R%,omxڗ|/_|ׯ4={!CI̕BO-]FF~*-R&uaxiɌ5Y`7q6kދKNN/4Lew IGb̨PwP#y/ˤ}N;ɻsS) ȱlVի\|YN4h4nٲ壏>&8e-'ZJTt)2 L j ?OB6wllpJ_fMRR҈#vgϞUVm߾@CV{t׶!3*I¡+3dd{+!D flc+ gϞGð|Nb ZjJ d)ŧK ZFa^)0à j3RO݀aȮwgϞÇ#N<עs)uYwR51fTvQ$ 7axjk<2D{vafoW Vz/^zuddd;ubŊYfM6@"$^TJ }N'8~Pdj4˼\ ҃a!ʿVA${Kav(j$InڽyDhHq`0PEn:5mNhߌ, /JJ[h_z%v3**s̙Oo *'r)2 Z-ד$IQF1 (t}:BW)ŗ26|l *bP0FJ{c(j\ۺl$zd]PHڐH$[b4tAl ש!ӨEߙ=t}0jum搟i2nKVGLLpUL&+))qbhM'aX?oѳ.e0渐-OEDHCt!Wxiy-SQf6 xjڴ$ܳi˓$j jW5 8+;wP|:t@%''7oK(%|*U!qJ҄Z W3[_HPԳ.Ԅ!"'[3tS#_|144M6]rw裏M]Vl01t\5Twb2xd uֆKʖwWu)L :J qƞ={]Fo9bbÇ1[LS9A<*ͧoeyO_۴sll)Ǎ`4x<BI6KPL;fVNhq}5e)`]> J/,,߿+WqQ6mLᎍ z h4rh8^Ct]u@<@^;O7ĵ[966g#8J6f}Za>⦏TzQ$; zan8/m6hwBxip߯p=G[L& ê\ce=u5.7>lD 0x ʍ ڰdbŖ_3<Wteʕ 6n11GkZ K:d` yKj W3BC|۴i@1H;7+t s-%j19>>u]4ߞ<Z( BV_Uo5I%M#N<>wΝ;3 3tM6M>Ç "88!ѣfͪ.[ZZ>ؚf%^wݵkW``I:veZtR4ܹ[&$$L0!7tPSRRV^6d0LR>`ĨT*4D+8$i0p}qHjM&]Hu_ӯU*IH-S93Tϲi6KQS5db1ehuǛF z^okCXq÷rgrz紽!;H$2Lz:G-0 ֭Ç_>q_|UVcƌYl0oݺu-X뛔tҼuY*qeee25ϫ7V5kF?xzzٳgϞ=fͪ}gfݺu . b G͞4h޽{Brի *LDÇlVD,F?l] D"M03{ t:>;# gNQ@ 'Z ?c\u(I r )Ga| R[_3r,04oD"! q~50СCsϞ=׬YS4֭[;vخ]_&;iҤ秤Im,PFXI={D=zo߾EFF׾G-]q;gٳgE=zEm~ "((rhOnURG O囋Kؓc pV$5/OdDX͛7o^B??J!ASh}uϳ^{^{}l9*!$5Q_$&MڵwϞ=F>ȑ#{$6P1I\(mo${Ua2Pq`{^/ܹ //ӎP%xv?~x .pOOOwn\_tHh~b IDAT}}xK&(Z0fJvN>(\n|(ܽ/.ԎotFg'aÆYk4v fX,:thrr2Wb@i|$M(3IЁoPܔo$&`N<7[;r)8 n}GA?~ÇkZV{رѣGs%wίdl&:0\T\I__;͛͂ɌLwd Zo߾|>={^z"X*@6̫$U5Js= 4ڹ9y/{yN}<wwn0cT=YI>K233˯\yyMOj37DYqr@2Fp]tls'D۲,YRQQnT%Koz,-kG^478*y\Fg<+{ӭ^j@%Vn믻w&t>INbRFʴͶb5<]/` L]4%+7@ !m6?wJ=]WW0LC ~2Lgw^rr͛7 5j+je(9t U~ n&yi7t }.nrAٓ!xddRV٩允M}i}oh~)S~S\qo?y~kob%ܹsĉU*D.Y*3,pv7vs9-k\7(KSr4ƈ0Ҵ g.BTvBss_%ں;yudEk–/?Uv]+ ߟ?oQ/N BvdMvm7H)b׫uegM^G&A E&rUܯO$YYyrׅʢ2_ iɷu[ױ&/ mܗC&%?,\4|3 hѢ|^oP|Nf~(&D8IMDp]^;ݚ((Zݠ!TfG .8hh{+$6PoU\(}{b`E% ٴ#^R,ܱ,jFl_1Og˟g˖-~~~gF}9rCv89uԭ[FcfͺwhsP(9+f-=sټp2Г26U(;2$yy"!n^+y+X3AƱ>v8qbpp0Bh˖-ʻvڼyso{ }3I&رlg}vΞ=[Bwy&U7YIrJxx8=jӦ}}mAHs" Am6T5,X`mZh6lҼ*!q^ѱד37HSPX=СB,ϼ400}Riqqq~~~HH[[eooo3;һHQԃBYYYcƌ={m8 uk_:{bfzþ 0Nch^l=k1MQLSf5 T)W/??}|E^myyyO>P*~~~BB_ S'q[gqcD'%%!lٲǏ;?0P?e7c))>dIAj]H` wTc4-gL;jYK8d!Clْ_^^>uLDrŢ"Z?X^i4ԩ'NO>dA 8p<0LK.$_,XQVUaC=m8”=ήҢE P~^zuݺuM.[O>aaa8/ZyQ5hР*wVf;vÇwR(GHNN*Bw>A.k45RLvo[qqr|:=N9zx؄R9?]8T*-))iP3ىDb'՟ {O9,9TT*$mP;b),±!3Y 3r&;ڞ>\\lrr'6mT܆ڵkFcTTTtttLLLDDN[f 7Ds^v!3,]Kjx4mdIMu!61vtCF:>}~h2"H$2O"-H$eR't]hƴTeEl#'.˘\wӽ{a񶢒^z5\.y>qV3*lb.8ê0]77暢׋niFX,u\nPHhϱ([! " U*IF~> .0Mw3_q.|B~'5KX-rF?#Wx:Jֺ|[z5p*u|(jB/MEQF4}Th^@*a<:pT*TUU} MEXlll&' ZYhf_.aBPۢR(P?e%eE!2U2f c^ZE&p82ymN*C$㟉7{|4o[(x<AFnGY CBB\]]vxRRŋMM^vڕǬmp1q7発B6eP4hyQ׊gϞ={Go#}nfnNK 9RmEVv96x5-S5*rHҹsy-Zb t6T0Թ tåL 3|ʟJێkpy4'M' 1^QQQ`W~g///Cl]K5!GBZyB%m 888*'X#B* i: |BB… u5qmmm/_~%ia5p~(ݭ.\>p62s:q?482dȒ%K~Hww~i&'''kkT^ZZiӦǃWX_֋G6mZuzݻyƌUUU>|_~9z]޺u 9sm{ O_|9::zϞ=O>=r䈹rĈ(}kwY O+u!.OZ6HleՖm",4BT*B?ZZ=Hk[@$M4ٳ?9rٳGx7nܰׯ$nBBBqqΝ;qDFFJZv-Æ ?My'<|Ǐ?~ŋ76k׮988ԩS|I=/_ng@TOyB%}j~vnTĮAuSVL9qekFH“ORO>V(vp^"x>:鶷s>ӳFիW;wܵkWy>F7/ߟ1L=O:::VTTxfee{Xllĉ5-[6yd`tݻwr$IÈ ֭[-Z4}^{_~ׯo$HkD-nN3o|u.εRmۼcC"!8r-WNJ:8^AH2̓t#r~tk=tuuј]'_9'HJJJkDWAf[ ;vr8E]]_QzKII׫\U[jrY;ĉ333CBBb%K̙)ovݺuT*=~-[:(ݜIZg|{uѵܹ BBBQ]re]q\sEQwC ic@"舍?~Vӧ7mڴt 6,^Qbz666 ,\n-aVVVxm_nq݋"<뀥*iތ%Iii)E"Y PXRRRU33sl;4ȱ{*d[`]}$Ieeemb1albK$2[,bҥݻw7E)hip KMM})t] KK{׵#-(I8|o;o_M1 ixCz #/aY.8sn<ߣ&[n!zq3")G9F07ZMD6qEQECq_ rMOÎuiH#6qޠ:F?MA%&,rQp8f̀ ,Mb2>2Gh4*q$]807SSU< +5*Jz0c"CK @ -: !kGQ˴zAXwi+ʴhJ8|oG j~DPDNVҺܾ_׮^ݚxr;;J&T(9r`~ IDATs:L8qҥ ݻw}YdddhNؾ}Ej B@LC̑Z=h#2iՁ@ pΝ]򂃃wgǎ۵kW^?u HSyhnm Or%=gn2?mpp03?o޼x]͠ X,|}}3|ϟ{zz8+555++kk/]޾z;m'Gʔo|k)%e4?{4Y:cJ m.ZB袒zu۞r.99X3xiy&c޽;|ӧ8|`!-zPѥtOxAZ8<3 { :PH2@ m5ɓ'Ϟ={Mbc޽CBBFrMЅ :P(:u4w\t } 끢IoF8c- 0JVSpBQr٘^M ӳaO;3Ȗl Y^4Mkڦqm"srƍ7nk۷oٷo߶m֬Y߿?qinŵ|/?A ߺi"EULvp3/lQ bgC2نCBB>S\.GQT,:R'ɅkMh &\em.83+_li>R-3\zu޽6m >|̘1(9rd֭ׯgzD_87z1[$i&$8j *uo;H 0/ nJnnuaW*M\.AMYRkF>IUPIߎ^{%%%88쨨+V<~8..β%+)  \d7ɍ5<OO6M p`̲'pyח!df8 ଘ eRi'`|y֌K8ݽV-,=-)&xqZ4qa8x P}O uU:tիW*(*.\0gΜk׮5Q{5|pƌ7oUVV(JӴP(9rݻ;w&''waĉK.Յy޽NNNvwwt͋|BBu:._Tm)SO=j9L@cKE R p& Z"j͸,!rs򐢥żxZ*"\JB &… ̆խ[:vw^=bΝ;LZ;v|ǟ}ٱcvիW'O|ᇉ]ѣ~~~W^pvvnv KA+ 4dG3xtN*[o;@-f,{պ#J%B('P9b|Lh! >:ݽ{p޽ѣG3gxzzΜ9!b̙۶m<{z{{;;;Ϙ1Ⱥu\\\|||:W7''gϞm۶ӯ:֭۩S.]PZZiӦǃWXk{e9rժU) BHӡi*2uNX}|ft;Q] =4VlϐCSf,1tsYwܻ#=]uw? âpɭ[ ٳC~L BBBΜ9SPP0iҤ~-55E>ϟ_xqr\y?~x'NdddTkV{ٟ~ի7o<{^ݞ>}zʕaÆu`SN5kuDDDPPбcǘ>7o1cƚ5kL|n MΝM!D7R>N.<0ŗ,ľzcfeeUYYi:7znsCLXK?O:8;7M`0:  qq-{?'op z+[$WUurRzvL2LP"   ҥK}||(*uhM9)BSqU]'wwY{/M %)e?HQC\ j\EWW@522=;"<Z"i{ LxͨnuuJnj& Szzz8ɬ1! L (2 8By2ygX1TJmIQy5cfHq?P(d݌0k!CJOwp2Sc٭Y !s-Twf@ &À裏"""ko)?SG4OvVU+$b&h֪{„z!V 3wRR><<pʕfC_pJ Uq(k y94Ĥ~MʜiHx{@7fpC,DкC ֨ϙ3gٲe6mһWDVh2\xB<\ Y8 FSޅ8pER.h!iӥR7|æ62<>>4.&Y +]ò3IwOŸ\1֖?:] 9𰴴1bDǛX++$J/vД * L( q½?#UUًfI,;zp@X͛qqq̆gϞ]tjAtU޺g?|h-J̱l,@Hu~i WVqNXWGAO^WNƍM%rM3EC,?\xI@"+$,=-)&xYWZ$ JCwb&4/_1!)G)eP“= wOK]C92/-b% ;1+o޼Ɏ!Irܹ~.Bbbݻ{51qRk!>"qG,xz;X NiLIRɽ7-PCt^.TR2pF'h!yaA.^kQ*7n/<<<֮]{ѣGQCva[\@S Nrh!2ukPA"Eժ OW+tU~ k иC "]\\"""o߾rnjS;on#ҕz8wVWk"e>0L ;`E?wpϜFu}q96VкC BUmbݮHf;22r ED(+@zsݬ_{B2v.1ZX,6&baaa>ȳ'wWwj^e~n.;x= E9 M ho8SaRrrr(e2+7D4M;`ƍcU*#Au5((Z]Dj(-sEI9P6}]1 |>_Ւg_a~E.Uտ?AT*w_RJb쿂\.sjhixyQkzHs@Q3M%٬Djq6UE.m. EC߶1`-[tw}׌{k׮gg縸6\Zƺ%gFtm#\WyqT%G ,3w VT@tQNI-vxKQGv6;@ fĀizʕ K QQQ֭jݺu5j1'ne}}혺 "iwEG3L btU:`MAѷE.7+ĀݻwVV'+KLLL={ٳ':I';،뾸>)s,I0%mhro\A\a 1oEQtÆ |󍭭MQ #Se>|ޢM-#;fF2*su" ܹ;hРچ4lٲÇ_e5ئ(JuLHh -8c!pZV6nؼڢM( 2(3I4aNmNV&ioAJnCZ2 ?e]BdhIr h B2 傗N=F:ٱff_+ ZҶ>Ԓ$X6 ^*I*2#;I:Bhnu 0oٲeذsCݺu+ƌcz%??|>?0Z 8FFIiO%")ըr,@ ZjfAHЈJbC RhhԨF /J"-5$ُT<\u@ m 66$鴲4J5((h&3'[cKx J$jQ)R4BӅ#D%BJUR T*s@Oc8iC E |iCchKcŏ[:eeKn]TČjukpi] ~71 akUUՄ H"$ZT\'OYޫP(hy#:3<ёwP*x@ D pf ˏ"`Th&@1J.n{Kn'r{8bKɓA>}n޼/ooo41cP=rHRR]2_~a{Ӣ_|R.z TJ4j@.x4-g1p8x<!py2aʯ\^,{ّ` uFxN]_ {q8$Oc pp8TXe#AV:h.fdGӴѢ i)ߟaXΝ'M$Zhaꏕ{u-..niq)E4w1٦x| ӁG@ _^Ye)pCFV8/C0V뮽}qf.I]vgb3BeDRYYɾ\Lyy9uM,6ckkۼ@ZgzZ\.zF\rիWssZbռE%Ǔ ˯[w@Q@:LTZwbٗVVVַmرb. `dzVX㸸8OOOVAeee͟?G&QЀ>tAnŕ'< W-@ &a`~ԨQd߾}<OO6M p5E꘥7zzƆ27 c7r,뀥C:ZYW=xa3o-)"_vtS o)OHHXp.v.]2^Pۖmݟ'kso;M"(픴i?J*+YSh;8nccP(7.U<=wA!]a_'''߼y{K,gA:thƌSNov ~qΚ/Zgm2y?η>.!A HM:IKK;qDlll^^Q<8șMV, d]U:N5ؙ&81.lFAΟ:y~`EaqjjjLLLLL̽{7@F2**֖(''ryLL o.t\}7!]7a'3\maR(,)8Dr\se_A?NptyV.A]5ʲ3Wa. ?aC0sEQ]]!VjrO>ezRRСCǏ?vXq۷;::nݺa2 ###ٳgwr1PUOMv'!s#T< q1x-gJܔelwxwpq8If\lFLAa/%Ga֬Y׭&eeeA ,ۡbu_lɪ{b6FTYYc*ς8,[?M|MAE9;vրbYm,\lFT# 55u˖-z;i/\oaee5bĈuֱ&Z7KώsC;AY1CHqDQ9i֖_8؉1'@ EcYzr  ,'O->q+뻾KmG7?Be6yl&d{ؖPRK}xܓ܃<4Vs)))sEssaMt';،qCr9ez+ZSֆ9//+m?eBi<#2s̙3g,W-}4]w il;F Έyvu_H+=\}r@ h,TL YDFglIN@4+mEn危K _q_0LƱ)iMF8RN5nnʕ*& ΃0@$4\M`րn v(vo{U* ֽrR0#FA Ii^7|g('ؐc*X衑vןR2 'Ppŗ% 4nk@RjGquA1@`Jچ[0%(8%M`;wi@_4(8gA*&ɏR-;ٻraO=<8B͐q ۻwoVd vUP[[CjU@QpXZp:Z;HUa*k^K~P+Ze@P ?riNWz'} _~(۸kVvm}W}Up BګIeJj>/ٛ_m[qzecm! !4BHZ:+:X\sܒw'.2Y 춤 _Up;9-ml)&1sKZOGnm+(-V0OE#`( k1Տ֩X ?=j澶ci6S]O!.:eN[9 t` z/P;wи901R2G7nmwSSͮ|<_f̓ڍ%X?fm ` <nWP(X<!@xB0 ` <!@,]>|؅Фѣ!!!"صФ.77wʕص~~zbb ŋ>}aBss0EO!ǎs玱T*=zhCC O}}ѣGe2 ۷?n*hUXXk*h[XXh*D!@'&[[[cBZ-GaZhp] MRT*9r ӧOU* OKK  .Lp ؀h4 ￯[4n111v-0 ӧW\gTjb -딖qy搿dddX0xˍ~itt;>}jb fee]GGKSE1Q^^G}xb\;XVV~իWdzBٹsgvv6EQMMM===۶maZ[[L:xoYG,md(ZT*JRVy/-kRZFGf~5/%%%t_{ߗnoo߷oߖ-[2228Nfff7m{ˋ燆6hnn3g;ϟ7o nc퓓x<;mroLQB %IDATer9<\^^4uTzիW@_6jKBBmq]4i!/'MۙuŊ۷oJ$WWWmWWWDBmdVO:5s!e+W:t---mhxyorȑYfy{{a݃`?~LIJJjii^fې rSS<==ׯ_oRŻZ ,$13v7>;Н/**駟cccTC1HAAAo։'222ZdRt…=R e-x燆쬬{u̓4ȖryMMg}&<:5A~+**VZ5tu 21cSjR__~BHCC'55ۺGI$'''BEQ|Ǐw1\vd˗/_rBp)))FdrQQ͛7cbb4Bo ewwGYhQNNAE >}As`#TEl?{"{ヲ&ZyG&''ޖ111 Z6%%ܹsElڴIRiBg#g׵krV?^>4/+W$%%utttuu>}z׮]t62plɓ'qqq<9qĎ;ld NLLloox0 %>>~2l9leeR&Oh"Bݻw.];رc4r@@@UU՚5kX,ք LvX_ly8d˳gϮ_n!wÆ ٲP(OKK?~III;… Ϧ;EQ .9uɓ'}]j9s!yyy۷oOHHzOLLܸqcqqV J999'O/!===gϞΦ(?{/^5kV{{;!7ҥK|`2Nv=ƍ˗/{T~~͛7kkk=<<!gΜ;vlAAAkkkKKKYY !D*=*jڵ"hƍsqq˫][PQl2]MMM ~*))),,Br1OOςŋBoܸ`n`&Laee^^^zԥ;!d"޽{o. !>}}}‚/_nii?IHHHHH $''?ϖR\\\zGjuYz//[n )z0G|>ǰX,V7fjJ;fkeccSRR'v=z輼 ```{r, echo = FALSE} knitr::opts_chunk$set( collapse = TRUE, comment = "#>", fig.path = "bench/fig-" ) ``` ```{r, echo = FALSE} library(ggplot2) ``` # Benchmarks These benchmarks compare pROC with competing ROC analysis packages in R. They can serve as a way to detect performance bottleneck that must be fixed, and possible regressions in performance. The benchmarking are carried out with the **microbenchmark** package and randomly generated data. The values of the `x` predictor variable are drawn from a normal distribution, resulting in every value being essentially unique. Predictor values for positive examples are increased to have a mean of 1, resulting in ROC curves with an AUC of 0.76. The benchmark code is adapted from the [cutpointr vignette by Christian Thiele](https://github.com/Thie1e/cutpointr/blob/master/vignettes/cutpointr.Rmd), released under a GPL-3 license. ## Building the ROC curve This first benchmark looks at the time needed to building the ROC curve only, and getting sensitivities, specificities and thresholds. Only packages allowing turn off the calculation of the AUC, or not computing it by default, were tested. ```{r, echo = FALSE} # Simply compute sensitivity, specificity and thresholds rocr_roc <- function(predictor, response) { pred <- ROCR::prediction(predictor, response) perf <- ROCR::performance(pred, "sens", "spec") se <- slot(perf, "y.values")[[1]] sp <- slot(perf, "x.values")[[1]] thr <- slot(perf, "alpha.values")[[1]] } proc_roc <- function(response, predictor) { r <- pROC::roc(response, predictor, algorithm = 2, levels = c(0, 1), direction = "<", auc = FALSE) se <- r$sensitivities sp <- r$specificities thr <- r$thresholds } ``` ```{r, echo = FALSE} n <- 1000 set.seed(123) dat <- data.frame(x = rnorm(n), y = sample(c(0:1), size = n, replace = TRUE)) dat$x <- dat$x + dat$y roc_bench_1000 <- microbenchmark::microbenchmark(unit = "ms", rocr_roc(dat$x, dat$y), proc_roc(dat$y, dat$x) ) n <- 10000 set.seed(123) dat <- data.frame(x = rnorm(n), y = sample(c(0:1), size = n, replace = TRUE)) dat$x <- dat$x + dat$y roc_bench_10000 <- microbenchmark::microbenchmark(unit = "ms", rocr_roc(dat$x, dat$y), proc_roc(dat$y, dat$x), times=50 ) n <- 1e5 set.seed(123) dat <- data.frame(x = rnorm(n), y = sample(c(0:1), size = n, replace = TRUE)) dat$x <- dat$x + dat$y roc_bench_1e5 <- microbenchmark::microbenchmark(unit = "ms", rocr_roc(dat$x, dat$y), proc_roc(dat$y, dat$x), times = 20 ) n <- 1e6 set.seed(123) dat <- data.frame(x = rnorm(n), y = sample(c(0:1), size = n, replace = TRUE)) dat$x <- dat$x + dat$y roc_bench_1e6 <- microbenchmark::microbenchmark(unit = "ms", rocr_roc(dat$x, dat$y), proc_roc(dat$y, dat$x), times = 15 ) n <- 1e7 set.seed(123) dat <- data.frame(x = rnorm(n), y = sample(c(0:1), size = n, replace = TRUE)) dat$x <- dat$x + dat$y roc_bench_1e7 <- microbenchmark::microbenchmark(unit = "ms", rocr_roc(dat$x, dat$y), proc_roc(dat$y, dat$x), times = 10 ) roc_results <- rbind( data.frame(time = summary(roc_bench_1000)$median, solution = summary(roc_bench_1000)$expr, n = 1000), data.frame(time = summary(roc_bench_10000)$median, solution = summary(roc_bench_10000)$expr, n = 10000), data.frame(time = summary(roc_bench_1e5)$median, solution = summary(roc_bench_1e5)$expr, n = 1e5), data.frame(time = summary(roc_bench_1e6)$median, solution = summary(roc_bench_1e6)$expr, n = 1e6), data.frame(time = summary(roc_bench_1e7)$median, solution = summary(roc_bench_1e7)$expr, n = 1e7) ) roc_results$solution <- as.character(roc_results$solution) roc_results$solution[grep(pattern = "rocr", x = roc_results$solution)] <- "ROCR" roc_results$solution[grep(pattern = "proc", x = roc_results$solution)] <- "pROC" ``` ```{r, echo = FALSE} ggplot(roc_results, aes(x = n, y = time, col = solution, shape = solution)) + geom_point(size = 3) + geom_line() + scale_y_log10(breaks = c(3, 5, 10, 25, 100, 250, 1000, 5000, 1e4, 15000)) + scale_x_log10(breaks = c(1000, 1e4, 1e5, 1e6, 1e7)) + ggtitle("ROC building benchmark results", "n = 1000, 10000, 1e5, 1e6, 1e7") + ylab("Median time (milliseconds, log scale)") + xlab("n (log scale)") ``` ```{r, echo = FALSE} res_table <- tidyr::spread(roc_results, solution, time) knitr::kable(res_table) ``` ## AUC This benchmark tests how long it takes to calculate the ROC curve and the area under the ROC curve (AUC). ```{r, echo = FALSE} # Calculate the AUC rocr_auc <- function(predictor, response) { pred <- ROCR::prediction(predictor, response) perf <- ROCR::performance(pred, measure = "auc") perf@y.values[[1]] } proc_auc <- function(response, predictor) { r <- pROC::roc(response, predictor, algorithm = 2, levels = c(0, 1), direction = "<") r$auc } prroc_auc <- function(positives, negatives) { r <- PRROC::roc.curve(positives, negatives) r$auc } epi_auc <- function(predictor, response) { e <- Epi::ROC(predictor, response, plot=FALSE) e$AUC } ``` ```{r, echo = FALSE} n <- 1000 set.seed(123) dat <- data.frame(x = rnorm(n), y = sample(c(0:1), size = n, replace = TRUE)) dat$x <- dat$x + dat$y negatives <- dat$x[dat$y == 0] positives <- dat$x[dat$y == 1] auc_bench_1000 <- microbenchmark::microbenchmark(unit = "ms", rocr_roc(dat$x, dat$y), proc_roc(dat$y, dat$x), prroc_auc(positives, negatives), epi_auc(dat$x, dat$y) ) n <- 10000 set.seed(123) dat <- data.frame(x = rnorm(n), y = sample(c(0:1), size = n, replace = TRUE)) dat$x <- dat$x + dat$y negatives <- dat$x[dat$y == 0] positives <- dat$x[dat$y == 1] auc_bench_10000 <- microbenchmark::microbenchmark(unit = "ms", rocr_roc(dat$x, dat$y), proc_roc(dat$y, dat$x), prroc_auc(positives, negatives), epi_auc(dat$x, dat$y), times=50 ) n <- 1e5 set.seed(123) dat <- data.frame(x = rnorm(n), y = sample(c(0:1), size = n, replace = TRUE)) dat$x <- dat$x + dat$y negatives <- dat$x[dat$y == 0] positives <- dat$x[dat$y == 1] auc_bench_1e5 <- microbenchmark::microbenchmark(unit = "ms", rocr_roc(dat$x, dat$y), proc_roc(dat$y, dat$x), prroc_auc(positives, negatives), epi_auc(dat$x, dat$y), times = 20 ) n <- 1e6 set.seed(123) dat <- data.frame(x = rnorm(n), y = sample(c(0:1), size = n, replace = TRUE)) dat$x <- dat$x + dat$y negatives <- dat$x[dat$y == 0] positives <- dat$x[dat$y == 1] auc_bench_1e6 <- microbenchmark::microbenchmark(unit = "ms", rocr_roc(dat$x, dat$y), proc_roc(dat$y, dat$x), prroc_auc(positives, negatives), epi_auc(dat$x, dat$y), times = 15 ) n <- 1e7 set.seed(123) dat <- data.frame(x = rnorm(n), y = sample(c(0:1), size = n, replace = TRUE)) dat$x <- dat$x + dat$y negatives <- dat$x[dat$y == 0] positives <- dat$x[dat$y == 1] auc_bench_1e7 <- microbenchmark::microbenchmark(unit = "ms", rocr_roc(dat$x, dat$y), proc_roc(dat$y, dat$x), prroc_auc(positives, negatives), times = 10 ) auc_results <- rbind( data.frame(time = summary(auc_bench_1000)$median, solution = summary(auc_bench_1000)$expr, n = 1000), data.frame(time = summary(auc_bench_10000)$median, solution = summary(auc_bench_10000)$expr, n = 10000), data.frame(time = summary(auc_bench_1e5)$median, solution = summary(auc_bench_1e5)$expr, n = 1e5), data.frame(time = summary(auc_bench_1e6)$median, solution = summary(auc_bench_1e6)$expr, n = 1e6), data.frame(time = summary(auc_bench_1e7)$median, solution = summary(auc_bench_1e7)$expr, n = 1e7) ) auc_results$solution <- as.character(auc_results$solution) auc_results$solution[grep(pattern = "epi", x = auc_results$solution)] <- "Epi" auc_results$solution[grep(pattern = "prroc", x = auc_results$solution)] <- "PRROC" auc_results$solution[grep(pattern = "rocr", x = auc_results$solution)] <- "ROCR" auc_results$solution[grep(pattern = "proc", x = auc_results$solution)] <- "pROC" ``` ```{r, echo = FALSE} ggplot(auc_results, aes(x = n, y = time, col = solution, shape = solution)) + geom_point(size = 3) + geom_line() + scale_y_log10(breaks = c(3, 5, 10, 25, 100, 250, 1000, 5000, 1e4, 15000)) + scale_x_log10(breaks = c(1000, 1e4, 1e5, 1e6, 1e7)) + ggtitle("ROC building benchmark results", "n = 1000, 10000, 1e5, 1e6, 1e7") + ylab("Median time (milliseconds, log scale)") + xlab("n (log scale)") ``` ```{r, echo = FALSE} res_table <- tidyr::spread(auc_results, solution, time) knitr::kable(res_table) ``` ## Best threshold Benchmarks packages that extract the "best" threshold. At the moment they all use the Youden index. This includes building the ROC curve first. ```{r, echo = FALSE} # Get the best threshold as a numeric value proc_best <- function(response, predictor) { r <- pROC::roc(response, predictor, algorithm = 2, levels = c(0, 1), direction = "<") pROC::coords(r, "best", ret="threshold", drop=TRUE) } cutpointr_best <- function(data, predictor_name, response_name) { cu <- cutpointr::cutpointr_(data, predictor_name, response_name, pos_class = 1, neg_class = 0, direction = ">=", metric = cutpointr::youden, break_ties = mean) cu[,"optimal_cutpoint", drop=TRUE] } optimalcutpoints_best <- function(data, predictor_name, response_name) { o <- OptimalCutpoints::optimal.cutpoints(predictor_name, response_name, data=data, tag.healthy = 0, methods = "Youden") o$Youden$Global$optimal.cutoff$cutoff } thresholdroc_best <- function(negatives, positives) { tr <- ThresholdROC::thres2(negatives, positives, rho = 0.5, method = "empirical", ci = FALSE) tr$T$thres } ``` ```{r, echo = FALSE} n <- 100 set.seed(123) dat <- data.frame(x = rnorm(n), y = sample(c(0:1), size = n, replace = TRUE)) dat$x <- dat$x + dat$y positives <- dat$x[dat$y == 1] negatives <- dat$x[dat$y == 0] best_bench_100 <- microbenchmark::microbenchmark( proc_best(dat$y, dat$x), cutpointr_best(dat, "x", "y"), optimalcutpoints_best(dat, "x", "y"), thresholdroc_best(negatives, positives), unit = "ms" ) n <- 1000 set.seed(123) dat <- data.frame(x = rnorm(n), y = sample(c(0:1), size = n, replace = TRUE)) dat$x <- dat$x + dat$y positives <- dat$x[dat$y == 1] negatives <- dat$x[dat$y == 0] best_bench_1000 <- microbenchmark::microbenchmark( proc_best(dat$y, dat$x), cutpointr_best(dat, "x", "y"), optimalcutpoints_best(dat, "x", "y"), thresholdroc_best(negatives, positives), unit = "ms" ) n <- 10000 set.seed(123) dat <- data.frame(x = rnorm(n), y = sample(c(0:1), size = n, replace = TRUE)) dat$x <- dat$x + dat$y positives <- dat$x[dat$y == 1] negatives <- dat$x[dat$y == 0] best_bench_10000 <- microbenchmark::microbenchmark( proc_best(dat$y, dat$x), cutpointr_best(dat, "x", "y"), optimalcutpoints_best(dat, "x", "y"), thresholdroc_best(negatives, positives), times = 20, unit = "ms" ) n <- 1e5 set.seed(123) dat <- data.frame(x = rnorm(n), y = sample(c(0:1), size = n, replace = TRUE)) dat$x <- dat$x + dat$y positives <- dat$x[dat$y == 1] negatives <- dat$x[dat$y == 0] best_bench_1e5 <- microbenchmark::microbenchmark( proc_best(dat$y, dat$x), cutpointr_best(dat, "x", "y"), times = 20, unit = "ms" ) n <- 1e6 set.seed(123) dat <- data.frame(x = rnorm(n), y = sample(c(0:1), size = n, replace = TRUE)) dat$x <- dat$x + dat$y best_bench_1e6 <- microbenchmark::microbenchmark( proc_best(dat$y, dat$x), cutpointr_best(dat, "x", "y"), times = 10, unit = "ms" ) n <- 1e7 set.seed(123) dat <- data.frame(x = rnorm(n), y = sample(c(0:1), size = n, replace = TRUE)) dat$x <- dat$x + dat$y best_bench_1e7 <- microbenchmark::microbenchmark( proc_best(dat$y, dat$x), cutpointr_best(dat, "x", "y"), times = 10, unit = "ms" ) best_results <- rbind( data.frame(time = summary(best_bench_100)$median, solution = summary(best_bench_100)$expr, n = 100), data.frame(time = summary(best_bench_1000)$median, solution = summary(best_bench_1000)$expr, n = 1000), data.frame(time = summary(best_bench_10000)$median, solution = summary(best_bench_10000)$expr, n = 10000), data.frame(time = summary(best_bench_1e5)$median, solution = summary(best_bench_1e5)$expr, n = 1e5), data.frame(time = summary(best_bench_1e6)$median, solution = summary(best_bench_1e6)$expr, n = 1e6), data.frame(time = summary(best_bench_1e7)$median, solution = summary(best_bench_1e7)$expr, n = 1e7) ) best_results$solution <- as.character(best_results$solution) best_results$solution[grep(pattern = "cutpointr", x = best_results$solution)] <- "cutpointr" best_results$solution[grep(pattern = "optimalcutpoints", x = best_results$solution)] <- "OptimalCutpoints" best_results$solution[grep(pattern = "proc", x = best_results$solution)] <- "pROC" best_results$solution[grep(pattern = "thresholdroc", x = best_results$solution)] <- "ThresholdROC" ``` ```{r, echo = FALSE} ggplot(best_results, aes(x = n, y = time, col = solution, shape = solution)) + geom_point(size = 3) + geom_line() + scale_y_log10(breaks = c(3, 5, 10, 25, 100, 250, 1000, 5000, 1e4, 15000)) + scale_x_log10(breaks = c(100, 1000, 1e4, 1e5, 1e6, 1e7)) + ggtitle("Benchmark results", "n = 1000, 10000, 1e5, 1e6, 1e7") + ylab("Median time (milliseconds, log scale)") + xlab("n (log scale)") ``` ```{r, echo = FALSE} res_table <- tidyr::spread(best_results, solution, time) knitr::kable(res_table) ```