From 5abe0c13134f486544b2bb000b533d45bad9620c Mon Sep 17 00:00:00 2001 From: Winston Chang Date: Mon, 16 Apr 2012 16:38:48 -0500 Subject: [PATCH 1/8] Allow empty data frame --- R/facet-null.r | 3 ++- R/fortify.r | 2 +- R/panel.r | 3 ++- 3 files changed, 5 insertions(+), 3 deletions(-) diff --git a/R/facet-null.r b/R/facet-null.r index ffcc720b5f..54b3df8de2 100644 --- a/R/facet-null.r +++ b/R/facet-null.r @@ -20,7 +20,8 @@ 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)) + if (is.waive(data)) return(data.frame(PANEL = 1)) + if (nrow(data) == 0) 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/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() From 989dbfe6ed2cceb139589c5c9a90f8e08340abd3 Mon Sep 17 00:00:00 2001 From: Winston Chang Date: Tue, 17 Apr 2012 16:28:51 -0500 Subject: [PATCH 2/8] Make empty data frames work with facets. Also throw error and print help when all data sources are missing values for faceting variables. --- R/facet-grid-.r | 1 + R/facet-layout.r | 5 +++++ R/facet-wrap.r | 1 + 3 files changed, 7 insertions(+) diff --git a/R/facet-grid-.r b/R/facet-grid-.r index da5d6f5b98..9f1fedea62 100644 --- a/R/facet-grid-.r +++ b/R/facet-grid-.r @@ -190,6 +190,7 @@ facet_train_layout.grid <- function(facet, data) { #' @S3method facet_map_layout grid facet_map_layout.grid <- function(facet, data, layout) { + if (nrow(data) == 0) return(cbind(data, PANEL = integer(0))) locate_grid(data, layout, facet$rows, facet$cols, facet$margins) } 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-wrap.r b/R/facet-wrap.r index da6d7c3c0c..cbc75e728b 100644 --- a/R/facet-wrap.r +++ b/R/facet-wrap.r @@ -88,6 +88,7 @@ facet_train_layout.wrap <- function(facet, data) { #' @S3method facet_map_layout wrap facet_map_layout.wrap <- function(facet, data, layout) { + if (nrow(data) == 0) return(cbind(data, PANEL = integer(0))) locate_wrap(data, layout, facet$facets) } From 946b13607b9079bfc0b14048c82872d88a636299 Mon Sep 17 00:00:00 2001 From: Winston Chang Date: Tue, 17 Apr 2012 17:01:27 -0500 Subject: [PATCH 3/8] Allow empty data frame while passing in vectors for aesthetics --- R/layer.r | 14 +++++++++++++- 1 file changed, 13 insertions(+), 1 deletion(-) diff --git a/R/layer.r b/R/layer.r index e3bea9dace..045a032385 100644 --- a/R/layer.r +++ b/R/layer.r @@ -161,7 +161,19 @@ Layer <- proto(expr = { if (length(evaled) == 0) return(data.frame(PANEL = unique(data$PANEL))) # evaled <- evaled[sapply(evaled, is.atomic)] - data.frame(evaled, PANEL = data$PANEL) + + if (empty(data)) { + if (length(evaled[[1]]) == 0) { + # No data and no vector of values for aesthetics + return(data.frame(PANEL = numeric(0))) + } else { + # No data but with a vector passed to aesthetics, as in qplot(1:3, 1:3) + return(data.frame(evaled, PANEL = 1)) + } + } + else { + return(data.frame(evaled, PANEL = data$PANEL)) + } } From 9b39cf9bd0882156d9c271377ec5f7ebe32052af Mon Sep 17 00:00:00 2001 From: Winston Chang Date: Wed, 18 Apr 2012 12:59:18 -0500 Subject: [PATCH 4/8] Add tests for empty data --- inst/tests/test-empty-data.r | 55 ++++++++++++++++++++++++++++++++++++ 1 file changed, 55 insertions(+) create mode 100644 inst/tests/test-empty-data.r diff --git a/inst/tests/test-empty-data.r b/inst/tests/test-empty-data.r new file mode 100644 index 0000000000..eee27c9a1b --- /dev/null +++ b/inst/tests/test-empty-data.r @@ -0,0 +1,55 @@ +context('Empty data') + +df0 <- data.frame(mpg=numeric(0), wt=numeric(0), am=numeric(0), cyl=numeric(0)) + +test_that("plots with empty data work", { + # 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("plots with empty data and facets work", { + # 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) +}) From 9b37e42391952a730f1a7a03ef8643eea0fcf913 Mon Sep 17 00:00:00 2001 From: Winston Chang Date: Wed, 18 Apr 2012 13:11:43 -0500 Subject: [PATCH 5/8] Clean up for empty data --- R/facet-grid-.r | 1 - R/facet-locate.r | 7 +++++++ R/facet-null.r | 6 ++++-- R/facet-wrap.r | 1 - 4 files changed, 11 insertions(+), 4 deletions(-) diff --git a/R/facet-grid-.r b/R/facet-grid-.r index 9f1fedea62..da5d6f5b98 100644 --- a/R/facet-grid-.r +++ b/R/facet-grid-.r @@ -190,7 +190,6 @@ facet_train_layout.grid <- function(facet, data) { #' @S3method facet_map_layout grid facet_map_layout.grid <- function(facet, data, layout) { - if (nrow(data) == 0) return(cbind(data, PANEL = integer(0))) locate_grid(data, layout, facet$rows, facet$cols, facet$margins) } 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 54b3df8de2..abbdb06f1a 100644 --- a/R/facet-null.r +++ b/R/facet-null.r @@ -20,8 +20,10 @@ facet_train_layout.null <- function(facet, data) { #' @S3method facet_map_layout null facet_map_layout.null <- function(facet, data, layout) { - if (is.waive(data)) return(data.frame(PANEL = 1)) - if (nrow(data) == 0) return(cbind(data, PANEL = integer(0))) + # 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/facet-wrap.r b/R/facet-wrap.r index cbc75e728b..da6d7c3c0c 100644 --- a/R/facet-wrap.r +++ b/R/facet-wrap.r @@ -88,7 +88,6 @@ facet_train_layout.wrap <- function(facet, data) { #' @S3method facet_map_layout wrap facet_map_layout.wrap <- function(facet, data, layout) { - if (nrow(data) == 0) return(cbind(data, PANEL = integer(0))) locate_wrap(data, layout, facet$facets) } From 7290ae07b67e7d200a03eceaae54357a6a1cd14d Mon Sep 17 00:00:00 2001 From: Winston Chang Date: Thu, 19 Apr 2012 13:10:10 -0500 Subject: [PATCH 6/8] Add more tests for empty data --- inst/tests/test-empty-data.r | 74 ++++++++++++++++++++++++++++++++++++ 1 file changed, 74 insertions(+) diff --git a/inst/tests/test-empty-data.r b/inst/tests/test-empty-data.r index eee27c9a1b..eab78ae56c 100644 --- a/inst/tests/test-empty-data.r +++ b/inst/tests/test-empty-data.r @@ -53,3 +53,77 @@ test_that("plots with empty data and facets work", { 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()))) + + # Should error when totally empty data frame, even when aesthetics are set + expect_error(ggplot_build(ggplot(mtcars, aes(x=mpg, y=wt)) + geom_point() + + geom_point(data=data.frame(), x = 20, y = 3, colour = "red", size = 5))) + + + # 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 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. +}) From 1acdd64e756ad52d9073387de5fa8c5eeda042a1 Mon Sep 17 00:00:00 2001 From: Winston Chang Date: Thu, 19 Apr 2012 15:33:16 -0500 Subject: [PATCH 7/8] Fix for set vars --- R/layer.r | 4 ++-- inst/tests/test-empty-data.r | 14 ++++++++------ 2 files changed, 10 insertions(+), 8 deletions(-) diff --git a/R/layer.r b/R/layer.r index 045a032385..47e1b212bb 100644 --- a/R/layer.r +++ b/R/layer.r @@ -159,8 +159,8 @@ 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)] + # If all aesthetics are set + if (length(evaled) == 0) return(data.frame(PANEL = data$PANEL)) if (empty(data)) { if (length(evaled[[1]]) == 0) { diff --git a/inst/tests/test-empty-data.r b/inst/tests/test-empty-data.r index eab78ae56c..43303b9381 100644 --- a/inst/tests/test-empty-data.r +++ b/inst/tests/test-empty-data.r @@ -2,7 +2,7 @@ context('Empty data') df0 <- data.frame(mpg=numeric(0), wt=numeric(0), am=numeric(0), cyl=numeric(0)) -test_that("plots with empty data work", { +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) @@ -35,7 +35,7 @@ test_that("plots with empty data and vectors for aesthetics work", { }) -test_that("plots with empty data and facets work", { +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))) @@ -60,10 +60,6 @@ test_that("data is not inherited when when data=data.frame()", { expect_error(ggplot_build(ggplot(mtcars, aes(x=mpg, y=wt)) + geom_point() + geom_point(data=data.frame()))) - # Should error when totally empty data frame, even when aesthetics are set - expect_error(ggplot_build(ggplot(mtcars, aes(x=mpg, y=wt)) + geom_point() + - geom_point(data=data.frame(), x = 20, y = 3, colour = "red", size = 5))) - # No extra points when x and y vars exist, but are empty d <- pdata(ggplot(mtcars, aes(x=mpg, y=wt)) + geom_point() + @@ -71,6 +67,12 @@ test_that("data is not inherited when when data=data.frame()", { 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)) From 7d2307895d379208c495a27d7148cd9a9d6c683c Mon Sep 17 00:00:00 2001 From: Winston Chang Date: Thu, 19 Apr 2012 15:44:33 -0500 Subject: [PATCH 8/8] Code cleanup for empty data --- R/layer.r | 25 +++++++++++++------------ 1 file changed, 13 insertions(+), 12 deletions(-) diff --git a/R/layer.r b/R/layer.r index 47e1b212bb..67beaa454b 100644 --- a/R/layer.r +++ b/R/layer.r @@ -159,21 +159,22 @@ Layer <- proto(expr = { evaled <- compact( eval.quoted(aesthetics, data, plot$plot_env)) - # If all aesthetics are set - if (length(evaled) == 0) return(data.frame(PANEL = data$PANEL)) + lengths <- vapply(evaled, length, integer(1)) + n <- if (length(lengths) > 0) max(lengths) else 0 - if (empty(data)) { - if (length(evaled[[1]]) == 0) { - # No data and no vector of values for aesthetics - return(data.frame(PANEL = numeric(0))) - } else { - # No data but with a vector passed to aesthetics, as in qplot(1:3, 1:3) - return(data.frame(evaled, PANEL = 1)) - } + 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) } - else { - return(data.frame(evaled, PANEL = data$PANEL)) + + if (empty(data) && n > 0) { + # No data, and vectors suppled to aesthetics + evaled$PANEL <- 1 + } else { + evaled$PANEL <- data$PANEL } + data.frame(evaled) }