Arbitrary positions for guides

R/guide-bins.R

@@ -100,6 +100,7 @@ guide_bins <- function(
   ticks.length = unit(0.2, "npc"),
 
   # general
+  position     = NULL,
   direction    = NULL,
   default.unit = "line",
   override.aes = list(),
@@ -121,6 +122,9 @@ guide_bins <- function(
   if (!is.null(title.position)) {
     title.position <- arg_match0(title.position, .trbl)
   }
+  if (!is.null(position)) {
+    position <- arg_match0(position, c(.trbl, "inside"))
+  }
   if (!is.null(direction)) {
     direction <- arg_match0(direction, c("horizontal", "vertical"))
   }
@@ -169,6 +173,7 @@ guide_bins <- function(
     ticks_length = ticks.length,
 
     # general
+    position = position,
     direction = direction,
     override.aes = rename_aes(override.aes),
     reverse = reverse,

R/guide-colorbar.R

@@ -151,6 +151,7 @@ guide_colourbar <- function(
   draw.llim = TRUE,
 
   # general
+  position = NULL,
   direction = NULL,
   default.unit = "line",
   reverse = FALSE,
@@ -171,6 +172,9 @@ guide_colourbar <- function(
   if (!is.null(title.position)) {
     title.position <- arg_match0(title.position, .trbl)
   }
+  if (!is.null(position)) {
+    position <- arg_match0(position, c(.trbl, "inside"))
+  }
   if (!is.null(direction)) {
     direction <- arg_match0(direction, c("horizontal", "vertical"))
   }
@@ -240,6 +244,7 @@ guide_colourbar <- function(
     draw_lim = c(isTRUE(draw.llim), isTRUE(draw.ulim)),
 
     # general
+    position = position,
     direction = direction,
     reverse = reverse,
     order = order,

R/guide-legend.R

@@ -46,6 +46,8 @@
 #'   object specifying the distance between key-label pairs in the horizontal
 #'   direction (`key.spacing.x`), vertical direction (`key.spacing.y`) or both
 #'   (`key.spacing`).
+#' @param position A character string indicating where the legend should be
+#'   placed relative to the plot panels.
 #' @param direction  A character string indicating the direction of the guide.
 #'   One of "horizontal" or "vertical."
 #' @param default.unit A character string indicating [grid::unit()]
@@ -152,6 +154,7 @@ guide_legend <- function(
   key.spacing.y = NULL,
 
   # General
+  position     = NULL,
   direction    = NULL,
   default.unit = "line",
   override.aes = list(),
@@ -187,6 +190,9 @@ guide_legend <- function(
   if (!is.null(label.position)) {
     label.position <- arg_match0(label.position, .trbl)
   }
+  if (!is.null(position)) {
+    position <- arg_match0(position, c(.trbl, "inside"))
+  }
 
   new_guide(
     # Title
@@ -217,6 +223,7 @@ guide_legend <- function(
     byrow = byrow,
     reverse = reverse,
     order = order,
+    position = position,
 
     # Fixed parameters
     available_aes = "any",

R/guides-.R

@@ -250,8 +250,8 @@ Guides <- ggproto(
 
   ## Building ------------------------------------------------------------------
 
-  # The `Guides$build()` method is called in ggplotGrob (plot-build.R) and makes
-  # the guide box for *non-position* scales.
+  # The `Guides$build()` method is called in ggplot_build (plot-build.R) and
+  # collects all information needed from the plot.
   # Note that position scales are handled in `Coord`s, which have their own
   # procedures to do equivalent steps.
   #
@@ -271,12 +271,7 @@ Guides <- ggproto(
   # 3. Guides$process_layers()
   #      process layer information and generate geom info.
   #
-  # 4. Guides$draw()
-  #      generate guide grob from each guide object
-  #      one guide grob for one guide object
-  #
-  # 5. Guides$assemble()
-  #      arrange all guide grobs
+  # The resulting guide is then drawn in ggplot_gtable
 
   build = function(self, scales, layers, labels, layer_data) {
 
@@ -458,49 +453,96 @@ Guides <- ggproto(
     invisible()
   },
 
-  # Loop over every guide, let them draw their grobs
-  draw = function(self, theme, position, direction) {
-    Map(
-      function(guide, params) guide$draw(theme, position, direction, params),
-      guide  = self$guides,
-      params = self$params
-    )
-  },
-
+  # The `Guides$assemble()` method is called in ggplot_gtable (plot-build.R) and
+  # applies the styling from the theme to render each guide and package them
+  # into guide boxes.
+  #
+  # The procedure is as follows
+  #
+  # 1. Guides$draw()
+  #      for every guide object, draw one grob,
+  #      then group the grobs in a list per position
+  #
+  # 2. Guides$package_box()
+  #      for every position, collect all individual guides and arrange them
+  #      into a guide box which will be inserted into the main gtable
   # Combining multiple guides in a guide box
-  assemble = function(self, theme, position) {
+  assemble = function(self, theme) {
 
     if (length(self$guides) < 1) {
       return(zeroGrob())
     }
 
-    position  <- legend_position(position)
-    if (position == "none") {
+    default_position <- theme$legend.position %||% "right"
+    if (length(default_position) == 2) {
+      default_position <- "inside"
+    }
+    if (default_position == "none") {
       return(zeroGrob())
     }
-    default_direction <- if (position == "inside") "vertical" else position
 
     theme$legend.key.width  <- theme$legend.key.width  %||% theme$legend.key.size
     theme$legend.key.height <- theme$legend.key.height %||% theme$legend.key.size
-    theme$legend.box       <- theme$legend.box       %||% default_direction
-    theme$legend.direction <- theme$legend.direction %||% default_direction
-    theme$legend.box.just  <- theme$legend.box.just  %||% switch(
-      position,
-      inside     = c("center", "center"),
-      vertical   = c("left",   "top"),
-      horizontal = c("center", "top")
-    )
 
-    grobs <- self$draw(theme, position, default_direction)
-    if (length(grobs) < 1) {
-      return(zeroGrob())
-    }
+    grobs <- self$draw(theme, default_position)
 
     # Set spacing
     theme$legend.spacing   <- theme$legend.spacing    %||% unit(0.5, "lines")
     theme$legend.spacing.y <- theme$legend.spacing.y  %||% theme$legend.spacing
     theme$legend.spacing.x <- theme$legend.spacing.x  %||% theme$legend.spacing
 
+    Map(
+      grobs    = grobs,
+      position = names(grobs),
+      self$package_box,
+      MoreArgs = list(theme = theme)
+    )
+  },
+
+  # Render the guides into grobs
+  draw = function(self, theme, default_position = "right",
+                  params = self$params, guides = self$guides) {
+    positions <- vapply(
+      params, function(p) p$position[1] %||% default_position, character(1)
+    )
+    positions <- factor(positions, levels = c(.trbl, "inside"))
+
+    theme$legend.key.width  <- theme$legend.key.width  %||% theme$legend.key.size
+    theme$legend.key.height <- theme$legend.key.height %||% theme$legend.key.size
+
+    directions <- rep("vertical", length(positions))
+    directions[positions %in% c("top", "bottom")] <- "horizontal"
+
+    grobs <- vector("list", length(guides))
+    for (i in seq_along(grobs)) {
+      grobs[[i]] <- guides[[i]]$draw(
+        theme = theme, position = as.character(positions[i]),
+        direction = directions[i], params = params[[i]]
+      )
+    }
+    split(grobs, positions)
+  },
+
+  package_box = function(grobs, position, theme) {
+
+    if (is.zero(grobs) || length(grobs) == 0) {
+      return(zeroGrob())
+    }
+
+    direction <- switch(
+      position,
+      inside = , left = , right = "vertical",
+      top = , bottom = "horizontal"
+    )
+
+    theme$legend.box       <- theme$legend.box       %||% direction
+    theme$legend.direction <- theme$legend.direction %||% direction
+    theme$legend.box.just  <- theme$legend.box.just  %||% switch(
+      direction,
+      vertical   = c("left", "top"),
+      horizontal = c("center", "top")
+    )
+
     # Measure guides
     widths  <- lapply(grobs, function(g) sum(g$widths))
     widths  <- inject(unit.c(!!!widths))