Rewrite of default label handling

Author: hadley

NEWS

@@ -22,3 +22,10 @@ ggplot2 0.8.5 (2009-XX-XX) ----------------------------------------
   value.  This was always a good idea, but now it is enforced with an 
   informative error message.
 * xlim, ylim: fix bug when setting limits of discrete scales
+* labels are now stored in the options, rather than in individual scales.  
+  This fixes a long standing bug where it was not easy to set the label for
+  computed variable, such as the y axis on a histogram. Additionally, it means
+  default scales are only added to the plot until just prior to plotting, 
+  instead of the previous behaviour where scales where added as layers were
+  added - this could cause problems if you layer modified the plot.
+  (Implements #28)

R/aes.r

@@ -36,6 +36,7 @@
 # @alias str.uneval
 # @alias print.uneval
 # @alias [.uneval
+# @alias as.character.uneval
 # @seealso \code{\link{aes_string}}
 #X aes(x = mpg, y = wt)
 #X aes(x = mpg ^ 2, y = wt / cyl)
@@ -118,6 +119,12 @@ print.uneval <- function(x, ...) str(unclass(x))
 str.uneval <- function(object, ...) str(unclass(object), ...)
 "[.uneval" <- function(x, i, ...) structure(unclass(x)[i], class = "uneval") 
 
+as.character.uneval <- function(x, ...) {
+  char <- as.character(unclass(x))
+  names(char) <- names(x)
+  char
+}
+
 # Aesthetic defaults
 # Convenience method for setting aesthetic defaults
 # 

R/facet-.r

@@ -17,8 +17,10 @@ Facet <- proto(TopLevel, {
     params[setdiff(names(params), c(".","variable"))]
   }
 
-  xlabel <- function(., theme) 
-    .$scales$x[[1]]$name
+  xlabel <- function(., theme) {
+    nulldefault(.$scales$x[[1]]$name, theme$labels$x)
+  }
+    
   ylabel <- function(., theme) 
-    .$scales$y[[1]]$name
+    nulldefault(.$scales$y[[1]]$name, theme$labels$y)
 })

R/guides-legend.r

@@ -61,18 +61,25 @@ guide_legends_box <- function(scales, layers, default_mapping, horizontal = FALS
 #X qplot(mpg, wt, data = mtcars, colour = cyl2)
 #X theme_set(theme_grey())
 guide_legends <- function(scales, layers, default_mapping, theme) {
-  legends <- scales$legend_desc()
-  if (length(legends) == 0) return()
+  legend <- scales$legend_desc(theme)
+  if (length(legend$titles) == 0) return()
 
-  lapply(names(legends), function(var) {
-    build_legend(var, legends[[var]], layers, default_mapping, theme)
+  titles <- unique(legend$titles)
+  lapply(titles, function(title) {
+    keys <- legend$keys[sapply(legend$titles, identical, title)]
+    if (length(keys) > 1) { 
+      # Multiple scales for this legend      
+      keys <- merge_recurse(keys, by = c(".value", ".label"))
+    } else {
+      keys <- keys[[1]]
+    }
+    
+    build_legend(title, keys, layers, default_mapping, theme)
   })
 }
 
 build_legend <- function(name, mapping, layers, default_mapping, theme) {
   legend_data <- llply(layers, build_legend_data, mapping, default_mapping)
-  # if (length(legend_data) == 0) return(zeroGrob())
-  # browser()
 
   # Calculate sizes for keys - mainly for v. large points and lines
   size_mat <- do.call("cbind", llply(legend_data, "[[", "size"))
@@ -82,10 +89,6 @@ build_legend <- function(name, mapping, layers, default_mapping, theme) {
     key_heights <- apply(size_mat, 1, max)    
   }
 
-  # points <- laply(layers, function(l) l$geom$objname == "point")
-  width <- max(unlist(llply(legend_data, "[[", "size")), 0)
-
-  name <- eval(parse(text = name))
   title <- theme_render(
     theme, "legend.title",
     name, x = 0, y = 0.5
@@ -96,6 +99,8 @@ build_legend <- function(name, mapping, layers, default_mapping, theme) {
   hgap <- vgap <- unit(0.3, "lines")
 
   label_width  <- max(stringWidth(mapping$.label))
+
+  width <- max(unlist(llply(legend_data, "[[", "size")), 0)
   key_width <- max(theme$legend.key.size, unit(width, "mm"))
 
   widths <- unit.c(

R/labels.r

@@ -11,14 +11,7 @@
 #X update_labels(p, list(colour = "Fail silently"))
 update_labels <- function(p, labels) {
   p <- plot_clone(p)
-
-  for(name in names(labels)) {
-    scale <- p$scales$get_scales(name)$clone()
-    p$scales$add(scale)
-    scale$name <- labels[[name]]
-  }
-  
-  p
+  p + opts(labels = labels)
 }
 
 # Change axis labels and legend titles

R/plot-construction.r

@@ -22,6 +22,7 @@
   if (is.data.frame(object)) {
     p$data <- object
   } else if (inherits(object, "options")) {
+    object$labels <- defaults(object$labels, p$options$labels)
     p$options <- defaults(object, p$options)
   } else if(inherits(object, "labels")) {
       p <- update_labels(p, object)
@@ -39,9 +40,13 @@
     p <- switch(object$class(),
       layer  = {
         p$layers <- append(p$layers, object)
-        data <- if(empty(object$data)) p$data else object$data
-        mapping <- object$mapping %||% p$mapping
-        p$scales$add_defaults(data, mapping, p$plot_env)
+        
+        # Add any new labels
+        mapping <- as.list(as.character(object$mapping))
+        default <- as.list(as.character(object$stat$default_aes()))
+        
+        new_labels <- defaults(mapping, default)
+        p$options$labels <- defaults(p$options$labels, new_labels)
         p
       },
       coord = {

R/plot-render.r

@@ -53,7 +53,7 @@ ggplotGrob <- function(plot, drop = plot$options$drop, keep = plot$options$keep,
   horiz <- any(c("top", "bottom") %in% position)
   vert <-  any(c("left", "right") %in% position)
 
-
+  
   # Generate grobs -----------------------------------------------------------
   # each of these grobs has a vp set
 
@@ -66,8 +66,8 @@ ggplotGrob <- function(plot, drop = plot$options$drop, keep = plot$options$keep,
   title <- theme_render(theme, "plot.title", plot$options$title)
 
   labels <- cs$labels(list(
-    x = pieces$facet$xlabel(),
-    y = pieces$facet$ylabel())
+    x = pieces$facet$xlabel(theme),
+    y = pieces$facet$ylabel(theme))
   )
   xlabel <- theme_render(theme, "axis.title.x", labels$x)
   ylabel <- theme_render(theme, "axis.title.y", labels$y)

R/plot.r

@@ -33,7 +33,7 @@ ggplot.data.frame <- function(data, mapping=aes(), ..., environment = globalenv(
     plot_env = environment
   ), class="ggplot")
 
-  p$scales$add_defaults(p$data, p$mapping, p$plot_env)
+  p$options$labels <- as.list(as.character(mapping))
 
   set_last_plot(p)
   p

R/quick-plot.r

@@ -88,6 +88,7 @@ qplot <- function(x, y = NULL, z=NULL, ..., data, facets = . ~ ., margins=FALSE,
       stat <- "qq"
     } else if (missing(y)) {
       geom[geom == "auto"] <- "histogram"
+      if (is.null(ylab)) ylab <- "count"
     } else {
       if (missing(x)) {
         aesthetics$x <- bquote(seq_along(.(y)), aesthetics)

R/scales-.r

@@ -12,14 +12,11 @@ Scales <- proto(Scale, expr={
   n <- function(.) length(.$.scales)
 
   add <- function(., scale) {
+    # Remove old scale if it exists
     old <- .$find(scale$output())
-
-    if (length(old) > 0 && sum(old) == 1 && is.null(scale$name)) {
-      scale <- scale$clone()
-      scale$name <- .$.scales[old][[1]]$name
-    }
-    
     .$.scales[old] <- NULL
+    
+    # Add new scale
     .$.scales <- append(.$.scales, scale)
   }
 
@@ -56,30 +53,33 @@ Scales <- proto(Scale, expr={
     Filter(function(x) x$trained(), .$.scales)
   }
 
-  get_scales_by_name <- function(., input) {
-    Filter(function(s) deparse(s$name) == input, .$get_trained_scales())
-  }
-  
-  variables <- function(.) {
-    unique(sapply(.$.scales, function(scale) deparse(scale$name)))
-  }
-  
-  legend_desc <- function(.) {
-    # For each input aesthetic, get breaks and labels
-    vars <- .$variables() 
-    names(vars) <- vars
-    compact(lapply(vars, function(var) {
-      scales <- .$get_scales_by_name(var)
-      # Remove scales with legend == FALSE
-      scales <- Filter(function(y) y$legend, scales)
-      if (length(scales) == 0) return()
+  legend_desc <- function(., theme) {
+    # Loop through all scales, creating a list of titles, and a list of keys
+    keys <- titles <- vector("list", .$n())
+    
+    for(i in seq_len(.$n())) {
+      scale <- .$.scales[[i]]
+      if (!scale$legend) next
 
-      breaks <- as.data.frame(lapply(scales, function(s) s$output_breaks()))
-      names(breaks)  <- lapply(scales, function(s) s$output())
+      # Figure out legend title
+      output <- scale$output()
+      if (!is.null(scale$name)) {
+        titles[[i]] <- scale$name
+      } else {
+        titles[[i]] <- theme$labels[[output]]
+      }
 
-      breaks$.labels <- scales[[1]]$labels()
-      breaks
-    }))
+      key <- data.frame(
+        scale$output_breaks(), scale$input_breaks(), I(scale$labels()))
+      names(key) <- c(output, ".value", ".label")
+      
+      keys[[i]] <- key
+    }
+    
+    empty <- sapply(titles, is.null)
+    
+    list(titles = titles[!empty], keys = keys[!empty])
+
   }
 
   position_scales <- function(.) {
@@ -138,9 +138,8 @@ Scales <- proto(Scale, expr={
   # Add default scales.
   # Add default scales to a plot.
   # 
-  # Called everytime a layer is added to the plot, so that default
-  # scales are always available for modification.   The type of a scale is
-  # fixed by the first use in a layer.
+  # Called during final construction to ensure that all aesthetics have 
+  # a scale
   add_defaults <- function(., data, aesthetics, env) {
     if (is.null(aesthetics)) return()
     names(aesthetics) <- laply(names(aesthetics), aes_to_scale)
@@ -150,9 +149,6 @@ Scales <- proto(Scale, expr={
     # No new aesthetics, so no new scales to add
     if(is.null(new_aesthetics)) return()
 
-    # Compute default scale names
-    names <- as.vector(sapply(aesthetics[new_aesthetics], deparse))
-
     # Determine variable type for each column -------------------------------
     vartype <- function(x) {
       if (inherits(x, "Date")) return("date")
@@ -177,18 +173,14 @@ Scales <- proto(Scale, expr={
     scale_name_generic <- paste("scale", vartypes, sep="_")
 
     for(i in 1:length(new_aesthetics)) {
-      s <- tryNULL(get(scale_name_type[i]))
-      if (!is.null(s)) {
-        .$add(s(name=names[i]))
+      scale <- tryNULL(get(scale_name_type[i]))
+      if (!is.null(scale)) {
+        .$add(scale())
       } else {      
-        s <- tryNULL(get(scale_name[i]))
-        if (!is.null(s)) {
-          .$add(s(name=names[i]))
+        scale <- tryNULL(get(scale_name[i]))
+        if (!is.null(scale)) {
+          .$add(scale())
         }
-        # } else {
-        #   s <- tryNULL(get(scale_name_generic[i]))
-        #   .$add(s(name=names[i], variable=new_aesthetics[i]))
-        # }
       }
     }