[R] maintenance Apr 2017 (#2237)

* [R] make sure things work for a single split model; fixes #2191

* [R] add option use_int_id to xgb.model.dt.tree

* [R] add example of exporting tree plot to a file

* [R] set save_period = NULL as default in xgboost() to be the same as in xgb.train; fixes #2182

* [R] it's a good practice after CRAN releases to bump up package version in dev

* [R] allow xgb.DMatrix construction from integer dense matrices

* [R] xgb.DMatrix: silent parameter; improve documentation

* [R] xgb.model.dt.tree code style changes

* [R] update NEWS with parameter changes

* [R] code safety & style; handle non-strict matrix and inherited classes of input and model; fixes #2242

* [R] change to x.y.z.p R-package versioning scheme and set version to 0.6.4.3

* [R] add an R package versioning section to the contributors guide

* [R] R-package/README.md: clean up the redundant old installation instructions, link the contributors guide

R-package/tests/testthat/test_basic.R

@@ -189,3 +189,36 @@ test_that("xgb.cv works", {
   expect_false(is.null(cv$callbacks))
   expect_false(is.null(cv$call))
 })
+
+test_that("train and predict with non-strict classes", {
+  # standard dense matrix input
+  train_dense <- as.matrix(train$data)
+  bst <- xgboost(data = train_dense, label = train$label, max_depth = 2,
+                 eta = 1, nthread = 2, nrounds = 2, objective = "binary:logistic", verbose = 0)
+  pr0 <- predict(bst, train_dense)
+  
+  # dense matrix-like input of non-matrix class
+  class(train_dense) <- 'shmatrix'
+  expect_true(is.matrix(train_dense))
+  expect_error(
+    bst <- xgboost(data = train_dense, label = train$label, max_depth = 2,
+                   eta = 1, nthread = 2, nrounds = 2, objective = "binary:logistic", verbose = 0)
+    , regexp = NA)
+  expect_error(pr <- predict(bst, train_dense), regexp = NA)
+  expect_equal(pr0, pr)
+  
+  # dense matrix-like input of non-matrix class with some inheritance
+  class(train_dense) <- c('pphmatrix','shmatrix')
+  expect_true(is.matrix(train_dense))
+  expect_error(
+    bst <- xgboost(data = train_dense, label = train$label, max_depth = 2,
+                   eta = 1, nthread = 2, nrounds = 2, objective = "binary:logistic", verbose = 0)
+    , regexp = NA)
+  expect_error(pr <- predict(bst, train_dense), regexp = NA)
+  expect_equal(pr0, pr)
+  
+  # when someone inhertis from xgb.Booster, it should still be possible to use it as xgb.Booster
+  class(bst) <- c('super.Booster', 'xgb.Booster')
+  expect_error(pr <- predict(bst, train_dense), regexp = NA)
+  expect_equal(pr0, pr)
+})

R-package/tests/testthat/test_dmatrix.R

@@ -7,18 +7,30 @@ data(agaricus.test, package='xgboost')
 test_data <- agaricus.test$data[1:100,]
 test_label <- agaricus.test$label[1:100]
 
-test_that("xgb.DMatrix: basic construction, saving, loading", {
+test_that("xgb.DMatrix: basic construction", {
   # from sparse matrix
   dtest1 <- xgb.DMatrix(test_data, label=test_label)
+  
   # from dense matrix 
   dtest2 <- xgb.DMatrix(as.matrix(test_data), label=test_label)
   expect_equal(getinfo(dtest1, 'label'), getinfo(dtest2, 'label'))
+  expect_equal(dim(dtest1), dim(dtest2))
   
+  #from dense integer matrix
+  int_data <- as.matrix(test_data)
+  storage.mode(int_data) <- "integer"
+  dtest3 <- xgb.DMatrix(int_data, label=test_label)
+  expect_equal(dim(dtest1), dim(dtest3))
+})
+
+test_that("xgb.DMatrix: saving, loading", {
   # save to a local file
+  dtest1 <- xgb.DMatrix(test_data, label=test_label)
   tmp_file <- tempfile('xgb.DMatrix_')
   expect_true(xgb.DMatrix.save(dtest1, tmp_file))
   # read from a local file
-  dtest3 <- xgb.DMatrix(tmp_file)
+  expect_output(dtest3 <- xgb.DMatrix(tmp_file), "entries loaded from")
+  expect_output(dtest3 <- xgb.DMatrix(tmp_file, silent = TRUE), NA)
   unlink(tmp_file)
   expect_equal(getinfo(dtest1, 'label'), getinfo(dtest3, 'label'))
   
@@ -26,7 +38,7 @@ test_that("xgb.DMatrix: basic construction, saving, loading", {
   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)
+  dtest4 <- xgb.DMatrix(tmp_file, silent = TRUE)
   expect_equal(dim(dtest4), c(3, 4))
   expect_equal(getinfo(dtest4, 'label'), c(0,1,0))
   unlink(tmp_file)

R-package/tests/testthat/test_helpers.R

@@ -133,6 +133,12 @@ test_that("xgb.model.dt.tree works with and without feature names", {
   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])
+
+  # using integer node ID instead of character
+  dt.tree.int <- xgb.model.dt.tree(model = bst.Tree, use_int_id = TRUE)
+  expect_equal(as.integer(tstrsplit(dt.tree$Yes, '-')[[2]]), dt.tree.int$Yes)
+  expect_equal(as.integer(tstrsplit(dt.tree$No, '-')[[2]]), dt.tree.int$No)
+  expect_equal(as.integer(tstrsplit(dt.tree$Missing, '-')[[2]]), dt.tree.int$Missing)
 })
 
 test_that("xgb.model.dt.tree throws error for gblinear", {
@@ -169,6 +175,17 @@ test_that("xgb.importance works with GLM model", {
   xgb.ggplot.importance(importance.GLM)
 })
 
+test_that("xgb.model.dt.tree and xgb.importance work with a single split model", {
+  bst1 <- xgboost(data = sparse_matrix, label = label, max_depth = 1,
+                  eta = 1, nthread = 2, nrounds = 1, verbose = 0,
+                  objective = "binary:logistic")
+  expect_error(dt <- xgb.model.dt.tree(model = bst1), regexp = NA) # no error
+  expect_equal(nrow(dt), 3)
+  expect_error(imp <- xgb.importance(model = bst1), regexp = NA) # no error
+  expect_equal(nrow(imp), 1)
+  expect_equal(imp$Gain, 1)
+})
+
 test_that("xgb.plot.tree works with and without feature names", {
   xgb.plot.tree(feature_names = feature.names, model = bst.Tree)
   xgb.plot.tree(model = bst.Tree)