diff --git a/R/facet-layout.r b/R/facet-layout.r index 5abae3d2f3..65dd5cebfd 100644 --- a/R/facet-layout.r +++ b/R/facet-layout.r @@ -98,6 +98,11 @@ layout_base <- function(data, vars = NULL, drop = TRUE) { base <- rbind(base, df.grid(old, new)) } + + if (is.null(base)) { + stop("Faceting variables must have at least one value") + } + base } diff --git a/R/facet-locate.r b/R/facet-locate.r index e9e1348972..bee123b4e3 100644 --- a/R/facet-locate.r +++ b/R/facet-locate.r @@ -4,6 +4,10 @@ # # @params data a data frame locate_grid <- function(data, panels, rows = NULL, cols = NULL, margins = FALSE) { + if (empty(data)) { + return(cbind(data, PANEL = integer(0))) + } + rows <- as.quoted(rows) cols <- as.quoted(cols) vars <- c(names(rows), names(cols)) @@ -48,6 +52,9 @@ locate_grid <- function(data, panels, rows = NULL, cols = NULL, margins = FALSE) } locate_wrap <- function(data, panels, vars) { + if (empty(data)) { + return(cbind(data, PANEL = integer(0))) + } vars <- as.quoted(vars) facet_vals <- quoted_df(data, vars) diff --git a/R/facet-null.r b/R/facet-null.r index ffcc720b5f..abbdb06f1a 100644 --- a/R/facet-null.r +++ b/R/facet-null.r @@ -20,7 +20,10 @@ facet_train_layout.null <- function(facet, data) { #' @S3method facet_map_layout null facet_map_layout.null <- function(facet, data, layout) { - if (empty(data)) return(data.frame(PANEL = 1)) + # Need the is.waive check for special case where no data, but aesthetics + # are mapped to vectors, like qplot(1:5, 1:5) + if (is.waive(data) || empty(data)) + return(cbind(data, PANEL = integer(0))) data$PANEL <- 1L data } diff --git a/R/fortify.r b/R/fortify.r index af07eacf61..1366ccc47d 100644 --- a/R/fortify.r +++ b/R/fortify.r @@ -15,7 +15,7 @@ fortify <- function(model, data, ...) UseMethod("fortify") fortify.data.frame <- function(model, data, ...) model -fortify.NULL <- function(model, data, ...) data.frame() +fortify.NULL <- function(model, data, ...) waiver() fortify.default <- function(model, data, ...) { stop("ggplot2 doesn't know how to deal with data of class ", class(model), call. = FALSE) diff --git a/R/layer.r b/R/layer.r index e3bea9dace..67beaa454b 100644 --- a/R/layer.r +++ b/R/layer.r @@ -159,9 +159,22 @@ Layer <- proto(expr = { evaled <- compact( eval.quoted(aesthetics, data, plot$plot_env)) - if (length(evaled) == 0) return(data.frame(PANEL = unique(data$PANEL))) - # evaled <- evaled[sapply(evaled, is.atomic)] - data.frame(evaled, PANEL = data$PANEL) + lengths <- vapply(evaled, length, integer(1)) + n <- if (length(lengths) > 0) max(lengths) else 0 + + wrong <- lengths != 1 & lengths != n + if (any(wrong)) { + stop("Aesthetics must either be length one, or the same length as the data", + "Problems:", paste(aesthetics[wrong], collapse = ", "), call. = FALSE) + } + + if (empty(data) && n > 0) { + # No data, and vectors suppled to aesthetics + evaled$PANEL <- 1 + } else { + evaled$PANEL <- data$PANEL + } + data.frame(evaled) } diff --git a/R/panel.r b/R/panel.r index 81c20e90c6..45343484f4 100644 --- a/R/panel.r +++ b/R/panel.r @@ -47,7 +47,7 @@ train_layout <- function(panel, facet, data, plot_data) { # @param plot_data default plot data frame map_layout <- function(panel, facet, data, plot_data) { lapply(data, function(data) { - if (empty(data)) data <- plot_data + if (is.waive(data)) data <- plot_data facet_map_layout(facet, data, panel$layout) }) } @@ -138,6 +138,7 @@ map_position <- function(panel, data, x_scale, y_scale) { # speed scale_apply <- function(data, vars, f, scale_id, scales) { if (length(vars) == 0) return() + if (nrow(data) == 0) return() n <- length(scales) if (any(is.na(scale_id))) stop() diff --git a/inst/tests/test-empty-data.r b/inst/tests/test-empty-data.r new file mode 100644 index 0000000000..43303b9381 --- /dev/null +++ b/inst/tests/test-empty-data.r @@ -0,0 +1,131 @@ +context('Empty data') + +df0 <- data.frame(mpg=numeric(0), wt=numeric(0), am=numeric(0), cyl=numeric(0)) + +test_that("layers with empty data are silently omitted", { + # Empty data (no visible points) + d <- pdata(ggplot(df0, aes(x=mpg,y=wt)) + geom_point()) + expect_equal(nrow(d[[1]]), 0) + + d <- pdata(ggplot() + geom_point(data=df0, aes(x=mpg,y=wt))) + expect_equal(nrow(d[[1]]), 0) + + + # Regular mtcars data, x=mpg, y=wt, normal points and points from empty data frame + d <- pdata(ggplot(mtcars, aes(x=mpg, y=wt)) + geom_point() + geom_point(data=df0)) + expect_equal(nrow(d[[1]]), nrow(mtcars)) + expect_equal(nrow(d[[2]]), 0) + + # Regular mtcars data, but points only from empty data frame + d <- pdata(ggplot(mtcars, aes(x=mpg, y=wt)) + geom_point(data=df0)) + expect_equal(nrow(d[[1]]), 0) +}) + + +test_that("plots with empty data and vectors for aesthetics work", { + # Empty data with x and y mapped to vector of values + d <- pdata(qplot(1:5, 1:5)) + expect_equal(nrow(d[[1]]), 5) + + d <- pdata(ggplot(mapping=aes(x=1:5, y=1:5)) + geom_point()) + expect_equal(nrow(d[[1]]), 5) + + d <- pdata(ggplot() + geom_point(aes(x=1:5, y=1:5))) + expect_equal(nrow(d[[1]]), 5) +}) + + +test_that("layers with empty data are silently omitted with facets", { + # Empty data, facet_wrap, throws error + expect_error(ggplot_build(ggplot(df0, aes(x=mpg, y=wt)) + geom_point() + facet_wrap(~ cyl))) + + # Empty data, facet_grid, throws error + expect_error(ggplot_build(ggplot(df0, aes(x=x, y=y)) + geom_point() + facet_grid(am ~ cyl))) + + + # points from mtcars points and points from empty data frame, facet_wrap + d <- pdata(ggplot(mtcars, aes(x=mpg, y=wt)) + geom_point() + geom_point(data=df0) + facet_wrap(~ cyl)) + expect_equal(nrow(d[[1]]), nrow(mtcars)) + expect_equal(nrow(d[[2]]), 0) + + # points from mtcars points and points from empty data frame, facet_grid + d <- pdata(ggplot(mtcars, aes(x=mpg, y=wt)) + geom_point() + geom_point(data=df0) + facet_grid(am ~ cyl)) + expect_equal(nrow(d[[1]]), nrow(mtcars)) + expect_equal(nrow(d[[2]]), 0) +}) + + +test_that("data is not inherited when when data=data.frame()", { + # Should error when totally empty data frame because there's no x and y + expect_error(ggplot_build(ggplot(mtcars, aes(x=mpg, y=wt)) + geom_point() + + geom_point(data=data.frame()))) + + + # No extra points when x and y vars exist, but are empty + d <- pdata(ggplot(mtcars, aes(x=mpg, y=wt)) + geom_point() + + geom_point(data = data.frame(mpg=numeric(0), wt=numeric(0)))) + expect_equal(nrow(d[[1]]), nrow(mtcars)) + expect_equal(nrow(d[[2]]), 0) + + # No extra points when x and y vars don't exist but are set + d <- pdata(ggplot(mtcars, aes(x=mpg, y=wt)) + geom_point() + + geom_point(data=data.frame(mpg=numeric(0), wt=numeric(0)), x = 20, y = 3, colour = "red", size = 5)) + expect_equal(nrow(d[[1]]), nrow(mtcars)) + expect_equal(nrow(d[[2]]), 0) + + # No extra points when x and y vars exist, but are empty, even when aesthetics are set + d <- pdata(ggplot(mtcars, aes(x=mpg, y=wt)) + geom_point() + + geom_point(data=data.frame(mpg=numeric(0), wt=numeric(0)), x = 20, y = 3, colour = "red", size = 5)) + expect_equal(nrow(d[[1]]), nrow(mtcars)) + expect_equal(nrow(d[[2]]), 0) +}) + + +test_that("data is inherited when data=NULL", { + # NULL should inherit data + d <- pdata(ggplot(mtcars, aes(x=mpg, y=wt)) + geom_point() + + geom_point(data=NULL)) + expect_equal(nrow(d[[1]]), nrow(mtcars)) + expect_equal(nrow(d[[2]]), nrow(mtcars)) + + # NULL should inherit data when all aesthetics are set + d <- pdata(ggplot(mtcars, aes(x=mpg, y=wt)) + geom_point() + + geom_point(data=NULL, x = 20, y = 3, colour = "red", size = 5)) + expect_equal(nrow(d[[1]]), nrow(mtcars)) + expect_equal(nrow(d[[2]]), nrow(mtcars)) + + + # NULL should inherit data when facet_wrap is used + d <- pdata(ggplot(mtcars, aes(x=mpg, y=wt)) + geom_point() + + geom_point(data=NULL) + + facet_wrap(~ cyl)) + expect_equal(nrow(d[[1]]), nrow(mtcars)) + expect_equal(nrow(d[[2]]), nrow(mtcars)) + + # NULL should inherit data when all aesthetics are set and facet_wrap is used + d <- pdata(ggplot(mtcars, aes(x=mpg, y=wt)) + geom_point() + + geom_point(data=NULL, x = 20, y = 3, colour = "red", size = 5) + + facet_wrap(~ cyl)) + expect_equal(nrow(d[[1]]), nrow(mtcars)) + expect_equal(nrow(d[[2]]), nrow(mtcars)) + expect_equal(sort(d[[1]]$PANEL), sort(d[[2]]$PANEL)) + + + # NULL should inherit data when facet_grid is used + d <- pdata(ggplot(mtcars, aes(x=mpg, y=wt)) + geom_point() + + geom_point(data=NULL) + + facet_grid(am ~ cyl)) + expect_equal(nrow(d[[1]]), nrow(mtcars)) + expect_equal(nrow(d[[2]]), nrow(mtcars)) + + # NULL should inherit data when all aesthetics are set and facet_grid is used + d <- pdata(ggplot(mtcars, aes(x=mpg, y=wt)) + geom_point() + + geom_point(data=NULL, x = 20, y = 3, colour = "red", size = 5) + + facet_grid(am ~ cyl)) + expect_equal(nrow(d[[1]]), nrow(mtcars)) + expect_equal(nrow(d[[2]]), nrow(mtcars)) + expect_equal(sort(d[[1]]$PANEL), sort(d[[2]]$PANEL)) + + # In the future, the behavior of NULL may change, and a test for waiver will + # also be added. +})