POC: no hardcoded position scales

R/coord-.R

@@ -59,6 +59,8 @@ Coord <- ggproto("Coord",
  # "on" = yes, "off" = no
  clip = "on",
 
+ aesthetics = c("x", "y"),
+
  aspect = function(ranges) NULL,
 
  labels = function(self, labels, panel_params) {
@@ -93,12 +95,12 @@ Coord <- ggproto("Coord",
  cli::cli_abort("{.fn {snake_class(self)}} has not implemented a {.fn range} method.")
  },
 
- setup_panel_params = function(scale_x, scale_y, params = list()) {
+ setup_panel_params = function(scales, params = list()) {
  list()
  },
 
  setup_panel_guides = function(self, panel_params, guides, params = list()) {
- aesthetics <- c("x", "y", "x.sec", "y.sec")
+ aesthetics <- c(self$aesthetics, paste0(self$aesthetics, ".sec"))
  names(aesthetics) <- aesthetics
  is_sec <- grepl("sec$", aesthetics)
  scales <- panel_params[aesthetics]
@@ -119,12 +121,8 @@ Coord <- ggproto("Coord",
  guide = guide_position[!is_sec],
  scale = scale_position[!is_sec]
  )
- opposite <- c(
- "top" = "bottom", "bottom" = "top",
- "left" = "right", "right" = "left"
- )
  guide_position[is_sec] <- Map(
- function(sec, prim) sec %|W|% unname(opposite[prim]),
+ function(sec, prim) sec %|W|% opposite_position(prim %||% "top"),
  sec = guide_position[is_sec],
  prim = guide_position[!is_sec]
  )
@@ -146,7 +144,7 @@ Coord <- ggproto("Coord",
 
  train_panel_guides = function(self, panel_params, layers, params = list()) {
 
- aesthetics <- c("x", "y", "x.sec", "y.sec")
+ aesthetics <- c(self$aesthetics, paste0(self$aesthetics, ".sec"))
 
  # If the panel_params doesn't contain the scale, there's no guide for the aesthetic
  aesthetics <- intersect(aesthetics, names(panel_params$guides$aesthetics))
@@ -200,14 +198,14 @@ Coord <- ggproto("Coord",
  # We're appending a COORD variable to the layout that determines the
  # uniqueness of panel parameters. The layout uses this to prevent redundant
  # setups of these parameters.
- scales <- layout[c("SCALE_X", "SCALE_Y")]
+ scales <- layout[grep("^SCALE_", names(layout), value = TRUE)]
  layout$COORD <- vec_match(scales, unique0(scales))
  layout
  },
 
  # Optionally, modify list of x and y scales in place. Currently
  # used as a fudge for CoordFlip and CoordPolar
- modify_scales = function(scales_x, scales_y) {
+ modify_scales = function(...) {
  invisible()
  },
 

R/coord-cartesian-.R

@@ -102,10 +102,10 @@ CoordCartesian <- ggproto("CoordCartesian", Coord,
  transform_position(data, squish_infinite, squish_infinite)
  },
 
- setup_panel_params = function(self, scale_x, scale_y, params = list()) {
+ setup_panel_params = function(self, scales, params = list()) {
  c(
- view_scales_from_scale(scale_x, self$limits$x, params$expand[c(4, 2)]),
- view_scales_from_scale(scale_y, self$limits$y, params$expand[c(3, 1)])
+ view_scales_from_scale(scales$x, self$limits$x, params$expand[c(4, 2)]),
+ view_scales_from_scale(scales$y, self$limits$y, params$expand[c(3, 1)])
  )
  },
 

R/coord-flip.R

@@ -88,10 +88,10 @@ CoordFlip <- ggproto("CoordFlip", CoordCartesian,
  list(x = un_flipped_range$y, y = un_flipped_range$x)
  },
 
- setup_panel_params = function(self, scale_x, scale_y, params = list()) {
+ setup_panel_params = function(self, scales, params = list()) {
  params$expand <- params$expand[c(2, 1, 4, 3)]
  parent <- ggproto_parent(CoordCartesian, self)
- panel_params <- parent$setup_panel_params(scale_x, scale_y, params)
+ panel_params <- parent$setup_panel_params(scales, params)
  flip_axis_labels(panel_params)
  },
 
@@ -106,9 +106,8 @@ CoordFlip <- ggproto("CoordFlip", CoordCartesian,
  layout
  },
 
- modify_scales = function(scales_x, scales_y) {
- lapply(scales_x, scale_flip_axis)
- lapply(scales_y, scale_flip_axis)
+ modify_scales = function(scales) {
+ lapply(scales, lapply, scale_flip_axis)
  }
 
 )

R/coord-map.R

@@ -190,12 +190,12 @@ CoordMap <- ggproto("CoordMap", Coord,
  diff(ranges$y.proj) / diff(ranges$x.proj)
  },
 
- setup_panel_params = function(self, scale_x, scale_y, params = list()) {
+ setup_panel_params = function(self, scales, params = list()) {
 
  # range in scale
  ranges <- list()
  for (n in c("x", "y")) {
- scale <- get(paste0("scale_", n))
+ scale <- scales[[n]]
  limits <- self$limits[[n]]
  range <- expand_limits_scale(scale, default_expansion(scale), coord_limits = limits)
  ranges[[n]] <- range
@@ -217,7 +217,7 @@ CoordMap <- ggproto("CoordMap", Coord,
  ret$y$proj <- proj[3:4]
 
  for (n in c("x", "y")) {
- out <- get(paste0("scale_", n))$break_info(ranges[[n]])
+ out <- scales[[n]]$break_info(ranges[[n]])
  ret[[n]]$range <- out$range
  ret[[n]]$major <- out$major_source
  ret[[n]]$minor <- out$minor_source
@@ -230,7 +230,7 @@ CoordMap <- ggproto("CoordMap", Coord,
  x.proj = ret$x$proj, y.proj = ret$y$proj,
  x.major = ret$x$major, x.minor = ret$x$minor, x.labels = ret$x$labels,
  y.major = ret$y$major, y.minor = ret$y$minor, y.labels = ret$y$labels,
- x.arrange = scale_x$axis_order(), y.arrange = scale_y$axis_order()
+ x.arrange = scales$x$axis_order(), y.arrange = scales$y$axis_order()
  )
  details
  },

R/coord-polar.R

@@ -111,12 +111,12 @@ CoordPolar <- ggproto("CoordPolar", Coord,
  )
  },
 
- setup_panel_params = function(self, scale_x, scale_y, params = list()) {
+ setup_panel_params = function(self, scales, params = list()) {
 
  ret <- list(x = list(), y = list())
  for (n in c("x", "y")) {
 
- scale <- get(paste0("scale_", n))
+ scale <- scales[[n]]
  limits <- self$limits[[n]]
 
  if (self$theta == n) {
@@ -151,11 +151,11 @@ CoordPolar <- ggproto("CoordPolar", Coord,
  if (self$theta == "y") {
  names(details) <- gsub("x\\.", "r.", names(details))
  names(details) <- gsub("y\\.", "theta.", names(details))
- details$r.arrange <- scale_x$axis_order()
+ details$r.arrange <- scales[["x"]]$axis_order()
  } else {
  names(details) <- gsub("x\\.", "theta.", names(details))
  names(details) <- gsub("y\\.", "r.", names(details))
- details$r.arrange <- scale_y$axis_order()
+ details$r.arrange <- scales[["y"]]$axis_order()
  }
 
  details
@@ -309,12 +309,12 @@ CoordPolar <- ggproto("CoordPolar", Coord,
  }
  },
 
- modify_scales = function(self, scales_x, scales_y) {
+ modify_scales = function(self, scales) {
  if (self$theta != "y")
  return()
 
- lapply(scales_x, scale_flip_position)
- lapply(scales_y, scale_flip_position)
+ lapply(scales$x, scale_flip_position)
+ lapply(scales$y, scale_flip_position)
  }
 )
 

R/coord-radial.R

@@ -135,18 +135,18 @@ CoordRadial <- ggproto("CoordRadial", Coord,
  )
  },
 
- setup_panel_params = function(self, scale_x, scale_y, params = list()) {
+ setup_panel_params = function(self, scales, params = list()) {
 
  params <- c(
- view_scales_polar(scale_x, self$theta, expand = params$expand[c(4, 2)]),
- view_scales_polar(scale_y, self$theta, expand = params$expand[c(3, 1)]),
+ view_scales_polar(scales$x, self$theta, expand = params$expand[c(4, 2)]),
+ view_scales_polar(scales$y, self$theta, expand = params$expand[c(3, 1)]),
  list(bbox = polar_bbox(self$arc, inner_radius = self$inner_radius),
  arc = self$arc, inner_radius = self$inner_radius)
  )
 
  axis_rotation <- self$r_axis_inside
  if (is.numeric(axis_rotation)) {
- theta_scale <- switch(self$theta, x = scale_x, y = scale_y)
+ theta_scale <- switch(self$theta, x = scales$x, y = scales$y)
  axis_rotation <- theta_scale$transform(axis_rotation)
  axis_rotation <- oob_squish(axis_rotation, params$theta.range)
  axis_rotation <- theta_rescale(
@@ -459,12 +459,12 @@ CoordRadial <- ggproto("CoordRadial", Coord,
  labels
  },
 
- modify_scales = function(self, scales_x, scales_y) {
+ modify_scales = function(self, scales) {
  if (self$theta != "y")
  return()
 
- lapply(scales_x, scale_flip_position)
- lapply(scales_y, scale_flip_position)
+ lapply(scales$x, scale_flip_position)
+ lapply(scales$y, scale_flip_position)
  },
 
  setup_params = function(self, data) {

R/coord-sf.R

@@ -166,15 +166,15 @@ CoordSf <- ggproto("CoordSf", CoordCartesian,
  graticule
  },
 
- setup_panel_params = function(self, scale_x, scale_y, params = list()) {
+ setup_panel_params = function(self, scales, params = list()) {
  # expansion factors for scale limits
- expansion_x <- default_expansion(scale_x, expand = params$expand[c(4, 2)])
- expansion_y <- default_expansion(scale_y, expand = params$expand[c(3, 1)])
+ expansion_x <- default_expansion(scales$x, expand = params$expand[c(4, 2)])
+ expansion_y <- default_expansion(scales$y, expand = params$expand[c(3, 1)])
 
  # get scale limits and coord limits and merge together
  # coord limits take precedence over scale limits
- scale_xlim <- scale_x$get_limits()
- scale_ylim <- scale_y$get_limits()
+ scale_xlim <- scales$x$get_limits()
+ scale_ylim <- scales$y$get_limits()
  coord_xlim <- self$limits$x %||% c(NA_real_, NA_real_)
  coord_ylim <- self$limits$y %||% c(NA_real_, NA_real_)
 
@@ -193,7 +193,7 @@ CoordSf <- ggproto("CoordSf", CoordCartesian,
 
  # merge coord bbox into scale limits if scale limits not explicitly set
  if (is.null(self$limits$x) && is.null(self$limits$y) &&
- is.null(scale_x$limits) && is.null(scale_y$limits)) {
+ is.null(scales$x$limits) && is.null(scales$y$limits)) {
  coord_bbox <- self$params$bbox
  scales_xrange <- range(scales_bbox$x, coord_bbox$xmin, coord_bbox$xmax, na.rm = TRUE)
  scales_yrange <- range(scales_bbox$y, coord_bbox$ymin, coord_bbox$ymax, na.rm = TRUE)
@@ -220,7 +220,7 @@ CoordSf <- ggproto("CoordSf", CoordCartesian,
  x_range[2], y_range[2]
  )
 
- breaks <- sf_breaks(scale_x, scale_y, bbox, params$crs)
+ breaks <- sf_breaks(scales$x, scales$y, bbox, params$crs)
 
  # Generate graticule and rescale to plot coords
  graticule <- sf::st_graticule(
@@ -240,12 +240,12 @@ CoordSf <- ggproto("CoordSf", CoordCartesian,
  }
 
  # override graticule labels provided by sf::st_graticule() if necessary
- graticule <- self$fixup_graticule_labels(graticule, scale_x, scale_y, params)
+ graticule <- self$fixup_graticule_labels(graticule, scales$x, scales$y, params)
 
  # Convert graticule to viewscales for axis guides
  viewscales <- Map(
  view_scales_from_graticule,
- scale = list(x = scale_x, y = scale_y, x.sec = scale_x, y.sec = scale_y),
+ scale = list(x = scales$x, y = scales$y, x.sec = scales$x, y.sec = scales$y),
  aesthetic = c("x", "y", "x.sec", "y.sec"),
  label = self$label_axes[c("bottom", "left", "top", "right")],
  MoreArgs = list(

R/coord-transform.R

@@ -151,10 +151,10 @@ CoordTrans <- ggproto("CoordTrans", Coord,
  transform_position(new_data, squish_infinite, squish_infinite)
  },
 
- setup_panel_params = function(self, scale_x, scale_y, params = list()) {
+ setup_panel_params = function(self, scales, params = list()) {
  c(
- view_scales_from_scale_with_coord_trans(scale_x, self$limits$x, self$trans$x, params$expand[c(4, 2)]),
- view_scales_from_scale_with_coord_trans(scale_y, self$limits$y, self$trans$y, params$expand[c(3, 1)])
+ view_scales_from_scale_with_coord_trans(scales$x, self$limits$x, self$trans$x, params$expand[c(4, 2)]),
+ view_scales_from_scale_with_coord_trans(scales$y, self$limits$y, self$trans$y, params$expand[c(3, 1)])
  )
  },
 

R/facet-.R

@@ -90,50 +90,39 @@ Facet <- ggproto("Facet", NULL,
  map_data = function(data, layout, params) {
  cli::cli_abort("Not implemented.")
  },
- init_scales = function(layout, x_scale = NULL, y_scale = NULL, params) {
- scales <- list()
- if (!is.null(x_scale)) {
- scales$x <- lapply(seq_len(max(layout$SCALE_X)), function(i) x_scale$clone())
- }
- if (!is.null(y_scale)) {
- scales$y <- lapply(seq_len(max(layout$SCALE_Y)), function(i) y_scale$clone())
+ init_scales = function(layout, scales, params) {
+ for (aes in names(scales)) {
+  if (is.null(scales[[aes]])) {
+  next
+  }
+  n <- max(layout[[paste0("SCALE_", to_upper_ascii(aes))]])
+ scales[[aes]] <- lapply(seq_len(n), function(i) scales[[aes]]$clone())
  }
  scales
  },
- train_scales = function(x_scales, y_scales, layout, data, params) {
+ train_scales = function(scales, layout, data, params) {
  # loop over each layer, training x and y scales in turn
  for (layer_data in data) {
  match_id <- NULL
 
- if (!is.null(x_scales)) {
- x_vars <- intersect(x_scales[[1]]$aesthetics, names(layer_data))
- if (length(x_vars) > 0) {
- match_id <- match(layer_data$PANEL, layout$PANEL)
- SCALE_X <- layout$SCALE_X[match_id]
- scale_apply(layer_data, x_vars, "train", SCALE_X, x_scales)
- }
- }
-
- if (!is.null(y_scales)) {
- y_vars <- intersect(y_scales[[1]]$aesthetics, names(layer_data))
- if (length(y_vars) > 0) {
- if (is.null(match_id)) {
- match_id <- match(layer_data$PANEL, layout$PANEL)
- }
- SCALE_Y <- layout$SCALE_Y[match_id]
-
- scale_apply(layer_data, y_vars, "train", SCALE_Y, y_scales)
+ for (aes in names(scales)) {
+ vars <- intersect(scales[[aes]][[1]]$aesthetics, names(layer_data))
+ if (length(vars) < 1) {
+ next
  }
+ match_id <- match_id %||% match(layer_data$PANEL, layout$PANEL)
+ SCALE <- layout[[paste0("SCALE_", to_upper_ascii(aes))]][match_id]
+ scale_apply(layer_data, vars, "train", SCALE, scales[[aes]])
  }
  }
  },
- draw_back = function(data, layout, x_scales, y_scales, theme, params) {
+ draw_back = function(data, layout, scales, theme, params) {
  rep(list(zeroGrob()), vec_unique_count(layout$PANEL))
  },
- draw_front = function(data, layout, x_scales, y_scales, theme, params) {
+ draw_front = function(data, layout, scales, theme, params) {
  rep(list(zeroGrob()), vec_unique_count(layout$PANEL))
  },
- draw_panels = function(self, panels, layout, x_scales = NULL, y_scales = NULL,
+ draw_panels = function(self, panels, layout, scales = NULL,
  ranges, coord, data = NULL, theme, params) {
 
  free <- params$free %||% list(x = FALSE, y = FALSE)
@@ -163,7 +152,7 @@ Facet <- ggproto("Facet", NULL,
  table <- self$attach_axes(table, layout, ranges, coord, theme, params)
  self$attach_strips(table, layout, params, theme)
  },
- draw_labels = function(panels, layout, x_scales, y_scales, ranges, coord, data, theme, labels, params) {
+ draw_labels = function(panels, layout, scales, ranges, coord, data, theme, labels, params) {
  panel_dim <- find_panel(panels)
 
  xlab_height_top <- grobHeight(labels$x[[1]])
@@ -197,7 +186,7 @@ Facet <- ggproto("Facet", NULL,
  setup_data = function(data, params) {
  data
  },
- finish_data = function(data, layout, x_scales, y_scales, params) {
+ finish_data = function(data, layout, scales, params) {
  data
  },
  init_gtable = function(panels, layout, theme, ranges, params,

R/facet-null.R

@@ -39,7 +39,7 @@ FacetNull <- ggproto("FacetNull", Facet,
  data$PANEL <- factor(1)
  data
  },
- draw_panels = function(panels, layout, x_scales, y_scales, ranges, coord, data, theme, params) {
+ draw_panels = function(panels, layout, scales, ranges, coord, data, theme, params) {
 
  range <- ranges[[1]]
 

R/facet-wrap.R

@@ -451,7 +451,7 @@ FacetWrap <- ggproto("FacetWrap", Facet,
  table
  },
 
- draw_panels = function(self, panels, layout, x_scales, y_scales, ranges, coord, data, theme, params) {
+ draw_panels = function(self, panels, layout, scales, ranges, coord, data, theme, params) {
  if (inherits(coord, "CoordFlip")) {
  if (params$free$x) {
  layout$SCALE_X <- seq_len(nrow(layout))