From e97ee3ab1c0624d09aefc12f583813d2aa0939e0 Mon Sep 17 00:00:00 2001 From: Toby Dylan Hocking Date: Fri, 6 Mar 2015 19:59:12 -0500 Subject: [PATCH 01/17] rect test fails --- tests/testthat/test-ggplot-rect.R | 28 ++++++++++++++++++++++++++++ 1 file changed, 28 insertions(+) create mode 100644 tests/testthat/test-ggplot-rect.R diff --git a/tests/testthat/test-ggplot-rect.R b/tests/testthat/test-ggplot-rect.R new file mode 100644 index 0000000000..472ba5f552 --- /dev/null +++ b/tests/testthat/test-ggplot-rect.R @@ -0,0 +1,28 @@ +context("geom_rect") + +expect_traces <- function(gg, n.traces, name){ + stopifnot(is.ggplot(gg)) + stopifnot(is.numeric(n.traces)) + save_outputs(gg, paste0("rects-", name)) + L <- gg2list(gg) + is.trace <- names(L) == "" + all.traces <- L[is.trace] + no.data <- sapply(all.traces, function(tr) { + is.null(tr[["x"]]) && is.null(tr[["y"]]) + }) + has.data <- all.traces[!no.data] + expect_equal(length(has.data), n.traces) + list(traces=has.data, kwargs=L$kwargs) +} + +df <- data.frame( + x = sample(10, 20, replace = TRUE), + y = sample(10, 20, replace = TRUE) +) + +gg <- ggplot(df, aes(xmin = x, xmax = x + 1, ymin = y, ymax = y + 2)) + + geom_rect() + +test_that('geom_rect becomes traces with mode "lines" with fill "tozerox"', { + expect_traces(gg, 1, "black") +}) From 0a208f5bc16343673a03a57d840f5fd0c1be036a Mon Sep 17 00:00:00 2001 From: Toby Dylan Hocking Date: Fri, 6 Mar 2015 20:17:05 -0500 Subject: [PATCH 02/17] test rect fill type mode NA --- tests/testthat/test-ggplot-rect.R | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/tests/testthat/test-ggplot-rect.R b/tests/testthat/test-ggplot-rect.R index 472ba5f552..2a1c23aff1 100644 --- a/tests/testthat/test-ggplot-rect.R +++ b/tests/testthat/test-ggplot-rect.R @@ -15,6 +15,7 @@ expect_traces <- function(gg, n.traces, name){ list(traces=has.data, kwargs=L$kwargs) } +set.seed(1) df <- data.frame( x = sample(10, 20, replace = TRUE), y = sample(10, 20, replace = TRUE) @@ -24,5 +25,12 @@ gg <- ggplot(df, aes(xmin = x, xmax = x + 1, ymin = y, ymax = y + 2)) + geom_rect() test_that('geom_rect becomes traces with mode "lines" with fill "tozerox"', { - expect_traces(gg, 1, "black") + info <- expect_traces(gg, 1, "black") + tr <- info$traces[[1]] + expect_identical(tr$fill, "tozerox") + expect_identical(tr$type, "scatter") + expect_identical(tr$mode, "lines") + for(xy in c("x", "y")){ + expect_true(any(is.na(tr[[xy]]))) + } }) From 214c3769113f894ff74b40088230752f5a287342 Mon Sep 17 00:00:00 2001 From: Toby Dylan Hocking Date: Fri, 6 Mar 2015 20:17:20 -0500 Subject: [PATCH 03/17] treat rect as polygon --- R/trace_generation.R | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/R/trace_generation.R b/R/trace_generation.R index dc8a62d741..1fa87be3d8 100644 --- a/R/trace_generation.R +++ b/R/trace_generation.R @@ -281,6 +281,18 @@ toBasic <- list( }) group2NA(g, "path") }, + rect=function(g){ + g$data$group <- 1:nrow(g$data) + used <- c("xmin", "ymin", "xmax", "ymax") + others <- g$data[!names(g$data) %in% used] + g$data <- with(g$data, { + rbind(cbind(x=xmin, y=ymin, others), + cbind(x=xmin, y=ymax, others), + cbind(x=xmax, y=ymax, others), + cbind(x=xmax, y=ymin, others)) + }) + group2NA(g, "polygon") + }, polygon=function(g){ if(is.null(g$params$fill)){ g From b0878ae4fa67806900ec8770d6f524a900ac7895 Mon Sep 17 00:00:00 2001 From: Toby Dylan Hocking Date: Tue, 10 Mar 2015 17:51:03 -0400 Subject: [PATCH 04/17] rect tests fail --- tests/testthat/test-ggplot-rect.R | 63 ++++++++++++++++++++++++++++++- 1 file changed, 62 insertions(+), 1 deletion(-) diff --git a/tests/testthat/test-ggplot-rect.R b/tests/testthat/test-ggplot-rect.R index 2a1c23aff1..0268cebe12 100644 --- a/tests/testthat/test-ggplot-rect.R +++ b/tests/testthat/test-ggplot-rect.R @@ -24,7 +24,7 @@ df <- data.frame( gg <- ggplot(df, aes(xmin = x, xmax = x + 1, ymin = y, ymax = y + 2)) + geom_rect() -test_that('geom_rect becomes traces with mode "lines" with fill "tozerox"', { +test_that('geom_rect becomes 1 trace with mode="lines" fill="tozerox"', { info <- expect_traces(gg, 1, "black") tr <- info$traces[[1]] expect_identical(tr$fill, "tozerox") @@ -34,3 +34,64 @@ test_that('geom_rect becomes traces with mode "lines" with fill "tozerox"', { expect_true(any(is.na(tr[[xy]]))) } }) + +df4 <- data.frame(x=1:4, status=c("cool", "not", "not", "cool")) + +gg4 <- ggplot(df4, aes(xmin = x, xmax = x + 0.5, ymin = 0, ymax = 1)) + + geom_rect() + +test_that('trace contains NA back to 1st rect', { + info <- expect_traces(gg4, 1, "black4") + tr <- info$traces[[1]] + expect_identical(tr$fill, "tozerox") + expect_identical(tr$type, "scatter") + expect_identical(tr$mode, "lines") + expected.x <- c(1, 1, 1.5, 1.5, 1, NA, + 2, 2, 2.5, 2.5, 2, NA, + 3, 3, 3.5, 3.5, 3, NA, + 4, 4, 4.5, 4.5, 4, NA, + 3, NA, + 2, NA, + 1, 1) + expect_equal(tr$x, expected.x) + expected.y <- c(0, 1, 1, 0, NA, + 0, 1, 1, 0, NA, + 0, 1, 1, 0, NA, + 0, 1, 1, 0, NA, + 0, NA, + 0, NA, + 0, 0) + expect_equal(tr$y, expected.y) + + ## This is how it may be implemented, but we do not include it in + ## the test: + forward.x <- as.numeric(with(df, rbind(x, x, x+0.5, x+0.5, x, NA))) + backward.x <- as.numeric(rbind(rev(df$x)[-1], NA)) + nb <- length(backward.x) - 1 + backward.x[c(1:nb, nb)] + backward.x <- c(3, NA, 2, NA, 1, 1) + full.x <- c(forward.x, backward.x) +}) + +rect.color <- ggplot(df4, aes(xmin = x, xmax = x + 0.5, ymin = 0, ymax = 1)) + + geom_rect(aes(color=status)) + +test_that('rect color', { + info <- expect_traces(rect.color, 2, "rect-color") + ## TODO: test for weird forward/backward NA pattern with 2 rects. +}) + +rect.fill <- ggplot(df4, aes(xmin = x, xmax = x + 0.5, ymin = 0, ymax = 1)) + + geom_rect(aes(fill=status)) + +test_that('rect color', { + info <- expect_traces(rect.fill, 2, "rect-fill") +}) + +rect.fill.color <- + ggplot(df4, aes(xmin = x, xmax = x + 0.5, ymin = 0, ymax = 1)) + + geom_rect(aes(fill=status), color="black") + +test_that('rect aes(fill) with constant color', { + info <- expect_traces(rect.fill.color, 2, "rect-fill-color") +}) From a16b6af196d23683ac6f515637f932a1a2836c8a Mon Sep 17 00:00:00 2001 From: Toby Dylan Hocking Date: Fri, 13 Mar 2015 18:07:10 -0400 Subject: [PATCH 05/17] fix y test --- tests/testthat/test-ggplot-rect.R | 17 ++++------------- 1 file changed, 4 insertions(+), 13 deletions(-) diff --git a/tests/testthat/test-ggplot-rect.R b/tests/testthat/test-ggplot-rect.R index 0268cebe12..8d668e0922 100644 --- a/tests/testthat/test-ggplot-rect.R +++ b/tests/testthat/test-ggplot-rect.R @@ -54,23 +54,14 @@ test_that('trace contains NA back to 1st rect', { 2, NA, 1, 1) expect_equal(tr$x, expected.x) - expected.y <- c(0, 1, 1, 0, NA, - 0, 1, 1, 0, NA, - 0, 1, 1, 0, NA, - 0, 1, 1, 0, NA, + expected.y <- c(0, 1, 1, 0, 0, NA, + 0, 1, 1, 0, 0, NA, + 0, 1, 1, 0, 0, NA, + 0, 1, 1, 0, 0, NA, 0, NA, 0, NA, 0, 0) expect_equal(tr$y, expected.y) - - ## This is how it may be implemented, but we do not include it in - ## the test: - forward.x <- as.numeric(with(df, rbind(x, x, x+0.5, x+0.5, x, NA))) - backward.x <- as.numeric(rbind(rev(df$x)[-1], NA)) - nb <- length(backward.x) - 1 - backward.x[c(1:nb, nb)] - backward.x <- c(3, NA, 2, NA, 1, 1) - full.x <- c(forward.x, backward.x) }) rect.color <- ggplot(df4, aes(xmin = x, xmax = x + 0.5, ymin = 0, ymax = 1)) + From 7b39c3e9cffa1e1f8554816a1eb1bf3eb65580f5 Mon Sep 17 00:00:00 2001 From: Toby Dylan Hocking Date: Fri, 13 Mar 2015 18:07:47 -0400 Subject: [PATCH 06/17] special case for polygons and rects inside of group2NA --- R/trace_generation.R | 29 ++++++++++++++++++++++------- 1 file changed, 22 insertions(+), 7 deletions(-) diff --git a/R/trace_generation.R b/R/trace_generation.R index 1fa87be3d8..7414755bd2 100644 --- a/R/trace_generation.R +++ b/R/trace_generation.R @@ -371,7 +371,6 @@ toBasic <- list( } ) - #' Drawing ggplot2 geoms with a group aesthetic is most efficient in #' plotly when we convert groups of things that look the same to #' vectors with NA. @@ -383,14 +382,30 @@ toBasic <- list( group2NA <- function(g, geom) { poly.list <- split(g$data, g$data$group) is.group <- names(g$data) == "group" - poly.na.df <- data.frame() - for (i in seq_along(poly.list)) { + poly.na.list <- list() + forward.i <- seq_along(poly.list) + for (i in forward.i) { no.group <- poly.list[[i]][, !is.group, drop=FALSE] na.row <- no.group[1, ] na.row[, c("x", "y")] <- NA - poly.na.df <- rbind(poly.na.df, no.group, na.row) + retrace.first <- if(g$geom %in% c("polygon", "rect")){ + no.group[1,] + } + poly.na.list[[paste(i, "forward")]] <- + rbind(no.group, retrace.first, na.row) + } + if(g$geom %in% c("polygon", "rect")){ + backward.i <- rev(forward.i[-1])[-1] + for(i in backward.i){ + no.group <- poly.list[[i]][1, !is.group, drop=FALSE] + na.row <- no.group[1, ] + na.row[, c("x", "y")] <- NA + poly.na.list[[paste(i, "backward")]] <- rbind(no.group, na.row) + } + first.group <- poly.list[[1]][1, !is.group, drop=FALSE] + poly.na.list[["last"]] <- rbind(first.group, first.group) } - g$data <- poly.na.df + g$data <- do.call(rbind, poly.na.list) g$geom <- geom g } @@ -437,8 +452,8 @@ geom2trace <- list( line=paramORdefault(params, aes2line, line.defaults)) }, polygon=function(data, params){ - list(x=c(data$x, data$x[1]), - y=c(data$y, data$y[1]), + list(x=data$x, + y=data$y, name=params$name, text=data$text, type="scatter", From 787596fc0f36ddf3b2ecd2bb0a390565df0f0f3e Mon Sep 17 00:00:00 2001 From: Toby Dylan Hocking Date: Fri, 13 Mar 2015 19:11:37 -0400 Subject: [PATCH 07/17] refactor polygon tests --- tests/testthat/test-ggplot-polygons.R | 199 +++++++++++++++----------- 1 file changed, 117 insertions(+), 82 deletions(-) diff --git a/tests/testthat/test-ggplot-polygons.R b/tests/testthat/test-ggplot-polygons.R index 5f93251550..24dab2b779 100644 --- a/tests/testthat/test-ggplot-polygons.R +++ b/tests/testthat/test-ggplot-polygons.R @@ -1,101 +1,136 @@ context("polygon") -test_that("filled polygons become several traces", { - poly.df <- data.frame(x=c(0, 1, 1, 0, 2, 3, 3, 2)+10, - y=c(0, 0, 1, 1, 0, 0, 1, 1)+10, - g=c(1, 1, 1, 1, 2, 2, 2, 2)) - poly.df$lab <- paste0("name", poly.df$g) +expect_traces <- function(gg, n.traces, name){ + stopifnot(is.ggplot(gg)) + stopifnot(is.numeric(n.traces)) + save_outputs(gg, paste0("polygon-", name)) + L <- gg2list(gg) + is.trace <- names(L) == "" + all.traces <- L[is.trace] + no.data <- sapply(all.traces, function(tr) { + is.null(tr[["x"]]) && is.null(tr[["y"]]) + }) + has.data <- all.traces[!no.data] + expect_equal(length(has.data), n.traces) + list(traces=has.data, kwargs=L$kwargs) +} + +poly.df <- data.frame(x=c(0, 1, 1, 0, 2, 3, 3, 2)+10, + y=c(0, 0, 1, 1, 0, 0, 1, 1), + g=c(1, 1, 1, 1, 2, 2, 2, 2), + lab=rep(c("left", "right"), each=4)) + +test_that("polygons filled with the same color become one trace", { gg <- ggplot(poly.df)+ geom_polygon(aes(x, y, group=g)) - info <- gg2list(gg) - expect_equal(length(info), 3) - expect_equal(info[[1]]$x, c(10, 11, 11, 10, 10)) - expect_equal(info[[1]]$y, c(10, 10, 11, 11, 10)) - expect_equal(info[[2]]$x, c(12, 13, 13, 12, 12)) - expect_equal(info[[2]]$y, c(10, 10, 11, 11, 10)) - expect_identical(info[[1]]$line$color, "transparent") - expect_identical(info[[2]]$line$color, "transparent") - - save_outputs(gg, "polygons-filled-polygons") + info <- expect_traces(gg, 1, "black") + tr <- info$traces[[1]] + expected.x <- + c(10, 11, 11, 10, 10, NA, + 12, 13, 13, 12, 12, NA, + 10, 10) + expect_equal(tr$x, expected.x) + expected.y <- + c(0, 0, 1, 1, 0, NA, + 0, 0, 1, 1, 0, NA, + 0, 0) + expect_equal(tr$y, expected.y) + expect_identical(tr$line$color, "transparent") + expect_identical(tr$line$color, "transparent") +}) + +blue.color <- rgb(0.23, 0.45, 0.67) - first.color <- rgb(0.23, 0.45, 0.67) +test_that("polygons with different color become separate traces", { gg <- ggplot(poly.df)+ geom_polygon(aes(x, y, color=lab), fill="grey")+ - scale_color_manual(values=c(name1=first.color, name2="springgreen3")) - info <- gg2list(gg) - expect_equal(length(info), 3) - expect_equal(info[[1]]$x, c(10, 11, 11, 10, 10)) - expect_equal(info[[1]]$y, c(10, 10, 11, 11, 10)) - expect_equal(info[[1]]$fillcolor, toRGB("grey")) - expect_equal(info[[1]]$line$color, toRGB(first.color)) - expect_equal(info[[1]]$name, "name1") - expect_equal(info[[2]]$x, c(12, 13, 13, 12, 12)) - expect_equal(info[[2]]$y, c(10, 10, 11, 11, 10)) - expect_equal(info[[2]]$fillcolor, toRGB("grey")) - expect_equal(info[[2]]$line$color, toRGB("springgreen3")) - expect_equal(info[[2]]$name, "name2") - - save_outputs(gg, "polygons-springgreen3") - + scale_color_manual(values=c(left=blue.color, right="springgreen3")) + info <- expect_traces(gg, 2, "aes-color") + traces.by.name <- list() + for(tr in info$traces){ + expect_equal(tr$fillcolor, toRGB("grey")) + traces.by.name[[tr$name]] <- tr + } + expect_equal(traces.by.name$left$x, c(10, 11, 11, 10, 10)) + expect_equal(traces.by.name$left$y, c(0, 0, 1, 1, 0)) + expect_equal(traces.by.name$right$x, c(12, 13, 13, 12, 12)) + expect_equal(traces.by.name$right$y, c(0, 0, 1, 1, 0)) + expect_equal(traces.by.name$left$line$color, toRGB(blue.color)) + expect_equal(traces.by.name$right$line$color, toRGB("springgreen3")) +}) - first.color <- rgb(0.23, 0.45, 0.67) +test_that("geom_polygon(aes(fill)) -> fillcolor + line$color transparent", { gg <- ggplot(poly.df)+ geom_polygon(aes(x, y, fill=lab))+ - scale_fill_manual(values=c(name1=first.color, name2="springgreen3")) - info <- gg2list(gg) - expect_equal(length(info), 3) - expect_equal(info[[1]]$x, c(10, 11, 11, 10, 10)) - expect_equal(info[[1]]$y, c(10, 10, 11, 11, 10)) - expect_equal(info[[1]]$fillcolor, toRGB(first.color)) - expect_equal(info[[1]]$name, "name1") - expect_equal(info[[2]]$x, c(12, 13, 13, 12, 12)) - expect_equal(info[[2]]$y, c(10, 10, 11, 11, 10)) - expect_equal(info[[2]]$fillcolor, toRGB("springgreen3")) - expect_equal(info[[2]]$name, "name2") - - save_outputs(gg, "polygons-springgreen3-lab") + scale_fill_manual(values=c(left=first.color, right="springgreen3")) + info <- expect_traces(gg, 2, "aes-fill") + traces.by.name <- list() + for(tr in info$traces){ + expect_equal(tr$line$color, "transparent") + traces.by.name[[tr$name]] <- tr + } + expect_equal(traces.by.name$left$x, c(10, 11, 11, 10, 10)) + expect_equal(traces.by.name$left$y, c(0, 0, 1, 1, 0)) + expect_equal(traces.by.name$right$x, c(12, 13, 13, 12, 12)) + expect_equal(traces.by.name$right$y, c(0, 0, 1, 1, 0)) + expect_equal(traces.by.name$left$fillcolor, toRGB(blue.color)) + expect_equal(traces.by.name$right$fillcolor, toRGB("springgreen3")) +}) +test_that("geom_polygon(aes(fill), color) -> line$color", { + gg <- ggplot(poly.df)+ + geom_polygon(aes(x, y, fill=lab), color="black")+ + scale_fill_manual(values=c(left=first.color, right="springgreen3")) + info <- expect_traces(gg, 2, "color-aes-fill") + traces.by.name <- list() + for(tr in info$traces){ + expect_equal(tr$line$color, toRGB("black")) + traces.by.name[[tr$name]] <- tr + } + expect_equal(traces.by.name$left$x, c(10, 11, 11, 10, 10)) + expect_equal(traces.by.name$left$y, c(0, 0, 1, 1, 0)) + expect_equal(traces.by.name$right$x, c(12, 13, 13, 12, 12)) + expect_equal(traces.by.name$right$y, c(0, 0, 1, 1, 0)) + expect_equal(traces.by.name$left$fillcolor, toRGB(blue.color)) + expect_equal(traces.by.name$right$fillcolor, toRGB("springgreen3")) +}) +test_that("geom_polygon(aes(linetype), fill, color)", { gg <- ggplot(poly.df)+ geom_polygon(aes(x, y, linetype=lab), fill="red", colour="blue")+ - scale_linetype_manual(values=c(name1="dotted", name2="dashed")) - info <- gg2list(gg) - expect_equal(length(info), 3) - expect_equal(info[[1]]$x, c(10, 11, 11, 10, 10)) - expect_equal(info[[1]]$y, c(10, 10, 11, 11, 10)) - expect_equal(info[[1]]$fillcolor, toRGB("red")) - expect_equal(info[[1]]$line$color, toRGB("blue")) - expect_equal(info[[1]]$line$dash, "dot") - expect_equal(info[[1]]$name, "name1") - expect_equal(info[[2]]$x, c(12, 13, 13, 12, 12)) - expect_equal(info[[2]]$y, c(10, 10, 11, 11, 10)) - expect_equal(info[[2]]$fillcolor, toRGB("red")) - expect_equal(info[[2]]$line$color, toRGB("blue")) - expect_equal(info[[2]]$line$dash, "dash") - expect_equal(info[[2]]$name, "name2") - - save_outputs(gg, "polygons-dashed") - + scale_linetype_manual(values=c(left="dotted", right="dashed")) + info <- expect_traces(gg, 2, "color-fill-aes-linetype") + traces.by.name <- list() + for(tr in info$traces){ + expect_equal(tr$fillcolor, toRGB("red")) + expect_equal(tr$line$color, toRGB("blue")) + traces.by.name[[tr$name]] <- tr + } + expect_equal(traces.by.name$left$x, c(10, 11, 11, 10, 10)) + expect_equal(traces.by.name$left$y, c(0, 0, 1, 1, 0)) + expect_equal(traces.by.name$left$line$dash, "dot") + expect_equal(traces.by.name$right$x, c(12, 13, 13, 12, 12)) + expect_equal(traces.by.name$right$y, c(0, 0, 1, 1, 0)) + expect_equal(traces.by.name$right$line$dash, "dash") +}) +test_that("geom_polygon(aes(size), fill, colour)", { gg <- ggplot(poly.df)+ geom_polygon(aes(x, y, size=lab), fill="orange", colour="black")+ - scale_size_manual(values=c(name1=2, name2=3)) - info <- gg2list(gg) - expect_equal(length(info), 3) - expect_equal(info[[1]]$x, c(10, 11, 11, 10, 10)) - expect_equal(info[[1]]$y, c(10, 10, 11, 11, 10)) - expect_equal(info[[1]]$fillcolor, toRGB("orange")) - expect_equal(info[[1]]$line$width, 4) - expect_equal(info[[1]]$name, "name1") - expect_equal(info[[2]]$x, c(12, 13, 13, 12, 12)) - expect_equal(info[[2]]$y, c(10, 10, 11, 11, 10)) - expect_equal(info[[2]]$fillcolor, toRGB("orange")) - expect_equal(info[[2]]$line$width, 6) - expect_equal(info[[2]]$name, "name2") - - - save_outputs(gg, "polygons-halloween") - + scale_size_manual(values=c(left=2, right=3)) + info <- expect_traces(gg, 2, "color-fill-aes-linetype") + traces.by.name <- list() + for(tr in info$traces){ + expect_equal(tr$fillcolor, toRGB("orange")) + expect_equal(tr$line$color, toRGB("black")) + traces.by.name[[tr$name]] <- tr + } + expect_equal(traces.by.name$left$x, c(10, 11, 11, 10, 10)) + expect_equal(traces.by.name$left$y, c(0, 0, 1, 1, 0)) + expect_equal(traces.by.name$right$x, c(12, 13, 13, 12, 12)) + expect_equal(traces.by.name$right$y, c(0, 0, 1, 1, 0)) + expect_false(traces.by.name$left$line$width == + traces.by.name$right$line$width) }) test_that("borders become one trace with NA", { @@ -108,5 +143,5 @@ test_that("borders become one trace with NA", { tr <- info[[1]] expect_true(any(is.na(tr$x))) - save_outputs(gg, "polygons-borders") + save_outputs(gg, "polygons-canada-borders") }) From 426d89bf716d8ba8951d38ea0e881402daca45fb Mon Sep 17 00:00:00 2001 From: Toby Dylan Hocking Date: Fri, 13 Mar 2015 19:12:29 -0400 Subject: [PATCH 08/17] first.color -> blue.color --- tests/testthat/test-ggplot-polygons.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/testthat/test-ggplot-polygons.R b/tests/testthat/test-ggplot-polygons.R index 24dab2b779..600873ae6d 100644 --- a/tests/testthat/test-ggplot-polygons.R +++ b/tests/testthat/test-ggplot-polygons.R @@ -62,7 +62,7 @@ test_that("polygons with different color become separate traces", { test_that("geom_polygon(aes(fill)) -> fillcolor + line$color transparent", { gg <- ggplot(poly.df)+ geom_polygon(aes(x, y, fill=lab))+ - scale_fill_manual(values=c(left=first.color, right="springgreen3")) + scale_fill_manual(values=c(left=blue.color, right="springgreen3")) info <- expect_traces(gg, 2, "aes-fill") traces.by.name <- list() for(tr in info$traces){ @@ -80,7 +80,7 @@ test_that("geom_polygon(aes(fill)) -> fillcolor + line$color transparent", { test_that("geom_polygon(aes(fill), color) -> line$color", { gg <- ggplot(poly.df)+ geom_polygon(aes(x, y, fill=lab), color="black")+ - scale_fill_manual(values=c(left=first.color, right="springgreen3")) + scale_fill_manual(values=c(left=blue.color, right="springgreen3")) info <- expect_traces(gg, 2, "color-aes-fill") traces.by.name <- list() for(tr in info$traces){ From 52827b6c4d81825119c1571147adea474b43d191 Mon Sep 17 00:00:00 2001 From: Toby Dylan Hocking Date: Fri, 13 Mar 2015 19:13:54 -0400 Subject: [PATCH 09/17] treat rects as basic polygons, process polygons using group2NA --- R/ggplotly.R | 6 +++++- R/trace_generation.R | 31 +++++++++++++++---------------- 2 files changed, 20 insertions(+), 17 deletions(-) diff --git a/R/ggplotly.R b/R/ggplotly.R index ba6acaef07..7bf369a998 100644 --- a/R/ggplotly.R +++ b/R/ggplotly.R @@ -47,7 +47,11 @@ markLegends <- # list(point=c("colour", "fill", "shape", "size"), list(point=c("colour", "fill", "shape"), path=c("linetype", "size", "colour", "shape"), - polygon=c("colour", "fill", "linetype", "size", "group"), + ## NOTE: typically "group" should not be present here, since + ## that would mean creating a separate plotly legend for each + ## group, even when they have the exact same visual + ## characteristics and could be drawn using just 1 trace! + polygon=c("colour", "fill", "linetype", "size"), bar=c("colour", "fill"), errorbar=c("colour", "linetype"), errorbarh=c("colour", "linetype"), diff --git a/R/trace_generation.R b/R/trace_generation.R index 7414755bd2..16c01bceff 100644 --- a/R/trace_generation.R +++ b/R/trace_generation.R @@ -291,16 +291,8 @@ toBasic <- list( cbind(x=xmax, y=ymax, others), cbind(x=xmax, y=ymin, others)) }) - group2NA(g, "polygon") - }, - polygon=function(g){ - if(is.null(g$params$fill)){ - g - }else if(is.na(g$params$fill)){ - group2NA(g, "path") - }else{ - g - } + g$geom <- "polygon" + g }, path=function(g) { group2NA(g, "path") @@ -380,7 +372,7 @@ toBasic <- list( #' @return list of geom info. #' @author Toby Dylan Hocking group2NA <- function(g, geom) { - poly.list <- split(g$data, g$data$group) + poly.list <- split(g$data, g$data$group, drop=TRUE) is.group <- names(g$data) == "group" poly.na.list <- list() forward.i <- seq_along(poly.list) @@ -402,10 +394,15 @@ group2NA <- function(g, geom) { na.row[, c("x", "y")] <- NA poly.na.list[[paste(i, "backward")]] <- rbind(no.group, na.row) } - first.group <- poly.list[[1]][1, !is.group, drop=FALSE] - poly.na.list[["last"]] <- rbind(first.group, first.group) + if(length(poly.list) > 1){ + first.group <- poly.list[[1]][1, !is.group, drop=FALSE] + poly.na.list[["last"]] <- rbind(first.group, first.group) + } } g$data <- do.call(rbind, poly.na.list) + if(is.na(g$data$x[nrow(g$data)])){ + g$data <- g$data[-nrow(g$data), ] + } g$geom <- geom g } @@ -452,10 +449,12 @@ geom2trace <- list( line=paramORdefault(params, aes2line, line.defaults)) }, polygon=function(data, params){ - list(x=data$x, - y=data$y, + g <- list(data=data, geom="polygon") + g <- group2NA(g, "polygon") + list(x=g$data$x, + y=g$data$y, name=params$name, - text=data$text, + text=g$data$text, type="scatter", mode="lines", line=paramORdefault(params, aes2line, polygon.line.defaults), From e977416b58ba636781be308b1f5a5ffa3cda508d Mon Sep 17 00:00:00 2001 From: Toby Dylan Hocking Date: Mon, 16 Mar 2015 17:07:21 -0400 Subject: [PATCH 10/17] more rect tests --- tests/testthat/test-ggplot-rect.R | 60 +++++++++++++++++++++++++++++-- 1 file changed, 58 insertions(+), 2 deletions(-) diff --git a/tests/testthat/test-ggplot-rect.R b/tests/testthat/test-ggplot-rect.R index 8d668e0922..af33a02db8 100644 --- a/tests/testthat/test-ggplot-rect.R +++ b/tests/testthat/test-ggplot-rect.R @@ -65,11 +65,29 @@ test_that('trace contains NA back to 1st rect', { }) rect.color <- ggplot(df4, aes(xmin = x, xmax = x + 0.5, ymin = 0, ymax = 1)) + - geom_rect(aes(color=status)) + geom_rect(aes(color=status), fill="grey") test_that('rect color', { info <- expect_traces(rect.color, 2, "rect-color") - ## TODO: test for weird forward/backward NA pattern with 2 rects. + traces.by.name <- list() + for(tr in info$traces){ + expect_equal(tr$fillcolor, toRGB("grey")) + expect_equal(tr$y, + c(0, 1, 1, 0, 0, NA, + 0, 1, 1, 0, 0, NA, + 0, 0)) + traces.by.name[[tr$name]] <- tr + } + expect_equal(traces.by.name$cool$x, + c(1, 1, 1.5, 1.5, 1, NA, + 4, 4, 4.5, 4.5, 4, NA, + 1, 1)) + expect_equal(traces.by.name$not$x, + c(2, 2, 2.5, 2.5, 2, NA, + 3, 3, 3.5, 3.5, 3, NA, + 2, 2)) + expect_false(traces.by.name$not$line$color == + traces.by.name$cool$line$color) }) rect.fill <- ggplot(df4, aes(xmin = x, xmax = x + 0.5, ymin = 0, ymax = 1)) + @@ -77,6 +95,25 @@ rect.fill <- ggplot(df4, aes(xmin = x, xmax = x + 0.5, ymin = 0, ymax = 1)) + test_that('rect color', { info <- expect_traces(rect.fill, 2, "rect-fill") + traces.by.name <- list() + for(tr in info$traces){ + expect_equal(tr$line$color, "transparent") + expect_equal(tr$y, + c(0, 1, 1, 0, 0, NA, + 0, 1, 1, 0, 0, NA, + 0, 0)) + traces.by.name[[tr$name]] <- tr + } + expect_equal(traces.by.name$cool$x, + c(1, 1, 1.5, 1.5, 1, NA, + 4, 4, 4.5, 4.5, 4, NA, + 1, 1)) + expect_equal(traces.by.name$not$x, + c(2, 2, 2.5, 2.5, 2, NA, + 3, 3, 3.5, 3.5, 3, NA, + 2, 2)) + expect_false(traces.by.name$not$fillcolor == + traces.by.name$cool$fillcolor) }) rect.fill.color <- @@ -85,4 +122,23 @@ rect.fill.color <- test_that('rect aes(fill) with constant color', { info <- expect_traces(rect.fill.color, 2, "rect-fill-color") + traces.by.name <- list() + for(tr in info$traces){ + expect_equal(tr$line$color, toRGB("black")) + expect_equal(tr$y, + c(0, 1, 1, 0, 0, NA, + 0, 1, 1, 0, 0, NA, + 0, 0)) + traces.by.name[[tr$name]] <- tr + } + expect_equal(traces.by.name$cool$x, + c(1, 1, 1.5, 1.5, 1, NA, + 4, 4, 4.5, 4.5, 4, NA, + 1, 1)) + expect_equal(traces.by.name$not$x, + c(2, 2, 2.5, 2.5, 2, NA, + 3, 3, 3.5, 3.5, 3, NA, + 2, 2)) + expect_false(traces.by.name$not$fillcolor == + traces.by.name$cool$fillcolor) }) From 80b1312608c6b7a9cca8ade8255bede867e454f1 Mon Sep 17 00:00:00 2001 From: Toby Dylan Hocking Date: Mon, 16 Mar 2015 17:24:19 -0400 Subject: [PATCH 11/17] more polygon tests --- tests/testthat/test-ggplot-polygons.R | 62 +++++++++++++++++++++++++++ 1 file changed, 62 insertions(+) diff --git a/tests/testthat/test-ggplot-polygons.R b/tests/testthat/test-ggplot-polygons.R index 600873ae6d..097d9588ee 100644 --- a/tests/testthat/test-ggplot-polygons.R +++ b/tests/testthat/test-ggplot-polygons.R @@ -30,6 +30,7 @@ test_that("polygons filled with the same color become one trace", { 12, 13, 13, 12, 12, NA, 10, 10) expect_equal(tr$x, expected.x) + expect_equal(tr$fill, "tozerox") expected.y <- c(0, 0, 1, 1, 0, NA, 0, 0, 1, 1, 0, NA, @@ -49,6 +50,7 @@ test_that("polygons with different color become separate traces", { traces.by.name <- list() for(tr in info$traces){ expect_equal(tr$fillcolor, toRGB("grey")) + expect_equal(tr$fill, "tozerox") traces.by.name[[tr$name]] <- tr } expect_equal(traces.by.name$left$x, c(10, 11, 11, 10, 10)) @@ -85,6 +87,7 @@ test_that("geom_polygon(aes(fill), color) -> line$color", { traces.by.name <- list() for(tr in info$traces){ expect_equal(tr$line$color, toRGB("black")) + expect_equal(tr$fill, "tozerox") traces.by.name[[tr$name]] <- tr } expect_equal(traces.by.name$left$x, c(10, 11, 11, 10, 10)) @@ -104,6 +107,7 @@ test_that("geom_polygon(aes(linetype), fill, color)", { for(tr in info$traces){ expect_equal(tr$fillcolor, toRGB("red")) expect_equal(tr$line$color, toRGB("blue")) + expect_equal(tr$fill, "tozerox") traces.by.name[[tr$name]] <- tr } expect_equal(traces.by.name$left$x, c(10, 11, 11, 10, 10)) @@ -123,6 +127,7 @@ test_that("geom_polygon(aes(size), fill, colour)", { for(tr in info$traces){ expect_equal(tr$fillcolor, toRGB("orange")) expect_equal(tr$line$color, toRGB("black")) + expect_equal(tr$fill, "tozerox") traces.by.name[[tr$name]] <- tr } expect_equal(traces.by.name$left$x, c(10, 11, 11, 10, 10)) @@ -145,3 +150,60 @@ test_that("borders become one trace with NA", { save_outputs(gg, "polygons-canada-borders") }) + +x <- c(0, -1, 2, -2, 1) +y <- c(2, 0, 1, 1, 0) +stars <- + rbind(data.frame(x, y, group="left"), + data.frame(x=x+10, y, group="right")) +star.group <- ggplot(stars)+ + geom_polygon(aes(x, y, group=group)) + +test_that("geom_polygon(aes(group)) -> 1 trace", { + info <- expect_traces(star.group, 1, "star-group") + tr <- info$traces[[1]] + expect_equal(tr$fill, "tozerox") + expect_equal(tr$x, + c(0, -1, 2, -2, 1, 0, NA, + 10, 9, 12, 8, 11, 10, NA, + 0, 0)) + expect_equal(tr$y, + c(2, 0, 1, 1, 0, 2, NA, + 2, 0, 1, 1, 0, 2, NA, + 2, 2)) +}) + +star.group.color <- ggplot(stars)+ + geom_polygon(aes(x, y, group=group), color="red") + +test_that("geom_polygon(aes(group), color) -> 1 trace", { + info <- expect_traces(star.group.color, 1, "star-group-color") + tr <- info$traces[[1]] + expect_equal(tr$fill, "tozerox") + expect_equal(tr$line$color, toRGB("red")) + expect_equal(tr$x, + c(0, -1, 2, -2, 1, 0, NA, + 10, 9, 12, 8, 11, 10, NA, + 0, 0)) + expect_equal(tr$y, + c(2, 0, 1, 1, 0, 2, NA, + 2, 0, 1, 1, 0, 2, NA, + 2, 2)) +}) + +star.fill.color <- ggplot(stars)+ + geom_polygon(aes(x, y, group=group, fill=group), color="black") + +test_that("geom_polygon(aes(group, fill), color) -> 2 trace", { + info <- expect_traces(star.fill.color, 2, "star-fill-color") + tr <- info$traces[[1]] + traces.by.name <- list() + for(tr in info$traces){ + expect_equal(tr$line$color, toRGB("black")) + expect_equal(tr$fill, "tozerox") + expect_equal(tr$y, c(2, 0, 1, 1, 0, 2)) + traces.by.name[[tr$name]] <- tr + } + expect_equal(traces.by.name$left$x, c(0, -1, 2, -2, 1, 0)) + expect_equal(traces.by.name$right$x, c(10, 9, 12, 8, 11, 10)) +}) From 8b03e902806699a74bf956f4f2a7351f3102c43c Mon Sep 17 00:00:00 2001 From: Toby Dylan Hocking Date: Mon, 16 Mar 2015 17:25:26 -0400 Subject: [PATCH 12/17] test fill=tozerox --- tests/testthat/test-ggplot-rect.R | 3 +++ 1 file changed, 3 insertions(+) diff --git a/tests/testthat/test-ggplot-rect.R b/tests/testthat/test-ggplot-rect.R index af33a02db8..5ed31cbbbd 100644 --- a/tests/testthat/test-ggplot-rect.R +++ b/tests/testthat/test-ggplot-rect.R @@ -72,6 +72,7 @@ test_that('rect color', { traces.by.name <- list() for(tr in info$traces){ expect_equal(tr$fillcolor, toRGB("grey")) + expect_equal(tr$fill, "tozerox") expect_equal(tr$y, c(0, 1, 1, 0, 0, NA, 0, 1, 1, 0, 0, NA, @@ -98,6 +99,7 @@ test_that('rect color', { traces.by.name <- list() for(tr in info$traces){ expect_equal(tr$line$color, "transparent") + expect_equal(tr$fill, "tozerox") expect_equal(tr$y, c(0, 1, 1, 0, 0, NA, 0, 1, 1, 0, 0, NA, @@ -125,6 +127,7 @@ test_that('rect aes(fill) with constant color', { traces.by.name <- list() for(tr in info$traces){ expect_equal(tr$line$color, toRGB("black")) + expect_equal(tr$fill, "tozerox") expect_equal(tr$y, c(0, 1, 1, 0, 0, NA, 0, 1, 1, 0, 0, NA, From 870e5f8d51de9e3886f7c5c4c345e34050c9ad20 Mon Sep 17 00:00:00 2001 From: Toby Dylan Hocking Date: Mon, 16 Mar 2015 17:42:11 -0400 Subject: [PATCH 13/17] clarify retrace.first.points only when basic polygon --- R/trace_generation.R | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/R/trace_generation.R b/R/trace_generation.R index 4e99091702..a136c9a50a 100644 --- a/R/trace_generation.R +++ b/R/trace_generation.R @@ -428,17 +428,21 @@ group2NA <- function(g, geom) { is.group <- names(g$data) == "group" poly.na.list <- list() forward.i <- seq_along(poly.list) + ## When group2NA is called on geom_polygon (or geom_rect, which is + ## treated as a basic polygon), we need to retrace the first points + ## of each group, see https://github.com/ropensci/plotly/pull/178 + retrace.first.points <- g$geom == "polygon" for (i in forward.i) { no.group <- poly.list[[i]][, !is.group, drop=FALSE] na.row <- no.group[1, ] na.row[, c("x", "y")] <- NA - retrace.first <- if(g$geom %in% c("polygon", "rect")){ + retrace.first <- if(retrace.first.points){ no.group[1,] } poly.na.list[[paste(i, "forward")]] <- rbind(no.group, retrace.first, na.row) } - if(g$geom %in% c("polygon", "rect")){ + if(retrace.first.points)){ backward.i <- rev(forward.i[-1])[-1] for(i in backward.i){ no.group <- poly.list[[i]][1, !is.group, drop=FALSE] From 8ac051827b537f6bb1e51d0245f9d18f1d0bb69a Mon Sep 17 00:00:00 2001 From: Toby Dylan Hocking Date: Mon, 16 Mar 2015 17:42:42 -0400 Subject: [PATCH 14/17] typo --- R/trace_generation.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/trace_generation.R b/R/trace_generation.R index a136c9a50a..2181e0e3c4 100644 --- a/R/trace_generation.R +++ b/R/trace_generation.R @@ -442,7 +442,7 @@ group2NA <- function(g, geom) { poly.na.list[[paste(i, "forward")]] <- rbind(no.group, retrace.first, na.row) } - if(retrace.first.points)){ + if(retrace.first.points){ backward.i <- rev(forward.i[-1])[-1] for(i in backward.i){ no.group <- poly.list[[i]][1, !is.group, drop=FALSE] From 49d027ac1591b723f6876025420b16ef4bf373f8 Mon Sep 17 00:00:00 2001 From: Toby Dylan Hocking Date: Wed, 18 Mar 2015 12:04:30 -0400 Subject: [PATCH 15/17] anyNA --- tests/testthat/test-ggplot-rect.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-ggplot-rect.R b/tests/testthat/test-ggplot-rect.R index 5ed31cbbbd..4b3189c514 100644 --- a/tests/testthat/test-ggplot-rect.R +++ b/tests/testthat/test-ggplot-rect.R @@ -31,7 +31,7 @@ test_that('geom_rect becomes 1 trace with mode="lines" fill="tozerox"', { expect_identical(tr$type, "scatter") expect_identical(tr$mode, "lines") for(xy in c("x", "y")){ - expect_true(any(is.na(tr[[xy]]))) + expect_true(anyNA(tr[[xy]])) } }) From a413a8e453e933357bf0123aad0f96c32100c22c Mon Sep 17 00:00:00 2001 From: Toby Dylan Hocking Date: Wed, 18 Mar 2015 12:05:07 -0400 Subject: [PATCH 16/17] rect- prefix --- tests/testthat/test-ggplot-rect.R | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/tests/testthat/test-ggplot-rect.R b/tests/testthat/test-ggplot-rect.R index 4b3189c514..964698a8a3 100644 --- a/tests/testthat/test-ggplot-rect.R +++ b/tests/testthat/test-ggplot-rect.R @@ -3,7 +3,7 @@ context("geom_rect") expect_traces <- function(gg, n.traces, name){ stopifnot(is.ggplot(gg)) stopifnot(is.numeric(n.traces)) - save_outputs(gg, paste0("rects-", name)) + save_outputs(gg, paste0("rect-", name)) L <- gg2list(gg) is.trace <- names(L) == "" all.traces <- L[is.trace] @@ -68,7 +68,7 @@ rect.color <- ggplot(df4, aes(xmin = x, xmax = x + 0.5, ymin = 0, ymax = 1)) + geom_rect(aes(color=status), fill="grey") test_that('rect color', { - info <- expect_traces(rect.color, 2, "rect-color") + info <- expect_traces(rect.color, 2, "color") traces.by.name <- list() for(tr in info$traces){ expect_equal(tr$fillcolor, toRGB("grey")) @@ -95,7 +95,7 @@ rect.fill <- ggplot(df4, aes(xmin = x, xmax = x + 0.5, ymin = 0, ymax = 1)) + geom_rect(aes(fill=status)) test_that('rect color', { - info <- expect_traces(rect.fill, 2, "rect-fill") + info <- expect_traces(rect.fill, 2, "fill") traces.by.name <- list() for(tr in info$traces){ expect_equal(tr$line$color, "transparent") @@ -123,7 +123,7 @@ rect.fill.color <- geom_rect(aes(fill=status), color="black") test_that('rect aes(fill) with constant color', { - info <- expect_traces(rect.fill.color, 2, "rect-fill-color") + info <- expect_traces(rect.fill.color, 2, "fill-color") traces.by.name <- list() for(tr in info$traces){ expect_equal(tr$line$color, toRGB("black")) From 10c8bcccd6b0f482f553dc772667339eeb060c2a Mon Sep 17 00:00:00 2001 From: Toby Dylan Hocking Date: Wed, 18 Mar 2015 12:05:19 -0400 Subject: [PATCH 17/17] NEWS/VERSION --- DESCRIPTION | 2 +- NEWS | 4 ++++ 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 53f7fb6af7..18e50e1b92 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: plotly Type: Package Title: Interactive, publication-quality graphs online. -Version: 0.5.25 +Version: 0.5.26 Authors@R: c(person("Chris", "Parmer", role = c("aut", "cre"), email = "chris@plot.ly"), person("Scott", "Chamberlain", role = "aut", diff --git a/NEWS b/NEWS index d6834f7932..d1d6bdca77 100644 --- a/NEWS +++ b/NEWS @@ -1,3 +1,7 @@ +0.5.26 -- 18 Mar 2015 + +Implemented geom_rect #178 + 0.5.25 -- 10 March 2015 Implemented geom_smooth() #183