update unit tests for factors and binary y

dashaub · Sep 30, 2016 · a889d7d · a889d7d
1 parent 32ae4f3
commit a889d7d
Showing 1 changed file with 30 additions and 10 deletions.
diff --git a/tests/testthat/test-supervisedPRIM.R b/tests/testthat/test-supervisedPRIM.R
@@ -6,7 +6,8 @@ if(require(testthat) & require(kernlab)){
    irisData <- iris
    set.seed(552)
    trainIndex <- sample(1:nrow(irisData), size = 120, replace = FALSE)
-   irisData$Species <- ifelse(irisData$Species == "setosa", 1L, 0L)
+   irisData$Species <- factor(ifelse(irisData$Species == "setosa", "Setosa", "Other"),
+                              levels = c("Setosa", "Other"))
    # Add some fake data so we don't get perfect separation
    irisData$fake1 <- rnorm(nrow(irisData))
    irisData$fake2 <- runif(nrow(irisData))
@@ -15,12 +16,12 @@ if(require(testthat) & require(kernlab)){
    training <- irisData[trainIndex, ]
    testing <- irisData[-trainIndex, ]
    ytrain <- training$Species
-   training$species <- NULL
+   training$Species <- NULL
    ytest <- testing$Species
-   testing$species <- NULL
+   testing$Species <- NULL
 
    # Perform the tests
-   test_that("Testing the supervisedPRIM() and predict.supervisedPRIM()", {
+   test_that("Testing the supervisedPRIM() and predict.supervisedPRIM() with factors", {
       # Fit the positive and negative thresholds
       expect_error(mp <- supervisedPRIM(x = training, y = ytrain, threshold.type = 1), NA)
       expect_error(mn <- supervisedPRIM(x = training, y = ytrain, threshold.type = -1), NA)
@@ -30,10 +31,10 @@ if(require(testthat) & require(kernlab)){
       # Verify the integrity of the class predictions
       expect_true(length(cpp) == length(ytest))
       expect_true(length(cpn) == length(ytest))
-      expect_true(class(cpp) == "integer")
-      expect_true(class(cpn) == "integer")
-      expect_true(all(cpp %in% c(0L, 1L)))
-      expect_true(all(cpn %in% c(0L, 1L)))
+      expect_true(class(cpp) == "factor")
+      expect_true(class(cpn) == "factor")
+      expect_true(all(cpp %in% levels(ytrain)))
+      expect_true(all(cpn %in% levels(ytrain)))
 
       # Make probability predictions
       expect_error(pp <- predict(mp, newdata = testing, classProb = TRUE), NA)
@@ -49,6 +50,25 @@ if(require(testthat) & require(kernlab)){
       expect_true(max(pn) <= 1)
    })
 
+   test_that("Testing the supervisedPRIM() and predict.supervisedPRIM() with binary data", {
+     data(quasiflow)
+     qf <- quasiflow
+     qf$y <- ifelse(quasiflow$y == 1, 1L, 0L)
+     qf.label <- qf$y[1:1000]
+     qf <- qf[1:1000, 1:3]
+
+     expect_error(qf.prim <- supervisedPRIM(x=qf, y=qf.label), NA)
+     expect_error(predictions <- predict(qf.prim, newdata = quasiflow[, 1:3]), NA)
+     expect_true(all(predictions %in% c(0L, 1L)))
+     expect_true(length(predictions) == nrow(quasiflow))
+     expect_error(predictions <- predict(qf.prim,
+                                         newdata = quasiflow[, 1:3],
+                                         classProb = TRUE), NA)
+     expect_true(max(predictions) <= 1L)
+     expect_true(min(predictions) >= 0L)
+
+   })
+
    # Test on a large dataset
    test_that("Testing on a large dataset", {
      data(spam)
@@ -57,10 +77,10 @@ if(require(testthat) & require(kernlab)){
      training <- spam[trInd, ]
      testing <- spam[-trInd, ]
      trainingX <- training
-     trainingY <- ifelse(training$type == "spam", 1L, 0L)
+     trainingY <- training$type
      trainingX$type <- NULL
      testingX <- testing
-     testingY <- ifelse(testing$type == "spam", 1L, 0L)
+     testingY <- testing$type
      testingX$type <- NULL
 
      # Fit both