Merge branch 'baobao-geom_jitter' of https://github.com/ropensci/plotly into baobao-geom_jitter

Author: cpsievert

R/trace_generation.R

@@ -556,6 +556,38 @@ 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,

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")
+

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