legend title annotation

Author: cpsievert

.Rbuildignore

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

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