add 'digits' argument when writing JSON

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: yyjsonr
 Type: Package
 Title: Fast JSON, GeoJSON and NDJSON Parsing and Serialisation
-Version: 0.1.10
+Version: 0.1.11
 Authors@R: c(
     person("Mike", "FC", role = c("aut", "cre"), email = "[email protected]"),
     person("Yao", "Yuan", role = "cph", email = "[email protected]", 

NEWS.md

@@ -1,4 +1,12 @@
 
+# yyjsonr 0.1.11 2023-10-27
+
+* Writing to JSON objects now supports a `digits` argument for rounding floating 
+  point values to the specified number of significant digits
+    * `digits = -1` means don't do any rounding
+    * `digits = 0` rounds floating point values to integers (and writes the 
+      values as JSON integers)
+
 # yyjsonr 0.1.10 2023-09-14
 
 * Refactored options for simplification to data.frame

R/geojson.R

@@ -93,34 +93,38 @@ read_geojson_file <- function(filename, opts = list(), ...) {
 #' @param opts named list of options. Usually created with \code{opts_write_geojson()}.
 #'        Default: empty \code{list()} to use the default options.
 #' @param ... any extra named options override those in \code{opts}
+#' @param digits decimal places to keep for floating point numbers. Default: -1.
+#'        Positive values specify number of decimal places. Using zero will
+#'        write the numeric value as an integer. Values less than zero mean that
+#'        the floating point value should be written as-is (the default).
 #'
 #' @return character string containing json
 #' @export
 #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-write_geojson_str <- function(x, opts = list(), ...) {
+write_geojson_str <- function(x, opts = list(), ..., digits = -1) {
   opts <- modify_list(opts, list(...))
 
   .Call(
     serialize_sf_to_str_,
     x,
     opts,                        # geojson serialize opts
-    list(yyjson_write_flag = 0L) # general serialize opts
+    list(yyjson_write_flag = 0L, digits = digits) # general serialize opts
   )
 }
 
 #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 #' @rdname write_geojson_str
 #' @export
 #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-write_geojson_file <- function(x, filename, opts = list(), ...) {
+write_geojson_file <- function(x, filename, opts = list(), ..., digits = -1) {
   opts <- modify_list(opts, list(...))
 
   .Call(
     serialize_sf_to_file_,
     x,
     filename,
     opts,                        # geojson serialize opts
-    list(yyjson_write_flag = 0L) # general serialize opts
+    list(yyjson_write_flag = 0L, digits = digits) # general serialize opts
   )
 
   invisible()

R/json-opts.R

@@ -141,7 +141,9 @@ read_flag <- list(
 #'
 #' @examples
 #' \dontrun{
-#' write_json_str(str, opts = opts_write_json(yyjson_write_flag = write_flag$YYJSON_WRITE_ESCAPE_SLASHES))
+#' write_json_str(str, opts = opts_write_json(
+#'   yyjson_write_flag = write_flag$YYJSON_WRITE_ESCAPE_SLASHES
+#' ))
 #' }
 #' 
 #' @export
@@ -229,6 +231,10 @@ opts_read_json <- function(
 #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 #' Create named list of options for serializing R to JSON
 #'
+#' @param digits decimal places to keep for floating point numbers. Default: -1.
+#'        Positive values specify number of decimal places. Using zero will
+#'        write the numeric value as an integer. Values less than zero mean that
+#'        the floating point value should be written as-is (the default).
 #' @param dataframe how to encode data.frame objects. Options 'rows' or 
 #'        columns'.  Default: 'rows'
 #' @param factor how to encode factor objects: must be one of 'string' or 'integer'
@@ -264,6 +270,7 @@ opts_read_json <- function(
 #' @export
 #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 opts_write_json <- function( 
+    digits            = -1,
     dataframe         = c("rows", "columns"),
     factor            = c("string", "integer"),
     auto_unbox        = FALSE,
@@ -275,6 +282,7 @@ opts_write_json <- function(
 
   structure(
     list(
+      digits            = as.integer(digits),
       dataframe         = match.arg(dataframe),
       factor            = match.arg(factor),
       auto_unbox        = isTRUE(auto_unbox),

man/benchmark/benchmarks.Rmd

@@ -105,12 +105,37 @@ From JSON raw vector
 ----------------------------------------------------------------------------
 
 ```{r warning=FALSE}
-a <- nanonext::ncurl("https://postman-echo.com/get", convert = FALSE)
+# a <- nanonext::ncurl("https://postman-echo.com/get", convert = FALSE)
+
+# raw_data <- a$data
+raw_data <- as.raw(c(0x7b, 0x0a, 0x20, 0x20, 0x22, 0x61, 0x72, 0x67, 0x73, 
+0x22, 0x3a, 0x20, 0x7b, 0x7d, 0x2c, 0x0a, 0x20, 0x20, 0x22, 0x68, 
+0x65, 0x61, 0x64, 0x65, 0x72, 0x73, 0x22, 0x3a, 0x20, 0x7b, 0x0a, 
+0x20, 0x20, 0x20, 0x20, 0x22, 0x78, 0x2d, 0x66, 0x6f, 0x72, 0x77, 
+0x61, 0x72, 0x64, 0x65, 0x64, 0x2d, 0x70, 0x72, 0x6f, 0x74, 0x6f, 
+0x22, 0x3a, 0x20, 0x22, 0x68, 0x74, 0x74, 0x70, 0x73, 0x22, 0x2c, 
+0x0a, 0x20, 0x20, 0x20, 0x20, 0x22, 0x78, 0x2d, 0x66, 0x6f, 0x72, 
+0x77, 0x61, 0x72, 0x64, 0x65, 0x64, 0x2d, 0x70, 0x6f, 0x72, 0x74, 
+0x22, 0x3a, 0x20, 0x22, 0x34, 0x34, 0x33, 0x22, 0x2c, 0x0a, 0x20, 
+0x20, 0x20, 0x20, 0x22, 0x68, 0x6f, 0x73, 0x74, 0x22, 0x3a, 0x20, 
+0x22, 0x70, 0x6f, 0x73, 0x74, 0x6d, 0x61, 0x6e, 0x2d, 0x65, 0x63, 
+0x68, 0x6f, 0x2e, 0x63, 0x6f, 0x6d, 0x22, 0x2c, 0x0a, 0x20, 0x20, 
+0x20, 0x20, 0x22, 0x78, 0x2d, 0x61, 0x6d, 0x7a, 0x6e, 0x2d, 0x74, 
+0x72, 0x61, 0x63, 0x65, 0x2d, 0x69, 0x64, 0x22, 0x3a, 0x20, 0x22, 
+0x52, 0x6f, 0x6f, 0x74, 0x3d, 0x31, 0x2d, 0x36, 0x35, 0x33, 0x62, 
+0x61, 0x33, 0x38, 0x65, 0x2d, 0x35, 0x65, 0x65, 0x66, 0x32, 0x39, 
+0x64, 0x38, 0x30, 0x61, 0x35, 0x63, 0x65, 0x62, 0x32, 0x30, 0x33, 
+0x65, 0x36, 0x64, 0x32, 0x64, 0x35, 0x61, 0x22, 0x0a, 0x20, 0x20, 
+0x7d, 0x2c, 0x0a, 0x20, 0x20, 0x22, 0x75, 0x72, 0x6c, 0x22, 0x3a, 
+0x20, 0x22, 0x68, 0x74, 0x74, 0x70, 0x73, 0x3a, 0x2f, 0x2f, 0x70, 
+0x6f, 0x73, 0x74, 0x6d, 0x61, 0x6e, 0x2d, 0x65, 0x63, 0x68, 0x6f, 
+0x2e, 0x63, 0x6f, 0x6d, 0x2f, 0x67, 0x65, 0x74, 0x22, 0x0a, 0x7d
+))
 
 res03 <- bench::mark(
-  jsonlite     = jsonlite::fromJSON(rawConnection(a$raw)),
-  rcppsimdjson = RcppSimdJson::fparse(a$raw),
-  yyjsonr      = yyjsonr::read_json_raw(a$raw),
+  jsonlite     = jsonlite::fromJSON(rawConnection(raw_data)),
+  rcppsimdjson = RcppSimdJson::fparse(raw_data),
+  yyjsonr      = yyjsonr::read_json_raw(raw_data),
   check = FALSE
 )
 ```

src/R-yyjson-serialize.c

@@ -27,6 +27,7 @@ serialize_options parse_serialize_options(SEXP serialize_opts_) {
     .data_frame        = DATAFRAME_BY_ROW,
     .factor            = FACTOR_AS_STR,
     .auto_unbox        = FALSE,
+    .digits            = -1,
     .name_repair       = NAME_REPAIR_NONE,
     .num_specials      = NUM_SPECIALS_AS_NULL,
     .str_specials      = STR_SPECIALS_AS_NULL,
@@ -50,7 +51,9 @@ serialize_options parse_serialize_options(SEXP serialize_opts_) {
     const char *opt_name = CHAR(STRING_ELT(nms_, i));
     SEXP val_ = VECTOR_ELT(serialize_opts_, i);
 
-    if (strcmp(opt_name, "dataframe") == 0) {
+    if (strcmp(opt_name, "digits") == 0) {
+      opt.digits = asInteger(val_);
+    } else if (strcmp(opt_name, "dataframe") == 0) {
       const char *tmp = CHAR(STRING_ELT(val_, 0));
       opt.data_frame = strcmp(tmp, "rows") == 0 ? DATAFRAME_BY_ROW : DATAFRAME_BY_COL;
     } else if (strcmp(opt_name, "factor") == 0) {
@@ -263,6 +266,10 @@ yyjson_mut_val *scalar_factor_to_json_val(SEXP factor_, unsigned int idx,  yyjso
 }
 
 
+// Powers of 10 for rounding calculation
+static double fac[20] = {1, 10, 100, 1000, 10000, 1e+05, 1e+06, 1e+07, 1e+08, 
+                         1e+09, 1e+10, 1e+11, 1e+12, 1e+13, 1e+14, 1e+15, 
+                         1e+16, 1e+17, 1e+18, 1e+19};
 
 //===========================================================================
 // Scalar double to JSON value
@@ -286,7 +293,15 @@ yyjson_mut_val *scalar_double_to_json_val(double rdbl, yyjson_mut_doc *doc, seri
       }
     }
   } else if ( R_FINITE(rdbl) ) {
-    val = yyjson_mut_real(doc, rdbl);
+    if (opt->digits < 0) {
+      val = yyjson_mut_real(doc, rdbl);
+    } else if (opt->digits == 0) {
+      // round to integer
+      val = yyjson_mut_int(doc, round(rdbl));
+    } else {
+      // round to decimal places
+      val = yyjson_mut_real(doc, round(rdbl * fac[opt->digits])/fac[opt->digits]);
+    }
   } else {
     // Infinite
     if (opt->num_specials == NUM_SPECIALS_AS_NULL) {

src/R-yyjson-serialize.h

@@ -69,6 +69,7 @@ typedef struct {
   unsigned int data_frame;
   unsigned int factor;
   unsigned int null;
+  int digits;
   bool auto_unbox; 
   unsigned int name_repair;
   unsigned int str_specials;

tests/testthat/test-digits.R

@@ -0,0 +1,51 @@
+
+test_that("digits argument works", {
+
+  robj <- c(1.51, 2, 3.141592654)
+
+
+  expect_equal(
+    write_json_str(robj, digits = -1),
+    "[1.51,2.0,3.141592654]"
+  )
+
+  expect_equal(
+    write_json_str(robj, digits = 0),
+    "[2,2,3]"
+  )
+
+  expect_equal(
+    write_json_str(robj, digits = 1),
+    "[1.5,2.0,3.1]"
+  )
+
+  expect_equal(
+    write_json_str(robj, digits = 2),
+    "[1.51,2.0,3.14]"
+  )
+
+
+
+  expect_equal(
+    write_json_str(pi, digits = 0),
+    "[3]"
+  )
+
+  expect_equal(
+    write_json_str(pi, digits = 1),
+    "[3.1]"
+  )
+
+  expect_equal(
+    write_json_str(pi, digits = 4),
+    "[3.1416]"
+  )
+
+
+  expect_equal(
+    write_json_str(pi, digits = 4, auto_unbox = TRUE),
+    "3.1416"
+  )
+
+
+})

tests/testthat/test-geojson-digits.R

@@ -0,0 +1,49 @@
+
+js <- r"(
+{
+    "type": "FeatureCollection",
+    "features": [
+        {
+            "type": "Feature",
+            "geometry": {
+                "type": "Point",
+                "coordinates": [
+                    -80.870885,
+                    35.215151
+                ]
+            },
+            "properties": {
+                "value": 1.0
+            }
+        },
+        {
+            "type": "Feature",
+            "geometry": {
+                "type": "Point",
+                "coordinates": [
+                    -80.837753,
+                    35.249801
+                ]
+            },
+            "properties": {
+                "value": "a"
+            }
+        }
+    ]
+} 
+)"
+
+
+test_that("geojson digits works", {
+
+  x <- read_geojson_str(js)
+
+  js2 <- write_geojson_str(x, digits = 0)
+
+  x2 <- read_geojson_str(js2)
+
+  expect_equal(unclass(x2$geometry[[1]]), c(-81, 35))
+  expect_equal(unclass(x2$geometry[[2]]), c(-81, 35))
+
+
+})

tests/testthat/test-geojson-promotion-compat.R

@@ -36,7 +36,7 @@ js <- r"(
 
 
 
-test_that("multiplication works", {
+test_that("geojson property promotion works", {
 
   tst <- read_geojson_str(js) # geojson compat
   expect_identical(tst$value, c("1.000000", "a"))