Fix #240

NEWS.md

@@ -13,6 +13,9 @@
 * Fix a bug in `geom_autohistogram()` that prevented it to be used with 
   continuous data (#297)
 * `facet_zoom()` now throws a better error when used with `coord_flip()` (#143)
+* You can now use `"inherit"`, `"inherit_fill"`, and `"inherit_col"` for the 
+  styling of the label box and connector in the `geom_mark_*()` family of geoms 
+  (#240)
 
 # ggforce 0.4.1
 

R/mark_circle.R

@@ -72,18 +72,24 @@
 #' @param label.hjust The horizontal justification for the annotation. If it
 #' contains two elements the first will be used for the label and the second for
 #' the description.
-#' @param label.fill The fill colour for the annotation box.
+#' @param label.fill The fill colour for the annotation box. Use `"inherit"` to
+#' use the fill from the enclosure or `"inherit_col"` to use the border colour
+#' of the enclosure.
 #' @param label.colour The text colour for the annotation. If it contains
 #' two elements the first will be used for the label and the second for the
-#' description.
+#' description. Use `"inherit"` to use the border colour of the enclosure or
+#' `"inherit_fill"` to use the fill colour from the enclosure.
 #' @param label.buffer The size of the region around the mark where labels
 #' cannot be placed.
 #' @param con.colour The colour for the line connecting the annotation to the
-#' mark.
-#' @param con.size The width of the connector.
+#' mark. Use `"inherit"` to use the border colour of the enclosure or
+#' `"inherit_fill"` to use the fill colour from the enclosure.
+#' @param con.size The width of the connector. Use `"inherit"` to use the border
+#' width of the enclosure.
 #' @param con.type The type of the connector. Either `"elbow"`, `"straight"`, or
 #' `"none"`.
-#' @param con.linetype The linetype of the connector.
+#' @param con.linetype The linetype of the connector. Use `"inherit"` to use the
+#' border linetype of the enclosure.
 #' @param con.border The bordertype of the connector. Either `"one"` (to draw a
 #' line on the horizontal side closest to the mark), `"all"` (to draw a border
 #' on all sides), or `"none"` (not going to explain that one).
@@ -131,6 +137,14 @@
 #'   geom_mark_circle(aes(fill = Species, label = Species),
 #'                    con.cap = 0) +
 #'   geom_point()
+#'
+#' # If you want to use the scaled colours for the labels or connectors you can
+#' # use the "inherit" keyword instead
+#' ggplot(iris, aes(Petal.Length, Petal.Width)) +
+#'   geom_mark_circle(aes(fill = Species, label = Species),
+#'                    label.fill = "inherit") +
+#'   geom_point()
+#'
 NULL
 
 #' @rdname ggforce-extensions
@@ -187,29 +201,42 @@ GeomMarkCircle <- ggproto('GeomMarkCircle', GeomShape,
       }
     }
 
+    gp <- gpar(
+      col = first_rows$colour,
+      fill = alpha(first_rows$fill, first_rows$alpha),
+      lwd = (first_rows$linewidth %||% first_rows$size) * .pt,
+      lty = first_rows$linetype,
+      fontsize = (first_rows$size %||% 4.217518) * .pt
+    )
+
     circEncGrob(coords$x, coords$y,
       default.units = 'native',
       id = coords$group, expand = expand, radius = radius, n = n,
       label = label, ghosts = ghosts,
-      mark.gp = gpar(
-        col = first_rows$colour,
-        fill = alpha(first_rows$fill, first_rows$alpha),
-        lwd = (first_rows$linewidth %||% first_rows$size) * .pt,
-        lty = first_rows$linetype
-      ),
-      label.gp = gpar(
-        col = label.colour,
+      mark.gp = gp,
+      label.gp = inherit_gp(
+        col = label.colour[1],
         fill = label.fill,
-        fontface = label.fontface,
-        fontfamily = label.family,
-        fontsize = label.fontsize,
-        lineheight = label.lineheight
+        fontface = label.fontface[1],
+        fontfamily = label.family[1],
+        fontsize = label.fontsize[1],
+        lineheight = label.lineheight[1],
+        gp = gp
+      ),
+      desc.gp = inherit_gp(
+        col = rep_len(label.colour, 2)[2],
+        fontface = rep_len(label.fontface, 2)[2],
+        fontfamily = rep_len(label.family, 2)[2],
+        fontsize = rep_len(label.fontsize, 2)[2],
+        lineheight = rep_len(label.lineheight, 2)[2],
+        gp = gp
       ),
-      con.gp = gpar(
+      con.gp = inherit_gp(
         col = con.colour,
         fill = con.colour,
-        lwd = con.size * .pt,
-        lty = con.linetype
+        lwd = if (is.numeric(con.size)) con.size * .pt else con.size,
+        lty = con.linetype,
+        gp = gp
       ),
       label.margin = label.margin,
       label.width = label.width,
@@ -297,7 +324,7 @@ geom_mark_circle <- function(mapping = NULL, data = NULL, stat = 'identity',
 circEncGrob <- function(x = c(0, 0.5, 1, 0.5), y = c(0.5, 1, 0.5, 0), id = NULL,
                         id.lengths = NULL, expand = 0, radius = 0, n = 100,
                         label = NULL, ghosts = NULL, default.units = 'npc',
-                        name = NULL, mark.gp = gpar(), label.gp = gpar(),
+                        name = NULL, mark.gp = gpar(), label.gp = gpar(), desc.gp = gpar(),
                         con.gp = gpar(), label.margin = margin(),
                         label.width = NULL, label.minwidth = unit(50, 'mm'),
                         label.hjust = 0, label.buffer = unit(10, 'mm'),
@@ -335,10 +362,12 @@ circEncGrob <- function(x = c(0, 0.5, 1, 0.5), y = c(0.5, 1, 0.5, 0), id = NULL,
     label <- lapply(seq_len(nrow(label)), function(i) {
       if (is.na(label$label[i] %||% NA) && is.na(label$description[i] %||% NA)) return(zeroGrob())
       grob <- labelboxGrob(label$label[i], 0, 0, label$description[i],
-        gp = label.gp, pad = label.margin, width = label.width,
+        gp = subset_gp(label.gp, i), desc.gp = subset_gp(desc.gp, i),
+        pad = label.margin, width = label.width,
         min.width = label.minwidth, hjust = label.hjust
       )
       if (con.border == 'all') {
+        con.gp <- subset_gp(con.gp, i)
         grob$children[[1]]$gp$col <- con.gp$col
         grob$children[[1]]$gp$lwd <- con.gp$lwd
         grob$children[[1]]$gp$lty <- con.gp$lty

R/mark_ellipse.R

@@ -75,6 +75,13 @@
 #'   geom_mark_ellipse(aes(fill = Species, label = Species),
 #'                     con.cap = 0) +
 #'   geom_point()
+#'
+#' # If you want to use the scaled colours for the labels or connectors you can
+#' # use the "inherit" keyword instead
+#' ggplot(iris, aes(Petal.Length, Petal.Width)) +
+#'   geom_mark_ellipse(aes(fill = Species, label = Species),
+#'                     label.fill = "inherit") +
+#'   geom_point()
 NULL
 
 #' @rdname ggforce-extensions
@@ -123,29 +130,42 @@ GeomMarkEllipse <- ggproto('GeomMarkEllipse', GeomMarkCircle,
       }
     }
 
+    gp <- gpar(
+      col = first_rows$colour,
+      fill = alpha(first_rows$fill, first_rows$alpha),
+      lwd = (first_rows$linewidth %||% first_rows$size) * .pt,
+      lty = first_rows$linetype,
+      fontsize = (first_rows$size %||% 4.217518) * .pt
+    )
+
     ellipEncGrob(coords$x, coords$y,
       default.units = 'native',
       id = coords$group, expand = expand, radius = radius, n = n,
       tol = tol, label = label, ghosts = ghosts,
-      mark.gp = gpar(
-        col = first_rows$colour,
-        fill = alpha(first_rows$fill, first_rows$alpha),
-        lwd = (first_rows$linewidth %||% first_rows$size) * .pt,
-        lty = first_rows$linetype
-      ),
-      label.gp = gpar(
-        col = label.colour,
+      mark.gp = gp,
+      label.gp = inherit_gp(
+        col = label.colour[1],
         fill = label.fill,
-        fontface = label.fontface,
-        fontfamily = label.family,
-        fontsize = label.fontsize,
-        lineheight = label.lineheight
+        fontface = label.fontface[1],
+        fontfamily = label.family[1],
+        fontsize = label.fontsize[1],
+        lineheight = label.lineheight[1],
+        gp = gp
+      ),
+      desc.gp = inherit_gp(
+        col = rep_len(label.colour, 2)[2],
+        fontface = rep_len(label.fontface, 2)[2],
+        fontfamily = rep_len(label.family, 2)[2],
+        fontsize = rep_len(label.fontsize, 2)[2],
+        lineheight = rep_len(label.lineheight, 2)[2],
+        gp = gp
       ),
-      con.gp = gpar(
+      con.gp = inherit_gp(
         col = con.colour,
         fill = con.colour,
-        lwd = con.size * .pt,
-        lty = con.linetype
+        lwd = if (is.numeric(con.size)) con.size * .pt else con.size,
+        lty = con.linetype,
+        gp = gp
       ),
       label.margin = label.margin,
       label.width = label.width,
@@ -225,7 +245,7 @@ ellipEncGrob <- function(x = c(0, 0.5, 1, 0.5), y = c(0.5, 1, 0.5, 0), id = NULL
                          id.lengths = NULL, expand = 0, radius = 0, n = 100,
                          tol = 0.01, label = NULL, ghosts = NULL,
                          default.units = 'npc', name = NULL, mark.gp = gpar(),
-                         label.gp = gpar(), con.gp = gpar(),
+                         label.gp = gpar(), desc.gp = gpar(), con.gp = gpar(),
                          label.margin = margin(), label.width = NULL,
                          label.minwidth = unit(50, 'mm'), label.hjust = 0,
                          label.buffer = unit(10, 'mm'), con.type = 'elbow',
@@ -263,10 +283,12 @@ ellipEncGrob <- function(x = c(0, 0.5, 1, 0.5), y = c(0.5, 1, 0.5, 0), id = NULL
     label <- lapply(seq_len(nrow(label)), function(i) {
       if (is.na(label$label[i] %||% NA) && is.na(label$description[i] %||% NA)) return(zeroGrob())
       grob <- labelboxGrob(label$label[i], 0, 0, label$description[i],
-        gp = label.gp, pad = label.margin, width = label.width,
+        gp = subset_gp(label.gp, i), desc.gp = subset_gp(desc.gp, i),
+        pad = label.margin, width = label.width,
         min.width = label.minwidth, hjust = label.hjust
       )
       if (con.border == 'all') {
+        con.gp <- subset_gp(con.gp, i)
         grob$children[[1]]$gp$col <- con.gp$col
         grob$children[[1]]$gp$lwd <- con.gp$lwd
         grob$children[[1]]$gp$lty <- con.gp$lty

R/mark_hull.R

@@ -86,6 +86,14 @@
 #'   geom_mark_hull(aes(fill = Species, label = Species),
 #'                  con.cap = 0) +
 #'   geom_point()
+#'
+#' # If you want to use the scaled colours for the labels or connectors you can
+#' # use the "inherit" keyword instead
+#' ggplot(iris, aes(Petal.Length, Petal.Width)) +
+#'   geom_mark_hull(aes(fill = Species, label = Species),
+#'                  label.fill = "inherit") +
+#'   geom_point()
+#'
 NULL
 
 #' @rdname ggforce-extensions
@@ -134,30 +142,42 @@ GeomMarkHull <- ggproto('GeomMarkHull', GeomMarkCircle,
       }
     }
 
+    gp <- gpar(
+      col = first_rows$colour,
+      fill = alpha(first_rows$fill, first_rows$alpha),
+      lwd = (first_rows$linewidth %||% first_rows$size) * .pt,
+      lty = first_rows$linetype,
+      fontsize = (first_rows$size %||% 4.217518) * .pt
+    )
 
     hullEncGrob(coords$x, coords$y,
       default.units = 'native',
       id = coords$group, expand = expand, radius = radius,
       concavity = concavity, label = label, ghosts = ghosts,
-      mark.gp = gpar(
-        col = first_rows$colour,
-        fill = alpha(first_rows$fill, first_rows$alpha),
-        lwd = (first_rows$linewidth %||% first_rows$size) * .pt,
-        lty = first_rows$linetype
-      ),
-      label.gp = gpar(
-        col = label.colour,
+      mark.gp = gp,
+      label.gp = inherit_gp(
+        col = label.colour[1],
         fill = label.fill,
-        fontface = label.fontface,
-        fontfamily = label.family,
-        fontsize = label.fontsize,
-        lineheight = label.lineheight
+        fontface = label.fontface[1],
+        fontfamily = label.family[1],
+        fontsize = label.fontsize[1],
+        lineheight = label.lineheight[1],
+        gp = gp
+      ),
+      desc.gp = inherit_gp(
+        col = rep_len(label.colour, 2)[2],
+        fontface = rep_len(label.fontface, 2)[2],
+        fontfamily = rep_len(label.family, 2)[2],
+        fontsize = rep_len(label.fontsize, 2)[2],
+        lineheight = rep_len(label.lineheight, 2)[2],
+        gp = gp
       ),
-      con.gp = gpar(
+      con.gp = inherit_gp(
         col = con.colour,
         fill = con.colour,
-        lwd = con.size * .pt,
-        lty = con.linetype
+        lwd = if (is.numeric(con.size)) con.size * .pt else con.size,
+        lty = con.linetype,
+        gp = gp
       ),
       label.margin = label.margin,
       label.width = label.width,
@@ -232,7 +252,7 @@ hullEncGrob <- function(x = c(0, 0.5, 1, 0.5), y = c(0.5, 1, 0.5, 0), id = NULL,
                         id.lengths = NULL, expand = 0, radius = 0, concavity = 2,
                         label = NULL, ghosts = NULL, default.units = 'npc',
                         name = NULL, mark.gp = gpar(), label.gp = gpar(),
-                        con.gp = gpar(), label.margin = margin(),
+                        desc.gp = gpar(), con.gp = gpar(), label.margin = margin(),
                         label.width = NULL, label.minwidth = unit(50, 'mm'),
                         label.hjust = 0, label.buffer = unit(10, 'mm'),
                         con.type = 'elbow', con.border = 'one',
@@ -248,10 +268,12 @@ hullEncGrob <- function(x = c(0, 0.5, 1, 0.5), y = c(0.5, 1, 0.5, 0), id = NULL,
     label <- lapply(seq_len(nrow(label)), function(i) {
       if (is.na(label$label[i] %||% NA) && is.na(label$description[i] %||% NA)) return(zeroGrob())
       grob <- labelboxGrob(label$label[i], 0, 0, label$description[i],
-        gp = label.gp, pad = label.margin, width = label.width,
+        gp = subset_gp(label.gp, i), desc.gp = subset_gp(desc.gp, i),
+        pad = label.margin, width = label.width,
         min.width = label.minwidth, hjust = label.hjust
       )
       if (con.border == 'all') {
+        con.gp <- subset_gp(con.gp, i)
         grob$children[[1]]$gp$col <- con.gp$col
         grob$children[[1]]$gp$lwd <- con.gp$lwd
         grob$children[[1]]$gp$lty <- con.gp$lty