[R-package] store numeric attributes with higher precision (#1628)

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)) {

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)