fix #71 - also fix tests, add as.feature

NAMESPACE

@@ -1,5 +1,6 @@
 # Generated by roxygen2: do not edit by hand
 
+S3method(as.feature,character)
 S3method(as.turf,centroid)
 S3method(as.turf,feature)
 S3method(as.turf,geo_list)
@@ -55,6 +56,7 @@ S3method(view,multipoint)
 S3method(view,point)
 S3method(view,polygon)
 export("%>%")
+export(as.feature)
 export(as.turf)
 export(as_feature)
 export(gr_point)

R/along.R

@@ -45,7 +45,9 @@ lawn_along <- function(line, distance, units, lint = FALSE) {
   line <- convert(line)
   lawnlint(line, lint)
   assert(distance, c('numeric', 'integer'))
-  is_type(line, type_top = "Feature", type_lower = "LineString")
+  if (lint) {
+    is_type(line, type_top = "Feature", type_lower = "LineString")
+  }
   ct$eval(sprintf("var alg = turf.along(%s, %s, '%s');", line, distance, units))
   structure(ct$get("alg"), class = "point")
 }

R/area.R

@@ -12,7 +12,9 @@
 lawn_area <- function(input, lint = FALSE) {
   input <- convert(input)
   lawnlint(input, lint)
-  is_type(input, type_top = c("Feature", "FeatureCollection"))
+  if (lint) {
+    is_type(input, type_top = c("Feature", "FeatureCollection"))
+  }
   ct$eval(sprintf("var area = turf.area(%s);", input))
   ct$get("area")
 }

R/as.feature.R

@@ -0,0 +1,84 @@
+#' Coerce character strings or JSON to GeoJSON Feature
+#'
+#' @export
+#' @param x a character string or json class with a GeoJSON object, any
+#' of feature, point, multipoint, linestring, multilinestring, polygon,
+#' or multipolygon. featurecollection and geometrycollection simply returned
+#' without alteration
+#' @param ... ignored
+#' @return a `feature` class object
+#' @examples
+#' poly <- '{
+#'   "type": "Feature",
+#'   "properties": {},
+#'   "geometry": {
+#'     "type": "Polygon",
+#'     "coordinates": [[
+#'       [105.818939,21.004714],
+#'       [105.818939,21.061754],
+#'       [105.890007,21.061754],
+#'       [105.890007,21.004714],
+#'       [105.818939,21.004714]
+#'      ]]
+#'   }
+#' }'
+#' as.feature(poly)
+#'
+#' pt <- '{"type":"Point","coordinates":[-75.343,39.984]}'
+#' as.feature(pt)
+#'
+#' line <- '{
+#'   "type": "LineString",
+#'   "coordinates": [
+#'     [-77.031669, 38.878605],
+#'     [-77.029609, 38.881946],
+#'     [-77.020339, 38.884084],
+#'     [-77.025661, 38.885821],
+#'     [-77.021884, 38.889563],
+#'     [-77.019824, 38.892368]
+#'     ]
+#' }'
+#' as.feature(line)
+#'
+#' # returns self if no match - note "Points" is not a geojson type
+#' pt <- '{"type":"Points","coordinates":[-75.343,39.984]}'
+#' as.feature(pt)
+as.feature <- function(x, ...) {
+  UseMethod("as.feature")
+}
+
+#' @export
+as.feature.character <- function(x, ...) {
+  keys <- get_keys(x)
+  if ("type" %in% keys) {
+    typ <- tolower(get_type(x))
+    if (typ == "feature") {
+      return(lawn_feature(get_geometry(x), get_props(x)))
+    } else if (typ %in% c("point", "multipoint", "linestring",
+                          "multilinestring", "polygon", "multipolygon")) {
+      return(lawn_feature(x))
+    } else {
+      return(x)
+    }
+  }
+}
+
+get_keys <- function(x) {
+  ht$eval(sprintf("var keys = Object.keys(%s);", jsonlite::minify(x)))
+  ht$get('keys')
+}
+
+get_type <- function(x) {
+  ht$eval(sprintf("var xx = %s.type;", jsonlite::minify(x)))
+  ht$get('xx')
+}
+
+get_geometry <- function(x) {
+  ht$eval(sprintf("var geom = %s.geometry;", jsonlite::minify(x)))
+  ht$get('geom')
+}
+
+get_props <- function(x) {
+  ht$eval(sprintf("var props = %s.properties;", jsonlite::minify(x)))
+  ht$get('props')
+}

R/as_feature.R

@@ -6,6 +6,8 @@
 #' each feature is split out into a separate feature, returned in a list.
 #' Each feature is assigned a class matching it's GeoJSON data type
 #' (e.g., point, polygon, linestring).
+#' @seealso [as.feature] , which is similarly named, but has a different
+#' purpose
 #' @examples
 #' as_feature(lawn_random())
 #' # as_feature(lawn_random("polygons"))

R/average.R

@@ -25,7 +25,9 @@ lawn_average <- function(polygons, points, in_field, out_field = 'average',
                          lint = FALSE) {
 
   lawnlint(list(polygons, points), lint)
-  is_type(polygons, type_top = "FeatureCollection")
-  is_type(points, type_top = "FeatureCollection")
+  if (lint) {
+    is_type(polygons, type_top = "FeatureCollection")
+    is_type(points, type_top = "FeatureCollection")
+  }
   calc_math("mean", convert(polygons), convert(points), in_field, out_field)
 }

R/bearing.R

@@ -36,8 +36,10 @@ lawn_bearing <- function(start, end, lint = FALSE) {
   start <- convert(start)
   end <- convert(end)
   lawnlint(list(start, end), lint)
-  is_type(start, type_top = "Feature", type_lower = "Point")
-  is_type(end, type_top = "Feature", type_lower = "Point")
+  if (lint) {
+    is_type(start, type_top = "Feature", type_lower = "Point")
+    is_type(end, type_top = "Feature", type_lower = "Point")
+  }
   ct$eval(sprintf("var bear = turf.bearing(%s, %s);", start, end))
   ct$get("bear")
 }

R/bezier.R

@@ -31,7 +31,7 @@ lawn_bezier <- function(line, resolution = 10000L, sharpness = 0.85,
 
   line <- convert(line)
   lawnlint(line, lint)
-  is_type(line, type_top = "Feature", type_lower = "LineString")
+  if (lint) is_type(line, type_top = "Feature", type_lower = "LineString")
   ct$eval(sprintf("var bz = turf.bezier(%s, %s, %s);", line, resolution,
                   sharpness))
   structure(ct$get("bz"), class = "linestring")

R/buffer.R

@@ -53,7 +53,7 @@ lawn_buffer <- function(input, dist, units = "kilometers", lint = FALSE) {
 
   input <- convert(input)
   lawnlint(input, lint)
-  is_type(input, type_top = c("Feature", "FeatureCollection"))
+  if (lint) is_type(input, type_top = c("Feature", "FeatureCollection"))
   units <- match.arg(units, c("meters", "feet", "kilometers",
                               "miles", "degrees"))
   ct$eval(sprintf("var units = '%s';", units))

R/center.R

@@ -23,7 +23,7 @@
 lawn_center <- function(features, properties = NULL, lint = FALSE) {
   features <- convert(features)
   lawnlint(features, lint)
-  is_type(features, type_top = c("Feature", "FeatureCollection"))
+  if (lint) is_type(features, type_top = c("Feature", "FeatureCollection"))
   ct$eval(sprintf("var cent = turf.center(%s, %s);", features, toj(properties)))
   structure(ct$get("cent"), class = "point")
 }

R/centerofmass.R

@@ -29,7 +29,7 @@
 #' lawn_center_of_mass(lawn_data$polygons_average)
 lawn_center_of_mass <- function(x, lint = FALSE) {
   lawnlint(x, lint)
-  is_type(x, type_top = c("Feature", "FeatureCollection"))
+  if (lint) is_type(x, type_top = c("Feature", "FeatureCollection"))
   ct$eval(sprintf('var out = turf.centerOfMass(%s);', convert(x)))
   as.f(ct$get("out"))
 }

R/centroid.R

@@ -28,11 +28,13 @@
 #'   }
 #' }'
 #' lawn_centroid(features = poly)
+#' lawn_centroid(features = as.feature(poly))
 #' lawn_centroid(features = poly, properties = list(foo = "bar"))
 lawn_centroid <- function(features, properties = NULL, lint = FALSE) {
   fts <- convert(features)
   lawnlint(fts, lint)
-  is_type(features, type_top = c("Feature", "FeatureCollection"))
+  assert(fts, c('character', 'feature', 'featurecollection', 'json'))
+  if (lint) is_type(fts, type_top = c("Feature", "FeatureCollection"))
   ct$eval(sprintf("var ctr = turf.centroid(%s, %s);", fts, toj(properties)))
   structure(ct$get("ctr"), class = "point")
 }

R/circle.R

@@ -36,7 +36,7 @@
 lawn_circle <- function(center, radius, steps = FALSE, units = "kilometers",
                         lint = FALSE) {
   lawnlint(center, lint)
-  is_type(center, type_top = "Feature")
+  if (lint) is_type(center, type_top = "Feature")
   ct$eval(sprintf("var xx = turf.circle(%s, %s, %s, '%s');",
                   convert(center), radius, tolower(steps), units))
   structure(ct$get("xx"), class = "polygon")

R/collect.R

@@ -29,8 +29,10 @@ lawn_collect <- function(polygons, points, in_field, out_field, lint = FALSE) {
   # \url{https://www.epa.gov/home/github-contribution-disclaimer}
 
   lawnlint(list(polygons, points), lint)
-  is_type(polygons, type_top = "FeatureCollection", type_lower = "Polygon")
-  is_type(points, type_top = "FeatureCollection", type_lower = "Point")
+  if (lint)  {
+    is_type(polygons, type_top = "FeatureCollection", type_lower = "Polygon")
+    is_type(points, type_top = "FeatureCollection", type_lower = "Point")
+  }
   ct$eval(sprintf("var fc = turf.collect(%s, %s, '%s', '%s');",
                   convert(polygons),
                   convert(points),

R/collectionof.R

@@ -10,13 +10,14 @@
 #' @return nothing if no problems - error message if a problem
 #' @examples
 #' # all okay
+#' cat(lawn_data$points_count)
 #' lawn_collectionof(lawn_data$points_count, 'Point', 'stuff')
 #'
 #' # error
 #' # lawn_collectionof(lawn_data$points_count, 'Polygon', 'stuff')
 lawn_collectionof <- function(x, type, name, lint = FALSE) {
   lawnlint(x, lint)
-  is_type(x, type_top = "FeatureCollection")
+  if (lint) is_type(x, type_top = "FeatureCollection")
   ct$eval(sprintf("var gt = turfinvariant.collectionOf(%s, '%s', '%s');",
                   convert(x), type, name))
   ct$get("gt")

R/combine.R

@@ -72,7 +72,7 @@
 lawn_combine <- function(fc, lint = FALSE) {
   fc <- convert(fc)
   lawnlint(fc, lint)
-  is_type(fc, type_top = "FeatureCollection")
+  if (lint) is_type(fc, type_top = "FeatureCollection")
   ct$eval(sprintf("var exp = turf.combine(%s);", fc))
   clz <- match.arg(tolower(fromJSON(fc)$features$geometry$type[1]),
                    c("point", "polygon", "linestring"))

R/concave.R

@@ -67,7 +67,7 @@
 lawn_concave <- function(points, maxEdge = 1, units = "miles", lint = FALSE) {
   points <- convert(points)
   lawnlint(points, lint)
-  is_type(points, type_top = "FeatureCollection", type_lower = "Point")
+  if (lint) is_type(points, type_top = "FeatureCollection", type_lower = "Point")
   ct$eval(sprintf("var cv = turf.concave(%s, %s, '%s');", points,
                   maxEdge, units))
   structure(ct$get("cv"), class = "linestring")

R/convex.R

@@ -66,7 +66,7 @@
 lawn_convex <- function(input, lint = FALSE) {
   input <- convert(input)
   lawnlint(input, lint)
-  is_type(input, c("Feature", "FeatureCollection"), "Point")
+  if (lint) is_type(input, c("Feature", "FeatureCollection"), "Point")
   ct$eval(sprintf("var cv = turf.convex(%s);", input))
   structure(ct$get("cv"), class = "polygon")
 }

R/count.R

@@ -19,8 +19,10 @@ lawn_count <- function(polygons, points, in_field, out_field = 'count',
                        lint = FALSE) {
 
   lawnlint(list(polygons, points), lint)
-  is_type(polygons, "FeatureCollection", "Polygon")
-  is_type(points, "FeatureCollection", "Point")
+  if (lint) {
+    is_type(polygons, "FeatureCollection", "Polygon")
+    is_type(points, "FeatureCollection", "Point")
+  }
   ct$eval(sprintf("var fc = turf.collect(%s, %s, '%s', 'values');",
                   convert(polygons), convert(points), in_field))
   ct$eval(sprintf("fc.features.forEach(function (feature) {

R/destination.R

@@ -39,7 +39,7 @@ lawn_destination <- function(start, distance, bearing, units, lint = FALSE) {
   units <- match.arg(units, c("miles", "kilometers", "degrees", "radians"))
   start <- convert(start)
   lawnlint(start, lint)
-  is_type(start, "Feature", "Point")
+  if (lint) is_type(start, "Feature", "Point")
   ct$eval(sprintf("var dest = turf.destination(%s, %s, %s, '%s');",
                   start, distance, bearing, units))
   structure(ct$get("dest"), class = "point")

R/deviation.R

@@ -31,8 +31,10 @@ lawn_deviation <- function(polygons, points, in_field, out_field = "deviation",
   # \url{https://www.epa.gov/home/github-contribution-disclaimer}
 
   lawnlint(list(polygons, points), lint)
-  is_type(polygons, type_top = "FeatureCollection")
-  is_type(points, type_top = "FeatureCollection")
+  if (lint) {
+    is_type(polygons, type_top = "FeatureCollection")
+    is_type(points, type_top = "FeatureCollection")
+  }
   calc_math("standardDeviation", convert(polygons), convert(points),
             in_field, out_field)
 }

R/dissolve.R

@@ -48,7 +48,7 @@
 #' lawn_dissolve(x, key = 'combine')
 lawn_dissolve <- function(features, key, lint = FALSE) {
   lawnlint(features, lint)
-  is_type(features, "FeatureCollection", "Polygon")
+  if (lint) is_type(features, "FeatureCollection", "Polygon")
   ct$eval(sprintf('var out = turf.dissolve(%s, "%s");', features, key))
   as.fc(ct$get("out"))
 }

R/distance.R

@@ -36,8 +36,10 @@ lawn_distance <- function(from, to, units = 'kilometers', lint = FALSE) {
   from <- convert(from)
   to <- convert(to)
   lawnlint(list(from, to), lint)
-  is_type(from, "Feature", "Point")
-  is_type(to, "Feature", "Point")
+  if (lint) {
+    is_type(from, "Feature", "Point")
+    is_type(to, "Feature", "Point")
+  }
   ct$eval(sprintf('var point1 = %s;', from))
   ct$eval(sprintf('var point2 = %s;', to))
   ct$eval(sprintf("var avg = turf.distance(point1, point2, '%s');", units))

R/envelope.R

@@ -51,7 +51,7 @@
 lawn_envelope <- function(fc, lint = FALSE) {
   fc <- convert(fc)
   lawnlint(fc, lint)
-  is_type(fc, c("Feature", "FeatureCollection"))
+  if (lint) is_type(fc, c("Feature", "FeatureCollection"))
   ct$eval(sprintf("var env = turf.envelope(%s);", fc))
   structure(ct$get("env"), class = "polygon")
 }

R/erase.R

@@ -58,8 +58,10 @@ lawn_difference <- function(poly1, poly2, lint = FALSE) {
   poly1 <- convert(poly1)
   poly2 <- convert(poly2)
   lawnlint(list(poly1, poly2), lint)
-  is_type(poly1, "Feature", "Polygon")
-  is_type(poly2, "Feature", "Polygon")
+  if (lint) {
+    is_type(poly1, "Feature", "Polygon")
+    is_type(poly2, "Feature", "Polygon")
+  }
   ct$eval(sprintf("var er = turf.difference(%s, %s);", poly1, poly2))
   structure(ct$get("er"), class = "polygon")
 }

R/explode.R

@@ -33,7 +33,7 @@
 lawn_explode <- function(input, lint = FALSE) {
   input <- convert(input)
   lawnlint(input, lint)
-  is_type(input, type_top = c("Feature", "FeatureCollection"))
+  if (lint) is_type(input, type_top = c("Feature", "FeatureCollection"))
   ct$eval(sprintf("var exp = turf.explode(%s);", input))
   as.fc(ct$get("exp"))
 }

R/extent.R

@@ -34,7 +34,7 @@
 lawn_extent <- function(input, lint = FALSE) {
   input <- convert(input)
   lawnlint(input, lint)
-  is_type(input, type_top = c("Feature", "FeatureCollection"))
+  if (lint) is_type(input, type_top = c("Feature", "FeatureCollection"))
   ct$eval(sprintf("var bbox = turf.bbox(%s);", input))
   ct$get("bbox")
 }

R/flip.R

@@ -28,7 +28,7 @@
 lawn_flip <- function(input, lint = FALSE) {
   input <- convert(input)
   lawnlint(input, lint)
-  is_type(input, type_top = c("Feature", "FeatureCollection"))
+  if (lint) is_type(input, type_top = c("Feature", "FeatureCollection"))
   ct$eval(sprintf("var flp = turf.flip(%s);", input))
   structure(ct$get("flp"), class = tolower(ct$get("flp.type")))
 }