tests/testthat/test-milr.R

In ChingChuan-Chen/milr: Multiple-Instance Logistic Regression with LASSO Penalty

context("test - milr")

load("milr-correctRes.RData")
set.seed(5)
beta <- c(-0.5, 0.7, -0.9, 1.1)
miData <- DGP(70, 3, beta)
miData_test <- DGP(30, 3, beta)
milr_result_1 <- milr(miData$Z, miData$X, miData$ID)
milr_result_2 <- milr(miData$Z, miData$X, miData$ID, lambda = -1)
milr_result_3 <- milr(miData$Z, miData$X, miData$ID, lambda = c(0.5, 0.7, 0.9, 1.1))
milr_result_4 <- milr(miData$Z, miData$X, miData$ID, lambda = -1, numLambda = 30L)
test_that("milr", {
  expect_equal(milr_result_1$lambda,     milr_result_1_correct$lambda)
  expect_equal(milr_result_1$deviance,   milr_result_1_correct$deviance)
  expect_equal(milr_result_1$BIC,        milr_result_1_correct$BIC)
  expect_equal(milr_result_1$beta,       milr_result_1_correct$beta)
  expect_equal(milr_result_1$best_index, 1)
  
  expect_equal(milr_result_2$lambda,     milr_result_2_correct$lambda)
  expect_equal(milr_result_2$deviance,   milr_result_2_correct$deviance)
  expect_equal(milr_result_2$BIC,        milr_result_2_correct$BIC)
  expect_equal(milr_result_2$beta,       milr_result_2_correct$beta)
  expect_equal(milr_result_2$best_index, which.min(milr_result_2$BIC))
  
  expect_equal(milr_result_3$lambda,     milr_result_3_correct$lambda)
  expect_equal(milr_result_3$deviance,   milr_result_3_correct$deviance)
  expect_equal(milr_result_3$BIC,        milr_result_3_correct$BIC)
  expect_equal(milr_result_3$beta,       milr_result_3_correct$beta)
  expect_equal(milr_result_3$best_index, which.min(milr_result_3$BIC))
  
  expect_equal(milr_result_4$lambda,     milr_result_4_correct$lambda)
  expect_equal(milr_result_4$deviance,   milr_result_4_correct$deviance)
  expect_equal(milr_result_4$BIC,        milr_result_4_correct$BIC)
  expect_equal(milr_result_4$beta,       milr_result_4_correct$beta)
  expect_equal(milr_result_4$best_index, which.min(milr_result_4$BIC))
  
  expect_message(milr(miData$Z, miData$X, miData$ID, lambda = 0), "Lasso-penalty is not used.")
  expect_message(milr(miData$Z, miData$X, miData$ID, lambda = -1), "The penalty term is selected automatically with 20 candidates.")
  expect_message(milr(miData$Z, miData$X, miData$ID, lambda = c(0.5, 0.7, 0.9, 1.1)), "Use the user-defined lambda vector.")
  expect_message(milr(miData$Z, miData$X, miData$ID, lambda = -1, numLambda = 30L), 
                 "The penalty term is selected automatically with 30 candidates.")
  
  expect_error(predict(milr_result_1, newdata = miData_test$X))
  expect_error(predict(milr_result_1, bag_newdata = miData_test$ID))
  
  expect_is(milr_result_1, "milr")
  expect_equal(length(milr_result_1$beta), 4L)
  expect_equal(length(coef(milr_result_1)), 4L)
  expect_equal(length(fitted(milr_result_1, type = "bag")), 70L)
  expect_equal(length(fitted(milr_result_1, type = "instance")), 210L)
  expect_equal(length(predict(milr_result_1, type = "bag")), 70L)
  expect_equal(length(predict(milr_result_1, type = "instance")), 210L)
  expect_equal(length(predict(milr_result_1, miData_test$X, miData_test$ID, type = "bag")), 30L)
  expect_equal(length(predict(milr_result_1, miData_test$X, miData_test$ID, type = "instance")), 90L)
  
  expect_is(milr_result_2, "milr")
  expect_equal(dim(milr_result_2$beta), c(4L, 20L))
  expect_equal(length(coef(milr_result_2)), 4L)
  expect_equal(length(fitted(milr_result_2, type = "bag")), 70L)
  expect_equal(length(fitted(milr_result_2, type = "instance")), 210L)
  expect_equal(length(predict(milr_result_2, type = "bag")), 70L)
  expect_equal(length(predict(milr_result_2, type = "instance")), 210L)
  expect_equal(length(predict(milr_result_2, miData_test$X, miData_test$ID, type = "bag")), 30L)
  expect_equal(length(predict(milr_result_2, miData_test$X, miData_test$ID, type = "instance")), 90L)
  
  expect_is(milr_result_3, "milr")
  expect_equal(dim(milr_result_3$beta), c(4L, 4L))
  expect_equal(length(coef(milr_result_3)), 4L)
  expect_equal(length(fitted(milr_result_3, type = "bag")), 70L)
  expect_equal(length(fitted(milr_result_3, type = "instance")), 210L)
  expect_equal(length(predict(milr_result_3, type = "bag")), 70L)
  expect_equal(length(predict(milr_result_3, type = "instance")), 210L)
  expect_equal(length(predict(milr_result_3, miData_test$X, miData_test$ID, type = "bag")), 30L)
  expect_equal(length(predict(milr_result_3, miData_test$X, miData_test$ID, type = "instance")), 90L)
  
  expect_is(milr_result_4, "milr")
  expect_equal(dim(milr_result_4$beta), c(4L, 30L))
  expect_equal(length(coef(milr_result_4)), 4L)
  expect_equal(length(fitted(milr_result_4, type = "bag")), 70L)
  expect_equal(length(fitted(milr_result_4, type = "instance")), 210L)
  expect_equal(length(predict(milr_result_4, type = "bag")), 70L)
  expect_equal(length(predict(milr_result_4, type = "instance")), 210L)
  expect_equal(length(predict(milr_result_4, miData_test$X, miData_test$ID, type = "bag")), 30L)
  expect_equal(length(predict(milr_result_4, miData_test$X, miData_test$ID, type = "instance")), 90L)
})

milr_result_1_div <- milr(miData$Z, miData$X, miData$ID, lambdaCriterion = "deviance")
milr_result_2_div <- milr(miData$Z, miData$X, miData$ID, lambda = -1, lambdaCriterion = "deviance")
milr_result_3_div <- milr(miData$Z, miData$X, miData$ID, lambda = c(0.5, 0.7, 0.9, 1.1), lambdaCriterion = "deviance")
milr_result_4_div <- milr(miData$Z, miData$X, miData$ID, lambda = -1, numLambda = 30L, lambdaCriterion = "deviance")
test_that("milr", {
  expect_equal(milr_result_1_div$lambda,     milr_result_1_div_correct$lambda)
  expect_equal(milr_result_1_div$deviance,   milr_result_1_div_correct$deviance)
  expect_equal(milr_result_1_div$BIC,        milr_result_1_div_correct$BIC)
  expect_equal(milr_result_1_div$beta,       milr_result_1_div_correct$beta)
  expect_equal(milr_result_1_div$best_index, 1)
  
  expect_equal(milr_result_2_div$lambda,     milr_result_2_div_correct$lambda)
  expect_equal(milr_result_2_div$deviance,   milr_result_2_div_correct$deviance)
  expect_equal(milr_result_2_div$BIC,        milr_result_2_div_correct$BIC)
  expect_equal(milr_result_2_div$beta,       milr_result_2_div_correct$beta)
  expect_equal(milr_result_2_div$best_index, which.min(milr_result_2_div$cv))
  
  expect_equal(milr_result_3_div$lambda,     milr_result_3_div_correct$lambda)
  expect_equal(milr_result_3_div$deviance,   milr_result_3_div_correct$deviance)
  expect_equal(milr_result_3_div$BIC,        milr_result_3_div_correct$BIC)
  expect_equal(milr_result_3_div$beta,       milr_result_3_div_correct$beta)
  expect_equal(milr_result_3_div$best_index, which.min(milr_result_3_div$cv))
  
  expect_equal(milr_result_4_div$lambda,     milr_result_4_div_correct$lambda)
  expect_equal(milr_result_4_div$deviance,   milr_result_4_div_correct$deviance)
  expect_equal(milr_result_4_div$BIC,        milr_result_4_div_correct$BIC)
  expect_equal(milr_result_4_div$beta,       milr_result_4_div_correct$beta)
  expect_equal(milr_result_4_div$best_index, which.min(milr_result_4_div$cv))
  
  expect_message(milr(miData$Z, miData$X, miData$ID, lambda = 0, lambdaCriterion = "deviance"), 
                 "Lasso-penalty is not used.")
  expect_message(milr(miData$Z, miData$X, miData$ID, lambda = -1, lambdaCriterion = "deviance"), 
                 "The penalty term is selected automatically with 20 candidates.")
  expect_message(milr(miData$Z, miData$X, miData$ID, lambda = c(0.5, 0.7, 0.9, 1.1), lambdaCriterion = "deviance"), 
                 "Use the user-defined lambda vector.")
  expect_message(milr(miData$Z, miData$X, miData$ID, lambda = -1, numLambda = 30L, lambdaCriterion = "deviance"), 
                 "The penalty term is selected automatically with 30 candidates.")
  
  expect_error(predict(milr_result_1_div, newdata = miData_test$X))
  expect_error(predict(milr_result_1_div, bag_newdata = miData_test$ID))
  
  expect_is(milr_result_1_div, "milr")
  expect_equal(length(milr_result_1_div$beta), 4L)
  expect_equal(length(coef(milr_result_1_div)), 4L)
  expect_equal(length(fitted(milr_result_1_div, type = "bag")), 70L)
  expect_equal(length(fitted(milr_result_1_div, type = "instance")), 210L)
  expect_equal(length(predict(milr_result_1_div, type = "bag")), 70L)
  expect_equal(length(predict(milr_result_1_div, type = "instance")), 210L)
  expect_equal(length(predict(milr_result_1_div, miData_test$X, miData_test$ID, type = "bag")), 30L)
  expect_equal(length(predict(milr_result_1_div, miData_test$X, miData_test$ID, type = "instance")), 90L)
  
  expect_is(milr_result_2_div, "milr")
  expect_equal(dim(milr_result_2_div$beta), c(4L, 20L))
  expect_equal(length(coef(milr_result_2_div)), 4L)
  expect_equal(length(fitted(milr_result_2_div, type = "bag")), 70L)
  expect_equal(length(fitted(milr_result_2_div, type = "instance")), 210L)
  expect_equal(length(predict(milr_result_2_div, type = "bag")), 70L)
  expect_equal(length(predict(milr_result_2_div, type = "instance")), 210L)
  expect_equal(length(predict(milr_result_2_div, miData_test$X, miData_test$ID, type = "bag")), 30L)
  expect_equal(length(predict(milr_result_2_div, miData_test$X, miData_test$ID, type = "instance")), 90L)
  
  expect_is(milr_result_3_div, "milr")
  expect_equal(dim(milr_result_3_div$beta), c(4L, 4L))
  expect_equal(length(coef(milr_result_3_div)), 4L)
  expect_equal(length(fitted(milr_result_3_div, type = "bag")), 70L)
  expect_equal(length(fitted(milr_result_3_div, type = "instance")), 210L)
  expect_equal(length(predict(milr_result_3_div, type = "bag")), 70L)
  expect_equal(length(predict(milr_result_3_div, type = "instance")), 210L)
  expect_equal(length(predict(milr_result_3_div, miData_test$X, miData_test$ID, type = "bag")), 30L)
  expect_equal(length(predict(milr_result_3_div, miData_test$X, miData_test$ID, type = "instance")), 90L)
  
  expect_is(milr_result_4_div, "milr")
  expect_equal(dim(milr_result_4_div$beta), c(4L, 30L))
  expect_equal(length(coef(milr_result_4_div)), 4L)
  expect_equal(length(fitted(milr_result_4_div, type = "bag")), 70L)
  expect_equal(length(fitted(milr_result_4_div, type = "instance")), 210L)
  expect_equal(length(predict(milr_result_4_div, type = "bag")), 70L)
  expect_equal(length(predict(milr_result_4_div, type = "instance")), 210L)
  expect_equal(length(predict(milr_result_4_div, miData_test$X, miData_test$ID, type = "bag")), 30L)
  expect_equal(length(predict(milr_result_4_div, miData_test$X, miData_test$ID, type = "instance")), 90L)
})