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

A fix for CRAN submission of version 0.7-0 (#3061)

Browse Source 
* modify test_helper.R

* fix noLD

* update desc

* fix solaris test

* fix desc

* improve fix

* fix url
This commit is contained in:
Tong He
2018-01-27 17:06:28 -08:00
committed by GitHub
parent c88bae112e
commit 98be9aef9a
6 changed files with 34 additions and 25 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -5,6 +5,8 @@ require(data.table)
require(Matrix)
require(vcd, quietly = TRUE)
float_tolerance = 5e-6
set.seed(1982)
data(Arthritis)
df <- data.table(Arthritis, keep.rownames = F)
@@ -85,7 +87,8 @@ test_that("predict feature contributions works", {
X <- sparse_matrix
colnames(X) <- NULL
expect_error(pred_contr_ <- predict(bst.Tree, X, predcontrib = TRUE), regexp = NA)
expect_equal(pred_contr, pred_contr_, check.attributes = FALSE)
expect_equal(pred_contr, pred_contr_, check.attributes = FALSE,
tolerance = float_tolerance)
# gbtree binary classifier (approximate method)
expect_error(pred_contr <- predict(bst.Tree, sparse_matrix, predcontrib = TRUE, approxcontrib = TRUE), regexp = NA)
@@ -104,7 +107,8 @@ test_that("predict feature contributions works", {
coefs <- xgb.dump(bst.GLM)[-c(1,2,4)] %>% as.numeric
coefs <- c(coefs[-1], coefs[1]) # intercept must be the last
pred_contr_manual <- sweep(cbind(sparse_matrix, 1), 2, coefs, FUN="*")
expect_equal(as.numeric(pred_contr), as.numeric(pred_contr_manual), 1e-5)
expect_equal(as.numeric(pred_contr), as.numeric(pred_contr_manual),
tolerance = float_tolerance)
# gbtree multiclass
pred <- predict(mbst.Tree, as.matrix(iris[, -5]), outputmargin = TRUE, reshape = TRUE)
@@ -123,11 +127,12 @@ test_that("predict feature contributions works", {
coefs_all <- xgb.dump(mbst.GLM)[-c(1,2,6)] %>% as.numeric %>% matrix(ncol = 3, byrow = TRUE)
for (g in seq_along(pred_contr)) {
expect_equal(colnames(pred_contr[[g]]), c(colnames(iris[, -5]), "BIAS"))
expect_lt(max(abs(rowSums(pred_contr[[g]]) - pred[, g])), 2e-6)
expect_lt(max(abs(rowSums(pred_contr[[g]]) - pred[, g])), float_tolerance)
# manual calculation of linear terms
coefs <- c(coefs_all[-1, g], coefs_all[1, g]) # intercept needs to be the last
pred_contr_manual <- sweep(as.matrix(cbind(iris[,-5], 1)), 2, coefs, FUN="*")
expect_equal(as.numeric(pred_contr[[g]]), as.numeric(pred_contr_manual), 2e-6)
expect_equal(as.numeric(pred_contr[[g]]), as.numeric(pred_contr_manual),
tolerance = float_tolerance)
}
})
@@ -171,14 +176,16 @@ if (grepl('Windows', Sys.info()[['sysname']]) ||
# check that lossless conversion works with 17 digits
# numeric -> character -> numeric
X <- 10^runif(100, -20, 20)
X2X <- as.numeric(format(X, digits = 17))
expect_identical(X, X2X)
if (capabilities('long.double')) {
X2X <- as.numeric(format(X, digits = 17))
expect_identical(X, X2X)
}
# retrieved attributes to be the same as written
for (x in X) {
xgb.attr(bst.Tree, "x") <- x
expect_identical(as.numeric(xgb.attr(bst.Tree, "x")), x)
expect_equal(as.numeric(xgb.attr(bst.Tree, "x")), x, tolerance = float_tolerance)
xgb.attributes(bst.Tree) <- list(a = "A", b = x)
expect_identical(as.numeric(xgb.attr(bst.Tree, "b")), x)
expect_equal(as.numeric(xgb.attr(bst.Tree, "b")), x, tolerance = float_tolerance)
}
})
}
@@ -187,7 +194,7 @@ 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(predict(bst.Tree, dtrain), predict(bst, dtrain), tolerance = float_tolerance)
expect_equal(xgb.dump(bst.Tree), xgb.dump(bst))
xgb.save(bst, 'xgb.model')
nil_ptr <- new("externalptr")
@@ -195,7 +202,7 @@ test_that("xgb.Booster serializing as R object works", {
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))
expect_equal(predict(bst.Tree, dtrain), predict(bst, dtrain), tolerance = float_tolerance)
})
test_that("xgb.model.dt.tree works with and without feature names", {
@@ -233,13 +240,14 @@ test_that("xgb.importance works with and without feature names", {
expect_output(str(importance.Tree), 'Feature.*\\"Age\\"')
importance.Tree.0 <- xgb.importance(model = bst.Tree)
expect_equal(importance.Tree, importance.Tree.0)
expect_equal(importance.Tree, importance.Tree.0, tolerance = float_tolerance)
# 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])
expect_equal(importance.Tree[, -1, with=FALSE], importance.Tree.x[, -1, with=FALSE],
tolerance = float_tolerance)
imp2plot <- xgb.plot.importance(importance_matrix = importance.Tree)
expect_equal(colnames(imp2plot), c("Feature", "Gain", "Cover", "Frequency", "Importance"))