From a4bfd02ef409900dd8b96e876834111914b91e88 Mon Sep 17 00:00:00 2001 From: Hiroaki Yutani Date: Wed, 29 Apr 2020 15:24:29 +0900 Subject: [PATCH 01/13] Move labels(), setup_panel_guides(), train_panel_guides() to Coord --- R/coord-.r | 77 +++++++++++++++++++++++++++++++++++++++++++- R/coord-cartesian-.r | 71 +--------------------------------------- 2 files changed, 77 insertions(+), 71 deletions(-) diff --git a/R/coord-.r b/R/coord-.r index 1170341e19..c05050d6e5 100644 --- a/R/coord-.r +++ b/R/coord-.r @@ -59,7 +59,33 @@ Coord <- ggproto("Coord", aspect = function(ranges) NULL, - labels = function(labels, panel_params) labels, + labels = function(self, labels, panel_params) { + # If panel params contains guides information, use it. + # Otherwise use the labels as is, for backward-compatibility + if (is.null(panel_params$guide)) { + return(labels) + } + + positions_x <- c("top", "bottom") + positions_y <- c("left", "right") + + list( + x = lapply(c(1, 2), function(i) { + panel_guide_label( + panel_params$guides, + position = positions_x[[i]], + default_label = labels$x[[i]] + ) + }), + y = lapply(c(1, 2), function(i) { + panel_guide_label( + panel_params$guides, + position = positions_y[[i]], + default_label = labels$y[[i]] + ) + }) + ) + }, render_fg = function(panel_params, theme) element_render(theme, "panel.border"), @@ -92,10 +118,59 @@ Coord <- ggproto("Coord", }, setup_panel_guides = function(self, panel_params, guides, params = list()) { + aesthetics <- c("x", "y", "x.sec", "y.sec") + names(aesthetics) <- aesthetics + + # If the panel_params doesn't contain the scale, do not use a guide for that aesthetic + idx <- vapply(aesthetics, function(aesthetic) { + scale <- panel_params[[aesthetic]] + !is.null(scale) && inherits(scale, "ViewScale") + }, logical(1L)) + aesthetics <- aesthetics[idx] + + # resolve the specified guide from the scale and/or guides + guides <- lapply(aesthetics, function(aesthetic) { + resolve_guide( + aesthetic, + panel_params[[aesthetic]], + guides, + default = guide_axis(), + null = guide_none() + ) + }) + + # resolve the guide definition as a "guide" S3 + guides <- lapply(guides, validate_guide) + + # if there is an "position" specification in the scale, pass this on to the guide + # ideally, this should be specified in the guide + guides <- lapply(aesthetics, function(aesthetic) { + guide <- guides[[aesthetic]] + scale <- panel_params[[aesthetic]] + # position could be NULL here for an empty scale + guide$position <- guide$position %|W|% scale$position + guide + }) + + panel_params$guides <- guides panel_params }, train_panel_guides = function(self, panel_params, layers, default_mapping, params = list()) { + aesthetics <- c("x", "y", "x.sec", "y.sec") + names(aesthetics) <- aesthetics + # If the panel_params doesn't contain the scale, there's no guide for the aesthetic + aesthetics <- intersect(aesthetics, names(panel_params$guides)) + + panel_params$guides <- lapply(aesthetics, function(aesthetic) { + axis <- substr(aesthetic, 1, 1) + guide <- panel_params$guides[[aesthetic]] + guide <- guide_train(guide, panel_params[[aesthetic]]) + guide <- guide_transform(guide, self, panel_params) + guide <- guide_geom(guide, layers, default_mapping) + guide + }) + panel_params }, diff --git a/R/coord-cartesian-.r b/R/coord-cartesian-.r index d36a49674a..e3a1f831dc 100644 --- a/R/coord-cartesian-.r +++ b/R/coord-cartesian-.r @@ -103,75 +103,6 @@ CoordCartesian <- ggproto("CoordCartesian", Coord, ) }, - setup_panel_guides = function(self, panel_params, guides, params = list()) { - aesthetics <- c("x", "y", "x.sec", "y.sec") - names(aesthetics) <- aesthetics - - # resolve the specified guide from the scale and/or guides - guides <- lapply(aesthetics, function(aesthetic) { - resolve_guide( - aesthetic, - panel_params[[aesthetic]], - guides, - default = guide_axis(), - null = guide_none() - ) - }) - - # resolve the guide definition as a "guide" S3 - guides <- lapply(guides, validate_guide) - - # if there is an "position" specification in the scale, pass this on to the guide - # ideally, this should be specified in the guide - guides <- lapply(aesthetics, function(aesthetic) { - guide <- guides[[aesthetic]] - scale <- panel_params[[aesthetic]] - # position could be NULL here for an empty scale - guide$position <- guide$position %|W|% scale$position - guide - }) - - panel_params$guides <- guides - panel_params - }, - - train_panel_guides = function(self, panel_params, layers, default_mapping, params = list()) { - aesthetics <- c("x", "y", "x.sec", "y.sec") - names(aesthetics) <- aesthetics - - panel_params$guides <- lapply(aesthetics, function(aesthetic) { - axis <- substr(aesthetic, 1, 1) - guide <- panel_params$guides[[aesthetic]] - guide <- guide_train(guide, panel_params[[aesthetic]]) - guide <- guide_transform(guide, self, panel_params) - guide <- guide_geom(guide, layers, default_mapping) - guide - }) - - panel_params - }, - - labels = function(self, labels, panel_params) { - positions_x <- c("top", "bottom") - positions_y <- c("left", "right") - - list( - x = lapply(c(1, 2), function(i) { - panel_guide_label( - panel_params$guides, - position = positions_x[[i]], - default_label = labels$x[[i]] - ) - }), - y = lapply(c(1, 2), function(i) { - panel_guide_label( - panel_params$guides, - position = positions_y[[i]], - default_label = labels$y[[i]]) - }) - ) - }, - render_bg = function(panel_params, theme) { guide_grid( theme, @@ -215,7 +146,7 @@ view_scales_from_scale <- function(scale, coord_limits = NULL, expand = TRUE) { } panel_guide_label <- function(guides, position, default_label) { - guide <- guide_for_position(guides, position) %||% guide_none(title = NULL) + guide <- guide_for_position(guides, position) %||% guide_none(title = waiver()) guide$title %|W|% default_label } From 094f5d824037e0adbefe6e6d74b998f451add74e Mon Sep 17 00:00:00 2001 From: Hiroaki Yutani Date: Wed, 29 Apr 2020 18:30:53 +0900 Subject: [PATCH 02/13] Support axis_guide() on CoordTrans --- R/coord-transform.r | 24 +++++++++++++++++++----- 1 file changed, 19 insertions(+), 5 deletions(-) diff --git a/R/coord-transform.r b/R/coord-transform.r index 358b8ecb91..5559f19bae 100644 --- a/R/coord-transform.r +++ b/R/coord-transform.r @@ -124,8 +124,18 @@ CoordTrans <- ggproto("CoordTrans", Coord, }, transform = function(self, data, panel_params) { - trans_x <- function(data) transform_value(self$trans$x, data, panel_params$x.range) - trans_y <- function(data) transform_value(self$trans$y, data, panel_params$y.range) + # trans_x() and trans_y() needs to keep Inf values because this can be called + # in guide_transform.axis() + trans_x <- function(data) { + idx <- !is.infinite(data) + data[idx] <- transform_value(self$trans$x, data[idx], panel_params$x.range) + data + } + trans_y <- function(data) { + idx <- !is.infinite(data) + data[idx] <- transform_value(self$trans$y, data[idx], panel_params$y.range) + data + } new_data <- transform_position(data, trans_x, trans_y) @@ -181,10 +191,11 @@ train_trans <- function(scale, coord_limits, trans, name, expand = TRUE) { expansion <- default_expansion(scale, expand = expand) scale_trans <- scale$trans %||% identity_trans() coord_limits <- coord_limits %||% scale_trans$inverse(c(NA, NA)) + scale_limits <- scale$get_limits() if (scale$is_discrete()) { continuous_ranges <- expand_limits_discrete_trans( - scale$get_limits(), + scale_limits, expansion, coord_limits, trans, @@ -194,7 +205,7 @@ train_trans <- function(scale, coord_limits, trans, name, expand = TRUE) { # transform user-specified limits to scale transformed space coord_limits <- scale$trans$transform(coord_limits) continuous_ranges <- expand_limits_continuous_trans( - scale$get_limits(), + scale_limits, expansion, coord_limits, trans @@ -215,6 +226,9 @@ train_trans <- function(scale, coord_limits, trans, name, expand = TRUE) { out$sec.minor_source <- transform_value(trans, out$sec.minor_source, out$range) out <- list( + view_scale_primary(scale, scale_limits, continuous_ranges$continuous_range_coord), + # TODO: Can I add here? This seems cause cryptic warning "In min(x) : no non-missing arguments to min; returning Inf" + # sec = view_scale_secondary(scale, scale_limits, continuous_ranges$continuous_range_coord), range = out$range, labels = out$labels, major = out$major_source, @@ -223,7 +237,7 @@ train_trans <- function(scale, coord_limits, trans, name, expand = TRUE) { sec.major = out$sec.major_source, sec.minor = out$sec.minor_source ) - names(out) <- paste(name, names(out), sep = ".") + names(out) <- c(name, paste(name, names(out)[-1], sep = ".")) out } From 4bc235db3e0e6b3bc563d6b189f4aa52d66a5ae6 Mon Sep 17 00:00:00 2001 From: Hiroaki Yutani Date: Sun, 19 Jun 2022 12:38:27 +0900 Subject: [PATCH 03/13] Use the range before the Coord transformation --- R/coord-transform.r | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/R/coord-transform.r b/R/coord-transform.r index 5be1fdb208..8fff8bd7e6 100644 --- a/R/coord-transform.r +++ b/R/coord-transform.r @@ -228,8 +228,10 @@ train_trans <- function(scale, coord_limits, trans, name, expand = TRUE) { out <- list( view_scale_primary(scale, scale_limits, continuous_ranges$continuous_range_coord), - # TODO: Can I add here? This seems cause cryptic warning "In min(x) : no non-missing arguments to min; returning Inf" - # sec = view_scale_secondary(scale, scale_limits, continuous_ranges$continuous_range_coord), + # TODO: currently, view_scale_secondary() requires the range that's not affected by + # the Coord transformation. I'm not yet sure if this is necessary or it's + # just I don't figure out the whole process. + sec = view_scale_secondary(scale, scale_limits, continuous_ranges$continuous_range), range = out$range, labels = out$labels, major = out$major_source, From 0a610b559eafd5eb04e1e9b6dcb20e310b9a8761 Mon Sep 17 00:00:00 2001 From: Hiroaki Yutani Date: Sun, 19 Jun 2022 12:50:59 +0900 Subject: [PATCH 04/13] Remove `name` argument --- R/coord-transform.r | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/R/coord-transform.r b/R/coord-transform.r index 8fff8bd7e6..fbedc6857e 100644 --- a/R/coord-transform.r +++ b/R/coord-transform.r @@ -148,8 +148,8 @@ CoordTrans <- ggproto("CoordTrans", Coord, setup_panel_params = function(self, scale_x, scale_y, params = list()) { c( - train_trans(scale_x, self$limits$x, self$trans$x, "x", self$expand), - train_trans(scale_y, self$limits$y, self$trans$y, "y", self$expand) + train_trans(scale_x, self$limits$x, self$trans$x, self$expand), + train_trans(scale_y, self$limits$y, self$trans$y, self$expand) ) }, @@ -188,7 +188,7 @@ transform_value <- function(trans, value, range) { rescale(trans$transform(value), 0:1, range) } -train_trans <- function(scale, coord_limits, trans, name, expand = TRUE) { +train_trans <- function(scale, coord_limits, trans, expand = TRUE) { expansion <- default_expansion(scale, expand = expand) scale_trans <- scale$trans %||% identity_trans() coord_limits <- coord_limits %||% scale_trans$inverse(c(NA, NA)) @@ -240,7 +240,9 @@ train_trans <- function(scale, coord_limits, trans, name, expand = TRUE) { sec.major = out$sec.major_source, sec.minor = out$sec.minor_source ) - names(out) <- c(name, paste(name, names(out)[-1], sep = ".")) + + aesthetic <- scale$aesthetics[1] + names(out) <- c(aesthetic, paste(aesthetic, names(out)[-1], sep = ".")) out } From e0c8de0c69284765cd501308eb1148414c50bdf0 Mon Sep 17 00:00:00 2001 From: Hiroaki Yutani Date: Sun, 19 Jun 2022 12:52:41 +0900 Subject: [PATCH 05/13] Rename `train_trans()` to `view_scales_from_scale_with_coord_trans()` --- R/coord-transform.r | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/R/coord-transform.r b/R/coord-transform.r index fbedc6857e..361d019f47 100644 --- a/R/coord-transform.r +++ b/R/coord-transform.r @@ -148,8 +148,8 @@ CoordTrans <- ggproto("CoordTrans", Coord, setup_panel_params = function(self, scale_x, scale_y, params = list()) { c( - train_trans(scale_x, self$limits$x, self$trans$x, self$expand), - train_trans(scale_y, self$limits$y, self$trans$y, self$expand) + view_scales_from_scale_with_coord_trans(scale_x, self$limits$x, self$trans$x, self$expand), + view_scales_from_scale_with_coord_trans(scale_y, self$limits$y, self$trans$y, self$expand) ) }, @@ -188,7 +188,8 @@ transform_value <- function(trans, value, range) { rescale(trans$transform(value), 0:1, range) } -train_trans <- function(scale, coord_limits, trans, expand = TRUE) { +# TODO: can we merge this with view_scales_from_scale()? +view_scales_from_scale_with_coord_trans <- function(scale, coord_limits, trans, expand = TRUE) { expansion <- default_expansion(scale, expand = expand) scale_trans <- scale$trans %||% identity_trans() coord_limits <- coord_limits %||% scale_trans$inverse(c(NA, NA)) From 87fffc0cc7ad80571d7aec65e9e1f6188c80970e Mon Sep 17 00:00:00 2001 From: Hiroaki Yutani Date: Sun, 19 Jun 2022 14:23:40 +0900 Subject: [PATCH 06/13] [WIP] Modify CoordPolar --- R/coord-polar.r | 93 ++++++++++++++++++++++++++++++++++++++++--------- 1 file changed, 77 insertions(+), 16 deletions(-) diff --git a/R/coord-polar.r b/R/coord-polar.r index 176e515fe6..853717e23e 100644 --- a/R/coord-polar.r +++ b/R/coord-polar.r @@ -105,11 +105,10 @@ CoordPolar <- ggproto("CoordPolar", Coord, }, setup_panel_params = function(self, scale_x, scale_y, params = list()) { - + scales <- list(x = scale_x, y = scale_y) ret <- list(x = list(), y = list()) for (n in c("x", "y")) { - - scale <- get(paste0("scale_", n)) + scale <- scales[[n]] limits <- self$limits[[n]] if (self$theta == n) { @@ -120,6 +119,10 @@ CoordPolar <- ggproto("CoordPolar", Coord, range <- expand_limits_scale(scale, expansion, coord_limits = limits) out <- scale$break_info(range) + + ret[[n]]$primary_axis <- view_scale_primary(scale, scale$get_limits(), out$range) + ret[[n]]$secondary_axis <- view_scale_secondary(scale, scale$get_limits(), out$range) + ret[[n]]$range <- out$range ret[[n]]$major <- out$major_source ret[[n]]$minor <- out$minor_source @@ -130,7 +133,11 @@ CoordPolar <- ggproto("CoordPolar", Coord, ret[[n]]$sec.labels <- out$sec.labels } - details = list( + details <- list( + x = ret$x$primary_axis, + y = ret$y$primary_axis, + x.sec = ret$x$secondary_axis, + y.sec = ret$y$secondary_axis, x.range = ret$x$range, y.range = ret$y$range, x.major = ret$x$major, y.major = ret$y$major, x.minor = ret$x$minor, y.minor = ret$y$minor, @@ -142,18 +149,80 @@ CoordPolar <- ggproto("CoordPolar", Coord, ) if (self$theta == "y") { - names(details) <- gsub("x\\.", "r.", names(details)) - names(details) <- gsub("y\\.", "theta.", names(details)) + # replace x to r, and x.foo to r.foo + names(details) <- gsub("x(\\.|$)", "r\\1", names(details)) + names(details) <- gsub("y(\\.|$)", "theta\\1", names(details)) details$r.arrange <- scale_x$axis_order() } else { - names(details) <- gsub("x\\.", "theta.", names(details)) - names(details) <- gsub("y\\.", "r.", names(details)) + names(details) <- gsub("x(\\.|$)", "theta\\1", names(details)) + names(details) <- gsub("y(\\.|$)", "r\\1", names(details)) details$r.arrange <- scale_y$axis_order() } details }, + # TODO: it's not very nice to copy the whole method just to tweak the + # `aesthetics` for r and theta + setup_panel_guides = function(self, panel_params, guides, params = list()) { + aesthetics <- c("r", "theta", "r.sec", "theta.sec") + names(aesthetics) <- aesthetics + + # If the panel_params doesn't contain the scale, do not use a guide for that aesthetic + idx <- vapply(aesthetics, function(aesthetic) { + scale <- panel_params[[aesthetic]] + !is.null(scale) && inherits(scale, "ViewScale") + }, logical(1L)) + aesthetics <- aesthetics[idx] + + # resolve the specified guide from the scale and/or guides + guides <- lapply(aesthetics, function(aesthetic) { + resolve_guide( + aesthetic, + panel_params[[aesthetic]], + guides, + default = guide_axis(), + null = guide_none() + ) + }) + + # resolve the guide definition as a "guide" S3 + guides <- lapply(guides, validate_guide) + + # if there is an "position" specification in the scale, pass this on to the guide + # ideally, this should be specified in the guide + guides <- lapply(aesthetics, function(aesthetic) { + guide <- guides[[aesthetic]] + scale <- panel_params[[aesthetic]] + # position could be NULL here for an empty scale + guide$position <- guide$position %|W|% scale$position + guide + }) + + panel_params$guides <- guides + panel_params + }, + + # TODO: it's not very nice to copy the whole method just to tweak the + # `aesthetics` for r and theta + train_panel_guides = function(self, panel_params, layers, default_mapping, params = list()) { + aesthetics <- c("r", "theta", "r.sec", "theta.sec") + names(aesthetics) <- aesthetics + # If the panel_params doesn't contain the scale, there's no guide for the aesthetic + aesthetics <- intersect(aesthetics, names(panel_params$guides)) + + panel_params$guides <- lapply(aesthetics, function(aesthetic) { + axis <- strsplit(aesthetic, ".", fixed = TRUE)[[1]][1] + guide <- panel_params$guides[[aesthetic]] + guide <- guide_train(guide, panel_params[[aesthetic]]) + guide <- guide_transform(guide, self, panel_params) + guide <- guide_geom(guide, layers, default_mapping) + guide + }) + + panel_params + }, + transform = function(self, data, panel_params) { data <- rename_data(self, data) @@ -306,14 +375,6 @@ CoordPolar <- ggproto("CoordPolar", Coord, ) }, - labels = function(self, labels, panel_params) { - if (self$theta == "y") { - list(x = labels$y, y = labels$x) - } else { - labels - } - }, - modify_scales = function(self, scales_x, scales_y) { if (self$theta != "y") return() From 16dc109d0f8d83c3eac3175f2428af7668d6bd58 Mon Sep 17 00:00:00 2001 From: Hiroaki Yutani Date: Thu, 7 Jul 2022 21:54:44 +0900 Subject: [PATCH 07/13] Revert coord-polar.r --- R/coord-polar.r | 105 ++++++++++-------------------------------------- 1 file changed, 22 insertions(+), 83 deletions(-) diff --git a/R/coord-polar.r b/R/coord-polar.r index 853717e23e..bb8e9a16a0 100644 --- a/R/coord-polar.r +++ b/R/coord-polar.r @@ -105,10 +105,11 @@ CoordPolar <- ggproto("CoordPolar", Coord, }, setup_panel_params = function(self, scale_x, scale_y, params = list()) { - scales <- list(x = scale_x, y = scale_y) + ret <- list(x = list(), y = list()) for (n in c("x", "y")) { - scale <- scales[[n]] + + scale <- get(paste0("scale_", n)) limits <- self$limits[[n]] if (self$theta == n) { @@ -119,10 +120,6 @@ CoordPolar <- ggproto("CoordPolar", Coord, range <- expand_limits_scale(scale, expansion, coord_limits = limits) out <- scale$break_info(range) - - ret[[n]]$primary_axis <- view_scale_primary(scale, scale$get_limits(), out$range) - ret[[n]]$secondary_axis <- view_scale_secondary(scale, scale$get_limits(), out$range) - ret[[n]]$range <- out$range ret[[n]]$major <- out$major_source ret[[n]]$minor <- out$minor_source @@ -133,11 +130,7 @@ CoordPolar <- ggproto("CoordPolar", Coord, ret[[n]]$sec.labels <- out$sec.labels } - details <- list( - x = ret$x$primary_axis, - y = ret$y$primary_axis, - x.sec = ret$x$secondary_axis, - y.sec = ret$y$secondary_axis, + details = list( x.range = ret$x$range, y.range = ret$y$range, x.major = ret$x$major, y.major = ret$y$major, x.minor = ret$x$minor, y.minor = ret$y$minor, @@ -149,80 +142,18 @@ CoordPolar <- ggproto("CoordPolar", Coord, ) if (self$theta == "y") { - # replace x to r, and x.foo to r.foo - names(details) <- gsub("x(\\.|$)", "r\\1", names(details)) - names(details) <- gsub("y(\\.|$)", "theta\\1", names(details)) + names(details) <- gsub("x\\.", "r.", names(details)) + names(details) <- gsub("y\\.", "theta.", names(details)) details$r.arrange <- scale_x$axis_order() } else { - names(details) <- gsub("x(\\.|$)", "theta\\1", names(details)) - names(details) <- gsub("y(\\.|$)", "r\\1", names(details)) + names(details) <- gsub("x\\.", "theta.", names(details)) + names(details) <- gsub("y\\.", "r.", names(details)) details$r.arrange <- scale_y$axis_order() } details }, - # TODO: it's not very nice to copy the whole method just to tweak the - # `aesthetics` for r and theta - setup_panel_guides = function(self, panel_params, guides, params = list()) { - aesthetics <- c("r", "theta", "r.sec", "theta.sec") - names(aesthetics) <- aesthetics - - # If the panel_params doesn't contain the scale, do not use a guide for that aesthetic - idx <- vapply(aesthetics, function(aesthetic) { - scale <- panel_params[[aesthetic]] - !is.null(scale) && inherits(scale, "ViewScale") - }, logical(1L)) - aesthetics <- aesthetics[idx] - - # resolve the specified guide from the scale and/or guides - guides <- lapply(aesthetics, function(aesthetic) { - resolve_guide( - aesthetic, - panel_params[[aesthetic]], - guides, - default = guide_axis(), - null = guide_none() - ) - }) - - # resolve the guide definition as a "guide" S3 - guides <- lapply(guides, validate_guide) - - # if there is an "position" specification in the scale, pass this on to the guide - # ideally, this should be specified in the guide - guides <- lapply(aesthetics, function(aesthetic) { - guide <- guides[[aesthetic]] - scale <- panel_params[[aesthetic]] - # position could be NULL here for an empty scale - guide$position <- guide$position %|W|% scale$position - guide - }) - - panel_params$guides <- guides - panel_params - }, - - # TODO: it's not very nice to copy the whole method just to tweak the - # `aesthetics` for r and theta - train_panel_guides = function(self, panel_params, layers, default_mapping, params = list()) { - aesthetics <- c("r", "theta", "r.sec", "theta.sec") - names(aesthetics) <- aesthetics - # If the panel_params doesn't contain the scale, there's no guide for the aesthetic - aesthetics <- intersect(aesthetics, names(panel_params$guides)) - - panel_params$guides <- lapply(aesthetics, function(aesthetic) { - axis <- strsplit(aesthetic, ".", fixed = TRUE)[[1]][1] - guide <- panel_params$guides[[aesthetic]] - guide <- guide_train(guide, panel_params[[aesthetic]]) - guide <- guide_transform(guide, self, panel_params) - guide <- guide_geom(guide, layers, default_mapping) - guide - }) - - panel_params - }, - transform = function(self, data, panel_params) { data <- rename_data(self, data) @@ -281,23 +212,23 @@ CoordPolar <- ggproto("CoordPolar", Coord, element_render(theme, "panel.background"), if (length(theta) > 0) element_render( theme, majortheta, name = "angle", - x = c(rbind(0, 0.45 * sin(theta))) + 0.5, - y = c(rbind(0, 0.45 * cos(theta))) + 0.5, + x = vec_interleave(0, 0.45 * sin(theta)) + 0.5, + y = vec_interleave(0, 0.45 * cos(theta)) + 0.5, id.lengths = rep(2, length(theta)), default.units = "native" ), if (length(thetamin) > 0) element_render( theme, minortheta, name = "angle", - x = c(rbind(0, 0.45 * sin(thetamin))) + 0.5, - y = c(rbind(0, 0.45 * cos(thetamin))) + 0.5, + x = vec_interleave(0, 0.45 * sin(thetamin)) + 0.5, + y = vec_interleave(0, 0.45 * cos(thetamin)) + 0.5, id.lengths = rep(2, length(thetamin)), default.units = "native" ), element_render( theme, majorr, name = "radius", - x = rep(rfine, each = length(thetafine)) * sin(thetafine) + 0.5, - y = rep(rfine, each = length(thetafine)) * cos(thetafine) + 0.5, + x = rep(rfine, each = length(thetafine)) * rep(sin(thetafine), length(rfine)) + 0.5, + y = rep(rfine, each = length(thetafine)) * rep(cos(thetafine), length(rfine)) + 0.5, id.lengths = rep(length(thetafine), length(rfine)), default.units = "native" ) @@ -375,6 +306,14 @@ CoordPolar <- ggproto("CoordPolar", Coord, ) }, + labels = function(self, labels, panel_params) { + if (self$theta == "y") { + list(x = labels$y, y = labels$x) + } else { + labels + } + }, + modify_scales = function(self, scales_x, scales_y) { if (self$theta != "y") return() From b70fe0a25306f09e76b2ee101c7cbcd4e8514be6 Mon Sep 17 00:00:00 2001 From: Hiroaki Yutani Date: Fri, 8 Jul 2022 00:25:33 +0900 Subject: [PATCH 08/13] Add arrange --- R/coord-transform.r | 1 + 1 file changed, 1 insertion(+) diff --git a/R/coord-transform.r b/R/coord-transform.r index 361d019f47..e92453a6fa 100644 --- a/R/coord-transform.r +++ b/R/coord-transform.r @@ -233,6 +233,7 @@ view_scales_from_scale_with_coord_trans <- function(scale, coord_limits, trans, # the Coord transformation. I'm not yet sure if this is necessary or it's # just I don't figure out the whole process. sec = view_scale_secondary(scale, scale_limits, continuous_ranges$continuous_range), + arrange = scale$axis_order(), range = out$range, labels = out$labels, major = out$major_source, From 7b85fd0319cce343f3839b06ce694fad8060ffcd Mon Sep 17 00:00:00 2001 From: Hiroaki Yutani Date: Fri, 8 Jul 2022 01:36:01 +0900 Subject: [PATCH 09/13] Use panel_guides_grob() in CoordTransform --- R/coord-cartesian-.r | 1 - R/coord-transform.r | 20 +++++++------------- 2 files changed, 7 insertions(+), 14 deletions(-) diff --git a/R/coord-cartesian-.r b/R/coord-cartesian-.r index e3a1f831dc..d4d3181b90 100644 --- a/R/coord-cartesian-.r +++ b/R/coord-cartesian-.r @@ -137,7 +137,6 @@ view_scales_from_scale <- function(scale, coord_limits = NULL, expand = TRUE) { view_scales <- list( view_scale_primary(scale, limits, continuous_range), sec = view_scale_secondary(scale, limits, continuous_range), - arrange = scale$axis_order(), range = continuous_range ) names(view_scales) <- c(aesthetic, paste0(aesthetic, ".", names(view_scales)[-1])) diff --git a/R/coord-transform.r b/R/coord-transform.r index e92453a6fa..9cab70b5c7 100644 --- a/R/coord-transform.r +++ b/R/coord-transform.r @@ -164,20 +164,16 @@ CoordTrans <- ggproto("CoordTrans", Coord, }, render_axis_h = function(panel_params, theme) { - arrange <- panel_params$x.arrange %||% c("secondary", "primary") - list( - top = render_axis(panel_params, arrange[1], "x", "top", theme), - bottom = render_axis(panel_params, arrange[2], "x", "bottom", theme) + top = panel_guides_grob(panel_params$guides, position = "top", theme = theme), + bottom = panel_guides_grob(panel_params$guides, position = "bottom", theme = theme) ) }, render_axis_v = function(panel_params, theme) { - arrange <- panel_params$y.arrange %||% c("primary", "secondary") - list( - left = render_axis(panel_params, arrange[1], "y", "left", theme), - right = render_axis(panel_params, arrange[2], "y", "right", theme) + left = panel_guides_grob(panel_params$guides, position = "left", theme = theme), + right = panel_guides_grob(panel_params$guides, position = "right", theme = theme) ) } ) @@ -228,12 +224,10 @@ view_scales_from_scale_with_coord_trans <- function(scale, coord_limits, trans, out$sec.minor_source <- transform_value(trans, out$sec.minor_source, out$range) out <- list( - view_scale_primary(scale, scale_limits, continuous_ranges$continuous_range_coord), - # TODO: currently, view_scale_secondary() requires the range that's not affected by - # the Coord transformation. I'm not yet sure if this is necessary or it's - # just I don't figure out the whole process. + # Note that a ViewScale requires a limit and a range that are before the + # Coord's transformation, so we pass `continuous_range`, not `continuous_range_coord`. + view_scale_primary(scale, scale_limits, continuous_ranges$continuous_range), sec = view_scale_secondary(scale, scale_limits, continuous_ranges$continuous_range), - arrange = scale$axis_order(), range = out$range, labels = out$labels, major = out$major_source, From 8c001189331ac18d29629fba2d375b6e971fa005 Mon Sep 17 00:00:00 2001 From: Hiroaki Yutani Date: Fri, 8 Jul 2022 22:04:28 +0900 Subject: [PATCH 10/13] Add a snapshot test --- .../guides/guide-titles-with-coord-trans.svg | 80 +++++++++++++++++++ tests/testthat/test-guides.R | 18 +++++ 2 files changed, 98 insertions(+) create mode 100644 tests/testthat/_snaps/guides/guide-titles-with-coord-trans.svg diff --git a/tests/testthat/_snaps/guides/guide-titles-with-coord-trans.svg b/tests/testthat/_snaps/guides/guide-titles-with-coord-trans.svg new file mode 100644 index 0000000000..78de62f91c --- /dev/null +++ b/tests/testthat/_snaps/guides/guide-titles-with-coord-trans.svg @@ -0,0 +1,80 @@ + + + + + + + + + + + + + + + + + + + + + + + + + +0.950 +0.975 +1.000 +1.025 +1.050 + + + + + +0.950 +0.975 +1.000 +1.025 +1.050 + + + + + + + + + + +0.950 +0.975 +1.000 +1.025 +1.050 + + + + + +0.950 +0.975 +1.000 +1.025 +1.050 +x (secondary) +x (primary) +y (primary) +y (secondary) +guide titles with coord_trans() + + diff --git a/tests/testthat/test-guides.R b/tests/testthat/test-guides.R index 4138e848b5..1b1c43de5d 100644 --- a/tests/testthat/test-guides.R +++ b/tests/testthat/test-guides.R @@ -373,6 +373,24 @@ test_that("guides have the final say in x and y", { expect_doppelganger("position guide titles", plot) }) +test_that("Axis titles won't be blown away by coord_*()", { + df <- data_frame(x = 1, y = 1) + plot <- ggplot(df, aes(x, y)) + + geom_point() + + guides( + x = guide_axis(title = "x (primary)"), + y = guide_axis(title = "y (primary)"), + x.sec = guide_axis(title = "x (secondary)"), + y.sec = guide_axis(title = "y (secondary)") + ) + + expect_doppelganger("guide titles with coord_trans()", plot + coord_trans()) + # TODO + # expect_doppelganger("guide titles with coord_polar()", plot + coord_polar()) + # TODO + # expect_doppelganger("guide titles with coord_sf()", plot + coord_sf()) +}) + test_that("guides are positioned correctly", { df <- data_frame(x = 1, y = 1, z = factor("a")) From 8fec68f4bb23dcd01a89adfa88b57613930170b5 Mon Sep 17 00:00:00 2001 From: Hiroaki Yutani Date: Fri, 8 Jul 2022 22:11:44 +0900 Subject: [PATCH 11/13] Add a NEWS item --- NEWS.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/NEWS.md b/NEWS.md index df68e55fd5..85c624c562 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,7 @@ # ggplot2 (development version) +* Improve the support for `guide_axis()` on `coord_trans()` (@yutannihilation, #3959) + * ggplot now checks during statistical transformations whether any data columns were dropped and warns about this. If stats intend to drop data columns they can declare them in the new field `dropped_aes`. From fe7386761c2acdd3f9afad2b2e0fd6e104cc324f Mon Sep 17 00:00:00 2001 From: Hiroaki Yutani Date: Wed, 27 Jul 2022 08:40:31 +0900 Subject: [PATCH 12/13] Add a linebreak --- NEWS.md | 1 + 1 file changed, 1 insertion(+) diff --git a/NEWS.md b/NEWS.md index 207a70b7fb..084f0b0a66 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,6 +1,7 @@ # ggplot2 (development version) * Improve the support for `guide_axis()` on `coord_trans()` (@yutannihilation, #3959) + * `geom_density()` and `stat_density()` now support `bounds` argument to estimate density with boundary correction (@echasnovski, #4013). From 24866808f0b0994e0fb6634aec1a556b8a732812 Mon Sep 17 00:00:00 2001 From: Hiroaki Yutani Date: Wed, 27 Jul 2022 08:41:27 +0900 Subject: [PATCH 13/13] Fix a typo in comment --- R/coord-.r | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/coord-.r b/R/coord-.r index f2a8f97be9..6cd2c5fc0c 100644 --- a/R/coord-.r +++ b/R/coord-.r @@ -142,7 +142,7 @@ Coord <- ggproto("Coord", # resolve the guide definition as a "guide" S3 guides <- lapply(guides, validate_guide) - # if there is an "position" specification in the scale, pass this on to the guide + # if there is a "position" specification in the scale, pass this on to the guide # ideally, this should be specified in the guide guides <- lapply(aesthetics, function(aesthetic) { guide <- guides[[aesthetic]]