Added tests

R/mbc.R

@@ -58,7 +58,7 @@ mbc <- function(..., times=5, input, inputi, evaluator, post, target, targetin,
   if (!missing(kfold)) {
     if (is.logical(kfold) && kfold==TRUE) {
       folds <- times
-    } else if (kfold > 1) {
+    } else if (kfold > 1 && (kfold==as.integer(kfold))) {
       times <- folds <- kfold
     } else {
       stop("kfold must be TRUE or an integer")
@@ -187,17 +187,19 @@ mbc <- function(..., times=5, input, inputi, evaluator, post, target, targetin,
         } else { # Use evaluator, dots are input to evaluator to be evaluated
           # browser()
           # This time there is no input, so create it
-          input <- new.env()
+          inputenv <- new.env()
           expr_evaluator <- match.call(expand.dots = FALSE)$`evaluator`
-          input$. <- eval(dots[[i]]) #, envir=input)
+          inputenv$. <- eval(dots[[i]]) #, envir=input)
           runtime <- system.time(
             # out <- dots[[i]](input) # Old version, required functions
-            out <- eval(expr_evaluator, envir=input)
+            out <- eval(expr_evaluator, envir=inputenv)
           )
           if (is.function(out)) {#print("Trying second time")
+            # if (is.environment(input)) {input <- as.list(input)}
             runtime <- system.time(
               # out <- out(input)
-              out <- do.call(out, input)
+              # out <- do.call(out, input)
+              out <- eval(quote(out()), inputenv)
             )
           }
         }

scratch/scratch_mbc_kfold.R

@@ -0,0 +1,5 @@
+mbc(mean(x), median(x), inputi={x <- (1:10)[ki]}, kfold=2, kfoldN=10)
+aa <- 1:10
+bb <- aa*1.8 + 10
+mbc(lm(y ~ x - 1), lm(y~x), inputi={x <- aa[ki];y <- bb[ki]}, kfold=5, kfoldN=10)
+mbc(lm(y ~ x - 1), lm(y~x), inputi={x <- aa[ki];y <- bb[ki]}, kfold=5, kfoldN=10, targetin = {data.frame(x=aa,y=bb)[-ki,]}, target='y')

tests/testthat/test_mbc.R

@@ -20,6 +20,9 @@ test_that("mbc basic runs", {
   # 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)
@@ -35,6 +38,17 @@ test_that("mbc basic runs", {
   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_error(print(m1), NA)
+
+  # Check inputi as unnamed data
+  expect_error(mbc(mean, inputi=rnorm(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)
 })
 test_that("test mbc print", {
   # Basic with compare
@@ -88,6 +102,12 @@ test_that("kfold", {
   expect_error(mbc(lm(y ~ x - 1), lm(y~x), inputi={x <- aa[ki];y <- bb[ki]}, kfold=5))
   expect_error(mbc(lm(y ~ x - 1), lm(y~x), inputi={x <- aa[ki];y <- bb[ki]}, kfold=5, kfoldN=10), NA)
   expect_error(mbc(lm(y ~ x - 1), lm(y~x), inputi={x <- aa[ki];y <- bb[ki]}, kfold=5, kfoldN=10, 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=TRUE, kfoldN=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=3.3, kfoldN=10))
+  expect_error(mbc(lm(y ~ x - 1), lm(y~x), inputi={x <- aa[ki];y <- bb[ki]}, kfold="5", kfoldN=10))
 
 })