tests/testthat/test_confidence.R

In confcons: Confidence and Consistency of Predictive Distribution Models

testthat::test_that(desc = "returns expexted value for normal parameters - small example",
					code = {
						observations <- c(0L, 0L, 0L, 1L, 1L, 1L)
						predictions <- c(0, 0.2, 0.5, 0.4, 0.6, 1)
						thresholds <- c(0.4, 0.6)
						testthat::expect_type(object = confidence(observations = observations,
																						predictions = predictions,
																						thresholds = thresholds,
																						type = "positive"),
												type = "double")
						testthat::expect_type(object = confidence(observations = observations,
																						predictions = predictions,
																						thresholds = thresholds,
																						type = "neutral"),
												type = "double")
						testthat::expect_vector(object= confidence(observations = observations,
																						 predictions = predictions,
																						 thresholds = thresholds,
																						 type = "positive"),
													ptype = numeric(length = 0))
						testthat::expect_vector(object= confidence(observations = observations,
																						 predictions = predictions,
																						 thresholds = thresholds,
																						 type = "neutral"),
													ptype = numeric(length = 0))
						testthat::expect_length(object = confidence(observations = observations,
																							predictions = predictions,
																							thresholds = thresholds,
																							type = "positive"),
													n = 1)
						testthat::expect_length(object = confidence(observations = observations,
																							predictions = predictions,
																							thresholds = thresholds,
																							type = "neutral"),
													n = 1)
						testthat::expect_equal(object = round(x = confidence(observations = observations,
																						           predictions = predictions,
																											 thresholds = thresholds,
																											 type = "positive"), digits = 7),
												 expected = 0.5)
						testthat::expect_equal(object = round(x = confidence(observations = observations,
																											 predictions = predictions,
																											 thresholds = thresholds,
																											 type = "neutral"), digits = 7),
												 expected = 0.6666667)
					}
)

testthat::test_that(desc = "returns expexted value for normal parameters - long example - logical",
					code = {
						withr::local_seed(seed = 12345,
											 .rng_kind = "Mersenne-Twister",
											 .rng_normal_kind = "Inversion",
											 .rng_sample_kind = "Rejection")
						observations_1000_logical <- c(rep(x = FALSE, times = 500),
																					 rep(x = TRUE, times = 500))
						predictions_1000 <- c(runif(n = 500, min = 0, max = 0.7),
																	runif(n = 500, min = 0.3, max = 1))
						testthat::expect_type(object = confidence(observations = observations_1000_logical, predictions = predictions_1000),
												type = "double")
						testthat::expect_vector(object= confidence(observations = observations_1000_logical, predictions = predictions_1000),
													ptype = numeric(length = 0))
						testthat::expect_length(object = confidence(observations = observations_1000_logical, predictions = predictions_1000),
													n = 1)
						testthat::expect_equal(object = round(x = confidence(observations = observations_1000_logical, predictions = predictions_1000), digits = 7),
												 expected = 0.5607064)
					}
)

testthat::test_that(desc = "returns expexted value for normal parameters - long example - integer",
					code = {
						withr::local_seed(seed = 12345,
											 .rng_kind = "Mersenne-Twister",
											 .rng_normal_kind = "Inversion",
											 .rng_sample_kind = "Rejection")
						observations_4000_integer <- c(rep(x = 0L, times = 3000),
																					 rep(x = 1L, times = 1000))
						predictions_4000 <- c(runif(n = 3000, min = 0, max = 0.8),
																	runif(n = 1000, min = 0.2, max = 0.9))
						testthat::expect_type(object = confidence(observations = observations_4000_integer,
																						predictions = predictions_4000,
																						type = "positive"),
												type = "double")
						testthat::expect_type(object = confidence(observations = observations_4000_integer,
																						predictions = predictions_4000,
																						type = "neutral"),
												type = "double")
						testthat::expect_vector(object= confidence(observations = observations_4000_integer,
																						 predictions = predictions_4000,
																						 type = "positive"),
													ptype = numeric(length = 0))
						testthat::expect_vector(object= confidence(observations = observations_4000_integer,
																						 predictions = predictions_4000,
																						 type = "neutral"),
													ptype = numeric(length = 0))
						testthat::expect_length(object = confidence(observations = observations_4000_integer,
																							predictions = predictions_4000,
																							type = "positive"),
													n = 1)
						testthat::expect_length(object = confidence(observations = observations_4000_integer,
																							predictions = predictions_4000,
																							type = "neutral"),
													n = 1)
						testthat::expect_equal(object = round(x = confidence(observations = observations_4000_integer,
																						           predictions = predictions_4000,
																											 type = "positive"), digits = 7),
												 expected = 0.7316017)
						testthat::expect_equal(object = round(x = confidence(observations = observations_4000_integer,
																											 predictions = predictions_4000,
																											 type = "neutral"), digits = 7),
												 expected = 0.814)
					}
)


testthat::test_that(desc = "returns expexted value for normal parameters - previously selected thresholds",
					code = {
						withr::local_seed(seed = 12345,
															.rng_kind = "Mersenne-Twister",
															.rng_normal_kind = "Inversion",
															.rng_sample_kind = "Rejection")
						observations_4000_integer <- c(rep(x = 0L, times = 3000),
																					 rep(x = 1L, times = 1000))
						predictions_4000 <- c(runif(n = 3000, min = 0, max = 0.8),
																	runif(n = 1000, min = 0.2, max = 0.9))
						strict_thresholds <- c(0.1, 0.9)
						permissive_thresholds <- c(0.4, 0.5)
						percentile_thresholds <- quantile(x = predictions_4000[observations_4000_integer == 1],
																							probs = c(0.1, 0.9))
						testthat::expect_equal(object = round(x = confidence(observations = observations_4000_integer,
																											 predictions = predictions_4000,
																											 thresholds = strict_thresholds,
																											 type = "neutral"), digits = 7),
												 expected = 0)
						testthat::expect_equal(object = round(x = confidence(observations = observations_4000_integer,
																											 predictions = predictions_4000,
																											 thresholds = permissive_thresholds,
																											 type = "neutral"), digits = 7),
												 expected = 0.862)
						testthat::expect_equal(object = round(x = confidence(observations = observations_4000_integer,
																											 predictions = predictions_4000,
																											 thresholds = percentile_thresholds,
																											 type = "neutral"), digits = 7),
												 expected = 0.2)
					}
)

testthat::test_that(desc = "returns expexted value for normal parameters - real-life case",
					code = {
						withr::local_seed(seed = 12345,
															.rng_kind = "Mersenne-Twister",
															.rng_normal_kind = "Inversion",
															.rng_sample_kind = "Rejection")
						observations_4000_integer <- c(rep(x = 0L, times = 3000),
																					 rep(x = 1L, times = 1000))
						predictions_4000 <- c(runif(n = 3000, min = 0, max = 0.8),
																	runif(n = 1000, min = 0.2, max = 0.9))
						dataset <- data.frame(
							observations = observations_4000_integer,
							predictions = predictions_4000,
							evaluation_mask = c(rep(x = FALSE, times = 250),
																  rep(x = TRUE, times = 250),
																  rep(x = FALSE, times = 250),
															 	 rep(x = TRUE, times = 250))
						)
						thresholds_whole <- thresholds(observations = dataset$observations,
																					 predictions = dataset$predictions)
						confidence(observations = dataset$observations[dataset$evaluation_mask],
											 predictions = dataset$predictions[dataset$evaluation_mask],
											 thresholds = thresholds_whole)

						testthat::expect_equal(object = round(x = confidence(observations = dataset$observations[dataset$evaluation_mask],
																											 predictions = dataset$predictions[dataset$evaluation_mask],
																											 thresholds = thresholds_whole), digits = 7),
												 expected = 0.7134831)
					}
)

testthat::test_that(desc = "returns errors/warnings if needed - parameter: observations",
					code = {
						predictions <- c(0, 0.2, 0.5, 0.4, 0.6, 1)
						thresholds <- c(0.4, 0.6)
						testthat::expect_error(object = confidence(predictions = predictions,
																						 thresholds = thresholds,
																						 type = "neutral"),
												 regexp = NULL)
						testthat::expect_warning(object = confidence(observations = as.numeric(c(0L, 0L, 0L, 1L, 1L, 1L)),
																							 predictions = predictions,
																							 thresholds = thresholds,
																							 type = "neutral"),
													 regexp = NULL)
						testthat::expect_warning(object = confidence(observations = as.character(c(0L, 0L, 0L, 1L, 1L, 1L)),
																							 predictions = predictions,
																							 thresholds = thresholds,
																							 type = "neutral"),
													 regexp = NULL)
						testthat::expect_silent(object = confidence(observations = c(0L, 0L, 0L, 1L, 1L, 1L),
																							predictions = predictions,
																							thresholds = thresholds,
																							type = "neutral"))
						testthat::expect_error(object = confidence(observations = c(0L, -2L, 0L, 1L, 1L, 1L),
																						 predictions = predictions,
																						 thresholds = thresholds,
																						 type = "neutral"),
												 regexp = NULL)
						testthat::expect_error(object = confidence(observations = c(0L, 0L, 0L, 1L, 1L, 5L),
																						 predictions = predictions,
																						 thresholds = thresholds,
																						 type = "neutral"),
												 regexp = NULL)
						testthat::expect_error(object = confidence(observations = integer(length = 0),
																						 predictions = predictions,
																						 thresholds = thresholds,
																						 type = "neutral"),
												 regexp = NULL)
					}
)

testthat::test_that(desc = "returns errors/warnings if needed - parameter: predictions",
					code = {
						observations <- c(0L, 0L, 0L, 1L, 1L, 1L)
						thresholds <- c(0.4, 0.6)
						testthat::expect_error(object = confidence(observations = observations,
																						 thresholds = thresholds,
																						 type = "neutral"),
												 regexp = NULL)
						testthat::expect_warning(object = confidence(observations = observations,
																							 predictions = as.character(c(0, 0.2, 0.5, 0.4, 0.6, 1)),
																							 thresholds = thresholds,
																							 type = "neutral"),
													 regexp = NULL)
						testthat::expect_silent(object = confidence(observations = observations,
																							predictions = c(0, 0.2, 0.5, 0.4, 0.6, 1),
																							thresholds = thresholds,
																							type = "neutral"))
						testthat::expect_warning(object = confidence(observations = observations,
																						 predictions = c(-0.6, 0.2, 0.5, 0.4, 0.6, 1),
																						 thresholds = thresholds,
																						 type = "neutral"),
												 regexp = NULL)
						testthat::expect_warning(object = confidence(observations = observations,
																						 predictions = c(0, 0.2, 0.5, 0.4, 0.6, 1.6),
																						 thresholds = thresholds,
																						 type = "neutral"),
												 regexp = NULL)
						testthat::expect_error(object = confidence(observations = observations,
																						 predictions = numeric(length = 0),
																						 thresholds = thresholds,
																						 type = "neutral"),
												 regexp = NULL)
					}
)

testthat::test_that(desc = "returns errors/warnings if needed - both observations amd predictions",
					code = {
						testthat::expect_error(object = confidence(thresholds = thresholds,
																						 type = "neutral"),
												 regexp = NULL)
						testthat::expect_error(object = confidence(),
												 regexp = NULL)
					}
)

testthat::test_that(desc = "returns errors/warnings if needed - parameter: thresholds",
					code = {
						observations <- c(0L, 0L, 0L, 1L, 1L, 1L)
						predictions <- c(0, 0.2, 0.5, 0.4, 0.6, 1)
						testthat::expect_warning(object = confidence(observations = observations,
																						 predictions = predictions,
																						 thresholds = c("0.2", "0.5"),
																						 type = "neutral"),
												 regexp = NULL)
						testthat::expect_error(object = confidence(observations = observations,
																							 predictions = predictions,
																							 thresholds = numeric(length = 0),
																							 type = "neutral"),
													 regexp = NULL)
						testthat::expect_error(object = confidence(observations = observations,
																							 predictions = predictions,
																							 thresholds = 0.5,
																							 type = "neutral"),
													 regexp = NULL)
						testthat::expect_warning(object = confidence(observations = observations,
																							 predictions = predictions,
																							 thresholds = c(0.2, 0.5, 0.7),
																							 type = "neutral"),
													 regexp = NULL)
						testthat::expect_warning(object = confidence(observations = observations,
																							 predictions = predictions,
																							 thresholds = c(-0.2, 0.8),
																							 type = "neutral"),
													 regexp = NULL)
						testthat::expect_warning(object = confidence(observations = observations,
																							 predictions = predictions,
																							 thresholds = c(NA_real_, 0.7),
																							 type = "neutral"),
													 regexp = NULL)
						testthat::expect_warning(object = confidence(observations = observations,
																							 predictions = predictions,
																							 thresholds = c(0.2, 1.8),
																							 type = "neutral"),
													 regexp = NULL)
						testthat::expect_warning(object = confidence(observations = observations,
																							 predictions = predictions,
																							 thresholds = c(0.2, NA_real_),
																							 type = "neutral"),
													 regexp = NULL)
						testthat::expect_warning(object = confidence(observations = observations,
																							 predictions = predictions,
																							 thresholds = c(0.7, 0.5),
																							 type = "neutral"),
													 regexp = NULL)
						testthat::expect_warning(object = confidence(observations = observations,
																							 predictions = predictions,
																							 thresholds = c(0.7, 0.7),
																							 type = "neutral"),
													 regexp = NULL)
						testthat::expect_silent(object = confidence(observations = observations,
																							predictions = predictions,
																							type = "neutral"))
					}
)

testthat::test_that(desc = "returns errors/warnings if needed - parameter: type",
					code = {
						observations <- c(0L, 0L, 0L, 1L, 1L, 1L)
						predictions <- c(0, 0.2, 0.5, 0.4, 0.6, 1)
						thresholds <- c(0.4, 0.6)
						testthat::expect_error(object = confidence(observations = observations,
																						 predictions = predictions,
																						 thresholds = thresholds,
																						 type = 5),
												 regexp = NULL)
						testthat::expect_error(object = confidence(observations = observations,
																						 predictions = predictions,
																						 thresholds = thresholds,
																						 type = character(length = 0)),
												 regexp = NULL)
						testthat::expect_warning(object = confidence(observations = observations,
																						 predictions = predictions,
																						 thresholds = thresholds,
																						 type = c("positive", "neutral")),
												 regexp = NULL)
						testthat::expect_error(object = confidence(observations = observations,
																							 predictions = predictions,
																							 thresholds = thresholds,
																							 type = "pos"),
													 regexp = NULL)
					}
)
testthat::test_that(desc = "returns errors/warnings if needed - complex examples",
					code = {
						observations_4000_numeric <- c(rep(x = 0, times = 3000),
																					 rep(x = 1, times = 1000))
						predictions_4000_strange <- c(runif(n = 3000, min = -0.3, max = 0.4),
																					runif(n = 1000, min = 0.6, max = 1.5))
						testthat::expect_warning(object = expect_warning(object = confidence(observations = observations_4000_numeric,
											                                                 predictions = predictions_4000_strange,
																																			 thresholds = c(0.2, 0.7)),
																									 regexp = NULL),
													 regexp = NULL)
						mask_of_normal_predictions <- predictions_4000_strange >= 0 & predictions_4000_strange <= 1
						testthat::expect_silent(object = confidence(observations = as.integer(observations_4000_numeric)[mask_of_normal_predictions],
																							predictions = predictions_4000_strange[mask_of_normal_predictions],
																							thresholds = c(0.2, 0.7)))
					}
)