reworked pkg for new turf version, started changing methods

for those that still need changes, made examples dontrun for now #49
ropensci-archive · Jul 21, 2016 · 64b1c1a · 64b1c1a
1 parent df7f092
commit 64b1c1a
Show file tree

Hide file tree

Showing 37 changed files with 1,856 additions and 33 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -6,11 +6,12 @@ Description: Client for 'Turfjs' (http://turfjs.org/) for
     measuring aspects of 'GeoJSON', and combining, transforming,
     and creating random 'GeoJSON' data objects.
 Type: Package
-Version: 0.1.7.9200
+Version: 0.1.8.9000
 License: MIT + file LICENSE
 Authors@R: c(
     person("Scott", "Chamberlain", role = c("aut", "cre"), email = "myrmecocystus@gmail.com"),
-    person("Jeff", "Hollister", role = "aut", email = "hollister.jeff@epa.gov")
+    person("Jeff", "Hollister", role = "aut", email = "hollister.jeff@epa.gov"),
+    person("Morgan", "Herlocker", role = "cph")
   )
 URL: https://github.com/ropensci/lawn
 BugReports: http://www.github.com/ropensci/lawn/issues

diff --git a/R/aggregate.R b/R/aggregate.R
@@ -37,7 +37,7 @@ lawn_aggregate <- function(polys, pts, agg = list(c("count", "", "num_of_pts")),
   pts <- convert(pts)
   lawnlint(list(polys, pts), lint)
   agg <- make_agg_array(agg)
-  ct$eval(sprintf("var aggreg = turf.aggregate(%s, %s, %s);", polys, pts, agg))
+  ct$eval(sprintf("var aggreg = turf.collect(%s, %s, %s);", polys, pts, agg))
   as.fc(ct$get("aggreg"))
 }
 

diff --git a/R/average.R b/R/average.R
@@ -14,12 +14,13 @@
 #' @template lint
 #' @family aggregations
 #' @return polygons with the value of outField set to the calculated averages
-#' @examples
+#' @examples \dontrun{
 #' # using data in the package
 #' cat(lawn_data$points_average)
 #' cat(lawn_data$polygons_average)
 #' lawn_average(polygons = lawn_data$polygons_average,
 #'              points = lawn_data$points_average, 'population')
+#' }
 lawn_average <- function(polygons, points, field, outputField = 'average', lint = FALSE) {
   lawnlint(list(polygons, points), lint)
   ct$eval(sprintf('var polygons = %s;', polygons))

diff --git a/R/count.R b/R/count.R
@@ -12,11 +12,12 @@
 #' @template lint
 #' @family aggregations
 #' @return a \code{\link{data-FeatureCollection}}
-#' @examples
+#' @examples \dontrun{
 #' # using data in the package
 #' cat(lawn_data$points_count)
 #' cat(lawn_data$polygons_count)
 #' lawn_count(polygons = lawn_data$polygons_count, points = lawn_data$points_count)
+#' }
 lawn_count <- function(polygons, points, countField = 'pt_count', lint = FALSE) {
   lawnlint(list(polygons, points), lint)
   ct$eval(sprintf('var polygons = %s;', polygons))

diff --git a/R/deviation.R b/R/deviation.R
@@ -16,10 +16,11 @@
 #' \code{\link{data-FeatureCollection}}
 #'
 #' @author Jeff Hollister \email{hollister.jeff@@epa.gov}
-#' @examples
+#' @examples \dontrun{
 #' ex_polys <- lawn_data$polygons_aggregate
 #' ex_pts <- lawn_data$points_aggregate
 #' lawn_deviation(ex_polys, ex_pts, "population", "pop_sd")
+#' }
 lawn_deviation <- function(polys, pts, inField, outField, lint = FALSE) {
   polys <- convert(polys)
   pts <- convert(pts)

diff --git a/R/erase.R b/R/erase.R
@@ -58,6 +58,6 @@ lawn_erase <- function(poly1, poly2, lint = FALSE) {
   poly1 <- convert(poly1)
   poly2 <- convert(poly2)
   lawnlint(list(poly1, poly2), lint)
-  ct$eval(sprintf("var er = turf.erase(%s, %s);", poly1, poly2))
+  ct$eval(sprintf("var er = turf.difference(%s, %s);", poly1, poly2))
   structure(ct$get("er"), class = "polygon")
 }
diff --git a/R/extent.R b/R/extent.R
@@ -33,6 +33,6 @@
 lawn_extent <- function(input, lint = FALSE) {
   input <- convert(input)
   lawnlint(input, lint)
-  ct$eval(sprintf("var bbox = turf.extent(%s);", input))
+  ct$eval(sprintf("var bbox = turf.bbox(%s);", input))
   ct$get("bbox")
 }
diff --git a/R/featurecollection.R b/R/featurecollection.R
@@ -193,6 +193,6 @@ lawn_featurecollection.featurecollection <- function(features) {
 do_fc <- function(features) {
   fts <- unlist(sapply(features, as.turf))
   ct$eval(sprintf("var features = %s;", sprintf("[ %s ]", paste0(fts, collapse = ", "))))
-  ct$eval("var feet = turf.featurecollection(features);")
+  ct$eval("var feet = turf.featureCollection(features);")
   as.fc(ct$get("feet"))
 }
diff --git a/R/filter.R b/R/filter.R
@@ -11,13 +11,24 @@
 #' features that match input key and value
 #' @examples
 #' cat(lawn_data$filter_features)
-#' lawn_filter(lawn_data$filter_features, 'species', 'oak')
+#' lawn_filter(features = lawn_data$filter_features, key = 'species', value = 'oak')
 #' lawn_filter(lawn_data$filter_features, 'species', 'maple')
 #' lawn_filter(lawn_data$filter_features, 'species', 'redwood')
 lawn_filter <- function(features, key, value, lint = FALSE) {
   lawnlint(features, lint)
   ct$eval(sprintf('var key = "%s";', key))
   ct$eval(sprintf('var value = "%s";', value))
-  ct$eval(sprintf("var filtered = turf.filter(%s, key, value);", features))
+  ct$eval('
+    fun = function(cc, k, v) {
+      var nfc = turf.featureCollection([]);
+      for (var i = 0; i < cc.features.length; i++) {
+          if(cc.features[i].properties[k] === v) {
+          nfc.features.push(cc.features[i]);
+        }
+      }
+      return nfc;
+    }
+  ')
+  ct$eval(sprintf("var filtered = fun(%s, key, value);", features))
   as.fc(ct$get("filtered"))
 }
diff --git a/R/jenks.R b/R/jenks.R
@@ -13,15 +13,21 @@
 #' @return An array of the break values (numeric)
 #' @references Jenks Natural breaks
 #' \url{http://en.wikipedia.org/wiki/Jenks_natural_breaks_optimization}
-#' @examples
-#' lawn_jenks(lawn_data$points_average, 'population', 0)
+#' @examples \dontrun{
+#' lawn_jenks(input = lawn_data$points_average, field = 'population', numberOfBreaks = 0)
 #' lawn_jenks(lawn_data$points_average, 'population', 1)
 #' lawn_jenks(lawn_data$points_average, 'population', 2)
 #' lawn_jenks(lawn_data$points_average, 'population', 3)
 #' lawn_jenks(lawn_data$points_average, 'population', 4)
+#' }
 lawn_jenks <- function(input, field, numberOfBreaks, lint = FALSE) {
   input <- convert(input)
   lawnlint(input, lint)
-  ct$eval(sprintf("var jks = turf.jenks(%s, '%s', %s);", input, field, toj(numberOfBreaks)))
+  # ct$eval('
+  #   jenksy = function(x, y, z) {
+  #
+  #   }
+  # ')
+  ct$eval(sprintf("var jks = jenksy(%s, '%s', %s);", input, field, toj(numberOfBreaks)))
   ct$get("jks")
 }
diff --git a/R/linestring.R b/R/linestring.R
@@ -34,6 +34,6 @@
 #' lawn_linestring(pts)
 lawn_linestring <- function(coordinates, properties = NULL) {
   # TODO: need to find way to fail well when unacceptable items passed in
-  ct$eval(sprintf("var poly = turf.linestring(%s, %s);", convert(coordinates), toj(properties)))
+  ct$eval(sprintf("var poly = turf.lineString(%s, %s);", convert(coordinates), toj(properties)))
   structure(ct$get("poly"), class = "linestring")
 }
diff --git a/R/max.R b/R/max.R
@@ -9,11 +9,10 @@
 #' @family aggregations
 #' @return A FeatureCollection of \code{\link{data-Polygon}} features with
 #' properties listed as \code{out_field}
-#' @examples
+#' @examples \dontrun{
 #' poly <- lawn_data$polygons_average
 #' pt <- lawn_data$points_average
 #' lawn_max(poly, pt, 'population', 'max')
-#' @examples \dontrun{
 #' lawn_max(poly, pt, 'population', 'max') %>% view
 #' }
 lawn_max <- function(polygons, points, in_field, out_field, lint = FALSE) {

diff --git a/R/median.R b/R/median.R
@@ -9,11 +9,10 @@
 #' @family aggregations
 #' @return A FeatureCollection of \code{\link{data-Polygon}} features with
 #' properties listed as \code{out_field}
-#' @examples
+#' @examples \dontrun{
 #' poly <- lawn_data$polygons_average
 #' pt <- lawn_data$points_average
 #' lawn_median(poly, pt, 'population', 'median')
-#' @examples \dontrun{
 #' lawn_median(poly, pt, 'population', 'median') %>% view
 #' }
 lawn_median <- function(polygons, points, in_field, out_field, lint = FALSE) {

diff --git a/R/merge.R b/R/merge.R
@@ -54,6 +54,16 @@
 lawn_merge <- function(fc, lint = FALSE) {
   fc <- convert(fc)
   lawnlint(fc, lint)
-  ct$eval(sprintf("var mrg = turf.merge(%s);", fc))
+  ct$eval('
+    mg = function merge(polys) {
+      var merged = clone(polys.features[0]), features = polys.features;
+      for (var i = 0, len = features.length; i < len; i++) {
+        var poly = features[i];
+        if (poly.geometry) merged = turf.union(merged, poly);
+      }
+      return merged;
+    }
+  ')
+  ct$eval(sprintf("var mrg = mg(%s);", fc))
   structure(ct$get("mrg"), class = "polygon")
 }
diff --git a/R/min.R b/R/min.R
@@ -9,11 +9,10 @@
 #' @family aggregations
 #' @return A FeatureCollection of \code{\link{data-Polygon}} features with
 #' properties listed as \code{out_field}
-#' @examples
+#' @examples \dontrun{
 #' poly <- lawn_data$polygons_average
 #' pt <- lawn_data$points_average
 #' lawn_min(poly, pt, 'population', 'min')
-#' @examples \dontrun{
 #' lawn_min(poly, pt, 'population', 'min') %>% view
 #' }
 lawn_min <- function(polygons, points, in_field, out_field, lint = FALSE) {

diff --git a/R/onLoad.R b/R/onLoad.R
@@ -2,9 +2,11 @@
 ct <- NULL
 rand <- NULL
 ht <- NULL
+
 .onLoad <- function(libname, pkgname){
   ct <<- new_context();
-  ct$source(system.file("js/turf.js", package = pkgname))
+  ct$source(system.file("js/turf2.js", package = pkgname))
+  ct$source(system.file("js/cloner.js", package = pkgname))
 
   rand <<- new_context();
   rand$source(system.file("js/geojson_random.js", package = pkgname))

diff --git a/R/quantile.R b/R/quantile.R
@@ -11,7 +11,7 @@
 #' @template lint
 #' @family classification
 #' @return An array of the break values
-#' @examples
+#' @examples \dontrun{
 #' pts <- '{
 #'  "type": "FeatureCollection",
 #'  "features": [
@@ -67,6 +67,7 @@
 #' lawn_quantile(pts, 'population', c(25, 50, 75, 95))
 #' lawn_quantile(pts, 'population', c(25, 50, 75))
 #' lawn_quantile(pts, 'population', c(1, 50, 99.9))
+#' }
 lawn_quantile <- function(input, field, percentiles, lint = FALSE) {
   input <- convert(input)
   lawnlint(input, lint)

diff --git a/R/reclass.R b/R/reclass.R
@@ -17,13 +17,14 @@
 #' @family classification
 #' @return a \code{\link{data-FeatureCollection}} with identical geometries to
 #' input but with outField populated.
-#' @examples
+#' @examples \dontrun{
 #' t1 <- list(list(0, 200, "small"), list(200, 400, "medium"), list(400, 600, "large"))
 #' lawn_reclass(lawn_data$points_average, 'population', 'size', t1)
 #' lawn_reclass(lawn_data$points_average, 'population', 'number', t1)
 #'
 #' t2 <- list(list(0, 150, "small"), list(150, 700, "big"))
 #' lawn_reclass(lawn_data$points_average, 'population', 'size', t2)
+#' }
 lawn_reclass <- function(input, inField, outField, translations, lint = FALSE) {
   input <- convert(input)
   translations <- convert(translations)

diff --git a/R/remove.R b/R/remove.R
@@ -19,6 +19,17 @@
 lawn_remove <- function(features, property, value, lint = FALSE) {
   features <- convert(features)
   lawnlint(features, lint)
-  ct$eval(sprintf("var rmv = turf.remove(%s, '%s', '%s');", features, property, value))
+  ct$eval('
+    fun = function(cc, k, v) {
+      var nfc = turf.featureCollection([]);
+      for (var i = 0; i < cc.features.length; i++) {
+          if(cc.features[i].properties[k] === v) {
+          nfc.features.push(cc.features[i]);
+        }
+      }
+      return nfc;
+    }
+  ')
+  ct$eval(sprintf("var rmv = fun(%s, '%s', '%s');", features, property, value))
   as.fc(ct$get("rmv"))
 }
diff --git a/R/size.R b/R/size.R
@@ -8,12 +8,13 @@
 #' @param factor the ratio of the new bbox to the input bbox
 #' @family measurements
 #' @return the resized bbox, numeric vector of length four
-#' @examples
+#' @examples \dontrun{
 #' bbox <- c(0, 0, 10, 10)
 #' lawn_size(bbox, factor = 1)
 #' lawn_size(bbox, factor = 10)
 #' lawn_size(bbox, factor = 50)
 #' lawn_size(bbox, factor = 100)
+#' }
 lawn_size <- function(bbox, factor) {
   ct$eval(sprintf("var resize = turf.size(%s, %s);", toj(bbox), factor))
   ct$get("resize")

diff --git a/R/sum.R b/R/sum.R
@@ -9,11 +9,10 @@
 #' @family aggregations
 #' @return A FeatureCollection of \code{\link{data-Polygon}} features with
 #' properties listed as \code{out_field}
-#' @examples
+#' @examples \dontrun{
 #' poly <- lawn_data$polygons_average
 #' pt <- lawn_data$points_average
 #' lawn_sum(poly, pt, 'population', 'sum')
-#' @examples \dontrun{
 #' lawn_sum(poly, pt, 'population', 'sum') %>% view
 #' }
 lawn_sum <- function(polygons, points, in_field, out_field, lint = FALSE) {

diff --git a/R/variance.R b/R/variance.R
@@ -11,11 +11,10 @@
 #' @template lint
 #' @return A FeatureCollection of \code{\link{data-Polygon}} features with
 #' properties listed as \code{out_field}
-#' @examples
+#' @examples \dontrun{
 #' poly <- lawn_data$polygons_average
 #' pt <- lawn_data$points_average
 #' lawn_variance(poly, pt, 'population', 'variance')
-#' @examples \dontrun{
 #' lawn_variance(poly, pt, 'population', 'variance') %>% view
 #' }
 lawn_variance <- function(polygons, points, in_field, out_field, lint = FALSE) {