library(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", "lr_pos", "lr_neg", "youden", "closest.topleft") obtained <- coords(r.s100b, "all", ret = return.rows) expect_equal(obtained, expected.coords[, return.rows]) }) test_that("coords returns all thresholds by default", { obtained <- coords(r.s100b) 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 = TRUE works", { suppressWarnings({ 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, t(expected.coords[, return.rows])) obtained <- coords(r.s100b, transpose = TRUE) expect_equal(obtained, t(expected.coords[, c("threshold", "specificity", "sensitivity")])) # With drop=TRUE obtained <- coords(r.s100b, "all", ret = "se", transpose = TRUE, 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 = TRUE, drop = FALSE) expect_is(obtained, "matrix") }) }) test_that("coords with ret='all' works", { obtained <- coords(r.s100b, "all", ret = "all") expect_equal(dim(obtained), c(51, 26)) expect_equal(obtained[, colnames(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.cols <- 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) # Adjust for percent obtained.percent[, percent.cols] <- obtained.percent[, percent.cols] / 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) # 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) expected.thresholds <- c( -Inf, 0x1.0a3d70a3d70a4p-4, 0x1.3333333333334p-4, 0x1.5c28f5c28f5c2p-4, 0x1.851eb851eb852p-4, 0x1.ae147ae147ae2p-4, 0x1.d70a3d70a3d7p-4, 0x1.147ae147ae148p-3, 0x1.3d70a3d70a3d7p-3, 0x1.a3d70a3d70a3ep-3, 0x1.f5c28f5c28f5cp-3, 0x1.28f5c28f5c29p-2, 0x1.4cccccccccccdp-2, 0x1.6147ae147ae14p-2, 0x1.947ae147ae148p-2, 0x1.bd70a3d70a3d7p-2, 0x1.e666666666666p-2, 0x1.f0a3d70a3d70ap-2, 0x1.051eb851eb852p-1 ) 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) expect_equivalent(obtained, expected.coords[abs(expected.coords[, "threshold"] - 0.205) < 0.001, , drop = FALSE]) }) 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) expect_equivalent(obtained, expected.coords[c(18, 4), return.rows]) }) 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) expect_equivalent(obtained[, -1], expected.coords[c(3, 40), -1]) }) test_that("coords with arbitrary thresholds works with direction=>", { obtained <- coords(r.s100b.reversed, c(0.05, 0.055, 0.205, 0.52), input = "threshold", ret = "all") 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) expect_equivalent(obtained, expected.coords[18, , drop = FALSE]) }) 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") expect_equivalent(obtained[, -1], expected.coords[3, -1]) obtained <- coords(r.s100b, c(0.52), input = "threshold", ret = "all") expect_equivalent(obtained[, -1], expected.coords[40, -1]) }) test_that("coords with arbitrary thresholds works with direction=>", { obtained <- coords(r.s100b.reversed, c(0.05), input = "threshold", ret = "all") expect_equivalent(obtained, expected.coords.reverse[1, ]) obtained <- coords(r.s100b.reversed, c(0.055), input = "threshold", ret = "all") expect_equivalent(obtained, expected.coords.reverse[2, ]) obtained <- coords(r.s100b.reversed, c(0.205), input = "threshold", ret = "all") expect_equivalent(obtained, expected.coords.reverse[3, ]) obtained <- coords(r.s100b.reversed, c(0.52), input = "threshold", ret = "all") expect_equivalent(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")) expect_equal(obtained[, "threshold"], c(Inf, rep(NA, 9), -Inf)) expect_equal(obtained[, "sensitivity"], seq(0, 1, .1)) expect_equal(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")) expect_equal(obtained[, "threshold"], c(Inf, rep(NA, 9), -Inf)) expect_equal(obtained[, "sensitivity"], seq(0, 100, 10)) expect_equal(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")) expect_equal(obtained[, "threshold"], c(-Inf, rep(NA, 9), 0.51)) expect_equal(obtained[, "specificity"], seq(0, 1, .1)) expect_equal(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")) expect_equal(obtained[, "threshold"], c(-Inf, rep(NA, 9), 0.51)) expect_equal(obtained[, "specificity"], seq(0, 100, 10)) expect_equal(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("drop works", { suppressWarnings({ # 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("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" ) ) 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" ) ) # We assume the following values: # tp fp tn fn N # 26 14 58 15 113 expected <- data.frame( 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_equivalent(obtained, expected) expect_equivalent(obtained.percent[, 1:5], expected[, 1:5]) expect_equivalent(obtained.percent[, 6:17], expected[, 6:17] * 100) }) test_that("coords works with smooth.roc and x = 'best' and transpose=TRUE", { suppressWarnings({ 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, 2.4428179690470926, 0.52125683157286817, 1.35946774343758, 0.215257834650296 ), .Dim = c(25L, 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", "lr_pos", "lr_neg", "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) expect_warning(obtained <- coords(smooth.s100b, "best", ret = "all", as.list = TRUE), "as.list") expect_equal(obtained, as.list(expect[, 1])) expect_equal(names(obtained), rownames(expect)) expect_warning(obtained <- coords(smooth.s100b, "best", ret = "all", as.list = TRUE, drop = FALSE), "as.list") expect_equal(obtained[[1]], as.list(expect[, 1])) # names expect_equal(names(obtained[[1]]), rownames(expect)) expect_warning(obtained <- coords(smooth.s100b, "best", ret = reduced.cols, as.list = TRUE), "as.list") expect_equal(obtained, as.list(expect[reduced.cols, 1])) expect_equal(names(obtained), reduced.cols) expect_warning(obtained <- coords(smooth.s100b, "best", ret = reduced.cols, as.list = TRUE, drop = FALSE), "as.list") 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", { suppressWarnings({ 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, 2.4428179690470926, 0.52125683157286817, 1.35946774343758, 0.215257834650296 ), .Dim = c(25L, 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", "lr_pos", "lr_neg", "youden", "closest.topleft" ), NULL)) reduced.cols <- c("specificity", "sensitivity", "youden") obtained <- coords(smooth.s100b, "best", ret = reduced.cols) expect_equal(obtained, as.data.frame(t(expect[reduced.cols, , drop = FALSE]))) obtained <- coords(smooth.s100b, "best", ret = "all", drop = FALSE) expect_equal(obtained, as.data.frame(t(expect))) # Without drop obtained <- coords(smooth.s100b, "best", ret = reduced.cols) expect_equivalent(obtained, as.data.frame(t(expect[reduced.cols, ]))) # drop = TRUE expect_warning(obtained <- coords(smooth.s100b, "best", ret = reduced.cols, drop = TRUE)) expect_equal(obtained, as.list(expect[reduced.cols, ])) # With as.matrix expect_warning(obtained <- coords(smooth.s100b, "best", ret = reduced.cols, as.matrix = TRUE)) expect_equal(obtained, t(expect[reduced.cols, , drop = FALSE])) # With matrix and drop = TRUE expect_warning(obtained <- coords(smooth.s100b, "best", ret = reduced.cols, 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") 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(list( specificity = c(0.5, 0.90000000000000002), sensitivity = c( 0.79774939210378937, 0.41207187155396763 ), accuracy = c(0.60803296527659623, 0.72296413038683782), tn = c(36, 64.799999999999997), tp = c( 32.707725076255365, 16.894946733712672 ), fn = c(8.2922749237446354, 24.105053266287328), fp = c(36, 7.2000000000000028), npv = c( 0.81278281736440605, 0.72886745600288694 ), ppv = c(0.47604145006918286, 0.70118215742199363), fdr = c(0.52395854993081703, 0.29881784257800637), fpr = c( 0.5, 0.099999999999999978 ), tpr = c(0.79774939210378937, 0.41207187155396763), tnr = c(0.5, 0.90000000000000002), fnr = c( 0.20225060789621063, 0.58792812844603237 ), `1-specificity` = c(0.5, 0.099999999999999978), `1-sensitivity` = c(0.20225060789621063, 0.58792812844603237), `1-accuracy` = c(0.39196703472340377, 0.27703586961316218), `1-npv` = c(0.18721718263559395, 0.27113254399711306), `1-ppv` = c( 0.52395854993081714, 0.29881784257800637 ), precision = c( 0.47604145006918286, 0.70118215742199363 ), recall = c(0.79774939210378937, 0.41207187155396763), lr_pos = c(1.5954987842075787, 4.1207187155396774), lr_neg = c( 0.40450121579242126, 0.65325347605114703 ), youden = c(1.2977493921037895, 1.3120718715539677), closest.topleft = c(0.29090530839438672, 0.35565948421805432) ), class = "data.frame", row.names = c(NA, -2L)) reduced.cols <- c("specificity", "sensitivity", "youden") obtained <- coords(smooth.s100b, c(0.5, 0.9), input = "sp", ret = "all") expect_equal(obtained, expect) obtained <- coords(smooth.s100b, c(0.5, 0.9), input = "spe", ret = reduced.cols) expect_equal(obtained, expect[, reduced.cols]) obtained <- coords(smooth.s100b, 0.9, input = "specificity", ret = "all") expect_equivalent(obtained, expect[2, , drop = FALSE]) obtained <- coords(smooth.s100b, 0.9, input = "specificity", ret = reduced.cols) expect_equivalent(obtained, expect[2, reduced.cols]) obtained <- coords(smooth.s100b, 0.9, input = "specificity", ret = reduced.cols) expect_equivalent(obtained, expect[2, reduced.cols, drop = FALSE]) }) test_that("coords works with smooth.roc and x = numeric and input = 'se'", { smooth.s100b <- smooth(r.s100b) expect <- structure(list( specificity = c(0.84418934548477731, 0.29332202419872122), sensitivity = c(0.5, 0.90000000000000002), accuracy = c( 0.7193064856186191, 0.51344412161334452 ), tn = c(60.781632874903963, 21.119185742307927), tp = c(20.5, 36.899999999999999), fn = c(20.5, 4.1000000000000014), fp = c(11.218367125096037, 50.880814257692073), npv = c( 0.74779049983468704, 0.83742536171095305 ), ppv = c(0.64631322032274796, 0.42036520522212539), fdr = c(0.35368677967725209, 0.57963479477787461), fpr = c( 0.15581065451522269, 0.70667797580127878 ), tpr = c(0.5, 0.90000000000000002), tnr = c( 0.84418934548477731, 0.29332202419872122 ), fnr = c(0.5, 0.10000000000000003), `1-specificity` = c( 0.15581065451522269, 0.70667797580127878 ), `1-sensitivity` = c(0.5, 0.099999999999999978), `1-accuracy` = c(0.2806935143813809, 0.48655587838665548), `1-npv` = c(0.25220950016531296, 0.16257463828904695), `1-ppv` = c( 0.35368677967725204, 0.57963479477787461 ), precision = c( 0.64631322032274796, 0.42036520522212539 ), recall = c(0.5, 0.90000000000000002), lr_pos = c(3.2090231669693039, 1.2735645241802247), lr_neg = c( 0.59228418680512263, 0.34092223477992739 ), youden = c(1.3441893454847773, 1.1933220241987212), closest.topleft = c(0.27427696006046209, 0.50939376148259274) ), class = "data.frame", row.names = c(NA, -2L)) reduced.cols <- c("specificity", "sensitivity", "youden") obtained <- coords(smooth.s100b, c(0.5, 0.9), input = "se", ret = "all") expect_equal(obtained, expect) obtained <- coords(smooth.s100b, c(0.5, 0.9), input = "se", ret = reduced.cols) expect_equal(obtained, expect[, reduced.cols]) obtained <- coords(smooth.s100b, 0.9, input = "se", ret = "all") expect_equivalent(obtained, expect[2, , drop = FALSE]) obtained <- coords(smooth.s100b, 0.9, input = "se", ret = reduced.cols) expect_equivalent(obtained, expect[2, reduced.cols, drop = FALSE]) }) test_that("coords with x = 'best' takes partial AUC into account", { # with sp obtained <- coords(r.s100b.partial1, "b", ret = "t") expect_equal(obtained$threshold, 0.475) # with se obtained <- coords(r.s100b.partial2, "b", ret = "t") expect_equal(obtained$threshold, 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") expect_equal(obtained$specificity, 0.900608847772859) obtained <- coords(smooth(r.s100b.partial1), "b", ret = c("se", "se", "youden")) expect_equivalent(as.vector(obtained), c(0.410958904109589, 0.410958904109589, 1.311567751882448)) # with se obtained <- coords(smooth(r.s100b.partial2), "b", ret = "se") expect_equal(obtained$sensitivity, 0.900195694716243) obtained <- coords(smooth(r.s100b.partial2), "b", ret = c("se", "se", "youden")) expect_equivalent(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 = c("t", "se", "sp")) expect_equal(dim(obtained), c(9, 3)) expect_equivalent(obtained[1, ], c(NA, 0.3902439, 0.9)) expect_equivalent(obtained[9, ], c(NA, 0.292682926, 0.99)) # with se obtained <- coords(r.s100b.partial2, "all", ret = c("t", "se", "sp")) expect_equal(dim(obtained), c(7, 3)) expect_equivalent(obtained[1, ], c(NA, 0.99, 0.0)) expect_equivalent(obtained[7, ], c(NA, 0.9, 0.230555555555556)) }) test_that("coords with ignore.partial.auc = TRUE ignores partial AUC", { # with sp obtained <- coords(r.s100b.partial1, "all", ret = "t", ignore.partial.auc = TRUE) expect_equal(dim(obtained), c(51, 1)) # with se obtained <- coords(r.s100b.partial2, "all", ret = "t", ignore.partial.auc = TRUE) expect_equal(dim(obtained), c(51, 1)) }) 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") expect_equal(dim(obtained), c(141, 1)) expect_equal(min(obtained), 0.9) expect_equal(max(obtained), 0.99) # with se obtained <- coords(smooth(r.s100b.partial2), "all", ret = "se") expect_equal(dim(obtained), c(48, 1)) expect_equal(min(obtained), 0.9) expect_equal(max(obtained), 0.99) }) test_that("coords with ignore.partial.auc = TRUE ignores partial AUC of smooth.roc", { # with sp obtained <- coords(smooth(r.s100b.partial1), "all", ret = "sp", ignore.partial.auc = TRUE) expect_equal(dim(obtained), c(514, 1)) # with se obtained <- coords(smooth(r.s100b.partial2), "all", ret = "se", ignore.partial.auc = TRUE) expect_equal(dim(obtained), c(514, 1)) }) test_that("coords with x = 'local maximas' takes partial AUC into account", { # with sp obtained <- coords(r.s100b.partial1, "local maximas", ret = "t") expect_equal(obtained$threshold, c(0.435, 0.475, 0.485)) # with se obtained <- coords(r.s100b.partial2, "local maximas", ret = "t") expect_equal(obtained$threshold, c(0.065, 0.075)) }) test_that("invalid best.weights", { expect_error(coords(r.s100b, "best", best.weights = 1)) expect_error(coords(r.s100b, "best", best.weights = 0:1)) expect_error(coords(r.s100b, "best", best.weights = c(0.1, 0.9)), NA) expect_error(coords(r.s100b, "best", best.weights = 1:3)) # with smooth expect_error(coords(smooth(r.s100b), "best", best.weights = 1)) expect_error(coords(smooth(r.s100b), "best", best.weights = 0:1)) expect_error(coords(smooth(r.s100b), "best", best.weights = c(0.1, 0.9)), NA) expect_error(coords(smooth(r.s100b), "best", best.weights = 1:3)) }) test_that("invalid best.method", { expect_error(coords(r.s100b, "best", best.method = 1)) expect_error(coords(r.s100b, "best", best.method = "1")) # with smooth expect_error(coords(smooth(r.s100b), "best", best.method = 1)) expect_error(coords(smooth(r.s100b), "best", best.method = "1")) }) 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)) expect_error(coords(r, x = 0, input = inp), NA) expect_error(coords(r, x = 1, input = inp), NA) expect_error(coords(r, x = 10, input = inp)) } } 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)) expect_error(coords(r.s100b.percent, x = 0, input = inp), NA) expect_error(coords(r.s100b.percent, x = 10, input = inp), NA) expect_error(coords(r.s100b.percent, x = 100, input = inp), NA) expect_error(coords(r.s100b.percent, x = 101, input = inp)) } } }) test_that("invalid x", { expect_error(coords(r.s100b.percent, x = list(1))) expect_error(coords(r.s100b, x = aSAH)) expect_error(coords(smooth(r.s100b), x = mean)) # character but invalid expect_error(coords(smooth(r.s100b), x = "c")) expect_error(coords(r.s100b, x = "c")) }) 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)) 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)) 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"), 0.13888888888888889 # and not 0 ) expect_equivalent( coords(r.s100b, 1, "sp", "se"), 0.2926829268292683 # and not 0 ) })