Fix workflowsets imports, zero-coefficient labeling, and feature-cutoff bugs from #31 review

DESCRIPTION

@@ -72,7 +72,6 @@ Imports:
     utils,
     withr,
     workflows,
-    workflowsets,
     yardstick
 biocViews:
     Software,

NAMESPACE

@@ -170,8 +170,6 @@ importFrom(tune,tune_grid)
 importFrom(workflows,add_model)
 importFrom(workflows,add_recipe)
 importFrom(workflows,workflow)
-importFrom(workflowsets,extract_fit_parsnip)
-importFrom(workflowsets,extract_spec_parsnip)
 importFrom(yardstick,bal_accuracy)
 importFrom(yardstick,conf_mat)
 importFrom(yardstick,f_meas)

R/core_ml.R

@@ -46,8 +46,6 @@
 #' @importFrom workflows add_model
 #' @importFrom workflows add_recipe
 #' @importFrom workflows workflow
-#' @importFrom workflowsets extract_fit_parsnip
-#' @importFrom workflowsets extract_spec_parsnip
 #' @importFrom yardstick bal_accuracy
 #' @importFrom yardstick conf_mat
 #' @importFrom yardstick f_meas
@@ -249,10 +247,9 @@ buildWflow <- function(parsnip_mod, recipe) {
 #' )
 #' @export
 buildTuningGrid <- function(
-  model = "LR",
-  penalty_vec = 10^seq(-4, -1, length.out = 10),
-  mix_vec = 0:5 / 5
-) {
+    model = "LR",
+    penalty_vec = 10^seq(-4, -1, length.out = 10),
+    mix_vec = 0:5 / 5) {
   .checkArgModel(model)
 
   if (model == "LR") {
@@ -770,7 +767,7 @@ calculateEvalMets <- function(test_data_plus_predictions) {
   tibble::tibble(
     Variable = names(coefs),
     Importance = abs(unname(coefs)),
-    Sign = ifelse(coefs > 0, "POS", "NEG")
+    Sign = ifelse(coefs > 0, "POS", ifelse(coefs < 0, "NEG", NA_character_))
   ) |>
     dplyr::arrange(dplyr::desc(Importance))
 }
@@ -796,9 +793,8 @@ calculateEvalMets <- function(test_data_plus_predictions) {
 #' extractTopFeats(demo_fit, n_top_feats = 10)
 #' @export
 extractTopFeats <- function(
-  fit, prop_vi_top_feats = c(0, 1),
-  n_top_feats = NA
-) {
+    fit, prop_vi_top_feats = c(0, 1),
+    n_top_feats = NA) {
   .checkArgWflow(fit)
 
   if (!is.na(n_top_feats)) {
@@ -860,7 +856,7 @@ extractTopFeats <- function(
 
     top_feats_and_VIs <- feats_arranged |>
       dplyr::mutate(cum_imp = cumsum(Importance)) |>
-      dplyr::filter(cum_imp < cum_vi_upper & cum_imp > cum_vi_lower)
+      dplyr::filter(cum_imp <= cum_vi_upper & cum_imp > cum_vi_lower)
   }
 
   top_feat_tibble <- tibble::tibble(

tests/testthat/test-core-ml.R

@@ -176,3 +176,48 @@ test_that(".viGlmnet reproduces vip::vi() for binomial glmnet fits", {
   expected <- expected[names(expected) != "(Intercept)"]
   expect_equal(vi$Importance, sort(abs(unname(expected)), decreasing = TRUE))
 })
+
+test_that(".viGlmnet labels exactly-zero coefficients NA, not \"NEG\"", {
+  # Mock .viGlmnet()'s two external calls so a zero coefficient is
+  # guaranteed, rather than depending on a real fit happening to produce
+  # one. positive/negative/zero coefficients, plus an intercept that must
+  # be dropped.
+  local_mocked_bindings(
+    extract_fit_engine = function(fit) list(lambda = c(0.5, 0.1, 0.01)),
+    .package = "parsnip"
+  )
+  local_mocked_bindings(
+    coef = function(object, s, ...) {
+      matrix(
+        c(1, 2, -3, 0),
+        dimnames = list(
+          c("(Intercept)", "pos_feat", "neg_feat", "zero_feat"), NULL
+        )
+      )
+    },
+    .package = "stats"
+  )
+
+  vi <- .viGlmnet(fit = "placeholder")
+
+  expect_equal(unname(vi$Sign[vi$Variable == "pos_feat"]), "POS")
+  expect_equal(unname(vi$Sign[vi$Variable == "neg_feat"]), "NEG")
+  expect_true(is.na(vi$Sign[vi$Variable == "zero_feat"]))
+})
+
+test_that("extractTopFeats includes the last feature at prop_vi_top_feats = c(0, 1)", {
+  skip_if_missing_deps()
+  fx <- make_pipeline_fixture()
+  mod <- parsnip::logistic_reg(penalty = 0.01, mixture = 0) |>
+    parsnip::set_engine("glmnet")
+  fit <- buildWflow(mod, buildRecipe(fx)) |> parsnip::fit(data = fx)
+
+  # The default prop_vi_top_feats = c(0, 1) is documented to return all
+  # features; the strict "<" upper-bound comparison used to drop the least
+  # important one, since its cumulative importance exactly equals the total.
+  all_feats <- .viGlmnet(fit)
+  top <- extractTopFeats(fit, prop_vi_top_feats = c(0, 1), n_top_feats = NA)
+
+  expect_equal(nrow(top), nrow(all_feats))
+  expect_setequal(top$Variable, all_feats$Variable)
+})