Checked glmnet learner unit test.

tests/testthat/test-learner_glmnet_S4.R

@@ -1,37 +1,48 @@
 # First test if all selectable learners are also available
 familiar:::test_all_learners_available(
-  learners = familiar:::.get_available_glmnet_ridge_learners(show_general = TRUE))
+  learners = familiar:::.get_available_glmnet_ridge_learners(show_general = TRUE)
+)
 familiar:::test_all_learners_available(
-  learners = familiar:::.get_available_glmnet_lasso_learners(show_general = TRUE))
+  learners = familiar:::.get_available_glmnet_lasso_learners(show_general = TRUE)
+)
 familiar:::test_all_learners_available(
-  learners = familiar:::.get_available_glmnet_elastic_net_learners(show_general = TRUE))
+  learners = familiar:::.get_available_glmnet_elastic_net_learners(show_general = TRUE)
+)
 
 # Don't perform any further tests on CRAN due to time of running the complete test.
 testthat::skip_on_cran()
 
 familiar:::test_all_learners_train_predict_vimp(
-  learners = familiar:::.get_available_glmnet_ridge_learners(show_general = FALSE))
+  learners = familiar:::.get_available_glmnet_ridge_learners(show_general = FALSE)
+)
 familiar:::test_all_learners_train_predict_vimp(
-  learners = familiar:::.get_available_glmnet_lasso_learners(show_general = FALSE))
+  learners = familiar:::.get_available_glmnet_lasso_learners(show_general = FALSE)
+)
 familiar:::test_all_learners_train_predict_vimp(
   learners = familiar:::.get_available_glmnet_elastic_net_learners(show_general = FALSE),
   hyperparameter_list = list(
     "continuous" = list("alpha" = 0.50),
     "binomial" = list("alpha" = 0.50),
     "multinomial" = list("alpha" = 0.50),
-    "survival" = list("alpha" = 0.50)))
+    "survival" = list("alpha" = 0.50)
+  )
+)
 
 familiar:::test_all_learners_parallel_train_predict_vimp(
-  learners = familiar:::.get_available_glmnet_ridge_learners(show_general = FALSE))
+  learners = familiar:::.get_available_glmnet_ridge_learners(show_general = FALSE)
+)
 familiar:::test_all_learners_parallel_train_predict_vimp(
-  learners = familiar:::.get_available_glmnet_lasso_learners(show_general = FALSE))
+  learners = familiar:::.get_available_glmnet_lasso_learners(show_general = FALSE)
+)
 familiar:::test_all_learners_parallel_train_predict_vimp(
   learners = familiar:::.get_available_glmnet_elastic_net_learners(show_general = FALSE),
   hyperparameter_list = list(
     "continuous" = list("alpha" = 0.50),
     "binomial" = list("alpha" = 0.50),
     "multinomial" = list("alpha" = 0.50),
-    "survival" = list("alpha" = 0.50)))
+    "survival" = list("alpha" = 0.50)
+  )
+)
 
 
 # Continuous outcome tests------------------------------------------------------
@@ -45,11 +56,12 @@ good_model <- familiar:::test_train(
   cluster_method = "none",
   imputation_method = "simple",
   hyperparameter_list = list("sign_size" = familiar:::get_n_features(good_data)),
-  learner = "lasso_gaussian")
+  learner = "lasso_gaussian"
+)
 
 testthat::test_that("Regularised regression model trained correctly", {
   # Model trained
-  testthat::expect_equal(familiar:::model_is_trained(good_model), TRUE)
+  testthat::expect_true(familiar:::model_is_trained(good_model))
 
   # That no deprecation warnings are given.
   familiar:::test_not_deprecated(good_model@messages$warning)
@@ -67,7 +79,8 @@ testthat::test_that("Regularised regression model has variable importance", {
 
   # Expect that the names are the same as that of the features.
   testthat::expect_true(
-    all(vimp_table$name %in% familiar:::get_feature_columns(good_data)))
+    all(vimp_table$name %in% familiar:::get_feature_columns(good_data))
+  )
 
   # Feature 1 is most important.
   testthat::expect_equal(vimp_table[rank == 1, ]$name, "feature_1")
@@ -85,11 +98,12 @@ good_model <- familiar:::test_train(
   cluster_method = "none",
   imputation_method = "simple",
   hyperparameter_list = list("sign_size" = familiar:::get_n_features(good_data)),
-  learner = "lasso_binomial")
+  learner = "lasso_binomial"
+)
 
 testthat::test_that("Regularised regression model trained correctly", {
   # Model trained
-  testthat::expect_equal(familiar:::model_is_trained(good_model), TRUE)
+  testthat::expect_true(familiar:::model_is_trained(good_model))
 
   # That no deprecation warnings are given.
   familiar:::test_not_deprecated(good_model@messages$warning)
@@ -108,7 +122,8 @@ testthat::test_that("Regularised regression model has variable importance", {
 
   # Expect that the names are the same as that of the features.
   testthat::expect_true(
-    all(vimp_table$name %in% familiar:::get_feature_columns(good_data)))
+    all(vimp_table$name %in% familiar:::get_feature_columns(good_data))
+  )
 
   # Feature 1 is most important.
   testthat::expect_equal(vimp_table[rank == 1, ]$name, "feature_1")
@@ -126,11 +141,12 @@ good_model <- familiar:::test_train(
   cluster_method = "none",
   imputation_method = "simple",
   hyperparameter_list = list("sign_size" = familiar:::get_n_features(good_data)),
-  learner = "lasso_multinomial")
+  learner = "lasso_multinomial"
+)
 
 testthat::test_that("Regularised regression model trained correctly", {
   # Model trained
-  testthat::expect_equal(familiar:::model_is_trained(good_model), TRUE)
+  testthat::expect_true(familiar:::model_is_trained(good_model))
 
   # That no deprecation warnings are given.
   familiar:::test_not_deprecated(good_model@messages$warning)
@@ -149,7 +165,8 @@ testthat::test_that("Regularised regression model has variable importance", {
 
   # Expect that the names are the same as that of the features.
   testthat::expect_true(
-    all(vimp_table$name %in% familiar:::get_feature_columns(good_data)))
+    all(vimp_table$name %in% familiar:::get_feature_columns(good_data))
+  )
 
   # Feature 1 is most important.
   testthat::expect_equal(vimp_table[rank == 1, ]$name, "feature_1")
@@ -168,24 +185,15 @@ good_model <- familiar:::test_train(
   imputation_method = "simple",
   hyperparameter_list = list("sign_size" = familiar:::get_n_features(good_data)),
   time_max = 3.5,
-  learner = "lasso_cox")
+  learner = "lasso_cox"
+)
 
 testthat::test_that("Regularised regression model trained correctly", {
   # Model trained
-  testthat::expect_equal(familiar:::model_is_trained(good_model), TRUE)
+  testthat::expect_true(familiar:::model_is_trained(good_model))
 
   # Calibration info is present
-  testthat::expect_equal(familiar:::has_calibration_info(good_model), TRUE)
-
-  # Test that the model predicts hazard ratios.
-  testthat::expect_equal(
-    familiar:::get_prediction_type(good_model),
-    "hazard_ratio")
-
-  # Test that the model predicts hazard ratios
-  testthat::expect_equal(
-    familiar:::get_prediction_type(good_model, type = "survival_probability"),
-    "survival_probability")
+  testthat::expect_true(familiar:::has_calibration_info(good_model))
 
   # That no deprecation warnings are given.
   familiar:::test_not_deprecated(good_model@messages$warning)
@@ -204,7 +212,8 @@ testthat::test_that("Regularised regression model has variable importance", {
 
   # Expect that the names are the same as that of the features.
   testthat::expect_true(
-    all(vimp_table$name %in% familiar:::get_feature_columns(good_data)))
+    all(vimp_table$name %in% familiar:::get_feature_columns(good_data))
+  )
 
   # Feature 1 is most important.
   testthat::expect_equal(vimp_table[rank == 1, ]$name, "feature_1")
@@ -216,14 +225,17 @@ testthat::skip("Skip hyperparameter optimisation, unless manual.")
 familiar:::test_hyperparameter_optimisation(
   learners = familiar:::.get_available_glmnet_ridge_learners(show_general = TRUE),
   debug = FALSE,
-  parallel = FALSE)
+  parallel = FALSE
+)
 
 familiar:::test_hyperparameter_optimisation(
   learners = familiar:::.get_available_glmnet_lasso_learners(show_general = TRUE),
   debug = FALSE,
-  parallel = FALSE)
+  parallel = FALSE
+)
 
 familiar:::test_hyperparameter_optimisation(
   learners = familiar:::.get_available_glmnet_elastic_net_learners(show_general = TRUE),
   debug = FALSE,
-  parallel = FALSE)
+  parallel = FALSE
+)