Merge pull request #503 from ropensci/fix/legendTitles

legend title annotation

Author: cpsievert

.Rbuildignore

@@ -5,3 +5,4 @@
 CONDUCT.md
 CONTRIBUTING.md
 build_site.R
+inst/examples/flexdashboard

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: plotly
 Title: Create Interactive Web Graphics via 'plotly.js'
-Version: 3.3.2
+Version: 3.4.1
 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,9 @@
+3.4.1 -- 13 Mar 2016
+
+BUGFIX:
+
+Legend titles are now supported.
+
 3.4.0 -- 12 Mar 2016
 
 NEW FEATURES:

R/ggplotly.R

@@ -525,6 +525,23 @@ gg2list <- function(p, width = NULL, height = NULL, tooltip = "all", source = "A
       }
     }
     traces <- c(traces, colorbar)
+    
+    # legend title annotation - https://github.com/plotly/plotly.js/issues/276
+    legendTitles <- compact(lapply(gdefs, function(g) if (inherits(g, "legend")) g$title else NULL))
+    legendTitle <- paste(legendTitles, collapse = "<br>")
+    titleAnnotation <- make_label(
+      legendTitle, 
+      x = gglayout$legend$x %||% 1.02,
+      y = gglayout$legend$y %||% 1, 
+      theme$legend.title,
+      xanchor = "left",
+      yanchor = "top"
+    )
+    gglayout$annotations <- c(gglayout$annotations, titleAnnotation)
+    # adjust the height of the legend to accomodate for the title
+    # this assumes the legend always appears below colorbars
+    gglayout$legend$y <- (gglayout$legend$y %||% 1) - 
+      length(legendTitles) * unitConvert(theme$legend.title$size, "npc", "height")
   }
 
   # geom_bar() hacks

tests/testthat/test-ggplot-density2d.R

@@ -51,7 +51,7 @@ test_that("StatDensity2d with GeomPolygon translates to filled path(s)", {
     length(unique(unlist(lapply(polygons, "[[", "fillcolor")))) > 1
   )
   # ensure the legend/guide are placed correctly
-  expect_true(L$layout$legend$y == 0.5)
+  expect_true(L$layout$legend$y < 0.5)
   expect_true(L$layout$legend$yanchor == "top")
   expect_true(colorbar$marker$colorbar$y == 1)
   expect_true(colorbar$marker$colorbar$yanchor == "top")

tests/testthat/test-ggplot-legend.R

@@ -29,6 +29,10 @@ test_that("Discrete colour and shape get merged into one legend", {
   expect_identical(
     nms, paste0("(", d$vs, ",", d$cyl, ")")
   )
+  a <- info$layout$annotations
+  expect_match(a[[3]]$text, "^factor\\(vs\\)")
+  expect_match(a[[3]]$text, "factor\\(cyl\\)$")
+  expect_true(a[[3]]$y > info$layout$legend$y)
 })