Deal correctly with dropping var combinations in facet_wrap. Also bet…

…ter fix to labelling bug

NEWS

@@ -19,4 +19,5 @@ ggplot2 0.8.3  (2008-XX-XX)
 * errorbarh: new geom for horizontal error bars
 * theme_bw: corrected justification of axis.text.y
 * geom_step: improve legend
-* facet_wrap: corrected labelling when facetting by multiple variables (thank to Charlotte Wickham for a clear test case)
+* facet_wrap: corrected labelling when facetting by multiple variables (thank to Charlotte Wickham for a clear test case)
+* facet_wrap: add drop argument to control whether or not panels for non-existent combinations of facetting variables should be dropped or not.  Defaults to TRUE

R/facet-wrap.r

@@ -1,5 +1,5 @@
 FacetWrap <- proto(Facet, {
-  new <- function(., facets, nrow = NULL, ncol = NULL, scales = "fixed", as.table = TRUE) {
+  new <- function(., facets, nrow = NULL, ncol = NULL, scales = "fixed", as.table = TRUE, drop = TRUE) {
     scales <- match.arg(scales, c("fixed", "free_x", "free_y", "free"))
     free <- list(
       x = any(scales %in% c("free_x", "free")),
@@ -8,7 +8,7 @@ FacetWrap <- proto(Facet, {
 
     .$proto(
       facets = as.quoted(facets), free = free, 
-      scales = NULL, as.table = as.table,
+      scales = NULL, as.table = as.table, drop = drop,
       ncol = ncol, nrow = nrow
     )
   }
@@ -24,19 +24,13 @@ FacetWrap <- proto(Facet, {
       as.data.frame(eval.quoted(.$facets, df))
     })
 
-    # Order labels correctly: first column varies fastest
-    labels <- unique(do.call(rbind, vars))
-    labels <- labels[do.call("order", rev(labels)), , drop = FALSE]
-    n <- nrow(labels)
-
-    .$shape <- matrix(NA, 1, n)
-    attr(.$shape, "split_labels") <- labels
+    .$shape <- dlply(data, .$facets, .drop = .$drop)
   }
 
   stamp_data <- function(., data) {
     data <- add_missing_levels(data, .$conditionals())
     lapply(data, function(df) {
-      data.matrix <- dlply(add_group(df), .$facets, .drop = FALSE)
+      data.matrix <- dlply(add_group(df), .$facets, .drop = .$drop)
       data.matrix <- as.list(data.matrix)
       dim(data.matrix) <- c(1, length(data.matrix))
       data.matrix

R/scale-.r

@@ -60,6 +60,7 @@ Scale <- proto(TopLevel, expr={
 
   # Train scale from a data frame
   train_df <- function(., df, drop = FALSE) {
+    if (is.null(df) || nrow(df) == 0) return() 
     # Don't train if limits have already been set
     if (!is.null(.$limits)) return()
 

R/scale-discrete-.r

@@ -40,6 +40,8 @@ ScaleDiscrete <- proto(Scale, expr={
   # Override default behaviour: we do need to train, even if limits
   # have been set
   train_df <- function(., df, drop = FALSE) {
+    if (is.null(df) || nrow(df) == 0) return() 
+
     input <- .$input_aesthetics(df)
     l_ply(input, function(var) .$train(df[[var]], drop))
   }

R/scales-.r

@@ -97,7 +97,7 @@ Scales <- proto(Scale, expr={
 
   # Train scale from a data frame
   train_df <- function(., df, drop = FALSE) {
-    if (is.null(df)) return()
+    if (is.null(df) || nrow(df) == 0) return() 
 
     lapply(.$.scales, function(scale) {
       scale$train_df(df, drop)