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

R-callbacks tests + other tests brushup

Browse Source
This commit is contained in:
Vadim Khotilovich
2016-06-09 02:53:37 -05:00
parent 2e0ffcc303
commit f34f9fb9f7
6 changed files with 372 additions and 61 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -7,25 +7,27 @@ require(vcd)
set.seed(1982)
data(Arthritis)
data(agaricus.train, package='xgboost')
df <- data.table(Arthritis, keep.rownames = F)
df[,AgeDiscret := as.factor(round(Age / 10,0))]
df[,AgeCat := as.factor(ifelse(Age > 30, "Old", "Young"))]
df[,ID := NULL]
sparse_matrix <- sparse.model.matrix(Improved~.-1, data = df)
output_vector <- df[,Y := 0][Improved == "Marked",Y := 1][,Y]
bst.Tree <- xgboost(data = sparse_matrix, label = output_vector, max.depth = 9,
label <- df[, ifelse(Improved == "Marked", 1, 0)]
bst.Tree <- xgboost(data = sparse_matrix, label = label, max.depth = 9,
eta = 1, nthread = 2, nround = 10, objective = "binary:logistic", booster = "gbtree")
bst.GLM <- xgboost(data = sparse_matrix, label = output_vector,
bst.GLM <- xgboost(data = sparse_matrix, label = label,
eta = 1, nthread = 2, nround = 10, objective = "binary:logistic", booster = "gblinear")
feature.names <- colnames(agaricus.train$data)
feature.names <- colnames(sparse_matrix)
test_that("xgb.dump works", {
capture.output(print(xgb.dump(bst.Tree)))
capture.output(print(xgb.dump(bst.GLM)))
expect_length(xgb.dump(bst.Tree), 172)
expect_length(xgb.dump(bst.GLM), 14)
expect_true(xgb.dump(bst.Tree, 'xgb.model.dump', with.stats = T))
expect_true(file.exists('xgb.model.dump'))
expect_gt(file.size('xgb.model.dump'), 8000)
})
test_that("xgb-attribute functionality", {
@@ -61,19 +63,19 @@ test_that("xgb.model.dt.tree works with and without feature names", {
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))
xgb.model.dt.tree(model = bst.Tree)
expect_output(str(xgb.model.dt.tree(model = bst.Tree)), 'Feature.*\\"3\\"')
})
test_that("xgb.importance works with and without feature names", {
importance.Tree <- xgb.importance(feature_names = sparse_matrix@Dimnames[[2]], model = bst.Tree)
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"))
xgb.importance(model = bst.Tree)
expect_output(str(xgb.importance(model = bst.Tree)), 'Feature.*\\"3\\"')
xgb.plot.importance(importance_matrix = importance.Tree)
})
test_that("xgb.importance works with GLM model", {
importance.GLM <- xgb.importance(feature_names = sparse_matrix@Dimnames[[2]], model = bst.GLM)
importance.GLM <- xgb.importance(feature_names = feature.names, model = bst.GLM)
expect_equal(dim(importance.GLM), c(10, 2))
expect_equal(colnames(importance.GLM), c("Feature", "Weight"))
xgb.importance(model = bst.GLM)