diff --git a/R-package/R/xgb.Booster.R b/R-package/R/xgb.Booster.R index 6c336f238..f4c248153 100644 --- a/R-package/R/xgb.Booster.R +++ b/R-package/R/xgb.Booster.R @@ -302,7 +302,11 @@ xgb.attr <- function(object, name) { if (!is.null(value)) { # Coerce the elements to be scalar strings. # Q: should we warn user about non-scalar elements? - value <- as.character(value[1]) + if (is.numeric(value[1])) { + value <- format(value[1], digits = 17) + } else { + value <- as.character(value[1]) + } } .Call("XGBoosterSetAttr_R", handle, as.character(name[1]), value, PACKAGE="xgboost") if (is(object, 'xgb.Booster') && !is.null(object$raw)) { @@ -335,7 +339,11 @@ xgb.attributes <- function(object) { # Q: should we warn a user about non-scalar elements? a <- lapply(a, function(x) { if (is.null(x)) return(NULL) - as.character(x[1]) + if (is.numeric(value[1])) { + format(x[1], digits = 17) + } else { + as.character(x[1]) + } }) handle <- xgb.get.handle(object) for (i in seq_along(a)) { diff --git a/R-package/tests/testthat/test_helpers.R b/R-package/tests/testthat/test_helpers.R index 9c63101fb..1d3ef3437 100644 --- a/R-package/tests/testthat/test_helpers.R +++ b/R-package/tests/testthat/test_helpers.R @@ -73,6 +73,19 @@ test_that("xgb-attribute functionality", { expect_null(xgb.attributes(bst)) }) +test_that("xgb-attribute numeric precision", { + # check that lossless conversion works with 17 digits + # numeric -> character -> numeric + X <- 10^runif(100, -20, 20) + X2X <- as.numeric(format(X, digits = 17)) + expect_identical(X, X2X) + # retrieved attributes to be the same as written + for (x in X) { + xgb.attr(bst.Tree, "x") <- x + expect_identical(as.numeric(xgb.attr(bst.Tree, "x")), x) + } +}) + test_that("xgb.model.dt.tree works with and without feature names", { names.dt.trees <- c("Tree", "Node", "ID", "Feature", "Split", "Yes", "No", "Missing", "Quality", "Cover") dt.tree <- xgb.model.dt.tree(feature_names = feature.names, model = bst.Tree)