1require(xgboost)
2require(Matrix)
3
4context("testing xgb.DMatrix functionality")
5
6data(agaricus.test, package = 'xgboost')
7test_data <- agaricus.test$data[1:100, ]
8test_label <- agaricus.test$label[1:100]
9
10test_that("xgb.DMatrix: basic construction", {
11  # from sparse matrix
12  dtest1 <- xgb.DMatrix(test_data, label = test_label)
13
14  # from dense matrix
15  dtest2 <- xgb.DMatrix(as.matrix(test_data), label = test_label)
16  expect_equal(getinfo(dtest1, 'label'), getinfo(dtest2, 'label'))
17  expect_equal(dim(dtest1), dim(dtest2))
18
19  #from dense integer matrix
20  int_data <- as.matrix(test_data)
21  storage.mode(int_data) <- "integer"
22  dtest3 <- xgb.DMatrix(int_data, label = test_label)
23  expect_equal(dim(dtest1), dim(dtest3))
24})
25
26test_that("xgb.DMatrix: saving, loading", {
27  # save to a local file
28  dtest1 <- xgb.DMatrix(test_data, label = test_label)
29  tmp_file <- tempfile('xgb.DMatrix_')
30  expect_true(xgb.DMatrix.save(dtest1, tmp_file))
31  # read from a local file
32  expect_output(dtest3 <- xgb.DMatrix(tmp_file), "entries loaded from")
33  expect_output(dtest3 <- xgb.DMatrix(tmp_file, silent = TRUE), NA)
34  unlink(tmp_file)
35  expect_equal(getinfo(dtest1, 'label'), getinfo(dtest3, 'label'))
36
37  # from a libsvm text file
38  tmp <- c("0 1:1 2:1", "1 3:1", "0 1:1")
39  tmp_file <- 'tmp.libsvm'
40  writeLines(tmp, tmp_file)
41  dtest4 <- xgb.DMatrix(tmp_file, silent = TRUE)
42  expect_equal(dim(dtest4), c(3, 4))
43  expect_equal(getinfo(dtest4, 'label'), c(0, 1, 0))
44  unlink(tmp_file)
45})
46
47test_that("xgb.DMatrix: getinfo & setinfo", {
48  dtest <- xgb.DMatrix(test_data)
49  expect_true(setinfo(dtest, 'label', test_label))
50  labels <- getinfo(dtest, 'label')
51  expect_equal(test_label, getinfo(dtest, 'label'))
52
53  expect_true(setinfo(dtest, 'label_lower_bound', test_label))
54  expect_equal(test_label, getinfo(dtest, 'label_lower_bound'))
55
56  expect_true(setinfo(dtest, 'label_upper_bound', test_label))
57  expect_equal(test_label, getinfo(dtest, 'label_upper_bound'))
58
59  expect_true(length(getinfo(dtest, 'weight')) == 0)
60  expect_true(length(getinfo(dtest, 'base_margin')) == 0)
61
62  expect_true(setinfo(dtest, 'weight', test_label))
63  expect_true(setinfo(dtest, 'base_margin', test_label))
64  expect_true(setinfo(dtest, 'group', c(50, 50)))
65  expect_error(setinfo(dtest, 'group', test_label))
66
67  # providing character values will give an error
68  expect_error(setinfo(dtest, 'weight', rep('a', nrow(test_data))))
69
70  # any other label should error
71  expect_error(setinfo(dtest, 'asdf', test_label))
72})
73
74test_that("xgb.DMatrix: slice, dim", {
75  dtest <- xgb.DMatrix(test_data, label = test_label)
76  expect_equal(dim(dtest), dim(test_data))
77  dsub1 <- slice(dtest, 1:42)
78  expect_equal(nrow(dsub1), 42)
79  expect_equal(ncol(dsub1), ncol(test_data))
80
81  dsub2 <- dtest[1:42, ]
82  expect_equal(dim(dtest), dim(test_data))
83  expect_equal(getinfo(dsub1, 'label'), getinfo(dsub2, 'label'))
84})
85
86test_that("xgb.DMatrix: slice, trailing empty rows", {
87  data(agaricus.train, package = 'xgboost')
88  train_data <- agaricus.train$data
89  train_label <- agaricus.train$label
90  dtrain <- xgb.DMatrix(data = train_data, label = train_label)
91  slice(dtrain, 6513L)
92  train_data[6513, ] <- 0
93  dtrain <- xgb.DMatrix(data = train_data, label = train_label)
94  slice(dtrain, 6513L)
95  expect_equal(nrow(dtrain), 6513)
96})
97
98test_that("xgb.DMatrix: colnames", {
99  dtest <- xgb.DMatrix(test_data, label = test_label)
100  expect_equal(colnames(dtest), colnames(test_data))
101  expect_error(colnames(dtest) <- 'asdf')
102  new_names <- make.names(seq_len(ncol(test_data)))
103  expect_silent(colnames(dtest) <- new_names)
104  expect_equal(colnames(dtest), new_names)
105  expect_silent(colnames(dtest) <- NULL)
106  expect_null(colnames(dtest))
107})
108
109test_that("xgb.DMatrix: nrow is correct for a very sparse matrix", {
110  set.seed(123)
111  nr <- 1000
112  x <- rsparsematrix(nr, 100, density = 0.0005)
113  # we want it very sparse, so that last rows are empty
114  expect_lt(max(x@i), nr)
115  dtest <- xgb.DMatrix(x)
116  expect_equal(dim(dtest), dim(x))
117})
118