Hendrik/xgboost
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

[R] Refactor callback structure and attributes (#9957)

Browse Source
This commit is contained in:
david-cortes
2024-03-01 08:57:47 +01:00
committed by GitHub
parent 3941b31ade
commit 2c12b956da
32 changed files with 2076 additions and 1339 deletions
Download Patch File Download Diff File Expand all files Collapse all files

1
R-package/tests/testthat.R
View File

@@ -1,5 +1,6 @@
library(testthat)
library(xgboost)
library(Matrix)
test_check("xgboost", reporter = ProgressReporter)
RhpcBLASctl::omp_set_num_threads(1)

1
R-package/tests/testthat/test_basic.R
View File

@@ -348,7 +348,6 @@ test_that("xgb.cv works", {
expect_false(is.null(cv$folds) && is.list(cv$folds))
expect_length(cv$folds, 5)
expect_false(is.null(cv$params) && is.list(cv$params))
expect_false(is.null(cv$callbacks))
expect_false(is.null(cv$call))
})

281
R-package/tests/testthat/test_callbacks.R
View File

@@ -28,79 +28,125 @@ param <- list(objective = "binary:logistic", eval_metric = "error",
max_depth = 2, nthread = n_threads)
test_that("cb.print.evaluation works as expected", {
test_that("xgb.cb.print.evaluation works as expected for xgb.train", {
logs1 <- capture.output({
model <- xgb.train(
data = dtrain,
params = list(
objective = "binary:logistic",
eval_metric = "auc",
max_depth = 2,
nthread = n_threads
),
nrounds = 10,
watchlist = list(train = dtrain, test = dtest),
callbacks = list(xgb.cb.print.evaluation(period = 1))
)
})
expect_equal(length(logs1), 10)
expect_true(all(grepl("^\\[\\d{1,2}\\]\ttrain-auc:0\\.\\d+\ttest-auc:0\\.\\d+\\s*$", logs1)))
lapply(seq(1, 10), function(x) expect_true(grepl(paste0("^\\[", x), logs1[x])))
bst_evaluation <- c('train-auc' = 0.9, 'test-auc' = 0.8)
bst_evaluation_err <- NULL
begin_iteration <- 1
end_iteration <- 7
f0 <- cb.print.evaluation(period = 0)
f1 <- cb.print.evaluation(period = 1)
f5 <- cb.print.evaluation(period = 5)
expect_false(is.null(attr(f1, 'call')))
expect_equal(attr(f1, 'name'), 'cb.print.evaluation')
iteration <- 1
expect_silent(f0())
expect_output(f1(), "\\[1\\]\ttrain-auc:0.900000\ttest-auc:0.800000")
expect_output(f5(), "\\[1\\]\ttrain-auc:0.900000\ttest-auc:0.800000")
expect_null(f1())
iteration <- 2
expect_output(f1(), "\\[2\\]\ttrain-auc:0.900000\ttest-auc:0.800000")
expect_silent(f5())
iteration <- 7
expect_output(f1(), "\\[7\\]\ttrain-auc:0.900000\ttest-auc:0.800000")
expect_output(f5(), "\\[7\\]\ttrain-auc:0.900000\ttest-auc:0.800000")
bst_evaluation_err <- c('train-auc' = 0.1, 'test-auc' = 0.2)
expect_output(f1(), "\\[7\\]\ttrain-auc:0.900000±0.100000\ttest-auc:0.800000±0.200000")
logs2 <- capture.output({
model <- xgb.train(
data = dtrain,
params = list(
objective = "binary:logistic",
eval_metric = "auc",
max_depth = 2,
nthread = n_threads
),
nrounds = 10,
watchlist = list(train = dtrain, test = dtest),
callbacks = list(xgb.cb.print.evaluation(period = 2))
)
})
expect_equal(length(logs2), 6)
expect_true(all(grepl("^\\[\\d{1,2}\\]\ttrain-auc:0\\.\\d+\ttest-auc:0\\.\\d+\\s*$", logs2)))
seq_matches <- c(seq(1, 10, 2), 10)
lapply(seq_along(seq_matches), function(x) expect_true(grepl(paste0("^\\[", seq_matches[x]), logs2[x])))
})
test_that("cb.evaluation.log works as expected", {
test_that("xgb.cb.print.evaluation works as expected for xgb.cv", {
logs1 <- capture.output({
model <- xgb.cv(
data = dtrain,
params = list(
objective = "binary:logistic",
eval_metric = "auc",
max_depth = 2,
nthread = n_threads
),
nrounds = 10,
nfold = 3,
callbacks = list(xgb.cb.print.evaluation(period = 1, showsd = TRUE))
)
})
expect_equal(length(logs1), 10)
expect_true(all(grepl("^\\[\\d{1,2}\\]\ttrain-auc:0\\.\\d+±0\\.\\d+\ttest-auc:0\\.\\d+±0\\.\\d+\\s*$", logs1)))
lapply(seq(1, 10), function(x) expect_true(grepl(paste0("^\\[", x), logs1[x])))
bst_evaluation <- c('train-auc' = 0.9, 'test-auc' = 0.8)
bst_evaluation_err <- NULL
logs2 <- capture.output({
model <- xgb.cv(
data = dtrain,
params = list(
objective = "binary:logistic",
eval_metric = "auc",
max_depth = 2,
nthread = n_threads
),
nrounds = 10,
nfold = 3,
callbacks = list(xgb.cb.print.evaluation(period = 2, showsd = TRUE))
)
})
expect_equal(length(logs2), 6)
expect_true(all(grepl("^\\[\\d{1,2}\\]\ttrain-auc:0\\.\\d+±0\\.\\d+\ttest-auc:0\\.\\d+±0\\.\\d+\\s*$", logs2)))
seq_matches <- c(seq(1, 10, 2), 10)
lapply(seq_along(seq_matches), function(x) expect_true(grepl(paste0("^\\[", seq_matches[x]), logs2[x])))
})
evaluation_log <- list()
f <- cb.evaluation.log()
test_that("xgb.cb.evaluation.log works as expected for xgb.train", {
model <- xgb.train(
data = dtrain,
params = list(
objective = "binary:logistic",
eval_metric = "auc",
max_depth = 2,
nthread = n_threads
),
nrounds = 10,
verbose = FALSE,
watchlist = list(train = dtrain, test = dtest),
callbacks = list(xgb.cb.evaluation.log())
)
logs <- attributes(model)$evaluation_log
expect_false(is.null(attr(f, 'call')))
expect_equal(attr(f, 'name'), 'cb.evaluation.log')
expect_equal(nrow(logs), 10)
expect_equal(colnames(logs), c("iter", "train_auc", "test_auc"))
})
iteration <- 1
expect_silent(f())
expect_equal(evaluation_log,
list(c(iter = 1, bst_evaluation)))
iteration <- 2
expect_silent(f())
expect_equal(evaluation_log,
list(c(iter = 1, bst_evaluation), c(iter = 2, bst_evaluation)))
expect_silent(f(finalize = TRUE))
expect_equal(evaluation_log,
data.table::data.table(iter = 1:2, train_auc = c(0.9, 0.9), test_auc = c(0.8, 0.8)))
test_that("xgb.cb.evaluation.log works as expected for xgb.cv", {
model <- xgb.cv(
data = dtrain,
params = list(
objective = "binary:logistic",
eval_metric = "auc",
max_depth = 2,
nthread = n_threads
),
nrounds = 10,
verbose = FALSE,
nfold = 3,
callbacks = list(xgb.cb.evaluation.log())
)
logs <- model$evaluation_log
bst_evaluation_err <- c('train-auc' = 0.1, 'test-auc' = 0.2)
evaluation_log <- list()
f <- cb.evaluation.log()
iteration <- 1
expect_silent(f())
expect_equal(evaluation_log,
list(c(iter = 1, c(bst_evaluation, bst_evaluation_err))))
iteration <- 2
expect_silent(f())
expect_equal(evaluation_log,
list(c(iter = 1, c(bst_evaluation, bst_evaluation_err)),
c(iter = 2, c(bst_evaluation, bst_evaluation_err))))
expect_silent(f(finalize = TRUE))
expect_equal(evaluation_log,
data.table::data.table(iter = 1:2,
train_auc_mean = c(0.9, 0.9), train_auc_std = c(0.1, 0.1),
test_auc_mean = c(0.8, 0.8), test_auc_std = c(0.2, 0.2)))
expect_equal(nrow(logs), 10)
expect_equal(
colnames(logs),
c("iter", "train_auc_mean", "train_auc_std", "test_auc_mean", "test_auc_std")
)
})
@@ -116,7 +162,7 @@ test_that("can store evaluation_log without printing", {
expect_lt(attributes(bst)$evaluation_log[, min(train_error)], 0.2)
})
test_that("cb.reset.parameters works as expected", {
test_that("xgb.cb.reset.parameters works as expected", {
# fixed eta
set.seed(111)
@@ -128,7 +174,7 @@ test_that("cb.reset.parameters works as expected", {
set.seed(111)
my_par <- list(eta = c(0.9, 0.9))
bst1 <- xgb.train(param, dtrain, nrounds = 2, watchlist, verbose = 0,
callbacks = list(cb.reset.parameters(my_par)))
callbacks = list(xgb.cb.reset.parameters(my_par)))
expect_false(is.null(attributes(bst1)$evaluation_log$train_error))
expect_equal(attributes(bst0)$evaluation_log$train_error,
attributes(bst1)$evaluation_log$train_error)
@@ -137,7 +183,7 @@ test_that("cb.reset.parameters works as expected", {
set.seed(111)
my_par <- list(eta = function(itr, itr_end) 0.9)
bst2 <- xgb.train(param, dtrain, nrounds = 2, watchlist, verbose = 0,
callbacks = list(cb.reset.parameters(my_par)))
callbacks = list(xgb.cb.reset.parameters(my_par)))
expect_false(is.null(attributes(bst2)$evaluation_log$train_error))
expect_equal(attributes(bst0)$evaluation_log$train_error,
attributes(bst2)$evaluation_log$train_error)
@@ -146,7 +192,7 @@ test_that("cb.reset.parameters works as expected", {
set.seed(111)
my_par <- list(eta = c(0.6, 0.5))
bst3 <- xgb.train(param, dtrain, nrounds = 2, watchlist, verbose = 0,
callbacks = list(cb.reset.parameters(my_par)))
callbacks = list(xgb.cb.reset.parameters(my_par)))
expect_false(is.null(attributes(bst3)$evaluation_log$train_error))
expect_false(all(attributes(bst0)$evaluation_log$train_error == attributes(bst3)$evaluation_log$train_error))
@@ -154,25 +200,25 @@ test_that("cb.reset.parameters works as expected", {
my_par <- list(eta = c(1., 0.5), gamma = c(1, 2), max_depth = c(4, 8))
expect_error(
bst4 <- xgb.train(param, dtrain, nrounds = 2, watchlist, verbose = 0,
callbacks = list(cb.reset.parameters(my_par)))
callbacks = list(xgb.cb.reset.parameters(my_par)))
, NA) # NA = no error
# CV works as well
expect_error(
bst4 <- xgb.cv(param, dtrain, nfold = 2, nrounds = 2, verbose = 0,
callbacks = list(cb.reset.parameters(my_par)))
callbacks = list(xgb.cb.reset.parameters(my_par)))
, NA) # NA = no error
# expect no learning with 0 learning rate
my_par <- list(eta = c(0., 0.))
bstX <- xgb.train(param, dtrain, nrounds = 2, watchlist, verbose = 0,
callbacks = list(cb.reset.parameters(my_par)))
callbacks = list(xgb.cb.reset.parameters(my_par)))
expect_false(is.null(attributes(bstX)$evaluation_log$train_error))
er <- unique(attributes(bstX)$evaluation_log$train_error)
expect_length(er, 1)
expect_gt(er, 0.4)
})
test_that("cb.save.model works as expected", {
test_that("xgb.cb.save.model works as expected", {
files <- c('xgboost_01.json', 'xgboost_02.json', 'xgboost.json')
files <- unname(sapply(files, function(f) file.path(tempdir(), f)))
for (f in files) if (file.exists(f)) file.remove(f)
@@ -238,8 +284,8 @@ test_that("early stopping using a specific metric works", {
expect_output(
bst <- xgb.train(param[-2], dtrain, nrounds = 20, watchlist, eta = 0.6,
eval_metric = "logloss", eval_metric = "auc",
callbacks = list(cb.early.stop(stopping_rounds = 3, maximize = FALSE,
metric_name = 'test_logloss')))
callbacks = list(xgb.cb.early.stop(stopping_rounds = 3, maximize = FALSE,
metric_name = 'test_logloss')))
, "Stopping. Best iteration")
expect_false(is.null(xgb.attr(bst, "best_iteration")))
expect_lt(xgb.attr(bst, "best_iteration"), 19)
@@ -281,10 +327,10 @@ test_that("early stopping xgb.cv works", {
cv <- xgb.cv(param, dtrain, nfold = 5, eta = 0.3, nrounds = 20,
early_stopping_rounds = 3, maximize = FALSE)
, "Stopping. Best iteration")
expect_false(is.null(cv$best_iteration))
expect_lt(cv$best_iteration, 19)
expect_false(is.null(cv$early_stop$best_iteration))
expect_lt(cv$early_stop$best_iteration, 19)
# the best error is min error:
expect_true(cv$evaluation_log[, test_error_mean[cv$best_iteration] == min(test_error_mean)])
expect_true(cv$evaluation_log[, test_error_mean[cv$early_stop$best_iteration] == min(test_error_mean)])
})
test_that("prediction in xgb.cv works", {
@@ -292,19 +338,19 @@ test_that("prediction in xgb.cv works", {
nrounds <- 4
cv <- xgb.cv(param, dtrain, nfold = 5, eta = 0.5, nrounds = nrounds, prediction = TRUE, verbose = 0)
expect_false(is.null(cv$evaluation_log))
expect_false(is.null(cv$pred))
expect_length(cv$pred, nrow(train$data))
err_pred <- mean(sapply(cv$folds, function(f) mean(err(ltrain[f], cv$pred[f]))))
expect_false(is.null(cv$cv_predict$pred))
expect_length(cv$cv_predict$pred, nrow(train$data))
err_pred <- mean(sapply(cv$folds, function(f) mean(err(ltrain[f], cv$cv_predict$pred[f]))))
err_log <- cv$evaluation_log[nrounds, test_error_mean]
expect_equal(err_pred, err_log, tolerance = 1e-6)
# save CV models
set.seed(11)
cvx <- xgb.cv(param, dtrain, nfold = 5, eta = 0.5, nrounds = nrounds, prediction = TRUE, verbose = 0,
callbacks = list(cb.cv.predict(save_models = TRUE)))
callbacks = list(xgb.cb.cv.predict(save_models = TRUE)))
expect_equal(cv$evaluation_log, cvx$evaluation_log)
expect_length(cvx$models, 5)
expect_true(all(sapply(cvx$models, class) == 'xgb.Booster'))
expect_length(cvx$cv_predict$models, 5)
expect_true(all(sapply(cvx$cv_predict$models, class) == 'xgb.Booster'))
})
test_that("prediction in xgb.cv works for gblinear too", {
@@ -312,8 +358,8 @@ test_that("prediction in xgb.cv works for gblinear too", {
p <- list(booster = 'gblinear', objective = "reg:logistic", nthread = n_threads)
cv <- xgb.cv(p, dtrain, nfold = 5, eta = 0.5, nrounds = 2, prediction = TRUE, verbose = 0)
expect_false(is.null(cv$evaluation_log))
expect_false(is.null(cv$pred))
expect_length(cv$pred, nrow(train$data))
expect_false(is.null(cv$cv_predict$pred))
expect_length(cv$cv_predict$pred, nrow(train$data))
})
test_that("prediction in early-stopping xgb.cv works", {
@@ -324,14 +370,14 @@ test_that("prediction in early-stopping xgb.cv works", {
prediction = TRUE, base_score = 0.5)
, "Stopping. Best iteration")
expect_false(is.null(cv$best_iteration))
expect_lt(cv$best_iteration, 19)
expect_false(is.null(cv$early_stop$best_iteration))
expect_lt(cv$early_stop$best_iteration, 19)
expect_false(is.null(cv$evaluation_log))
expect_false(is.null(cv$pred))
expect_length(cv$pred, nrow(train$data))
expect_false(is.null(cv$cv_predict$pred))
expect_length(cv$cv_predict$pred, nrow(train$data))
err_pred <- mean(sapply(cv$folds, function(f) mean(err(ltrain[f], cv$pred[f]))))
err_log <- cv$evaluation_log[cv$best_iteration, test_error_mean]
err_pred <- mean(sapply(cv$folds, function(f) mean(err(ltrain[f], cv$cv_predict$pred[f]))))
err_log <- cv$evaluation_log[cv$early_stop$best_iteration, test_error_mean]
expect_equal(err_pred, err_log, tolerance = 1e-6)
err_log_last <- cv$evaluation_log[cv$niter, test_error_mean]
expect_gt(abs(err_pred - err_log_last), 1e-4)
@@ -346,9 +392,9 @@ test_that("prediction in xgb.cv for softprob works", {
subsample = 0.8, gamma = 2, verbose = 0,
prediction = TRUE, objective = "multi:softprob", num_class = 3)
, NA)
expect_false(is.null(cv$pred))
expect_equal(dim(cv$pred), c(nrow(iris), 3))
expect_lt(diff(range(rowSums(cv$pred))), 1e-6)
expect_false(is.null(cv$cv_predict$pred))
expect_equal(dim(cv$cv_predict$pred), c(nrow(iris), 3))
expect_lt(diff(range(rowSums(cv$cv_predict$pred))), 1e-6)
})
test_that("prediction in xgb.cv works for multi-quantile", {
@@ -368,7 +414,7 @@ test_that("prediction in xgb.cv works for multi-quantile", {
prediction = TRUE,
verbose = 0
)
expect_equal(dim(cv$pred), c(nrow(x), 5))
expect_equal(dim(cv$cv_predict$pred), c(nrow(x), 5))
})
test_that("prediction in xgb.cv works for multi-output", {
@@ -389,5 +435,46 @@ test_that("prediction in xgb.cv works for multi-output", {
prediction = TRUE,
verbose = 0
)
expect_equal(dim(cv$pred), c(nrow(x), 2))
expect_equal(dim(cv$cv_predict$pred), c(nrow(x), 2))
})
test_that("prediction in xgb.cv works for multi-quantile", {
data(mtcars)
y <- mtcars$mpg
x <- as.matrix(mtcars[, -1])
dm <- xgb.DMatrix(x, label = y, nthread = 1)
cv <- xgb.cv(
data = dm,
params = list(
objective = "reg:quantileerror",
quantile_alpha = c(0.1, 0.2, 0.5, 0.8, 0.9),
nthread = 1
),
nrounds = 5,
nfold = 3,
prediction = TRUE,
verbose = 0
)
expect_equal(dim(cv$cv_predict$pred), c(nrow(x), 5))
})
test_that("prediction in xgb.cv works for multi-output", {
data(mtcars)
y <- mtcars$mpg
x <- as.matrix(mtcars[, -1])
dm <- xgb.DMatrix(x, label = cbind(y, -y), nthread = 1)
cv <- xgb.cv(
data = dm,
params = list(
tree_method = "hist",
multi_strategy = "multi_output_tree",
objective = "reg:squarederror",
nthread = n_threads
),
nrounds = 5,
nfold = 3,
prediction = TRUE,
verbose = 0
)
expect_equal(dim(cv$cv_predict$pred), c(nrow(x), 2))
})

4
R-package/tests/testthat/test_glm.R
View File

@@ -27,7 +27,7 @@ test_that("gblinear works", {
expect_lt(attributes(bst)$evaluation_log$eval_error[n], ERR_UL)
bst <- xgb.train(param, dtrain, n, watchlist, verbose = VERB, feature_selector = 'cyclic',
callbacks = list(cb.gblinear.history()))
callbacks = list(xgb.cb.gblinear.history()))
expect_lt(attributes(bst)$evaluation_log$eval_error[n], ERR_UL)
h <- xgb.gblinear.history(bst)
expect_equal(dim(h), c(n, ncol(dtrain) + 1))
@@ -44,7 +44,7 @@ test_that("gblinear works", {
expect_lt(attributes(bst)$evaluation_log$eval_error[2], ERR_UL)
bst <- xgb.train(param, dtrain, n, watchlist, verbose = VERB, feature_selector = 'thrifty',
top_k = 50, callbacks = list(cb.gblinear.history(sparse = TRUE)))
top_k = 50, callbacks = list(xgb.cb.gblinear.history(sparse = TRUE)))
expect_lt(attributes(bst)$evaluation_log$eval_error[n], ERR_UL)
h <- xgb.gblinear.history(bst)
expect_equal(dim(h), c(n, ncol(dtrain) + 1))