Fix #308 Provide concaveman as C++ code

Author: thomasp85

DESCRIPTION

@@ -45,7 +45,6 @@ LinkingTo: Rcpp, RcppEigen
 RoxygenNote: 7.2.3
 Suggests:
     sessioninfo,
-    concaveman,
     deldir,
     latex2exp,
     reshape2,
@@ -64,6 +63,7 @@ Collate:
     'bspline.R'
     'bspline_closed.R'
     'circle.R'
+    'concaveman.R'
     'diagonal.R'
     'diagonal_wide.R'
     'ellipse.R'

LICENSE.note

@@ -0,0 +1,30 @@
+--------------------------------------------------------------------------------
+The concaveman.h file is redistributed with the following license
+
+BSD 2-Clause License
+
+Copyright (c) 2019, sadaszewski
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+1. Redistributions of source code must retain the above copyright notice, this
+   list of conditions and the following disclaimer.
+
+2. Redistributions in binary form must reproduce the above copyright notice,
+   this list of conditions and the following disclaimer in the documentation
+   and/or other materials provided with the distribution.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
+OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+--------------------------------------------------------------------------------

NEWS.md

@@ -1,6 +1,7 @@
 # ggforce (development version)
 
 * Fixed a bug that would cause reordering of data in some geoms (#314)
+* The concaveman package is no longer a dependency for `geom_mark_hull()` (#308)
 
 # ggforce 0.4.1
 

R/RcppExports.R

@@ -17,6 +17,10 @@ getBeziers <- function(x, y, id, detail) {
     .Call('_ggforce_getBeziers', PACKAGE = 'ggforce', x, y, id, detail)
 }
 
+concaveman_c <- function(p, h, concavity, threshold) {
+    .Call('_ggforce_concaveman_c', PACKAGE = 'ggforce', p, h, concavity, threshold)
+}
+
 enclose_ellip_points <- function(x, y, id, tol) {
     .Call('_ggforce_enclose_ellip_points', PACKAGE = 'ggforce', x, y, id, tol)
 }

R/concaveman.R

@@ -0,0 +1,5 @@
+concaveman <- function(points, concavity, threshold) {
+  if (nrow(points) < 4) return(points)
+  hull <- as.integer(grDevices::chull(points)) - 1L
+  concaveman_c(points, hull, concavity, threshold)
+}

R/mark_hull.R

@@ -38,8 +38,7 @@
 #' @name geom_mark_hull
 #' @rdname geom_mark_hull
 #'
-#' @examplesIf requireNamespace("concaveman", quietly = TRUE)
-#' ## requires the concaveman packages
+#' @examples
 #' ggplot(iris, aes(Petal.Length, Petal.Width)) +
 #'   geom_mark_hull(aes(fill = Species, filter = Species != 'versicolor')) +
 #'   geom_point()
@@ -108,8 +107,6 @@ GeomMarkHull <- ggproto('GeomMarkHull', GeomMarkCircle,
                         con.cap = unit(3, 'mm'), con.arrow = NULL) {
     if (nrow(data) == 0) return(zeroGrob())
 
-    check_installed('concaveman', 'to calculate concave hulls')
-
     # As long as coord$transform() doesn't recognise x0/y0
     data$xmin <- data$x0
     data$ymin <- data$y0
@@ -193,7 +190,6 @@ geom_mark_hull <- function(mapping = NULL, data = NULL, stat = 'identity',
                            con.border = 'one', con.cap = unit(3, 'mm'),
                            con.arrow = NULL, ..., na.rm = FALSE,
                            show.legend = NA, inherit.aes = TRUE) {
-  check_installed('concaveman', 'to calculate concave hulls')
   layer(
     data = data,
     mapping = mapping,
@@ -304,13 +300,13 @@ makeContent.hull_enc <- function(x) {
     if (length(unique0((yy[-1] - yy[1]) / (xx[-1] - xx[1]))) == 1) {
       return(mat[c(which.min(mat[, 1]), which.max(mat[, 1])), ])
     }
-    concaveman::concaveman(mat, x$concavity, 0)
+    concaveman(mat, x$concavity, 0)
   }, xx = x_new, yy = y_new)
   # ensure that all polygons have the same set of column names
   polygons <- lapply(polygons, function(x) {
     colnames(x) <- c("x", "y")
-    return(x)}
-  )
+    return(x)
+  })
   mark$id <- rep(seq_along(polygons), vapply(polygons, nrow, numeric(1)))
   polygons <- vec_rbind(!!!polygons)
   mark$x <- unit(polygons[, 1], 'mm')

man/geom_mark_hull.Rd

@@ -69,6 +69,20 @@ BEGIN_RCPP
     return rcpp_result_gen;
 END_RCPP
 }
+// concaveman_c
+NumericMatrix concaveman_c(NumericMatrix p, IntegerVector h, double concavity, double threshold);
+RcppExport SEXP _ggforce_concaveman_c(SEXP pSEXP, SEXP hSEXP, SEXP concavitySEXP, SEXP thresholdSEXP) {
+BEGIN_RCPP
+    Rcpp::RObject rcpp_result_gen;
+    Rcpp::RNGScope rcpp_rngScope_gen;
+    Rcpp::traits::input_parameter< NumericMatrix >::type p(pSEXP);
+    Rcpp::traits::input_parameter< IntegerVector >::type h(hSEXP);
+    Rcpp::traits::input_parameter< double >::type concavity(concavitySEXP);
+    Rcpp::traits::input_parameter< double >::type threshold(thresholdSEXP);
+    rcpp_result_gen = Rcpp::wrap(concaveman_c(p, h, concavity, threshold));
+    return rcpp_result_gen;
+END_RCPP
+}
 // enclose_ellip_points
 DataFrame enclose_ellip_points(NumericVector x, NumericVector y, IntegerVector id, double tol);
 RcppExport SEXP _ggforce_enclose_ellip_points(SEXP xSEXP, SEXP ySEXP, SEXP idSEXP, SEXP tolSEXP) {
@@ -115,6 +129,7 @@ static const R_CallMethodDef CallEntries[] = {
     {"_ggforce_getSplines", (DL_FUNC) &_ggforce_getSplines, 5},
     {"_ggforce_bezierPath", (DL_FUNC) &_ggforce_bezierPath, 3},
     {"_ggforce_getBeziers", (DL_FUNC) &_ggforce_getBeziers, 4},
+    {"_ggforce_concaveman_c", (DL_FUNC) &_ggforce_concaveman_c, 4},
     {"_ggforce_enclose_ellip_points", (DL_FUNC) &_ggforce_enclose_ellip_points, 4},
     {"_ggforce_enclose_points", (DL_FUNC) &_ggforce_enclose_points, 3},
     {"_ggforce_points_to_path", (DL_FUNC) &_ggforce_points_to_path, 3},

src/RcppExports.cpp

@@ -0,0 +1,28 @@
+#include <Rcpp.h>
+#include "concaveman.h"
+
+using namespace Rcpp;
+
+// [[Rcpp::export]]
+NumericMatrix concaveman_c(NumericMatrix p, IntegerVector h, double concavity, double threshold) {
+  typedef std::array<double, 2> point_type;
+  std::vector<point_type> points(p.size());
+  for (auto i = 0; i < p.size(); ++i) {
+    points[i] = {p(i, 0), p(i, 1)};
+  }
+  std::vector<int> hull(h.size());
+  for (auto i = 0; i < h.size(); ++i) {
+    hull[i] = h[i];
+  }
+
+  auto chull = concaveman<double, 16>(points, hull, concavity, threshold);
+
+  NumericMatrix res(chull.size(), 2);
+
+  for (auto i = 0; i < chull.size(); ++i) {
+    res(i, 0) = chull[i][0];
+    res(i, 1) = chull[i][1];
+  }
+
+  return res;
+}