Toby legend hiding

R/ggplotly.R

@@ -69,6 +69,7 @@ gg2list <- function(p){
   }
   # Always use identity size scale so that plot.ly gets the real
   # units for the size variables.
+  original.p <- p
   p <- tryCatch({
     # this will be an error for discrete variables.
     suppressMessages({
@@ -117,7 +118,8 @@ gg2list <- function(p){
     ggsizemin <- min(unlist(sizerange))
     ggsizemax <- max(unlist(sizerange))
   }
-
+
+  layer.legends <- list()
   for(i in seq_along(built$plot$layers)){
     # This is the layer from the original ggplot object.
     L <- p$layers[[i]]
@@ -134,14 +136,14 @@ gg2list <- function(p){
     # sent to plotly as characters, not as numeric data (which is
     # what ggplot_build gives us).
     misc <- list()
-    for(a in c("fill", "colour", "x", "y")){
+    for(a in c("fill", "colour", "x", "y", "size")){
       for(data.type in c("continuous", "date", "datetime", "discrete")){
         fun.name <- sprintf("scale_%s_%s", a, data.type)
         misc.name <- paste0("is.", data.type)
         misc[[misc.name]][[a]] <- tryCatch({
           fun <- get(fun.name)
           suppressMessages({
-            with.scale <- p+fun()
+            with.scale <- original.p + fun()
           })
           ggplot_build(with.scale)
           TRUE
@@ -152,13 +154,16 @@ gg2list <- function(p){
     }
 
     # scales are needed for legend ordering.
+    misc$breaks <- list()
     for(sc in p$scales$scales){
-      a <- sc$aesthetics
-      if(length(a) == 1){
+      a.vec <- sc$aesthetics
+      default.breaks <- inherits(sc$breaks, "waiver")
+      if (length(a.vec) == 1 && (!default.breaks) ) {
+        # TODO: generalize for x/y scales too.
         br <- sc$breaks
         ranks <- seq_along(br)
         names(ranks) <- br
-        misc$breaks[[sc$aesthetics]] <- ranks
+        misc$breaks[[a.vec]] <- ranks
       }
       misc$trans[sc$aesthetics] <- sc$trans$name
     }
@@ -202,6 +207,10 @@ gg2list <- function(p){
 
     # This extracts essential info for this geom/layer.
     traces <- layer2traces(L, df, misc)
+
+    possible.legends <- markLegends[[L$geom$objname]]
+    actual.legends <- possible.legends[possible.legends %in% names(L$mapping)]
+    layer.legends[[paste(i)]] <- actual.legends
 
     # Do we really need to coord_transform?
     # g$data <- ggplot2:::coord_transform(built$plot$coord, g$data,
@@ -528,7 +537,27 @@ gg2list <- function(p){
   if (any(names(layer.aes) %in% markUnique[markUnique != "x"]) == FALSE)
     layout$showlegend <- FALSE
 
-  if (layout$showlegend && length(p$data)) {
+  ## Legend hiding when guides(fill="none").
+  legends.present <- unique(unlist(layer.legends))
+  is.false <- function(x){
+    is.logical(x) && length(x) == 1 && x == FALSE
+  }
+  is.none <- function(x){
+    is.character(x) && length(x) == 1 && x == "none"
+  }
+  is.hidden <- function(x){
+    is.false(x) || is.none(x)
+  }
+  for(a in legends.present){
+    if(is.hidden(p$guides[[a]])){
+      layout$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.title <- ""
@@ -687,7 +716,13 @@ gg2list <- function(p){
   }
 
   # Put the traces in correct order, according to any manually
-  # specified scales.
+  # specified scales. This seems to be repetitive with the trace$rank
+  # attribute in layer2traces (which is useful for sorting traces that
+  # get different legend entries but come from the same geom, as in
+  # test-ggplot-legend.R), but in fact this is better since it could
+  # be used for sorting traces that come from different geoms
+  # (currently we don't have a test for this). TODO: write such a
+  # test, delete the trace$rank code, and have it work here instead.
   trace.order <- unlist(trace.order.list)
   ordered.traces <- if(length(trace.order)){
     trace.order.score <- seq_along(trace.order)

R/trace_generation.R

@@ -210,16 +210,24 @@ layer2traces <- function(l, d, misc) {
       }
     }
     name.names <- grep("[.]name$", names(data.params$params), value=TRUE)
-    if (length(name.names)) {
-      for(a.name in name.names){
+    not.group <- grep("group", name.names, value=TRUE, invert=TRUE)
+    if (length(not.group)) {
+      for(a.name in not.group){
         a <- sub("[.]name$", "", a.name)
-        a.value <- as.character(data.params$params[[a.name]])
-        ranks <- misc$breaks[[a]]
-        if(length(ranks)){
-          tr$sort[[a.name]] <- ranks[[a.value]]
+        tr$sort[[a.name]] <- if (a %in% names(misc$breaks)){
+          # Custom breaks were specified.
+          a.value <- as.character(data.params$params[[a.name]])
+          ranks <- misc$breaks[[a]]
+          if (a.value %in% names(ranks)){
+            ranks[[a.value]]
+          } else {
+            Inf # sorts to the end, when there are less breaks than classes.
+          }
+        } else { # custom breaks were not specified.
+          1 # sort them all the same.
         }
       }
-      name.list <- data.params$params[name.names]
+      name.list <- data.params$params[not.group]
       tr$name <- paste(unlist(name.list), collapse=".")
       if (length(unique(name.list)) < 2)
         tr$name <- as.character(name.list[[1]])
@@ -257,14 +265,25 @@ layer2traces <- function(l, d, misc) {
       0
     }
   })
-  
+
   ord <- order(sort.val)
   no.sort <- traces[ord]
   for(tr.i in seq_along(no.sort)){
+    s <- no.sort[[tr.i]]$sort
+    no.sort[[tr.i]]$showlegend <-
+      if (is.numeric(s)) {
+        if (s == Inf){
+          FALSE
+        } else {
+          TRUE
+        }
+      } else { # no legend.
+        FALSE
+      }
     no.sort[[tr.i]]$sort <- NULL
   }
   no.sort
-  }
+}#layer2traces
 
 
 # Preprocess data and params.
@@ -309,7 +328,10 @@ toBasic <- list(
   bar=function(g) {
     if (any(is.na(g$prestats.data$x)))
       g$prestats.data$x <- g$prestats.data$x.name
-    g$prestats.data$fill <- g$data$fill[match(g$prestats.data$group, g$data$group)]
+    for(a in c("fill", "colour")){
+      g$prestats.data[[a]] <-
+        g$data[[a]][match(g$prestats.data$group, g$data$group)]
+    }
     g$params$xstart <- min(g$data$xmin)
     g$params$xend <- max(g$data$xmax)
     g$data <- g$prestats.data

tests/testthat/test-ggplot-abline.R

@@ -11,13 +11,16 @@ test_that("Second trace be the a-b line", {
     geom_abline(intercept=1.1, slope=0.9, colour="red", size=4)
 
   L <- gg2list(gg)
-  
+
   expect_equal(length(L), 3)
   expect_true(L[[2]]$x[1] <= 0)
   expect_true(L[[2]]$x[2] >= 3.5)
   expect_identical(L[[2]]$mode, "lines")
   expect_identical(L[[2]]$line$shape, "linear")
   expect_equal(L[[2]]$line$width, 8)
 
+  expect_identical(L[[1]]$showlegend, FALSE)
+  expect_identical(L[[2]]$showlegend, FALSE)
+
   save_outputs(gg, "abline")
 })

tests/testthat/test-ggplot-bar.R

@@ -63,3 +63,122 @@ test_that("dates work well with bar charts", {
 
   save_outputs(gd, "bar-dates")
 })
+
+expect_traces <- function(gg, n.traces, name){
+  stopifnot(is.ggplot(gg))
+  stopifnot(is.numeric(n.traces))
+  save_outputs(gg, paste0("bar-", name))
+  L <- gg2list(gg)
+  is.trace <- names(L) == ""
+  all.traces <- L[is.trace]
+  no.data <- sapply(all.traces, function(tr) {
+    is.null(tr[["x"]]) && is.null(tr[["y"]])
+  })
+  has.data <- all.traces[!no.data]
+  expect_equal(length(has.data), n.traces)
+  list(traces=has.data, kwargs=L$kwargs)
+}
+
+## http://www.cookbook-r.com/Graphs/Bar_and_line_graphs_%28ggplot2%29/
+df <- data.frame(time = factor(c("Lunch","Dinner"), levels=c("Lunch","Dinner")),
+                 total_bill = c(14.89, 17.23))
+
+test_that("Very basic bar graph", {
+  gg <- ggplot(data=df, aes(x=time, y=total_bill)) +
+    geom_bar(stat="identity")
+  info <- expect_traces(gg, 1, "nocolor")
+  for(tr in info$traces){
+    expect_null(tr$marker$color)
+    expect_null(tr$marker$line$color)
+    expect_null(tr$marker$line$width)
+  }
+  expect_null(info$kwargs$layout$annotations)
+  expect_false(info$kwargs$layout$showlegend)
+})
+
+test_that("Map the time of day to different fill colors", {
+  gg <- ggplot(data=df, aes(x=time, y=total_bill, fill=time)) +
+    geom_bar(stat="identity")
+  info <- expect_traces(gg, 2, "color")
+  for(tr in info$traces){
+    expect_true(is.character(tr$marker$color))
+    expect_null(tr$marker$line$color)
+    expect_null(tr$marker$line$width)
+    expect_true(tr$showlegend)
+  }
+  expect_match(info$kwargs$layout$annotations[[1]]$text, "time")
+  expect_true(info$kwargs$layout$showlegend)
+})
+
+test_that("Add a black outline", {
+  gg <- ggplot(data=df, aes(x=time, y=total_bill, fill=time)) +
+    geom_bar(colour="black", stat="identity")
+  info <- expect_traces(gg, 2, "black-outline")
+  for(tr in info$traces){
+    expect_true(is.character(tr$marker$color))
+    expect_identical(tr$marker$line$color, toRGB("black"))
+    expect_equal(tr$marker$line$width, 1)
+    expect_true(tr$showlegend)
+  }
+  expect_match(info$kwargs$layout$annotations[[1]]$text, "time")
+  expect_true(info$kwargs$layout$showlegend)
+})
+
+test_that("guides(fill=FALSE) hides fill legend", {
+  gg <- ggplot(data=df, aes(x=time, y=total_bill, fill=time)) +
+    geom_bar(colour="black", stat="identity") +
+    guides(fill=FALSE)
+  info <- expect_traces(gg, 2, "aes-fill-guides-fill-FALSE")
+  for(tr in info$traces){
+    expect_true(is.character(tr$marker$color))
+    expect_identical(tr$marker$line$color, toRGB("black"))
+    expect_equal(tr$marker$line$width, 1)
+  }
+  expect_null(info$kwargs$layout$annotations)
+  expect_false(info$kwargs$layout$showlegend)
+})
+
+test_that('guides(fill="none") hides fill legend', {
+  gg <- ggplot(data=df, aes(x=time, y=total_bill, fill=time)) +
+    geom_bar(colour="black", stat="identity") +
+    guides(fill="none")
+  info <- expect_traces(gg, 2, "aes-fill-guides-fill-none")
+  for(tr in info$traces){
+    expect_true(is.character(tr$marker$color))
+    expect_identical(tr$marker$line$color, toRGB("black"))
+    expect_equal(tr$marker$line$width, 1)
+  }
+  expect_null(info$kwargs$layout$annotations)
+  expect_false(info$kwargs$layout$showlegend)
+})
+
+test_that('guides(colour="none") does not affect fill legend', {
+  gg <- ggplot(data=df, aes(x=time, y=total_bill, fill=time)) +
+    geom_bar(color="black", stat="identity") +
+    guides(colour="none")
+  info <- expect_traces(gg, 2, "aes-fill-guides-color-none")
+  for(tr in info$traces){
+    expect_true(is.character(tr$marker$color))
+    expect_identical(tr$marker$line$color, toRGB("black"))
+    expect_equal(tr$marker$line$width, 1)
+    expect_true(tr$showlegend)
+  }
+  expect_match(info$kwargs$layout$annotations[[1]]$text, "time")
+  expect_true(info$kwargs$layout$showlegend)
+})
+
+test_that("guides(fill=FALSE) does not affect colour legend", {
+  gg <- ggplot(data=df, aes(x=time, y=total_bill, colour=time)) +
+    geom_bar(fill="grey", stat="identity") +
+    guides(fill=FALSE)
+  info <- expect_traces(gg, 2, "aes-colour-guides-fill-FALSE")
+  for(tr in info$traces){
+    expect_identical(tr$marker$color, toRGB("grey"))
+    expect_true(is.character(tr$marker$line$color))
+    expect_equal(tr$marker$line$width, 1)
+    expect_true(tr$showlegend)
+  }
+  expect_match(info$kwargs$layout$annotations[[1]]$text, "time")
+  expect_true(info$kwargs$layout$showlegend)
+})
+