first attempt at point.size

Issue #83 mentioned that it would be nice if ggrepel would respect
different point sizes when positioning text labels next to the data
points.

This commit is a first attempt to get this feature working.
Some of the code added might be redundant, but it works well enough for
now.

.gitignore

@@ -23,3 +23,5 @@ vignettes/figures/ggrepel/make_gallery_html.sh
 # MacOS
 .DS_Store
 inst/
+scripts
+movies

DESCRIPTION

@@ -39,5 +39,6 @@ VignetteBuilder: knitr
 License: GPL-3 | file LICENSE
 URL: http://github.com/slowkow/ggrepel
 BugReports: http://github.com/slowkow/ggrepel/issues
-RoxygenNote: 6.1.0
+RoxygenNote: 6.1.1
 LinkingTo: Rcpp
+Encoding: UTF-8

R/RcppExports.R

@@ -34,6 +34,12 @@ NULL
 #' @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
@@ -74,6 +80,14 @@ centroid <- function(b, hjust, vjust) {
     .Call('_ggrepel_centroid', PACKAGE = 'ggrepel', b, hjust, vjust)
 }
 
+#' Find the intersections between a line and a rectangle.
+#' @param c A circle like \code{c(x, y, r)}
+#' @param r A rectangle like \code{c(x1, y1, x2, y2)}
+#' @noRd
+intersect_circle_rectangle <- function(c, r) {
+    .Call('_ggrepel_intersect_circle_rectangle', PACKAGE = 'ggrepel', c, r)
+}
+
 #' 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)}
@@ -110,3 +124,23 @@ repel_boxes <- function(data_points, point_padding_x, point_padding_y, boxes, xl
     .Call('_ggrepel_repel_boxes', PACKAGE = 'ggrepel', data_points, point_padding_x, point_padding_y, boxes, xlim, ylim, hjust, vjust, force_push, force_pull, maxiter, direction)
 }
 
+#' 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_size A numeric vector representing the sizes of data points.
+#' @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_boxes2 <- function(data_points, point_size, point_padding_x, point_padding_y, boxes, xlim, ylim, hjust, vjust, force_push = 1e-7, force_pull = 1e-7, maxiter = 2000L, direction = "both") {
+    .Call('_ggrepel_repel_boxes2', PACKAGE = 'ggrepel', data_points, point_size, point_padding_x, point_padding_y, boxes, xlim, ylim, hjust, vjust, force_push, force_pull, maxiter, direction)
+}
+

R/geom-text-repel.R

@@ -164,6 +164,7 @@ geom_text_repel <- function(
   parse = FALSE,
   ...,
   box.padding = 0.25,
+  point.size = 0,
   point.padding = 1e-6,
   segment.colour = NULL,
   segment.color = NULL,
@@ -202,6 +203,7 @@ geom_text_repel <- function(
       parse = parse,
       na.rm = na.rm,
       box.padding = to_unit(box.padding),
+      point.size = to_unit(point.size),
       point.padding = to_unit(point.padding),
       segment.colour = segment.color %||% segment.colour,
       segment.size = segment.size,
@@ -241,6 +243,7 @@ GeomTextRepel <- ggproto("GeomTextRepel", Geom,
     parse = FALSE,
     na.rm = FALSE,
     box.padding = 0.25,
+    point.size = 0,
     point.padding = 1e-6,
     segment.colour = NULL,
     segment.size = 0.5,
@@ -301,6 +304,7 @@ GeomTextRepel <- ggproto("GeomTextRepel", Geom,
       lab = lab,
       nudges = nudges,
       box.padding = to_unit(box.padding),
+      point.size = to_unit(point.size),
       point.padding = to_unit(point.padding),
       segment.colour = segment.colour,
       segment.size = segment.size,
@@ -336,6 +340,12 @@ makeContent.textrepeltree <- function(x) {
   point_padding_x <- convertWidth(x$point.padding, "native", valueOnly = TRUE)
   point_padding_y <- convertHeight(x$point.padding, "native", valueOnly = TRUE)
 
+  # The padding around each point.
+  if (length(x$point.size) == 1 && is.na(x$point.size)) {
+    x$point.size = unit(0, "lines")
+  }
+  point_size <- convertWidth(x$point.size, "native", valueOnly = TRUE)
+
   # Do not create text labels for empty strings.
   valid_strings <- which(not_empty(x$lab))
   invalid_strings <- which(!not_empty(x$lab))
@@ -377,9 +387,17 @@ makeContent.textrepeltree <- function(x) {
                               c(x$data$y[valid_strings],
                                 x$data$y[invalid_strings]))
 
+  point_size <- x$point.size
+  if (length(point_size) != nrow(x$data)) {
+    point_size <- rep_len(point_size, length.out = nrow(x$data))
+  }
+  point_size <- c(point_size[valid_strings], point_size[invalid_strings])
+  point_size <- convertWidth(to_unit(point_size), "native", valueOnly = TRUE)
+
   # Repel overlapping bounding boxes away from each other.
-  repel <- repel_boxes(
+  repel <- repel_boxes2(
     data_points = points_valid_first,
+    point_size = point_size,
     point_padding_x = point_padding_x,
     point_padding_y = point_padding_y,
     boxes = do.call(rbind, boxes),
@@ -408,6 +426,7 @@ makeContent.textrepeltree <- function(x) {
       y.orig = unit(x$data$y[xi], "native"),
       rot = row$angle,
       box.padding = x$box.padding,
+      point.size = point_size[i],
       point.padding = x$point.padding,
       text.gp = gpar(
         col = scales::alpha(row$colour, row$alpha),
@@ -449,6 +468,7 @@ makeTextRepelGrobs <- function(
   default.units = "npc",
   just = "center",
   box.padding = 0.25,
+  point.size = 0,
   point.padding = 1e-6,
   name = NULL,
   text.gp = gpar(),
@@ -509,16 +529,32 @@ makeTextRepelGrobs <- function(
     point_inside <- TRUE
   }
 
-  # Nudge the original data point toward the label with point.padding.
-  point_padding_x <- convertWidth(point.padding, "native", TRUE) / 2
-  point_padding_y <- convertHeight(point.padding, "native", TRUE) / 2
-  point_padding <- point_padding_x > 0 & point_padding_y > 0
-  if (point_padding) {
-    point_box <- c(
-      point_pos[1] - point_padding_x, point_pos[2] - point_padding_y,
-      point_pos[1] + point_padding_x, point_pos[2] + point_padding_y
+  # # Nudge the original data point toward the label with point.padding.
+  # point_padding_x <- convertWidth(point.padding, "native", TRUE) / 2
+  # point_padding_y <- convertHeight(point.padding, "native", TRUE) / 2
+  # point_padding <- point_padding_x > 0 & point_padding_y > 0
+  # if (point_padding) {
+  #   point_box <- c(
+  #     point_pos[1] - point_padding_x, point_pos[2] - point_padding_y,
+  #     point_pos[1] + point_padding_x, point_pos[2] + point_padding_y
+  #   )
+  #   point_pos <- intersect_line_rectangle(center, point_pos, point_box)
+  # }
+
+  dx <- abs(int[1] - point_pos[1])
+  dy <- abs(int[2] - point_pos[2])
+  d1 <- sqrt(dx * dx + dy * dy)
+  if (d1 > 0) {
+    new_pos <- c(
+      point_pos[1] - (as.numeric(point.size) / 10 + as.numeric(point.padding)) * (dx / d1),
+      point_pos[2] - (as.numeric(point.size) / 10 + as.numeric(point.padding)) * (dy / d1)
     )
-    point_pos <- intersect_line_rectangle(center, point_pos, point_box)
+    dx <- abs(int[1] - new_pos[1])
+    dy <- abs(int[2] - new_pos[2])
+    d2 <- sqrt(dx * dx + dy * dy)
+  }
+  if (d2 < d1) {
+    point_pos <- new_pos
   }
 
   # Compute the distance between the data point and the edge of the text box.

R/utilities.R

@@ -31,7 +31,7 @@ to_unit <- function(x) {
   }
 
   # NA used to exclude points from repulsion calculations
-  if (is.na(x)) {
+  if (length(x) == 1 && is.na(x)) {
     return(NA)
   }
 

src/RcppExports.cpp

@@ -30,6 +30,18 @@ BEGIN_RCPP
     return rcpp_result_gen;
 END_RCPP
 }
+// intersect_circle_rectangle
+bool intersect_circle_rectangle(NumericVector c, NumericVector r);
+RcppExport SEXP _ggrepel_intersect_circle_rectangle(SEXP cSEXP, SEXP rSEXP) {
+BEGIN_RCPP
+    Rcpp::RObject rcpp_result_gen;
+    Rcpp::RNGScope rcpp_rngScope_gen;
+    Rcpp::traits::input_parameter< NumericVector >::type c(cSEXP);
+    Rcpp::traits::input_parameter< NumericVector >::type r(rSEXP);
+    rcpp_result_gen = Rcpp::wrap(intersect_circle_rectangle(c, r));
+    return rcpp_result_gen;
+END_RCPP
+}
 // intersect_line_rectangle
 NumericVector intersect_line_rectangle(NumericVector p1, NumericVector p2, NumericVector b);
 RcppExport SEXP _ggrepel_intersect_line_rectangle(SEXP p1SEXP, SEXP p2SEXP, SEXP bSEXP) {
@@ -89,14 +101,39 @@ BEGIN_RCPP
     return rcpp_result_gen;
 END_RCPP
 }
+// repel_boxes2
+DataFrame repel_boxes2(NumericMatrix data_points, NumericVector point_size, double point_padding_x, double point_padding_y, NumericMatrix boxes, NumericVector xlim, NumericVector ylim, NumericVector hjust, NumericVector vjust, double force_push, double force_pull, int maxiter, std::string direction);
+RcppExport SEXP _ggrepel_repel_boxes2(SEXP data_pointsSEXP, SEXP point_sizeSEXP, SEXP point_padding_xSEXP, SEXP point_padding_ySEXP, SEXP boxesSEXP, SEXP xlimSEXP, SEXP ylimSEXP, SEXP hjustSEXP, SEXP vjustSEXP, SEXP force_pushSEXP, SEXP force_pullSEXP, 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< NumericVector >::type point_size(point_sizeSEXP);
+    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< NumericVector >::type hjust(hjustSEXP);
+    Rcpp::traits::input_parameter< NumericVector >::type vjust(vjustSEXP);
+    Rcpp::traits::input_parameter< double >::type force_push(force_pushSEXP);
+    Rcpp::traits::input_parameter< double >::type force_pull(force_pullSEXP);
+    Rcpp::traits::input_parameter< int >::type maxiter(maxiterSEXP);
+    Rcpp::traits::input_parameter< std::string >::type direction(directionSEXP);
+    rcpp_result_gen = Rcpp::wrap(repel_boxes2(data_points, point_size, point_padding_x, point_padding_y, boxes, xlim, ylim, hjust, vjust, force_push, force_pull, maxiter, direction));
+    return rcpp_result_gen;
+END_RCPP
+}
 
 static const R_CallMethodDef CallEntries[] = {
     {"_ggrepel_euclid", (DL_FUNC) &_ggrepel_euclid, 2},
     {"_ggrepel_centroid", (DL_FUNC) &_ggrepel_centroid, 3},
+    {"_ggrepel_intersect_circle_rectangle", (DL_FUNC) &_ggrepel_intersect_circle_rectangle, 2},
     {"_ggrepel_intersect_line_rectangle", (DL_FUNC) &_ggrepel_intersect_line_rectangle, 3},
     {"_ggrepel_select_line_connection", (DL_FUNC) &_ggrepel_select_line_connection, 2},
     {"_ggrepel_approximately_equal", (DL_FUNC) &_ggrepel_approximately_equal, 2},
     {"_ggrepel_repel_boxes", (DL_FUNC) &_ggrepel_repel_boxes, 12},
+    {"_ggrepel_repel_boxes2", (DL_FUNC) &_ggrepel_repel_boxes2, 13},
     {NULL, NULL, 0}
 };