Make is_free a method of Coord to indicate whether the coordinate system supports free positional scales (supersedes the use of check_coord_freedom()) (#2604)

Author: thomasp85

R/coord-.r

@@ -18,7 +18,8 @@
 #'   - `distance`: Calculates distance.
 #'   - `is_linear`: Returns `TRUE` if the coordinate system is
 #'     linear; `FALSE` otherwise.
-#'
+#'   - `is_free`: Returns `TRUE` if the coordinate system supports free
+#'     positional scales.
 #'   - `setup_panel_params(data)`:
 #'   - `setup_data(data, params)`: Allows the coordinate system to
 #'     manipulate the plot data. Should return list of data frames.
@@ -86,6 +87,8 @@ Coord <- ggproto("Coord",
 
   is_linear = function() FALSE,
 
+  is_free = function() FALSE,
+
   setup_params = function(data) {
     list()
   },

R/coord-cartesian-.r

@@ -76,6 +76,7 @@ coord_cartesian <- function(xlim = NULL, ylim = NULL, expand = TRUE,
 CoordCartesian <- ggproto("CoordCartesian", Coord,
 
   is_linear = function() TRUE,
+  is_free = function() TRUE,
 
   distance = function(x, y, panel_params) {
     max_dist <- dist_euclidean(panel_params$x.range, panel_params$y.range)

R/coord-fixed.r

@@ -42,6 +42,7 @@ coord_equal <- coord_fixed
 #' @usage NULL
 #' @export
 CoordFixed <- ggproto("CoordFixed", CoordCartesian,
+  is_free = function() FALSE,
 
   aspect = function(self, ranges) {
     diff(ranges$y.range) / diff(ranges$x.range) * self$ratio

R/coord-transform.r

@@ -113,7 +113,7 @@ coord_trans <- function(x = "identity", y = "identity", limx = NULL, limy = NULL
 #' @usage NULL
 #' @export
 CoordTrans <- ggproto("CoordTrans", Coord,
-
+  is_free = function() TRUE,
   distance = function(self, x, y, panel_params) {
     max_dist <- dist_euclidean(panel_params$x.range, panel_params$y.range)
     dist_euclidean(self$trans$x$transform(x), self$trans$y$transform(y)) / max_dist

R/facet-.r

@@ -637,21 +637,3 @@ render_strips <- function(x = NULL, y = NULL, labeller, theme) {
     y = build_strip(y, labeller, theme, FALSE)
   )
 }
-
-
-check_coord_freedom <- function(coord) {
-  # Check first element of class vector because this is a hideous hack on
-  # top of another hideous hack
-  class <- class(coord)[[1]]
-
-  if (class %in% c("CoordCartesian", "CoordFlip")) {
-    return()
-  }
-
-  stop(
-    "Free scales are only supported with `coord_cartesian()` and `coord_flip()`",
-    call. = FALSE
-  )
-}
-
-

R/facet-grid-.r

@@ -322,8 +322,9 @@ FacetGrid <- ggproto("FacetGrid", Facet,
     data[order(data$PANEL), , drop = FALSE]
   },
   draw_panels = function(panels, layout, x_scales, y_scales, ranges, coord, data, theme, params) {
-    if (params$free$x || params$free$y)
-      check_coord_freedom(coord)
+    if ((params$free$x || params$free$y) && !coord$is_free()) {
+      stop(snake_class(coord), " doesn't support free scales", call. = FALSE)
+    }
 
     cols <- which(layout$ROW == 1)
     rows <- which(layout$COL == 1)

R/facet-wrap.r

@@ -206,8 +206,9 @@ FacetWrap <- ggproto("FacetWrap", Facet,
     data[order(data$PANEL), ]
   },
   draw_panels = function(panels, layout, x_scales, y_scales, ranges, coord, data, theme, params) {
-    if (params$free$x || params$free$y)
-      check_coord_freedom(coord)
+    if ((params$free$x || params$free$y) && !coord$is_free()) {
+      stop(snake_class(coord), " doesn't support free scales", call. = FALSE)
+    }
 
     if (inherits(coord, "CoordFlip")) {
       if (params$free$x) {