Merge branch 'develop-0.5.8'

DESCRIPTION

@@ -1,8 +1,8 @@
 Package: ggpp
 Type: Package
 Title: Grammar Extensions to 'ggplot2'
-Version: 0.5.7.9000
-Date: 2024-06-21
+Version: 0.5.7.9001
+Date: 2024-06-26
 Authors@R:
     c(
     person("Pedro J.", "Aphalo", email = "[email protected]", role = c("aut", "cre"), comment = c(ORCID = "0000-0003-3385-972X")),

NEWS.md

@@ -8,7 +8,10 @@ editor_options:
 
 # ggpp 0.5.8
 
--  Fix wrong test for availability of 'gginnards' in examples (reported by _Joshua Ulrich_ in issue #53)
+-  Fix wrong test for availability of 'gginnards' in examples (reported by
+_Joshua Ulrich_ in issue #53).
+-  Revise `position_nudge_to()` to support expansion and contraction of the
+range within which to spread the positions.
 
 # ggpp 0.5.7
 

R/position-nudge-to.R

@@ -16,9 +16,13 @@
 #'   there are in \code{data}. The default, \code{NULL}, leaves the original
 #'   coordinates unchanged.
 #' @param x.action,y.action character string, one of \code{"none"}, or
-#'   \code{"spread"}. With \code{"spread"} evenly distributing the positions
+#'   \code{"spread"}. With \code{"spread"} distributing the positions
 #'   within the range of argument \code{x} or \code{y}, if non-null, or the
 #'   range the variable mapped to \emph{x} or \code{y}, otherwise.
+#' @param x.distance,y.distance character or numeric Currently only \code{"equal"} is
+#'   implemented.
+#' @param x.expansion,y.expansion numeric vectors of length 1 or 2, as a
+#'   fraction of width of the range.
 #' @param kept.origin One of \code{"original"} or \code{"none"}.
 #'
 #' @details The nudged to \code{x} and/or \code{y} values replace the original ones in
@@ -84,6 +88,18 @@
 #'   geom_text_s(position =
 #'     position_nudge_to(y = 3, x.action = "spread"))
 #'
+#' # spread the values at equal distance within the expanded available space
+#' ggplot(df, aes(x, y, label = label)) +
+#'   geom_point() +
+#'   geom_text_s(position =
+#'     position_nudge_to(y = 3, x.action = "spread", x.expansion = 0.1))
+#'
+#' # spread the values at equal distance within the contracted available space
+#' ggplot(df, aes(x, y, label = label)) +
+#'   geom_point() +
+#'   geom_text_s(position =
+#'     position_nudge_to(y = 3, x.action = "spread", x.expansion = -0.1))
+#'
 #' # spread the values at equal distance within the range given by x
 #' ggplot(df, aes(x, y, label = label)) +
 #'   geom_point() +
@@ -102,12 +118,18 @@ position_nudge_to <-
            y = NULL,
            x.action = c("none", "spread"),
            y.action = c("none", "spread"),
+           x.distance = "equal",
+           y.distance = "equal",
+           x.expansion = 0,
+           y.expansion = 0,
            kept.origin = c("original", "none")) {
     kept.origin <- rlang::arg_match(kept.origin)
     x.action <- rlang::arg_match(x.action)
     y.action <- rlang::arg_match(y.action)
-    stopifnot("'x' must be NULL or of mode numeric" = is.null(x) || mode(x) == "numeric")
-    stopifnot("'y' must be NULL or of mode numeric" = is.null(y) || mode(y) == "numeric")
+    stopifnot("'x' must be NULL or of mode numeric" = length(x) == 0 ||
+                (!anyNA(x) && mode(x) == "numeric"))
+    stopifnot("'y' must be NULL or of mode numeric" = length(y) == 0 ||
+                (!anyNA(y) && mode(y) == "numeric"))
 
     # this works as long as nudge and mapped variable are of the same class
     # ggplot2's behaviour has been in the past and seems to be again to expect
@@ -124,6 +146,10 @@ position_nudge_to <-
                      y = y,
                      x.action = x.action,
                      y.action = y.action,
+                     x.distance = x.distance,
+                     y.distance = y.distance,
+                     x.expansion = rep_len(x.expansion, 2),
+                     y.expansion = rep_len(y.expansion, 2),
                      kept.origin = kept.origin
     )
   }
@@ -144,6 +170,10 @@ PositionNudgeTo <-
            y = self$y,
            x.action = self$x.action,
            y.action = self$y.action,
+           x.distance = self$x.distance,
+           y.distance = self$y.distance,
+           x.expansion = self$x.expansion,
+           y.expansion = self$y.expansion,
            x.reorder = !is.null(self$x) && length(self$x) > 1 && length(self$x) < nrow(data),
            y.reorder = !is.null(self$y) && length(self$y) > 1 && length(self$y) < nrow(data),
            kept.origin = self$kept.origin
@@ -155,17 +185,20 @@ PositionNudgeTo <-
       y_orig <- data$y
 
       # compute/convert x nudges
-      if (is.null(params$x)) {
+      if (!length(params$x)) {
+        # set default x
         if (params$x.action == "none") {
           params$x <- rep_len(0, nrow(data))
         } else if (params$x.action == "spread") {
           params$x <- range(x_orig)
         }
       } else if (is.numeric(params$x)) {
+        # check user supplied x
         if (length(params$x) > nrow(data)) {
           warning("Argument 'x' longer than data: some values dropped!")
         }
         if (params$x.action == "none") {
+          # recycle or trim x as needed
           if (params$x.reorder) {
             params$x <- rep_len(params$x, nrow(data))[order(order(data$x))] - x_orig
           } else {
@@ -175,25 +208,36 @@ PositionNudgeTo <-
           params$x <- range(params$x)
         }
       }
+
       if (params$x.action == "spread") {
-        # evenly spaced sequence ordered as in data
-        params$x <- seq(from = params$x[1],
-                        to = params$x[2],
-                        length.out = nrow(data))[order(order(data$x))] - x_orig
+        # apply x.expansion to x
+        x.spread <- diff(params$x)
+        params$x[1] <- params$x[1] - params$x.expansion[1] * x.spread
+        params$x[2] <- params$x[2] + params$x.expansion[2] * x.spread
+        if (params$x.distance == "equal") {
+          # evenly spaced sequence of positions ordered as in data
+          params$x <- seq(from = params$x[1],
+                          to = params$x[2],
+                          length.out = nrow(data))[order(order(data$x))] - x_orig
+        }
+        # other strategies to distribute positions could be added here
       }
 
       # compute/convert y nudges
-      if (is.null(params$y)) {
+      if (!length(params$y)) {
+        # set default y
         if (params$y.action == "none") {
           params$y <- rep_len(0, nrow(data))
         } else if (params$y.action == "spread") {
           params$y <- range(y_orig)
         }
       } else if (is.numeric(params$y)) {
+        # check user supplied y
+        if (length(params$y) > nrow(data)) {
+          warning("Argument 'y' longer than data: some values dropped!")
+        }
         if (params$y.action == "none") {
-          if (length(params$y) > nrow(data)) {
-            warning("Argument 'y' longer than data: some values dropped!")
-          }
+          # recycle or trim y as needed
           if (params$y.reorder) {
             params$y <- rep_len(params$y, nrow(data))[order(order(data$y))] - y_orig
           } else {
@@ -203,11 +247,18 @@ PositionNudgeTo <-
           params$y <- range(params$y)
         }
       }
+
       if (params$y.action == "spread") {
-        # evenly spaced sequence ordered as in data
-        params$y <- seq(from = params$y[1],
-                        to = params$y[2],
-                        length.out = nrow(data))[order(order(data$y))] - y_orig
+        y.spread <- diff(params$y)
+        params$y[1] <- params$y[1] - params$y.expansion[1] * y.spread
+        params$y[2] <- params$y[2] + params$y.expansion[2] * y.spread
+        if (params$y.distance == "equal") {
+          # evenly spaced sequence ordered as in data
+          params$y <- seq(from = params$y[1],
+                          to = params$y[2],
+                          length.out = nrow(data))[order(order(data$y))] - y_orig
+        }
+        # other strategies could be added here
       }
 
       # As in 'ggplot2' we apply the nudge to xmin, xmax, xend, ymin, ymax, and yend.