[R-package] ensure use of interaction_constraints does not lead to features being ignored

R-package/R/utils.R

@@ -59,68 +59,66 @@
 
 }
 
+# [description]
+#
+# Besides applying checks, this function
+#
+# 1. turns feature *names* into 1-based integer positions, then
+# 2. adds an extra list element with skipped features, then
+# 2. turns 1-based integer positions into 0-based positions, and finally
+# 3. collapses the values of each list element into a string like "[0, 1]".
+#
 .check_interaction_constraints <- function(interaction_constraints, column_names) {
+ if (is.null(interaction_constraints)) {
+ return(list())
+ }
+ if (!identical(class(interaction_constraints), "list")) {
+ stop("interaction_constraints must be a list")
+ }
 
- # Convert interaction constraints to feature numbers
- string_constraints <- list()
+ column_indices <- seq_along(column_names)
 
- if (!is.null(interaction_constraints)) {
+ # Convert feature names to 1-based integer positions and apply checks
+ for (j in seq_along(interaction_constraints)) {
+ constraint <- interaction_constraints[[j]]
 
- if (!methods::is(interaction_constraints, "list")) {
- stop("interaction_constraints must be a list")
- }
- constraint_is_character_or_numeric <- sapply(
- X = interaction_constraints
- , FUN = function(x) {
- return(is.character(x) || is.numeric(x))
- }
- )
- if (!all(constraint_is_character_or_numeric)) {
- stop("every element in interaction_constraints must be a character vector or numeric vector")
+ if (is.character(constraint)) {
+ constraint_indices <- match(constraint, column_names)
+ } else if (is.numeric(constraint)) {
+ constraint_indices <- as.integer(constraint)
+ } else {
+ stop("every element in interaction_constraints must be a character vector or numeric vector")
  }
 
- for (constraint in interaction_constraints) {
-
- # Check for character name
- if (is.character(constraint)) {
-
- constraint_indices <- as.integer(match(constraint, column_names) - 1L)
-
- # Provided indices, but some indices are not existing?
- if (sum(is.na(constraint_indices)) > 0L) {
- stop(
- "supplied an unknown feature in interaction_constraints "
- , sQuote(constraint[is.na(constraint_indices)])
- )
- }
-
- } else {
-
- # Check that constraint indices are at most number of features
- if (max(constraint) > length(column_names)) {
- stop(
- "supplied a too large value in interaction_constraints: "
- , max(constraint)
- , " but only "
- , length(column_names)
- , " features"
- )
- }
-
- # Store indices as [0, n-1] indexed instead of [1, n] indexed
- constraint_indices <- as.integer(constraint - 1L)
-
- }
-
- # Convert constraint to string
- constraint_string <- paste0("[", paste0(constraint_indices, collapse = ","), "]")
- string_constraints <- append(string_constraints, constraint_string)
+ # Features outside range?
+ bad <- !(constraint_indices %in% column_indices)
+ if (any(bad)) {
+ stop(
+ "supplied an unknown feature in interaction_constraints "
+ , sQuote(constraint[bad])
+ )
  }
 
+ interaction_constraints[[j]] <- constraint_indices
  }
 
- return(string_constraints)
+ # Add missing features as new interaction set
+ remaining_indices <- setdiff(
+ column_indices, sort(unique(unlist(interaction_constraints)))
+ )
+ if (length(remaining_indices) > 0L) {
+ interaction_constraints <- c(
+ interaction_constraints, list(remaining_indices)
+ )
+ }
 
+ # Turn indices 0-based and convert to string
+ for (j in seq_along(interaction_constraints)) {
+ interaction_constraints[[j]] <- paste0(
+ "[", paste0(interaction_constraints[[j]] - 1L, collapse = ","), "]"
+ )
+ }
+ return(interaction_constraints)
 }
 
 

R-package/tests/testthat/test_basic.R

@@ -2773,7 +2773,7 @@ test_that(paste0("lgb.train() throws an informative error if the members of inte
  }, "every element in interaction_constraints must be a character vector or numeric vector")
 })
 
-test_that("lgb.train() throws an informative error if interaction_constraints contains a too large index", {
+test_that("lgb.train() throws an error if interaction_constraints contains wrong features", {
  dtrain <- lgb.Dataset(train$data, label = train$label)
  params <- list(objective = "regression",
  interaction_constraints = list(c(1L, length(colnames(train$data)) + 1L), 3L))
@@ -2783,7 +2783,7 @@ test_that("lgb.train() throws an informative error if interaction_constraints co
  , params = params
  , nrounds = 2L
  )
- }, "supplied a too large value in interaction_constraints")
+ })
 })
 
 test_that(paste0("lgb.train() gives same result when interaction_constraints is specified as a list of ",

R-package/tests/testthat/test_lgb.Booster.R

@@ -174,7 +174,7 @@ test_that("Loading a Booster from a text file works", {
  , bagging_freq = 1L
  , boost_from_average = FALSE
  , categorical_feature = c(1L, 2L)
- , interaction_constraints = list(c(1L, 2L), 1L)
+ , interaction_constraints = list(1L:2L, 3L, 4L:ncol(train$data))
  , feature_contri = rep(0.5, ncol(train$data))
  , metric = c("mape", "average_precision")
  , learning_rate = 1.0

R-package/tests/testthat/test_utils.R

@@ -147,3 +147,21 @@ test_that(".equal_or_both_null produces expected results", {
  expect_false(.equal_or_both_null(10.0, 1L))
  expect_true(.equal_or_both_null(0L, 0L))
 })
+
+test_that(".check_interaction_constraints() adds skipped features", {
+ ref <- letters[1L:5L]
+ ic_num <- list(1L, c(2L, 3L))
+ ic_char <- list("a", c("b", "c"))
+ expected <- list("[0]", "[1,2]", "[3,4]")
+
+ ic_checked_num <- .check_interaction_constraints(
+ interaction_constraints = ic_num, column_names = ref
+ )
+
+ ic_checked_char <- .check_interaction_constraints(
+ interaction_constraints = ic_char, column_names = ref
+ )
+
+ expect_equal(ic_checked_num, expected)
+ expect_equal(ic_checked_char, expected)
+})