From 9c7d4be82746691f6c1edc42db29649e3205e65f Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Mon, 19 Jun 2023 21:59:15 +0200 Subject: [PATCH 01/28] allow alignment of upside-down labels --- R/guide-axis.R | 46 ++++++----- .../coord_sf/coord-sf-with-custom-guides.svg | 42 +++++----- tests/testthat/_snaps/guides.md | 13 --- .../guides/axis-guides-negative-rotation.svg | 80 +++++++++---------- ...axis-guides-vertical-negative-rotation.svg | 80 +++++++++---------- tests/testthat/test-guides.R | 7 -- 6 files changed, 125 insertions(+), 143 deletions(-) diff --git a/R/guide-axis.R b/R/guide-axis.R index 7ff9ac8dba..4ce0be711c 100644 --- a/R/guide-axis.R +++ b/R/guide-axis.R @@ -508,42 +508,44 @@ axis_label_priority_between <- function(x, y) { #' overridden from the user- or theme-supplied element. #' @noRd #' +#' axis_label_element_overrides <- function(axis_position, angle = NULL) { + if (is.null(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/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 f088f31f7d..69fa05591c 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/test-guides.R b/tests/testthat/test-guides.R index 4a3f7ed64d..7ac38957e6 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() + From e698b138c12d6a3d64786881ef4f65433eb715f4 Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Mon, 19 Jun 2023 21:59:15 +0200 Subject: [PATCH 02/28] allow alignment of upside-down labels --- R/guide-axis.R | 45 ++++++----- .../coord_sf/coord-sf-with-custom-guides.svg | 42 +++++----- tests/testthat/_snaps/guides.md | 13 --- .../guides/axis-guides-negative-rotation.svg | 80 +++++++++---------- ...axis-guides-vertical-negative-rotation.svg | 80 +++++++++---------- tests/testthat/test-guides.R | 7 -- 6 files changed, 124 insertions(+), 143 deletions(-) diff --git a/R/guide-axis.R b/R/guide-axis.R index 7ff9ac8dba..533eb57d4d 100644 --- a/R/guide-axis.R +++ b/R/guide-axis.R @@ -509,41 +509,42 @@ axis_label_priority_between <- function(x, y) { #' @noRd #' axis_label_element_overrides <- function(axis_position, angle = NULL) { + if (is.null(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/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 f088f31f7d..69fa05591c 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/test-guides.R b/tests/testthat/test-guides.R index 4a3f7ed64d..7ac38957e6 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() + From d5fce8c84774bac6abfdd1e46c19bd3c142ecc56 Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Mon, 19 Jun 2023 22:25:15 +0200 Subject: [PATCH 03/28] Allow `angle` to be a waiver --- R/guide-axis.R | 9 ++++++--- man/guide_axis.Rd | 9 +++++++-- 2 files changed, 13 insertions(+), 5 deletions(-) diff --git a/R/guide-axis.R b/R/guide-axis.R index 533eb57d4d..bdec408bba 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. @@ -41,7 +44,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, cap = "none", order = 0, position = waiver()) { @@ -510,7 +513,7 @@ axis_label_priority_between <- function(x, y) { #' 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)) } diff --git a/man/guide_axis.Rd b/man/guide_axis.Rd index 086ba0b25a..31f2be4c53 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, cap = "none", order = 0, @@ -25,7 +25,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 From 0f11fd3cfd5b59ca583e8a2cf8b562f146513d46 Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Tue, 20 Jun 2023 20:07:16 +0200 Subject: [PATCH 04/28] First implementation of guide_axis_theta --- DESCRIPTION | 1 + NAMESPACE | 1 + R/guide-axis-theta.R | 272 ++++++++++++++++++++++++++++++++++++++++ man/guide_axis_theta.Rd | 76 +++++++++++ 4 files changed, 350 insertions(+) create mode 100644 R/guide-axis-theta.R create mode 100644 man/guide_axis_theta.Rd diff --git a/DESCRIPTION b/DESCRIPTION index 22f4670da0..159800659b 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -175,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 41676e5022..72dbc8c9e8 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -411,6 +411,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/R/guide-axis-theta.R b/R/guide-axis-theta.R new file mode 100644 index 0000000000..821da30c01 --- /dev/null +++ b/R/guide-axis-theta.R @@ -0,0 +1,272 @@ +#' @include guide-axis.R +NULL + +#' Angle axis guide +#' +#' This is a specialised guide used in `coord_polar2()` to represent the theta +#' position scale. +#' +#' @inheritParams guide_axis +#' @param major.length,minor.length A `numeric` of length 1 giving the length of +#' major and minor ticks relative to the theme's setting. +#' @param minor.ticks A theme element inheriting from `element_line` or +#' `element_blank` for drawing minor ticks. Alternatively, a `logical` of +#' length 1 as shorthand for `element_line()` (`TRUE`) or `element_blank` +#' (`FALSE`). `minor.ticks = element_line(...)` can be used to style the +#' minor ticks. +#' +#' @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 basic polar plot +#' p <- ggplot(mtcars, aes(disp, mpg)) + +#' geom_point() + +#' coord_polar2() +#' +#' # The `angle` argument can be used to set relative angles +#' p + guides(theta = guide_axis_theta(angle = 0)) +#' +#' # Minor ticks can be activated by providing a line element +#' p + guides(theta = guide_axis_theta(minor.ticks = element_line())) +guide_axis_theta <- function(title = waiver(), angle = waiver(), + cap = "none", order = 0, + major.length = 1, minor.length = 0.75, + minor.ticks = element_blank(), + position = waiver()) { + + if (is.logical(cap)) { + check_bool(cap) + cap <- if (cap) "both" else "none" + } + cap <- arg_match0(cap, c("none", "both", "upper", "lower")) + + if (is.logical(minor.ticks)) { + check_bool(minor.ticks) + minor.ticks <- if (minor.ticks) element_line() else element_blank() + } + check_inherits(minor.ticks, c("element_line", "element_blank")) + if (inherits(minor.ticks, "element_blank")) { + minor.length <- 0 + } + + new_guide( + title = title, + + # customisations + angle = angle, + cap = cap, + major.length = major.length, + minor.length = minor.length, + minor.ticks = minor.ticks, + + # parameter + available_aes = c("x", "y"), + + # general + order = order, + position = position, + name = "axis", + super = GuideAxisTheta + ) +} + +GuideAxisTheta <- ggproto( + "GuideAxisTheta", GuideAxis, + + # TODO: delete if minor ticks PR (#5287) gets merged + params = c(GuideAxis$params, list( + major.length = 1, + minor.length = 0.75, + minor.ticks = NULL + )), + + # TODO: delete if minor ticks PR (#5287) gets merged + extract_key = function(scale, aesthetic, minor.ticks, ...) { + major <- Guide$extract_key(scale, aesthetic, ...) + if (is.expression(major$.label)) { + major$.label <- as.list(major$.label) + } + if (inherits(minor.ticks, "element_blank")) { + return(major) + } + if (!is.null(major)) { + major$.type <- "major" + } + minor <- setdiff(scale$get_breaks_minor(), major$.value) + new_scale <- ggproto(NULL, scale, breaks = minor, get_labels = function(...) NULL) + minor <- Guide$extract_key(new_scale, aesthetic, ...) + minor$.type <- "minor" + vec_rbind(major, minor) + }, + + extract_decor = function(scale, aesthetic, key, cap = "none", ...) { + # We put position = "left" to get `Inf` on the opposite aesthetic + GuideAxis$extract_decor( + scale = scale, aesthetic = aesthetic, + position = "left", key = key, cap = cap + ) + }, + + transform = function(params, coord, panel_params) { + opposite <- setdiff(c("x", "y"), params$aesthetic) + params$key[[opposite]] <- Inf + params <- GuideAxis$transform(params, coord, panel_params) + + key <- params$key + n <- nrow(key) + + 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) { + params + }, + + setup_elements = function(params, elements, theme) { + axis_elem <- c("line", "text", "ticks", "ticks_length") + is_char <- vapply(elements[axis_elem], is.character, logical(1)) + axis_elem <- axis_elem[is_char] + elements[axis_elem] <- lapply( + paste( + unlist(elements[axis_elem]), + params$aes, sep = "." + ), + calc_element, theme = theme + ) + elements$minor_ticks <- combine_elements(params$minor.ticks, elements$ticks) + elements + }, + + override_elements = function(params, elements, theme) { + return(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 <- (360 - key$theta * 180 / pi + params$angle) %% 360 + flip <- angle > 90 & angle < 270 + angle[flip] <- angle[flip] + 180 + } + # Text angle in radians + rad <- angle * pi / 180 + # Position angle in radians + theta <- key$theta + + # Offset distance to displace text away from outer circle line + offset <- max(0, params$major.length, params$minor.length) + offset <- max(elements$ticks_length * offset, unit(0, "pt")) + + max(elements$text$margin) + xoffset <- offset * sin(theta) + yoffset <- 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 + do.call(grobTree, Map( + element_grob, + 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, + MoreArgs = list(element = elements$text) + )) + }, + + build_ticks = function(key, elements, params, position = params$position) { + + if (".type" %in% names(key)) { + major <- vec_slice(key, key$.type == "major") + minor <- vec_slice(key, key$.type == "minor") + } else { + major <- key + minor <- NULL + } + + n_breaks <- nrow(major) + + tick_len <- elements$ticks_length * params$major.length + tick_len <- rep(tick_len, length.out = n_breaks * 2) + + angle <- rep(major$theta, each = 2) + x <- rep(major$x, each = 2) + y <- rep(major$y, each = 2) + end <- rep(c(0, 1), n_breaks) + + major <- element_grob( + elements$ticks, + x = unit(x, "npc") + sin(angle) * end * tick_len, + y = unit(y, "npc") + cos(angle) * end * tick_len, + id.lengths = rep(2, n_breaks) + ) + + if (empty(minor) || inherits(elements$minor_ticks, "element_blank")) { + return(major) + } + + n_breaks <- nrow(minor) + + tick_len <- elements$ticks_length * params$minor.length + tick_len <- rep(tick_len, length.out = n_breaks * 2) + + angle <- rep(minor$theta, each = 2) + x <- rep(minor$x, each = 2) + y <- rep(minor$y, each = 2) + end <- rep(c(0, 1), n_breaks) + + minor <- element_grob( + elements$minor_ticks, + x = unit(x, "npc") + sin(angle) * end * tick_len, + y = unit(y, "npc") + cos(angle) * end * tick_len, + id.lengths = rep(2, n_breaks) + ) + + grobTree(major, minor, name = "ticks") + }, + + measure_grobs = function(grobs, params, elements) { + return(invisible()) + }, + + arrange_layout = function(key, sizes, params) { + return(invisible()) + }, + + assemble_drawing = function(grobs, layout, sizes, params, elements) { + do.call(grobTree, grobs) + } + +) + diff --git a/man/guide_axis_theta.Rd b/man/guide_axis_theta.Rd new file mode 100644 index 0000000000..abf72df583 --- /dev/null +++ b/man/guide_axis_theta.Rd @@ -0,0 +1,76 @@ +% 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(), + cap = "none", + order = 0, + major.length = 1, + minor.length = 0.75, + minor.ticks = element_blank(), + 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{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{major.length, minor.length}{A \code{numeric} of length 1 giving the length of +major and minor ticks relative to the theme's setting.} + +\item{minor.ticks}{A theme element inheriting from \code{element_line} or +\code{element_blank} for drawing minor ticks. Alternatively, a \code{logical} of +length 1 as shorthand for \code{element_line()} (\code{TRUE}) or \code{element_blank} +(\code{FALSE}). \code{minor.ticks = element_line(...)} can be used to style the +minor ticks.} + +\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_polar2()} 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 basic polar plot +p <- ggplot(mtcars, aes(disp, mpg)) + + geom_point() + + coord_polar2() + +# The `angle` argument can be used to set relative angles +p + guides(theta = guide_axis_theta(angle = 0)) + +# Minor ticks can be activated by providing a line element +p + guides(theta = guide_axis_theta(minor.ticks = element_line())) +} From 25bdb6634c5d4d56f047f956ec84c61269ce8b76 Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Wed, 21 Jun 2023 23:27:14 +0200 Subject: [PATCH 05/28] Add theta/r to available aes --- R/guide-axis-theta.R | 2 +- R/guide-axis.R | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/R/guide-axis-theta.R b/R/guide-axis-theta.R index 821da30c01..a02b42e85f 100644 --- a/R/guide-axis-theta.R +++ b/R/guide-axis-theta.R @@ -65,7 +65,7 @@ guide_axis_theta <- function(title = waiver(), angle = waiver(), minor.ticks = minor.ticks, # parameter - available_aes = c("x", "y"), + available_aes = c("x", "y", "theta"), # general order = order, diff --git a/R/guide-axis.R b/R/guide-axis.R index bdec408bba..6531d7faf1 100644 --- a/R/guide-axis.R +++ b/R/guide-axis.R @@ -65,7 +65,7 @@ guide_axis <- function(title = waiver(), check.overlap = FALSE, angle = waiver() cap = cap, # parameter - available_aes = c("x", "y"), + available_aes = c("x", "y", "r"), # general order = order, From c21ac204ce95e400141f82073058789aff9609e2 Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Wed, 21 Jun 2023 23:28:10 +0200 Subject: [PATCH 06/28] theta guide refuses regular positions --- R/guide-axis-theta.R | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/R/guide-axis-theta.R b/R/guide-axis-theta.R index a02b42e85f..4b6b3de9a4 100644 --- a/R/guide-axis-theta.R +++ b/R/guide-axis-theta.R @@ -113,6 +113,15 @@ GuideAxisTheta <- ggproto( }, transform = function(params, coord, panel_params) { + + if (params$position != "theta") { + cli::cli_warn(c(paste0( + "{.fn guide_axis_theta} cannot be used for the ", + "{.field {params$position}} position." + ), i = "It requires the position to be {.field theta}.")) + return(NULL) + } + opposite <- setdiff(c("x", "y"), params$aesthetic) params$key[[opposite]] <- Inf params <- GuideAxis$transform(params, coord, panel_params) From ee65abaf6bf212e6d44bef72bb6a191c95ba0902 Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Wed, 21 Jun 2023 23:29:38 +0200 Subject: [PATCH 07/28] Don't set labels to NULL when guide cannot be found --- R/layout.R | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) 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) From 07a625a4b742a0e0315a422090563e70937bb245 Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Thu, 22 Jun 2023 21:46:56 +0200 Subject: [PATCH 08/28] opposite_position helper --- R/guide-.R | 9 +++++++++ R/guide-axis.R | 2 +- 2 files changed, 10 insertions(+), 1 deletion(-) diff --git a/R/guide-.R b/R/guide-.R index a1c194bf99..93ff484eb5 100644 --- a/R/guide-.R +++ b/R/guide-.R @@ -342,3 +342,12 @@ 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" + ) +} diff --git a/R/guide-axis.R b/R/guide-axis.R index 6531d7faf1..eb5f0fb326 100644 --- a/R/guide-axis.R +++ b/R/guide-axis.R @@ -257,7 +257,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, From baa591aa12ebbfac86c5d3fd1363aa4a6d572bdb Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Thu, 22 Jun 2023 21:48:28 +0200 Subject: [PATCH 09/28] Fallback for regular positions --- R/guide-axis-theta.R | 83 +++++++++++++++++++++++++++++++------------- 1 file changed, 59 insertions(+), 24 deletions(-) diff --git a/R/guide-axis-theta.R b/R/guide-axis-theta.R index 4b6b3de9a4..909e98fc8e 100644 --- a/R/guide-axis-theta.R +++ b/R/guide-axis-theta.R @@ -114,14 +114,6 @@ GuideAxisTheta <- ggproto( transform = function(params, coord, panel_params) { - if (params$position != "theta") { - cli::cli_warn(c(paste0( - "{.fn guide_axis_theta} cannot be used for the ", - "{.field {params$position}} position." - ), i = "It requires the position to be {.field theta}.")) - return(NULL) - } - opposite <- setdiff(c("x", "y"), params$aesthetic) params$key[[opposite]] <- Inf params <- GuideAxis$transform(params, coord, panel_params) @@ -129,18 +121,32 @@ GuideAxisTheta <- ggproto( key <- params$key n <- nrow(key) - 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 = "/") + if (!("theta" %in% names(key))) { + # We likely have a linear coord, so we match the text angles to + # standard axes. + key$theta <- switch( + params$position, + top = 0, + bottom = 1 * pi, + left = 1.5 * pi, + right = 0.5 * pi + ) + } else { + # 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) } - key$.label[[n]] <- combined - key <- vec_slice(key, -1) } params$key <- key @@ -194,11 +200,8 @@ GuideAxisTheta <- ggproto( theta <- key$theta # Offset distance to displace text away from outer circle line - offset <- max(0, params$major.length, params$minor.length) - offset <- max(elements$ticks_length * offset, unit(0, "pt")) + - max(elements$text$margin) - xoffset <- offset * sin(theta) - yoffset <- offset * cos(theta) + 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 @@ -274,6 +277,38 @@ GuideAxisTheta <- ggproto( }, assemble_drawing = function(grobs, layout, sizes, params, elements) { + if (params$position != "theta") { + # 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) + ) + } + + out <- absoluteGrob( + do.call(gList, grobs), + width = vp$width, + height = vp$height, + vp = vp + ) + return(out) + } do.call(grobTree, grobs) } From 3b7159b138d638ebfe5924f2755e291afa477480 Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Thu, 22 Jun 2023 21:48:56 +0200 Subject: [PATCH 10/28] Simplify tickmarks --- R/guide-axis-theta.R | 138 ++++++++++++++++++++++--------------------- 1 file changed, 70 insertions(+), 68 deletions(-) diff --git a/R/guide-axis-theta.R b/R/guide-axis-theta.R index 909e98fc8e..1e4c1bcf05 100644 --- a/R/guide-axis-theta.R +++ b/R/guide-axis-theta.R @@ -127,7 +127,7 @@ GuideAxisTheta <- ggproto( key$theta <- switch( params$position, top = 0, - bottom = 1 * pi, + bottom = 1 * pi, left = 1.5 * pi, right = 0.5 * pi ) @@ -154,6 +154,7 @@ GuideAxisTheta <- ggproto( }, setup_params = function(params) { + # Theta axis doesn't need to setup any position specific parameters. params }, @@ -161,6 +162,9 @@ GuideAxisTheta <- ggproto( axis_elem <- c("line", "text", "ticks", "ticks_length") is_char <- vapply(elements[axis_elem], is.character, logical(1)) axis_elem <- axis_elem[is_char] + # Note that we're taking the {element}.{aes} elements here and not the + # {element}.{aes}.{position} elements, as bottom/top/left/right have no + # meaning for a theta axis. elements[axis_elem] <- lapply( paste( unlist(elements[axis_elem]), @@ -169,10 +173,18 @@ GuideAxisTheta <- ggproto( calc_element, theme = theme ) elements$minor_ticks <- combine_elements(params$minor.ticks, elements$ticks) + + # Offset distance from axis arc to text positions + offset <- max(0, params$major.length, params$minor.length) + offset <- max(elements$ticks_length * offset, unit(0, "pt")) + + max(elements$text$margin) + elements$offset <- offset elements }, override_elements = function(params, elements, theme) { + # We don't override any label angles/hjust/vjust because these depend on + # theta of label. return(elements) }, @@ -190,12 +202,12 @@ GuideAxisTheta <- ggproto( if (is.waive(params$angle) || is.null(params$angle)) { angle <- elements$text$angle } else { - angle <- (360 - key$theta * 180 / pi + params$angle) %% 360 + angle <- (360 - rad2deg(key$theta) + params$angle) %% 360 flip <- angle > 90 & angle < 270 angle[flip] <- angle[flip] + 180 } # Text angle in radians - rad <- angle * pi / 180 + rad <- deg2rad(angle) # Position angle in radians theta <- key$theta @@ -227,42 +239,14 @@ GuideAxisTheta <- ggproto( minor <- NULL } - n_breaks <- nrow(major) - - tick_len <- elements$ticks_length * params$major.length - tick_len <- rep(tick_len, length.out = n_breaks * 2) - - angle <- rep(major$theta, each = 2) - x <- rep(major$x, each = 2) - y <- rep(major$y, each = 2) - end <- rep(c(0, 1), n_breaks) - - major <- element_grob( - elements$ticks, - x = unit(x, "npc") + sin(angle) * end * tick_len, - y = unit(y, "npc") + cos(angle) * end * tick_len, - id.lengths = rep(2, n_breaks) + major <- theta_tickmarks( + elements$ticks, major, + elements$ticks_length * params$major.length ) - if (empty(minor) || inherits(elements$minor_ticks, "element_blank")) { - return(major) - } - - n_breaks <- nrow(minor) - - tick_len <- elements$ticks_length * params$minor.length - tick_len <- rep(tick_len, length.out = n_breaks * 2) - - angle <- rep(minor$theta, each = 2) - x <- rep(minor$x, each = 2) - y <- rep(minor$y, each = 2) - end <- rep(c(0, 1), n_breaks) - - minor <- element_grob( - elements$minor_ticks, - x = unit(x, "npc") + sin(angle) * end * tick_len, - y = unit(y, "npc") + cos(angle) * end * tick_len, - id.lengths = rep(2, n_breaks) + minor <- theta_tickmarks( + elements$minor_ticks, minor, + elements$ticks_length * params$minor.length ) grobTree(major, minor, name = "ticks") @@ -277,40 +261,58 @@ GuideAxisTheta <- ggproto( }, assemble_drawing = function(grobs, layout, sizes, params, elements) { - if (params$position != "theta") { - # 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) - ) - } + if (params$position == "theta") { + return(do.call(grobTree, grobs)) + } - out <- absoluteGrob( - do.call(gList, grobs), - width = vp$width, - height = vp$height, - vp = vp + # 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) ) - return(out) } - do.call(grobTree, grobs) - } + absoluteGrob( + do.call(gList, grobs), + width = vp$width, + height = vp$height, + vp = vp + ) + } ) +theta_tickmarks <- function(element, key, 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) + ) +} From 94a2ad33e423cfa79328fe4b4e73a9f2e0c5d3eb Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Sun, 25 Jun 2023 11:12:34 +0200 Subject: [PATCH 11/28] regular axis sets opposite aesthetic --- R/guide-axis.R | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/R/guide-axis.R b/R/guide-axis.R index eb5f0fb326..49ea2ba607 100644 --- a/R/guide-axis.R +++ b/R/guide-axis.R @@ -154,6 +154,12 @@ GuideAxis <- ggproto( params$decor <- coord_munch(coord, params$decor, panel_params) + if (inherits(coord, "CoordPolar2")) { + # Radius axis that needs to correct the other aesthetic + # for having incorrect theta. + params$decor$x <- switch(position, left = 1, right = 0, params$decor$x) + } + # 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"). From a32c6cb7d1a2e023b3141be8f3122c52d386616a Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Sun, 25 Jun 2023 11:40:50 +0200 Subject: [PATCH 12/28] accommodate secondary theta scale --- R/guide-axis-theta.R | 38 +++++++++++++++++++++++++------------- 1 file changed, 25 insertions(+), 13 deletions(-) diff --git a/R/guide-axis-theta.R b/R/guide-axis-theta.R index 1e4c1bcf05..5c29525582 100644 --- a/R/guide-axis-theta.R +++ b/R/guide-axis-theta.R @@ -23,7 +23,7 @@ NULL #' @export #' #' @examples -#' # A basic polar plot +#' # A plot using coord_polar2 #' p <- ggplot(mtcars, aes(disp, mpg)) + #' geom_point() + #' coord_polar2() @@ -104,23 +104,29 @@ GuideAxisTheta <- ggproto( vec_rbind(major, minor) }, - extract_decor = function(scale, aesthetic, key, cap = "none", ...) { - # We put position = "left" to get `Inf` on the opposite aesthetic + 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 = "left", key = key, cap = cap + position = position, key = key, cap = cap ) }, transform = function(params, coord, panel_params) { opposite <- setdiff(c("x", "y"), params$aesthetic) - params$key[[opposite]] <- Inf + params$key[[opposite]] <- switch(params$position, theta.sec = -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. @@ -132,6 +138,10 @@ GuideAxisTheta <- ggproto( 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) @@ -162,14 +172,16 @@ GuideAxisTheta <- ggproto( axis_elem <- c("line", "text", "ticks", "ticks_length") is_char <- vapply(elements[axis_elem], is.character, logical(1)) axis_elem <- axis_elem[is_char] - # Note that we're taking the {element}.{aes} elements here and not the - # {element}.{aes}.{position} elements, as bottom/top/left/right have no - # meaning for a theta axis. + + 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]), - params$aes, sep = "." - ), + paste(unlist(elements[axis_elem]), aes, sep = "."), calc_element, theme = theme ) elements$minor_ticks <- combine_elements(params$minor.ticks, elements$ticks) @@ -261,7 +273,7 @@ GuideAxisTheta <- ggproto( }, assemble_drawing = function(grobs, layout, sizes, params, elements) { - if (params$position == "theta") { + if (params$position %in% c("theta", "theta.sec")) { return(do.call(grobTree, grobs)) } From b7b9770df95f280114a060b5fb86d840a335d2f6 Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Sun, 25 Jun 2023 11:59:36 +0200 Subject: [PATCH 13/28] First implementation of coord_polar2 --- DESCRIPTION | 1 + NAMESPACE | 1 + R/coord-polar.R | 3 +- R/coord-polar2.R | 580 +++++++++++++++++++++++++++++++++++++++++ man/coord_polar.Rd | 51 +++- man/ggplot2-ggproto.Rd | 5 +- 6 files changed, 636 insertions(+), 5 deletions(-) create mode 100644 R/coord-polar2.R diff --git a/DESCRIPTION b/DESCRIPTION index 159800659b..60c083323b 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -115,6 +115,7 @@ Collate: 'coord-map.R' 'coord-munch.R' 'coord-polar.R' + 'coord-polar2.R' 'coord-quickmap.R' 'coord-sf.R' 'coord-transform.R' diff --git a/NAMESPACE b/NAMESPACE index 72dbc8c9e8..e80a29f9c9 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -151,6 +151,7 @@ export(CoordFixed) export(CoordFlip) export(CoordMap) export(CoordPolar) +export(CoordPolar2) export(CoordQuickmap) export(CoordSf) export(CoordTrans) diff --git a/R/coord-polar.R b/R/coord-polar.R index f9bb6395da..3e750e44ac 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_polar2()` 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 diff --git a/R/coord-polar2.R b/R/coord-polar2.R new file mode 100644 index 0000000000..ae9b8d727b --- /dev/null +++ b/R/coord-polar2.R @@ -0,0 +1,580 @@ + +#' @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_polar2()`, 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`. +#' +#' @examples +#' # A partial polar plot +#' ggplot(mtcars, aes(disp, mpg)) + +#' geom_point() + +#' coord_polar2(start = -0.4 * pi, end = 0.4 * pi, donut = 0.3) +#' +coord_polar2 <- 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, CoordPolar2, + 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 +CoordPolar2 <- ggproto("CoordPolar2", 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_clip2( + x, details$theta.range, + arc, self$direction + ) + } else { + r <- rescale(x, from = details$r.range, to = self$donut / 0.4) + theta <- theta_rescale_no_clip2( + 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) + + # Fill in theta guide default + panel_params$theta$guide <- panel_params$theta$guide %|W|% guide_axis_theta() + + guides <- guides$setup( + panel_params, 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_rescale2(data$r, panel_params$r.range, panel_params$donut) + data$theta <- theta_rescale2( + 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)) { + offset <- self$direction * arc[1] + data$angle <- flip_text_angle(data$angle - rad2deg(data$theta - offset)) + } + + 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_rescale2(theta_maj, theta_lim, arc, dir) + } + if (length(theta_min) > 0) { + theta_min <- theta_rescale2(theta_min, theta_lim, arc, dir) + } + theta_fine <- seq(self$arc[1], self$arc[2], length.out = 100) + + r_fine <- r_rescale2(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 <- FALSE + } + return(NULL) + } +) + +theta_rescale_no_clip2 <- function(x, range, arc = c(0, 2 * pi), direction = 1) { + rescale(x, to = arc, from = range) * direction +} + +theta_rescale2 <- 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_rescale2 <- function(x, range, donut = c(0, 0.4)) { + x <- squish_infinite(x, range) + rescale(x, donut, range) +} + +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) { + 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/man/coord_polar.Rd b/man/coord_polar.Rd index a04f202961..204fc4b487 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-polar2.R \name{coord_polar} \alias{coord_polar} +\alias{coord_polar2} \title{Polar coordinates} \usage{ coord_polar(theta = "x", start = 0, direction = 1, clip = "on") + +coord_polar2( + 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_polar2()} has extended +options. +} +\note{ +In \code{coord_polar2()}, 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,9 @@ 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_polar2(start = -0.4 * pi, end = 0.4 * pi, donut = 0.3) + } diff --git a/man/ggplot2-ggproto.Rd b/man/ggplot2-ggproto.Rd index 0e320e5c46..66e51c74f6 100644 --- a/man/ggplot2-ggproto.Rd +++ b/man/ggplot2-ggproto.Rd @@ -3,8 +3,8 @@ % 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/coord-polar.R, R/coord-polar2.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, @@ -43,6 +43,7 @@ \alias{CoordFlip} \alias{CoordMap} \alias{CoordPolar} +\alias{CoordPolar2} \alias{CoordQuickmap} \alias{CoordTrans} \alias{Facet} From 36c93ee8d0f8425b147f5cd3d31fe84ecaf491a4 Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Sun, 25 Jun 2023 13:46:01 +0200 Subject: [PATCH 14/28] Polishes --- R/coord-polar2.R | 6 +++--- R/guide-axis-theta.R | 10 ++++++---- 2 files changed, 9 insertions(+), 7 deletions(-) diff --git a/R/coord-polar2.R b/R/coord-polar2.R index ae9b8d727b..251710675b 100644 --- a/R/coord-polar2.R +++ b/R/coord-polar2.R @@ -230,8 +230,7 @@ CoordPolar2 <- ggproto("CoordPolar2", Coord, data$y <- rescale(data$r * cos(data$theta) + 0.5, from = bbox$y) if (self$rotate_angle && "angle" %in% names(data)) { - offset <- self$direction * arc[1] - data$angle <- flip_text_angle(data$angle - rad2deg(data$theta - offset)) + data$angle <- flip_text_angle(data$angle - rad2deg(data$theta)) } data @@ -413,7 +412,7 @@ CoordPolar2 <- ggproto("CoordPolar2", Coord, "No appropriate placement found for {.arg r_axis_inside}.", i = "Axis will be placed at panel edge." )) - self$r_axis_inside <- FALSE + self$r_axis_inside <- TRUE } return(NULL) } @@ -540,6 +539,7 @@ rotate_r_axis <- function(axis, angle, bbox, position = "left") { } flip_text_angle <- function(angle) { + angle <- angle %% 360 flip <- angle > 90 & angle < 270 angle[flip] <- angle[flip] + 180 angle diff --git a/R/guide-axis-theta.R b/R/guide-axis-theta.R index 5c29525582..2897d101a4 100644 --- a/R/guide-axis-theta.R +++ b/R/guide-axis-theta.R @@ -118,7 +118,11 @@ GuideAxisTheta <- ggproto( transform = function(params, coord, panel_params) { opposite <- setdiff(c("x", "y"), params$aesthetic) - params$key[[opposite]] <- switch(params$position, theta.sec = -Inf, Inf) + params$key[[opposite]] <- switch(params$position, + theta.sec = -Inf, + top = -Inf, + right = -Inf, + Inf) params <- GuideAxis$transform(params, coord, panel_params) @@ -214,9 +218,7 @@ GuideAxisTheta <- ggproto( if (is.waive(params$angle) || is.null(params$angle)) { angle <- elements$text$angle } else { - angle <- (360 - rad2deg(key$theta) + params$angle) %% 360 - flip <- angle > 90 & angle < 270 - angle[flip] <- angle[flip] + 180 + angle <- flip_text_angle(params$angle - rad2deg(key$theta)) } # Text angle in radians rad <- deg2rad(angle) From a1d980b8f3d41ef1003252931d4d9ec7a4be1e00 Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Sun, 25 Jun 2023 13:46:17 +0200 Subject: [PATCH 15/28] Write tests --- tests/testthat/_snaps/coord-polar.md | 10 + .../bottom-half-circle-with-rotated-text.svg | 75 +++++++ .../coord-polar/donut-with-all-axes.svg | 126 ++++++++++++ .../coord-polar/partial-with-all-axes.svg | 127 ++++++++++++ ...de-axis-theta-in-cartesian-coordinates.svg | 131 ++++++++++++ ...xis-theta-with-angle-adapting-to-theta.svg | 192 ++++++++++++++++++ tests/testthat/test-coord-polar.R | 92 +++++++++ tests/testthat/test-guides.R | 31 +++ 8 files changed, 784 insertions(+) create mode 100644 tests/testthat/_snaps/coord-polar.md create mode 100644 tests/testthat/_snaps/coord-polar/bottom-half-circle-with-rotated-text.svg create mode 100644 tests/testthat/_snaps/coord-polar/donut-with-all-axes.svg create mode 100644 tests/testthat/_snaps/coord-polar/partial-with-all-axes.svg create mode 100644 tests/testthat/_snaps/guides/guide-axis-theta-in-cartesian-coordinates.svg create mode 100644 tests/testthat/_snaps/guides/guide-axis-theta-with-angle-adapting-to-theta.svg diff --git a/tests/testthat/_snaps/coord-polar.md b/tests/testthat/_snaps/coord-polar.md new file mode 100644 index 0000000000..78e2d97306 --- /dev/null +++ b/tests/testthat/_snaps/coord-polar.md @@ -0,0 +1,10 @@ +# coord_polar2 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 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +cat +strawberry +cake +coffee +window +fluid +cat +strawberry +cake +coffee +window +fluid +1 +2 +3 +4 +5 + + + + + + + +0 degrees +90 degrees + + +x +y +bottom half circle with rotated text + + 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 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +100 +200 +300 +400 + + + + + +100 +200 +300 +400 + + + + + + +10 +15 +20 +25 +30 +35 + + + + + + + + + + + + + +10 +15 +20 +25 +30 +35 +disp +mpg +donut with all axes + + 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 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +10 +15 +20 +25 +30 +35 + + + + + + + +10 +15 +20 +25 +30 +35 + + + + + + + + +100 +200 +300 +400 + + + + + + + + + +100 +200 +300 +400 +disp +mpg +partial with all axes + + 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..f9c50c7388 --- /dev/null +++ b/tests/testthat/_snaps/guides/guide-axis-theta-in-cartesian-coordinates.svg @@ -0,0 +1,131 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +100 +200 +300 +400 + + + + + +10 +15 +20 +25 +30 +35 + + + + + + + +10 +15 +20 +25 +30 +35 + + + + + + + +100 +200 +300 +400 + + + + + +disp +mpg +guide_axis_theta in cartesian coordinates + + 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 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +75 +100 +125 +150 +175 +200 +225 +250 +275 +300 +325 +350 +375 +400 +425 +450 +475 + + + + + + + + + + + + + + + + + + +75 +100 +125 +150 +175 +200 +225 +250 +275 +300 +325 +350 +375 +400 +425 +450 +475 + + + + + + + + + + + + + + + + + + + +10 +15 +20 +25 +30 +35 + + + + + + +disp +mpg +guide_axis_theta with angle adapting to theta + + diff --git a/tests/testthat/test-coord-polar.R b/tests/testthat/test-coord-polar.R index f1570b6a96..f2271c6864 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_polar2 warns about axes", { + + p <- ggplot(mtcars, aes(disp, mpg)) + + geom_point() + + # Cannot use regular axis for theta position + expect_snapshot_warning(ggplotGrob( + p + coord_polar2() + 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_polar2(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_polar2() 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_polar2(donut = 0.3, r_axis_inside = FALSE) + + guides(r.sec = "axis", theta.sec = "axis_theta") + }) + + expect_doppelganger("partial with all axes", { + p + coord_polar2(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_polar2(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_polar2(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 7ac38957e6..58899fd5c5 100644 --- a/tests/testthat/test-guides.R +++ b/tests/testthat/test-guides.R @@ -739,6 +739,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_polar2(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)) From 67feb630e1b9c493baa544e8f038c096c0a4f848 Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Wed, 25 Oct 2023 10:02:41 +0200 Subject: [PATCH 16/28] update minor ticks implementation --- R/coord-polar2.R | 3 +- R/guide-axis-theta.R | 96 +++++++++++--------------------------------- 2 files changed, 25 insertions(+), 74 deletions(-) diff --git a/R/coord-polar2.R b/R/coord-polar2.R index 251710675b..f65a955625 100644 --- a/R/coord-polar2.R +++ b/R/coord-polar2.R @@ -125,12 +125,13 @@ CoordPolar2 <- ggproto("CoordPolar2", Coord, 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( - panel_params, aesthetics, + scales, aesthetics, default = params$guide_default %||% guide_axis(), missing = params$guide_missing %||% guide_none() ) diff --git a/R/guide-axis-theta.R b/R/guide-axis-theta.R index 2897d101a4..9d843daa31 100644 --- a/R/guide-axis-theta.R +++ b/R/guide-axis-theta.R @@ -7,13 +7,6 @@ NULL #' position scale. #' #' @inheritParams guide_axis -#' @param major.length,minor.length A `numeric` of length 1 giving the length of -#' major and minor ticks relative to the theme's setting. -#' @param minor.ticks A theme element inheriting from `element_line` or -#' `element_blank` for drawing minor ticks. Alternatively, a `logical` of -#' length 1 as shorthand for `element_line()` (`TRUE`) or `element_blank` -#' (`FALSE`). `minor.ticks = element_line(...)` can be used to style the -#' minor ticks. #' #' @note #' The axis labels in this guide are insensitive to `hjust` and `vjust` @@ -34,34 +27,22 @@ NULL #' # Minor ticks can be activated by providing a line element #' p + guides(theta = guide_axis_theta(minor.ticks = element_line())) guide_axis_theta <- function(title = waiver(), angle = waiver(), - cap = "none", order = 0, - major.length = 1, minor.length = 0.75, - minor.ticks = element_blank(), + 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")) - if (is.logical(minor.ticks)) { - check_bool(minor.ticks) - minor.ticks <- if (minor.ticks) element_line() else element_blank() - } - check_inherits(minor.ticks, c("element_line", "element_blank")) - if (inherits(minor.ticks, "element_blank")) { - minor.length <- 0 - } - new_guide( title = title, # customisations angle = angle, cap = cap, - major.length = major.length, - minor.length = minor.length, minor.ticks = minor.ticks, # parameter @@ -78,32 +59,6 @@ guide_axis_theta <- function(title = waiver(), angle = waiver(), GuideAxisTheta <- ggproto( "GuideAxisTheta", GuideAxis, - # TODO: delete if minor ticks PR (#5287) gets merged - params = c(GuideAxis$params, list( - major.length = 1, - minor.length = 0.75, - minor.ticks = NULL - )), - - # TODO: delete if minor ticks PR (#5287) gets merged - extract_key = function(scale, aesthetic, minor.ticks, ...) { - major <- Guide$extract_key(scale, aesthetic, ...) - if (is.expression(major$.label)) { - major$.label <- as.list(major$.label) - } - if (inherits(minor.ticks, "element_blank")) { - return(major) - } - if (!is.null(major)) { - major$.type <- "major" - } - minor <- setdiff(scale$get_breaks_minor(), major$.value) - new_scale <- ggproto(NULL, scale, breaks = minor, get_labels = function(...) NULL) - minor <- Guide$extract_key(new_scale, aesthetic, ...) - minor$.type <- "minor" - vec_rbind(major, minor) - }, - 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. @@ -173,7 +128,8 @@ GuideAxisTheta <- ggproto( }, setup_elements = function(params, elements, theme) { - axis_elem <- c("line", "text", "ticks", "ticks_length") + + 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] @@ -188,13 +144,14 @@ GuideAxisTheta <- ggproto( paste(unlist(elements[axis_elem]), aes, sep = "."), calc_element, theme = theme ) - elements$minor_ticks <- combine_elements(params$minor.ticks, elements$ticks) # Offset distance from axis arc to text positions - offset <- max(0, params$major.length, params$minor.length) - offset <- max(elements$ticks_length * offset, unit(0, "pt")) + - max(elements$text$margin) - elements$offset <- offset + 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 }, @@ -231,36 +188,29 @@ GuideAxisTheta <- ggproto( # Note that element_grob expects 1 angle for *all* labels, so we're # rendering one grob per label to propagate angle properly - do.call(grobTree, Map( + labels <- Map( element_grob, label = labels, - x = unit(key$x, "npc") + xoffset, - y = unit(key$y, "npc") + yoffset, + 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, MoreArgs = list(element = elements$text) - )) + ) + + inject(grobTree(!!!labels)) }, build_ticks = function(key, elements, params, position = params$position) { - if (".type" %in% names(key)) { - major <- vec_slice(key, key$.type == "major") - minor <- vec_slice(key, key$.type == "minor") - } else { - major <- key - minor <- NULL - } - major <- theta_tickmarks( - elements$ticks, major, - elements$ticks_length * params$major.length + vec_slice(key, (key$.type %||% "major") == "major"), + elements$ticks, elements$major_length ) - minor <- theta_tickmarks( - elements$minor_ticks, minor, - elements$ticks_length * params$minor.length + vec_slice(key, (key$.type %||% "major") == "minor"), + elements$minor, elements$minor_length ) grobTree(major, minor, name = "ticks") @@ -276,7 +226,7 @@ GuideAxisTheta <- ggproto( assemble_drawing = function(grobs, layout, sizes, params, elements) { if (params$position %in% c("theta", "theta.sec")) { - return(do.call(grobTree, grobs)) + return(inject(grobTree(!!!grobs))) } # As a fallback, we adjust the viewport to act like regular axes. @@ -303,7 +253,7 @@ GuideAxisTheta <- ggproto( } absoluteGrob( - do.call(gList, grobs), + inject(gList(!!!grobs)), width = vp$width, height = vp$height, vp = vp @@ -311,7 +261,7 @@ GuideAxisTheta <- ggproto( } ) -theta_tickmarks <- function(element, key, length) { +theta_tickmarks <- function(key, element, length) { n_breaks <- nrow(key) if (n_breaks < 1 || inherits(element, "element_blank")) { return(zeroGrob()) From 5acb8abe609af05c5f8bf0b7b25dc3677b1cc53f Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Wed, 25 Oct 2023 10:07:49 +0200 Subject: [PATCH 17/28] Rename file --- DESCRIPTION | 2 +- R/{coord-polar2.R => coord-radial.R} | 0 2 files changed, 1 insertion(+), 1 deletion(-) rename R/{coord-polar2.R => coord-radial.R} (100%) diff --git a/DESCRIPTION b/DESCRIPTION index 622a765ba9..57d98a23b8 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -114,8 +114,8 @@ Collate: 'coord-map.R' 'coord-munch.R' 'coord-polar.R' - 'coord-polar2.R' 'coord-quickmap.R' + 'coord-radial.R' 'coord-sf.R' 'coord-transform.R' 'data.R' diff --git a/R/coord-polar2.R b/R/coord-radial.R similarity index 100% rename from R/coord-polar2.R rename to R/coord-radial.R From c159487a0651f662169b17abd9f9afb841d9b73e Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Wed, 25 Oct 2023 10:15:07 +0200 Subject: [PATCH 18/28] rename coord_polar2 -> coord_radial --- NAMESPACE | 2 +- R/coord-polar.R | 2 +- R/coord-radial.R | 10 +++++----- R/guide-axis-theta.R | 6 +++--- tests/testthat/_snaps/coord-polar.md | 2 +- tests/testthat/test-coord-polar.R | 16 ++++++++-------- tests/testthat/test-guides.R | 2 +- 7 files changed, 20 insertions(+), 20 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 4ebf8ddc85..16b2a36ec8 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -156,8 +156,8 @@ export(CoordFixed) export(CoordFlip) export(CoordMap) export(CoordPolar) -export(CoordPolar2) export(CoordQuickmap) +export(CoordRadial) export(CoordSf) export(CoordTrans) export(Facet) diff --git a/R/coord-polar.R b/R/coord-polar.R index 3e750e44ac..b507724a74 100644 --- a/R/coord-polar.R +++ b/R/coord-polar.R @@ -1,7 +1,7 @@ #' Polar coordinates #' #' The polar coordinate system is most commonly used for pie charts, which -#' are a stacked bar chart in polar coordinates. `coord_polar2()` has extended +#' are a stacked bar chart in polar coordinates. `coord_radial()` has extended #' options. #' #' @param theta variable to map angle to (`x` or `y`) diff --git a/R/coord-radial.R b/R/coord-radial.R index f65a955625..11f0fe2f77 100644 --- a/R/coord-radial.R +++ b/R/coord-radial.R @@ -18,7 +18,7 @@ #' @param donut A `numeric` between 0 and 1 setting the size of a donut hole. #' #' @note -#' In `coord_polar2()`, position guides are can be defined by using +#' 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 @@ -29,9 +29,9 @@ #' # A partial polar plot #' ggplot(mtcars, aes(disp, mpg)) + #' geom_point() + -#' coord_polar2(start = -0.4 * pi, end = 0.4 * pi, donut = 0.3) +#' coord_radial(start = -0.4 * pi, end = 0.4 * pi, donut = 0.3) #' -coord_polar2 <- function(theta = "x", +coord_radial <- function(theta = "x", start = 0, end = NULL, expand = TRUE, direction = 1, @@ -56,7 +56,7 @@ coord_polar2 <- function(theta = "x", } r_axis_inside <- r_axis_inside %||% !(abs(end - start) >= 1.999 * pi) - ggproto(NULL, CoordPolar2, + ggproto(NULL, CoordRadial, theta = theta, r = r, arc = c(start, end), @@ -73,7 +73,7 @@ coord_polar2 <- function(theta = "x", #' @format NULL #' @usage NULL #' @export -CoordPolar2 <- ggproto("CoordPolar2", Coord, +CoordRadial <- ggproto("CoordPolar2", Coord, aspect = function(details) { diff(details$bbox$y) / diff(details$bbox$x) diff --git a/R/guide-axis-theta.R b/R/guide-axis-theta.R index 9d843daa31..2b2683a9cd 100644 --- a/R/guide-axis-theta.R +++ b/R/guide-axis-theta.R @@ -3,7 +3,7 @@ NULL #' Angle axis guide #' -#' This is a specialised guide used in `coord_polar2()` to represent the theta +#' This is a specialised guide used in `coord_radial()` to represent the theta #' position scale. #' #' @inheritParams guide_axis @@ -16,10 +16,10 @@ NULL #' @export #' #' @examples -#' # A plot using coord_polar2 +#' # A plot using coord_radial #' p <- ggplot(mtcars, aes(disp, mpg)) + #' geom_point() + -#' coord_polar2() +#' 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 index 78e2d97306..9b9a48099f 100644 --- a/tests/testthat/_snaps/coord-polar.md +++ b/tests/testthat/_snaps/coord-polar.md @@ -1,4 +1,4 @@ -# coord_polar2 warns about axes +# coord_radial warns about axes `guide_axis()` cannot be used for theta. i Use one of x, y, or r instead. diff --git a/tests/testthat/test-coord-polar.R b/tests/testthat/test-coord-polar.R index f2271c6864..d4bb5b014d 100644 --- a/tests/testthat/test-coord-polar.R +++ b/tests/testthat/test-coord-polar.R @@ -79,20 +79,20 @@ test_that("Inf is squished to range", { expect_equal(d[[3]]$theta, mapped_discrete(0)) }) -test_that("coord_polar2 warns about axes", { +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_polar2() + guides(theta = "axis") + 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_polar2(start = 0.1 * pi, end = 0.4 * pi, r_axis_inside = FALSE) + p + coord_radial(start = 0.1 * pi, end = 0.4 * pi, r_axis_inside = FALSE) )) }) @@ -186,7 +186,7 @@ test_that("polar coordinates draw correctly", { ) }) -test_that("coord_polar2() draws correctly", { +test_that("coord_radial() draws correctly", { # Theme to test for axis placement theme <- theme( @@ -201,12 +201,12 @@ test_that("coord_polar2() draws correctly", { theme expect_doppelganger("donut with all axes", { - p + coord_polar2(donut = 0.3, r_axis_inside = FALSE) + + 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_polar2(start = 0.25 * pi, end = 0.75 * pi, donut = 0.3, + 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") }) @@ -218,7 +218,7 @@ test_that("coord_polar2() draws correctly", { ggplot(df, aes(x, label = lab)) + geom_text(aes(y = "0 degrees"), angle = 0) + geom_text(aes(y = "90 degrees"), angle = 90) + - coord_polar2(start = 0.5 * pi, end = 1.5 * pi, + coord_radial(start = 0.5 * pi, end = 1.5 * pi, rotate_angle = TRUE) + theme @@ -227,7 +227,7 @@ test_that("coord_polar2() draws correctly", { ggplot(df, aes(x, label = lab)) + geom_text(aes(y = "0 degrees"), angle = 0) + geom_text(aes(y = "90 degrees"), angle = 90) + - coord_polar2(start = 0.5 * pi, end = 1.5 * pi, + 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 0b1a58ca75..38c6d7589f 100644 --- a/tests/testthat/test-guides.R +++ b/tests/testthat/test-guides.R @@ -829,7 +829,7 @@ test_that("guide_axis_theta sets relative angle", { p <- ggplot(mtcars, aes(disp, mpg)) + geom_point() + scale_x_continuous(breaks = breaks_width(25)) + - coord_polar2(donut = 0.5) + + coord_radial(donut = 0.5) + guides( theta = guide_axis_theta(angle = 0, cap = "none"), theta.sec = guide_axis_theta(angle = 90, cap = "both") From c0c3fa73f700bcd72cc142a78bc7dcd765c1bdcc Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Wed, 25 Oct 2023 10:48:13 +0200 Subject: [PATCH 19/28] unify helpers --- R/coord-polar.R | 43 ++++++++++++++++++++++++------------------- R/coord-radial.R | 28 +++++++--------------------- 2 files changed, 31 insertions(+), 40 deletions(-) diff --git a/R/coord-polar.R b/R/coord-polar.R index b507724a74..219a8fca4d 100644 --- a/R/coord-polar.R +++ b/R/coord-polar.R @@ -81,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) @@ -164,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 @@ -177,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 @@ -202,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 @@ -248,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 @@ -306,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 index 11f0fe2f77..972ef08f66 100644 --- a/R/coord-radial.R +++ b/R/coord-radial.R @@ -83,13 +83,13 @@ CoordRadial <- ggproto("CoordPolar2", Coord, 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_clip2( + 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_clip2( + theta <- theta_rescale_no_clip( y, details$theta.range, arc, self$direction ) @@ -222,8 +222,8 @@ CoordRadial <- ggproto("CoordPolar2", Coord, bbox <- panel_params$bbox %||% list(x = c(0, 1), y = c(0, 1)) arc <- panel_params$arc %||% c(0, 2 * pi) - data$r <- r_rescale2(data$r, panel_params$r.range, panel_params$donut) - data$theta <- theta_rescale2( + 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 ) @@ -269,14 +269,14 @@ CoordRadial <- ggproto("CoordPolar2", Coord, theta_min <- setdiff(panel_params$theta.minor, theta_maj) if (length(theta_maj) > 0) { - theta_maj <- theta_rescale2(theta_maj, theta_lim, arc, dir) + theta_maj <- theta_rescale(theta_maj, theta_lim, arc, dir) } if (length(theta_min) > 0) { - theta_min <- theta_rescale2(theta_min, theta_lim, arc, dir) + 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_rescale2(panel_params$r.major, panel_params$r.range, + 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: @@ -419,20 +419,6 @@ CoordRadial <- ggproto("CoordPolar2", Coord, } ) -theta_rescale_no_clip2 <- function(x, range, arc = c(0, 2 * pi), direction = 1) { - rescale(x, to = arc, from = range) * direction -} - -theta_rescale2 <- 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_rescale2 <- function(x, range, donut = c(0, 0.4)) { - x <- squish_infinite(x, range) - rescale(x, donut, range) -} - view_scales_polar <- function(scale, theta = "x", expand = TRUE) { aesthetic <- scale$aesthetics[1] From be1653ab509207dcbfd966c4f560fd8fdd8fe079 Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Wed, 25 Oct 2023 10:51:21 +0200 Subject: [PATCH 20/28] document --- NAMESPACE | 1 + R/coord-radial.R | 2 +- man/coord_polar.Rd | 13 ++++++------ man/ggplot2-ggproto.Rd | 47 +++++++++++++++++++++-------------------- man/guide_axis_theta.Rd | 22 ++++++------------- 5 files changed, 39 insertions(+), 46 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 16b2a36ec8..64fe953a19 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -303,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) diff --git a/R/coord-radial.R b/R/coord-radial.R index 972ef08f66..2a5a677033 100644 --- a/R/coord-radial.R +++ b/R/coord-radial.R @@ -25,12 +25,12 @@ #' 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, diff --git a/man/coord_polar.Rd b/man/coord_polar.Rd index 204fc4b487..da54c854fa 100644 --- a/man/coord_polar.Rd +++ b/man/coord_polar.Rd @@ -1,13 +1,13 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/coord-polar.R, R/coord-polar2.R +% Please edit documentation in R/coord-polar.R, R/coord-radial.R \name{coord_polar} \alias{coord_polar} -\alias{coord_polar2} +\alias{coord_radial} \title{Polar coordinates} \usage{ coord_polar(theta = "x", start = 0, direction = 1, clip = "on") -coord_polar2( +coord_radial( theta = "x", start = 0, end = NULL, @@ -53,11 +53,11 @@ alignment with the coordinates.} } \description{ The polar coordinate system is most commonly used for pie charts, which -are a stacked bar chart in polar coordinates. \code{coord_polar2()} has extended +are a stacked bar chart in polar coordinates. \code{coord_radial()} has extended options. } \note{ -In \code{coord_polar2()}, position guides are can be defined by using +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 @@ -114,6 +114,5 @@ doh + geom_bar(width = 0.9, position = "fill") + coord_polar(theta = "y") # A partial polar plot ggplot(mtcars, aes(disp, mpg)) + geom_point() + - coord_polar2(start = -0.4 * pi, end = 0.4 * pi, donut = 0.3) - + 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 68b34973e8..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} @@ -43,8 +44,8 @@ \alias{CoordFlip} \alias{CoordMap} \alias{CoordPolar} -\alias{CoordPolar2} \alias{CoordQuickmap} +\alias{CoordRadial} \alias{CoordTrans} \alias{Facet} \alias{FacetGrid} diff --git a/man/guide_axis_theta.Rd b/man/guide_axis_theta.Rd index abf72df583..0a8e91f882 100644 --- a/man/guide_axis_theta.Rd +++ b/man/guide_axis_theta.Rd @@ -7,11 +7,9 @@ guide_axis_theta( title = waiver(), angle = waiver(), + minor.ticks = FALSE, cap = "none", order = 0, - major.length = 1, - minor.length = 0.75, - minor.ticks = element_blank(), position = waiver() ) } @@ -30,6 +28,9 @@ you probably want. Can be one of the following: \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 @@ -41,20 +42,11 @@ 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{major.length, minor.length}{A \code{numeric} of length 1 giving the length of -major and minor ticks relative to the theme's setting.} - -\item{minor.ticks}{A theme element inheriting from \code{element_line} or -\code{element_blank} for drawing minor ticks. Alternatively, a \code{logical} of -length 1 as shorthand for \code{element_line()} (\code{TRUE}) or \code{element_blank} -(\code{FALSE}). \code{minor.ticks = element_line(...)} can be used to style the -minor ticks.} - \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_polar2()} to represent the theta +This is a specialised guide used in \code{coord_radial()} to represent the theta position scale. } \note{ @@ -63,10 +55,10 @@ settings. The distance from the tick marks to the labels is determined by the largest \code{margin} size set in the theme. } \examples{ -# A basic polar plot +# A plot using coord_radial p <- ggplot(mtcars, aes(disp, mpg)) + geom_point() + - coord_polar2() + coord_radial() # The `angle` argument can be used to set relative angles p + guides(theta = guide_axis_theta(angle = 0)) From 42cfa21af89d497ed1f66e9fc35f69a8e039523e Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Wed, 25 Oct 2023 11:10:01 +0200 Subject: [PATCH 21/28] Add theta guide topic --- _pkgdown.yml | 1 + 1 file changed, 1 insertion(+) 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 From f84f41b148711c148f164c148d28a444e427e7c0 Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Wed, 25 Oct 2023 11:24:50 +0200 Subject: [PATCH 22/28] Drop minor ticks example --- R/guide-axis-theta.R | 3 --- man/guide_axis_theta.Rd | 3 --- 2 files changed, 6 deletions(-) diff --git a/R/guide-axis-theta.R b/R/guide-axis-theta.R index 2b2683a9cd..74980c5dc4 100644 --- a/R/guide-axis-theta.R +++ b/R/guide-axis-theta.R @@ -23,9 +23,6 @@ NULL #' #' # The `angle` argument can be used to set relative angles #' p + guides(theta = guide_axis_theta(angle = 0)) -#' -#' # Minor ticks can be activated by providing a line element -#' p + guides(theta = guide_axis_theta(minor.ticks = element_line())) guide_axis_theta <- function(title = waiver(), angle = waiver(), minor.ticks = FALSE, cap = "none", order = 0, position = waiver()) { diff --git a/man/guide_axis_theta.Rd b/man/guide_axis_theta.Rd index 0a8e91f882..16a8e89cf1 100644 --- a/man/guide_axis_theta.Rd +++ b/man/guide_axis_theta.Rd @@ -62,7 +62,4 @@ p <- ggplot(mtcars, aes(disp, mpg)) + # The `angle` argument can be used to set relative angles p + guides(theta = guide_axis_theta(angle = 0)) - -# Minor ticks can be activated by providing a line element -p + guides(theta = guide_axis_theta(minor.ticks = element_line())) } From 3c97b986ae3b3112c9c223ff4359a31762341b73 Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Wed, 25 Oct 2023 13:25:19 +0200 Subject: [PATCH 23/28] vectorise `rotate_just()` --- R/margins.R | 37 ++++++++++++++++++++++++------------- 1 file changed, 24 insertions(+), 13 deletions(-) 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) } From d7e9a2dae2e77f6545a7de6edaaf005587bd599f Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Wed, 25 Oct 2023 13:27:36 +0200 Subject: [PATCH 24/28] Don't `Map()` labels --- R/guide-axis-theta.R | 9 +++------ 1 file changed, 3 insertions(+), 6 deletions(-) diff --git a/R/guide-axis-theta.R b/R/guide-axis-theta.R index 74980c5dc4..6d55b5623c 100644 --- a/R/guide-axis-theta.R +++ b/R/guide-axis-theta.R @@ -185,18 +185,15 @@ GuideAxisTheta <- ggproto( # Note that element_grob expects 1 angle for *all* labels, so we're # rendering one grob per label to propagate angle properly - labels <- Map( - element_grob, + 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, - MoreArgs = list(element = elements$text) + angle = angle ) - - inject(grobTree(!!!labels)) }, build_ticks = function(key, elements, params, position = params$position) { From 076035b6c2a5be10332d35815c855ce27321c61d Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Wed, 25 Oct 2023 13:27:49 +0200 Subject: [PATCH 25/28] accept snapshot --- ...de-axis-theta-in-cartesian-coordinates.svg | 198 +++++++++--------- 1 file changed, 99 insertions(+), 99 deletions(-) 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 index f9c50c7388..61a923ac4e 100644 --- a/tests/testthat/_snaps/guides/guide-axis-theta-in-cartesian-coordinates.svg +++ b/tests/testthat/_snaps/guides/guide-axis-theta-in-cartesian-coordinates.svg @@ -21,109 +21,109 @@ - - + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + -100 -200 -300 -400 - - - - - -10 -15 -20 -25 -30 -35 - - - - - - - -10 -15 -20 -25 -30 -35 - - - - - - - -100 -200 -300 -400 - - - - - +100 +200 +300 +400 + + + + + +10 +15 +20 +25 +30 +35 + + + + + + + +10 +15 +20 +25 +30 +35 + + + + + + + +100 +200 +300 +400 + + + + + disp mpg guide_axis_theta in cartesian coordinates From 0c03a1935288320a32ba1ce892d40f130bb01bc7 Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Wed, 25 Oct 2023 14:18:47 +0200 Subject: [PATCH 26/28] Clean up references to CoordPolar2 --- R/coord-radial.R | 2 +- R/guide-axis.R | 6 +++--- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/R/coord-radial.R b/R/coord-radial.R index 2a5a677033..9f2ede8cce 100644 --- a/R/coord-radial.R +++ b/R/coord-radial.R @@ -73,7 +73,7 @@ coord_radial <- function(theta = "x", #' @format NULL #' @usage NULL #' @export -CoordRadial <- ggproto("CoordPolar2", Coord, +CoordRadial <- ggproto("CoordRadial", Coord, aspect = function(details) { diff(details$bbox$y) / diff(details$bbox$x) diff --git a/R/guide-axis.R b/R/guide-axis.R index 272b1b7d4d..a6f614de45 100644 --- a/R/guide-axis.R +++ b/R/guide-axis.R @@ -180,10 +180,10 @@ GuideAxis <- ggproto( params$decor <- coord_munch(coord, params$decor, panel_params) - if (inherits(coord, "CoordPolar2")) { - # Radius axis that needs to correct the other aesthetic - # for having incorrect theta. + 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` From 16653fef0b516e6645399b754177e21b77fdb1f1 Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Mon, 20 Nov 2023 14:38:00 +0100 Subject: [PATCH 27/28] comments and remove return statements --- R/guide-axis-theta.R | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/R/guide-axis-theta.R b/R/guide-axis-theta.R index 6d55b5623c..22a2db06a1 100644 --- a/R/guide-axis-theta.R +++ b/R/guide-axis-theta.R @@ -85,7 +85,7 @@ GuideAxisTheta <- ggproto( if (!("theta" %in% names(key))) { # We likely have a linear coord, so we match the text angles to - # standard axes. + # standard axes to be visually similar. key$theta <- switch( params$position, top = 0, @@ -155,7 +155,7 @@ GuideAxisTheta <- ggproto( override_elements = function(params, elements, theme) { # We don't override any label angles/hjust/vjust because these depend on # theta of label. - return(elements) + elements }, build_labels = function(key, elements, params) { @@ -211,11 +211,15 @@ GuideAxisTheta <- ggproto( }, measure_grobs = function(grobs, params, elements) { - return(invisible()) + # 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) { - return(invisible()) + NULL }, assemble_drawing = function(grobs, layout, sizes, params, elements) { From 9ca4b656d373ea0c2136de28f5ad7dac3d69ba56 Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Mon, 20 Nov 2023 15:34:54 +0100 Subject: [PATCH 28/28] add news bullet --- NEWS.md | 12 ++++++++++++ 1 file changed, 12 insertions(+) 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).