Merge branch 'master' of github.com:ropensci/plotly into fix/subplot

cpsievert · cpsievert · commit f8eedaa48d49 · 2016-04-18T14:30:41.000+10:00
diff --git a/.Rbuildignore b/.Rbuildignore
@@ -5,4 +5,5 @@
 CONDUCT.md
 CONTRIBUTING.md
 build_site.R
+todo.R
 inst/examples/flexdashboard
diff --git a/.gitignore b/.gitignore
@@ -8,3 +8,4 @@ build_site.R
 todo.R
 inst/examples/*/*.html
 inst/examples/*/rsconnect/*
+.Rproj.user
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,6 +1,6 @@
 Package: plotly
 Title: Create Interactive Web Graphics via 'plotly.js'
-Version: 3.4.12
+Version: 3.4.15
 Authors@R: c(person("Carson", "Sievert", role = c("aut", "cre"),
     email = "cpsievert1@gmail.com"),
     person("Chris", "Parmer", role = c("aut", "cph"),
diff --git a/NAMESPACE b/NAMESPACE
@@ -87,6 +87,7 @@ importFrom(jsonlite,toJSON)
 importFrom(magrittr,"%>%")
 importFrom(plyr,ddply)
 importFrom(plyr,summarise)
+importFrom(stats,complete.cases)
 importFrom(stats,setNames)
 importFrom(tidyr,gather)
 importFrom(utils,browseURL)
diff --git a/NEWS b/NEWS
@@ -1,3 +1,22 @@
+3.4.15 -- 18 Apr 2016
+
+BUGFIX:
+
+The alpha in geom_smooth was incorrectly inheriting from other layers. See #551.
+
+3.4.14 -- 15 Apr 2016
+
+CHANGES:
+
+Upgrade to plotlyjs v1.9.0 -- https://github.com/plotly/plotly.js/releases/tag/v1.9.0
+
+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:
diff --git a/R/ggplotly.R b/R/ggplotly.R
@@ -232,6 +232,7 @@ gg2list <- function(p, width = NULL, height = NULL, tooltip = "all", source = "A
   # attach a new column (hovertext) to each layer of data that should get mapped
   # to the text trace property
   data <- Map(function(x, y) {
+    if (nrow(x) == 0) return(x)
     # make sure the relevant aes exists in the data
     for (i in seq_along(y)) {
       aesName <- names(y)[[i]]
diff --git a/R/imports.R b/R/imports.R
@@ -1,7 +1,7 @@
 #' @import ggplot2
 #' @importFrom grDevices col2rgb
 #' @importFrom utils getFromNamespace modifyList data packageVersion browseURL
-#' @importFrom stats setNames
+#' @importFrom stats setNames complete.cases
 #' @importFrom tidyr gather
 #' @importFrom plyr ddply summarise
 #' @importFrom viridis viridis
diff --git a/R/layers2traces.R b/R/layers2traces.R
@@ -141,7 +141,8 @@ to_basic.GeomBoxplot <- function(data, prestats_data, layout, params, p, ...) {
 #' @export
 to_basic.GeomSmooth <- function(data, prestats_data, layout, params, p, ...) {
   dat <- prefix_class(data, "GeomPath")
-  dat$alpha <- NULL
+  # alpha for the path is always 1 (see GeomSmooth$draw_key)
+  dat$alpha <- 1
   if (!identical(params$se, FALSE)) {
     dat2 <- prefix_class(ribbon_dat(data), c("GeomPolygon", "GeomSmooth"))
     dat2$colour <- NULL
@@ -395,6 +396,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 +406,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
 }
@@ -538,7 +539,7 @@ geom2trace.GeomTile <- function(data, params, p) {
   # create the colorscale 
   colScale <- unique(g[, c("fill_plotlyDomain", "fill")])
   # colorscale goes crazy if there are NAs
-  colScale <- colScale[complete.cases(colScale), ]
+  colScale <- colScale[stats::complete.cases(colScale), ]
   colScale <- colScale[order(colScale$fill_plotlyDomain), ]
   list(
     x = x,
diff --git a/inst/htmlwidgets/lib/plotlyjs/plotly-latest.min.js b/inst/htmlwidgets/lib/plotlyjs/plotly-latest.min.js
diff --git a/inst/htmlwidgets/plotly.yaml b/inst/htmlwidgets/plotly.yaml
@@ -1,6 +1,6 @@
 dependencies:
   - name: plotlyjs
-    version: 1.8.0
+    version: 1.9.0
     src: "htmlwidgets/lib/plotlyjs"
     script: plotly-latest.min.js
     stylesheet: plotly-htmlwidgets.css
diff --git a/tests/testthat/test-ggplot-point.R b/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), 
