replacing vip::vi() call with internal functionality

DESCRIPTION

@@ -35,8 +35,6 @@ Suggests:
     xgboost
 VignetteBuilder: knitr
 Config/testthat/edition: 3
-Remotes:
-    vip=url::https://cran.r-project.org/src/contrib/Archive/vip/vip_0.4.6.tar.gz
 Imports:
     arrow,
     BiocParallel,
@@ -72,7 +70,6 @@ Imports:
     tidyr,
     tune,
     utils,
-    vip,
     withr,
     workflows,
     workflowsets,

NAMESPACE

@@ -1,9 +1,27 @@
 # Generated by roxygen2: do not edit by hand
 
+export(.getFeatureTypes)
 export(.getTargetVarName)
+export(.register_parquet_views)
 export(applyBenjaminiHochberg)
 export(buildLRModel)
+export(buildPerfPq)
+export(buildPerfPqCrossCountry)
+export(buildPerfPqCrossDrug)
+export(buildPerfPqCrossYear)
+export(buildPerfPqLOOCountry)
+export(buildPerfPqLOODrug)
+export(buildPerfPqLOOYear)
+export(buildPerfPqMDR)
+export(buildPerfPqYearCountry)
+export(buildPredPqMDR)
 export(buildRecipe)
+export(buildTopFeatsPq)
+export(buildTopFeatsPqLOOCountry)
+export(buildTopFeatsPqLOODrug)
+export(buildTopFeatsPqLOOYear)
+export(buildTopFeatsPqMDR)
+export(buildTopFeatsPqYearCountry)
 export(buildTuningGrid)
 export(buildWflow)
 export(calculateEvalMets)
@@ -18,6 +36,7 @@ export(generateMLInputs)
 export(getConfusionMatrix)
 export(getNumFeat)
 export(loadMLInputTibble)
+export(parse_ml_filename)
 export(plotBaselineComparison)
 export(plotCM)
 export(plotCrossDrug)
@@ -150,8 +169,6 @@ importFrom(tune,extract_fit_parsnip)
 importFrom(tune,finalize_workflow)
 importFrom(tune,select_best)
 importFrom(tune,tune_grid)
-importFrom(vip,vi)
-importFrom(vip,vip)
 importFrom(workflows,add_model)
 importFrom(workflows,add_recipe)
 importFrom(workflows,workflow)

R/core_ml.R

@@ -43,7 +43,6 @@
 #' @importFrom tune finalize_workflow
 #' @importFrom tune select_best
 #' @importFrom tune tune_grid
-#' @importFrom vip vi
 #' @importFrom workflows add_model
 #' @importFrom workflows add_recipe
 #' @importFrom workflows workflow
@@ -751,6 +750,31 @@ calculateEvalMets <- function(test_data_plus_predictions) {
   return(c(f1, auprc, bal_acc, mcc, nmcc, log2_apop))
 }
 
+#' Variable importance for a binomial glmnet fit
+#'
+#' Internal replacement for `vip::vi()`, dropped as a dependency after it left
+#' CRAN. Returns `|coefficient|` as `Importance` and its direction as `Sign`,
+#' sorted by decreasing importance.
+#'
+#' Importance is taken at glmnet's minimum lambda, not the tuned `penalty`.
+#' That is what `vip::vi()` did.
+#'
+#' @param fit A fitted workflow backed by a binomial glmnet engine.
+#' @return A tibble with `Variable`, `Importance`, and `Sign` columns.
+#' @keywords internal
+.viGlmnet <- function(fit) {
+  glmnet_fit <- parsnip::extract_fit_engine(fit)
+  coefs <- stats::coef(glmnet_fit, s = min(glmnet_fit$lambda))[, 1, drop = TRUE]
+  coefs <- coefs[names(coefs) != "(Intercept)"]
+
+  tibble::tibble(
+    Variable = names(coefs),
+    Importance = abs(unname(coefs)),
+    Sign = ifelse(coefs > 0, "POS", "NEG")
+  ) |>
+    dplyr::arrange(dplyr::desc(Importance))
+}
+
 #' extractTopFeats()
 #'
 #' Returns the top features that an ML model found to be important for
@@ -793,30 +817,8 @@ extractTopFeats <- function(
     stop("Please specify either `n_top_feats` or `prop_vi_top_feats`.")
   }
 
-  feats_arranged <- fit |>
-    workflowsets::extract_fit_parsnip() |>
-    vip::vi() |>
-    dplyr::arrange(dplyr::desc(Importance))
-
-  if (!is.na(n_top_feats)) {
-    top_feats_and_VIs <- feats_arranged |> dplyr::slice(seq_len(n_top_feats))
-  } else if (any(!is.na(prop_vi_top_feats))) {
-    cum_vi_lower <- prop_vi_top_feats[1] * sum(feats_arranged$Importance)
-    cum_vi_upper <- prop_vi_top_feats[2] * sum(feats_arranged$Importance)
-
-    top_feats_and_VIs <- feats_arranged |>
-      dplyr::mutate(cum_imp = cumsum(Importance)) |>
-      dplyr::filter(cum_imp < cum_vi_upper & cum_imp > cum_vi_lower)
-  }
-
-  top_feat_tibble <- tibble::tibble(
-    Variable = dplyr::pull(top_feats_and_VIs, Variable),
-    Importance = dplyr::pull(top_feats_and_VIs, Importance),
-    Sign = dplyr::pull(top_feats_and_VIs, Sign)
-  )
-
-  # Take a different approach if using multi-class (the previous code would give
-  # a less meaningful result).
+  # Multi-class: glmnet returns one coefficient matrix per class, so there is no
+  # single ranking to slice. Handled before `.viGlmnet()`, which expects one.
   if (is(fit$fit$actions$model$spec, "multinom_reg")) {
     warning(
       "Extracting top features from a multi-class model. ",
@@ -844,7 +846,28 @@ extractTopFeats <- function(
         values_fill = 0 # Fill missing values with 0.
       ) |>
       dplyr::filter(dplyr::if_any(-Variable, ~ . != 0))
+
+    return(top_feat_tibble)
+  }
+
+  feats_arranged <- .viGlmnet(fit)
+
+  if (!is.na(n_top_feats)) {
+    top_feats_and_VIs <- feats_arranged |> dplyr::slice(seq_len(n_top_feats))
+  } else if (any(!is.na(prop_vi_top_feats))) {
+    cum_vi_lower <- prop_vi_top_feats[1] * sum(feats_arranged$Importance)
+    cum_vi_upper <- prop_vi_top_feats[2] * sum(feats_arranged$Importance)
+
+    top_feats_and_VIs <- feats_arranged |>
+      dplyr::mutate(cum_imp = cumsum(Importance)) |>
+      dplyr::filter(cum_imp < cum_vi_upper & cum_imp > cum_vi_lower)
   }
 
+  top_feat_tibble <- tibble::tibble(
+    Variable = dplyr::pull(top_feats_and_VIs, Variable),
+    Importance = dplyr::pull(top_feats_and_VIs, Importance),
+    Sign = dplyr::pull(top_feats_and_VIs, Sign)
+  )
+
   return(top_feat_tibble)
 }

R/plot_ml.R

@@ -18,7 +18,6 @@
 #' @importFrom ggplot2 ylim
 #' @importFrom graphics barplot
 #' @importFrom tune extract_fit_parsnip
-#' @importFrom vip vip
 #' @importFrom yardstick pr_curve
 NULL
 

R/run_ml_pipeline.R

@@ -328,7 +328,7 @@ runMLPipeline <- function(
     prop_vi_top_feats = prop_vi_top_feats
   )
 
-  # Account for the case where `vip::vi()` assigned a variable importance of
+  # Account for the case where a feature was assigned a variable importance of
   # zero, thereby not including the full `n_top_feats` requested. Do this only
   # if `n_top_feats` was specified instead of `prop_vi_top_feats`. Features will
   # be randomly assigned as top hits. This is important for downstream

tests/testthat/test-core-ml.R

@@ -126,3 +126,53 @@ test_that("extractTopFeats rejects conflicting / missing selectors", {
   expect_setequal(colnames(top), c("Variable", "Importance", "Sign"))
   expect_lte(nrow(top), 2)
 })
+
+# A multi-class (MDR-style) fit, where glmnet returns one coefficient matrix per
+# class. This is the case that must not reach `.viGlmnet()`.
+make_multiclass_fit <- function() {
+  set.seed(42)
+  n <- 30
+  mc <- tibble::tibble(
+    genome_id = paste0("g", seq_len(n)),
+    resistant_classes = factor(rep(c("A", "B", "C"), each = n / 3))
+  )
+  for (j in 1:8) mc[[paste0("feat_", j)]] <- as.integer(rbinom(n, 1, 0.5))
+
+  mod <- parsnip::multinom_reg(penalty = 0.01, mixture = 0.5) |>
+    parsnip::set_engine("glmnet")
+  buildWflow(mod, buildRecipe(mc)) |> parsnip::fit(data = mc)
+}
+
+test_that("extractTopFeats handles multi-class fits with per-class columns", {
+  skip_if_missing_deps()
+  fit <- make_multiclass_fit()
+
+  expect_warning(
+    top <- extractTopFeats(fit, n_top_feats = 5),
+    "multi-class"
+  )
+
+  # One column per class, not the binary Variable/Importance/Sign triple.
+  expect_setequal(colnames(top), c("Variable", "A", "B", "C"))
+  expect_gt(nrow(top), 0)
+})
+
+test_that(".viGlmnet reproduces vip::vi() for binomial glmnet fits", {
+  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)
+
+  vi <- .viGlmnet(fit)
+  expect_setequal(colnames(vi), c("Variable", "Importance", "Sign"))
+  expect_true(all(vi$Sign %in% c("POS", "NEG")))
+  # Downstream slicing relies on the decreasing sort `vip::vi()` provided.
+  expect_equal(vi$Importance, sort(vi$Importance, decreasing = TRUE))
+
+  # Importance is |coefficient| at the minimum lambda, not the tuned penalty.
+  gf <- parsnip::extract_fit_engine(fit)
+  expected <- stats::coef(gf, s = min(gf$lambda))[, 1, drop = TRUE]
+  expected <- expected[names(expected) != "(Intercept)"]
+  expect_equal(vi$Importance, sort(abs(unname(expected)), decreasing = TRUE))
+})

tests/testthat/test-pipeline.R

@@ -10,7 +10,6 @@ skip_pipeline_if_missing <- function() {
   skip_if_not_installed("tune")
   skip_if_not_installed("workflows")
   skip_if_not_installed("yardstick")
-  skip_if_not_installed("vip")
 }
 
 minimal_grid_args <- list(