Make work with all versions of xgboost (#119)

Author: EmilHvitfeldt

NEWS.md

@@ -1,5 +1,7 @@
 # orbital (development version)
 
+* Make work with new versions of xgboost. (#119)
+
 # orbital 0.4.0
 
 * Added support for tailor package and its integration into workflows. The following adjustments have gained `orbital()` support. (#103)

R/model-xgboost.R

@@ -10,7 +10,7 @@ orbital.xgb.Booster <- function(
   type <- default_type(type)
 
   if (mode == "classification") {
-    objective <- x$params$objective
+    objective <- x$params$objective %||% attr(x, "params")$objective
     objective <- rlang::arg_match0(
       objective,
       c("multi:softprob", "binary:logistic")
@@ -32,7 +32,10 @@ orbital.xgb.Booster <- function(
 xgboost_multisoft <- function(x, type, lvl) {
   trees <- tidypredict::.extract_xgb_trees(x)
 
-  trees_split <- split(trees, rep(seq_along(lvl), x$niter))
+  trees_split <- split(
+    trees,
+    rep(seq_along(lvl), x$niter %||% nrow(attr(x, "evaluation_log")))
+  )
   trees_split <- lapply(trees_split, collapse_stumps)
   trees_split <- vapply(trees_split, paste, character(1), collapse = " + ")
 

tests/testthat/test-model-xgboost.R

@@ -1,3 +1,35 @@
+test_that("boost_tree(), objective = reg:squarederror, works with type = numeric", {
+  skip_if_not_installed("parsnip")
+  skip_if_not_installed("tidypredict")
+  skip_if_not_installed("xgboost")
+
+  bt_spec <- parsnip::boost_tree(mode = "regression", engine = "xgboost")
+
+  bt_fit <- parsnip::fit(bt_spec, mpg ~ disp + vs + hp, mtcars)
+
+  orb_obj <- orbital(bt_fit)
+
+  # to avoid exact split values
+  mtcars <- mtcars + 0.1
+
+  preds <- predict(orb_obj, mtcars)
+  exps <- predict(bt_fit, mtcars)
+
+  expect_named(preds, ".pred")
+  expect_type(preds$.pred, "double")
+
+  exps <- as.data.frame(exps)
+
+  rownames(preds) <- NULL
+  rownames(exps) <- NULL
+
+  expect_equal(
+    preds,
+    exps,
+    tolerance = 0.0000001
+  )
+})
+
 test_that("boost_tree(), objective = binary:logistic, works with type = class", {
   skip_if_not_installed("parsnip")
   skip_if_not_installed("tidypredict")
@@ -11,6 +43,9 @@ test_that("boost_tree(), objective = binary:logistic, works with type = class",
 
   orb_obj <- orbital(bt_fit, type = "class")
 
+  # to avoid exact split values
+  mtcars[, -8] <- mtcars[, -8] + 0.1
+
   preds <- predict(orb_obj, mtcars)
   exps <- predict(bt_fit, mtcars)
 
@@ -23,7 +58,7 @@ test_that("boost_tree(), objective = binary:logistic, works with type = class",
   )
 })
 
-test_that("boost_tree(), objective = binary:logistic, works with type = class", {
+test_that("boost_tree(), objective = multi:softprob, works with type = class", {
   skip_if_not_installed("parsnip")
   skip_if_not_installed("tidypredict")
   skip_if_not_installed("xgboost")
@@ -34,6 +69,9 @@ test_that("boost_tree(), objective = binary:logistic, works with type = class",
 
   orb_obj <- orbital(bt_fit, type = "class")
 
+  # to avoid exact split values
+  iris[, -5] <- iris[, -5] + 0.05
+
   preds <- predict(orb_obj, iris)
   exps <- predict(bt_fit, iris)
 
@@ -59,6 +97,9 @@ test_that("boost_tree(), objective = binary:logistic, works with type = prob", {
 
   orb_obj <- orbital(bt_fit, type = "prob")
 
+  # to avoid exact split values
+  mtcars[, -8] <- mtcars[, -8] + 0.1
+
   preds <- predict(orb_obj, mtcars)
   exps <- predict(bt_fit, mtcars, type = "prob")
 
@@ -78,7 +119,7 @@ test_that("boost_tree(), objective = binary:logistic, works with type = prob", {
   )
 })
 
-test_that("boost_tree(), objective = binary:logistic, works with type = prob", {
+test_that("boost_tree(), objective = multi:softprob, works with type = prob", {
   skip_if_not_installed("parsnip")
   skip_if_not_installed("tidypredict")
   skip_if_not_installed("xgboost")
@@ -89,6 +130,9 @@ test_that("boost_tree(), objective = binary:logistic, works with type = prob", {
 
   orb_obj <- orbital(bt_fit, type = "prob")
 
+  # to avoid exact split values
+  iris[, -5] <- iris[, -5] + 0.05
+
   preds <- predict(orb_obj, iris)
   exps <- predict(bt_fit, iris, type = "prob")
 
@@ -122,6 +166,9 @@ test_that("boost_tree(), objective = binary:logistic, works with type = c(class,
 
   orb_obj <- orbital(bt_fit, type = c("class", "prob"))
 
+  # to avoid exact split values
+  mtcars[, -8] <- mtcars[, -8] + 0.1
+
   preds <- predict(orb_obj, mtcars)
   exps <- dplyr::bind_cols(
     predict(bt_fit, mtcars, type = c("class")),
@@ -146,7 +193,7 @@ test_that("boost_tree(), objective = binary:logistic, works with type = c(class,
   )
 })
 
-test_that("boost_tree(), objective = binary:logistic, works with type = c(class, prob)", {
+test_that("boost_tree(), objective = multi:softprob, works with type = c(class, prob)", {
   skip_if_not_installed("parsnip")
   skip_if_not_installed("tidypredict")
   skip_if_not_installed("xgboost")
@@ -157,6 +204,9 @@ test_that("boost_tree(), objective = binary:logistic, works with type = c(class,
 
   orb_obj <- orbital(bt_fit, type = c("class", "prob"))
 
+  # to avoid exact split values
+  iris[, -5] <- iris[, -5] + 0.05
+
   preds <- predict(orb_obj, iris)
   exps <- dplyr::bind_cols(
     predict(bt_fit, iris, type = c("class")),