diff --git a/NEWS b/NEWS index 3db5ad3fd7..120337e902 100644 --- a/NEWS +++ b/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) \ No newline at end of file +* 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 \ No newline at end of file diff --git a/R/facet-wrap.r b/R/facet-wrap.r index 6574b4f557..6350436de7 100644 --- a/R/facet-wrap.r +++ b/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 diff --git a/R/scale-.r b/R/scale-.r index 51842fd447..d190a79e30 100644 --- a/R/scale-.r +++ b/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() diff --git a/R/scale-discrete-.r b/R/scale-discrete-.r index f9f15ed492..c45a1a0bd8 100644 --- a/R/scale-discrete-.r +++ b/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)) } diff --git a/R/scales-.r b/R/scales-.r index 7172ebddab..1b1dfac480 100644 --- a/R/scales-.r +++ b/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)