WIP: scale-like objects in panel_params that can be used to train guides

R/coord-.r

@@ -64,51 +64,27 @@ Coord <- ggproto("Coord",
   render_fg = function(panel_params, theme) element_render(theme, "panel.border"),
 
   render_bg = function(panel_params, theme) {
-    guide_grid(theme,
-               panel_params$x.minor,
-               panel_params$x.major,
-               panel_params$y.minor,
-               panel_params$y.major)
+    stop("Not implemented", call. = FALSE)
   },
 
   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)
-    )
+    stop("Not implemented", call. = FALSE)
   },
 
   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)
-    )
+    stop("Not implemented", call. = FALSE)
   },
 
   # transform range given in transformed coordinates
   # back into range in given in (possibly scale-transformed)
   # data coordinates
   backtransform_range = function(self, panel_params) {
-    warning(
-      "range backtransformation not implemented in this coord; results may be wrong.",
-      call. = FALSE
-      )
-    # return result from range function for backwards compatibility
-    # before ggplot2 3.0.1
-    self$range(panel_params)
+    stop("Not implemented", call. = FALSE)
   },
 
   # return range stored in panel_params
   range = function(panel_params) {
-    warning(
-      "range calculation not implemented in this coord; results may be wrong.",
-      call. = FALSE
-    )
-    list(x = panel_params$x.range, y = panel_params$y.range)
+    stop("Not implemented", call. = FALSE)
   },
 
   setup_panel_params = function(scale_x, scale_y, params = list()) {

R/coord-cartesian-.r

@@ -79,50 +79,91 @@ CoordCartesian <- ggproto("CoordCartesian", Coord,
   is_free = function() TRUE,
 
   distance = function(x, y, panel_params) {
-    max_dist <- dist_euclidean(panel_params$x.range, panel_params$y.range)
+    max_dist <- dist_euclidean(panel_params$x$dimension(), panel_params$y$dimension())
     dist_euclidean(x, y) / max_dist
   },
 
   range = function(panel_params) {
-    list(x = panel_params$x.range, y = panel_params$y.range)
+    list(x = panel_params$x$dimension(), y = panel_params$y$dimension())
   },
 
   backtransform_range = function(self, panel_params) {
     self$range(panel_params)
   },
 
   transform = function(data, panel_params) {
-    rescale_x <- function(data) rescale(data, from = panel_params$x.range)
-    rescale_y <- function(data) rescale(data, from = panel_params$y.range)
-
-    data <- transform_position(data, rescale_x, rescale_y)
+    data <- transform_position(data, panel_params$x$rescale, panel_params$y$rescale)
     transform_position(data, squish_infinite, squish_infinite)
   },
 
   setup_panel_params = function(self, scale_x, scale_y, params = list()) {
-    train_cartesian <- function(scale, limits, name) {
-      range <- scale_range(scale, limits, self$expand)
+    c(
+      view_scales_from_scale(scale_x, self$limits$x, self$expand),
+      view_scales_from_scale(scale_y, self$limits$y, self$expand)
+    )
+  },
+
+  render_bg = function(panel_params, theme) {
+    guide_grid(
+      theme,
+      panel_params$x$break_positions_minor(),
+      panel_params$x$break_positions(),
+      panel_params$y$break_positions_minor(),
+      panel_params$y$break_positions()
+    )
+  },
 
-      out <- scale$break_info(range)
-      out$arrange <- scale$axis_order()
-      names(out) <- paste(name, names(out), sep = ".")
-      out
-    }
+  render_axis_h = function(panel_params, theme) {
+    arrange <- panel_params$x.arrange %||% c("secondary", "primary")
+    arrange_scale_keys <- c("primary" = "x", "secondary" = "x.sec")[arrange]
+    arrange_scales <- panel_params[arrange_scale_keys]
 
-    c(
-      train_cartesian(scale_x, self$limits$x, "x"),
-      train_cartesian(scale_y, self$limits$y, "y")
+    list(
+      top = draw_view_scale_axis(arrange_scales[[1]], "top", theme),
+      bottom = draw_view_scale_axis(arrange_scales[[2]], "bottom", theme)
+    )
+  },
+
+  render_axis_v = function(panel_params, theme) {
+    arrange <- panel_params$y.arrange %||% c("primary", "secondary")
+    arrange_scale_keys <- c("primary" = "y", "secondary" = "y.sec")[arrange]
+    arrange_scales <- panel_params[arrange_scale_keys]
+
+    list(
+      left = draw_view_scale_axis(arrange_scales[[1]], "left", theme),
+      right = draw_view_scale_axis(arrange_scales[[2]], "right", theme)
     )
   }
 )
 
-scale_range <- function(scale, limits = NULL, expand = TRUE) {
-  expansion <- if (expand) expand_default(scale) else c(0, 0)
+view_scales_from_scale <- function(scale, coord_limits = NULL, expand = TRUE) {
+  expansion <- if (expand) expand_default(scale) else expand_scale(0, 0)
+  limits <- scale$get_limits()
 
-  if (is.null(limits)) {
-    scale$dimension(expansion)
+  if (is.null(coord_limits)) {
+    continuous_range <- scale$dimension(expansion, limits)
   } else {
-    range <- range(scale$transform(limits))
-    expand_range(range, expansion[1], expansion[2])
+    continuous_range <- range(scale$transform(coord_limits))
+    continuous_range <- expand_range4(continuous_range, expansion)
+  }
+
+  aesthetic <- scale$aesthetics[1]
+
+  view_scales <- list(
+    view_scale(scale, limits, continuous_range),
+    sec = second_view_scale(scale, limits, continuous_range),
+    arrange = scale$axis_order(),
+    range = continuous_range
+  )
+  names(view_scales) <- c(aesthetic, paste0(aesthetic, ".", names(view_scales)[-1]))
+
+  view_scales
+}
+
+draw_view_scale_axis <- function(view_scale, axis_position, theme) {
+  if(is.null(view_scale) || view_scale$is_empty()) {
+    return(zeroGrob())
   }
+
+  draw_axis(view_scale$break_positions(), view_scale$get_labels(), axis_position, theme)
 }

R/coord-flip.r

@@ -48,10 +48,11 @@ CoordFlip <- ggproto("CoordFlip", CoordCartesian,
     self$range(panel_params)
   },
 
-  range = function(panel_params) {
+  range = function(self, panel_params) {
     # summarise_layout() expects the original x and y ranges here,
     # not the ones we would get after flipping the axes
-    list(x = panel_params$y.range, y = panel_params$x.range)
+    un_flipped_range <- ggproto_parent(CoordCartesian, self)$range(panel_params)
+    list(x = un_flipped_range$y, y = un_flipped_range$x)
   },
 
   setup_panel_params = function(self, scale_x, scale_y, params = list()) {

R/coord-sf.R

@@ -466,3 +466,14 @@ parse_axes_labeling <- function(x) {
   labs = unlist(strsplit(x, ""))
   list(top = labs[1], right = labs[2], bottom = labs[3], left = labs[4])
 }
+
+scale_range <- function(scale, limits = NULL, expand = TRUE) {
+  expansion <- if (expand) expand_default(scale) else expand_scale(0, 0)
+
+  if (is.null(limits)) {
+    scale$dimension(expansion)
+  } else {
+    continuous_range <- range(scale$transform(limits))
+    expand_range4(continuous_range, expansion)
+  }
+}

R/coord-transform.r

@@ -150,6 +150,34 @@ CoordTrans <- ggproto("CoordTrans", Coord,
       train_trans(scale_x, self$limits$x, self$trans$x, "x"),
       train_trans(scale_y, self$limits$y, self$trans$y, "y")
     )
+  },
+
+  render_bg = function(panel_params, theme) {
+    guide_grid(
+      theme,
+      panel_params$x.minor,
+      panel_params$x.major,
+      panel_params$y.minor,
+      panel_params$y.major
+    )
+  },
+
+  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)
+    )
+  },
+
+  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)
+    )
   }
 )