diff --git a/CONTRIBUTORS.md b/CONTRIBUTORS.md index 6ae79f795..ab9c980c8 100644 --- a/CONTRIBUTORS.md +++ b/CONTRIBUTORS.md @@ -34,6 +34,7 @@ List of Contributors * [Zygmunt ZajÄ…c](https://github.com/zygmuntz) - Zygmunt is the master behind the early stopping feature frequently used by kagglers. * [Ajinkya Kale](https://github.com/ajkl) +* [Yuan Tang](https://github.com/terrytangyuan) * [Boliang Chen](https://github.com/cblsjtu) * [Vadim Khotilovich](https://github.com/khotilov) * [Yangqing Men](https://github.com/yanqingmen) diff --git a/R-package/tests/testthat/test_custom_objective.R b/R-package/tests/testthat/test_custom_objective.R new file mode 100644 index 000000000..9fcbeca4d --- /dev/null +++ b/R-package/tests/testthat/test_custom_objective.R @@ -0,0 +1,47 @@ +context('Test models with custom objective') + +require(xgboost) + +test_that("custom objective works", { + data(agaricus.train, package='xgboost') + data(agaricus.test, package='xgboost') + dtrain <- xgb.DMatrix(agaricus.train$data, label = agaricus.train$label) + dtest <- xgb.DMatrix(agaricus.test$data, label = agaricus.test$label) + + watchlist <- list(eval = dtest, train = dtrain) + num_round <- 2 + + logregobj <- function(preds, dtrain) { + labels <- getinfo(dtrain, "label") + preds <- 1/(1 + exp(-preds)) + grad <- preds - labels + hess <- preds * (1 - preds) + return(list(grad = grad, hess = hess)) + } + evalerror <- function(preds, dtrain) { + labels <- getinfo(dtrain, "label") + err <- as.numeric(sum(labels != (preds > 0)))/length(labels) + return(list(metric = "error", value = err)) + } + + param <- list(max.depth=2, eta=1, nthread = 2, silent=1, + objective=logregobj, eval_metric=evalerror) + + bst <- xgb.train(param, dtrain, num_round, watchlist) + expect_equal(class(bst), "xgb.Booster") + expect_equal(length(bst$raw), 1064) + attr(dtrain, 'label') <- getinfo(dtrain, 'label') + + logregobjattr <- function(preds, dtrain) { + labels <- attr(dtrain, 'label') + preds <- 1/(1 + exp(-preds)) + grad <- preds - labels + hess <- preds * (1 - preds) + return(list(grad = grad, hess = hess)) + } + param <- list(max.depth=2, eta=1, nthread = 2, silent=1, + objective=logregobjattr, eval_metric=evalerror) + bst <- xgb.train(param, dtrain, num_round, watchlist) + expect_equal(class(bst), "xgb.Booster") + expect_equal(length(bst$raw), 1064) +}) \ No newline at end of file diff --git a/R-package/tests/testthat/test_helpers.R b/R-package/tests/testthat/test_helpers.R new file mode 100644 index 000000000..4d80146e3 --- /dev/null +++ b/R-package/tests/testthat/test_helpers.R @@ -0,0 +1,32 @@ +context('Test helper functions') + +require(xgboost) +require(data.table) +require(Matrix) +require(vcd) + +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 <- xgboost(data = sparse_matrix, label = output_vector, max.depth = 9, + eta = 1, nthread = 2, nround = 10,objective = "binary:logistic") + + +test_that("xgb.dump works", { + capture.output(print(xgb.dump(bst))) +}) + +test_that("xgb.importance works", { + xgb.dump(bst, 'xgb.model.dump', with.stats = T) + importance <- xgb.importance(sparse_matrix@Dimnames[[2]], 'xgb.model.dump') + expect_equal(dim(importance), c(7, 4)) +}) + +test_that("xgb.plot.tree works", { + xgb.plot.tree(agaricus.train$data@Dimnames[[2]], model = bst) +}) \ No newline at end of file diff --git a/R-package/tests/testthat/test_poisson_regression.R b/R-package/tests/testthat/test_poisson_regression.R new file mode 100644 index 000000000..5d3d78e27 --- /dev/null +++ b/R-package/tests/testthat/test_poisson_regression.R @@ -0,0 +1,13 @@ +context('Test poisson regression model') + +require(xgboost) + +test_that("poisson regression works", { + data(mtcars) + bst = xgboost(data=as.matrix(mtcars[,-11]),label=mtcars[,11], + objective='count:poisson',nrounds=5) + expect_equal(class(bst), "xgb.Booster") + pred = predict(bst,as.matrix(mtcars[,-11])) + expect_equal(length(pred), 32) + sqrt(mean((pred-mtcars[,11])^2)) +}) \ No newline at end of file