Merge branch 'experiment-rounded-rect'

.gitignore

@@ -3,6 +3,5 @@
 .Rdata
 .httr-oauth
 .DS_Store
-Davies*/*
 tests/testthat/Rplots.pdf
 docs

DESCRIPTION

@@ -25,7 +25,6 @@ Imports:
     rlang
 Suggests: 
     doctest,
-    ggforce,
     ggfx,
     hexbin,
     maps,
@@ -45,3 +44,5 @@ Collate:
     'helpers.R'
     'inset-theme.R'
     'projection.R'
+Remotes:  
+    thomasp85/ggforce

NEWS.md

@@ -1,6 +1,11 @@
+
+# ggmagnify (development version)
+
+* New `corners` argument sets corner radius on target and inset. Thanks
+  to @thomasp85 for help with this.
+
 # ggmagnify 0.2.0
 
-* First CRAN release.
 * `from` and `to` can now be mapped to aesthetics, allowing different targets in
   different facets.
   - `from` can now be a logical vector of points to select.

R/compute-shape-grob.R

@@ -2,17 +2,19 @@
 #' Compute a shape grob on scale 0-1 npc for use for borders,
 #' target lines and mask
 #'
-#' @param from Stripped of surrounding `list()`
-#' @param shape "rect", "ellipse", "outline"
-#' @param data Data
-#' @param coord Coord object
-#' @param panel_params Opaque object
-#' @param expand Parameter for proportional expansion (not done yet)
+#' @param from Stripped of surrounding `list()`.
+#' @param shape "rect", "ellipse", "outline".
+#' @param corners Numeric. Radius of corners for "rect" shape.
+#' @param data Data.
+#' @param coord Coord object.
+#' @param panel_params Opaque object.
+#' @param expand Parameter for proportional expansion (not done yet).
 #'
 #' @return A [grid::grob()] object with units "npc" and data between 0 and
 #' 1 on screen scale. Coordinates have been transformed by `coord$transform(...)`.
 #' @noRd
-compute_shape_grob <- function (from, shape, data, coord, panel_params, expand) {
+compute_shape_grob <- function (from, shape, corners, data, coord,
+                                panel_params, expand) {
   UseMethod("compute_shape_grob")
   # if from is a grob, use it directly (after rescaling). If from is a data
   # frame, make a grob
@@ -22,8 +24,8 @@ compute_shape_grob <- function (from, shape, data, coord, panel_params, expand)
 }
 
 
-compute_shape_grob.grob <- function (from, shape, data, coord, panel_params,
-                                     expand) {
+compute_shape_grob.grob <- function (from, shape, corners, data, coord,
+                                     panel_params, expand) {
   scale01 <- function (x) (x - min(x))/(max(x) - min(x))
   scalexy <- function(mx) {
     # we don't transform for a raw grob; and we've expanded the bounding box
@@ -42,22 +44,22 @@ compute_shape_grob.grob <- function (from, shape, data, coord, panel_params,
 }
 
 
-compute_shape_grob.data.frame <- function (from, shape, data, coord, panel_params,
-                                           expand) {
+compute_shape_grob.data.frame <- function (from, shape, corners, data, coord,
+                                           panel_params, expand) {
   # this will be on scale of data
   names(from) <- c("x", "y")
   from_grob <- polygonGrob(x = from$x, y = from$y,
                             default.units = "native")
-  compute_shape_grob(from_grob, shape, data, coord, panel_params, expand)
+  compute_shape_grob(from_grob, shape, corners, data, coord, panel_params, expand)
 }
 
 
-compute_shape_grob.default <- function (from, shape, data, coord, panel_params,
-                                        expand) {
+compute_shape_grob.default <- function (from, shape, corners, data, coord,
+                                        panel_params, expand) {
   if (shape == "rect") {
-    grid::rectGrob()
+    grid::roundrectGrob(r = unit(corners, "snpc"))
   } else if (shape == "ellipse") {
-    # resist the temptation to replace this with cirleGrob. You need to
+    # resist the temptation to replace this with circleGrob. You need to
     # mess with it later.
     gridExtra::ellipseGrob(x = 0.5, y = 0.5, size = 0.5, n = 180,
                              position.units = "npc", size.units = "npc")
@@ -69,31 +71,36 @@ compute_shape_grob.default <- function (from, shape, data, coord, panel_params,
     if (! is.null(data$geometry) && inherits(data$geometry, "sfc")) {
       rlang::check_installed("sf")
       from <- sf::st_as_grob(data$geometry)
-      compute_shape_grob(from, shape, data, coord, panel_params, expand)
+      compute_shape_grob(from, shape, corners, data, coord, panel_params, expand)
     } else if ("x" %in% names(data) && "y" %in% names(data)){
       # only here we use the actual x and y points
       from_df <- hull_around(data$x, data$y, expand = 0)
       from_df <- coord$transform(from_df, panel_params)
 
       from_grob <- polygonGrob(x = from_df$x, y = from_df$y,
                                default.units = "native")
-      compute_shape_grob(from_grob, shape, data, coord, panel_params, expand = 0)
+      compute_shape_grob(from_grob, shape, corners, data, coord, panel_params,
+                         expand = 0)
     } else {
       cli::cli_warn(c("Couldn't find `x` and `y` to build convex hull.",
                       "Falling back to shape = \"rect\""))
-      grid::rectGrob()
+      compute_shape_grob(from_grob, shape = "rect", corners, data, coord,
+                         panel_params, expand = 0)
     }
   }
 }
 
+
 subset_by_from <- function (from, data) {
   UseMethod("subset_by_from")
 }
 
+
 subset_by_from.logical <- function (from, data) {
   data[from,]
 }
 
+
 subset_by_from.default <- function (from, data) {
   if (is.null(names(from))) names(from) <- c("xmin", "xmax", "ymin", "ymax")
   if (inherits(data$geometry, "sfc")) {
@@ -110,5 +117,3 @@ subset_by_from.default <- function (from, data) {
     data[cond,]
   }
 }
-
-

R/geom-magnify-tile.R

@@ -21,6 +21,7 @@ geom_magnify_tile <- function (mapping = NULL,
                                axes = "",
                                proj = "facing",
                                shadow = FALSE,
+                               corners = 0,
                                colour = "black",
                                linetype = 1,
                                target.linetype = linetype,
@@ -46,7 +47,8 @@ geom_magnify_tile <- function (mapping = NULL,
          position = "identity", show.legend = FALSE, inherit.aes = inherit.aes,
          params = list(na.rm = na.rm, expand = expand, aspect = aspect,
                        axes = axes,
-                       proj = proj, shadow = shadow, colour = colour,
+                       proj = proj, shadow = shadow, corners = corners,
+                       colour = colour,
                        linewidth = linewidth, linetype = linetype,
                        target.linetype = target.linetype,
                        proj.linetype = proj.linetype,

R/geom-magnify.R

@@ -41,6 +41,9 @@ NULL
 #'   default), `"corresponding"` or `"single"`. Can be abbreviated. See below.
 #' @param shadow Logical. Draw a shadow behind the inset plot? Requires the
 #'   "ggfx" package.
+#' @param corners Numeric between 0 and 1. Radius of rounded corners for the
+#'   target area and inset. Only used if `shape` is `"rect"`. 0.1 is a good
+#'   starting value.
 #' @param linetype,colour,alpha,linewidth Linetype, colour, alpha and linewidth
 #' for borders and projection lines.
 #' @param target.linetype,inset.linetype,proj.linetype Linetypes
@@ -189,6 +192,7 @@ geom_magnify <- function (mapping = NULL,
                           axes = "",
                           proj = c("facing", "corresponding", "single"),
                           shadow = FALSE,
+                          corners = 0,
                           colour = "black",
                           linetype = 1,
                           target.linetype = linetype,
@@ -213,7 +217,8 @@ geom_magnify <- function (mapping = NULL,
          mapping = mapping, data = data, stat = stat,
          position = "identity", show.legend = FALSE, inherit.aes = inherit.aes,
          params = list(expand = expand, aspect = aspect,
-                       axes = axes, proj = proj, shadow = shadow, colour = colour,
+                       axes = axes, proj = proj, shadow = shadow,
+                       corners = corners, colour = colour,
                        linewidth = linewidth, linetype = linetype, alpha = alpha,
                        target.linetype = target.linetype,
                        proj.linetype = proj.linetype,
@@ -266,7 +271,7 @@ GeomMagnify <- ggproto("GeomMagnify", Geom,
 
 
   draw_panel = function (self, data, panel_params, coord, from,
-                         magnify, axes, proj, shadow, colour,
+                         magnify, axes, proj, shadow, corners, colour,
                          linetype, target.linetype, proj.linetype, inset.linetype,
                          linewidth, alpha, shape, expand, plot, shadow.args,
                          recompute, scale.inset, proj.combine
@@ -282,18 +287,18 @@ GeomMagnify <- ggproto("GeomMagnify", Geom,
             }  else {
               from
             }
-    shape_grob <- compute_shape_grob(from, shape, data, coord, panel_params,
+    shape_grob <- compute_shape_grob(from, shape, corners, data, coord, panel_params,
                                      expand)
 
     # == create grob for border around target ==
-    target_corners <- data.frame(
+    target_limits <- data.frame(
                        x = c(d1$xmin, d1$xmax),
                        y = c(d1$ymin, d1$ymax)
                      )
 
-    target_corners_t <- coord$transform(target_corners, panel_params)
-    target_x_rng <- range(target_corners_t$x, na.rm = TRUE)
-    target_y_rng <- range(target_corners_t$y, na.rm = TRUE)
+    target_limits_t <- coord$transform(target_limits, panel_params)
+    target_x_rng <- range(target_limits_t$x, na.rm = TRUE)
+    target_y_rng <- range(target_limits_t$y, na.rm = TRUE)
 
     target_vp <- viewport(x = mean(target_x_rng),
                           y = mean(target_y_rng),
@@ -314,13 +319,13 @@ GeomMagnify <- ggproto("GeomMagnify", Geom,
 
     # == create the viewport and mask for the inset plot ==============
 
-    corners <- data.frame(
+    limits <- data.frame(
       x = c(d1$to_xmin, d1$to_xmax),
       y = c(d1$to_ymin, d1$to_ymax)
     )
-    corners_t <- coord$transform(corners, panel_params)
-    x_rng <- range(corners_t$x, na.rm = TRUE)
-    y_rng <- range(corners_t$y, na.rm = TRUE)
+    limits_t <- coord$transform(limits, panel_params)
+    x_rng <- range(limits_t$x, na.rm = TRUE)
+    y_rng <- range(limits_t$y, na.rm = TRUE)
     # we use a mask here instead of clipping because gtable doesn't inherit
     # clip, and grid doesn't nest clips (so I guess ggplot needs its own
     # clipping, presumably when grid.draw is called on it?)
@@ -358,7 +363,7 @@ GeomMagnify <- ggproto("GeomMagnify", Geom,
     # == create projection lines =====
     proj_df <- if (identical(shape, "rect") && ! inherits(from, "grob") &&
                    ! inherits(from, "data.frame")) {
-      calculate_proj_df_rect(proj, d1, coord, panel_params)
+      calculate_proj_df_rect(proj, d1, corners, coord, panel_params)
     } else {
       calculate_proj_df(proj, proj.combine, target_grob, border_grob)
     }
@@ -381,6 +386,7 @@ GeomMagnify <- ggproto("GeomMagnify", Geom,
   }
 )
 
+
 create_plot_gtable <- function (plot, data, axes, recompute, scale.inset) {
   plot_coord <- ggplot_build(plot)$layout$coord
   plot_limits <- plot_coord$limits

R/projection.R

@@ -151,7 +151,7 @@ in_bbox <- function(pts, p1, p2) {
 }
 
 
-calculate_proj_df_rect <- function(proj, data, coord, panel_params) {
+calculate_proj_df_rect <- function(proj, data, corners, coord, panel_params) {
   # using mean allows Dates and maybe other things
   xmin <- data$xmin
   xmax <- data$xmax
@@ -162,13 +162,37 @@ calculate_proj_df_rect <- function(proj, data, coord, panel_params) {
   to_ymin <- data$to_ymin
   to_ymax <- data$to_ymax
 
+  if (corners > 0 && ! identical(proj, "single")) {
+    # a 1 - 1/sqrt(2) adjustment, c. 0.29, would get to the midpoint of the
+    # rounded corner (at a 45 degree angle), calculated via Pythagoras.
+    # This isn't perfect because lines don't always come in at 45 deg.
+    # An adj of 0.2 is a bit "looser" and should give fewer cases
+    # where projection lines end up inside the target area.
+    # The use of min() below reflects that corners is in "snpc" units:
+    # see ?grid::unit.
+    size <- min(xmax - xmin, ymax - ymin)
+    to_size <- min(to_xmax - to_xmin, to_ymax - to_ymin)
+    adj <- 0.2 # 1 - 1/sqrt(2)
+    corn_adj <- corners * size * adj
+    to_corn_adj <- corners * to_size * adj
+
+    xmin <- xmin + corn_adj
+    xmax <- xmax - corn_adj
+    ymin <- ymin + corn_adj
+    ymax <- ymax - corn_adj
+
+    to_xmin <- to_xmin + to_corn_adj
+    to_xmax <- to_xmax - to_corn_adj
+    to_ymin <- to_ymin + to_corn_adj
+    to_ymax <- to_ymax - to_corn_adj
+  }
 
   x <- mean(c(xmin, xmax))
   y <- mean(c(ymin, ymax))
   to_x <- mean(c(to_xmin, to_xmax))
   to_y <- mean(c(to_ymin, to_ymax))
 
-  if (proj %in% c("auto", "corresponding", "facing")) {
+  if (proj %in% c("corresponding", "facing")) {
     # which of the four lines connecting the four corners can we draw?
     can_top_left  <- sign(xmin - to_xmin) == sign(ymax - to_ymax)
     can_bot_right <- sign(xmax - to_xmax) == sign(ymin - to_ymin)

README.Rmd

@@ -36,28 +36,28 @@ target area and the inset, along with projection lines from one to the other.
 The inset can have a drop shadow. The magnified area can be a rectangle, 
 an ellipse, a convex hull of points, or an arbitrary shape.
 
-You can install the development version of ggmagnify from [GitHub](https://github.com/) with:
+You can install ggmagnify from r-universe:
 
 ``` r
-# install.packages("remotes")
-remotes::install_github("hughjonesd/ggmagnify")
+install.packages("ggmagnify", repos = c("https://hughjonesd.r-universe.dev", 
+                 "https://cloud.r-project.org"))
 ```
 
-Alternatively, install ggmagnify from r-universe:
+This will install the latest github release (currently `r latest`).
+
+Or install the development version from [GitHub](https://github.com/) with:
 
 ``` r
-install.packages("ggmagnify", repos = c("https://hughjonesd.r-universe.dev", 
-                 "https://cloud.r-project.org"))
+# install.packages("remotes")
+remotes::install_github("hughjonesd/ggmagnify")
 ```
 
-This will install the latest github release (currently `r latest`).
 
 ## Basic inset
 
 To create an inset, use `geom_magnify(from, to)`. `from` can
-be a list giving the four corners of the area to magnify:
-`from = c(xmin, xmax, ymin, ymax)`. Optionally you can use the names
-`xmin`, etc.
+be a vector giving the four corners of the area to magnify:
+`from = c(xmin, xmax, ymin, ymax)`.
 
 Similarly, `to` specifies where the magnified inset should go: `to = c(xmin, xmax, ymin, ymax)`.
 
@@ -72,7 +72,7 @@ ggp <- ggplot(dv, aes(Position, NegLogP)) +
 
 from <- c(xmin = 9.75e7, xmax = 9.95e7, ymin = 16, ymax = 28)
 # Names xmin, xmax, ymin, ymax are optional:
-to <- c(2e08 - 2e7, 2e08 + 2e7,10, 26)
+to <- c(2e8 - 2e7, 2e8 + 2e7,10, 26)
 
 ggp + geom_magnify(from = from, to = to)
 ```
@@ -88,6 +88,15 @@ ggp + geom_magnify(from = from, to = to,
                    shadow = TRUE)
 ```
 
+## Rounded corners
+
+New in version 0.3.0, use `corners` to give a proportional radius for rounded
+corners.
+
+```{r example-corners}
+ggp + geom_magnify(from = from, to = to, 
+                   corners = 0.1, shadow = TRUE)
+```
 
 ## Ellipse