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-custom.R

@@ -43,7 +43,7 @@
 guide_custom <- function(
  grob, width = grobWidth(grob), height = grobHeight(grob),
  title = NULL, title.position = "top", margin = NULL,
- position = waiver(), order = 0
+ position = NULL, order = 0
 ) {
  check_object(grob, is.grob, "a {.cls grob} object")
  check_object(width, is.unit, "a {.cls unit} object")

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

@@ -262,8 +262,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.
  #
@@ -283,12 +283,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) {
 
@@ -476,104 +471,201 @@ 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")
- )
+ # Populate key sizes
+ theme$legend.key.width <- calc_element("legend.key.width", theme)
+ theme$legend.key.height <- calc_element("legend.key.height", theme)
 
- grobs <- self$draw(theme, position, theme$legend.direction)
+ grobs <- self$draw(theme, default_position, theme$legend.direction)
  if (length(grobs) < 1) {
  return(zeroGrob())
  }
  grobs <- grobs[order(names(grobs))]
 
  # 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
+ theme$legend.spacing <- theme$legend.spacing %||% unit(0.5, "lines")
+ theme$legend.spacing.y <- calc_element("legend.spacing.y", theme)
+ theme$legend.spacing.x <- calc_element("legend.spacing.x", theme)
+
+ 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",
+ direction = NULL,
+ 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"))
+
+ directions <- rep(direction %||% "vertical", length(positions))
+ if (is.null(direction)) {
+ 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())
+ }
+
+ # Determine default direction
+ direction <- switch(
+ position,
+ inside = , left = , right = "vertical",
+ top = , bottom = "horizontal"
+ )
+
+ # Populate missing theme arguments
+ theme$legend.box <- theme$legend.box %||% 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))
  heights <- lapply(grobs, function(g) sum(g$heights))
  heights <- inject(unit.c(!!!heights))
 
+ # Global justification of the complete legend box
+ global_just <- paste0("legend.justification.", position)
+ global_just <- valid.just(calc_element(global_just, theme))
+
+ if (position == "inside") {
+ # The position of inside legends are set by their justification
+ inside_position <- theme$legend.position.inside %||% global_just
+ global_xjust <- inside_position[1]
+ global_yjust <- inside_position[2]
+ global_margin <- margin()
+ } else {
+ global_xjust <- global_just[1]
+ global_yjust <- global_just[2]
+ # Legends to the side of the plot need a margin for justification
+ # relative to the plot panel
+ global_margin <- margin(
+ t = 1 - global_yjust, b = global_yjust,
+ r = 1 - global_xjust, l = global_xjust,
+ unit = "null"
+ )
+ }
+
  # Set the justification of each legend within the legend box
  # First value is xjust, second value is yjust
- just <- valid.just(theme$legend.box.just)
- xjust <- just[1]
- yjust <- just[2]
+ box_just  <- valid.just(theme$legend.box.just)
+ box_xjust <- box_just[1]
+ box_yjust <- box_just[2]
 
  # setting that is different for vertical and horizontal guide-boxes.
  if (identical(theme$legend.box, "horizontal")) {
- # Set justification for each legend
+ # Set justification for each legend within the box
  for (i in seq_along(grobs)) {
  grobs[[i]] <- editGrob(
  grobs[[i]],
- vp = viewport(x = xjust, y = yjust, just = c(xjust, yjust),
+ vp = viewport(x = box_xjust, y = box_yjust, just = box_just,
  height = heightDetails(grobs[[i]]))
  )
  }
+ spacing <- theme$legend.spacing.x
+
+ # Set global justification
+ vp <- viewport(
+ x = global_xjust, y = global_yjust, just = global_just,
+ height = max(heights),
+ width = sum(widths, spacing * (length(grobs) - 1L))
+ )
 
- guides <- gtable_row(name = "guides",
- grobs = grobs,
- widths = widths, height = max(heights))
+ # Initialise gtable as legends in a row
+ guides <- gtable_row(
+ name = "guides", grobs = grobs,
+ widths = widths, height = max(heights),
+ vp = vp
+ )
 
- # add space between the guide-boxes
- guides <- gtable_add_col_space(guides, theme$legend.spacing.x)
+ # Add space between the guide-boxes
+ guides <- gtable_add_col_space(guides, spacing)
 
  } else { # theme$legend.box == "vertical"
- # Set justification for each legend
+ # Set justification for each legend within the box
  for (i in seq_along(grobs)) {
  grobs[[i]] <- editGrob(
  grobs[[i]],
- vp = viewport(x = xjust, y = yjust, just = c(xjust, yjust),
+ vp = viewport(x = box_xjust, y = box_yjust, just = box_just,
  width = widthDetails(grobs[[i]]))
  )
  }
+ spacing <- theme$legend.spacing.y
+
+ # Set global justification
+ vp <- viewport(
+ x = global_xjust, y = global_yjust, just = global_just,
+ height = sum(heights, spacing * (length(grobs) - 1L)),
+ width = max(widths)
+ )
 
- guides <- gtable_col(name = "guides",
- grobs = grobs,
- width = max(widths), heights = heights)
+ # Initialise gtable as legends in a column
+ guides <- gtable_col(
+ name = "guides", grobs = grobs,
+ width = max(widths), heights = heights,
+ vp = vp
+ )
 
- # add space between the guide-boxes
- guides <- gtable_add_row_space(guides, theme$legend.spacing.y)
+ # Add space between the guide-boxes
+ guides <- gtable_add_row_space(guides, spacing)
  }
 
  # Add margins around the guide-boxes.
  margin <- theme$legend.box.margin %||% margin()
- guides <- gtable_add_cols(guides, margin[4], pos = 0)
- guides <- gtable_add_cols(guides, margin[2], pos = ncol(guides))
- guides <- gtable_add_rows(guides, margin[1], pos = 0)
- guides <- gtable_add_rows(guides, margin[3], pos = nrow(guides))
+ guides <- gtable_add_padding(guides, margin)
 
  # Add legend box background
  background <- element_grob(theme$legend.box.background %||% element_blank())
@@ -584,6 +676,10 @@ Guides <- ggproto(
  z = -Inf, clip = "off",
  name = "legend.box.background"
  )
+
+ # Set global margin
+ guides <- gtable_add_padding(guides, global_margin)
+
  guides$name <- "guide-box"
  guides
  },