Merge pull request #538 from ropensci/fix/shape

fix #537

Author: cpsievert

.gitignore

@@ -8,3 +8,4 @@ build_site.R
 todo.R
 inst/examples/*/*.html
 inst/examples/*/rsconnect/*
+.Rproj.user

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: plotly
 Title: Create Interactive Web Graphics via 'plotly.js'
-Version: 3.4.12
+Version: 3.4.13
 Authors@R: c(person("Carson", "Sievert", role = c("aut", "cre"),
     email = "cpsievert1@gmail.com"),
     person("Chris", "Parmer", role = c("aut", "cph"),

NEWS

@@ -1,3 +1,10 @@
+3.4.13 -- 6 Apr 2016
+
+BUGFIX:
+
+In some cases, marker color was inheriting from the marker line color when
+it shouldn't have. See ##537.
+
 3.4.12 -- 5 Apr 2016
 
 CHANGES:

R/layers2traces.R

@@ -395,6 +395,7 @@ geom2trace.GeomPath <- function(data, params, p) {
 #' @export
 geom2trace.GeomPoint <- function(data, params, p) {
   shape <- aes2plotly(data, params, "shape")
+  color <- aes2plotly(data, params, "colour")
   L <- list(
     x = data$x,
     y = data$y,
@@ -404,21 +405,20 @@ geom2trace.GeomPoint <- function(data, params, p) {
     mode = "markers",
     marker = list(
       autocolorscale = FALSE,
-      color = aes2plotly(data, params, "fill"),
+      color = color,
       opacity = aes2plotly(data, params, "alpha"),
       size = aes2plotly(data, params, "size"),
       symbol = shape,
       line = list(
         width = aes2plotly(data, params, "stroke"),
-        color = aes2plotly(data, params, "colour")
+        color = color
       )
     )
   )
-  # fill is irrelevant for pch %in% c(1, 15:20)
+  # fill is only relevant for pch %in% 21:25
   pch <- uniq(data$shape) %||% params$shape %||% GeomPoint$default_aes$shape
-  if (any(pch %in% c(1, 15:20)) ||
-      all(grepl("open$", shape)) && all(L$marker$color %in% "transparent")) {
-    L$marker$color <- L$marker$line$color
+  if (any(idx <- pch %in% 21:25)) {
+    L$marker$color[idx] <- aes2plotly(data, params, "fill")[idx]
   }
   L
 }

tests/testthat/test-ggplot-point.R

@@ -34,6 +34,21 @@ test_that("marker color is non-transparent for open shapes", {
   )
 })
 
+test_that("marker color inherits from fill, when appropriate", {
+  df_shapes <- data.frame(shape = factor(0:24))
+  p <- ggplot(df_shapes, aes(shape = shape)) +
+    geom_point(aes(shape = shape, x = 0, y = 0), size = 5, fill = "red") +
+    facet_wrap(~shape) +
+    scale_shape_manual(values = df_shapes$shape, guide = "none")
+  l <- save_outputs(p, "all-shapes")
+  expect_equal(length(l$data), 25)
+  markerColors <- sapply(l$data, function(x) x$marker$color)
+  lineColors <- sapply(l$data, function(x) x$marker$line$color)
+  expect_true(all(markerColors[1:20] == lineColors[1:20]))
+  expect_true(all(markerColors[21:25] != lineColors[21:25]))
+})
+
+
 test_that("can plot on sub-second time scale", {
   d <- data.frame(
     x = Sys.time() + 1e-3 * c(1:9, 5000),