[R] additional and modified tests
This commit is contained in:
@@ -14,18 +14,18 @@ df[,ID := NULL]
|
||||
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, nround = 10, objective = "binary:logistic", booster = "gbtree")
|
||||
bst.Tree <- xgboost(data = sparse_matrix, label = label, max_depth = 9,
|
||||
eta = 1, nthread = 2, nrounds = 10, objective = "binary:logistic", booster = "gbtree")
|
||||
|
||||
bst.GLM <- xgboost(data = sparse_matrix, label = label,
|
||||
eta = 1, nthread = 2, nround = 10, objective = "binary:logistic", booster = "gblinear")
|
||||
eta = 1, nthread = 2, nrounds = 10, objective = "binary:logistic", booster = "gblinear")
|
||||
|
||||
feature.names <- colnames(sparse_matrix)
|
||||
|
||||
test_that("xgb.dump works", {
|
||||
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(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)
|
||||
})
|
||||
@@ -35,12 +35,15 @@ test_that("xgb-attribute functionality", {
|
||||
list.val <- list(my_attr=val, a=123, b='ok')
|
||||
list.ch <- list.val[order(names(list.val))]
|
||||
list.ch <- lapply(list.ch, as.character)
|
||||
# note: iter is 0-index in xgb attributes
|
||||
list.default <- list(niter = "9")
|
||||
list.ch <- c(list.ch, list.default)
|
||||
# proper input:
|
||||
expect_error(xgb.attr(bst.Tree, NULL))
|
||||
expect_error(xgb.attr(val, val))
|
||||
# set & get:
|
||||
expect_null(xgb.attr(bst.Tree, "asdf"))
|
||||
expect_null(xgb.attributes(bst.Tree)) # initially, expect no attributes
|
||||
expect_equal(xgb.attributes(bst.Tree), list.default)
|
||||
xgb.attr(bst.Tree, "my_attr") <- val
|
||||
expect_equal(xgb.attr(bst.Tree, "my_attr"), val)
|
||||
xgb.attributes(bst.Tree) <- list.val
|
||||
@@ -53,8 +56,10 @@ test_that("xgb-attribute functionality", {
|
||||
# deletion:
|
||||
xgb.attr(bst, "my_attr") <- NULL
|
||||
expect_null(xgb.attr(bst, "my_attr"))
|
||||
expect_equal(xgb.attributes(bst), list.ch[c("a", "b")])
|
||||
expect_equal(xgb.attributes(bst), list.ch[c("a", "b", "niter")])
|
||||
xgb.attributes(bst) <- list(a=NULL, b=NULL)
|
||||
expect_equal(xgb.attributes(bst), list.default)
|
||||
xgb.attributes(bst) <- list(niter=NULL)
|
||||
expect_null(xgb.attributes(bst))
|
||||
})
|
||||
|
||||
@@ -88,10 +93,27 @@ test_that("xgb.plot.tree works with and without feature names", {
|
||||
})
|
||||
|
||||
test_that("xgb.plot.multi.trees works with and without feature names", {
|
||||
xgb.plot.multi.trees(model = bst.Tree, feature_names = feature.names, features.keep = 3)
|
||||
xgb.plot.multi.trees(model = bst.Tree, features.keep = 3)
|
||||
xgb.plot.multi.trees(model = bst.Tree, feature_names = feature.names, features_keep = 3)
|
||||
xgb.plot.multi.trees(model = bst.Tree, features_keep = 3)
|
||||
})
|
||||
|
||||
test_that("xgb.plot.deepness works", {
|
||||
xgb.plot.deepness(model = bst.Tree)
|
||||
})
|
||||
|
||||
test_that("check.deprecation works", {
|
||||
ttt <- function(a = NNULL, DUMMY=NULL, ...) {
|
||||
check.deprecation(...)
|
||||
as.list((environment()))
|
||||
}
|
||||
res <- ttt(a = 1, DUMMY = 2, z = 3)
|
||||
expect_equal(res, list(a = 1, DUMMY = 2))
|
||||
expect_warning(
|
||||
res <- ttt(a = 1, dummy = 22, z = 3)
|
||||
, "\'dummy\' is deprecated")
|
||||
expect_equal(res, list(a = 1, DUMMY = 22))
|
||||
expect_warning(
|
||||
res <- ttt(a = 1, dumm = 22, z = 3)
|
||||
, "\'dumm\' was partially matched to \'dummy\'")
|
||||
expect_equal(res, list(a = 1, DUMMY = 22))
|
||||
})
|
||||
|
||||
Reference in New Issue
Block a user