diff --git a/R/guide-bins.R b/R/guide-bins.R index 77ea847b53..b2b0bb9d56 100644 --- a/R/guide-bins.R +++ b/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, diff --git a/R/guide-colorbar.R b/R/guide-colorbar.R index 6e2206a26e..374f8ac92e 100644 --- a/R/guide-colorbar.R +++ b/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, diff --git a/R/guide-custom.R b/R/guide-custom.R index 3ea4fc3ffe..bca9e0214d 100644 --- a/R/guide-custom.R +++ b/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") diff --git a/R/guide-legend.R b/R/guide-legend.R index 056ca8f68b..910ef12cc3 100644 --- a/R/guide-legend.R +++ b/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", diff --git a/R/guides-.R b/R/guides-.R index ee1ddb2477..c44fc06907 100644 --- a/R/guides-.R +++ b/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,49 +471,105 @@ 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)) @@ -526,54 +577,95 @@ Guides <- ggproto( 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 }, diff --git a/R/plot-build.R b/R/plot-build.R index cf3ff3fdcd..2a46b31514 100644 --- a/R/plot-build.R +++ b/R/plot-build.R @@ -182,91 +182,8 @@ ggplot_gtable.ggplot_built <- function(data) { plot_table <- layout$render(geom_grobs, data, theme, plot$labels) # Legends - position <- theme$legend.position %||% "right" - if (length(position) == 2) { - position <- "manual" - } - - legend_box <- plot$guides$assemble(theme, position) - - if (is.zero(legend_box)) { - position <- "none" - } else { - # these are a bad hack, since it modifies the contents of viewpoint directly... - legend_width <- gtable_width(legend_box) - legend_height <- gtable_height(legend_box) - - # Set the justification of the legend box - # First value is xjust, second value is yjust - just <- valid.just(theme$legend.justification) - xjust <- just[1] - yjust <- just[2] - - if (position == "manual") { - xpos <- theme$legend.position[1] - ypos <- theme$legend.position[2] - - # x and y are specified via theme$legend.position (i.e., coords) - legend_box <- editGrob( - legend_box, - vp = viewport( - x = xpos, - y = ypos, - just = c(xjust, yjust), - height = legend_height, - width = legend_width - ) - ) - } else { - # x and y are adjusted using justification of legend box (i.e., theme$legend.justification) - legend_box <- editGrob( - legend_box, - vp = viewport( - x = xjust, - y = yjust, - just = c(xjust, yjust), - height = legend_height, - width = legend_width - ) - ) - legend_box <- gtable_add_rows(legend_box, unit(yjust, 'null')) - legend_box <- gtable_add_rows(legend_box, unit(1 - yjust, 'null'), 0) - legend_box <- gtable_add_cols(legend_box, unit(xjust, 'null'), 0) - legend_box <- gtable_add_cols(legend_box, unit(1 - xjust, 'null')) - } - } - - panel_dim <- find_panel(plot_table) - # for align-to-device, use this: - # panel_dim <- summarise(plot_table$layout, t = min(t), r = max(r), b = max(b), l = min(l)) - - theme$legend.box.spacing <- theme$legend.box.spacing %||% unit(0.2, 'cm') - if (position == "left") { - plot_table <- gtable_add_cols(plot_table, theme$legend.box.spacing, pos = 0) - plot_table <- gtable_add_cols(plot_table, legend_width, pos = 0) - plot_table <- gtable_add_grob(plot_table, legend_box, clip = "off", - t = panel_dim$t, b = panel_dim$b, l = 1, r = 1, name = "guide-box") - } else if (position == "right") { - plot_table <- gtable_add_cols(plot_table, theme$legend.box.spacing, pos = -1) - plot_table <- gtable_add_cols(plot_table, legend_width, pos = -1) - plot_table <- gtable_add_grob(plot_table, legend_box, clip = "off", - t = panel_dim$t, b = panel_dim$b, l = -1, r = -1, name = "guide-box") - } else if (position == "bottom") { - plot_table <- gtable_add_rows(plot_table, theme$legend.box.spacing, pos = -1) - plot_table <- gtable_add_rows(plot_table, legend_height, pos = -1) - plot_table <- gtable_add_grob(plot_table, legend_box, clip = "off", - t = -1, b = -1, l = panel_dim$l, r = panel_dim$r, name = "guide-box") - } else if (position == "top") { - plot_table <- gtable_add_rows(plot_table, theme$legend.box.spacing, pos = 0) - plot_table <- gtable_add_rows(plot_table, legend_height, pos = 0) - plot_table <- gtable_add_grob(plot_table, legend_box, clip = "off", - t = 1, b = 1, l = panel_dim$l, r = panel_dim$r, name = "guide-box") - } else if (position == "manual") { - # should guide box expand whole region or region without margin? - plot_table <- gtable_add_grob(plot_table, legend_box, - t = panel_dim$t, b = panel_dim$b, l = panel_dim$l, r = panel_dim$r, - clip = "off", name = "guide-box") - } + legend_box <- plot$guides$assemble(theme) + plot_table <- table_add_legends(plot_table, legend_box, theme) # Title title <- element_render( @@ -502,3 +419,94 @@ table_add_tag <- function(table, label, theme) { t = place$t, l = place$l, b = place$b, r = place$r ) } + +# Add the legends to the gtable +table_add_legends <- function(table, legends, theme) { + + if (is.zero(legends)) { + legends <- rep(list(zeroGrob()), 5) + names(legends) <- c(.trbl, "inside") + } + + # Extract sizes + widths <- heights <- set_names( + rep(list(unit(0, "cm")), length(legends)), + names(legends) + ) + + empty <- vapply(legends, is.zero, logical(1)) + widths[!empty] <- lapply(legends[!empty], gtable_width) + heights[!empty] <- lapply(legends[!empty], gtable_height) + spacing <- theme$legend.box.spacing %||% unit(0.2, "cm") + + # If legend is missing, set spacing to zero for that legend + zero <- unit(0, "pt") + spacing <- lapply(empty, function(is_empty) if (is_empty) zero else spacing) + + location <- switch( + theme$legend.location %||% "panel", + "plot" = plot_extent, + find_panel + ) + + place <- location(table) + + # Add right legend + table <- gtable_add_cols(table, spacing$right, pos = -1) + table <- gtable_add_cols(table, widths$right, pos = -1) + table <- gtable_add_grob( + table, legends$right, clip = "off", + t = place$t, b = place$b, l = -1, r = -1, + name = "guide-box-right" + ) + + # Add left legend + table <- gtable_add_cols(table, spacing$left, pos = 0) + table <- gtable_add_cols(table, widths$left, pos = 0) + table <- gtable_add_grob( + table, legends$left, clip = "off", + t = place$t, b = place$b, l = 1, r = 1, + name = "guide-box-left" + ) + + place <- location(table) + + # Add bottom legend + table <- gtable_add_rows(table, spacing$bottom, pos = -1) + table <- gtable_add_rows(table, heights$bottom, pos = -1) + table <- gtable_add_grob( + table, legends$bottom, clip = "off", + t = -1, b = -1, l = place$l, r = place$r, + name = "guide-box-bottom" + ) + + # Add top legend + table <- gtable_add_rows(table, spacing$top, pos = 0) + table <- gtable_add_rows(table, heights$top, pos = 0) + table <- gtable_add_grob( + table, legends$top, clip = "off", + t = 1, b = 1, l = place$l, r = place$r, + name = "guide-box-top" + ) + + # Add manual legend + place <- find_panel(table) + table <- gtable_add_grob( + table, legends$inside, clip = "off", + t = place$t, b = place$b, l = place$l, r = place$r, + name = "guide-box-inside" + ) + + table +} + +plot_extent <- function(table) { + layout <- table$layout + data_frame0( + t = min(layout[["t"]]), + r = max(layout[["r"]]), + b = max(layout[["b"]]), + l = min(layout[["l"]]), + .size = 1L + ) +} diff --git a/R/theme-elements.R b/R/theme-elements.R index d671ec2900..448aa4763a 100644 --- a/R/theme-elements.R +++ b/R/theme-elements.R @@ -502,9 +502,34 @@ el_def <- function(class = NULL, inherit = NULL, description = NULL) { legend.key.width = el_def(c("unit", "rel"), "legend.key.size"), legend.text = el_def("element_text", "text"), legend.title = el_def("element_text", "title"), - legend.position = el_def(c("character", "numeric", "integer")), + legend.position = el_def("character"), + legend.position.inside = el_def(c("numeric", "integer")), legend.direction = el_def("character"), + legend.justification = el_def(c("character", "numeric", "integer")), + legend.justification.top = el_def( + c("character", "numeric", "integer"), + "legend.justification" + ), + legend.justification.bottom = el_def( + c("character", "numeric", "integer"), + "legend.justification" + ), + legend.justification.left = el_def( + c("character", "numeric", "integer"), + "legend.justification" + ), + legend.justification.right = el_def( + c("character", "numeric", "integer"), + "legend.justification" + ), + legend.justification.inside = el_def( + c("character", "numeric", "integer"), + "legend.justification" + ), + + legend.location = el_def("character"), + legend.box = el_def("character"), legend.box.just = el_def("character"), legend.box.margin = el_def("margin"), diff --git a/R/theme.R b/R/theme.R index dda2dcd8c8..6def5d7ab5 100644 --- a/R/theme.R +++ b/R/theme.R @@ -78,13 +78,20 @@ #' `text`) #' @param legend.title title of legend ([element_text()]; inherits from #' `title`) -#' @param legend.position the position of legends ("none", "left", "right", -#' "bottom", "top", or two-element numeric vector) +#' @param legend.position the default position of legends ("none", "left", +#' "right", "bottom", "top", "inside") +#' @param legend.position.inside A numeric vector of length two setting the +#' placement of legends that have the `"inside"` position. #' @param legend.direction layout of items in legends ("horizontal" or #' "vertical") #' @param legend.justification anchor point for positioning legend inside plot #' ("center" or two-element numeric vector) or the justification according to #' the plot area when positioned outside the plot +#' @param legend.justification.top,legend.justification.bottom,legend.justification.left,legend.justification.right,legend.justification.inside +#' Same as `legend.justification` but specified per `legend.position` option. +#' @param legend.location Relative placement of legends outside the plot as a +#' string. Can be `"panel"` (default) to align legends to the panels or +#' `"plot"` to align legends to the plot as a whole. #' @param legend.box arrangement of multiple legends ("horizontal" or #' "vertical") #' @param legend.box.just justification of each legend within the overall @@ -345,8 +352,15 @@ theme <- function(..., legend.text, legend.title, legend.position, + legend.position.inside, legend.direction, legend.justification, + legend.justification.top, + legend.justification.bottom, + legend.justification.left, + legend.justification.right, + legend.justification.inside, + legend.location, legend.box, legend.box.just, legend.box.margin, @@ -455,6 +469,14 @@ theme <- function(..., } elements$legend.text.align <- NULL } + if (is.numeric(elements[["legend.position"]])) { + deprecate_soft0( + "3.5.0", I("A numeric `legend.position` argument in `theme()`"), + "theme(legend.position.inside)" + ) + elements$legend.position.inside <- elements$legend.position + elements$legend.position <- "inside" + } # If complete theme set all non-blank elements to inherit from blanks if (complete) { diff --git a/man/guide_bins.Rd b/man/guide_bins.Rd index 6eeada9598..811037d474 100644 --- a/man/guide_bins.Rd +++ b/man/guide_bins.Rd @@ -23,6 +23,7 @@ guide_bins( axis.arrow = NULL, ticks = NULL, ticks.length = unit(0.2, "npc"), + position = NULL, direction = NULL, default.unit = "line", override.aes = list(), @@ -98,6 +99,9 @@ re-used as \code{ticks} argument (without arrow).} \item{ticks.length}{A numeric or a \code{\link[grid:unit]{grid::unit()}} object specifying the length of tick marks between the keys.} +\item{position}{A character string indicating where the legend should be +placed relative to the plot panels.} + \item{direction}{A character string indicating the direction of the guide. One of "horizontal" or "vertical."} diff --git a/man/guide_colourbar.Rd b/man/guide_colourbar.Rd index 7813c12b1c..8273ec4326 100644 --- a/man/guide_colourbar.Rd +++ b/man/guide_colourbar.Rd @@ -30,6 +30,7 @@ guide_colourbar( ticks.length = unit(0.2, "npc"), draw.ulim = TRUE, draw.llim = TRUE, + position = NULL, direction = NULL, default.unit = "line", reverse = FALSE, @@ -63,6 +64,7 @@ guide_colorbar( ticks.length = unit(0.2, "npc"), draw.ulim = TRUE, draw.llim = TRUE, + position = NULL, direction = NULL, default.unit = "line", reverse = FALSE, @@ -159,6 +161,9 @@ be visible.} \item{draw.llim}{A logical specifying if the lower limit tick marks should be visible.} +\item{position}{A character string indicating where the legend should be +placed relative to the plot panels.} + \item{direction}{A character string indicating the direction of the guide. One of "horizontal" or "vertical."} diff --git a/man/guide_coloursteps.Rd b/man/guide_coloursteps.Rd index e97230b6f4..d77895415e 100644 --- a/man/guide_coloursteps.Rd +++ b/man/guide_coloursteps.Rd @@ -96,6 +96,8 @@ label text. The default for standard text is 0 (left-aligned) and 1 (right-aligned) for expressions.} \item{\code{label.vjust}}{A numeric specifying vertical justification of the label text.} + \item{\code{position}}{A character string indicating where the legend should be +placed relative to the plot panels.} \item{\code{order}}{positive integer less than 99 that specifies the order of this guide among multiple guides. This controls the order in which multiple guides are displayed, not the contents of the guide itself. diff --git a/man/guide_custom.Rd b/man/guide_custom.Rd index 3893dbc2c9..ad8a77b80b 100644 --- a/man/guide_custom.Rd +++ b/man/guide_custom.Rd @@ -11,7 +11,7 @@ guide_custom( title = NULL, title.position = "top", margin = NULL, - position = waiver(), + position = NULL, order = 0 ) } diff --git a/man/guide_legend.Rd b/man/guide_legend.Rd index 224de5587a..75e965adfc 100644 --- a/man/guide_legend.Rd +++ b/man/guide_legend.Rd @@ -20,6 +20,7 @@ guide_legend( key.spacing = NULL, key.spacing.x = NULL, key.spacing.y = NULL, + position = NULL, direction = NULL, default.unit = "line", override.aes = list(), @@ -82,6 +83,9 @@ object specifying the distance between key-label pairs in the horizontal direction (\code{key.spacing.x}), vertical direction (\code{key.spacing.y}) or both (\code{key.spacing}).} +\item{position}{A character string indicating where the legend should be +placed relative to the plot panels.} + \item{direction}{A character string indicating the direction of the guide. One of "horizontal" or "vertical."} diff --git a/man/theme.Rd b/man/theme.Rd index 4c91c5fe85..f0f7b179e1 100644 --- a/man/theme.Rd +++ b/man/theme.Rd @@ -69,8 +69,15 @@ theme( legend.text, legend.title, legend.position, + legend.position.inside, legend.direction, legend.justification, + legend.justification.top, + legend.justification.bottom, + legend.justification.left, + legend.justification.right, + legend.justification.inside, + legend.location, legend.box, legend.box.just, legend.box.margin, @@ -187,8 +194,11 @@ inherits from \code{rect})} \item{legend.title}{title of legend (\code{\link[=element_text]{element_text()}}; inherits from \code{title})} -\item{legend.position}{the position of legends ("none", "left", "right", -"bottom", "top", or two-element numeric vector)} +\item{legend.position}{the default position of legends ("none", "left", +"right", "bottom", "top", "inside")} + +\item{legend.position.inside}{A numeric vector of length two setting the +placement of legends that have the \code{"inside"} position.} \item{legend.direction}{layout of items in legends ("horizontal" or "vertical")} @@ -197,6 +207,12 @@ inherits from \code{rect})} ("center" or two-element numeric vector) or the justification according to the plot area when positioned outside the plot} +\item{legend.justification.top, legend.justification.bottom, legend.justification.left, legend.justification.right, legend.justification.inside}{Same as \code{legend.justification} but specified per \code{legend.position} option.} + +\item{legend.location}{Relative placement of legends outside the plot as a +string. Can be \code{"panel"} (default) to align legends to the panels or +\code{"plot"} to align legends to the plot as a whole.} + \item{legend.box}{arrangement of multiple legends ("horizontal" or "vertical")} diff --git a/tests/testthat/_snaps/theme/legends-at-all-sides-with-justification.svg b/tests/testthat/_snaps/theme/legends-at-all-sides-with-justification.svg new file mode 100644 index 0000000000..9847f9f0c9 --- /dev/null +++ b/tests/testthat/_snaps/theme/legends-at-all-sides-with-justification.svg @@ -0,0 +1,157 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +10 +15 +20 +25 +30 +35 + + + + + + + + + + +100 +200 +300 +400 +disp +mpg + +wt + + + + + + + + +2 +3 +4 +5 + +drat + + + + + + + + +3.0 +3.5 +4.0 +4.5 + +hp + + + + + + + + + + + +100 +150 +200 +250 +300 + +factor(cyl) + + + + + + +4 +6 +8 + +factor(gear) + + + + + + +3 +4 +5 +legends at all sides with justification + + diff --git a/tests/testthat/test-facet-strips.R b/tests/testthat/test-facet-strips.R index a56f5644cb..1ee8792e99 100644 --- a/tests/testthat/test-facet-strips.R +++ b/tests/testthat/test-facet-strips.R @@ -154,19 +154,19 @@ test_that("padding is only added if axis is present", { strip.switch.pad.grid = unit(10, "mm") ) pg <- ggplotGrob(p) - expect_equal(length(pg$heights), 13) + expect_equal(length(pg$heights), 17) pg <- ggplotGrob(p + scale_x_continuous(position = "top")) - expect_equal(length(pg$heights), 14) - expect_equal(as.character(pg$heights[7]), "1cm") + expect_equal(length(pg$heights), 18) + expect_equal(as.character(pg$heights[9]), "1cm") # Also add padding with negative ticks and no text (#5251) pg <- ggplotGrob( p + scale_x_continuous(labels = NULL, position = "top") + theme(axis.ticks.length.x.top = unit(-2, "mm")) ) - expect_equal(length(pg$heights), 14) - expect_equal(as.character(pg$heights[7]), "1cm") + expect_equal(length(pg$heights), 18) + expect_equal(as.character(pg$heights[9]), "1cm") }) test_that("y strip labels are rotated when strips are switched", { diff --git a/tests/testthat/test-guides.R b/tests/testthat/test-guides.R index 58d5d04124..69b7bb558c 100644 --- a/tests/testthat/test-guides.R +++ b/tests/testthat/test-guides.R @@ -51,22 +51,21 @@ test_that("Colorbar respects show.legend in layer", { df <- data_frame(x = 1:3, y = 1) p <- ggplot(df, aes(x = x, y = y, color = x)) + geom_point(size = 20, shape = 21, show.legend = FALSE) - expect_false("guide-box" %in% ggplotGrob(p)$layout$name) + expect_length(ggplot_build(p)$plot$guides$guides, 0L) p <- ggplot(df, aes(x = x, y = y, color = x)) + geom_point(size = 20, shape = 21, show.legend = TRUE) - expect_true("guide-box" %in% ggplotGrob(p)$layout$name) + expect_length(ggplot_build(p)$plot$guides$guides, 1L) }) test_that("show.legend handles named vectors", { n_legends <- function(p) { g <- ggplotGrob(p) - gb <- which(g$layout$name == "guide-box") - if (length(gb) > 0) { - n <- length(g$grobs[[gb]]) - 1 - } else { - n <- 0 - } - n + gb <- grep("guide-box", g$layout$name) + n <- vapply(g$grobs[gb], function(x) { + if (is.zero(x)) return(0) + length(x$grobs) - 1 + }, numeric(1)) + sum(n) } df <- data_frame(x = 1:3, y = 20:22) @@ -749,18 +748,19 @@ test_that("guides are positioned correctly", { expect_doppelganger("padding in legend box", p2) + p2 <- p2 + theme(legend.position = "inside") # Placement of legend inside expect_doppelganger("legend inside plot, centered", - p2 + theme(legend.position = c(.5, .5)) + p2 + theme(legend.position.inside = c(.5, .5)) ) expect_doppelganger("legend inside plot, bottom left", - p2 + theme(legend.justification = c(0,0), legend.position = c(0,0)) + p2 + theme(legend.justification = c(0,0), legend.position.inside = c(0,0)) ) expect_doppelganger("legend inside plot, top right", - p2 + theme(legend.justification = c(1,1), legend.position = c(1,1)) + p2 + theme(legend.justification = c(1,1), legend.position.inside = c(1,1)) ) expect_doppelganger("legend inside plot, bottom left of legend at center", - p2 + theme(legend.justification = c(0,0), legend.position = c(.5,.5)) + p2 + theme(legend.justification = c(0,0), legend.position.inside = c(.5,.5)) ) }) diff --git a/tests/testthat/test-theme.R b/tests/testthat/test-theme.R index 53feb08832..af6a4b670a 100644 --- a/tests/testthat/test-theme.R +++ b/tests/testthat/test-theme.R @@ -743,6 +743,38 @@ test_that("plot titles and caption can be aligned to entire plot", { }) +test_that("Legends can on all sides of the plot with custom justification", { + + plot <- ggplot(mtcars) + + aes( + disp, mpg, + colour = hp, + fill = factor(gear), + shape = factor(cyl), + size = drat, + alpha = wt + ) + + geom_point() + + guides( + shape = guide_legend(position = "top"), + colour = guide_colourbar(position = "bottom"), + size = guide_legend(position = "left"), + alpha = guide_legend(position = "right"), + fill = guide_legend(position = "inside", override.aes = list(shape = 21)) + ) + + theme_test() + + theme( + legend.justification.top = "left", + legend.justification.bottom = c(1, 0), + legend.justification.left = c(0, 1), + legend.justification.right = "bottom", + legend.justification.inside = c(0.75, 0.75), + legend.location = "plot" + ) + + expect_doppelganger("legends at all sides with justification", plot) +}) + test_that("Strips can render custom elements", { element_test <- function(...) { el <- element_text(...)