#170 add precision param to geojson_json - add tests for geojson_json…

… precision

DESCRIPTION

@@ -5,7 +5,7 @@ Description: Convert data to 'GeoJSON' or 'TopoJSON' from various R classes,
     'geojsonio' does not aim to replace packages like 'sp', 'rgdal', 'rgeos',
     but rather aims to be a high level client to simplify conversions of data
     from and to 'GeoJSON' and 'TopoJSON'.
-Version: 0.9.2.91
+Version: 0.9.2.93
 License: MIT + file LICENSE
 Authors@R: c(
     person("Scott", "Chamberlain", role = c("aut", "cre"), email = "myrmecocystus@gmail.com"),

R/geojson_write.r

@@ -419,11 +419,14 @@ geojson_write.geo_list <- function(input, lat = NULL, lon = NULL, geometry = "po
 
 #' @export
 geojson_write.json <- function(input, lat = NULL, lon = NULL, geometry = "point",
-                               group = NULL, file = "myfile.geojson", overwrite = TRUE, ...) {
+                               group = NULL, file = "myfile.geojson", overwrite = TRUE,
+                               precision = NULL, ...) {
   if (!overwrite && file.exists(file)) {
     stop(file, " already exists and overwrite = FALSE", call. = FALSE)
   }
-  cat(toJSON(jsonlite::fromJSON(input), auto_unbox = TRUE, ...), file = file)
+  if (is.null(precision)) precision <- 4
+  cat(toJSON(jsonlite::fromJSON(input), auto_unbox = TRUE, digits = precision, ...),
+    file = file)
   message("Success! File is at ", file)
   return(geo_file(file, "json"))
 }

R/zzz.r

@@ -5,10 +5,11 @@ json_val_safe <- function(x) {
   if (inherits(tmp, "error")) FALSE else tmp
 }
 
-to_json <- function(x, ...) {
+to_json <- function(x, precision = 7, ...) {
   if (is.character(x) && json_val_safe(x)) return(structure(x, class = "json"))
-  structure(jsonlite::toJSON(x, ..., digits = 7, auto_unbox = TRUE, force = TRUE),
-            class = c('json','geo_json'))
+  if (is.null(precision)) precision <- 7
+  structure(jsonlite::toJSON(x, ..., digits = precision, auto_unbox = TRUE,
+    force = TRUE), class = c('json','geo_json'))
 }
 
 class_json <- function(x, ..., type = "FeatureCollection") {

tests/testthat/helper-geojsonio.R

@@ -3,3 +3,26 @@ gdel <- function(x) {
 }
 
 supw <- function(x) suppressWarnings(x)
+
+# functions for precision testing
+# modified from https://stat.ethz.ch/pipermail/r-help/2012-July/317676.html
+decimalnumcount <- function(x) {
+  stopifnot(is.character(x))
+  vec <- vector("numeric", length = length(x))
+  for (i in seq_along(x)) {
+    if (!grepl("\\.", x[i])) {
+      vec[i] <- 0
+    } else {
+      w <- strsplit(x[i], "\\.")[[1]][2]
+      w <- gsub("(.*)(\\.)|([0]*$)", "", w)
+      vec[i] <- nchar(w)
+    }
+  }
+  return(vec)
+}
+num_digits <- function(x) {
+  z <- jsonlite::fromJSON(unclass(x)[[1]])
+  if ("features" %in% names(z)) w <- unlist(z$features$geometry$coordinates)
+  if ("geometries" %in% names(z)) w <- unlist(z$geometries$coordinates)
+  decimalnumcount(as.character(w))
+}

tests/testthat/test-geojson_json.R

@@ -122,3 +122,58 @@ test_that("skipping geoclass works with type = skip", {
   expect_match(attr(geojson_json(x), "type"), "FeatureCollection")
   expect_null(attr(geojson_json(x, type = "skip"), "type"))
 })
+
+context("geojson_json precision")
+def_digits <- getOption("digits")
+options(digits=15)
+test_that("precision", {
+  skip_on_cran()
+
+  # numeric
+  x <- geojson_json(c(-99.123456789,32.12345678), precision = 10)
+  expect_equal(num_digits(x), c(9, 8))
+
+  # list
+  vecs <- list(c(100.1,0.1), c(101.01,0.012), c(101.12345678,1.1), c(100,1), c(100.123456,0))
+  x <- geojson_json(vecs, precision = 10)
+  expect_equal(num_digits(x), c(1, 1, 2, 3, 8, 1, 0, 0, 6, 0))
+
+  # data.frame
+  df <- data.frame(lat = c(45.123,48.12), lon = c(-122,-122.1234567),
+    city = c("Portland", "Seattle"))
+  x <- geojson_json(df, lat='lat', lon='lon', precision = 3)
+  expect_equal(num_digits(x), c(0, 3, 3, 2))
+  x <- geojson_json(df, lat='lat', lon='lon', precision = 7)
+  expect_equal(num_digits(x), c(0, 3, 7, 2))
+
+  # from geojson_list output
+  a <- geojson_list(df, precision = 5)
+  x <- geojson_json(a, precision = 5)
+  expect_equal(num_digits(x), c(0, 3, 5, 2))
+
+  # sp classes: SpatialPolygons
+  library('sp')
+  poly1 <- Polygons(list(Polygon(cbind(c(-100.1,-90.12,-85.123,-100.1234),
+     c(40,50,45,40)))), "1")
+  poly2 <- Polygons(list(Polygon(cbind(c(-90,-80,-75,-90),
+     c(30,40,35,30)))), "2")
+  sp_poly <- SpatialPolygons(list(poly1, poly2), 1:2)
+  expect_equal(num_digits(geojson_json(sp_poly)),
+    c(1, 2, 3, 4, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0))
+  expect_equal(num_digits(geojson_json(sp_poly, precision = 2)),
+    c(1, 2, 2, 2, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0))
+
+  # sf classes
+  library('sf')
+  p1 <- rbind(c(0,0), c(1,0), c(3,2), c(2,4), c(1,4.1234567), c(0,0))
+  p2 <- rbind(c(5.123,5.1), c(5,6), c(4,5), c(5.123,5.1))
+  poly_sfc <- st_sfc(st_polygon(list(p1)), st_polygon(list(p2)))
+  expect_equal(num_digits(geojson_json(poly_sfc)),
+    c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 7, 0, 3, 0, 0, 3, 1, 0, 0, 1))
+  # FIXME: not working yet
+  expect_equal(num_digits(geojson_json(poly_sfc, precision = 2)),
+    c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 7, 0, 3, 0, 0, 3, 1, 0, 0, 1))
+})
+
+# reset digits to default value
+options(digits = def_digits)