Breaks and labels enhancement

NEWS

@@ -10,4 +10,8 @@ ggplot2 0.8.5 (2009-XX-XX) ----------------------------------------
   (implements #24)
 * facet_wrap now maintains original order of data
 * geom_bin now allows you to set whether bins used intervals of the form 
-  (a, b] or [a, b) with the "right" parameter (implements #20)
+  (a, b] or [a, b) with the "right" parameter (implements #20)
+* scales: all scales check that breaks are supplied if labels are, and 
+  that breaks and labels are the same length (implements #40)
+* scales: if breaks are a named vector, the names will be used as labels
+  (thanks to suggestion by David Kahle)

R/scale-continuous-.r

@@ -8,7 +8,6 @@ ScaleContinuous <- proto(Scale, funEnvir = globalenv(), {
   tr_default <- "identity"
 
   new <- function(., name=NULL, limits=NULL, breaks=NULL, labels=NULL, variable, trans = NULL, expand=c(0.05, 0), minor_breaks = NULL, formatter = "scientific", ...) {
-    if (is.null(breaks) && !is.null(labels)) stop("Labels can only be specified in conjunction with breaks")
 
     if (is.null(trans))      trans <- .$tr_default
     if (is.character(trans)) trans <- Trans$find(trans)
@@ -18,7 +17,9 @@ ScaleContinuous <- proto(Scale, funEnvir = globalenv(), {
     breaks <- trans$transform(breaks)
     minor_breaks <- trans$transform(minor_breaks)
 
-    .$proto(name=name, .input=variable, .output=variable, limits=limits, breaks = breaks, .labels = labels, .expand=expand, .tr = trans, minor_breaks = minor_breaks, formatter = formatter, ...)
+    b_and_l <- check_breaks_and_labels(breaks, labels)
+
+    .$proto(name=name, .input=variable, .output=variable, limits=limits, breaks = b_and_l$breaks, .labels = b_and_l$labels, .expand=expand, .tr = trans, minor_breaks = minor_breaks, formatter = formatter, ...)
   }
 
   set_limits <- function(., limits) {
@@ -163,3 +164,20 @@ ScaleContinuous <- proto(Scale, funEnvir = globalenv(), {
   }
 })
 
+
+
+check_breaks_and_labels <- function(breaks = NULL, labels = NULL) {
+  if (is.null(breaks) && is.null(labels)) {
+  } else if (is.null(breaks)) {
+    stop("Labels can only be specified in conjunction with breaks", 
+      call. = FALSE)
+  } else if (is.null(labels)) {
+    labels <- names(breaks)
+  } else { 
+    if (length(labels) != length(breaks)) {
+      stop("Labels and breaks must be same length", call. = FALSE)
+    }
+  }
+
+  list(breaks = breaks, labels = labels)  
+}

R/scale-continuous-colour.r

@@ -3,7 +3,10 @@ ScaleGradient <- proto(ScaleContinuous, expr={
 
   new <- function(., name=NULL, low="#3B4FB8", high="#B71B1A", space="rgb", breaks = NULL, labels = NULL, limits=NULL, trans="identity", ..., variable) {
     if (is.character(trans)) trans <- Trans$find(trans)
-    .$proto(name=name, low=low, high=high, space=space, .input=variable, .output=variable, .tr = trans, limits=limits, breaks = breaks, .labels = labels, ...)
+
+    b_and_l <- check_breaks_and_labels(breaks, labels)
+
+    .$proto(name=name, low=low, high=high, space=space, .input=variable, .output=variable, .tr = trans, limits=limits, breaks = b_and_l$breaks, .labels = b_and_l$labels, ...)
   }
 
   map <- function(., x) {
@@ -93,7 +96,10 @@ ScaleGradient <- proto(ScaleContinuous, expr={
 ScaleGradient2 <- proto(ScaleContinuous, expr={  
   new <- function(., name=NULL, low=muted("red"), mid="white", high=muted("blue"), midpoint=0, space="rgb", breaks = NULL, labels = NULL, limits=NULL, trans="identity", ..., variable) {
     if (is.character(trans)) trans <- Trans$find(trans)
-    .$proto(name=name, low=low, mid=mid, high=high, midpoint=midpoint, space=space, ..., .input=variable, .output=variable, .tr=trans, limits=limits, breaks = breaks, .labels = labels)
+
+    b_and_l <- check_breaks_and_labels(breaks, labels)
+
+    .$proto(name=name, low=low, mid=mid, high=high, midpoint=midpoint, space=space, ..., .input=variable, .output=variable, .tr=trans, limits=limits, breaks = b_and_l$breaks, .labels = b_and_l$labels)
   }
 
   aliases <- c("scale_color_gradient2")
@@ -190,12 +196,14 @@ ScaleGradientn <- proto(ScaleContinuous, expr={
     if (is.character(trans)) trans <- Trans$find(trans)
     if (!is.null(values)) limits <- range(values)
 
+    b_and_l <- check_breaks_and_labels(breaks, labels)
+
     .$proto(
       name = name, 
       colours = colours, values = values, rescale = rescale, 
       space = space,  ..., 
       .input = variable, .output = variable, .tr = trans, 
-      limits = limits, breaks = breaks, .labels = labels
+      limits = limits, breaks = b_and_l$breaks, .labels = b_and_l$labels
     )
   }
 

R/scale-discrete-.r

@@ -8,7 +8,10 @@ ScaleDiscrete <- proto(Scale, expr={
   discrete <- function(.) TRUE
 
   new <- function(., name=NULL, variable=.$.input, expand = c(0.05, 0.55), limits = NULL, breaks = NULL, labels = NULL, formatter = identity, drop = FALSE) {
-    .$proto(name=name, .input=variable, .output=variable, .expand = expand, .labels = labels, limits = limits, breaks = breaks, formatter = formatter, drop = drop)
+
+    b_and_l <- check_breaks_and_labels(breaks, labels)
+
+    .$proto(name=name, .input=variable, .output=variable, .expand = expand, .labels = labels, limits = b_and_l$limits, breaks = b_and_l$breaks, formatter = formatter, drop = drop)
   }
 
   # Range -------------------

R/scale-discrete-colour.r

@@ -8,7 +8,9 @@ ScaleHue <- proto(ScaleColour, expr={
   aliases <- c("scale_colour_discrete", "scale_fill_discrete", "scale_color_hue")
 
   new <- function(., name=NULL, h=c(0,360) + 15, l=65, c=100, limits=NULL, breaks = NULL, labels=NULL, h.start = 0, direction = 1,  formatter = identity, variable) {
-    .$proto(name=name, h=h, l=l, c=c, .input=variable, .output=variable, .labels = labels, breaks = breaks, direction = direction, start  = h.start, limits = limits, formatter = formatter)
+    b_and_l <- check_breaks_and_labels(breaks, labels)
+
+    .$proto(name=name, h=h, l=l, c=c, .input=variable, .output=variable, .labels = b_and_l$labels, breaks = b_and_l$breaks, direction = direction, start  = h.start, limits = limits, formatter = formatter)
   }
 
   output_set <- function(.) {
@@ -84,7 +86,8 @@ ScaleBrewer <- proto(ScaleColour, expr={
   doc <- TRUE
 
   new <- function(., name=NULL, palette=1, type="qual", limits=NULL, breaks = NULL, labels=NULL, formatter = identity, variable) {
-    .$proto(name=name, palette=palette, type=type, .input=variable, .output=variable, .labels = labels, breaks = breaks, limits= limits, formatter = formatter)
+    b_and_l <- check_breaks_and_labels(breaks, labels)
+    .$proto(name=name, palette=palette, type=type, .input=variable, .output=variable, .labels = b_and_l$labels, breaks = b_and_l$breaks, limits= limits, formatter = formatter)
   }
   aliases <- c("scale_color_brewer")
 

R/scale-discrete-grey.r

@@ -3,7 +3,10 @@ ScaleGrey <- proto(ScaleColour, expr={
   common <- c("colour", "fill")
 
   new <- function(., name=NULL, variable, start = 0.2, end = 0.8, limits=NULL, breaks = NULL, labels=NULL, formatter = identity) {
-    .$proto(name=name, .input=variable, .output=variable, start=start, end=end, limits = limits, breaks = breaks, .labels = labels, formatter=formatter)
+
+    b_and_l <- check_breaks_and_labels(breaks, labels)
+
+    .$proto(name=name, .input=variable, .output=variable, start=start, end=end, limits = limits, breaks = b_and_l$breaks, .labels = b_and_l$labels, formatter=formatter)
   }
 
   output_set <- function(.) {

R/scale-identity.r

@@ -2,7 +2,10 @@ ScaleIdentity <- proto(ScaleDiscrete, {
   doc <- TRUE
   common <- c("colour","fill","size","shape","linetype")
   new <- function(., name=NULL, breaks=NULL, labels=NULL, formatter = NULL, variable="x") {
-    .$proto(name=name, breaks=breaks, .labels=labels, .input=variable, .output=variable, formatter = formatter)
+
+    b_and_l <- check_breaks_and_labels(breaks, labels)
+
+    .$proto(name=name, breaks=b_and_l$breaks, .labels=b_and_l$labels, .input=variable, .output=variable, formatter = formatter)
   }
 
   train <- function(., data, drop = FALSE) {

R/scale-manual.r

@@ -4,7 +4,9 @@ ScaleManual <- proto(ScaleDiscrete, {
   values <- c()
 
   new <- function(., name=NULL, values=NULL, variable="x", limits = NULL, breaks = NULL, labels = NULL, formatter = identity) {
-    .$proto(name=name, values=values, .input=variable, .output=variable, limits = limits, breaks = breaks, .labels = labels, formatter = formatter)
+    b_and_l <- check_breaks_and_labels(breaks, labels)
+
+    .$proto(name=name, values=values, .input=variable, .output=variable, limits = limits, breaks = b_and_l$breaks, .labels = b_and_l$labels, formatter = formatter)
   }
 
   map <- function(., values) {

R/scale-shape.r

@@ -6,7 +6,9 @@ ScaleShape <- proto(ScaleDiscrete, expr={
   solid <- TRUE
 
   new <- function(., name=NULL, solid=TRUE, limits = NULL, breaks = NULL, labels = NULL, formatter = identity) {
-    .$proto(name=name, solid=solid, limits = limits, breaks = breaks, .labels = labels, formatter = formatter)
+
+    b_and_l <- check_breaks_and_labels(breaks, labels)
+    .$proto(name=name, solid=solid, limits = b_and_l$limits, breaks = b_and_l$breaks, .labels = labels, formatter = formatter)
   }
 
   output_set <- function(.) {

R/scale-size.r

@@ -6,7 +6,10 @@ ScaleSize <- proto(ScaleContinuous, expr={
 
 
   new <- function(., name=NULL, limits=NULL, breaks=NULL, labels=NULL, trans = NULL, to = c(1, 6)) {
-    .super$new(., name=name, limits=limits, breaks=breaks, labels=labels, trans=trans, variable = "size", to = to)
+
+    b_and_l <- check_breaks_and_labels(breaks, labels)
+
+    .super$new(., name=name, limits=limits, breaks=b_and_l$breaks, labels=b_and_l$labels, trans=trans, variable = "size", to = to)
   }
 
   map <- function(., values) {