# Don't perform any further tests on CRAN due to time of running the complete # test. testthat::skip_on_cran() testthat::skip_on_ci() # Survival data with multiple instances ---------------------------------------- # Create a dataset using the good dataset. data <- familiar:::test_create_good_data("survival") # Train a simple linear GLM using the good dataset. fam_model <- familiar:::test_train( data = data, cluster_method = "none", imputation_method = "simple", hyperparameter_list = list("sign_size" = familiar:::get_n_features(data)), learner = "cox", create_novelty_detector = TRUE ) # Default predictions using data object. predictions_1 <- familiar::predict( object = fam_model, newdata = data, .as_prediction_table = TRUE ) # Default predictions using data.table. predictions_2 <- familiar::predict( object = fam_model, newdata = familiar:::test_create_good_data("survival", to_data_object = FALSE), .as_prediction_table = TRUE ) # Survival probability. predictions_surv <- familiar::predict( object = fam_model, newdata = data, type = "survival_probability", .as_prediction_table = TRUE ) # Survival probability at a different time points. predictions_surv_early <- familiar::predict( object = fam_model, newdata = data, type = "survival_probability", time = 1.0, .as_prediction_table = TRUE ) # Novelty. predictions_novelty_1 <- familiar::predict( object = fam_model, newdata = data, type = "novelty", .as_prediction_table = TRUE ) # Novelty predictions using data.table. predictions_novelty_2 <- familiar::predict( object = fam_model@novelty_detector, newdata = familiar:::test_create_good_data("survival", to_data_object = FALSE), .as_prediction_table = TRUE ) # Novelty from list of novelty detectors. predictions_novelty_3 <- familiar::predict( object = list(fam_model@novelty_detector), newdata = data, .as_prediction_table = TRUE ) # Risk stratification. predictions_risk <- familiar::predict( object = fam_model, newdata = data, type = "risk_stratification", .as_prediction_table = TRUE ) testthat::test_that("Survival models can predict using external data.", { # Check that predictions 1 and 2 are equal. testthat::expect_equal(predictions_1, predictions_2, ignore_attr = TRUE) testthat::expect_equal(predictions_novelty_1, predictions_novelty_2, ignore_attr = TRUE) testthat::expect_equal(predictions_novelty_1, predictions_novelty_3, ignore_attr = TRUE) # Check that the number of rows is equal to the input data. testthat::expect_equal(nrow(predictions_1@data), nrow(data@data)) testthat::expect_equal(nrow(predictions_2@data), nrow(data@data)) testthat::expect_equal(nrow(predictions_surv@data), nrow(data@data)) testthat::expect_equal(nrow(predictions_novelty_1@data), nrow(data@data)) testthat::expect_equal(nrow(predictions_novelty_2@data), nrow(data@data)) testthat::expect_equal(nrow(predictions_risk@data), nrow(data@data)) # Check that all predictions are valid. testthat::expect_true(familiar:::any_predictions_valid(predictions_1)) testthat::expect_true(familiar:::any_predictions_valid(predictions_2)) testthat::expect_true(familiar:::any_predictions_valid(predictions_surv)) testthat::expect_true(familiar:::all_predictions_valid(predictions_novelty_1)) testthat::expect_true(familiar:::all_predictions_valid(predictions_novelty_2)) testthat::expect_true(familiar:::any_predictions_valid(predictions_risk)) # Test on survival probability: that testthat::expect_gt(predictions_surv@time, predictions_surv_early@time) testthat::expect_true(all(predictions_surv@data$predicted_outcome < predictions_surv_early@data$predicted_outcome)) }) # Survival data with one instance ---------------------------------------------- # Create one-sample dataset. data <- familiar:::test_create_one_sample_data("survival") # Default predictions using data object. predictions_1 <- familiar::predict( object = fam_model, newdata = data, .as_prediction_table = TRUE ) # Default predictions using data.table. predictions_2 <- familiar::predict( object = fam_model, newdata = familiar:::test_create_one_sample_data( "survival", to_data_object = FALSE ), .as_prediction_table = TRUE ) # Survival probability. predictions_surv <- familiar::predict( object = fam_model, newdata = data, type = "survival_probability", .as_prediction_table = TRUE ) # Novelty. predictions_novelty_1 <- familiar::predict( object = fam_model, newdata = data, type = "novelty", .as_prediction_table = TRUE ) # Novelty predictions using data.table. predictions_novelty_2 <- familiar::predict( object = fam_model@novelty_detector, newdata = familiar:::test_create_one_sample_data( "survival", to_data_object = FALSE ), .as_prediction_table = TRUE ) # Risk stratification. predictions_risk <- familiar::predict( object = fam_model, newdata = data, type = "risk_stratification", .as_prediction_table = TRUE ) testthat::test_that("Surival models can predict single instances using external data.", { # Check that predictions 1 and 2 are equal. testthat::expect_equal(predictions_1, predictions_2, ignore_attr = TRUE) testthat::expect_equal(predictions_novelty_1, predictions_novelty_2, ignore_attr = TRUE) # Check that the number of rows is equal to the input data. testthat::expect_equal(nrow(predictions_1@data), nrow(data@data)) testthat::expect_equal(nrow(predictions_2@data), nrow(data@data)) testthat::expect_equal(nrow(predictions_surv@data), nrow(data@data)) testthat::expect_equal(nrow(predictions_novelty_1@data), nrow(data@data)) testthat::expect_equal(nrow(predictions_novelty_2@data), nrow(data@data)) testthat::expect_equal(nrow(predictions_risk@data), nrow(data@data)) # Check that all predictions are valid. testthat::expect_true(familiar:::any_predictions_valid(predictions_1)) testthat::expect_true(familiar:::any_predictions_valid(predictions_2)) testthat::expect_true(familiar:::any_predictions_valid(predictions_surv)) testthat::expect_true(familiar:::all_predictions_valid(predictions_novelty_1)) testthat::expect_true(familiar:::all_predictions_valid(predictions_novelty_2)) testthat::expect_true(familiar:::any_predictions_valid(predictions_risk)) }) # Binomial data with multiple instances ---------------------------------------- # Create a dataset using the good dataset. data <- familiar:::test_create_good_data("binomial") # Train a simple linear GLM using the good dataset. fam_model <- familiar:::test_train( data = data, cluster_method = "none", imputation_method = "simple", hyperparameter_list = list("sign_size" = familiar:::get_n_features(data)), learner = "glm_logistic", create_novelty_detector = TRUE ) # Default predictions using data object. predictions_1 <- familiar::predict( object = fam_model, newdata = data, .as_prediction_table = TRUE ) # Default predictions using data.table. predictions_2 <- familiar::predict( object = fam_model, newdata = familiar:::test_create_good_data( "binomial", to_data_object = FALSE ), .as_prediction_table = TRUE ) # Novelty. predictions_novelty_1 <- familiar::predict( object = fam_model, newdata = data, type = "novelty", .as_prediction_table = TRUE ) # Novelty predictions using data.table. predictions_novelty_2 <- familiar::predict( object = fam_model@novelty_detector, newdata = familiar:::test_create_good_data( "binomial", to_data_object = FALSE ), .as_prediction_table = TRUE ) testthat::test_that("Binomial models can predict using external data.", { # Check that predictions 1 and 2 are equal. testthat::expect_equal(predictions_1, predictions_2, ignore_attr = TRUE) testthat::expect_equal(predictions_novelty_1, predictions_novelty_2, ignore_attr = TRUE) # Check that the number of rows is equal to the input data. testthat::expect_equal(nrow(predictions_1@data), nrow(data@data)) testthat::expect_equal(nrow(predictions_2@data), nrow(data@data)) testthat::expect_equal(nrow(predictions_novelty_1@data), nrow(data@data)) testthat::expect_equal(nrow(predictions_novelty_2@data), nrow(data@data)) # Check that all predictions are valid. testthat::expect_true(familiar:::any_predictions_valid(predictions_1)) testthat::expect_true(familiar:::any_predictions_valid(predictions_2)) testthat::expect_true(familiar:::all_predictions_valid(predictions_novelty_1)) testthat::expect_true(familiar:::all_predictions_valid(predictions_novelty_2)) }) # Binomial data with one instance ---------------------------------------------- # Create one-sample dataset. data <- familiar:::test_create_one_sample_data("binomial") # Default predictions using data object. predictions_1 <- familiar::predict( object = fam_model, newdata = data, .as_prediction_table = TRUE ) # Default predictions using data.table. predictions_2 <- familiar::predict( object = fam_model, newdata = familiar:::test_create_one_sample_data( "binomial", to_data_object = FALSE ), .as_prediction_table = TRUE ) # Novelty. predictions_novelty_1 <- familiar::predict( object = fam_model, newdata = data, type = "novelty", .as_prediction_table = TRUE ) # Novelty predictions using data.table. predictions_novelty_2 <- familiar::predict( object = fam_model@novelty_detector, newdata = familiar:::test_create_one_sample_data( "binomial", to_data_object = FALSE ), .as_prediction_table = TRUE ) testthat::test_that("Binomial models can predict single instances using external data.", { # Check that predictions 1 and 2 are equal. testthat::expect_equal(predictions_1, predictions_2, ignore_attr = TRUE) testthat::expect_equal(predictions_novelty_1, predictions_novelty_2, ignore_attr = TRUE) # Check that the number of rows is equal to the input data. testthat::expect_equal(nrow(predictions_1@data), nrow(data@data)) testthat::expect_equal(nrow(predictions_2@data), nrow(data@data)) testthat::expect_equal(nrow(predictions_novelty_1@data), nrow(data@data)) testthat::expect_equal(nrow(predictions_novelty_2@data), nrow(data@data)) # Check that all predictions are valid. testthat::expect_true(familiar:::any_predictions_valid(predictions_1)) testthat::expect_true(familiar:::any_predictions_valid(predictions_2)) testthat::expect_true(familiar:::all_predictions_valid(predictions_novelty_1)) testthat::expect_true(familiar:::all_predictions_valid(predictions_novelty_2)) }) # Multinomial data with multiple instances ------------------------------------- # Create a dataset using the good dataset. data <- familiar:::test_create_good_data("multinomial") # Train a simple linear GLM using the good dataset. fam_model <- familiar:::test_train( data = data, cluster_method = "none", imputation_method = "simple", hyperparameter_list = list("sign_size" = familiar:::get_n_features(data)), learner = "lasso_multinomial", create_novelty_detector = TRUE ) # Default predictions using data object. predictions_1 <- familiar::predict( object = fam_model, newdata = data, .as_prediction_table = TRUE ) # Default predictions using data.table. predictions_2 <- familiar::predict( object = fam_model, newdata = familiar:::test_create_good_data( "multinomial", to_data_object = FALSE ), .as_prediction_table = TRUE ) # Novelty. predictions_novelty_1 <- familiar::predict( object = fam_model, newdata = data, type = "novelty", .as_prediction_table = TRUE ) # Novelty predictions using data.table. predictions_novelty_2 <- familiar::predict( object = fam_model@novelty_detector, newdata = familiar:::test_create_good_data( "multinomial", to_data_object = FALSE ), .as_prediction_table = TRUE ) testthat::test_that("Multinomial models can predict using external data.", { # Check that predictions 1 and 2 are equal. testthat::expect_equal(predictions_1, predictions_2, ignore_attr = TRUE) testthat::expect_equal(predictions_novelty_1, predictions_novelty_2, ignore_attr = TRUE) # Check that the number of rows is equal to the input data. testthat::expect_equal(nrow(predictions_1@data), nrow(data@data)) testthat::expect_equal(nrow(predictions_2@data), nrow(data@data)) testthat::expect_equal(nrow(predictions_novelty_1@data), nrow(data@data)) testthat::expect_equal(nrow(predictions_novelty_2@data), nrow(data@data)) # Check that all predictions are valid. testthat::expect_true(familiar:::any_predictions_valid(predictions_1)) testthat::expect_true(familiar:::any_predictions_valid(predictions_2)) testthat::expect_true(familiar:::all_predictions_valid(predictions_novelty_1)) testthat::expect_true(familiar:::all_predictions_valid(predictions_novelty_2)) }) # Multinomial data with one instance ------------------------------------------- # Create one-sample dataset. data <- familiar:::test_create_one_sample_data("multinomial") # Default predictions using data object. predictions_1 <- familiar::predict( object = fam_model, newdata = data, .as_prediction_table = TRUE ) # Default predictions using data.table. predictions_2 <- familiar::predict( object = fam_model, newdata = familiar:::test_create_one_sample_data( "multinomial", to_data_object = FALSE ), .as_prediction_table = TRUE ) # Novelty. predictions_novelty_1 <- familiar::predict( object = fam_model, newdata = data, type = "novelty", .as_prediction_table = TRUE ) # Novelty predictions using data.table. predictions_novelty_2 <- familiar::predict( object = fam_model@novelty_detector, newdata = familiar:::test_create_one_sample_data( "multinomial", to_data_object = FALSE ), .as_prediction_table = TRUE ) testthat::test_that("Multinomial models can predict single instances using external data.", { # Check that predictions 1 and 2 are equal. testthat::expect_equal(predictions_1, predictions_2, ignore_attr = TRUE) testthat::expect_equal(predictions_novelty_1, predictions_novelty_2, ignore_attr = TRUE) # Check that the number of rows is equal to the input data. testthat::expect_equal(nrow(predictions_1@data), nrow(data@data)) testthat::expect_equal(nrow(predictions_2@data), nrow(data@data)) testthat::expect_equal(nrow(predictions_novelty_1@data), nrow(data@data)) testthat::expect_equal(nrow(predictions_novelty_2@data), nrow(data@data)) # Check that all predictions are valid. testthat::expect_true(familiar:::any_predictions_valid(predictions_1)) testthat::expect_true(familiar:::any_predictions_valid(predictions_2)) testthat::expect_true(familiar:::all_predictions_valid(predictions_novelty_1)) testthat::expect_true(familiar:::all_predictions_valid(predictions_novelty_2)) }) # Continuous data with multiple instances -------------------------------------- # Create a dataset using the good dataset. data <- familiar:::test_create_good_data("continuous") # Train a simple linear GLM using the good dataset. fam_model <- familiar:::test_train( data = data, cluster_method = "none", imputation_method = "simple", hyperparameter_list = list("sign_size" = familiar:::get_n_features(data)), learner = "lasso_gaussian", create_novelty_detector = TRUE ) # Default predictions using data object. predictions_1 <- familiar::predict( object = fam_model, newdata = data, .as_prediction_table = TRUE ) # Default predictions using data.table. predictions_2 <- familiar::predict( object = fam_model, newdata = familiar:::test_create_good_data( "continuous", to_data_object = FALSE ), .as_prediction_table = TRUE ) # Novelty. predictions_novelty_1 <- familiar::predict( object = fam_model, newdata = data, type = "novelty", .as_prediction_table = TRUE ) # Novelty predictions using data.table. predictions_novelty_2 <- familiar::predict( object = fam_model@novelty_detector, newdata = familiar:::test_create_good_data( "continuous", to_data_object = FALSE ), .as_prediction_table = TRUE ) testthat::test_that("Continuous models can predict using external data.", { # Check that predictions 1 and 2 are equal. # testthat::expect_equal(predictions_1, predictions_2, ignore_attr = TRUE) testthat::expect_equal(predictions_1@data, predictions_2@data, ignore_attr = TRUE) testthat::expect_equal(predictions_novelty_1, predictions_novelty_2, ignore_attr = TRUE) # Check that the number of rows is equal to the input data. testthat::expect_equal(nrow(predictions_1@data), nrow(data@data)) testthat::expect_equal(nrow(predictions_2@data), nrow(data@data)) testthat::expect_equal(nrow(predictions_novelty_1@data), nrow(data@data)) testthat::expect_equal(nrow(predictions_novelty_2@data), nrow(data@data)) # Check that all predictions are valid. testthat::expect_true(familiar:::any_predictions_valid(predictions_1)) testthat::expect_true(familiar:::any_predictions_valid(predictions_2)) testthat::expect_true(familiar:::all_predictions_valid(predictions_novelty_1)) testthat::expect_true(familiar:::all_predictions_valid(predictions_novelty_2)) }) # Continuous data with one instance -------------------------------------------- # Create one-sample dataset. data <- familiar:::test_create_one_sample_data("continuous") # Default predictions using data object. predictions_1 <- familiar::predict( object = fam_model, newdata = data, .as_prediction_table = TRUE ) # Default predictions using data.table. predictions_2 <- familiar::predict( object = fam_model, newdata = familiar:::test_create_one_sample_data( "continuous", to_data_object = FALSE ), .as_prediction_table = TRUE ) # Novelty. predictions_novelty_1 <- familiar::predict( object = fam_model, newdata = data, type = "novelty", .as_prediction_table = TRUE ) # Novelty predictions using data.table. predictions_novelty_2 <- familiar::predict( object = fam_model@novelty_detector, newdata = familiar:::test_create_one_sample_data( "continuous", to_data_object = FALSE ), .as_prediction_table = TRUE ) testthat::test_that("Continuous models can predict single instances using external data.", { # Check that predictions 1 and 2 are equal. testthat::expect_equal(predictions_novelty_1, predictions_novelty_2, ignore_attr = TRUE) # Check that the number of rows is equal to the input data. testthat::expect_equal(nrow(predictions_1@data), nrow(data@data)) testthat::expect_equal(nrow(predictions_2@data), nrow(data@data)) testthat::expect_equal(nrow(predictions_novelty_1@data), nrow(data@data)) testthat::expect_equal(nrow(predictions_novelty_2@data), nrow(data@data)) # Check that all predictions are valid. testthat::expect_true(familiar:::any_predictions_valid(predictions_1)) testthat::expect_true(familiar:::any_predictions_valid(predictions_2)) testthat::expect_true(familiar:::all_predictions_valid(predictions_novelty_1)) testthat::expect_true(familiar:::all_predictions_valid(predictions_novelty_2)) })