test_mbc.R
In comparer: Compare Output and Run Time

# library(testthat)

context("mbc tests")

test_that("mbc basic runs", {
  expect_error(m1 <- mbc(mean, median, input=rnorm(100)), regexp = NA)
  expect_is(m1, "mbc")
  expect_is(m1, "list")
  # expect_equal(length(m1), 5)

  # Get error when x not specified # No longer an error, actually works
  # expect_error(m1 <- mbc(mean, median, inputi={rnorm(100)}))
  # Test inputi
  expect_error(m1 <- mbc(mean(x), median(x), inputi={x=rnorm(100)}), regexp = NA)
  # Error if both input and inputi given it
  expect_error(m1 <- mbc(mean, median, input=rnorm(100), inputi={rnorm(100)}))
  # Give in names
  expect_error(m1 <- mbc(mean=mean(x), med=median(x), inputi={x=rnorm(100)}), regexp = NA)
  expect_equal(dimnames(m1$Output)[[1]], c("mean", "med"))
  # Give in only one name
  expect_error(m1 <- mbc(mean(x), med=median(x), inputi={x=rnorm(100)}), regexp = NA)
  expect_equal(dimnames(m1$Output)[[1]], c("mean(x)", "med"))
  # Check single name
  expect_error(m1 <- mbc(mean(2)), NA)
  expect_equal(dimnames(m1$Output)[[1]], c("mean(2)"))

  # Give in evaluator
  expect_error(m1 <- mbc(1, 2, evaluator={.}), regexp = NA)

  # Give in no input
  expect_error(m1 <- mbc(mean(rnorm(10)), median(rnorm(10))), regexp = NA)
  # Give in functions, no input
  expect_error(m1 <- mbc(function(x)mean(rnorm(10)), function(x)median(rnorm(10))), regexp = NA)

  # Try different times
  expect_error(m1 <- mbc(mean(x), median(x), inputi={x=rnorm(100)}, times=1), regexp = NA)
  expect_error(m1 <- mbc(mean(x), median(x), inputi={x=rnorm(100)}, times=2, target=.5), regexp = NA)
  expect_error(m1 <- mbc(mean(x), median(x), inputi={x=rnorm(100)}, times=20), regexp = NA)
  expect_error(m1 <- mbc(mean(x), median(x), inputi={x=rnorm(100)}, times=20, target=.5), regexp = NA)
  expect_true(length(capture.output(print(m1)))>1)

  # Check inputi as unnamed data
  expect_error(mbc(mean, inputi=rnorm(10)), NA)
  expect_error(mbc(mean, median, inputi={rexp(10)}), NA)
  # Check inputi as named single input no {}
  expect_error(mbc(mean(x), inputi=x <- rnorm(10)), NA)
  # Check inputi as list
  expect_error(mbc(mean, inputi=replicate(5, list(rnorm(10)))), NA)

  # Test evaluator
  expect_error(mbc(12, evaluator=function(., x) mean(.+x), input=13), NA)
  expect_error(mbc(12, evaluator=function() mean(.)), NA)

  expect_error(mbc(identity, function(x) x, inputi=12, times=3, post=12), NA)
  # This doesn't work anymore, need to put (x)
  expect_error(mbc(mean, median, input=rnorm(100), times=7, target=0))
  expect_error(mbc(mean(x), median(x), input=rnorm(100), times=7, target=0), NA)
  expect_error(mbc(mean(x), median(x), inputi=0:10, times=7, target=0), NA)

  # Test duplicate names
  expect_error(mbc(mean,mean,input=rnorm(3), times=2), NA)
  expect_error(mbc(mean,mean,mean,input=rnorm(3), times=2), NA)
  expect_error(mbc(m=mean,m=mean, m2=mean,input=rnorm(3), times=2), NA)
})

test_that("test mbc print", {
  # Basic with compare
  m1 <- mbc(mean, median, inputi=function(i)rnorm(100))
  # expect_error(print(m1), regexp = NA)
  expect_true(length(capture.output(print(m1)))>1)
})

test_that("test mbc metrics", {

  expect_error(m1 <- mbc(mean(x), median(x), inputi=function(i)rnorm(10)), NA)

  expect_error(m1 <- mbc(mean(x), median(x), inputi=function(i)rnorm(10), target=10), NA)
  # Give function for target
  expect_error(m1 <- mbc(mean(x), median(x), inputi=function(i)rnorm(10), target=function(i){i}), NA)
  expect_error(m1 <- mbc(mean(x), median(x), inputi=function(i)rnorm(10), target=list(1,2,3,4,5)), NA)

  # Test t and mis90 using lm
  x1 <- runif(10)
  x2 <- runif(10)
  y1 <- x1 * 1.2 + x2 * .43 - .76 + rnorm(10,0,.1)
  xdf <- data.frame(x1=runif(10), x2=runif(10))
  ydf <- with(xdf, x1 * 1.2 + x2 * .43 - .76 + rnorm(10,0,.1))
  # Just run, no compare of output
  expect_error(m1 <- mbc(lm(y1 ~ x1), lm(y1 ~ x1 + x2)), NA)
  expect_true(length(capture.output(print(m1)))>1)
  # Test target in
  expect_error(mbc(lm(y1 ~ x1), lm(y1 ~ x1 + x2), targetin = xdf, target=ydf), NA)
  # mbc(lm(y1 ~ x1), lm(y1 ~ x1 + x2), targetin = cbind(xdf, ydf), target="ydf")

  # Test t
  m1 <- mbc(lm(y1 ~ x1), lm(y1 ~ x1 + x2), target=ydf, metric="t", post=function(mod){predict(mod, xdf,se=T)})
  expect_true("Mean t" %in% m1$Output_disp$Stat)
  expect_true(length(capture.output(print(m1)))>1)

  # Test mis90
  m1 <- mbc(lm(y1 ~ x1), lm(y1 ~ x1 + x2), target=ydf, metric="mis90", post=function(mod){predict(mod, xdf,se=T)})
  expect_true("mis90" %in% m1$Output_disp$Stat)
  # Test giving in as function, list, and character as name from input
  expect_error(mbc(lm(y1 ~ x1), lm(y1 ~ x1 + x2), target=function(i) {ydf}, metric="mis90", post=function(mod){predict(mod, xdf,se=T)}), NA)
  expect_error(mbc(lm(y1 ~ x1), lm(y1 ~ x1 + x2), target=lapply(1:5, function(i)ydf), metric="mis90", post=function(mod){predict(mod, xdf,se=T)}), NA)
  expect_error(mbc(lm(y1 ~ x1), lm(y1 ~ x1 + x2), target="ydf", metric="mis90", input=list(ydf=ydf, x1=xdf$x1, x2=xdf$x2, y1=y1),post=function(mod){predict(mod, xdf,se=T)}), NA)
  expect_error(mbc(lm(y1 ~ x1), lm(y1 ~ x1 + x2), targetin=data.frame(ydf=ydf, x1=xdf$x1, x2=xdf$x2, y1=y1), target="ydf", metric="mis90", input=list(ydf=ydf, x1=xdf$x1, x2=xdf$x2, y1=y1)), NA)

  # t and mis90
  m1 <- mbc(lm(y1 ~ x1), lm(y1 ~ x1 + x2), target=ydf, metric=c("t","mis90"), post=function(mod){predict(mod, xdf,se=T)})
  expect_true(("mis90" %in% m1$Output_disp$Stat) && "Mean t" %in% m1$Output_disp$Stat)

  m1 <- mbc(lm(y1 ~ x1), lm(y1 ~ x1 + x2), target=ydf, metric=c("rmse","mis90","sr27"), post=function(mod){predict(mod, xdf,se=T)})
  expect_true(("mis90" %in% m1$Output_disp$Stat) && "rmse" %in% m1$Output_disp$Stat && "sr27" %in% m1$Output_disp$Stat)

})

test_that("mbc plot", {
  pdf(NULL) # Don't create Rplots.pdf file
  m1 <- mbc(mn={Sys.sleep(rexp(1,10));mean(x)},med= {Sys.sleep(rexp(1,20));median(x)}, inputi={x=rnorm(100)}, target=0)
  expect_error(plot(m1), NA)
})

test_that("kfold", {
  aa <- 1:10
  bb <- aa*1.8 + 10
  # Need to give in kfoldN
  expect_error(mbc(lm(y ~ x - 1), lm(y~x), inputi={x <- aa[ki];y <- bb[ki]}, kfold=TRUE))
  expect_error(mbc(lm(y ~ x - 1), lm(y~x), inputi={x <- aa[ki];y <- bb[ki]}, kfold=c(10,5)), NA)
  expect_error(mbc(lm(y ~ x - 1), lm(y~x), inputi={x <- aa[ki];y <- bb[ki]}, kfold=c(10,5), times=15, targetin = {data.frame(x=aa,y=bb)[-ki,]}, target='y'), NA)
  # expect_error(mbc(lm(y ~ x - 1), lm(y~x), inputi={x <- aa[ki];y <- bb[ki]}, kfold=5, kfoldN=10, post=predict(., data.frame(x=aa[-ki])), target=bb[-ki]), NA)
  # Check kfold=TRUE works
  expect_error(mbc(lm(y ~ x - 1), lm(y~x), inputi={x <- aa[ki];y <- bb[ki]}, kfold=c(10)), NA)
  # Check error for bad kfold
  expect_error(mbc(lm(y ~ x - 1), lm(y~x), inputi={x <- aa[ki];y <- bb[ki]}, kfold=c(10,3.3)))
  expect_error(mbc(lm(y ~ x - 1), lm(y~x), inputi={x <- aa[ki];y <- bb[ki]}, kfold=c(10,"5")))
  # Test post with expression
  expect_error(mbc(mean(x), inputi={x <- rnorm(100)[ki]}, kfold=c(100,5), post=.+max(ki)), NA)

})

test_that("non numeric", {
  # Logical
  expect_error(mbc(TRUE, times=8), NA)
  expect_error(mbc(x>.5, inputi=x <- runif(1)), NA)

  # Character
  expect_error(mbc("a"), NA)
  expect_error(mbc(letters[x], inputi=x <- sample(1:2,1), times=10), NA)
  expect_error(mbc(letters[x], letters[3-x], inputi=x <- sample(1:2,1), times=10), NA)

  # List
  expect_error(mbc(list(1,2)), NA)
})

# test_that("GauPro", {
#   # Trying to figure out better way to get input
#   m1 <- mbc(GauPro::Gaussian, GauPro::Matern52, times=2,
#       evaluator=GauPro::GauPro_kernel_model$new(X=x, Z=y, kernel=.)$predict(xp, se=T),
#       inputi={xp <- matrix(3,1,2)}, target=yp, metric='t')
#   expect_is(m1, "mbc")
# })