From d545662510bccd373c00c10f487d746050bf3e09 Mon Sep 17 00:00:00 2001 From: Hyunsu Cho Date: Sun, 26 Jul 2020 03:28:37 -0700 Subject: [PATCH 1/3] [R] enable weighted learning to rank --- R-package/R/xgb.DMatrix.R | 2 -- 1 file changed, 2 deletions(-) diff --git a/R-package/R/xgb.DMatrix.R b/R-package/R/xgb.DMatrix.R index 9c7ba2684845..9d1d53c12197 100644 --- a/R-package/R/xgb.DMatrix.R +++ b/R-package/R/xgb.DMatrix.R @@ -257,8 +257,6 @@ setinfo.xgb.DMatrix <- function(object, name, info, ...) { return(TRUE) } if (name == "weight") { - if (length(info) != nrow(object)) - stop("The length of weights must equal to the number of rows in the input data") .Call(XGDMatrixSetInfo_R, object, name, as.numeric(info)) return(TRUE) } From 47145ff5f80fa84f8183cfb1690a9d8ef8fe31c6 Mon Sep 17 00:00:00 2001 From: Hyunsu Cho Date: Sun, 26 Jul 2020 04:07:48 -0700 Subject: [PATCH 2/3] Add R unit test for ranking --- R-package/tests/testthat/test_ranking.R | 51 +++++++++++++++++++++++++ 1 file changed, 51 insertions(+) create mode 100644 R-package/tests/testthat/test_ranking.R diff --git a/R-package/tests/testthat/test_ranking.R b/R-package/tests/testthat/test_ranking.R new file mode 100644 index 000000000000..e6f26bb5691a --- /dev/null +++ b/R-package/tests/testthat/test_ranking.R @@ -0,0 +1,51 @@ +require(xgboost) +require(Matrix) + +context('Learning to rank') + +test_that('Test ranking with unweighted data', { + X <- sparseMatrix(i = c(2, 3, 7, 9, 12, 15, 17, 18), + j = c(1, 1, 2, 2, 3, 3, 4, 4), + x = rep(1.0, 8), dims = c(20, 4)) + y <- c(0, 1, 1, 0, 0, 0, 1, 0, 1, 0, 0, 1, 0, 0, 1, 0, 1, 1, 0, 0) + group <- c(5, 5, 5, 5) + dtrain <- xgb.DMatrix(X, label = y, group = group) + + params = list(eta = 1, tree_method = 'exact', objective = 'rank:pairwise', max_depth = 1, + eval_metric = 'auc', eval_metric = 'aucpr') + bst <- xgb.train(params, dtrain, nrounds = 10, watchlist = list(train = dtrain)) + # Check if the metric is monotone increasing + expect_true(all(diff(bst$evaluation_log$train_auc) >= 0)) + expect_true(all(diff(bst$evaluation_log$train_aucpr) >= 0)) +}) + +test_that('Test ranking with weighted data', { + X <- sparseMatrix(i = c(2, 3, 7, 9, 12, 15, 17, 18), + j = c(1, 1, 2, 2, 3, 3, 4, 4), + x = rep(1.0, 8), dims = c(20, 4)) + y <- c(0, 1, 1, 0, 0, 0, 1, 0, 1, 0, 0, 1, 0, 0, 1, 0, 1, 1, 0, 0) + group <- c(5, 5, 5, 5) + weight <- c(1.0, 2.0, 3.0, 4.0) + dtrain <- xgb.DMatrix(X, label = y, group = group, weight = weight) + + params = list(eta = 1, tree_method = 'exact', objective = 'rank:pairwise', max_depth = 1, + eval_metric = 'auc', eval_metric = 'aucpr') + bst <- xgb.train(params, dtrain, nrounds = 10, watchlist = list(train = dtrain)) + # Check if the metric is monotone increasing + expect_true(all(diff(bst$evaluation_log$train_auc) >= 0)) + expect_true(all(diff(bst$evaluation_log$train_aucpr) >= 0)) + for (i in 1:10) { + pred <- predict(bst, newdata = dtrain, ntreelimit = i) + # is_sorted[i]: is i-th group correctly sorted by the ranking predictor? + is_sorted <- lapply(seq(1, 20, by = 5), + function (k) { + ind <- order(-pred[k:(k + 4)]) + z <- y[ind + (k - 1)] + all(diff(z) <= 0) # Check if z is monotone decreasing + }) + # Since we give weights 1, 2, 3, 4 to the four query groups, + # the ranking predictor will first try to correctly sort the last query group + # before correctly sorting other groups. + expect_true(all(diff(as.numeric(is_sorted)) >= 0)) + } +}) From 829da14a602587796d244e4e0e54e3da5bdf5afd Mon Sep 17 00:00:00 2001 From: Philip Hyunsu Cho Date: Sun, 26 Jul 2020 04:38:09 -0700 Subject: [PATCH 3/3] Fix lint --- R-package/tests/testthat/test_ranking.R | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/R-package/tests/testthat/test_ranking.R b/R-package/tests/testthat/test_ranking.R index e6f26bb5691a..7a352bea2ec0 100644 --- a/R-package/tests/testthat/test_ranking.R +++ b/R-package/tests/testthat/test_ranking.R @@ -11,8 +11,8 @@ test_that('Test ranking with unweighted data', { group <- c(5, 5, 5, 5) dtrain <- xgb.DMatrix(X, label = y, group = group) - params = list(eta = 1, tree_method = 'exact', objective = 'rank:pairwise', max_depth = 1, - eval_metric = 'auc', eval_metric = 'aucpr') + params <- list(eta = 1, tree_method = 'exact', objective = 'rank:pairwise', max_depth = 1, + eval_metric = 'auc', eval_metric = 'aucpr') bst <- xgb.train(params, dtrain, nrounds = 10, watchlist = list(train = dtrain)) # Check if the metric is monotone increasing expect_true(all(diff(bst$evaluation_log$train_auc) >= 0)) @@ -28,8 +28,8 @@ test_that('Test ranking with weighted data', { weight <- c(1.0, 2.0, 3.0, 4.0) dtrain <- xgb.DMatrix(X, label = y, group = group, weight = weight) - params = list(eta = 1, tree_method = 'exact', objective = 'rank:pairwise', max_depth = 1, - eval_metric = 'auc', eval_metric = 'aucpr') + params <- list(eta = 1, tree_method = 'exact', objective = 'rank:pairwise', max_depth = 1, + eval_metric = 'auc', eval_metric = 'aucpr') bst <- xgb.train(params, dtrain, nrounds = 10, watchlist = list(train = dtrain)) # Check if the metric is monotone increasing expect_true(all(diff(bst$evaluation_log$train_auc) >= 0))