naive approach to avoiding redundant legends

Author: cpsievert

R/ggplotly.R

@@ -598,13 +598,36 @@ gg2list <- function(p){
       layout$showlegend <- FALSE
     }
   }
-
+  
+  # avoid redundant legends
+  fills <- lapply(trace.list, function(x) paste0(x$name, "-", x$fillcolor))
+  linez <- lapply(trace.list, function(x) paste0(x$name, "-", x$line$color))
+  marks <- lapply(trace.list, function(x) paste0(x$name, "-", x$marker$color))
+  fill_set <- unlist(fills)
+  line_set <- unlist(linez)
+  mark_set <- unlist(marks)
+  legend_intersect <- function(x, y) {
+    i <- intersect(x, y)
+    # restrict intersection to valid legend entries
+    i[grepl("-rgb[a]?\\(", i)]
+  }
+  # if there is a mark & line legend, get rid of line
+  t1 <- line_set %in% legend_intersect(mark_set, line_set)
+  # if there is a mark & fill legend, get rid of fill
+  t2 <- fill_set %in% legend_intersect(mark_set, fill_set)
+  # if there is a line & fill legend, get rid of fill
+  t3 <- fill_set %in% legend_intersect(line_set, fill_set)
+  t <- t1 | t2 | t3
+  for (m in seq_along(trace.list)) 
+    if (trace.list[[m]]$showlegend && t[m]) 
+      trace.list[[m]]$showlegend <- FALSE
+  
   # Only show a legend title if there is at least 1 trace with
   # showlegend=TRUE.
   trace.showlegend <- sapply(trace.list, "[[", "showlegend")
   if (any(trace.showlegend) && layout$showlegend && length(p$data)) {
     # Retrieve legend title
-    legend.elements <- sapply(traces, "[[", "name")
+    legend.elements <- unlist(sapply(traces, "[[", "name"))
     legend.title <- ""
     for (i in 1:ncol(p$data)) {
       if (all(legend.elements %in% unique(p$data[, i])))
@@ -629,6 +652,8 @@ gg2list <- function(p){
     layout$annotations <- annotations
   }
 
+  
+  
   # Family font for text
   if (!is.null(theme.pars$text$family)) {
     layout$titlefont$family   <- theme.pars$text$family

tests/testthat/test-ggplot-smooth.R

@@ -36,13 +36,37 @@ test_that("geom_smooth() respects group aesthetic", {
 })
 
 p4 <- qplot(carat, price, colour = cut, data = d) + geom_smooth()
+p5 <- qplot(carat, price, data = d) + geom_smooth(aes(colour = cut))
 
 test_that("geom_smooth() respects colour aesthetic", {
   info <- expect_traces(p4, 11, "colour")
+  # number of showlegends should equal the number of factor levels 
+  n <- sum(unlist(sapply(info$traces, "[[", "showlegend")))
+  expect_equal(n, nlevels(d$cut))
+  info <- expect_traces(p5, 11, "colour2")
+  n <- sum(unlist(sapply(info$traces, "[[", "showlegend")))
+  expect_equal(n, nlevels(d$cut))
 })
 
-p5 <- qplot(carat, price, fill = cut, data = d) + geom_smooth()
+# why are 5 traces for point being created here??
+#p6 <- qplot(carat, price, fill = cut, data = d) + geom_smooth()
+p7 <- qplot(carat, price, data = d) + geom_smooth(aes(fill = cut))
 
 test_that("geom_smooth() respects fill aesthetic", {
-  info <- expect_traces(p5, 11, "fill")
+#   info <- expect_traces(p6, 11, "fill")
+#   n <- sum(unlist(sapply(info$traces, "[[", "showlegend")))
+#   expect_equal(n, nlevels(d$cut))
+  info <- expect_traces(p7, 11, "fill2")
+  n <- sum(unlist(sapply(info$traces, "[[", "showlegend")))
+  expect_equal(n, nlevels(d$cut))
 })
+
+# ensure legend is drawn when needed
+p8 <- qplot(carat, price, data = d) + facet_wrap(~cut) + 
+  geom_smooth(aes(colour = cut, fill = cut))
+
+test_that("geom_smooth() works with facets", {
+  # 3 traces for each panel
+  info <- expect_traces(p8, 15, "fill2")
+})
+