diff --git a/R/pca-fit.R b/R/pca-fit.R index 04b83ec..1b541df 100644 --- a/R/pca-fit.R +++ b/R/pca-fit.R @@ -26,7 +26,10 @@ apd_pca_impl <- function(predictors, threshold) { retx = TRUE ) - # TODO: verify threshold \in (0, 1] + if (threshold <= 0 || threshold > 1) { + rlang::abort("threshold must be between 0 and 1: (0, 1]") + } + eigs <- pcs$sdev^2 cum_sum <- cumsum(eigs) / sum(eigs) num_comp <- sum(cum_sum <= threshold) + 1 diff --git a/R/pca-score.R b/R/pca-score.R index cfa29f6..6742551 100644 --- a/R/pca-score.R +++ b/R/pca-score.R @@ -7,6 +7,21 @@ score_apd_pca_numeric <- function(model, predictors) { rlang::abort("The model must contain a pcs argument.") } + incomplete_rows <- which(!stats::complete.cases(predictors)) + + if (length(incomplete_rows) > 0) { + cols_with_na <- names(which(colSums(is.na(predictors)) > 0)) + msg <- paste0( + "`new_data` contains missing predictor values; score columns may be `NA`. ", + "Rows with missing values: ", + paste(incomplete_rows, collapse = ", "), + ". Columns with missing values: ", + paste(cols_with_na, collapse = ", "), + "." + ) + rlang::warn(msg) + } + # Predict output and subset using `num_comp` predicted_output <- stats::predict(model$pcs, predictors) predicted_output <- predicted_output[, 1:model$num_comp, drop = FALSE] diff --git a/tests/testthat/test-pca-fit.R b/tests/testthat/test-pca-fit.R index 3443fd7..0715acb 100644 --- a/tests/testthat/test-pca-fit.R +++ b/tests/testthat/test-pca-fit.R @@ -110,3 +110,11 @@ test_that("`apd_pca` is not defined for vectors", { expected_message ) }) + +test_that ("invalid threshold value throws error", { + error_message <- "threshold must be between 0 and 1: \\(0, 1\\]" + expect_error(apd_pca(mtcars, threshold = 1.1), + error_message) + expect_error(apd_pca(mtcars, threshold = 0), + error_message) +}) diff --git a/tests/testthat/test-pca-score.R b/tests/testthat/test-pca-score.R index 8a12a00..73b4af2 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_apd_pca_numeric` warns for missing predictor values", { + model <- apd_pca(mtcars %>% dplyr::slice(1:15)) + predictors <- as.matrix(mtcars %>% dplyr::slice(16:30)) + predictors[1, 1] <- NA_real_ + + expect_warning( + score_apd_pca_numeric(model, predictors), + "`new_data` contains missing predictor values" + ) +})