Merge branch 'main' into flexible_palettes

Author: teunbrand

NEWS.md

@@ -2,6 +2,10 @@
 
 * The default colour and fill scales have a new `palette` argument 
   (@teunbrand, #6064).
+* `guide_*()` can now accept two inside legend theme elements:
+  `legend.position.inside` and `legend.justification.inside`, allowing inside
+  legends to be placed at different positions. Only inside legends with the same
+  position and justification will be merged (@Yunuuuu, #6210).
 * New stat: `stat_manual()` for arbitrary computations (@teunbrand, #3501)
 * Reversal of a dimension, typically 'x' or 'y', is now controlled by the 
   `reverse` argument in `coord_cartesian()`, `coord_fixed()`, `coord_radial()`

R/coord-polar.R

@@ -20,7 +20,7 @@
 #' # to demonstrate how these common plots can be described in the
 #' # grammar.  Use with EXTREME caution.
 #'
-#' #' # A pie chart = stacked bar chart + polar coordinates
+#' # A pie chart = stacked bar chart + polar coordinates
 #' pie <- ggplot(mtcars, aes(x = factor(1), fill = factor(cyl))) +
 #'  geom_bar(width = 1)
 #' pie + coord_polar(theta = "y")

R/coord-radial.R

@@ -27,10 +27,10 @@
 #' @param r_axis_inside,rotate_angle `r lifecycle::badge("deprecated")`
 #'
 #' @note
-#' In `coord_radial()`, position guides are can be defined by using
+#' In `coord_radial()`, position guides can be defined by using
 #' `guides(r = ..., theta = ..., r.sec = ..., theta.sec = ...)`. Note that
 #' these guides require `r` and `theta` as available aesthetics. The classic
-#' `guide_axis()` can be used for the `r` positions and `guide_axis_theta()` can
+#' [guide_axis()] can be used for the `r` positions and [guide_axis_theta()] can
 #' be used for the `theta` positions. Using the `theta.sec` position is only
 #' sensible when `inner.radius > 0`.
 #'

R/fortify-map.R

@@ -1,5 +1,8 @@
 #' Fortify method for map objects
 #'
+#' @description
+#' `r lifecycle::badge("deprecated")`
+#'
 #' This function turns a map into a data frame that can more easily be
 #' plotted with ggplot2.
 #'
@@ -24,6 +27,9 @@
 #'   geom_polygon(aes(group = group), colour = "white")
 #' }
 fortify.map <- function(model, data, ...) {
+  lifecycle::deprecate_warn(
+    "3.6.0", I("`fortify(<map>)`"), "map_data()"
+  )
   df <- data_frame0(
     long = model$x,
     lat = model$y,
@@ -46,10 +52,10 @@ fortify.map <- function(model, data, ...) {
 #' for plotting with ggplot2.
 #'
 #' @param map name of map provided by the \pkg{maps} package. These
-#'   include [maps::county()], [maps::france()],
-#'   [maps::italy()], [maps::nz()],
-#'   [maps::state()], [maps::usa()],
-#'   [maps::world()], [maps::world2()].
+#'   include [`"county"`][maps::county], [`"france"`][maps::france],
+#'   [`"italy"`][maps::italy], [`"nz"`][maps::nz],
+#'   [`"state"`][maps::state], [`"usa"`][maps::usa],
+#'   [`"world"`][maps::world], or [`"world2"`][maps::world2].
 #' @param region name(s) of subregion(s) to include. Defaults to `.` which
 #'   includes all subregions. See documentation for [maps::map()]
 #'   for more details.
@@ -80,7 +86,27 @@ fortify.map <- function(model, data, ...) {
 map_data <- function(map, region = ".", exact = FALSE, ...) {
   check_installed("maps", reason = "for `map_data()`.")
   map_obj <- maps::map(map, region, exact = exact, plot = FALSE, fill = TRUE, ...)
-  fortify(map_obj)
+
+  if (!inherits(map_obj, "map")) {
+    cli::cli_abort(c(
+      "{.fn maps::map} must return an object of type {.cls map}, not \\
+      {obj_type_friendly(map_obj)}.",
+      i = "Did you pass the right arguments?"
+    ))
+  }
+
+  df <- data_frame0(
+    long  = map_obj$x,
+    lat   = map_obj$y,
+    group = cumsum(is.na(map_obj$x) & is.na(map_obj$y)) + 1,
+    order = seq_along(map_obj$x),
+    .size = length(map_obj$x)
+  )
+
+  names <- lapply(strsplit(map_obj$names, "[:,]"), "[", 1:2)
+  names <- vec_rbind(!!!names, .name_repair = ~ c("region", "subregion"))
+  df[names(names)] <- vec_slice(names, df$group)
+  vec_slice(df, stats::complete.cases(df$lat, df$long))
 }
 
 #' Create a layer of map borders

R/fortify-spatial.R

@@ -1,5 +1,8 @@
 #' Fortify method for classes from the sp package.
 #'
+#' @description
+#' `r lifecycle::badge("deprecated")`
+#'
 #' To figure out the correct variable name for region, inspect
 #' `as.data.frame(model)`.
 #'

R/guide-axis-stack.R

@@ -22,7 +22,7 @@ NULL
 #' @export
 #'
 #' @examples
-#' #' # A standard plot
+#' # A standard plot
 #' p <- ggplot(mpg, aes(displ, hwy)) +
 #'   geom_point() +
 #'   theme(axis.line = element_line())

R/guides-.R

@@ -471,7 +471,7 @@ Guides <- ggproto(
   #      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) {
+  assemble = function(self, theme, params = self$params, guides = self$guides) {
 
     if (length(self$guides) < 1) {
       return(zeroGrob())
@@ -485,42 +485,95 @@ Guides <- ggproto(
       return(zeroGrob())
     }
 
+    # extract the guide position
+    positions <- vapply(
+      params,
+      function(p) p$position[1] %||% default_position,
+      character(1), USE.NAMES = FALSE
+    )
+
     # 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, default_position, theme$legend.direction)
+    grobs <- self$draw(theme, positions, theme$legend.direction)
+    keep <- !vapply(grobs, is.zero, logical(1), USE.NAMES = FALSE)
+    grobs <- grobs[keep]
     if (length(grobs) < 1) {
       return(zeroGrob())
     }
-    grobs <- grobs[order(names(grobs))]
+
+    # prepare the position of inside legends
+    default_inside_just <- calc_element("legend.justification.inside", theme)
+    default_inside_position <- calc_element("legend.position.inside", theme)
+
+    groups <- data_frame0(
+      positions = positions,
+      justs     = list(NULL),
+      coords    = list(NULL)
+    )
+
+    # we grouped the legends by the positions, for inside legends, they'll be
+    # splitted by the actual inside coordinate
+    for (i in which(positions == "inside")) {
+      # the actual inside position and justification can be set in each guide
+      # by `theme` argument, here, we won't use `calc_element()` which will
+      # use inherits from `legend.justification` or `legend.position`, we only
+      # follow the inside elements from the guide theme
+      just <- params[[i]]$theme[["legend.justification.inside"]]
+      just <- valid.just(just %||% default_inside_just)
+      coord <- params[[i]]$theme[["legend.position.inside"]]
+      coord <- coord %||% default_inside_position %||% just
+
+      groups$justs[[i]] <- just
+      groups$coord[[i]] <- coord
+    }
+
+    groups <- vec_group_loc(vec_slice(groups, keep))
+    grobs <- vec_chop(grobs, indices = groups$loc)
+    names(grobs) <- groups$key$positions
 
     # Set 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)
-    )
+    # prepare output
+    for (i in vec_seq_along(groups)) {
+      adjust <- NULL
+      position <- groups$key$position[i]
+      if (position == "inside") {
+        adjust <- theme(
+          legend.position.inside = groups$key$coord[[i]],
+          legend.justification.inside = groups$key$justs[[i]]
+        )
+      }
+      grobs[[i]] <- self$package_box(grobs[[i]], position, theme + adjust)
+    }
+
+    # merge inside grobs into single gtable
+    is_inside <- names(grobs) == "inside"
+    if (sum(is_inside) > 1) {
+      inside <- gtable(unit(1, "npc"), unit(1, "npc"))
+      inside <- gtable_add_grob(
+        inside, grobs[is_inside],
+        t = 1, l = 1, clip = "off",
+        name = paste0("guide-box-inside-", seq_len(sum(is_inside)))
+      )
+      grobs <- grobs[!is_inside]
+      grobs$inside <- inside
+    }
+
+    # fill in missing guides
+    grobs[setdiff(c(.trbl, "inside"), names(grobs))] <- list(zeroGrob())
+
+    grobs
   },
 
   # Render the guides into grobs
-  draw = function(self, theme,
-                  default_position = "right",
-                  direction = NULL,
+  draw = function(self, theme, positions, 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"
@@ -529,14 +582,16 @@ Guides <- ggproto(
     grobs <- vector("list", length(guides))
     for (i in seq_along(grobs)) {
       grobs[[i]] <- guides[[i]]$draw(
-        theme = theme, position = as.character(positions[i]),
+        theme = theme, position = positions[i],
         direction = directions[i], params = params[[i]]
       )
     }
-    keep <- !vapply(grobs, is.zero, logical(1))
-    split(grobs[keep], positions[keep])
+    grobs
   },
 
+  # here, we put `inside_position` and `inside_just` in the last, so that it
+  # won't break current implement of patchwork, which depends on the top three
+  # arguments to collect guides
   package_box = function(grobs, position, theme) {
 
     if (is.zero(grobs) || length(grobs) == 0) {
@@ -699,7 +754,6 @@ Guides <- ggproto(
     guides$name <- "guide-box"
     guides
   },
-
   ## Utilities -----------------------------------------------------------------
 
   print = function(self) {

R/plot-build.R

@@ -286,7 +286,7 @@ ggplot_gtable.ggplot_built <- function(data) {
   plot_table <- table_add_tag(plot_table, plot$labels$tag, theme)
 
   # Margins
-  plot_margin <- calc_element("plot.margin", theme)
+  plot_margin <- calc_element("plot.margin", theme) %||% margin()
   plot_table  <- gtable_add_padding(plot_table, plot_margin)
 
   if (is.theme_element(theme$plot.background)) {