From 880f42dc330a471f6ef033ff4e7a71909f3b0621 Mon Sep 17 00:00:00 2001 From: Baobao Zhang Date: Tue, 19 May 2015 17:20:39 -0400 Subject: [PATCH 1/6] first attempt at supporting geom_jitter --- R/trace_generation.R | 29 +++++++++++++++++++++++++++++ 1 file changed, 29 insertions(+) diff --git a/R/trace_generation.R b/R/trace_generation.R index 0c2598efe3..974ef89ba7 100644 --- a/R/trace_generation.R +++ b/R/trace_generation.R @@ -556,6 +556,35 @@ geom2trace <- list( } L }, + jitter=function(data, params){ + L <- list(x=data$x, + y=data$y, + name=params$name, + text=data$text, + type="scatter", + mode="markers", + marker=paramORdefault(params, aes2marker, marker.defaults)) + if("size" %in% names(data)){ + L$text <- paste("size:", data$size) + L$marker$sizeref <- default.marker.sizeref + # Make sure sizes are passed as a list even when there is only one element. + s <- data$size + marker.size <- 5 * (s - params$sizemin)/(params$sizemax - params$sizemin) + 0.25 + marker.size <- marker.size * marker.size.mult + L$marker$size <- if (length(s) > 1) marker.size else list(marker.size) + L$marker$line$width <- 0 + } + if (!is.null(params$shape) && params$shape %in% c(21:25)) { + L$marker$color <- ifelse(!is.null(params$fill), toRGB(params$fill), "rgba(0,0,0,0)") + if (!is.null(params$colour)) + L$marker$line$color <- toRGB(params$colour) + L$marker$line$width <- 1 + } + if (!is.null(params$shape) && params$shape %in% c(32)) { + L$visible <- FALSE + } + L + }, text=function(data, params){ L <- list(x=data$x, y=data$y, From 2060c2103f503068ccae61a0de4e48604e3c2e34 Mon Sep 17 00:00:00 2001 From: Baobao Zhang Date: Wed, 20 May 2015 22:38:29 -0400 Subject: [PATCH 2/6] first attempt to testing geom_jitter --- R/trace_generation.R | 31 ++++++++------- tests/testthat/test-cookbook-scatterplots.R | 8 ++++ tests/testthat/test-ggplot-jitter.R | 42 +++++++++++++++++++++ 3 files changed, 67 insertions(+), 14 deletions(-) create mode 100644 tests/testthat/test-ggplot-jitter.R diff --git a/R/trace_generation.R b/R/trace_generation.R index 974ef89ba7..1cb886f6cc 100644 --- a/R/trace_generation.R +++ b/R/trace_generation.R @@ -557,33 +557,36 @@ geom2trace <- list( L }, jitter=function(data, params){ - L <- list(x=data$x, - y=data$y, - name=params$name, - text=data$text, - type="scatter", - mode="markers", - marker=paramORdefault(params, aes2marker, marker.defaults)) - if("size" %in% names(data)){ + L <- list(x = data$x, + y = data$y, + name = params$name, + text = data$text, + type = "scatter", + mode = "markers", + marker = paramORdefault(params, aes2marker, marker.defaults)) + if ("size" %in% names(data)) { L$text <- paste("size:", data$size) L$marker$sizeref <- default.marker.sizeref # Make sure sizes are passed as a list even when there is only one element. s <- data$size - marker.size <- 5 * (s - params$sizemin)/(params$sizemax - params$sizemin) + 0.25 + marker.size <- 5 * (s - params$sizemin) / + (params$sizemax - params$sizemin) + 0.25 marker.size <- marker.size * marker.size.mult - L$marker$size <- if (length(s) > 1) marker.size else list(marker.size) + L$marker$size <- ifelse(length(s) > 1, marker.size, list(marker.size)) L$marker$line$width <- 0 } if (!is.null(params$shape) && params$shape %in% c(21:25)) { - L$marker$color <- ifelse(!is.null(params$fill), toRGB(params$fill), "rgba(0,0,0,0)") - if (!is.null(params$colour)) - L$marker$line$color <- toRGB(params$colour) + L$marker$color <- ifelse(!is.null(params$fill), + toRGB(params$fill), "rgba(0,0,0,0)") + if (!is.null(params$colour)) { + L$marker$line$color <- toRGB(params$colour) + } L$marker$line$width <- 1 } if (!is.null(params$shape) && params$shape %in% c(32)) { L$visible <- FALSE } - L + return(L) }, text=function(data, params){ L <- list(x=data$x, diff --git a/tests/testthat/test-cookbook-scatterplots.R b/tests/testthat/test-cookbook-scatterplots.R index 375fecdeee..792fc9c58a 100644 --- a/tests/testthat/test-cookbook-scatterplots.R +++ b/tests/testthat/test-cookbook-scatterplots.R @@ -72,3 +72,11 @@ g <- ggplot(dat, aes(x=xrnd, y=yrnd)) + geom_point(shape=1, # Use hollow circles position=position_jitter(width=1,height=.5)) save_outputs(g, "scatterplots-jitter") + +# Jitter the points using geom_jitter +# Jitter range is 1 on the x-axis, .5 on the y-axis +g <- ggplot(dat, aes(x = xrnd, y = yrnd)) + + geom_jitter(shape = 1, # Use hollow circles + width = 1, height = 0.5) +save_outputs(g, "scatterplots-geom_jitter") + diff --git a/tests/testthat/test-ggplot-jitter.R b/tests/testthat/test-ggplot-jitter.R new file mode 100644 index 0000000000..9ae93a5f82 --- /dev/null +++ b/tests/testthat/test-ggplot-jitter.R @@ -0,0 +1,42 @@ +context("geom_jitter") + +# Expect trace function +expect_traces <- function(gg, n_traces, name, seed) { + stopifnot(is.ggplot(gg)) + stopifnot(is.numeric(n_traces)) + save_outputs(gg, paste0("coord_fixed-", name)) + set.seed(seed) + L <- gg2list(gg) + all_traces <- L$data + 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, layout = L$layout) +} + +#head(L$data[[1]]$x) + +# get data from mpg dataset +p <- ggplot(mpg, aes(displ, hwy)) + +# Test 1 +# set up the data +set.seed(1001) +p1 <- ggplot() + geom_jitter(data = mpg, aes(displ, hwy), width = 1) +head(ggplot_build2(p1)$data[[1]]$x) +# test +test_that("geom_jitter is working", { + info <- expect_traces(p1, 1, "geom_jitter", 1001) + tr <- info$traces[[1]] + la <- info$layout + expect_identical(tr$type, "scatter") + set.seed(1001) + built <- ggplot_build2(p1) + print(head(tr$x)) # from gg2list + print(head(built$data[[1]]$x)) # from ggplot_build2 + expect_identical(tr$x, built$data[[1]]$x) + expect_identical(tr$y, built$data[[1]]$y) +}) + From dfb079ae85e03f0f8f4b9b7b21efe57089ae5bb0 Mon Sep 17 00:00:00 2001 From: cpsievert Date: Wed, 20 May 2015 22:40:51 -0500 Subject: [PATCH 3/6] get test working; jitter shouldn't be a basic geom --- R/trace_generation.R | 40 ++++++----------------------- tests/testthat/test-ggplot-jitter.R | 29 +++++---------------- 2 files changed, 15 insertions(+), 54 deletions(-) diff --git a/R/trace_generation.R b/R/trace_generation.R index aaa80b8a0a..c8a0ba91c0 100644 --- a/R/trace_generation.R +++ b/R/trace_generation.R @@ -384,6 +384,14 @@ toBasic <- list( g$params$yend <- max(g$prestats.data$globymax) g }, + jitter=function(g) { + if ("size" %in% names(g$data)) { + g$params$sizemin <- min(g$prestats.data$globsizemin) + g$params$sizemax <- max(g$prestats.data$globsizemax) + } + g$geom <- "point" + g + }, point=function(g) { if ("size" %in% names(g$data)) { g$params$sizemin <- min(g$prestats.data$globsizemin) @@ -556,38 +564,6 @@ geom2trace <- list( } L }, - jitter=function(data, params){ - L <- list(x = data$x, - y = data$y, - name = params$name, - text = data$text, - type = "scatter", - mode = "markers", - marker = paramORdefault(params, aes2marker, marker.defaults)) - if ("size" %in% names(data)) { - L$text <- paste("size:", data$size) - L$marker$sizeref <- default.marker.sizeref - # Make sure sizes are passed as a list even when there is only one element. - s <- data$size - marker.size <- 5 * (s - params$sizemin) / - (params$sizemax - params$sizemin) + 0.25 - marker.size <- marker.size * marker.size.mult - L$marker$size <- ifelse(length(s) > 1, marker.size, list(marker.size)) - L$marker$line$width <- 0 - } - if (!is.null(params$shape) && params$shape %in% c(21:25)) { - L$marker$color <- ifelse(!is.null(params$fill), - toRGB(params$fill), "rgba(0,0,0,0)") - if (!is.null(params$colour)) { - L$marker$line$color <- toRGB(params$colour) - } - L$marker$line$width <- 1 - } - if (!is.null(params$shape) && params$shape %in% c(32)) { - L$visible <- FALSE - } - return(L) - }, text=function(data, params){ L <- list(x=data$x, y=data$y, diff --git a/tests/testthat/test-ggplot-jitter.R b/tests/testthat/test-ggplot-jitter.R index 9ae93a5f82..fd4d86393f 100644 --- a/tests/testthat/test-ggplot-jitter.R +++ b/tests/testthat/test-ggplot-jitter.R @@ -1,11 +1,10 @@ context("geom_jitter") # Expect trace function -expect_traces <- function(gg, n_traces, name, seed) { +expect_traces <- function(gg, n_traces, name) { stopifnot(is.ggplot(gg)) stopifnot(is.numeric(n_traces)) - save_outputs(gg, paste0("coord_fixed-", name)) - set.seed(seed) + save_outputs(gg, paste0("jitter-", name)) L <- gg2list(gg) all_traces <- L$data no_data <- sapply(all_traces, function(tr) { @@ -16,27 +15,13 @@ expect_traces <- function(gg, n_traces, name, seed) { list(traces = has_data, layout = L$layout) } -#head(L$data[[1]]$x) - -# get data from mpg dataset -p <- ggplot(mpg, aes(displ, hwy)) - -# Test 1 -# set up the data set.seed(1001) -p1 <- ggplot() + geom_jitter(data = mpg, aes(displ, hwy), width = 1) -head(ggplot_build2(p1)$data[[1]]$x) -# test +p <- ggplot(mpg, aes(cyl, hwy)) + geom_jitter() + test_that("geom_jitter is working", { - info <- expect_traces(p1, 1, "geom_jitter", 1001) + info <- expect_traces(p1, 1, "basic") tr <- info$traces[[1]] - la <- info$layout expect_identical(tr$type, "scatter") - set.seed(1001) - built <- ggplot_build2(p1) - print(head(tr$x)) # from gg2list - print(head(built$data[[1]]$x)) # from ggplot_build2 - expect_identical(tr$x, built$data[[1]]$x) - expect_identical(tr$y, built$data[[1]]$y) + # default jitter is 40% of the resolution of the data. + expect_true(all(0 < abs(mpg$cyl - tr$x) < 0.4)) }) - From 6cc033c7dc9c7c0665bea5e9af7400445a75a1b2 Mon Sep 17 00:00:00 2001 From: cpsievert Date: Thu, 21 May 2015 01:48:37 -0500 Subject: [PATCH 4/6] bug fix --- tests/testthat/test-ggplot-jitter.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/tests/testthat/test-ggplot-jitter.R b/tests/testthat/test-ggplot-jitter.R index fd4d86393f..1d04db11f2 100644 --- a/tests/testthat/test-ggplot-jitter.R +++ b/tests/testthat/test-ggplot-jitter.R @@ -23,5 +23,6 @@ test_that("geom_jitter is working", { tr <- info$traces[[1]] expect_identical(tr$type, "scatter") # default jitter is 40% of the resolution of the data. - expect_true(all(0 < abs(mpg$cyl - tr$x) < 0.4)) + diffs <- abs(mpg$cyl - tr$x) + expect_true(all(0 < diffs & diffs < 0.4)) }) From 037a0271c223caff7d9494b98a85354b9999568b Mon Sep 17 00:00:00 2001 From: Baobao Zhang Date: Mon, 1 Jun 2015 22:07:44 -0700 Subject: [PATCH 5/6] fixed silly test mistake --- tests/testthat/test-ggplot-jitter.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-ggplot-jitter.R b/tests/testthat/test-ggplot-jitter.R index 1d04db11f2..b995795be4 100644 --- a/tests/testthat/test-ggplot-jitter.R +++ b/tests/testthat/test-ggplot-jitter.R @@ -19,7 +19,7 @@ set.seed(1001) p <- ggplot(mpg, aes(cyl, hwy)) + geom_jitter() test_that("geom_jitter is working", { - info <- expect_traces(p1, 1, "basic") + info <- expect_traces(p, 1, "basic") tr <- info$traces[[1]] expect_identical(tr$type, "scatter") # default jitter is 40% of the resolution of the data. From 62c34ba17139bcfbd656403ced4941781df74fae Mon Sep 17 00:00:00 2001 From: cpsievert Date: Fri, 11 Dec 2015 20:19:51 -0600 Subject: [PATCH 6/6] bump version; update news --- DESCRIPTION | 2 +- NEWS | 4 ++++ 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 9582928e1e..0ee1405acf 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: plotly Title: Create Interactive Web Graphics via Plotly's JavaScript Graphing Library -Version: 2.0.11 +Version: 2.0.12 Authors@R: c(person("Carson", "Sievert", role = c("aut", "cre"), email = "cpsievert1@gmail.com"), person("Chris", "Parmer", role = c("aut", "cph"), diff --git a/NEWS b/NEWS index 88d1df09ec..712f4a1097 100644 --- a/NEWS +++ b/NEWS @@ -1,3 +1,7 @@ +2.0.12 -- 11 Dec 2015 + +Fix #221 + 2.0.11 -- 11 Dec 2015 Fix #250