Convert coords to ggproto

NAMESPACE

@@ -7,44 +7,6 @@ S3method("[[",ggproto)
 S3method(as.character,uneval)
 S3method(as.list,ggproto)
 S3method(autoplot,default)
-S3method(coord_aspect,default)
-S3method(coord_aspect,fixed)
-S3method(coord_aspect,map)
-S3method(coord_aspect,polar)
-S3method(coord_aspect,quickmap)
-S3method(coord_distance,cartesian)
-S3method(coord_distance,map)
-S3method(coord_distance,polar)
-S3method(coord_distance,trans)
-S3method(coord_expand_defaults,default)
-S3method(coord_expand_defaults,polar)
-S3method(coord_labels,default)
-S3method(coord_labels,flip)
-S3method(coord_labels,polar)
-S3method(coord_range,default)
-S3method(coord_range,flip)
-S3method(coord_range,polar)
-S3method(coord_render_axis_h,default)
-S3method(coord_render_axis_h,map)
-S3method(coord_render_axis_h,polar)
-S3method(coord_render_axis_v,default)
-S3method(coord_render_axis_v,map)
-S3method(coord_render_axis_v,polar)
-S3method(coord_render_bg,default)
-S3method(coord_render_bg,map)
-S3method(coord_render_bg,polar)
-S3method(coord_render_fg,default)
-S3method(coord_render_fg,polar)
-S3method(coord_train,cartesian)
-S3method(coord_train,flip)
-S3method(coord_train,map)
-S3method(coord_train,polar)
-S3method(coord_train,trans)
-S3method(coord_transform,cartesian)
-S3method(coord_transform,flip)
-S3method(coord_transform,map)
-S3method(coord_transform,polar)
-S3method(coord_transform,trans)
 S3method(drawDetails,dotstackGrob)
 S3method(drawDetails,zeroGrob)
 S3method(element_grob,element_blank)
@@ -110,9 +72,6 @@ S3method(guide_train,legend)
 S3method(heightDetails,zeroGrob)
 S3method(interleave,default)
 S3method(interleave,unit)
-S3method(is.linear,cartesian)
-S3method(is.linear,default)
-S3method(is.linear,flip)
 S3method(limits,Date)
 S3method(limits,POSIXct)
 S3method(limits,POSIXlt)
@@ -180,6 +139,7 @@ S3method(summary,ggplot)
 S3method(widthDetails,zeroGrob)
 export("%+%")
 export("%+replace%")
+export(Coord)
 export(Geom)
 export(GeomAbline)
 export(GeomAnnotationMap)
@@ -267,7 +227,6 @@ export(benchplot)
 export(borders)
 export(calc_element)
 export(continuous_scale)
-export(coord)
 export(coord_cartesian)
 export(coord_equal)
 export(coord_fixed)
@@ -356,7 +315,7 @@ export(guide_colorbar)
 export(guide_colourbar)
 export(guide_legend)
 export(guides)
-export(is.coord)
+export(is.Coord)
 export(is.facet)
 export(is.ggplot)
 export(is.ggproto)

R/annotation-custom.r

@@ -67,7 +67,7 @@ GeomCustomAnn <- ggproto("GeomCustomAnn", Geom,
         call. = FALSE)
     }
     corners <- data.frame(x = c(xmin, xmax), y = c(ymin, ymax))
-    data <- coord_transform(coordinates, corners, scales)
+    data <- coordinates$transform(corners, scales)
 
     x_rng <- range(data$x, na.rm = TRUE)
     y_rng <- range(data$y, na.rm = TRUE)

R/annotation-logticks.r

@@ -135,8 +135,8 @@ GeomLogticks <- ggproto("GeomLogticks", Geom,
       if (scaled)
         xticks$value <- log(xticks$value, base)
 
-      names(xticks)[names(xticks)=="value"] <- "x"           # Rename to 'x' for coord_transform
-      xticks <- coord_transform(coordinates, xticks, scales)
+      names(xticks)[names(xticks)=="value"] <- "x"   # Rename to 'x' for coordinates$transform
+      xticks <- coordinates$transform(xticks, scales)
 
       # Make the grobs
       if(grepl("b", sides)) {
@@ -164,8 +164,8 @@ GeomLogticks <- ggproto("GeomLogticks", Geom,
       if (scaled)
         yticks$value <- log(yticks$value, base)
 
-      names(yticks)[names(yticks)=="value"] <- "y"           # Rename to 'y' for coord_transform
-      yticks <- coord_transform(coordinates, yticks, scales)
+      names(yticks)[names(yticks)=="value"] <- "y"   # Rename to 'y' for coordinates$transform
+      yticks <- coordinates$transform(yticks, scales)
 
       # Make the grobs
       if(grepl("l", sides)) {

R/annotation-raster.r

@@ -77,7 +77,7 @@ GeomRasterAnn <- ggproto("GeomRasterAnn", GeomRaster,
         call. = FALSE)
     }
     corners <- data.frame(x = c(xmin, xmax), y = c(ymin, ymax))
-    data <- coord_transform(coordinates, corners, scales)
+    data <- coordinates$transform(corners, scales)
 
     x_rng <- range(data$x, na.rm = TRUE)
     y_rng <- range(data$y, na.rm = TRUE)

R/coord-.r

@@ -1,109 +1,66 @@
-#' New coordinate system.
-#'
-#' Internal use only.
-#'
-#' @param ... object fields
-#' @keywords internal
 #' @export
-coord <- function(..., subclass = c()) {
-  structure(list(...), class = c(subclass, "coord"))
-}
+Coord <- ggproto("Coord",
 
-#' Is this object a coordinate system?
-#'
-#' @export is.coord
-#' @keywords internal
-is.coord <- function(x) inherits(x, "coord")
+  aspect = function(ranges) NULL,
 
-distance <- function(., x, y, details) {
-  max_dist <- dist_euclidean(details$x.range, details$y.range)
-  dist_euclidean(x, y) / max_dist
-}
-
-coord_aspect <- function(coord, ranges)
-  UseMethod("coord_aspect")
-#' @export
-coord_aspect.default <- function(coord, ranges) NULL
+  labels = function(scale_details) scale_details,
 
-coord_labels <- function(coord, scales) UseMethod("coord_labels")
-#' @export
-coord_labels.default <- function(coord, scales) scales
+  render_fg = function(scale_details, theme) element_render(theme, "panel.border"),
 
-coord_render_fg <- function(coord, scales, theme)
-  UseMethod("coord_render_fg")
-#' @export
-coord_render_fg.default <- function(coord, scales, theme)
-  element_render(theme, "panel.border")
+  render_bg = function(scale_details, theme) {
+    x.major <- if(length(scale_details$x.major) > 0) unit(scale_details$x.major, "native")
+    x.minor <- if(length(scale_details$x.minor) > 0) unit(scale_details$x.minor, "native")
+    y.major <- if(length(scale_details$y.major) > 0) unit(scale_details$y.major, "native")
+    y.minor <- if(length(scale_details$y.minor) > 0) unit(scale_details$y.minor, "native")
 
-coord_render_bg <- function(coord, scales, theme)
-  UseMethod("coord_render_bg")
-#' @export
-coord_render_bg.default <- function(coord, details, theme) {
-  x.major <- if(length(details$x.major) > 0) unit(details$x.major, "native")
-  x.minor <- if(length(details$x.minor) > 0) unit(details$x.minor, "native")
-  y.major <- if(length(details$y.major) > 0) unit(details$y.major, "native")
-  y.minor <- if(length(details$y.minor) > 0) unit(details$y.minor, "native")
+    guide_grid(theme, x.minor, x.major, y.minor, y.major)
+  },
 
-  guide_grid(theme, x.minor, x.major, y.minor, y.major)
-}
+  render_axis_h = function(scale_details, theme) {
+    guide_axis(scale_details$x.major, scale_details$x.labels, "bottom", theme)
+  },
 
-coord_render_axis_h <- function(coord, scales, theme)
-  UseMethod("coord_render_axis_h")
-#' @export
-coord_render_axis_h.default <- function(coord, details, theme) {
-  guide_axis(details$x.major, details$x.labels, "bottom", theme)
-}
+  render_axis_v = function(scale_details, theme) {
+    guide_axis(scale_details$y.major, scale_details$y.labels, "left", theme)
+  },
 
-coord_render_axis_v <- function(coord, scales, theme)
-  UseMethod("coord_render_axis_v")
-#' @export
-coord_render_axis_v.default <- function(coord, details, theme) {
-  guide_axis(details$y.major, details$y.labels, "left", theme)
-}
+  range = function(scale_details) {
+    return(list(x = scale_details$x.range, y = scale_details$y.range))
+  },
 
-coord_range <- function(coord, scales)
-  UseMethod("coord_range")
+  train = function(scale_details) NULL,
 
-#' @export
-coord_range.default <- function(coord, scales) {
-  return(list(x = scales$x.range, y = scales$y.range))
-}
+  transform = function(data, range) NULL,
 
-coord_train <- function(coord, scales)
-  UseMethod("coord_train")
+  distance = function(x, y, scale_details) NULL,
 
-coord_transform <- function(coord, data, range)
-  UseMethod("coord_transform")
+  is_linear = function() FALSE,
 
-coord_distance <- function(coord, x, y, details)
-  UseMethod("coord_distance")
+  # Set the default expand values for the scale, if NA
+  expand_defaults = function(scale_details, aesthetic = NULL) {
+    # Expand the same regardless of whether it's x or y
 
-is.linear <- function(coord) UseMethod("is.linear")
-#' @export
-is.linear.default <- function(coord) FALSE
+    # @kohske TODO:
+    # Here intentionally verbose. These constants may be held by coord as, say,
+    # coord$default.expand <- list(discrete = ..., continuous = ...)
+    #
+    # @kohske
+    # Now scale itself is not changed.
+    # This function only returns expanded (numeric) limits
+    discrete <- c(0, 0.6)
+    continuous <-  c(0.05, 0)
+    expand_default(scale_details, discrete, continuous)
+  }
+)
 
-#' Set the default expand values for the scale, if NA
+#' Is this object a coordinate system?
+#'
+#' @export is.Coord
 #' @keywords internal
-coord_expand_defaults <- function(coord, scale, aesthetic = NULL)
-  UseMethod("coord_expand_defaults")
+is.Coord <- function(x) inherits(x, "Coord")
 
-#' @export
-coord_expand_defaults.default <- function(coord, scale, aesthetic = NULL) {
-  # Expand the same regardless of whether it's x or y
-
-  # @kohske TODO:
-  # Here intentionally verbose. These constants may be held by coord as, say,
-  # coord$default.expand <- list(discrete = ..., continuous = ...)
-  #
-  # @kohske
-  # Now scale itself is not changed.
-  # This function only returns expanded (numeric) limits
-  discrete <- c(0, 0.6)
-  continuous <-  c(0.05, 0)
-  expand_default(scale, discrete, continuous)
-}
 
-# This is a utility function used by coord_expand_defaults, to expand a single scale
+# This is a utility function used by Coord$expand_defaults, to expand a single scale
 expand_default <- function(scale, discrete = c(0, 0), continuous = c(0, 0)) {
   # Default expand values for discrete and continuous scales
   if (is.waive(scale$expand)) {

R/coord-cartesian-.r

@@ -38,46 +38,50 @@
 #' # displayed bigger
 #' d + coord_cartesian(xlim = c(0, 2))
 coord_cartesian <- function(xlim = NULL, ylim = NULL) {
-  coord(limits = list(x = xlim, y = ylim), subclass = "cartesian")
+  ggproto(NULL, CoordCartesian,
+    limits = list(x = xlim, y = ylim)
+  )
 }
 
-#' @export
-is.linear.cartesian <- function(coord) TRUE
 
-#' @export
-coord_distance.cartesian <- function(coord, x, y, details) {
-  max_dist <- dist_euclidean(details$x.range, details$y.range)
-  dist_euclidean(x, y) / max_dist
-}
+CoordCartesian <- ggproto("CoordCartesian", Coord,
 
-#' @export
-coord_transform.cartesian <- function(., data, details) {
-  rescale_x <- function(data) rescale(data, from = details$x.range)
-  rescale_y <- function(data) rescale(data, from = details$y.range)
+  is_linear = function() TRUE,
 
-  data <- transform_position(data, rescale_x, rescale_y)
-  transform_position(data, squish_infinite, squish_infinite)
-}
+  distance = function(x, y, scale_details) {
+    max_dist <- dist_euclidean(scale_details$x.range, scale_details$y.range)
+    dist_euclidean(x, y) / max_dist
+  },
+
+  transform = function(data, scale_details) {
+    rescale_x <- function(data) rescale(data, from = scale_details$x.range)
+    rescale_y <- function(data) rescale(data, from = scale_details$y.range)
+
+    data <- transform_position(data, rescale_x, rescale_y)
+    transform_position(data, squish_infinite, squish_infinite)
+  },
+
+  train = function(self, scale_details) {
+    c(train_cartesian(scale_details$x, self$limits$x, "x"),
+      train_cartesian(scale_details$y, self$limits$y, "y"))
+  }
+)
 
-#' @export
-coord_train.cartesian <- function(coord, scales) {
-  c(train_cartesian(scales$x, coord$limits$x, "x"),
-    train_cartesian(scales$y, coord$limits$y, "y"))
-}
 
-train_cartesian <- function(scale, limits, name) {
+train_cartesian <- function(scale_details, limits, name) {
 
   # first, calculate the range that is the numerical limits in data space
 
   # expand defined by scale OR coord
   if (is.null(limits)) {
-    expand <- coord_expand_defaults(coord, scale)
-    range <- scale_dimension(scale, expand)
+    # TODO: This is weird, accessing Coord directly for this method.
+    expand <- Coord$expand_defaults(scale_details)
+    range <- scale_dimension(scale_details, expand)
   } else {
-    range <- range(scale_transform(scale, limits))
+    range <- range(scale_transform(scale_details, limits))
   }
 
-  out <- scale_break_info(scale, range)
+  out <- scale_break_info(scale_details, range)
   names(out) <- paste(name, names(out), sep = ".")
   out
 }

R/coord-fixed.r

@@ -23,12 +23,17 @@
 #'
 #' # Resize the plot to see that the specified aspect ratio is maintained
 coord_fixed <- function(ratio = 1, xlim = NULL, ylim = NULL) {
-  coord(limits = list(x = xlim, y = ylim), ratio = ratio,
-    subclass = c("fixed", "cartesian"))
+  ggproto(NULL, CoordFixed,
+    limits = list(x = xlim, y = ylim),
+    ratio = ratio
+  )
 }
 coord_equal <- coord_fixed
 
-#' @export
-coord_aspect.fixed <- function(coord, ranges) {
-  diff(ranges$y.range) / diff(ranges$x.range) * coord$ratio
-}
+
+CoordFixed <- ggproto("CoordFixed", CoordCartesian,
+
+  aspect = function(self, ranges) {
+    diff(ranges$y.range) / diff(ranges$x.range) * self$ratio
+  }
+)