diff --git a/R/helpers.R b/R/helpers.R index a9d360f..3d681e6 100644 --- a/R/helpers.R +++ b/R/helpers.R @@ -57,7 +57,7 @@ get_inv <- function(X) { # Get percentile for new samples get_new_percentile <- function(ref, x_new, grid) { res <- approx(ref, grid, xout = x_new)$y - res[x_new < min(ref, na.rm = TRUE)] <- 0 - res[x_new > max(ref, na.rm = TRUE)] <- 1 + res[x_new < min(ref, na.rm = TRUE)] <- min(grid, na.rm = TRUE) + res[x_new > max(ref, na.rm = TRUE)] <- max(grid, na.rm = TRUE) res } diff --git a/tests/testthat/test-isolation-score.R b/tests/testthat/test-isolation-score.R index 5144926..6bb40bf 100644 --- a/tests/testthat/test-isolation-score.R +++ b/tests/testthat/test-isolation-score.R @@ -16,3 +16,18 @@ test_that("scoring isolation forests", { raw_res <- unname(predict(res_df$model, cells_te)) expect_equal(raw_res, score_te$score) }) + +test_that("isolation score percentiles clamp to 100 for extreme scores", { + skip_if_not_installed("isotree") + + mod <- apd_isolation(iris[, 1:4], nthreads = 1) + new_data <- tibble::tibble( + Sepal.Length = 1e9, + Sepal.Width = 1e9, + Petal.Length = 1e9, + Petal.Width = 1e9 + ) + + res <- score(mod, new_data) + expect_equal(res$score_pctl, 100) +}) diff --git a/tests/testthat/test-pca-score.R b/tests/testthat/test-pca-score.R index b4e311a..28e6952 100644 --- a/tests/testthat/test-pca-score.R +++ b/tests/testthat/test-pca-score.R @@ -78,3 +78,14 @@ test_that("`score_apd_pca_bridge` output is correct", { expected ) }) + +test_that("`score` percentiles clamp to 100 for extreme PCA values", { + model <- apd_pca(mtcars) + predictors <- mtcars[1, , drop = FALSE] + predictors[] <- predictors[] * 1000 + + pctls <- score(model, predictors) |> + dplyr::select(dplyr::ends_with("_pctl")) + + expect_true(all(unlist(pctls, use.names = FALSE) == 100)) +})