tests/testthat/test-CRAN.R

In tdhock/aum: Area Under Minimum of False Positives and Negatives

library(testthat)
ggcost <- function(){
  if(interactive() && require("ggplot2") && require("data.table")){
    prob.vec <- unique(models$example)
    gg.dt <- data.table(problem=prob.vec+1L)[, {
      data.table(log.pen=seq(-2, 2, by=0.5))[, {
        predictions[problem] <- log.pen
        L <- aum::aum(models, predictions)
        with(L, data.table(aum))
      }, by=log.pen]
    }, by=problem]
    ggplot()+
      geom_vline(aes(
        xintercept=predictions),
        data=data.table(predictions, problem=seq_along(predictions)))+
      geom_point(aes(
        log.pen, aum),
        data=gg.dt)+
      theme_bw()+
      theme(panel.spacing=grid::unit(0, "lines"))+
      facet_grid(problem ~ .)+
      coord_equal()
  }
}
diffs <- function(...){
  L <- list(...)
  for(example.i in seq_along(L)){
    L[[example.i]]$example <- example.i-1L
  }
  do.call(rbind, L)
}


models <- diffs(
  data.frame(fp_diff=1,
             fn_diff=0,
             pred   =0),
  data.frame(fp_diff=0,
             fn_diff=-1,
             pred=0))
predictions <- c(a=1, b=-1)
ggcost()
test_that("aum=2 diff 1fp[1,1] 1fn[-1,-1]", {
  L <- aum::aum(models, predictions)
  expect_equal(L$aum, 2)
  expect_identical(rownames(L$derivative_mat), c("a","b"))
  expect_equal(L$derivative_mat[1,], c(1,1))
  expect_equal(L$derivative_mat[2,], c(-1,-1))
})

predictions <- c(0,0)
ggcost()
test_that("aum=0 nondiff 1fp[0,1] 1fn[-1,0]", {
  L <- aum::aum(models, predictions)
  expect_equal(L$aum, 0)
  expect_equal(L$derivative_mat[1,], c(0,1))
  expect_equal(L$derivative_mat[2,], c(-1,0))
})

predictions <- c(-1, 1)
ggcost()
test_that("aum=0 diff 1fp[0,0] 1fn[0,0]", {
  (L <- aum::aum(models, predictions))
  expect_equal(L$aum, 0)
  expect_equal(L$derivative_mat[1,], c(0,0))
  expect_equal(L$derivative_mat[2,], c(0,0))
})

models <- diffs(
  data.frame(fp_diff=c( 1,-1, 1),
             fn_diff=c( 0, 0, 0),
             pred=   c(-1, 0, 1)),
  data.frame(fp_diff=c( 0, 0, 0),
             fn_diff=c(-1, 1,-1),
             pred=   c(-1, 0, 1)))
predictions <- c(0,1)
ggcost()
test_that("aum=1 noncvx 1fp[1,-1] 1fn[1,-1]", {
  (L <- aum::aum(models, predictions))
  expect_equal(L$aum, 1)
  expect_equal(L$derivative_mat[1,], c(1, -1))
  expect_equal(L$derivative_mat[2,], c(1, -1))
})

predictions <- c(0,0)
ggcost()
test_that("aum=0 1fp[-1,2] 1fn[-2,1]", {
  (L <- aum::aum(models, predictions))
  expect_equal(L$aum, 0)
  expect_equal(L$derivative_mat[1,], c(-1, 2))
  expect_equal(L$derivative_mat[2,], c(-2, 1))
})

predictions <- c(-1,1)
ggcost()
test_that("aum=0 1fp[0,1] 1fn[-1,0]", {
  L <- aum::aum(models, predictions)
  expect_equal(L$aum, 0)
  expect_equal(L$derivative_mat[1,], c(0, 1))
  expect_equal(L$derivative_mat[2,], c(-1, 0))
})

models <- diffs(
  data.frame(fp_diff=1,
             fn_diff=0,
             pred   =0),
  data.frame(fp_diff=0,
             fn_diff=-1,
             pred   =0),
  data.frame(fp_diff=1,
             fn_diff=0,
             pred   =0))
predictions <- c(0,0,0)
ggcost()
test_that("1fp[0,1] 1fn[-1,0] 1fp[0,1]", {
  L <- aum::aum(models, predictions)
  expect_equal(L$aum, 0)
  expect_equal(L$derivative_mat[1,], c(0,1))
  expect_equal(L$derivative_mat[2,], c(-1,0))
  expect_equal(L$derivative_mat[3,], c(0,1))
})

models <- diffs(
  data.frame(fp_diff=1,
             fn_diff=0,
             pred   =0),
  data.frame(fp_diff=0,
             fn_diff=-2,
             pred   =0),
  data.frame(fp_diff=1,
             fn_diff=0,
             pred   =0))
predictions <- c(0,0,0)
ggcost()
test_that("1fp[0,1] 2fn[-2,0] 1fp[0,1]", {
  L <- aum::aum(models, predictions)
  expect_equal(L$aum, 0)
  expect_equal(L$derivative_mat[1,], c(0,1))
  expect_equal(L$derivative_mat[2,], c(-2,0))
  expect_equal(L$derivative_mat[3,], c(0,1))
})

models <- diffs(
  data.frame(fp_diff=2,
             fn_diff=0,
             pred   =0),
  data.frame(fp_diff=0,
             fn_diff=-1,
             pred   =0),
  data.frame(fp_diff=c(0,1,1),
             fn_diff=c(-1,-1,0),
             pred   =c(-1,0,1)))
predictions <- c(0,0,0)
ggcost()
test_that("2fp[0,2] 1fn[-1,0] 2fp2fn(0)[-1,1]", {
  L <- aum::aum(models, predictions)
  expect_equal(L$aum, 0)
  expect_equal(L$derivative_mat[1,], c(0,2))
  expect_equal(L$derivative_mat[2,], c(-1,0))
  expect_equal(L$derivative_mat[3,], c(-1,1))
})

predictions <- c(0,0,-1)
ggcost()
test_that("2fp[1,2] 1fn[-1,0] 2fp2fn(1)[-2,-1]", {
  L <- aum::aum(models, predictions)
  expect_equal(L$aum, 1)
  expect_equal(L$derivative_mat[1,], c(1,2))
  expect_equal(L$derivative_mat[2,], c(-1,0))
  expect_equal(L$derivative_mat[3,], c(-2,-1))
})

models <- diffs(
  data.frame(fp_diff=4,
             fn_diff=0,
             pred   =0),
  data.frame(fp_diff=0,
             fn_diff=-1,
             pred   =0),
  data.frame(fp_diff=c(0,1,1),
             fn_diff=c(-1,-1,0),
             pred   =c(-1,0,1)))
predictions <- c(1,0,0)
ggcost()
test_that("4fp[2,3] 1fn[-1,-1] 2fp2fn[-2,-1]", {
  L <- aum::aum(models, predictions)
  expect_equal(L$derivative_mat[1,], c(2,3))
  expect_equal(L$derivative_mat[2,], c(-1,-1))
  expect_equal(L$derivative_mat[3,], c(-2,-1))
})

bad.fn.diffs <- diffs(data.frame(
  fp_diff=1,
  fn_diff=1,
  pred   =0))
bad.fn.pred <- c(1,0,0)
test_that("error for fn<0", {
  expect_error({
    aum::aum(bad.fn.diffs, bad.fn.pred)
  }, "fn should be non-negative")
})

test_that("line search error for negative max FN", {
  line_search_input <- data.table(
    fp.diff = bad.fn.diffs$fp_diff, 
    fn.diff = bad.fn.diffs$fn_diff, 
    intercept = bad.fn.diffs$pred,
    slope = bad.fn.diffs$pred,
    key=c("intercept","slope"))
  expect_error({
    aum:::aumLineSearch(line_search_input, 0, maxStepSize=-1)
  }, "max FN should be positive")
})

bad.fp.diffs <- diffs(data.frame(
  fp_diff=-1,
  fn_diff=-1,
  pred   =0))
bad.fp.pred <- c(1,0,0)
test_that("error for fp<0", {
  expect_error({
    aum::aum(bad.fp.diffs, bad.fp.pred)
  }, "fp should be non-negative")
})

test_that("line search error for negative max FP", {
  line_search_input <- data.table(
    fp.diff = bad.fp.diffs$fp_diff, 
    fn.diff = bad.fp.diffs$fn_diff, 
    intercept = bad.fp.diffs$pred,
    slope = bad.fp.diffs$pred,
    key=c("intercept","slope"))
  expect_error({
    aum:::aumLineSearch(line_search_input, 0, maxStepSize=-1)
  }, "max FP should be positive")
})

models <- diffs(
  data.frame(fp_diff=1,
             fn_diff=0,
             pred   =-1),
  data.frame(fp_diff=0,
             fn_diff=-1,
             pred=1))
predictions <- c(0,0,0)
test_that("extra pred ok", {
  L <- aum::aum(models, predictions)
  expect_equal(L$aum, 2)
  expect_equal(L$derivative_mat[1,], c(1,1))
  expect_equal(L$derivative_mat[2,], c(-1,-1))
  expect_equal(L$derivative_mat[3,], c(0,0))
  other <- with(models, data.frame(example=example+1L, fp_diff, fn_diff, pred))
  L <- aum::aum(other, predictions)
  expect_equal(L$aum, 2)
  expect_equal(L$derivative_mat[1,], c(0,0))
  expect_equal(L$derivative_mat[2,], c(1,1))
  expect_equal(L$derivative_mat[3,], c(-1,-1))
})

test_that("error for example=length(predictions)", {
  other <- with(models, data.frame(example=example+2L, fp_diff, fn_diff, pred))
  expect_error({
    aum::aum(other, predictions)
  }, "example should be less than number of predictions")
})

test_that("error for example<0", {
  other <- with(models, data.frame(example=example-1L, fp_diff, fn_diff, pred))
  expect_error({
    aum::aum(other, predictions)
  }, "example should be non-negative")
})

test_that("error for no predictions", {
  expect_error({
    aum::aum(models, numeric())
  }, "need at least one prediction")
})

test_that("error for non-finite prediction", {
  expect_error({
    aum::aum(models, c(0,NA))
  }, "all predictions should be finite")
  expect_error({
    aum::aum(models, c(0,Inf))
  }, "all predictions should be finite")
})

models <- data.frame(
  example=integer(),
  fp_diff=numeric(),
  fn_diff=numeric(),
  pred   =numeric())
predictions <- c(1,0,0)
test_that("no diffs ok", {
  L <- aum::aum(models, predictions)
  expect_equal(L$aum, 0)
  expect_equal(L$derivative_mat[1,], c(0,0))
  expect_equal(L$derivative_mat[2,], c(0,0))
  expect_equal(L$derivative_mat[3,], c(0,0))
})

data(neg.zero.fp, package="aum")
test_that("no error for negative zero fp", {
  result <- with(neg.zero.fp, aum::aum(diffs, pred))
  expect_is(result, "list")
})