test-are-paired.R
In pROC: Display and Analyze ROC Curves

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