Merge branch 'develop-0.5.7'

DESCRIPTION

@@ -1,8 +1,8 @@
 Package: ggpp
 Type: Package
 Title: Grammar Extensions to 'ggplot2'
-Version: 0.5.6.9000
-Date: 2024-03-01
+Version: 0.5.6.9001
+Date: 2024-03-04
 Authors@R:
     c(
     person("Pedro J.", "Aphalo", email = "[email protected]", role = c("aut", "cre"), comment = c(ORCID = "0000-0003-3385-972X")),
@@ -26,7 +26,7 @@ LazyLoad: TRUE
 ByteCompile: TRUE
 Depends:
     R (>= 4.0.0),
-    ggplot2 (>= 3.3.6)
+    ggplot2 (>= 3.5.0)
 Imports:
     stats,
     grid,
@@ -58,3 +58,45 @@ BugReports: https://github.com/aphalo/ggpp/issues
 Encoding: UTF-8
 RoxygenNote: 7.3.1
 VignetteBuilder: knitr
+Collate: 
+    'annotate.r'
+    'compute-npc.r'
+    'dark-or-light.R'
+    'example-data.R'
+    'geom-grob.R'
+    'ggpp-legend-draw.R'
+    'utilities.R'
+    'ggp2-margins.R'
+    'geom-label-linked.r'
+    'geom-label-npc.r'
+    'geom-label-pairwise.r'
+    'geom-margin-arrow.r'
+    'geom-margin-grob.r'
+    'geom-margin-point.r'
+    'geom-plot.R'
+    'geom-point-linked.r'
+    'geom-quadrant-lines.R'
+    'geom-table.R'
+    'geom-text-linked.r'
+    'geom-text-npc.r'
+    'geom-text-pairwise.R'
+    'ggpp.R'
+    'position-nudge-center.R'
+    'position-nudge-dodge.R'
+    'position-nudge-dodge2.R'
+    'position-nudge-jitter.R'
+    'position-nudge-line.R'
+    'position-nudge-stack.R'
+    'position-nudge-to.R'
+    'scale-continuous-npc.r'
+    'stat-apply.R'
+    'stat-dens1d-filter.r'
+    'stat-dens1d-labels.r'
+    'stat-dens2d-filter.r'
+    'stat-dens2d-labels.r'
+    'stat-format-table.R'
+    'stat-functions.R'
+    'stat-panel-counts.R'
+    'stat-quadrant-counts.R'
+    'try-data-frame.R'
+    'weather-data.R'

NAMESPACE

@@ -42,9 +42,15 @@ export(StatGroupCounts)
 export(StatPanelCounts)
 export(StatQuadrantCounts)
 export(annotate)
+export(as_npc)
+export(as_npcx)
+export(as_npcy)
+export(compute_npc)
 export(compute_npcx)
 export(compute_npcy)
 export(dark_or_light)
+export(draw_key_label_s)
+export(draw_key_text_s)
 export(geom_grob)
 export(geom_grob_npc)
 export(geom_label_npc)

NEWS.md

@@ -6,8 +6,33 @@ editor_options:
     wrap: 72
 ---
 
-# ggpp 0.5.7
-
+# ggpp 0.5.7/0.6.0
+
+Track changes in 'ggplot2' 3.5.0. Fix a couple of minor incompatibilities. 
+Add some new features matching those new in 'ggplot2'. General improvements
+and bug fixes.
+
+-   This version depends on 'ggplot2' >= 3.5.0.
+-   Add `as_npc()`, `as_npcx()` and `as_npcy()` helper functions that translate
+positions given as character strings in numeric values in [0..1] into NPC
+(Normalised Parent Coordinates) and validate the range of numeric values if
+passed directly as arguments. The returned values belong to class `AsIs` and
+ready to use in aesthetic mappings.
+-   Update `geom_point_s()` adding parameter `move.point` to allow its use to 
+highlight points at the original position with an arrow with its start given by 
+the displacement by a position function.
+-   Change in `geom_point_s()` the end at which the tip of the arrow is drawn,
+to its most frequently used direction, even if opposite to the default for
+`geom_text_s()` and `geom_label_s()`.
+-   Update `geom_text_s()`, `geom_label_s()`. `geom_text_pairwise()` and 
+`geom_label_pairwise()` adding parameter `size.unit` tracking change in 
+`geom_text()` and `geom_label()` in 'ggplot2' 3.5.0.
+-   Update `geom_text_s()`, `geom_label_s()`. `geom_text_pairwise()` and 
+`geom_label_pairwise()` so that graphic elements in the keys match those in
+the plot, even when using the additional features not availablr in 'ggplot2'.
+-   Fix in `geom_text_s()`, `geom_label_s()`. `geom_text_pairwise()` and 
+`geom_label_pairwise()` an infrequent problem with incomplete guides in 
+'ggplot2' 3.5.0.
 -   Fix bug in `geom_point_s()`, `alpha_target = "point"` ignored.
 
 # ggpp 0.5.6

R/compute-npc.r

@@ -1,26 +1,39 @@
-#' Compute npc coordinates
+#' Compute NPC coordinates
 #'
-#' Convert character-encoded positions to npc units and shift positions to
-#' avoid overlaps when grouping is active. If numeric, validate npc values.
+#' Translate and/or compute NPC (Normalised Parent Coordinates) for use with
+#' aesthetics \code{x} and \code{y}.
 #'
-#' @details These functions use NPC (normalized plot coordinates) instead of
-#'   data coordinates. They translate named positions into numeric values in
-#'   [0..1] and they can also shift the position according to the group, e.g.,
-#'   for each increase in the group number displace the position inwards or
-#'   outwards, by a user-supplied distance. They make it possible to set
-#'   automatically set default positions for grouped text labels.
+#' @details Functions \code{compute_npcx} and \code{compute_npcy} convert
+#'   character-encoded positions to npc units and shift positions to avoid
+#'   overlaps when grouping is active. If numeric, they validate the npc values.
+#'   Function \code{compute_npcx} does the translation either for both \code{x}
+#'   and \code{y} aesthetics, but does not implement a shift for grpups.
+#'   Functions \code{as_npcx()},  \code{as_npcy()} and \code{as_npc()} are
+#'   wrappers on these functions that return the value as objects of class
+#'   \code{"AsIs"} so that in 'ggplot2' >= 3.5.0 they can be used with any layer
+#'   function.
+#'
+#'   These functions use NPC (Normalised Parent Coordinates) instead of data
+#'   coordinates. They translate named positions into numeric values in [0..1]
+#'   and they can also shift the position according to the group, e.g., for each
+#'   increase in the group number displace the position inwards or outwards, by
+#'   a user-supplied distance. They make it possible to set automatically set
+#'   default positions for grouped text labels.
 #'
 #'   Out of bounds numeric values are constrained to [0..1]. Unrecognized
 #'   character values are silently converted into \code{NA_integer_}.
 #'
-#' @note These functions are used by several layer functions in packages
-#'   'ggpp' and 'ggpmisc', and can be useful to developers of other 'ggplot2'
-#'   extensions.
+#' @note The \emph{as_npc()} functions make it easier the use of NPC coordinates
+#'   with 'ggplot2' >= 3.5.0. The _compute_ functions are used by several layer
+#'   functions in packages 'ggpp' and 'ggpmisc', are compatible with 'ggplot2'
+#'   <= 3.4.4 and can be useful to developers of other 'ggplot2' extensions.
 #'
-#' @param x numeric or if character, one of "right", "left", "centre",
-#'  "center" or "middle".
-#' @param y numeric or if character, one of "top", "bottom", "centre",
-#'  "center" or "middle".
+#' @param x numeric or if character, one of "right", "left", "maximum",
+#'   "minimum", "centre", "center" or "middle".
+#' @param y numeric or if character, one of "top", "bottom", "maximum",
+#'   "minimum", "centre", "center" or "middle".
+#' @param a numeric or if character, one of "right", "left", "top", "maximum",
+#'   "minimum", "bottom", "centre", "center" or "middle".
 #' @param group integer vector, ggplot's group id. Used to shift coordinates to
 #'   avoid overlaps.
 #' @param h.step,v.step numeric [0..1] The step size for shifting coordinates
@@ -29,18 +42,28 @@
 #'   plotting area edge when converting character coordinates into npc. Usually
 #'   << 1.
 #' @param each.len integer The number of steps per group.
+#' @param ... named arguments passed to \code{compute_npcx()} or
+#'   \code{compute_npcy()}.
 #'
 #' @return A numeric vector with values in the range [0..1] representing
 #'   npc coordinates.
 #'
 #' @examples
 #' compute_npcx("right")
 #' compute_npcx(c("left", "right"))
+#' compute_npcx(c("minimum", "maximum"))
+#' compute_npcx(c("left", "right"), margin.npc = 0)
 #' compute_npcy("bottom")
 #' compute_npcy("bottom", group = 1L:3L)
+#' compute_npcy("bottom", group = 1L:3L, v.step = 0.2)
 #' compute_npcy("bottom", group = 2L)
 #' compute_npcx(0.5)
 #' compute_npcx(1)
+#' compute_npcx(-2)
+#'
+#' as_npc("right")
+#' class(as_npc("right"))
+#' class(compute_npcx("right"))
 #'
 #' @export
 #'
@@ -57,6 +80,8 @@ compute_npcx <- function(x,
     # we must handle character vectors with length > 1
     map <- c(right = 1 - margin.npc,
              left = 0 + margin.npc,
+             maximum = 1,
+             minimum = 0,
              centre = 0.5,
              center = 0.5,
              middle = 0.5,
@@ -94,6 +119,8 @@ compute_npcy <- function(y,
     # we must handle character vectors with length > 1
     map <- c(top = 1 - margin.npc,
              bottom = 0 + margin.npc,
+             maximum = 1,
+             minimum = 0,
              centre = 0.5,
              center = 0.5,
              middle = 0.5,
@@ -113,3 +140,58 @@ compute_npcy <- function(y,
   y <- ifelse(y < 0, 0, y)
   y
 }
+
+#' @rdname compute_npcx
+#'
+#' @export
+#'
+as_npcx <- function(x, ...) {
+  I(compute_npcx(x = x, ...))
+}
+
+#' @rdname compute_npcx
+#'
+#' @export
+#'
+as_npcy <- function(y, ...) {
+  I(compute_npcy(y = y, ...))
+}
+
+#' @rdname compute_npcx
+#'
+#' @export
+#'
+compute_npc <- function(a,
+                        margin.npc = 0.05) {
+  if (is.factor(a)) {
+    a <- as.character(a)
+  }
+  if (is.character(a)) {
+    # we must handle character vectors with length > 1
+    map <- c(top = 1 - margin.npc,
+             bottom = 0 + margin.npc,
+             right = 1 - margin.npc,
+             left = 0 + margin.npc,
+             maximum = 1,
+             minimum = 0,
+             centre = 0.5,
+             center = 0.5,
+             middle = 0.5,
+             NA_real_)
+    a <- unname(map[a])
+  } else if (is.numeric(a)) {
+    a <- ifelse(a > 1, 1, a)
+    a <- ifelse(a < 0, 0, a)
+    a
+  }
+  a
+}
+
+#' @rdname compute_npcx
+#'
+#' @export
+#'
+as_npc <- function(a,
+                   margin.npc = 0.05) {
+  I(compute_npc(a = a, margin.npc = margin.npc))
+}

R/geom-label-linked.r

@@ -1,4 +1,5 @@
 #' @rdname geom_text_s
+#' @include ggp2-margins.R utilities.R ggpp-legend-draw.R
 #'
 #' @param label.padding Amount of padding around label. Defaults to 0.25 lines.
 #' @param label.r Radius of rounded corners. Defaults to 0.15 lines.
@@ -28,6 +29,7 @@ geom_label_s <-
            point.padding = 1e-06,
            min.segment.length = 0,
            arrow = NULL,
+           size.unit = "mm",
            na.rm = FALSE,
            show.legend = NA,
            inherit.aes = TRUE) {
@@ -73,6 +75,7 @@ geom_label_s <-
       point.padding = point.padding,
       min.segment.length = min.segment.length,
       arrow = arrow,
+      size.unit = size.unit,
       na.rm = na.rm,
       ...
     )
@@ -87,12 +90,14 @@ GeomLabelS <-
   ggplot2::ggproto("GeomLabelS", ggplot2::Geom,
                    required_aes = c("x", "y", "label"),
 
+                   non_missing_aes = "angle",
+
                    default_aes = ggplot2::aes(
                      colour = "black",
                      fill = "white",
                      size = 3.88,
-                     angle = 0, # currently ignored
-                     linewidth = 0.25,
+                     angle = 0,
+                     linewidth = 0.5,
                      linetype = "solid",
                      hjust = "position",
                      vjust = "position",
@@ -105,6 +110,7 @@ GeomLabelS <-
                    draw_panel = function(data, panel_params, coord, #panel_scales,
                                          parse = FALSE,
                                          na.rm = FALSE,
+                                         size.unit = "mm",
                                          add.segments = TRUE,
                                          default.colour = "black",
                                          colour.target = "all",
@@ -120,6 +126,11 @@ GeomLabelS <-
 
                      add.segments <- add.segments && all(c("x_orig", "y_orig") %in% colnames(data))
 
+                     # ensure compatibility with 'ggplot2'
+                     if (exists("label.size", data)) {
+                       data$line.width <- data$label.size * .pt / ggplot2::.stroke
+                       data$label.size <- NULL
+                     }
                      data$label <- as.character(data$label)
                      data <- subset(data, !is.na(label) & label != "")
                      if (nrow(data) == 0L) {
@@ -155,6 +166,9 @@ GeomLabelS <-
                                         just = data$hjust,
                                         a = "x", b = "y")
                      }
+
+                     size.unit <- resolve_text_unit(size.unit)
+
                      if (!inherits(label.padding, "margin")) {
                        label.padding <- rep(label.padding, length.out = 4)
                      }
@@ -194,7 +208,7 @@ GeomLabelS <-
                                                 col = ifelse(any(colour.target %in% c("all", "text")),
                                                              ggplot2::alpha(row$colour, text.alpha),
                                                              ggplot2::alpha(default.colour, text.alpha)),
-                                                fontsize = row$size * .pt,
+                                                fontsize = row$size * size.unit,
                                                 fontfamily = row$family,
                                                 fontface = row$fontface,
                                                 lineheight = row$lineheight
@@ -245,7 +259,7 @@ GeomLabelS <-
 
                    },
 
-                   draw_key = draw_key_text
+                   draw_key = draw_key_label_s
   )
 
 labelGrob <- function(label, x = grid::unit(0.5, "npc"), y = grid::unit(0.5, "npc"),