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

[R] various R code maintenance (#1964)

Browse Source 
* [R] xgb.save must work when handle in nil but raw exists

* [R] print.xgb.Booster should still print other info when handle is nil

* [R] rename internal function xgb.Booster to xgb.Booster.handle to make its intent clear

* [R] rename xgb.Booster.check to xgb.Booster.complete and make it visible; more docs

* [R] storing evaluation_log should depend only on watchlist, not on verbose

* [R] reduce the excessive chattiness of unit tests

* [R] only disable some tests in windows when it's not 64-bit

* [R] clean-up xgb.DMatrix

* [R] test xgb.DMatrix loading from libsvm text file

* [R] store feature_names in xgb.Booster, use them from utility functions

* [R] remove non-functional co-occurence computation from xgb.importance

* [R] verbose=0 is enough without a callback

* [R] added forgotten xgb.Booster.complete.Rd; cran check fixes

* [R] update installation instructions
This commit is contained in:
Vadim Khotilovich
2017-01-21 13:22:46 -06:00
committed by Tianqi Chen
parent a073a2c3d4
commit 2b5b96d760
27 changed files with 561 additions and 327 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -8,7 +8,9 @@ train <- agaricus.train
test <- agaricus.test
set.seed(1994)
windows_flag = grepl('Windows', Sys.info()[['sysname']])
# disable some tests for Win32
windows_flag = .Platform$OS.type == "windows" &&
.Machine$sizeof.pointer != 8
test_that("train and predict binary classification", {
nrounds = 2
@@ -109,7 +111,7 @@ test_that("train and predict RF with softprob", {
set.seed(11)
bst <- xgboost(data = as.matrix(iris[, -5]), label = lb,
max_depth = 3, eta = 0.9, nthread = 2, nrounds = nrounds,
objective = "multi:softprob", num_class=3,
objective = "multi:softprob", num_class=3, verbose = 0,
num_parallel_tree = 4, subsample = 0.5, colsample_bytree = 0.5)
expect_equal(bst$niter, 15)
expect_equal(xgb.ntree(bst), 15*3*4)
@@ -144,25 +146,25 @@ test_that("training continuation works", {
# for the reference, use 4 iterations at once:
set.seed(11)
bst <- xgb.train(param, dtrain, nrounds = 4, watchlist)
bst <- xgb.train(param, dtrain, nrounds = 4, watchlist, verbose = 0)
# first two iterations:
set.seed(11)
bst1 <- xgb.train(param, dtrain, nrounds = 2, watchlist)
bst1 <- xgb.train(param, dtrain, nrounds = 2, watchlist, verbose = 0)
# continue for two more:
bst2 <- xgb.train(param, dtrain, nrounds = 2, watchlist, xgb_model = bst1)
bst2 <- xgb.train(param, dtrain, nrounds = 2, watchlist, verbose = 0, xgb_model = bst1)
if (!windows_flag)
expect_equal(bst$raw, bst2$raw)
expect_false(is.null(bst2$evaluation_log))
expect_equal(dim(bst2$evaluation_log), c(4, 2))
expect_equal(bst2$evaluation_log, bst$evaluation_log)
# test continuing from raw model data
bst2 <- xgb.train(param, dtrain, nrounds = 2, watchlist, xgb_model = bst1$raw)
bst2 <- xgb.train(param, dtrain, nrounds = 2, watchlist, verbose = 0, xgb_model = bst1$raw)
if (!windows_flag)
expect_equal(bst$raw, bst2$raw)
expect_equal(dim(bst2$evaluation_log), c(2, 2))
# test continuing from a model in file
xgb.save(bst1, "xgboost.model")
bst2 <- xgb.train(param, dtrain, nrounds = 2, watchlist, xgb_model = "xgboost.model")
bst2 <- xgb.train(param, dtrain, nrounds = 2, watchlist, verbose = 0, xgb_model = "xgboost.model")
if (!windows_flag)
expect_equal(bst$raw, bst2$raw)
expect_equal(dim(bst2$evaluation_log), c(2, 2))
@@ -171,9 +173,11 @@ test_that("training continuation works", {
test_that("xgb.cv works", {
set.seed(11)
cv <- xgb.cv(data = train$data, label = train$label, max_depth = 2, nfold = 5,
eta = 1., nthread = 2, nrounds = 2, objective = "binary:logistic",
verbose=TRUE)
expect_output(
cv <- xgb.cv(data = train$data, label = train$label, max_depth = 2, nfold = 5,
eta = 1., nthread = 2, nrounds = 2, objective = "binary:logistic",
verbose=TRUE)
, "train-error:")
expect_is(cv, 'xgb.cv.synchronous')
expect_false(is.null(cv$evaluation_log))
expect_lt(cv$evaluation_log[, min(test_error_mean)], 0.03)

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

@@ -107,18 +107,27 @@ test_that("cb.evaluation.log works as expected", {
param <- list(objective = "binary:logistic", max_depth = 4, nthread = 2)
test_that("can store evaluation_log without printing", {
expect_silent(
bst <- xgb.train(param, dtrain, nrounds = 10, watchlist, eta = 1, verbose = 0)
)
expect_false(is.null(bst$evaluation_log))
expect_false(is.null(bst$evaluation_log$train_error))
expect_lt(bst$evaluation_log[, min(train_error)], 0.2)
})
test_that("cb.reset.parameters works as expected", {
# fixed eta
set.seed(111)
bst0 <- xgb.train(param, dtrain, nrounds = 2, watchlist, eta = 0.9)
bst0 <- xgb.train(param, dtrain, nrounds = 2, watchlist, eta = 0.9, verbose = 0)
expect_false(is.null(bst0$evaluation_log))
expect_false(is.null(bst0$evaluation_log$train_error))
# same eta but re-set as a vector parameter in the callback
set.seed(111)
my_par <- list(eta = c(0.9, 0.9))
bst1 <- xgb.train(param, dtrain, nrounds = 2, watchlist,
bst1 <- xgb.train(param, dtrain, nrounds = 2, watchlist, verbose = 0,
callbacks = list(cb.reset.parameters(my_par)))
expect_false(is.null(bst1$evaluation_log$train_error))
expect_equal(bst0$evaluation_log$train_error,
@@ -127,7 +136,7 @@ test_that("cb.reset.parameters works as expected", {
# same eta but re-set via a function in the callback
set.seed(111)
my_par <- list(eta = function(itr, itr_end) 0.9)
bst2 <- xgb.train(param, dtrain, nrounds = 2, watchlist,
bst2 <- xgb.train(param, dtrain, nrounds = 2, watchlist, verbose = 0,
callbacks = list(cb.reset.parameters(my_par)))
expect_false(is.null(bst2$evaluation_log$train_error))
expect_equal(bst0$evaluation_log$train_error,
@@ -136,7 +145,7 @@ test_that("cb.reset.parameters works as expected", {
# different eta re-set as a vector parameter in the callback
set.seed(111)
my_par <- list(eta = c(0.6, 0.5))
bst3 <- xgb.train(param, dtrain, nrounds = 2, watchlist,
bst3 <- xgb.train(param, dtrain, nrounds = 2, watchlist, verbose = 0,
callbacks = list(cb.reset.parameters(my_par)))
expect_false(is.null(bst3$evaluation_log$train_error))
expect_false(all(bst0$evaluation_log$train_error == bst3$evaluation_log$train_error))
@@ -144,18 +153,18 @@ test_that("cb.reset.parameters works as expected", {
# resetting multiple parameters at the same time runs with no error
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,
bst4 <- xgb.train(param, dtrain, nrounds = 2, watchlist, verbose = 0,
callbacks = list(cb.reset.parameters(my_par)))
, NA) # NA = no error
# CV works as well
expect_error(
bst4 <- xgb.cv(param, dtrain, nfold = 2, nrounds = 2,
bst4 <- xgb.cv(param, dtrain, nfold = 2, nrounds = 2, verbose = 0,
callbacks = list(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,
bstX <- xgb.train(param, dtrain, nrounds = 2, watchlist, verbose = 0,
callbacks = list(cb.reset.parameters(my_par)))
expect_false(is.null(bstX$evaluation_log$train_error))
er <- unique(bstX$evaluation_log$train_error)
@@ -167,7 +176,7 @@ test_that("cb.save.model works as expected", {
files <- c('xgboost_01.model', 'xgboost_02.model', 'xgboost.model')
for (f in files) if (file.exists(f)) file.remove(f)
bst <- xgb.train(param, dtrain, nrounds = 2, watchlist, eta = 1,
bst <- xgb.train(param, dtrain, nrounds = 2, watchlist, eta = 1, verbose = 0,
save_period = 1, save_name = "xgboost_%02d.model")
expect_true(file.exists('xgboost_01.model'))
expect_true(file.exists('xgboost_02.model'))
@@ -178,7 +187,8 @@ test_that("cb.save.model works as expected", {
expect_equal(bst$raw, b2$raw)
# save_period = 0 saves the last iteration's model
bst <- xgb.train(param, dtrain, nrounds = 2, watchlist, eta = 1, save_period = 0)
bst <- xgb.train(param, dtrain, nrounds = 2, watchlist, eta = 1, verbose = 0,
save_period = 0)
expect_true(file.exists('xgboost.model'))
b2 <- xgb.load('xgboost.model')
expect_equal(bst$raw, b2$raw)
@@ -186,16 +196,6 @@ test_that("cb.save.model works as expected", {
for (f in files) if (file.exists(f)) file.remove(f)
})
test_that("can store evaluation_log without printing", {
expect_silent(
bst <- xgb.train(param, dtrain, nrounds = 10, watchlist, eta = 1,
verbose = 0, callbacks = list(cb.evaluation.log()))
)
expect_false(is.null(bst$evaluation_log))
expect_false(is.null(bst$evaluation_log$train_error))
expect_lt(bst$evaluation_log[, min(train_error)], 0.2)
})
test_that("early stopping xgb.train works", {
set.seed(11)
expect_output(
@@ -211,6 +211,13 @@ test_that("early stopping xgb.train works", {
err_pred <- err(ltest, pred)
err_log <- bst$evaluation_log[bst$best_iteration, test_error]
expect_equal(err_log, err_pred, tolerance = 5e-6)
set.seed(11)
expect_silent(
bst0 <- xgb.train(param, dtrain, nrounds = 20, watchlist, eta = 0.3,
early_stopping_rounds = 3, maximize = FALSE, verbose = 0)
)
expect_equal(bst$evaluation_log, bst0$evaluation_log)
})
test_that("early stopping using a specific metric works", {
@@ -248,7 +255,7 @@ test_that("early stopping xgb.cv works", {
test_that("prediction in xgb.cv works", {
set.seed(11)
nrounds = 4
cv <- xgb.cv(param, dtrain, nfold = 5, eta = 0.5, nrounds = nrounds, prediction = TRUE)
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))
@@ -258,7 +265,7 @@ test_that("prediction in xgb.cv works", {
# save CV models
set.seed(11)
cvx <- xgb.cv(param, dtrain, nfold = 5, eta = 0.5, nrounds = nrounds, prediction = TRUE,
cvx <- xgb.cv(param, dtrain, nfold = 5, eta = 0.5, nrounds = nrounds, prediction = TRUE, verbose = 0,
callbacks = list(cb.cv.predict(save_models = TRUE)))
expect_equal(cv$evaluation_log, cvx$evaluation_log)
expect_length(cvx$models, 5)
@@ -268,7 +275,7 @@ test_that("prediction in xgb.cv works", {
test_that("prediction in xgb.cv works for gblinear too", {
set.seed(11)
p <- list(booster = 'gblinear', objective = "reg:logistic", nthread = 2)
cv <- xgb.cv(p, dtrain, nfold = 5, eta = 0.5, nrounds = 2, prediction = TRUE)
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))
@@ -300,7 +307,7 @@ test_that("prediction in xgb.cv for softprob works", {
expect_warning(
cv <- xgb.cv(data = as.matrix(iris[, -5]), label = lb, nfold = 4,
eta = 0.5, nrounds = 5, max_depth = 3, nthread = 2,
subsample = 0.8, gamma = 2,
subsample = 0.8, gamma = 2, verbose = 0,
prediction = TRUE, objective = "multi:softprob", num_class = 3)
, NA)
expect_false(is.null(cv$pred))

9
R-package/tests/testthat/test_dmatrix.R
View File

@@ -21,6 +21,15 @@ test_that("xgb.DMatrix: basic construction, saving, loading", {
dtest3 <- xgb.DMatrix(tmp_file)
unlink(tmp_file)
expect_equal(getinfo(dtest1, 'label'), getinfo(dtest3, 'label'))
# from a libsvm text file
tmp <- c("0 1:1 2:1","1 3:1","0 1:1")
tmp_file <- 'tmp.libsvm'
writeLines(tmp, tmp_file)
dtest4 <- xgb.DMatrix(tmp_file)
expect_equal(dim(dtest4), c(3, 4))
expect_equal(getinfo(dtest4, 'label'), c(0,1,0))
unlink(tmp_file)
})
test_that("xgb.DMatrix: getinfo & setinfo", {

47
R-package/tests/testthat/test_helpers.R
View File

@@ -3,7 +3,7 @@ context('Test helper functions')
require(xgboost)
require(data.table)
require(Matrix)
require(vcd)
require(vcd, quietly = TRUE)
set.seed(1982)
data(Arthritis)
@@ -15,10 +15,12 @@ sparse_matrix <- sparse.model.matrix(Improved~.-1, data = df)
label <- df[, ifelse(Improved == "Marked", 1, 0)]
bst.Tree <- xgboost(data = sparse_matrix, label = label, max_depth = 9,
eta = 1, nthread = 2, nrounds = 10, objective = "binary:logistic", booster = "gbtree")
eta = 1, nthread = 2, nrounds = 10, verbose = 0,
objective = "binary:logistic", booster = "gbtree")
bst.GLM <- xgboost(data = sparse_matrix, label = label,
eta = 1, nthread = 2, nrounds = 10, objective = "binary:logistic", booster = "gblinear")
eta = 1, nthread = 2, nrounds = 10, verbose = 0,
objective = "binary:logistic", booster = "gblinear")
feature.names <- colnames(sparse_matrix)
@@ -100,12 +102,37 @@ if (grepl('Windows', Sys.info()[['sysname']]) || grepl('Linux', Sys.info()[['sys
})
}
test_that("xgb.Booster serializing as R object works", {
saveRDS(bst.Tree, 'xgb.model.rds')
bst <- readRDS('xgb.model.rds')
dtrain <- xgb.DMatrix(sparse_matrix, label = label)
expect_equal(predict(bst.Tree, dtrain), predict(bst, dtrain))
expect_equal(xgb.dump(bst.Tree), xgb.dump(bst))
xgb.save(bst, 'xgb.model')
nil_ptr <- new("externalptr")
class(nil_ptr) <- "xgb.Booster.handle"
expect_true(identical(bst$handle, nil_ptr))
bst <- xgb.Booster.complete(bst)
expect_true(!identical(bst$handle, nil_ptr))
expect_equal(predict(bst.Tree, dtrain), predict(bst, dtrain))
})
test_that("xgb.model.dt.tree works with and without feature names", {
names.dt.trees <- c("Tree", "Node", "ID", "Feature", "Split", "Yes", "No", "Missing", "Quality", "Cover")
dt.tree <- xgb.model.dt.tree(feature_names = feature.names, model = bst.Tree)
expect_equal(names.dt.trees, names(dt.tree))
expect_equal(dim(dt.tree), c(162, 10))
expect_output(str(xgb.model.dt.tree(model = bst.Tree)), 'Feature.*\\"3\\"')
expect_output(str(dt.tree), 'Feature.*\\"Age\\"')
dt.tree.0 <- xgb.model.dt.tree(model = bst.Tree)
expect_equal(dt.tree, dt.tree.0)
# when model contains no feature names:
bst.Tree.x <- bst.Tree
bst.Tree.x$feature_names <- NULL
dt.tree.x <- xgb.model.dt.tree(model = bst.Tree.x)
expect_output(str(dt.tree.x), 'Feature.*\\"3\\"')
expect_equal(dt.tree[, -4, with=FALSE], dt.tree.x[, -4, with=FALSE])
})
test_that("xgb.model.dt.tree throws error for gblinear", {
@@ -116,7 +143,17 @@ test_that("xgb.importance works with and without feature names", {
importance.Tree <- xgb.importance(feature_names = feature.names, model = bst.Tree)
expect_equal(dim(importance.Tree), c(7, 4))
expect_equal(colnames(importance.Tree), c("Feature", "Gain", "Cover", "Frequency"))
expect_output(str(xgb.importance(model = bst.Tree)), 'Feature.*\\"3\\"')
expect_output(str(importance.Tree), 'Feature.*\\"Age\\"')
importance.Tree.0 <- xgb.importance(model = bst.Tree)
expect_equal(importance.Tree, importance.Tree.0)
# when model contains no feature names:
bst.Tree.x <- bst.Tree
bst.Tree.x$feature_names <- NULL
importance.Tree.x <- xgb.importance(model = bst.Tree)
expect_equal(importance.Tree[, -1, with=FALSE], importance.Tree.x[, -1, with=FALSE])
imp2plot <- xgb.plot.importance(importance_matrix = importance.Tree)
expect_equal(colnames(imp2plot), c("Feature", "Gain", "Cover", "Frequency", "Importance"))
xgb.ggplot.importance(importance_matrix = importance.Tree)

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

@@ -10,8 +10,8 @@ train = matrix(x, ncol = 1)
test_that("monotone constraints for regression", {
bst = xgboost(data = train, label = y, max_depth = 2,
eta = 0.1, nthread = 2, nrounds = 100,
monotone_constraints = -1)
eta = 0.1, nthread = 2, nrounds = 100, verbose = 0,
monotone_constraints = -1)
pred = predict(bst, train)

17
R-package/tests/testthat/test_update.R
View File

@@ -9,24 +9,23 @@ dtest <- xgb.DMatrix(agaricus.test$data, label = agaricus.test$label)
test_that("updating the model works", {
watchlist = list(train = dtrain, test = dtest)
cb = list(cb.evaluation.log()) # to run silent, but store eval. log
# no-subsampling
p1 <- list(objective = "binary:logistic", max_depth = 2, eta = 0.05, nthread = 2)
set.seed(11)
bst1 <- xgb.train(p1, dtrain, nrounds = 10, watchlist, verbose = 0, callbacks = cb)
bst1 <- xgb.train(p1, dtrain, nrounds = 10, watchlist, verbose = 0)
tr1 <- xgb.model.dt.tree(model = bst1)
# with subsampling
p2 <- modifyList(p1, list(subsample = 0.1))
set.seed(11)
bst2 <- xgb.train(p2, dtrain, nrounds = 10, watchlist, verbose = 0, callbacks = cb)
bst2 <- xgb.train(p2, dtrain, nrounds = 10, watchlist, verbose = 0)
tr2 <- xgb.model.dt.tree(model = bst2)
# the same no-subsampling boosting with an extra 'refresh' updater:
p1r <- modifyList(p1, list(updater = 'grow_colmaker,prune,refresh', refresh_leaf = FALSE))
set.seed(11)
bst1r <- xgb.train(p1r, dtrain, nrounds = 10, watchlist, verbose = 0, callbacks = cb)
bst1r <- xgb.train(p1r, dtrain, nrounds = 10, watchlist, verbose = 0)
tr1r <- xgb.model.dt.tree(model = bst1r)
# all should be the same when no subsampling
expect_equal(bst1$evaluation_log, bst1r$evaluation_log)
@@ -35,7 +34,7 @@ test_that("updating the model works", {
# the same boosting with subsampling with an extra 'refresh' updater:
p2r <- modifyList(p2, list(updater = 'grow_colmaker,prune,refresh', refresh_leaf = FALSE))
set.seed(11)
bst2r <- xgb.train(p2r, dtrain, nrounds = 10, watchlist, verbose = 0, callbacks = cb)
bst2r <- xgb.train(p2r, dtrain, nrounds = 10, watchlist, verbose = 0)
tr2r <- xgb.model.dt.tree(model = bst2r)
# should be the same evaluation but different gains and larger cover
expect_equal(bst2$evaluation_log, bst2r$evaluation_log)
@@ -45,7 +44,7 @@ test_that("updating the model works", {
# process type 'update' for no-subsampling model, refreshing the tree stats AND leaves from training data:
p1u <- modifyList(p1, list(process_type = 'update', updater = 'refresh', refresh_leaf = TRUE))
bst1u <- xgb.train(p1u, dtrain, nrounds = 10, watchlist, verbose = 0, callbacks = cb, xgb_model = bst1)
bst1u <- xgb.train(p1u, dtrain, nrounds = 10, watchlist, verbose = 0, xgb_model = bst1)
tr1u <- xgb.model.dt.tree(model = bst1u)
# all should be the same when no subsampling
expect_equal(bst1$evaluation_log, bst1u$evaluation_log)
@@ -53,7 +52,7 @@ test_that("updating the model works", {
# process type 'update' for model with subsampling, refreshing only the tree stats from training data:
p2u <- modifyList(p2, list(process_type = 'update', updater = 'refresh', refresh_leaf = FALSE))
bst2u <- xgb.train(p2u, dtrain, nrounds = 10, watchlist, verbose = 0, callbacks = cb, xgb_model = bst2)
bst2u <- xgb.train(p2u, dtrain, nrounds = 10, watchlist, verbose = 0, xgb_model = bst2)
tr2u <- xgb.model.dt.tree(model = bst2u)
# should be the same evaluation but different gains and larger cover
expect_equal(bst2$evaluation_log, bst2u$evaluation_log)
@@ -66,7 +65,7 @@ test_that("updating the model works", {
# process type 'update' for no-subsampling model, refreshing only the tree stats from TEST data:
p1ut <- modifyList(p1, list(process_type = 'update', updater = 'refresh', refresh_leaf = FALSE))
bst1ut <- xgb.train(p1ut, dtest, nrounds = 10, watchlist, verbose = 0, callbacks = cb, xgb_model = bst1)
bst1ut <- xgb.train(p1ut, dtest, nrounds = 10, watchlist, verbose = 0, xgb_model = bst1)
tr1ut <- xgb.model.dt.tree(model = bst1ut)
# should be the same evaluations but different gains and smaller cover (test data is smaller)
expect_equal(bst1$evaluation_log, bst1ut$evaluation_log)