Support guide_axis() on CoordTrans

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

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
 }
 

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
 }