Copy over code from ggrepel

resolves #179
resolves #182

Author: zachary-foster

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: metacoder
 Title: Tools for Parsing, Manipulating, and Graphing Hierarchical Data
-Version: 0.1.3.9033
+Version: 0.1.3.9034
 Authors@R: c( person("Zachary", "Foster", email =
         "[email protected]", role = c("aut", "cre")),
         person("Niklaus", "Grunwald", email =
@@ -44,7 +44,8 @@ Imports:
     vegan,
     ggrepel,
     cowplot,
-    GA
+    GA,
+    Rcpp
 Suggests:
     knitr,
     rmarkdown,
@@ -54,3 +55,4 @@ RoxygenNote: 6.0.1
 Date: 2017-05-22
 Encoding: UTF-8
 biocViews: 
+LinkingTo: Rcpp

NAMESPACE

@@ -40,6 +40,7 @@ export(write_rdp)
 export(write_silva_fasta)
 export(write_unite_general)
 export(zero_low_counts)
+importFrom(Rcpp,sourceCpp)
 importFrom(dplyr,contains)
 importFrom(dplyr,ends_with)
 importFrom(dplyr,everything)
@@ -48,3 +49,4 @@ importFrom(dplyr,num_range)
 importFrom(dplyr,one_of)
 importFrom(dplyr,starts_with)
 importFrom(magrittr,"%>%")
+useDynLib(metacoder)

NEWS.md

@@ -14,7 +14,7 @@
 
 ### Improvements
 
-* `ggrepel` package now used to repel labels to avoid overlapping labels.
+* code from [ggrepel](https://github.com/slowkow/ggrepel) package now used to avoid overlapping labels. Thanks Kamil Slowikowski!
 * New function `heat_tree_matrix` to make plotting a pairwise matrix of heat trees for comparing treatments.
 * New parser named `parse_mothur_tax_summary` for mothur *.tax.summary file made by [classify.seqs](https://www.mothur.org/wiki/Classify.seqs).
 * New parser named `parse_mothur_taxonomy` for mothur *.taxonomy file made by [classify.seqs](https://www.mothur.org/wiki/Classify.seqs).

R/RcppExports.R

@@ -0,0 +1,104 @@
+# Generated by using Rcpp::compileAttributes() -> do not edit by hand
+# Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393
+
+#' Euclidean distance between two points.
+#' @param a A point.
+#' @param b A point.
+#' @return The distance between two points.
+#' @noRd
+NULL
+
+#' Squared Euclidean distance between two points.
+#' @param a A point.
+#' @param b A point.
+#' @return The distance between two points.
+#' @noRd
+NULL
+
+#' Move a box into the area specificied by x limits and y limits.
+#' @param b A box like \code{c(x1, y1, x2, y2)}
+#' @param xlim A Point with limits on the x axis like \code{c(xmin, xmax)}
+#' @param ylim A Point with limits on the y axis like \code{c(xmin, xmax)}
+#' @param force Magnitude of the force (defaults to \code{1e-6})
+#' @noRd
+NULL
+
+#' Get the coordinates of the center of a box.
+#' @param b A box like \code{c(x1, y1, x2, y2)}
+#' @noRd
+NULL
+
+#' Test if a box overlaps another box.
+#' @param a A box like \code{c(x1, y1, x2, y2)}
+#' @param b A box like \code{c(x1, y1, x2, y2)}
+#' @noRd
+NULL
+
+#' Compute the repulsion force upon point \code{a} from point \code{b}.
+#'
+#' The force decays with the squared distance between the points, similar
+#' to the force of repulsion between magnets.
+#'
+#' @param a A point like \code{c(x, y)}
+#' @param b A point like \code{c(x, y)}
+#' @param force Magnitude of the force (defaults to \code{1e-6})
+#' @param direction direction in which to exert force, either "both", "x", or "y"
+#' @noRd
+NULL
+
+#' Compute the spring force upon point \code{a} from point \code{b}.
+#'
+#' The force increases with the distance between the points, similar
+#' to Hooke's law for springs.
+#'
+#' @param a A point like \code{c(x, y)}
+#' @param b A point like \code{c(x, y)}
+#' @param force Magnitude of the force (defaults to \code{1e-6})
+#' @param direction direction in which to exert force, either "both", "x", or "y"
+#' @noRd
+NULL
+
+#' Euclidean distance between two points.
+#' @param a A numeric vector.
+#' @param b A numeric vector.
+#' @return The distance between two points.
+#' @noRd
+euclid <- function(a, b) {
+    .Call('_metacoder_euclid', PACKAGE = 'metacoder', a, b)
+}
+
+#' Get the coordinates of the center of a box.
+#' @param b A box like \code{c(x1, y1, x2, y2)}
+#' @noRd
+centroid <- function(b) {
+    .Call('_metacoder_centroid', PACKAGE = 'metacoder', b)
+}
+
+#' Find the intersections between a line and a rectangle.
+#' @param p1 A point like \code{c(x, y)}
+#' @param p2 A point like \code{c(x, y)}
+#' @param b A rectangle like \code{c(x1, y1, x2, y2)}
+#' @noRd
+intersect_line_rectangle <- function(p1, p2, b) {
+    .Call('_metacoder_intersect_line_rectangle', PACKAGE = 'metacoder', p1, p2, b)
+}
+
+#' Adjust the layout of a list of potentially overlapping boxes.
+#' @param data_points A numeric matrix with rows representing points like
+#'   \code{rbind(c(x, y), c(x, y), ...)}
+#' @param point_padding_x Padding around each data point on the x axis.
+#' @param point_padding_y Padding around each data point on the y axis.
+#' @param boxes A numeric matrix with rows representing boxes like
+#'   \code{rbind(c(x1, y1, x2, y2), c(x1, y1, x2, y2), ...)}
+#' @param xlim A numeric vector representing the limits on the x axis like
+#'   \code{c(xmin, xmax)}
+#' @param ylim A numeric vector representing the limits on the y axis like
+#'   \code{c(ymin, ymax)}
+#' @param force Magnitude of the force (defaults to \code{1e-6})
+#' @param maxiter Maximum number of iterations to try to resolve overlaps
+#'   (defaults to 2000)
+#' @noRd
+repel_boxes <- function(data_points, point_padding_x, point_padding_y, boxes, xlim, ylim, force = 1e-6, maxiter = 2000L, direction = "both") {
+    .Call('_metacoder_repel_boxes', PACKAGE = 'metacoder', data_points, point_padding_x, point_padding_y, boxes, xlim, ylim, force, maxiter, direction)
+}
+

R/heat_tree.R

@@ -304,6 +304,15 @@ heat_tree.Taxmap <- function(.input, ...) {
 #' or setting logical boundaries (such as \code{c(0,1)} for proportions.
 #' Note that this is different from the "range" options, which determine the range of graphed sizes/colors.
 #' 
+#' @section Acknowledgements
+#' 
+#' This package includes code from the R package ggrepel to handle label overlap
+#' avoidance with permission from the author of ggrepel Kamil Slowikowski. We
+#' included the code instead of depending on ggrepel becacuse we are using
+#' internal functions to ggrepel that might change in the future. We thank Kamil
+#' Slowikowski for letting us use his code and would like to acknowledge his
+#' implementation of the label overlap avoidance used in metacoder.
+#' 
 #' @examples
 #' \dontrun{
 #' # Parse dataset for plotting
@@ -700,7 +709,7 @@ heat_tree.default <- function(taxon_id, supertaxon_id,
         overlap <- (overlap ^ 2) / (scaled_vs[distance$index_1] ^ 2 + scaled_vs[distance$index_2] ^ 2)
         mean(overlap)
       }
-
+      
       # Choose base range based on optimality criteria  - - - - - - - - - - - - - - - - - - - - - - - -
       optimality_stat <- function(minimum, maximum) {
         overlap <- find_overlap(minimum, maximum, all_pairwise)
@@ -966,14 +975,16 @@ heat_tree.default <- function(taxon_id, supertaxon_id,
 
     if (repel_labels) {
       movable <- text_data$group != "legend"
-      text_data[movable, c("x", "y")] <- ggrepel:::repel_boxes(data_points = as.matrix(text_data[movable, c("x", "y")]),
-                                                               boxes = as.matrix(bounds[movable, c("xmin", "ymin", "xmax", "ymax")]),
-                                                               point_padding_x = 0, point_padding_y = 0,
-                                                               xlim = ranges$x,
-                                                               ylim = ranges$y,
-                                                               force = 1e-06 * repel_force,
-                                                               maxiter = repel_iter,
-                                                               direction = "both")
+      text_data[movable, c("x", "y")] <- repel_boxes(data_points = as.matrix(text_data[movable, c("x", "y")]),
+                                                     boxes = as.matrix(bounds[movable, c("xmin", "ymin", "xmax", "ymax")]),
+                                                     point_padding_x = 0, point_padding_y = 0,
+                                                     xlim = ranges$x,
+                                                     ylim = ranges$y,
+                                                     # hjust = 0.5,
+                                                     # vjust = 0.5,
+                                                     force = 1e-06 * repel_force,
+                                                     maxiter = repel_iter,
+                                                     direction = "both")
       bounds <- label_bounds(label = text_data$label, x = text_data$x, y = text_data$y,
                              height = text_data$size, rotation = text_data$rotation,
                              just = text_data$justification)

R/metacoder-package.r renamed to R/metacoder-package.R

@@ -40,4 +40,6 @@
 #' @author Zachary Foster 
 #' @name metacoder
 #' @docType package
+#' @useDynLib metacoder
+#' @importFrom Rcpp sourceCpp
 NULL

README.md

@@ -48,3 +48,10 @@ Foster ZSL, Sharpton TJ, Grünwald NJ (2017) Metacoder: An R package for visuali
 ### License
 
 This work is subject to the [MIT License](https://github.com/grunwaldlab/metacoder/blob/master/LICENSE).
+
+### Acknowledgements
+
+This package includes code from the R package [ggrepel](https://github.com/slowkow/ggrepel) to handle label overlap avoidance with permission from the author of [ggrepel](https://github.com/slowkow/ggrepel) [Kamil Slowikowski](https://github.com/slowkow).
+We included the code instead of depending on `ggrepel` becacuse we are using internal functions to `ggrepel` that might change in the future.
+We thank Kamil Slowikowski for letting us use his code and would like to acknowledge his implementation of the label overlap avoidance used in metacoder.
+

man/metacoder.Rd

@@ -0,0 +1,75 @@
+// Generated by using Rcpp::compileAttributes() -> do not edit by hand
+// Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393
+
+#include <Rcpp.h>
+
+using namespace Rcpp;
+
+// euclid
+double euclid(NumericVector a, NumericVector b);
+RcppExport SEXP _metacoder_euclid(SEXP aSEXP, SEXP bSEXP) {
+BEGIN_RCPP
+    Rcpp::RObject rcpp_result_gen;
+    Rcpp::RNGScope rcpp_rngScope_gen;
+    Rcpp::traits::input_parameter< NumericVector >::type a(aSEXP);
+    Rcpp::traits::input_parameter< NumericVector >::type b(bSEXP);
+    rcpp_result_gen = Rcpp::wrap(euclid(a, b));
+    return rcpp_result_gen;
+END_RCPP
+}
+// centroid
+NumericVector centroid(NumericVector b);
+RcppExport SEXP _metacoder_centroid(SEXP bSEXP) {
+BEGIN_RCPP
+    Rcpp::RObject rcpp_result_gen;
+    Rcpp::RNGScope rcpp_rngScope_gen;
+    Rcpp::traits::input_parameter< NumericVector >::type b(bSEXP);
+    rcpp_result_gen = Rcpp::wrap(centroid(b));
+    return rcpp_result_gen;
+END_RCPP
+}
+// intersect_line_rectangle
+NumericVector intersect_line_rectangle(NumericVector p1, NumericVector p2, NumericVector b);
+RcppExport SEXP _metacoder_intersect_line_rectangle(SEXP p1SEXP, SEXP p2SEXP, SEXP bSEXP) {
+BEGIN_RCPP
+    Rcpp::RObject rcpp_result_gen;
+    Rcpp::RNGScope rcpp_rngScope_gen;
+    Rcpp::traits::input_parameter< NumericVector >::type p1(p1SEXP);
+    Rcpp::traits::input_parameter< NumericVector >::type p2(p2SEXP);
+    Rcpp::traits::input_parameter< NumericVector >::type b(bSEXP);
+    rcpp_result_gen = Rcpp::wrap(intersect_line_rectangle(p1, p2, b));
+    return rcpp_result_gen;
+END_RCPP
+}
+// repel_boxes
+DataFrame repel_boxes(NumericMatrix data_points, double point_padding_x, double point_padding_y, NumericMatrix boxes, NumericVector xlim, NumericVector ylim, double force, int maxiter, std::string direction);
+RcppExport SEXP _metacoder_repel_boxes(SEXP data_pointsSEXP, SEXP point_padding_xSEXP, SEXP point_padding_ySEXP, SEXP boxesSEXP, SEXP xlimSEXP, SEXP ylimSEXP, SEXP forceSEXP, SEXP maxiterSEXP, SEXP directionSEXP) {
+BEGIN_RCPP
+    Rcpp::RObject rcpp_result_gen;
+    Rcpp::RNGScope rcpp_rngScope_gen;
+    Rcpp::traits::input_parameter< NumericMatrix >::type data_points(data_pointsSEXP);
+    Rcpp::traits::input_parameter< double >::type point_padding_x(point_padding_xSEXP);
+    Rcpp::traits::input_parameter< double >::type point_padding_y(point_padding_ySEXP);
+    Rcpp::traits::input_parameter< NumericMatrix >::type boxes(boxesSEXP);
+    Rcpp::traits::input_parameter< NumericVector >::type xlim(xlimSEXP);
+    Rcpp::traits::input_parameter< NumericVector >::type ylim(ylimSEXP);
+    Rcpp::traits::input_parameter< double >::type force(forceSEXP);
+    Rcpp::traits::input_parameter< int >::type maxiter(maxiterSEXP);
+    Rcpp::traits::input_parameter< std::string >::type direction(directionSEXP);
+    rcpp_result_gen = Rcpp::wrap(repel_boxes(data_points, point_padding_x, point_padding_y, boxes, xlim, ylim, force, maxiter, direction));
+    return rcpp_result_gen;
+END_RCPP
+}
+
+static const R_CallMethodDef CallEntries[] = {
+    {"_metacoder_euclid", (DL_FUNC) &_metacoder_euclid, 2},
+    {"_metacoder_centroid", (DL_FUNC) &_metacoder_centroid, 1},
+    {"_metacoder_intersect_line_rectangle", (DL_FUNC) &_metacoder_intersect_line_rectangle, 3},
+    {"_metacoder_repel_boxes", (DL_FUNC) &_metacoder_repel_boxes, 9},
+    {NULL, NULL, 0}
+};
+
+RcppExport void R_init_metacoder(DllInfo *dll) {
+    R_registerRoutines(dll, NULL, CallEntries, NULL, NULL);
+    R_useDynamicSymbols(dll, FALSE);
+}