Allow empty data frame

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
 }
 

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)

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
 }

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)

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)
   }
 
 

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()

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.
+})