diff --git a/DESCRIPTION b/DESCRIPTION
index 6b6bb41f3e..77cb1ce98d 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -115,6 +115,7 @@ Collate:
'coord-munch.R'
'coord-polar.R'
'coord-quickmap.R'
+ 'coord-radial.R'
'coord-sf.R'
'coord-transform.R'
'data.R'
@@ -174,6 +175,7 @@ Collate:
'grouping.R'
'guide-.R'
'guide-axis.R'
+ 'guide-axis-theta.R'
'guide-legend.R'
'guide-bins.R'
'guide-colorbar.R'
diff --git a/NAMESPACE b/NAMESPACE
index 0cd6c7f2c8..c5f5a94219 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -157,6 +157,7 @@ export(CoordFlip)
export(CoordMap)
export(CoordPolar)
export(CoordQuickmap)
+export(CoordRadial)
export(CoordSf)
export(CoordTrans)
export(Facet)
@@ -302,6 +303,7 @@ export(coord_map)
export(coord_munch)
export(coord_polar)
export(coord_quickmap)
+export(coord_radial)
export(coord_sf)
export(coord_trans)
export(cut_interval)
@@ -418,6 +420,7 @@ export(ggproto_parent)
export(ggsave)
export(ggtitle)
export(guide_axis)
+export(guide_axis_theta)
export(guide_bins)
export(guide_colorbar)
export(guide_colorsteps)
diff --git a/NEWS.md b/NEWS.md
index 1b02530a3e..9043752ad0 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -1,5 +1,17 @@
# ggplot2 (development version)
+* `coord_radial()` is a successor to `coord_polar()` with more customisation
+ options. `coord_radial()` can:
+
+ * integrate with the new guide system via a dedicated `guide_axis_theta()` to
+ display the angle coordinate.
+ * in addition to drawing full circles, also draw circle sectors by using the
+ `end` argument.
+ * avoid data vanishing in the center of the plot by setting the `donut`
+ argument.
+ * adjust the `angle` aesthetic of layers, such as `geom_text()`, to align
+ with the coordinate system using the `rotate_angle` argument.
+
* By default, `guide_legend()` now only draws a key glyph for a layer when
the value is is the layer's data. To revert to the old behaviour, you
can still set `show.legend = c({aesthetic} = TRUE)` (@teunbrand, #3648).
diff --git a/R/coord-polar.R b/R/coord-polar.R
index f9bb6395da..219a8fca4d 100644
--- a/R/coord-polar.R
+++ b/R/coord-polar.R
@@ -1,7 +1,8 @@
#' Polar coordinates
#'
#' The polar coordinate system is most commonly used for pie charts, which
-#' are a stacked bar chart in polar coordinates.
+#' are a stacked bar chart in polar coordinates. `coord_radial()` has extended
+#' options.
#'
#' @param theta variable to map angle to (`x` or `y`)
#' @param start Offset of starting point from 12 o'clock in radians. Offset
@@ -80,12 +81,14 @@ CoordPolar <- ggproto("CoordPolar", Coord,
aspect = function(details) 1,
distance = function(self, x, y, details) {
+ arc <- self$start + c(0, 2 * pi)
+ dir <- self$direction
if (self$theta == "x") {
r <- rescale(y, from = details$r.range)
- theta <- theta_rescale_no_clip(self, x, details)
+ theta <- theta_rescale_no_clip(x, details$theta.range, arc, dir)
} else {
r <- rescale(x, from = details$r.range)
- theta <- theta_rescale_no_clip(self, y, details)
+ theta <- theta_rescale_no_clip(y, details$theta.range, arc, dir)
}
dist_polar(r, theta)
@@ -163,10 +166,12 @@ CoordPolar <- ggproto("CoordPolar", Coord,
},
transform = function(self, data, panel_params) {
+ arc <- self$start + c(0, 2 * pi)
+ dir <- self$direction
data <- rename_data(self, data)
- data$r <- r_rescale(self, data$r, panel_params$r.range)
- data$theta <- theta_rescale(self, data$theta, panel_params)
+ data$r <- r_rescale(data$r, panel_params$r.range)
+ data$theta <- theta_rescale(data$theta, panel_params$theta.range, arc, dir)
data$x <- data$r * sin(data$theta) + 0.5
data$y <- data$r * cos(data$theta) + 0.5
@@ -176,11 +181,10 @@ CoordPolar <- ggproto("CoordPolar", Coord,
render_axis_v = function(self, panel_params, theme) {
arrange <- panel_params$r.arrange %||% c("primary", "secondary")
- x <- r_rescale(self, panel_params$r.major, panel_params$r.range) + 0.5
+ x <- r_rescale(panel_params$r.major, panel_params$r.range) + 0.5
panel_params$r.major <- x
if (!is.null(panel_params$r.sec.major)) {
panel_params$r.sec.major <- r_rescale(
- self,
panel_params$r.sec.major,
panel_params$r.sec.range
) + 0.5
@@ -201,14 +205,16 @@ CoordPolar <- ggproto("CoordPolar", Coord,
render_bg = function(self, panel_params, theme) {
panel_params <- rename_data(self, panel_params)
+ arc <- self$start + c(0, 2 * pi)
+ dir <- self$direction
theta <- if (length(panel_params$theta.major) > 0)
- theta_rescale(self, panel_params$theta.major, panel_params)
+ theta_rescale(panel_params$theta.major, panel_params$theta.range, arc, dir)
thetamin <- if (length(panel_params$theta.minor) > 0)
- theta_rescale(self, panel_params$theta.minor, panel_params)
+ theta_rescale(panel_params$theta.minor, panel_params$theta.range, arc, dir)
thetafine <- seq(0, 2 * pi, length.out = 100)
- rfine <- c(r_rescale(self, panel_params$r.major, panel_params$r.range), 0.45)
+ rfine <- c(r_rescale(panel_params$r.major, panel_params$r.range), 0.45)
# This gets the proper theme element for theta and r grid lines:
# panel.grid.major.x or .y
@@ -247,8 +253,10 @@ CoordPolar <- ggproto("CoordPolar", Coord,
if (is.null(panel_params$theta.major)) {
return(element_render(theme, "panel.border"))
}
+ arc <- self$start + c(0, 2 * pi)
+ dir <- self$direction
- theta <- theta_rescale(self, panel_params$theta.major, panel_params)
+ theta <- theta_rescale(panel_params$theta.major, panel_params$theta.range, arc, dir)
labels <- panel_params$theta.labels
# Combine the two ends of the scale if they are close
@@ -305,18 +313,16 @@ rename_data <- function(coord, data) {
}
}
-theta_rescale_no_clip <- function(coord, x, panel_params) {
- rotate <- function(x) (x + coord$start) * coord$direction
- rotate(rescale(x, c(0, 2 * pi), panel_params$theta.range))
+theta_rescale_no_clip <- function(x, range, arc = c(0, 2 * pi), direction = 1) {
+ rescale(x, to = arc, from = range) * direction
}
-theta_rescale <- function(coord, x, panel_params) {
- x <- squish_infinite(x, panel_params$theta.range)
- rotate <- function(x) (x + coord$start) %% (2 * pi) * coord$direction
- rotate(rescale(x, c(0, 2 * pi), panel_params$theta.range))
+theta_rescale <- function(x, range, arc = c(0, 2 * pi), direction = 1) {
+ x <- squish_infinite(x, range)
+ rescale(x, to = arc, from = range) %% (2 * pi) * direction
}
-r_rescale <- function(coord, x, range) {
+r_rescale <- function(x, range, donut = c(0, 0.4)) {
x <- squish_infinite(x, range)
- rescale(x, c(0, 0.4), range)
+ rescale(x, donut, range)
}
diff --git a/R/coord-radial.R b/R/coord-radial.R
new file mode 100644
index 0000000000..9f2ede8cce
--- /dev/null
+++ b/R/coord-radial.R
@@ -0,0 +1,567 @@
+
+#' @rdname coord_polar
+#'
+#' @param end Position from 12 o'clock in radians where plot ends, to allow
+#' for partial polar coordinates. The default, `NULL`, is set to
+#' `start + 2 * pi`.
+#' @param expand If `TRUE`, the default, adds a small expansion factor the
+#' the limits to prevent overlap between data and axes. If `FALSE`, limits
+#' are taken directly from the scale.
+#' @param r_axis_inside If `TRUE`, places the radius axis inside the
+#' panel. If `FALSE`, places the radius axis next to the panel. The default,
+#' `NULL`, places the radius axis outside if the `start` and `end` arguments
+#' form a full circle.
+#' @param rotate_angle If `TRUE`, transforms the `angle` aesthetic in data
+#' in accordance with the computed `theta` position. If `FALSE` (default),
+#' no such transformation is performed. Can be useful to rotate text geoms in
+#' alignment with the coordinates.
+#' @param donut A `numeric` between 0 and 1 setting the size of a donut hole.
+#'
+#' @note
+#' In `coord_radial()`, position guides are 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
+#' be used for the `theta` positions. Using the `theta.sec` position is only
+#' sensible when `donut > 0`.
+#'
+#' @export
+#' @examples
+#' # A partial polar plot
+#' ggplot(mtcars, aes(disp, mpg)) +
+#' geom_point() +
+#' coord_radial(start = -0.4 * pi, end = 0.4 * pi, donut = 0.3)
+coord_radial <- function(theta = "x",
+ start = 0, end = NULL,
+ expand = TRUE,
+ direction = 1,
+ clip = "off",
+ r_axis_inside = NULL,
+ rotate_angle = FALSE,
+ donut = 0) {
+
+ theta <- arg_match0(theta, c("x", "y"))
+ r <- if (theta == "x") "y" else "x"
+ check_bool(r_axis_inside, allow_null = TRUE)
+ check_bool(expand)
+ check_bool(rotate_angle)
+ check_number_decimal(start, allow_infinite = FALSE)
+ check_number_decimal(end, allow_infinite = FALSE, allow_null = TRUE)
+ check_number_decimal(donut, min = 0, max = 1, allow_infinite = FALSE)
+
+ end <- end %||% (start + 2 * pi)
+ if (start > end) {
+ n_rotate <- ((start - end) %/% (2 * pi)) + 1
+ start <- start - n_rotate * 2 * pi
+ }
+ r_axis_inside <- r_axis_inside %||% !(abs(end - start) >= 1.999 * pi)
+
+ ggproto(NULL, CoordRadial,
+ theta = theta,
+ r = r,
+ arc = c(start, end),
+ expand = expand,
+ direction = sign(direction),
+ r_axis_inside = r_axis_inside,
+ rotate_angle = rotate_angle,
+ donut = c(donut, 1) * 0.4,
+ clip = clip
+ )
+}
+
+#' @rdname ggplot2-ggproto
+#' @format NULL
+#' @usage NULL
+#' @export
+CoordRadial <- ggproto("CoordRadial", Coord,
+
+ aspect = function(details) {
+ diff(details$bbox$y) / diff(details$bbox$x)
+ },
+
+ distance = function(self, x, y, details) {
+ arc <- details$arc %||% c(0, 2 * pi)
+ if (self$theta == "x") {
+ r <- rescale(y, from = details$r.range, to = self$donut / 0.4)
+ theta <- theta_rescale_no_clip(
+ x, details$theta.range,
+ arc, self$direction
+ )
+ } else {
+ r <- rescale(x, from = details$r.range, to = self$donut / 0.4)
+ theta <- theta_rescale_no_clip(
+ y, details$theta.range,
+ arc, self$direction
+ )
+ }
+
+ dist_polar(r, theta)
+ },
+
+ backtransform_range = function(self, panel_params) {
+ self$range(panel_params)
+ },
+
+ range = function(self, panel_params) {
+ # summarise_layout() expects that the x and y ranges here
+ # match the setting from self$theta and self$r
+ setNames(
+ list(panel_params$theta.range, panel_params$r.range),
+ c(self$theta, self$r)
+ )
+ },
+
+ setup_panel_params = function(self, scale_x, scale_y, params = list()) {
+ c(
+ view_scales_polar(scale_x, self$theta, expand = self$expand),
+ view_scales_polar(scale_y, self$theta, expand = self$expand),
+ list(bbox = polar_bbox(self$arc, donut = self$donut),
+ arc = self$arc, donut = self$donut)
+ )
+ },
+
+ setup_panel_guides = function(self, panel_params, guides, params = list()) {
+
+ aesthetics <- c("r", "theta", "r.sec", "theta.sec")
+ names(aesthetics) <- aesthetics
+ is_sec <- grepl("sec$", aesthetics)
+ scales <- panel_params[aesthetics]
+
+ # Fill in theta guide default
+ panel_params$theta$guide <- panel_params$theta$guide %|W|% guide_axis_theta()
+
+ guides <- guides$setup(
+ scales, aesthetics,
+ default = params$guide_default %||% guide_axis(),
+ missing = params$guide_missing %||% guide_none()
+ )
+
+ # Validate appropriateness of guides
+ drop_guides <- character(0)
+ for (type in aesthetics) {
+ drop_guides <- check_polar_guide(drop_guides, guides, type)
+ }
+
+ guide_params <- guides$get_params(aesthetics)
+ names(guide_params) <- aesthetics
+
+ # Set guide positions
+ guide_params[["theta"]]$position <- "theta"
+ guide_params[["theta.sec"]]$position <- "theta.sec"
+
+ if (self$r_axis_inside) {
+
+ arc <- rad2deg(self$arc)
+ r_position <- c("left", "right")
+ if (self$direction == -1) {
+ arc <- rev(arc)
+ r_position <- rev(r_position)
+ }
+
+ guide_params[["r"]]$position <- r_position[1]
+ guide_params[["r.sec"]]$position <- r_position[2]
+ # Set guide text angles
+ guide_params[["r"]]$angle <- guide_params[["r"]]$angle %|W|% arc[1]
+ guide_params[["r.sec"]]$angle <- guide_params[["r.sec"]]$angle %|W|% arc[2]
+ } else {
+ guide_params[["r"]]$position <- params$r_axis
+ guide_params[["r.sec"]]$position <- opposite_position(params$r_axis)
+ }
+
+ guide_params[drop_guides] <- list(NULL)
+ guides$update_params(guide_params)
+
+ panel_params$guides <- guides
+ panel_params
+ },
+
+ train_panel_guides = function(self, panel_params, layers, params = list()) {
+
+ aesthetics <- c("r", "theta", "r.sec", "theta.sec")
+ aesthetics <- intersect(aesthetics, names(panel_params$guides$aesthetics))
+ names(aesthetics) <- aesthetics
+
+ guides <- panel_params$guides$get_guide(aesthetics)
+ names(guides) <- aesthetics
+ empty <- vapply(guides, inherits, logical(1), "GuideNone")
+ gdefs <- panel_params$guides$get_params(aesthetics)
+ names(gdefs) <- aesthetics
+
+ # Train theta guide
+ for (t in intersect(c("theta", "theta.sec"), aesthetics[!empty])) {
+ gdefs[[t]] <- guides[[t]]$train(gdefs[[t]], panel_params[[t]])
+ gdefs[[t]] <- guides[[t]]$transform(gdefs[[t]], self, panel_params)
+ gdefs[[t]] <- guides[[t]]$get_layer_key(gdefs[[t]], layers)
+ }
+
+ if (self$r_axis_inside) {
+ # For radial axis, we need to pretend that rotation starts at 0 and
+ # the bounding box is for circles, otherwise tick positions will be
+ # spaced too closely.
+ mod <- list(bbox = list(x = c(0, 1), y = c(0, 1)), arc = c(0, 2 * pi))
+ } else {
+ # When drawing radial axis outside, we need to pretend that arcs starts
+ # at horizontal or vertical position to have the transform work right.
+ mod <- list(arc = params$fake_arc)
+ }
+ temp <- modify_list(panel_params, mod)
+
+ # Train radial guide
+ for (r in intersect(c("r", "r.sec"), aesthetics[!empty])) {
+ gdefs[[r]] <- guides[[r]]$train(gdefs[[r]], panel_params[[r]])
+ gdefs[[r]] <- guides[[r]]$transform(gdefs[[r]], self, temp) # Use temp
+ gdefs[[r]] <- guides[[r]]$get_layer_key(gdefs[[r]], layers)
+ }
+
+ panel_params$guides$update_params(gdefs)
+ panel_params
+ },
+
+ transform = function(self, data, panel_params) {
+ data <- rename_data(self, data)
+ bbox <- panel_params$bbox %||% list(x = c(0, 1), y = c(0, 1))
+ arc <- panel_params$arc %||% c(0, 2 * pi)
+
+ data$r <- r_rescale(data$r, panel_params$r.range, panel_params$donut)
+ data$theta <- theta_rescale(
+ data$theta, panel_params$theta.range,
+ arc, self$direction
+ )
+ data$x <- rescale(data$r * sin(data$theta) + 0.5, from = bbox$x)
+ data$y <- rescale(data$r * cos(data$theta) + 0.5, from = bbox$y)
+
+ if (self$rotate_angle && "angle" %in% names(data)) {
+ data$angle <- flip_text_angle(data$angle - rad2deg(data$theta))
+ }
+
+ data
+ },
+
+ render_axis_v = function(self, panel_params, theme) {
+ if (self$r_axis_inside) {
+ return(list(left = zeroGrob(), right = zeroGrob()))
+ }
+ list(
+ left = panel_guides_grob(panel_params$guides, position = "left", theme = theme),
+ right = panel_guides_grob(panel_params$guides, position = "right", theme = theme)
+ )
+ },
+
+ render_axis_h = function(self, panel_params, theme) {
+ if (self$r_axis_inside) {
+ return(list(top = zeroGrob(), bottom = zeroGrob()))
+ }
+ list(
+ top = panel_guides_grob(panel_params$guides, position = "top", theme = theme),
+ bottom = panel_guides_grob(panel_params$guides, position = "bottom", theme = theme)
+ )
+ },
+
+ render_bg = function(self, panel_params, theme) {
+
+ bbox <- panel_params$bbox %||% list(x = c(0, 1), y = c(0, 1))
+ arc <- panel_params$arc %||% c(0, 2 * pi)
+ dir <- self$direction
+ donut <- panel_params$donut
+
+ theta_lim <- panel_params$theta.range
+ theta_maj <- panel_params$theta.major
+ theta_min <- setdiff(panel_params$theta.minor, theta_maj)
+
+ if (length(theta_maj) > 0) {
+ theta_maj <- theta_rescale(theta_maj, theta_lim, arc, dir)
+ }
+ if (length(theta_min) > 0) {
+ theta_min <- theta_rescale(theta_min, theta_lim, arc, dir)
+ }
+ theta_fine <- seq(self$arc[1], self$arc[2], length.out = 100)
+
+ r_fine <- r_rescale(panel_params$r.major, panel_params$r.range,
+ panel_params$donut)
+
+ # This gets the proper theme element for theta and r grid lines:
+ # panel.grid.major.x or .y
+ grid_elems <- paste(
+ c("panel.grid.major.", "panel.grid.minor.", "panel.grid.major."),
+ c(self$theta, self$theta, self$r), sep = ""
+ )
+ grid_elems <- lapply(grid_elems, calc_element, theme = theme)
+ majortheta <- paste("panel.grid.major.", self$theta, sep = "")
+ minortheta <- paste("panel.grid.minor.", self$theta, sep = "")
+ majorr <- paste("panel.grid.major.", self$r, sep = "")
+
+ bg_element <- calc_element("panel.background", theme)
+ if (!inherits(bg_element, "element_blank")) {
+ background <- data_frame0(
+ x = c(Inf, Inf, -Inf, -Inf),
+ y = c(Inf, -Inf, -Inf, Inf)
+ )
+ background <- coord_munch(self, background, panel_params, is_closed = TRUE)
+ bg_gp <- gpar(
+ lwd = len0_null(bg_element$linewidth * .pt),
+ col = bg_element$colour, fill = bg_element$fill,
+ lty = bg_element$linetype
+ )
+ background <- polygonGrob(
+ x = background$x, y = background$y,
+ gp = bg_gp
+ )
+ } else {
+ background <- zeroGrob()
+ }
+
+ ggname("grill", grobTree(
+ background,
+ theta_grid(theta_maj, grid_elems[[1]], donut, bbox),
+ theta_grid(theta_min, grid_elems[[2]], donut, bbox),
+ element_render(
+ theme, majorr, name = "radius",
+ x = rescale(rep(r_fine, each = length(theta_fine)) *
+ rep(sin(theta_fine), length(r_fine)) + 0.5, from = bbox$x),
+ y = rescale(rep(r_fine, each = length(theta_fine)) *
+ rep(cos(theta_fine), length(r_fine)) + 0.5, from = bbox$y),
+ id.lengths = rep(length(theta_fine), length(r_fine)),
+ default.units = "native"
+ )
+ ))
+ },
+
+ render_fg = function(self, panel_params, theme) {
+
+ if (!self$r_axis_inside) {
+ out <- grobTree(
+ panel_guides_grob(panel_params$guides, "theta", theme),
+ panel_guides_grob(panel_params$guides, "theta.sec", theme),
+ element_render(theme, "panel.border")
+ )
+ return(out)
+ }
+
+ bbox <- panel_params$bbox
+ dir <- self$direction
+ arc <- if (dir == 1) self$arc else rev(self$arc)
+ arc <- dir * rad2deg(-arc)
+
+ left <- panel_guides_grob(panel_params$guides, position = "left", theme)
+ left <- rotate_r_axis(left, arc[1], bbox, "left")
+
+ right <- panel_guides_grob(panel_params$guides, position = "right", theme)
+ right <- rotate_r_axis(right, arc[2], bbox, "right")
+
+ grobTree(
+ panel_guides_grob(panel_params$guides, "theta", theme),
+ panel_guides_grob(panel_params$guides, "theta.sec", theme),
+ left, right,
+ element_render(theme, "panel.border")
+ )
+ },
+
+ labels = function(self, labels, panel_params) {
+ # `Layout$resolve_label()` doesn't know to look for theta/r/r.sec guides,
+ # so we'll handle title propagation here.
+ titles <- lapply(
+ panel_params$guides$get_params(c("theta", "r", "r.sec")),
+ function(x) x$title
+ )
+ if (self$theta == "y") {
+ # Need to use single brackets for labels to avoid deleting an element by
+ # assigning NULL
+ labels$y['primary'] <- list(titles[[1]] %|W|% labels$y$primary)
+ labels$x['primary'] <- list(titles[[2]] %|W|% labels$x$primary)
+ labels$x['secondary'] <- list(titles[[3]] %|W|% labels$x$secondary)
+ if (any(in_arc(c(0, 1) * pi, panel_params$arc))) {
+ labels <- list(x = labels$y, y = labels$x)
+ } else {
+ labels <- list(x = rev(labels$x), y = rev(labels$y))
+ }
+ } else {
+ labels$x['primary'] <- list(titles[[1]] %|W|% labels$x$primary)
+ labels$y['primary'] <- list(titles[[2]] %|W|% labels$y$primary)
+ labels$y['secondary'] <- list(titles[[3]] %|W|% labels$y$secondary)
+
+ if (!any(in_arc(c(0, 1) * pi, panel_params$arc))) {
+ labels <- list(x = rev(labels$y), y = rev(labels$x))
+ }
+ }
+ labels
+ },
+
+ modify_scales = function(self, scales_x, scales_y) {
+ if (self$theta != "y")
+ return()
+
+ lapply(scales_x, scale_flip_position)
+ lapply(scales_y, scale_flip_position)
+ },
+
+ setup_params = function(self, data) {
+ if (!self$r_axis_inside) {
+ place <- in_arc(c(0, 0.5, 1, 1.5) * pi, self$arc)
+ if (place[1]) {
+ return(list(r_axis = "left", fake_arc = c(0, 2) * pi))
+ }
+ if (place[3]) {
+ return(list(r_axis = "left", fake_arc = c(1, 3)* pi))
+ }
+ if (place[2]) {
+ return(list(r_axis = "bottom", fake_arc = c(0.5, 2.5) * pi))
+ }
+ if (place[4]) {
+ return(list(r_axis = "bottom", fake_arc = c(1.5, 3.5) * pi))
+ }
+ cli::cli_warn(c(
+ "No appropriate placement found for {.arg r_axis_inside}.",
+ i = "Axis will be placed at panel edge."
+ ))
+ self$r_axis_inside <- TRUE
+ }
+ return(NULL)
+ }
+)
+
+view_scales_polar <- function(scale, theta = "x", expand = TRUE) {
+
+ aesthetic <- scale$aesthetics[1]
+ is_theta <- theta == aesthetic
+ name <- if (is_theta) "theta" else "r"
+
+ expansion <- default_expansion(scale, expand = expand)
+ limits <- scale$get_limits()
+ continuous_range <- expand_limits_scale(scale, expansion, limits)
+
+ primary <- view_scale_primary(scale, limits, continuous_range)
+ view_scales <- list(
+ primary,
+ sec = view_scale_secondary(scale, limits, continuous_range),
+ major = primary$map(primary$get_breaks()),
+ minor = primary$map(primary$get_breaks_minor()),
+ range = continuous_range
+ )
+
+ names(view_scales) <- c(name, paste0(name, ".", names(view_scales)[-1]))
+ view_scales
+}
+
+#' Bounding box for partial polar coordinates
+#'
+#' Calculates the appropriate area to display a partial polar plot.
+#'
+#' @param arc The theta limits of the arc spanned by the partial polar plot.
+#' @param margin A `numeric[4]` giving the margin that should be added to the
+#' top, right, bottom and left to the plot at edges that are shortened.
+#'
+#' @return A `list` with element `x`, containing the 'xmin' and 'xmax', and
+#' element `y` giving 'ymin' and 'ymax' of the bounding box.
+#'
+#' @noRd
+#' @examples
+#' polar_bbox(c(0, 1) * pi)
+polar_bbox <- function(arc, margin = c(0.05, 0.05, 0.05, 0.05),
+ donut = c(0, 0.4)) {
+
+ # Early exit if we have full circle or more
+ if (abs(diff(arc)) >= 2 * pi) {
+ return(list(x = c(0, 1), y = c(0, 1)))
+ }
+
+ # X and Y position of the sector arc ends
+ xmax <- 0.5 * sin(arc) + 0.5
+ ymax <- 0.5 * cos(arc) + 0.5
+ xmin <- donut[1] * sin(arc) + 0.5
+ ymin <- donut[1] * cos(arc) + 0.5
+
+ margin <- c(
+ max(ymin) + margin[1],
+ max(xmin) + margin[2],
+ min(ymin) - margin[3],
+ min(xmin) - margin[4]
+ )
+
+ # Check for top, right, bottom and left if it falls in sector
+ pos_theta <- seq(0, 1.5 * pi, length.out = 4)
+ in_sector <- in_arc(pos_theta, arc)
+
+ bounds <- ifelse(
+ in_sector,
+ c(1, 1, 0, 0),
+ c(max(ymax, margin[1]), max(xmax, margin[2]),
+ min(ymax, margin[3]), min(xmax, margin[4]))
+ )
+ list(x = c(bounds[4], bounds[2]),
+ y = c(bounds[3], bounds[1]))
+}
+
+# For any `theta` in [0, 2 * pi), test if theta is inside the span
+# given by `arc`
+in_arc <- function(theta, arc) {
+ arc <- arc %% (2 * pi)
+ if (arc[1] < arc[2]) {
+ theta >= arc[1] & theta <= arc[2]
+ } else {
+ !(theta < arc[1] & theta > arc[2])
+ }
+}
+
+# Helpers to convert degrees to radians and vice versa
+rad2deg <- function(rad) rad * 180 / pi
+deg2rad <- function(deg) deg * pi / 180
+
+# Function to rotate a radius axis through viewport
+rotate_r_axis <- function(axis, angle, bbox, position = "left") {
+
+ if (inherits(axis, "zeroGrob")) {
+ return(axis)
+ }
+
+ gTree(
+ children = gList(axis),
+ vp = viewport(
+ angle = angle,
+ x = unit(rescale(0.5, from = bbox$x), "npc"),
+ y = unit(rescale(0.5, from = bbox$y), "npc"),
+ just = c(as.numeric(position == "left"), 0.5),
+ height = unit(1 / diff(bbox$y), "npc")
+ )
+ )
+}
+
+flip_text_angle <- function(angle) {
+ angle <- angle %% 360
+ flip <- angle > 90 & angle < 270
+ angle[flip] <- angle[flip] + 180
+ angle
+}
+
+
+theta_grid <- function(theta, element, donut = c(0, 0.4),
+ bbox = list(x = c(0, 1), y = c(0, 1))) {
+ n <- length(theta)
+ if (n < 1) {
+ return(NULL)
+ }
+
+ donut <- rep(donut, n)
+ x <- rep(sin(theta), each = 2) * donut + 0.5
+ y <- rep(cos(theta), each = 2) * donut + 0.5
+
+ element_grob(
+ element,
+ x = rescale(x, from = bbox$x),
+ y = rescale(y, from = bbox$y),
+ id.lengths = rep(2, n),
+ default.units = "native"
+ )
+}
+
+check_polar_guide <- function(drop_list, guides, type = "theta") {
+ guide <- guides$get_guide(type)
+ primary <- gsub("\\.sec$", "", type)
+ if (inherits(guide, "GuideNone") || primary %in% guide$available_aes) {
+ return(drop_list)
+ }
+ cli::cli_warn(c(
+ "{.fn {snake_class(guide)}} cannot be used for {.field {primary}}.",
+ i = "Use {?one of} {.or {.field {guide$available_aes}}} instead."
+ ))
+ c(drop_list, type)
+}
diff --git a/R/guide-.R b/R/guide-.R
index bdf360db8e..daf026e88a 100644
--- a/R/guide-.R
+++ b/R/guide-.R
@@ -436,6 +436,16 @@ flip_names = c(
# Shortcut for position argument matching
.trbl <- c("top", "right", "bottom", "left")
+opposite_position <- function(position) {
+ switch(
+ position,
+ top = "bottom",
+ bottom = "top",
+ left = "right",
+ right = "left"
+ )
+}
+
# Ensure that labels aren't a list of expressions, but proper expressions
validate_labels <- function(labels) {
if (!is.list(labels)) {
diff --git a/R/guide-axis-theta.R b/R/guide-axis-theta.R
new file mode 100644
index 0000000000..22a2db06a1
--- /dev/null
+++ b/R/guide-axis-theta.R
@@ -0,0 +1,280 @@
+#' @include guide-axis.R
+NULL
+
+#' Angle axis guide
+#'
+#' This is a specialised guide used in `coord_radial()` to represent the theta
+#' position scale.
+#'
+#' @inheritParams guide_axis
+#'
+#' @note
+#' The axis labels in this guide are insensitive to `hjust` and `vjust`
+#' settings. The distance from the tick marks to the labels is determined by
+#' the largest `margin` size set in the theme.
+#'
+#' @export
+#'
+#' @examples
+#' # A plot using coord_radial
+#' p <- ggplot(mtcars, aes(disp, mpg)) +
+#' geom_point() +
+#' coord_radial()
+#'
+#' # The `angle` argument can be used to set relative angles
+#' p + guides(theta = guide_axis_theta(angle = 0))
+guide_axis_theta <- function(title = waiver(), angle = waiver(),
+ minor.ticks = FALSE, cap = "none", order = 0,
+ position = waiver()) {
+
+ check_bool(minor.ticks)
+ if (is.logical(cap)) {
+ check_bool(cap)
+ cap <- if (cap) "both" else "none"
+ }
+ cap <- arg_match0(cap, c("none", "both", "upper", "lower"))
+
+ new_guide(
+ title = title,
+
+ # customisations
+ angle = angle,
+ cap = cap,
+ minor.ticks = minor.ticks,
+
+ # parameter
+ available_aes = c("x", "y", "theta"),
+
+ # general
+ order = order,
+ position = position,
+ name = "axis",
+ super = GuideAxisTheta
+ )
+}
+
+GuideAxisTheta <- ggproto(
+ "GuideAxisTheta", GuideAxis,
+
+ extract_decor = function(scale, aesthetic, key, cap = "none", position, ...) {
+ # For theta position, we pretend we're left/right because that will put
+ # the correct opposite aesthetic as the line coordinates.
+ position <- switch(position, theta = "left", theta.sec = "right", position)
+
+ GuideAxis$extract_decor(
+ scale = scale, aesthetic = aesthetic,
+ position = position, key = key, cap = cap
+ )
+ },
+
+ transform = function(params, coord, panel_params) {
+
+ opposite <- setdiff(c("x", "y"), params$aesthetic)
+ params$key[[opposite]] <- switch(params$position,
+ theta.sec = -Inf,
+ top = -Inf,
+ right = -Inf,
+ Inf)
+
+ params <- GuideAxis$transform(params, coord, panel_params)
+
+ key <- params$key
+ n <- nrow(key)
+
+ params$theme_aes <- coord$theta %||% params$aesthetic
+
+ if (!("theta" %in% names(key))) {
+ # We likely have a linear coord, so we match the text angles to
+ # standard axes to be visually similar.
+ key$theta <- switch(
+ params$position,
+ top = 0,
+ bottom = 1 * pi,
+ left = 1.5 * pi,
+ right = 0.5 * pi
+ )
+ } else {
+ if (params$position == 'theta.sec') {
+ key$theta <- key$theta + pi
+ }
+
+ # If the first and last positions are close together, we merge the
+ # labels of these positions
+ ends_apart <- (key$theta[n] - key$theta[1]) %% (2 * pi)
+ if (n > 0 && ends_apart < 0.05 && !is.null(key$.label)) {
+ if (is.expression(key$.label)) {
+ combined <- substitute(
+ paste(a, "/", b),
+ list(a = key$.label[[1]], b = key$.label[[n]])
+ )
+ } else {
+ combined <- paste(key$.label[1], key$.label[n], sep = "/")
+ }
+ key$.label[[n]] <- combined
+ key <- vec_slice(key, -1)
+ }
+ }
+
+ params$key <- key
+ params
+ },
+
+ setup_params = function(params) {
+ # Theta axis doesn't need to setup any position specific parameters.
+ params
+ },
+
+ setup_elements = function(params, elements, theme) {
+
+ axis_elem <- c("line", "text", "ticks", "minor", "major_length", "minor_length")
+ is_char <- vapply(elements[axis_elem], is.character, logical(1))
+ axis_elem <- axis_elem[is_char]
+
+ aes <- switch(
+ params$position,
+ theta = "x.bottom",
+ theta.sec = "x.top",
+ paste0(params$aesthetic, ".", params$position)
+ )
+
+ elements[axis_elem] <- lapply(
+ paste(unlist(elements[axis_elem]), aes, sep = "."),
+ calc_element, theme = theme
+ )
+
+ # Offset distance from axis arc to text positions
+ if (!params$minor.ticks) {
+ elements$minor_length <- unit(0, "pt")
+ }
+
+ offset <- max(unit(0, "pt"), elements$major_length, elements$minor_length)
+ elements$offset <- offset + max(elements$text$margin)
+ elements
+ },
+
+ override_elements = function(params, elements, theme) {
+ # We don't override any label angles/hjust/vjust because these depend on
+ # theta of label.
+ elements
+ },
+
+ build_labels = function(key, elements, params) {
+
+ key <- vec_slice(key, !vec_detect_missing(key$.label %||% NA))
+
+ # Early exit if drawing no labels
+ labels <- key$.label
+ if (length(labels) < 1) {
+ return(list(zeroGrob()))
+ }
+
+ # Resolve text angle
+ if (is.waive(params$angle) || is.null(params$angle)) {
+ angle <- elements$text$angle
+ } else {
+ angle <- flip_text_angle(params$angle - rad2deg(key$theta))
+ }
+ # Text angle in radians
+ rad <- deg2rad(angle)
+ # Position angle in radians
+ theta <- key$theta
+
+ # Offset distance to displace text away from outer circle line
+ xoffset <- elements$offset * sin(theta)
+ yoffset <- elements$offset * cos(theta)
+
+ # Note that element_grob expects 1 angle for *all* labels, so we're
+ # rendering one grob per label to propagate angle properly
+ element_grob(
+ elements$text,
+ label = labels,
+ x = unit(key$x, "npc") + xoffset,
+ y = unit(key$y, "npc") + yoffset,
+ hjust = 0.5 - sin(theta + rad) / 2,
+ vjust = 0.5 - cos(theta + rad) / 2,
+ angle = angle
+ )
+ },
+
+ build_ticks = function(key, elements, params, position = params$position) {
+
+ major <- theta_tickmarks(
+ vec_slice(key, (key$.type %||% "major") == "major"),
+ elements$ticks, elements$major_length
+ )
+ minor <- theta_tickmarks(
+ vec_slice(key, (key$.type %||% "major") == "minor"),
+ elements$minor, elements$minor_length
+ )
+
+ grobTree(major, minor, name = "ticks")
+ },
+
+ measure_grobs = function(grobs, params, elements) {
+ # As this guide is expected to be placed in the interior of coord_radial,
+ # we don't need to measure grob sizes nor arrange the layout.
+ # There is a fallback in `$assemble_drawing()` that takes care of this
+ # for non-polar coordinates.
+ NULL
+ },
+
+ arrange_layout = function(key, sizes, params) {
+ NULL
+ },
+
+ assemble_drawing = function(grobs, layout, sizes, params, elements) {
+ if (params$position %in% c("theta", "theta.sec")) {
+ return(inject(grobTree(!!!grobs)))
+ }
+
+ # As a fallback, we adjust the viewport to act like regular axes.
+ if (params$position %in% c("top", "bottom")) {
+ height <- sum(
+ elements$offset,
+ unit(max(height_cm(grobs$labels$children)), "cm")
+ )
+ vp <- viewport(
+ y = unit(as.numeric(params$position == "bottom"), "npc"),
+ height = height, width = unit(1, "npc"),
+ just = opposite_position(params$position)
+ )
+ } else {
+ width <- sum(
+ elements$offset,
+ unit(max(width_cm(grobs$labels$children)), "cm")
+ )
+ vp <- viewport(
+ x = unit(as.numeric(params$position == "left"), "npc"),
+ height = unit(1, "npc"), width = width,
+ just = opposite_position(params$position)
+ )
+ }
+
+ absoluteGrob(
+ inject(gList(!!!grobs)),
+ width = vp$width,
+ height = vp$height,
+ vp = vp
+ )
+ }
+)
+
+theta_tickmarks <- function(key, element, length) {
+ n_breaks <- nrow(key)
+ if (n_breaks < 1 || inherits(element, "element_blank")) {
+ return(zeroGrob())
+ }
+
+ length <- rep(length, length.out = n_breaks * 2)
+ angle <- rep(key$theta, each = 2)
+ x <- rep(key$x, each = 2)
+ y <- rep(key$y, each = 2)
+ length <- rep(c(0, 1), times = n_breaks) * length
+
+ minor <- element_grob(
+ element,
+ x = unit(x, "npc") + sin(angle) * length,
+ y = unit(y, "npc") + cos(angle) * length,
+ id.lengths = rep(2, n_breaks)
+ )
+}
diff --git a/R/guide-axis.R b/R/guide-axis.R
index 8e23b155a0..2914830746 100644
--- a/R/guide-axis.R
+++ b/R/guide-axis.R
@@ -10,7 +10,10 @@
#' (recursively) prioritizing the first, last, and middle labels.
#' @param angle Compared to setting the angle in [theme()] / [element_text()],
#' this also uses some heuristics to automatically pick the `hjust` and `vjust` that
-#' you probably want.
+#' you probably want. Can be one of the following:
+#' * `NULL` to take the angles and `hjust`/`vjust` directly from the theme.
+#' * `waiver()` to allow reasonable defaults in special cases.
+#' * A number representing the text angle in degrees.
#' @param n.dodge The number of rows (for vertical axes) or columns (for
#' horizontal axes) that should be used to render the labels. This is
#' useful for displaying labels that would otherwise overlap.
@@ -43,7 +46,7 @@
#'
#' # can also be used to add a duplicate guide
#' p + guides(x = guide_axis(n.dodge = 2), y.sec = guide_axis())
-guide_axis <- function(title = waiver(), check.overlap = FALSE, angle = NULL,
+guide_axis <- function(title = waiver(), check.overlap = FALSE, angle = waiver(),
n.dodge = 1, minor.ticks = FALSE, cap = "none",
order = 0, position = waiver()) {
check_bool(minor.ticks)
@@ -64,7 +67,7 @@ guide_axis <- function(title = waiver(), check.overlap = FALSE, angle = NULL,
cap = cap,
# parameter
- available_aes = c("x", "y"),
+ available_aes = c("x", "y", "r"),
# general
order = order,
@@ -177,6 +180,12 @@ GuideAxis <- ggproto(
params$decor <- coord_munch(coord, params$decor, panel_params)
+ if (!coord$is_linear()) {
+ # For non-linear coords, we hardcode the opposite position
+ params$decor$x <- switch(position, left = 1, right = 0, params$decor$x)
+ params$decor$y <- switch(position, top = 0, bottom = 1, params$decor$y)
+ }
+
# Ported over from `warn_for_position_guide`
# This is trying to catch when a user specifies a position perpendicular
# to the direction of the axis (e.g., a "y" axis on "top").
@@ -271,7 +280,7 @@ GuideAxis <- ggproto(
}
new_params <- list(
- opposite = unname(setNames(.trbl, .trbl[c(3,4,1,2)])[position]),
+ opposite = opposite_position(position),
secondary = position %in% c("top", "right"),
lab_first = position %in% c("top", "left"),
orth_side = if (position %in% c("top", "right")) 0 else 1,
@@ -554,41 +563,42 @@ axis_label_priority_between <- function(x, y) {
#' @noRd
#'
axis_label_element_overrides <- function(axis_position, angle = NULL) {
- if (is.null(angle)) {
+
+ if (is.null(angle) || is.waive(angle)) {
return(element_text(angle = NULL, hjust = NULL, vjust = NULL))
}
- # it is not worth the effort to align upside-down labels properly
- check_number_decimal(angle, min = -90, max = 90)
+ check_number_decimal(angle)
+ angle <- angle %% 360
if (axis_position == "bottom") {
- element_text(
- angle = angle,
- hjust = if (angle > 0) 1 else if (angle < 0) 0 else 0.5,
- vjust = if (abs(angle) == 90) 0.5 else 1
- )
+
+ hjust = if (angle %in% c(0, 180)) 0.5 else if (angle < 180) 1 else 0
+ vjust = if (angle %in% c(90, 270)) 0.5 else if (angle > 90 & angle < 270) 0 else 1
+
} else if (axis_position == "left") {
- element_text(
- angle = angle,
- hjust = if (abs(angle) == 90) 0.5 else 1,
- vjust = if (angle > 0) 0 else if (angle < 0) 1 else 0.5,
- )
+
+ hjust = if (angle %in% c(90, 270)) 0.5 else if (angle > 90 & angle < 270) 0 else 1
+ vjust = if (angle %in% c(0, 180)) 0.5 else if (angle < 180) 0 else 1
+
} else if (axis_position == "top") {
- element_text(
- angle = angle,
- hjust = if (angle > 0) 0 else if (angle < 0) 1 else 0.5,
- vjust = if (abs(angle) == 90) 0.5 else 0
- )
+
+ hjust = if (angle %in% c(0, 180)) 0.5 else if (angle < 180) 0 else 1
+ vjust = if (angle %in% c(90, 270)) 0.5 else if (angle > 90 & angle < 270) 1 else 0
+
} else if (axis_position == "right") {
- element_text(
- angle = angle,
- hjust = if (abs(angle) == 90) 0.5 else 0,
- vjust = if (angle > 0) 1 else if (angle < 0) 0 else 0.5,
- )
+
+ hjust = if (angle %in% c(90, 270)) 0.5 else if (angle > 90 & angle < 270) 1 else 0
+ vjust = if (angle %in% c(0, 180)) 0.5 else if (angle < 180) 1 else 0
+
} else {
+
cli::cli_abort(c(
"Unrecognized {.arg axis_position}: {.val {axis_position}}",
"i" = "Use one of {.val top}, {.val bottom}, {.val left} or {.val right}"
))
+
}
+
+ element_text(angle = angle, hjust = hjust, vjust = vjust)
}
diff --git a/R/layout.R b/R/layout.R
index 6e2124e8be..e6a292932c 100644
--- a/R/layout.R
+++ b/R/layout.R
@@ -257,11 +257,13 @@ Layout <- ggproto("Layout", NULL,
guides <- c("x", "x.sec")
}
params <- self$panel_params[[1]]$guides$get_params(guides)
- primary <- params[[1]]$title %|W|% primary
- secondary <- params[[2]]$title %|W|% secondary
- position <- params[[1]]$position %||% scale$position
- if (position != scale$position) {
- order <- rev(order)
+ if (!is.null(params)) {
+ primary <- params[[1]]$title %|W|% primary
+ secondary <- params[[2]]$title %|W|% secondary
+ position <- params[[1]]$position %||% scale$position
+ if (position != scale$position) {
+ order <- rev(order)
+ }
}
}
primary <- scale$make_title(primary)
diff --git a/R/margins.R b/R/margins.R
index a1c14a5b42..674d05bd46 100644
--- a/R/margins.R
+++ b/R/margins.R
@@ -252,19 +252,30 @@ rotate_just <- function(angle, hjust, vjust) {
#vnew <- sin(rad) * hjust + cos(rad) * vjust + (1 - cos(rad) - sin(rad)) / 2
angle <- (angle %||% 0) %% 360
- if (0 <= angle & angle < 90) {
- hnew <- hjust
- vnew <- vjust
- } else if (90 <= angle & angle < 180) {
- hnew <- 1 - vjust
- vnew <- hjust
- } else if (180 <= angle & angle < 270) {
- hnew <- 1 - hjust
- vnew <- 1 - vjust
- } else if (270 <= angle & angle < 360) {
- hnew <- vjust
- vnew <- 1 - hjust
- }
+
+ # Apply recycle rules
+ size <- vec_size_common(angle, hjust, vjust)
+ angle <- vec_recycle(angle, size)
+ hjust <- vec_recycle(hjust, size)
+ vjust <- vec_recycle(vjust, size)
+
+ # Find quadrant on circle
+ case <- findInterval(angle, c(0, 90, 180, 270, 360))
+
+ hnew <- hjust
+ vnew <- vjust
+
+ is_case <- which(case == 2) # 90 <= x < 180
+ hnew[is_case] <- 1 - vjust[is_case]
+ vnew[is_case] <- hjust[is_case]
+
+ is_case <- which(case == 3) # 180 <= x < 270
+ hnew[is_case] <- 1 - hjust[is_case]
+ vnew[is_case] <- 1 - vjust[is_case]
+
+ is_case <- which(case == 4) # 270 <= x < 360
+ hnew[is_case] <- vjust[is_case]
+ vnew[is_case] <- 1 - hjust[is_case]
list(hjust = hnew, vjust = vnew)
}
diff --git a/_pkgdown.yml b/_pkgdown.yml
index 7dbedc3062..fa854d76ef 100644
--- a/_pkgdown.yml
+++ b/_pkgdown.yml
@@ -126,6 +126,7 @@ reference:
- guide_colourbar
- guide_legend
- guide_axis
+ - guide_axis_theta
- guide_bins
- guide_coloursteps
- guide_none
diff --git a/man/coord_polar.Rd b/man/coord_polar.Rd
index a04f202961..da54c854fa 100644
--- a/man/coord_polar.Rd
+++ b/man/coord_polar.Rd
@@ -1,10 +1,23 @@
% Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/coord-polar.R
+% Please edit documentation in R/coord-polar.R, R/coord-radial.R
\name{coord_polar}
\alias{coord_polar}
+\alias{coord_radial}
\title{Polar coordinates}
\usage{
coord_polar(theta = "x", start = 0, direction = 1, clip = "on")
+
+coord_radial(
+ theta = "x",
+ start = 0,
+ end = NULL,
+ expand = TRUE,
+ direction = 1,
+ clip = "off",
+ r_axis_inside = NULL,
+ rotate_angle = FALSE,
+ donut = 0
+)
}
\arguments{
\item{theta}{variable to map angle to (\code{x} or \code{y})}
@@ -17,10 +30,39 @@ is applied clockwise or anticlockwise depending on value of \code{direction}.}
\item{clip}{Should drawing be clipped to the extent of the plot panel? A
setting of \code{"on"} (the default) means yes, and a setting of \code{"off"}
means no. For details, please see \code{\link[=coord_cartesian]{coord_cartesian()}}.}
+
+\item{end}{Position from 12 o'clock in radians where plot ends, to allow
+for partial polar coordinates. The default, \code{NULL}, is set to
+\code{start + 2 * pi}.}
+
+\item{expand}{If \code{TRUE}, the default, adds a small expansion factor the
+the limits to prevent overlap between data and axes. If \code{FALSE}, limits
+are taken directly from the scale.}
+
+\item{r_axis_inside}{If \code{TRUE}, places the radius axis inside the
+panel. If \code{FALSE}, places the radius axis next to the panel. The default,
+\code{NULL}, places the radius axis outside if the \code{start} and \code{end} arguments
+form a full circle.}
+
+\item{rotate_angle}{If \code{TRUE}, transforms the \code{angle} aesthetic in data
+in accordance with the computed \code{theta} position. If \code{FALSE} (default),
+no such transformation is performed. Can be useful to rotate text geoms in
+alignment with the coordinates.}
+
+\item{donut}{A \code{numeric} between 0 and 1 setting the size of a donut hole.}
}
\description{
The polar coordinate system is most commonly used for pie charts, which
-are a stacked bar chart in polar coordinates.
+are a stacked bar chart in polar coordinates. \code{coord_radial()} has extended
+options.
+}
+\note{
+In \code{coord_radial()}, position guides are can be defined by using
+\code{guides(r = ..., theta = ..., r.sec = ..., theta.sec = ...)}. Note that
+these guides require \code{r} and \code{theta} as available aesthetics. The classic
+\code{guide_axis()} can be used for the \code{r} positions and \code{guide_axis_theta()} can
+be used for the \code{theta} positions. Using the \code{theta.sec} position is only
+sensible when \code{donut > 0}.
}
\examples{
# NOTE: Use these plots with caution - polar coordinates has
@@ -69,4 +111,8 @@ doh + geom_bar(width = 1) + coord_polar()
doh + geom_bar(width = 0.9, position = "fill") + coord_polar(theta = "y")
}
}
+# A partial polar plot
+ggplot(mtcars, aes(disp, mpg)) +
+ geom_point() +
+ coord_radial(start = -0.4 * pi, end = 0.4 * pi, donut = 0.3)
}
diff --git a/man/ggplot2-ggproto.Rd b/man/ggplot2-ggproto.Rd
index 37a042dd68..04e9780bfe 100644
--- a/man/ggplot2-ggproto.Rd
+++ b/man/ggplot2-ggproto.Rd
@@ -3,28 +3,29 @@
% R/annotation-logticks.R, R/geom-polygon.R, R/geom-map.R, R/annotation-map.R,
% R/geom-raster.R, R/annotation-raster.R, R/axis-secondary.R, R/coord-.R,
% R/coord-cartesian-.R, R/coord-fixed.R, R/coord-flip.R, R/coord-map.R,
-% R/coord-polar.R, R/coord-quickmap.R, R/coord-transform.R, R/facet-.R,
-% R/facet-grid-.R, R/facet-null.R, R/facet-wrap.R, R/stat-.R, R/geom-abline.R,
-% R/geom-rect.R, R/geom-bar.R, R/geom-blank.R, R/geom-boxplot.R, R/geom-col.R,
-% R/geom-path.R, R/geom-contour.R, R/geom-crossbar.R, R/geom-segment.R,
-% R/geom-curve.R, R/geom-ribbon.R, R/geom-density.R, R/geom-density2d.R,
-% R/geom-dotplot.R, R/geom-errorbar.R, R/geom-errorbarh.R, R/geom-function.R,
-% R/geom-hex.R, R/geom-hline.R, R/geom-label.R, R/geom-linerange.R,
-% R/geom-point.R, R/geom-pointrange.R, R/geom-quantile.R, R/geom-rug.R,
-% R/geom-smooth.R, R/geom-spoke.R, R/geom-text.R, R/geom-tile.R,
-% R/geom-violin.R, R/geom-vline.R, R/guide-.R, R/guide-axis.R,
-% R/guide-legend.R, R/guide-bins.R, R/guide-colorbar.R, R/guide-colorsteps.R,
-% R/guide-none.R, R/guide-old.R, R/layout.R, R/position-.R,
-% R/position-dodge.R, R/position-dodge2.R, R/position-identity.R,
-% R/position-jitter.R, R/position-jitterdodge.R, R/position-nudge.R,
-% R/position-stack.R, R/scale-.R, R/scale-binned.R, R/scale-continuous.R,
-% R/scale-date.R, R/scale-discrete-.R, R/scale-identity.R, R/stat-align.R,
-% R/stat-bin.R, R/stat-bin2d.R, R/stat-bindot.R, R/stat-binhex.R,
-% R/stat-boxplot.R, R/stat-contour.R, R/stat-count.R, R/stat-density-2d.R,
-% R/stat-density.R, R/stat-ecdf.R, R/stat-ellipse.R, R/stat-function.R,
-% R/stat-identity.R, R/stat-qq-line.R, R/stat-qq.R, R/stat-quantilemethods.R,
-% R/stat-smooth.R, R/stat-sum.R, R/stat-summary-2d.R, R/stat-summary-bin.R,
-% R/stat-summary-hex.R, R/stat-summary.R, R/stat-unique.R, R/stat-ydensity.R
+% R/coord-polar.R, R/coord-quickmap.R, R/coord-radial.R, R/coord-transform.R,
+% R/facet-.R, R/facet-grid-.R, R/facet-null.R, R/facet-wrap.R, R/stat-.R,
+% R/geom-abline.R, R/geom-rect.R, R/geom-bar.R, R/geom-blank.R,
+% R/geom-boxplot.R, R/geom-col.R, R/geom-path.R, R/geom-contour.R,
+% R/geom-crossbar.R, R/geom-segment.R, R/geom-curve.R, R/geom-ribbon.R,
+% R/geom-density.R, R/geom-density2d.R, R/geom-dotplot.R, R/geom-errorbar.R,
+% R/geom-errorbarh.R, R/geom-function.R, R/geom-hex.R, R/geom-hline.R,
+% R/geom-label.R, R/geom-linerange.R, R/geom-point.R, R/geom-pointrange.R,
+% R/geom-quantile.R, R/geom-rug.R, R/geom-smooth.R, R/geom-spoke.R,
+% R/geom-text.R, R/geom-tile.R, R/geom-violin.R, R/geom-vline.R,
+% R/guide-.R, R/guide-axis.R, R/guide-legend.R, R/guide-bins.R,
+% R/guide-colorbar.R, R/guide-colorsteps.R, R/guide-none.R, R/guide-old.R,
+% R/layout.R, R/position-.R, R/position-dodge.R, R/position-dodge2.R,
+% R/position-identity.R, R/position-jitter.R, R/position-jitterdodge.R,
+% R/position-nudge.R, R/position-stack.R, R/scale-.R, R/scale-binned.R,
+% R/scale-continuous.R, R/scale-date.R, R/scale-discrete-.R,
+% R/scale-identity.R, R/stat-align.R, R/stat-bin.R, R/stat-bin2d.R,
+% R/stat-bindot.R, R/stat-binhex.R, R/stat-boxplot.R, R/stat-contour.R,
+% R/stat-count.R, R/stat-density-2d.R, R/stat-density.R, R/stat-ecdf.R,
+% R/stat-ellipse.R, R/stat-function.R, R/stat-identity.R, R/stat-qq-line.R,
+% R/stat-qq.R, R/stat-quantilemethods.R, R/stat-smooth.R, R/stat-sum.R,
+% R/stat-summary-2d.R, R/stat-summary-bin.R, R/stat-summary-hex.R,
+% R/stat-summary.R, R/stat-unique.R, R/stat-ydensity.R
\docType{data}
\name{ggplot2-ggproto}
\alias{ggplot2-ggproto}
@@ -44,6 +45,7 @@
\alias{CoordMap}
\alias{CoordPolar}
\alias{CoordQuickmap}
+\alias{CoordRadial}
\alias{CoordTrans}
\alias{Facet}
\alias{FacetGrid}
diff --git a/man/guide_axis.Rd b/man/guide_axis.Rd
index d2efadff8e..fa09421300 100644
--- a/man/guide_axis.Rd
+++ b/man/guide_axis.Rd
@@ -7,7 +7,7 @@
guide_axis(
title = waiver(),
check.overlap = FALSE,
- angle = NULL,
+ angle = waiver(),
n.dodge = 1,
minor.ticks = FALSE,
cap = "none",
@@ -26,7 +26,12 @@ specified in \code{\link[=labs]{labs()}} is used for the title.}
\item{angle}{Compared to setting the angle in \code{\link[=theme]{theme()}} / \code{\link[=element_text]{element_text()}},
this also uses some heuristics to automatically pick the \code{hjust} and \code{vjust} that
-you probably want.}
+you probably want. Can be one of the following:
+\itemize{
+\item \code{NULL} to take the angles and \code{hjust}/\code{vjust} directly from the theme.
+\item \code{waiver()} to allow reasonable defaults in special cases.
+\item A number representing the text angle in degrees.
+}}
\item{n.dodge}{The number of rows (for vertical axes) or columns (for
horizontal axes) that should be used to render the labels. This is
diff --git a/man/guide_axis_theta.Rd b/man/guide_axis_theta.Rd
new file mode 100644
index 0000000000..16a8e89cf1
--- /dev/null
+++ b/man/guide_axis_theta.Rd
@@ -0,0 +1,65 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/guide-axis-theta.R
+\name{guide_axis_theta}
+\alias{guide_axis_theta}
+\title{Angle axis guide}
+\usage{
+guide_axis_theta(
+ title = waiver(),
+ angle = waiver(),
+ minor.ticks = FALSE,
+ cap = "none",
+ order = 0,
+ position = waiver()
+)
+}
+\arguments{
+\item{title}{A character string or expression indicating a title of guide.
+If \code{NULL}, the title is not shown. By default
+(\code{\link[=waiver]{waiver()}}), the name of the scale object or the name
+specified in \code{\link[=labs]{labs()}} is used for the title.}
+
+\item{angle}{Compared to setting the angle in \code{\link[=theme]{theme()}} / \code{\link[=element_text]{element_text()}},
+this also uses some heuristics to automatically pick the \code{hjust} and \code{vjust} that
+you probably want. Can be one of the following:
+\itemize{
+\item \code{NULL} to take the angles and \code{hjust}/\code{vjust} directly from the theme.
+\item \code{waiver()} to allow reasonable defaults in special cases.
+\item A number representing the text angle in degrees.
+}}
+
+\item{minor.ticks}{Whether to draw the minor ticks (\code{TRUE}) or not draw
+minor ticks (\code{FALSE}, default).}
+
+\item{cap}{A \code{character} to cut the axis line back to the last breaks. Can
+be \code{"none"} (default) to draw the axis line along the whole panel, or
+\code{"upper"} and \code{"lower"} to draw the axis to the upper or lower break, or
+\code{"both"} to only draw the line in between the most extreme breaks. \code{TRUE}
+and \code{FALSE} are shorthand for \code{"both"} and \code{"none"} respectively.}
+
+\item{order}{A positive \code{integer} of length 1 that specifies the order of
+this guide among multiple guides. This controls in which order guides are
+merged if there are multiple guides for the same position. If 0 (default),
+the order is determined by a secret algorithm.}
+
+\item{position}{Where this guide should be drawn: one of top, bottom,
+left, or right.}
+}
+\description{
+This is a specialised guide used in \code{coord_radial()} to represent the theta
+position scale.
+}
+\note{
+The axis labels in this guide are insensitive to \code{hjust} and \code{vjust}
+settings. The distance from the tick marks to the labels is determined by
+the largest \code{margin} size set in the theme.
+}
+\examples{
+# A plot using coord_radial
+p <- ggplot(mtcars, aes(disp, mpg)) +
+ geom_point() +
+ coord_radial()
+
+# The `angle` argument can be used to set relative angles
+p + guides(theta = guide_axis_theta(angle = 0))
+}
diff --git a/tests/testthat/_snaps/coord-polar.md b/tests/testthat/_snaps/coord-polar.md
new file mode 100644
index 0000000000..9b9a48099f
--- /dev/null
+++ b/tests/testthat/_snaps/coord-polar.md
@@ -0,0 +1,10 @@
+# coord_radial warns about axes
+
+ `guide_axis()` cannot be used for theta.
+ i Use one of x, y, or r instead.
+
+---
+
+ No appropriate placement found for `r_axis_inside`.
+ i Axis will be placed at panel edge.
+
diff --git a/tests/testthat/_snaps/coord-polar/bottom-half-circle-with-rotated-text.svg b/tests/testthat/_snaps/coord-polar/bottom-half-circle-with-rotated-text.svg
new file mode 100644
index 0000000000..8dd86b9e70
--- /dev/null
+++ b/tests/testthat/_snaps/coord-polar/bottom-half-circle-with-rotated-text.svg
@@ -0,0 +1,75 @@
+
+
diff --git a/tests/testthat/_snaps/coord-polar/donut-with-all-axes.svg b/tests/testthat/_snaps/coord-polar/donut-with-all-axes.svg
new file mode 100644
index 0000000000..463773d759
--- /dev/null
+++ b/tests/testthat/_snaps/coord-polar/donut-with-all-axes.svg
@@ -0,0 +1,126 @@
+
+
diff --git a/tests/testthat/_snaps/coord-polar/partial-with-all-axes.svg b/tests/testthat/_snaps/coord-polar/partial-with-all-axes.svg
new file mode 100644
index 0000000000..bc58f6429b
--- /dev/null
+++ b/tests/testthat/_snaps/coord-polar/partial-with-all-axes.svg
@@ -0,0 +1,127 @@
+
+
diff --git a/tests/testthat/_snaps/coord_sf/coord-sf-with-custom-guides.svg b/tests/testthat/_snaps/coord_sf/coord-sf-with-custom-guides.svg
index 7037b22e72..8447a9d8d5 100644
--- a/tests/testthat/_snaps/coord_sf/coord-sf-with-custom-guides.svg
+++ b/tests/testthat/_snaps/coord_sf/coord-sf-with-custom-guides.svg
@@ -47,27 +47,27 @@
-80
-°
-W
-79
-°
-W
-78
-°
-W
-77
-°
-W
-76
-°
-W
-75
-°
-W
-40
-°
-N
+80
+°
+W
+79
+°
+W
+78
+°
+W
+77
+°
+W
+76
+°
+W
+75
+°
+W
+40
+°
+N
35
°
N
diff --git a/tests/testthat/_snaps/guides.md b/tests/testthat/_snaps/guides.md
index 6fb109ecbd..202b064f29 100644
--- a/tests/testthat/_snaps/guides.md
+++ b/tests/testthat/_snaps/guides.md
@@ -1,16 +1,3 @@
-# axis_label_element_overrides errors when angles are outside the range [0, 90]
-
- `angle` must be a number between -90 and 90, not the number 91.
-
----
-
- `angle` must be a number between -90 and 90, not the number -91.
-
----
-
- Unrecognized `axis_position`: "test"
- i Use one of "top", "bottom", "left" or "right"
-
# Using non-position guides for position scales results in an informative error
`guide_legend()` cannot be used for x, xmin, xmax, or xend.
diff --git a/tests/testthat/_snaps/guides/axis-guides-negative-rotation.svg b/tests/testthat/_snaps/guides/axis-guides-negative-rotation.svg
index 8902fa04cd..f5ad2b2273 100644
--- a/tests/testthat/_snaps/guides/axis-guides-negative-rotation.svg
+++ b/tests/testthat/_snaps/guides/axis-guides-negative-rotation.svg
@@ -70,16 +70,16 @@
-1,000
-2,000
-3,000
-4,000
-5,000
-6,000
-7,000
-8,000
-9,000
-10,000
+1,000
+2,000
+3,000
+4,000
+5,000
+6,000
+7,000
+8,000
+9,000
+10,000
@@ -91,16 +91,16 @@
-1,000
-2,000
-3,000
-4,000
-5,000
-6,000
-7,000
-8,000
-9,000
-10,000
+1,000
+2,000
+3,000
+4,000
+5,000
+6,000
+7,000
+8,000
+9,000
+10,000
@@ -112,27 +112,27 @@
-1,000
-2,000
-3,000
-4,000
-5,000
-6,000
-7,000
-8,000
-9,000
-10,000
+1,000
+2,000
+3,000
+4,000
+5,000
+6,000
+7,000
+8,000
+9,000
+10,000
-1,000
-2,000
-3,000
-4,000
-5,000
-6,000
-7,000
-8,000
-9,000
-10,000
+1,000
+2,000
+3,000
+4,000
+5,000
+6,000
+7,000
+8,000
+9,000
+10,000
diff --git a/tests/testthat/_snaps/guides/axis-guides-vertical-negative-rotation.svg b/tests/testthat/_snaps/guides/axis-guides-vertical-negative-rotation.svg
index 1d83ebc1e2..fb7d39a9d3 100644
--- a/tests/testthat/_snaps/guides/axis-guides-vertical-negative-rotation.svg
+++ b/tests/testthat/_snaps/guides/axis-guides-vertical-negative-rotation.svg
@@ -70,16 +70,16 @@
-1,000
-2,000
-3,000
-4,000
-5,000
-6,000
-7,000
-8,000
-9,000
-10,000
+1,000
+2,000
+3,000
+4,000
+5,000
+6,000
+7,000
+8,000
+9,000
+10,000
@@ -91,16 +91,16 @@
-1,000
-2,000
-3,000
-4,000
-5,000
-6,000
-7,000
-8,000
-9,000
-10,000
+1,000
+2,000
+3,000
+4,000
+5,000
+6,000
+7,000
+8,000
+9,000
+10,000
@@ -112,27 +112,27 @@
-1,000
-2,000
-3,000
-4,000
-5,000
-6,000
-7,000
-8,000
-9,000
-10,000
+1,000
+2,000
+3,000
+4,000
+5,000
+6,000
+7,000
+8,000
+9,000
+10,000
-1,000
-2,000
-3,000
-4,000
-5,000
-6,000
-7,000
-8,000
-9,000
-10,000
+1,000
+2,000
+3,000
+4,000
+5,000
+6,000
+7,000
+8,000
+9,000
+10,000
diff --git a/tests/testthat/_snaps/guides/guide-axis-theta-in-cartesian-coordinates.svg b/tests/testthat/_snaps/guides/guide-axis-theta-in-cartesian-coordinates.svg
new file mode 100644
index 0000000000..61a923ac4e
--- /dev/null
+++ b/tests/testthat/_snaps/guides/guide-axis-theta-in-cartesian-coordinates.svg
@@ -0,0 +1,131 @@
+
+
diff --git a/tests/testthat/_snaps/guides/guide-axis-theta-with-angle-adapting-to-theta.svg b/tests/testthat/_snaps/guides/guide-axis-theta-with-angle-adapting-to-theta.svg
new file mode 100644
index 0000000000..5e2a6fdbfe
--- /dev/null
+++ b/tests/testthat/_snaps/guides/guide-axis-theta-with-angle-adapting-to-theta.svg
@@ -0,0 +1,192 @@
+
+
diff --git a/tests/testthat/test-coord-polar.R b/tests/testthat/test-coord-polar.R
index f1570b6a96..d4bb5b014d 100644
--- a/tests/testthat/test-coord-polar.R
+++ b/tests/testthat/test-coord-polar.R
@@ -79,6 +79,51 @@ test_that("Inf is squished to range", {
expect_equal(d[[3]]$theta, mapped_discrete(0))
})
+test_that("coord_radial warns about axes", {
+
+ p <- ggplot(mtcars, aes(disp, mpg)) +
+ geom_point()
+
+ # Cannot use regular axis for theta position
+ expect_snapshot_warning(ggplotGrob(
+ p + coord_radial() + guides(theta = "axis")
+ ))
+
+ # If arc doesn't contain the top/bottom/left/right of a circle,
+ # axis placement cannot be outside panel
+ expect_snapshot_warning(ggplotGrob(
+ p + coord_radial(start = 0.1 * pi, end = 0.4 * pi, r_axis_inside = FALSE)
+ ))
+
+})
+
+test_that("bounding box calculations are sensible", {
+
+ # Full cirle
+ expect_equal(
+ polar_bbox(arc = c(0, 2 * pi)),
+ list(x = c(0, 1), y = c(0, 1))
+ )
+
+ # Right half of circle
+ expect_equal(
+ polar_bbox(arc = c(0, pi)),
+ list(x = c(0.45, 1), y = c(0, 1))
+ )
+
+ # Right quarter of circle
+ expect_equal(
+ polar_bbox(arc = c(0.25 * pi, 0.75 * pi)),
+ list(x = c(0.45, 1), y = c(0.146446609, 0.853553391))
+ )
+
+ # Top quarter of circle with donuthole
+ expect_equal(
+ polar_bbox(arc = c(-0.25 * pi, 0.25 * pi), donut = c(0.2, 0.4)),
+ list(x = c(0.146446609, 0.853553391), y = c(0.59142136, 1))
+ )
+})
+
# Visual tests ------------------------------------------------------------
@@ -140,3 +185,50 @@ test_that("polar coordinates draw correctly", {
theme(axis.text.x = element_blank())
)
})
+
+test_that("coord_radial() draws correctly", {
+
+ # Theme to test for axis placement
+ theme <- theme(
+ axis.line.x.bottom = element_line(colour = "tomato"),
+ axis.line.x.top = element_line(colour = "limegreen"),
+ axis.line.y.left = element_line(colour = "dodgerblue"),
+ axis.line.y.right = element_line(colour = "orchid")
+ )
+
+ p <- ggplot(mtcars, aes(disp, mpg)) +
+ geom_point() +
+ theme
+
+ expect_doppelganger("donut with all axes", {
+ p + coord_radial(donut = 0.3, r_axis_inside = FALSE) +
+ guides(r.sec = "axis", theta.sec = "axis_theta")
+ })
+
+ expect_doppelganger("partial with all axes", {
+ p + coord_radial(start = 0.25 * pi, end = 0.75 * pi, donut = 0.3,
+ r_axis_inside = TRUE, theta = "y") +
+ guides(r.sec = "axis", theta.sec = "axis_theta")
+ })
+
+ df <- data_frame0(
+ x = 1:5, lab = c("cat", "strawberry\ncake", "coffee", "window", "fluid")
+ )
+
+ ggplot(df, aes(x, label = lab)) +
+ geom_text(aes(y = "0 degrees"), angle = 0) +
+ geom_text(aes(y = "90 degrees"), angle = 90) +
+ coord_radial(start = 0.5 * pi, end = 1.5 * pi,
+ rotate_angle = TRUE) +
+ theme
+
+ expect_doppelganger(
+ "bottom half circle with rotated text",
+ ggplot(df, aes(x, label = lab)) +
+ geom_text(aes(y = "0 degrees"), angle = 0) +
+ geom_text(aes(y = "90 degrees"), angle = 90) +
+ coord_radial(start = 0.5 * pi, end = 1.5 * pi,
+ rotate_angle = TRUE, r_axis_inside = FALSE) +
+ theme
+ )
+})
diff --git a/tests/testthat/test-guides.R b/tests/testthat/test-guides.R
index 0d029c8b1b..9c335af80b 100644
--- a/tests/testthat/test-guides.R
+++ b/tests/testthat/test-guides.R
@@ -96,13 +96,6 @@ test_that("axis_label_overlap_priority always returns the correct number of elem
expect_setequal(axis_label_priority(100), seq_len(100))
})
-test_that("axis_label_element_overrides errors when angles are outside the range [0, 90]", {
- expect_s3_class(axis_label_element_overrides("bottom", 0), "element")
- expect_snapshot_error(axis_label_element_overrides("bottom", 91))
- expect_snapshot_error(axis_label_element_overrides("bottom", -91))
- expect_snapshot_error(axis_label_element_overrides("test", 0))
-})
-
test_that("a warning is generated when guides are drawn at a location that doesn't make sense", {
plot <- ggplot(mpg, aes(class, hwy)) +
geom_point() +
@@ -835,6 +828,37 @@ test_that("binning scales understand the different combinations of limits, break
expect_snapshot_warning(ggplotGrob(p + scale_color_binned(labels = 1:4, show.limits = TRUE)))
})
+test_that("guide_axis_theta sets relative angle", {
+
+ p <- ggplot(mtcars, aes(disp, mpg)) +
+ geom_point() +
+ scale_x_continuous(breaks = breaks_width(25)) +
+ coord_radial(donut = 0.5) +
+ guides(
+ theta = guide_axis_theta(angle = 0, cap = "none"),
+ theta.sec = guide_axis_theta(angle = 90, cap = "both")
+ ) +
+ theme(axis.line = element_line(colour = "black"))
+
+ expect_doppelganger("guide_axis_theta with angle adapting to theta", p)
+})
+
+test_that("guide_axis_theta can be used in cartesian coordinates", {
+
+ p <- ggplot(mtcars, aes(disp, mpg)) +
+ geom_point() +
+ guides(x = "axis_theta", y = "axis_theta",
+ x.sec = "axis_theta", y.sec = "axis_theta") +
+ theme(
+ axis.line.x.bottom = element_line(colour = "tomato"),
+ axis.line.x.top = element_line(colour = "limegreen"),
+ axis.line.y.left = element_line(colour = "dodgerblue"),
+ axis.line.y.right = element_line(colour = "orchid")
+ )
+
+ expect_doppelganger("guide_axis_theta in cartesian coordinates", p)
+})
+
test_that("a warning is generated when guides( = FALSE) is specified", {
df <- data_frame(x = c(1, 2, 4),
y = c(6, 5, 7))