Support guide_axis() on CoordTrans

NEWS.md

@@ -1,5 +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).
 

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 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]]
+      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
   },
 

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,
@@ -206,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]))
@@ -215,7 +145,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
 }
 

R/coord-transform.r

@@ -125,8 +125,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)
 
@@ -138,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)
+      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)
     )
   },
 
@@ -154,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)
     )
   }
 )
@@ -178,14 +184,16 @@ transform_value <- function(trans, value, range) {
   rescale(trans$transform(value), 0:1, range)
 }
 
-train_trans <- function(scale, coord_limits, trans, name, 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))
+  scale_limits <- scale$get_limits()
 
   if (scale$is_discrete()) {
     continuous_ranges <- expand_limits_discrete_trans(
-      scale$get_limits(),
+      scale_limits,
       expansion,
       coord_limits,
       trans,
@@ -195,7 +203,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
@@ -216,6 +224,10 @@ 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(
+    # 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),
     range = out$range,
     labels = out$labels,
     major = out$major_source,
@@ -224,7 +236,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) <- paste(name, names(out), sep = ".")
+
+  aesthetic <- scale$aesthetics[1]
+  names(out) <- c(aesthetic, paste(aesthetic, names(out)[-1], sep = "."))
   out
 }