Train position scales using all position aesthetics

R/layer.r

@@ -210,7 +210,7 @@ Layer <- proto(expr = {
 
   adjust_position <- function(., data) {
     ddply(data, "PANEL", function(data) {
-      .$position$adjust(data, scales)
+      .$position$adjust(data)
     })
   }
 

R/panel.r

@@ -31,10 +31,6 @@ train_layout <- function(panel, facet, data, plot_data) {
   panel$layout <- layout
   panel$shrink <- facet$shrink
 
-  # Make space for scales
-  panel$x_scales <- vector("list", max(layout$SCALE_X))
-  panel$y_scales <- vector("list", max(layout$SCALE_Y))
-
   panel
 }
 
@@ -67,34 +63,35 @@ map_layout <- function(panel, facet, data, plot_data) {
 # @param x_scale x scale for the plot
 # @param y_scale y scale for the plot
 train_position <- function(panel, data, x_scale, y_scale) { 
-  # Extract columns relevant for position, and join with panel info
-  pos <- ldply(data, function(df) df[c("x", "y", "PANEL")])
-  pos <- join(pos, panel$layout, by = "PANEL", match = "first")
-
-  # Loop through data for each scale, creating a new scale if needed
-  d_ply(pos, "SCALE_X", function(df) {
-    if (is.null(df$x)) return()
-
-    i <- df$SCALE_X[1]
-    if (is.null(panel$x_scales[[i]])) {
-      panel$x_scales[[i]] <<- scale_clone(x_scale)
-    }
-    scale_train(panel$x_scales[[i]], df$x)
-  })
+  # Initialise scales if needed, and possible.
+  layout <- panel$layout
+  if (is.null(panel$x_scales) && !is.null(x_scale)) {
+    panel$x_scales <- rlply(max(layout$SCALE_X), scale_clone(x_scale))
+  }
+  if (is.null(panel$y_scales) && !is.null(y_scale)) {
+    panel$y_scales <- rlply(max(layout$SCALE_Y), scale_clone(y_scale))
+  }
 
-  d_ply(pos, "SCALE_Y", function(df) {
-    if (is.null(df$y)) return()
+  # loop over each layer, training x and y scales in turn
+  for(layer_data in data) {
+    pos <- join(layer_data, layout, by = "PANEL")
 
-    i <- df$SCALE_Y[1]
-    if (is.null(panel$y_scales[[i]])) {
-      panel$y_scales[[i]] <<- scale_clone(y_scale)
-    }
-    scale_train(panel$y_scales[[i]], df$y)
-  })
-
+    # Loop through data for each scale, creating a new scale if needed
+    d_ply(pos, "SCALE_X", function(df) {
+      if (is.null(x_scale)) return()
+      scale_train_df(panel$x_scales[[df$SCALE_X[1]]], df)
+    })
+
+    d_ply(pos, "SCALE_Y", function(df) {
+      if (is.null(y_scale)) return()
+      scale_train_df(panel$y_scales[[df$SCALE_Y[1]]], df)
+    })
+  }
+
   panel
 }
 
+
 reset_scales <- function(panel) {
   if (!panel$shrink) return()
   l_ply(panel$x_scales, scale_reset)

R/scales-.r

@@ -30,6 +30,7 @@ Scales <- setRefClass("Scales", fields = "scales", methods = list(
   },
   get_scales = function(output) {
     scale <- scales[find(output)]
+    if (length(scale) == 0) return()
     scale[[1]]
   }  
 ))

inst/tests/test-scales.r

@@ -52,4 +52,36 @@ test_that("identity scale preserves input values", {
   expect_that(d1$alpha, equals(as.numeric(df$z)))
 
 
+})
+
+test_that("position scales updated by all position aesthetics", {
+  df <- data.frame(x = 1:3)
+
+  aesthetics <- list(
+    aes(xend = x, yend = x),
+    aes(xmin = x, ymin = x),
+    aes(xmax = x, ymax = x)
+  )
+
+  base <- ggplot(df, aes(x = 1, y = 1)) + geom_point()
+  plots <- lapply(aesthetics, function(x) base %+% x)
+  ranges <- lapply(plots, pranges)
+
+  lapply(ranges, function(range) {
+    expect_that(range$x[[1]], equals(c(1, 3)))
+    expect_that(range$y[[1]], equals(c(1, 3)))
+  })
+
+})
+
+test_that("position scales generate after stats", {
+  df <- data.frame(x = factor(c(1, 1, 1)))
+  plot <- ggplot(df, aes(x)) + geom_bar()
+  ranges <- pranges(plot)
+
+  expect_that(ranges$x[[1]], equals(c("1")))
+  expect_that(ranges$y[[1]], equals(c(0, 3)))
+
+
+
 })