Move legend drawing functions out of Geom objects

tidyverse · Jul 22, 2015 · c9c6fb1 · c9c6fb1
1 parent 53c0023
commit c9c6fb1
Show file tree

Hide file tree

Showing 30 changed files with 173 additions and 167 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -52,6 +52,7 @@ Collate:
     'aes-linetype-size-shape.r'
     'aes-position.r'
     'aes.r'
+    'legend-draw.r'
     'geom-.r'
     'annotation-custom.r'
     'annotation-logticks.r'

diff --git a/R/geom-.r b/R/geom-.r
@@ -1,3 +1,5 @@
+#' @include legend-draw.r
+
 Geom <- proto2("Geom", TopLevel,
   class = function(self) "geom",
 
@@ -17,7 +19,7 @@ Geom <- proto2("Geom", TopLevel,
 
   default_aes = aes(),
 
-  guide_geom = function(self) "point",
+  guide_geom = legend_point,
 
   draw = function(self, ...) {},
 

diff --git a/R/geom-abline.r b/R/geom-abline.r
@@ -115,18 +115,5 @@ GeomAbline <- proto2("GeomAbline", Geom,
   default_aes = aes(colour = "black", size = 0.5, linetype = 1, alpha = NA),
   required_aes = c("slope", "intercept"),
 
-  guide_geom = function(self) "abline",
-  draw_legend = function(self, data, ...) {
-    data <- aesdefaults(data, self$default_aes, list(...))
-    ggname(self$my_name(),
-      segmentsGrob(0, 0, 1, 1, default.units = "npc",
-        gp = gpar(
-          col = alpha(data$colour, data$alpha),
-          lwd = data$size * .pt,
-          lty = data$linetype,
-          lineend = "butt"
-        )
-      )
-    )
-  }
+  guide_geom = legend_abline
 )
diff --git a/R/geom-bar-.r b/R/geom-bar-.r
@@ -163,5 +163,6 @@ GeomBar <- proto2("GeomBar", Geom,
   draw_groups = function(self, data, scales, coordinates, ...) {
     GeomRect$draw_groups(data, scales, coordinates, ...)
   },
-  guide_geom = function(self) "polygon"
+
+  guide_geom = legend_polygon
 )
diff --git a/R/geom-blank.r b/R/geom-blank.r
@@ -38,9 +38,5 @@ geom_blank <- function (mapping = NULL, data = NULL, stat = "identity",
 
 
 GeomBlank <- proto2("GeomBlank", Geom,
-  default_aes = aes(),
-
-  draw_legend = function(self, data, ...) {
-    zeroGrob()
-  }
+  default_aes = aes()
 )
diff --git a/R/geom-boxplot.r b/R/geom-boxplot.r
@@ -192,18 +192,7 @@ GeomBoxplot <- proto2("GeomBoxplot", Geom,
     ))
   },
 
-  guide_geom = function(self) "boxplot",
-
-  draw_legend = function(self, data, ...)  {
-    data <- aesdefaults(data, self$default_aes, list(...))
-    gp <- with(data, gpar(col=colour, fill=alpha(fill, alpha), lwd=size * .pt, lty = linetype))
-    gTree(gp = gp, children = gList(
-      linesGrob(0.5, c(0.1, 0.25)),
-      linesGrob(0.5, c(0.75, 0.9)),
-      rectGrob(height=0.5, width=0.75),
-      linesGrob(c(0.125, 0.875), 0.5)
-    ))
-  },
+  guide_geom = legend_boxplot,
 
   default_aes = aes(weight = 1, colour = "grey20", fill = "white", size = 0.5,
     alpha = NA, shape = 19, linetype = "solid", outlier.colour = "black",

diff --git a/R/geom-crossbar.r b/R/geom-crossbar.r
@@ -38,16 +38,7 @@ GeomCrossbar <- proto2("GeomCrossbar", Geom,
 
   required_aes = c("x", "y", "ymin", "ymax"),
 
-  guide_geom = function(self) "crossbar",
-
-  draw_legend = function(self, data, ...)  {
-    data <- aesdefaults(data, self$default_aes, list(...))
-    gp <- with(data, gpar(col=colour, fill=alpha(fill, alpha), lwd=size * .pt, lty = linetype))
-    gTree(gp = gp, children = gList(
-      rectGrob(height=0.5, width=0.75),
-      linesGrob(c(0.125, 0.875), 0.5)
-    ))
-  },
+  guide_geom = legend_crossbar,
 
   draw = function(self, data, scales, coordinates, fatten = 2.5, width = NULL, ...) {
     middle <- transform(data, x = xmin, xend = xmax, yend = y, size = size * fatten, alpha = NA)

diff --git a/R/geom-curve.r b/R/geom-curve.r
@@ -57,5 +57,5 @@ GeomCurve <- proto2("GeomCurve", Geom,
 
   default_aes = aes(colour = "black", size = 0.5, linetype = 1, alpha = NA),
 
-  guide_geom = function(self) "path"
+  guide_geom = legend_path
 )
diff --git a/R/geom-dotplot.r b/R/geom-dotplot.r
@@ -236,21 +236,7 @@ GeomDotplot <- proto2("GeomDotplot", Geom,
     )
   },
 
-  guide_geom = function(self) "dotplot",
-
-  draw_legend = function(self, data, ...) {
-    data$shape <- 21
-
-    data <- aesdefaults(data, self$default_aes, list(...))
-
-    with(data,
-      pointsGrob(0.5, 0.5, size = unit(.5, "npc"), pch = shape,
-        gp = gpar(
-          col = alpha(colour, alpha),
-          fill = alpha(fill, alpha))
-      )
-    )
-  },
+  guide_geom = legend_dotplot,
 
   required_aes = c("x", "y"),
 

diff --git a/R/geom-errorbar.r b/R/geom-errorbar.r
@@ -67,7 +67,7 @@ GeomErrorbar <- proto2("GeomErrorbar", Geom,
   default_aes = aes(colour = "black", size = 0.5, linetype = 1, width = 0.5,
     alpha = NA),
 
-  guide_geom = function(self) "path",
+  guide_geom = legend_path,
 
   required_aes = c("x", "ymin", "ymax"),
 

diff --git a/R/geom-errorbarh.r b/R/geom-errorbarh.r
@@ -41,7 +41,7 @@ GeomErrorbarh <- proto2("GeomErrorbarh", Geom,
   default_aes = aes(colour = "black", size = 0.5, linetype = 1, height = 0.5,
     alpha = NA),
 
-  guide_geom = function(self) "path",
+  guide_geom = legend_path,
 
   required_aes = c("x", "xmin", "xmax", "y"),
 

diff --git a/R/geom-hex.r b/R/geom-hex.r
@@ -35,7 +35,7 @@ GeomHex <- proto2("GeomHex", Geom,
 
   default_aes = aes(colour=NA, fill = "grey50", size=0.5, alpha = NA),
 
-  guide_geom = function(self) "polygon"
+  guide_geom = legend_polygon
 )
 
 

diff --git a/R/geom-hline.r b/R/geom-hline.r
@@ -40,5 +40,5 @@ GeomHline <- proto2("GeomHline", Geom,
   default_aes = aes(colour = "black", size = 0.5, linetype = 1, alpha = NA),
   required_aes = "yintercept",
 
-  guide_geom = function(self) "path"
+  guide_geom = legend_path
 )
diff --git a/R/geom-linerange.r b/R/geom-linerange.r
@@ -50,7 +50,7 @@ geom_linerange <- function (mapping = NULL, data = NULL, stat = "identity",
 GeomLinerange <- proto2("GeomLinerange", Geom,
   default_aes = aes(colour = "black", size = 0.5, linetype = 1, alpha = NA),
 
-  guide_geom = function(self) "path",
+  guide_geom = legend_path,
 
   required_aes = c("x", "ymin", "ymax"),
 

diff --git a/R/geom-path-.r b/R/geom-path-.r
@@ -205,20 +205,9 @@ GeomPath <- proto2("GeomPath", Geom,
     }
   },
 
-  draw_legend = function(self, data, ...) {
-    data$arrow <- NULL
-    data <- aesdefaults(data, self$default_aes, list(...))
-
-    with(data,
-      ggname(self$my_name(), segmentsGrob(0.1, 0.5, 0.9, 0.5, default.units="npc",
-      gp=gpar(col=alpha(colour, alpha), lwd=size * .pt,
-        lty=linetype, lineend="butt")))
-    )
-  },
-
   required_aes = c("x", "y"),
 
   default_aes = aes(colour = "black", size = 0.5, linetype = 1, alpha = NA),
 
-  guide_geom = function(self) "path"
+  guide_geom = legend_path
 )
diff --git a/R/geom-point-.r b/R/geom-point-.r
@@ -159,20 +159,7 @@ GeomPoint <- proto2("GeomPoint", Geom,
     )
   },
 
-  draw_legend = function(self, data, ...) {
-    data <- aesdefaults(data, self$default_aes, list(...))
-
-    pointsGrob(
-      0.5, 0.5,
-      pch = data$shape,
-      gp = gpar(
-        col = alpha(data$colour, data$alpha),
-        fill = alpha(data$fill, data$alpha),
-        fontsize = data$size * .pt + data$stroke * .stroke / 2,
-        lwd = data$stroke * .stroke / 2
-      )
-    )
-  },
+  guide_geom = legend_point,
 
   required_aes = c("x", "y"),
   default_aes = aes(shape = 19, colour = "black", size = 2, fill = NA,

diff --git a/R/geom-pointrange.r b/R/geom-pointrange.r
@@ -32,7 +32,7 @@ GeomPointrange <- proto2("GeomPointrange", Geom,
   default_aes = aes(colour = "black", size = 0.5, linetype = 1, shape = 19,
     fill = NA, alpha = NA, stroke = 1),
 
-  guide_geom = function(self) "pointrange",
+  guide_geom = legend_pointrange,
 
   required_aes = c("x", "y", "ymin", "ymax"),
 
@@ -45,14 +45,5 @@ GeomPointrange <- proto2("GeomPointrange", Geom,
         GeomPoint$draw(transform(data, size = size * 4), scales, coordinates, ...)
       ))
     )
-  },
-
-  draw_legend = function(self, data, ...) {
-    data <- aesdefaults(data, self$default_aes, list(...))
-
-    grobTree(
-      GeomPath$draw_legend(data, ...),
-      GeomPoint$draw_legend(transform(data, size = size * 4), ...)
-    )
   }
 )
diff --git a/R/geom-polygon.r b/R/geom-polygon.r
@@ -101,15 +101,6 @@ GeomPolygon <- proto2("GeomPolygon", Geom,
 
   required_aes = c("x", "y"),
 
-  guide_geom = function(self) "polygon",
-
-  draw_legend = function(self, data, ...)  {
-    data <- aesdefaults(data, self$default_aes, list(...))
-
-    with(data, grobTree(
-      rectGrob(gp = gpar(col = colour, fill = alpha(fill, alpha), lty = linetype)),
-      linesGrob(gp = gpar(col = colour, lwd = size * .pt, lineend="butt", lty = linetype))
-    ))
-  }
+  guide_geom = legend_polygon
 )
 
diff --git a/R/geom-raster.r b/R/geom-raster.r
@@ -126,5 +126,5 @@ GeomRaster <- proto2("GeomRaster", Geom,
 
   required_aes = c("x", "y"),
 
-  guide_geom = function(self) "polygon"
+  guide_geom = legend_polygon
 )
diff --git a/R/geom-rect.r b/R/geom-rect.r
@@ -65,7 +65,7 @@ GeomRect <- proto2("GeomRect", Geom,
 
   draw_groups = function(self, ...) self$draw(...),
 
-  guide_geom = function(self) "polygon"
+  guide_geom = legend_polygon
 )
 
 

diff --git a/R/geom-ribbon-.r b/R/geom-ribbon-.r
@@ -51,7 +51,7 @@ GeomRibbon <- proto2("GeomRibbon", Geom,
 
   required_aes = c("x", "ymin", "ymax"),
 
-  guide_geom = function(self) "polygon",
+  guide_geom = legend_polygon,
 
   draw = function(self, data, scales, coordinates, na.rm = FALSE, ...) {
     if (na.rm) data <- data[complete.cases(data[self$required_aes]), ]

diff --git a/R/geom-rug.r b/R/geom-rug.r
@@ -81,5 +81,5 @@ GeomRug <- proto2("GeomRug", Geom,
 
   default_aes = aes(colour = "black", size = 0.5, linetype = 1, alpha = NA),
 
-  guide_geom = function(self) "path"
+  guide_geom = legend_path
 )
diff --git a/R/geom-segment.r b/R/geom-segment.r
@@ -93,5 +93,6 @@ GeomSegment <- proto2("GeomSegment", Geom,
 
   required_aes = c("x", "y", "xend", "yend"),
   default_aes = aes(colour = "black", size = 0.5, linetype = 1, alpha = NA),
-  guide_geom = function(self) "path"
+
+  guide_geom = legend_path
 )
diff --git a/R/geom-smooth.r b/R/geom-smooth.r
@@ -105,25 +105,10 @@ GeomSmooth <- proto2("GeomSmooth", Geom,
     )
   },
 
-  guide_geom = function(self) "smooth",
+  guide_geom = legend_smooth,
 
   required_aes = c("x", "y"),
 
   default_aes = aes(colour = "#3366FF", fill = "grey60", size = 1,
-    linetype = 1, weight = 1, alpha = 0.4),
-
-  draw_legend = function(self, data, params, ...) {
-    data <- aesdefaults(data, self$default_aes, list(...))
-    data$fill <- alpha(data$fill, data$alpha)
-    data$alpha <- 1
-
-    if (is.null(params$se) || params$se) {
-      gTree(children = gList(
-        rectGrob(gp = gpar(col = NA, fill = data$fill)),
-        GeomPath$draw_legend(data, ...)
-      ))
-    } else {
-      GeomPath$draw_legend(data, ...)
-    }
-  }
+    linetype = 1, weight = 1, alpha = 0.4)
 )
diff --git a/R/geom-text.r b/R/geom-text.r
@@ -132,25 +132,12 @@ GeomText <- proto2("GeomText", Geom,
     )
   },
 
-  draw_legend = function(self, data, ...) {
-    data <- aesdefaults(data, self$default_aes, list(...))
-    textGrob(
-      "a", 0.5, 0.5,
-      rot = data$angle,
-      gp = gpar(
-        col = alpha(data$colour, data$alpha),
-        fontsize = data$size * .pt
-      )
-    )
-  },
-
-
   required_aes = c("x", "y", "label"),
 
   default_aes = aes(colour = "black", size = 5, angle = 0, hjust = 0.5,
     vjust = 0.5, alpha = NA, family = "", fontface = 1, lineheight = 1.2),
 
-  guide_geom = function(self, x) "text"
+  guide_geom = legend_text
 )
 
 compute_just <- function(just, x) {

diff --git a/R/geom-violin.r b/R/geom-violin.r
@@ -106,7 +106,7 @@ GeomViolin <- proto2("GeomViolin", Geom,
     ggname(self$my_name(), GeomPolygon$draw(newdata, ...))
   },
 
-  guide_geom = function(self) "polygon",
+  guide_geom = legend_polygon,
 
   default_aes = aes(weight=1, colour="grey20", fill="white", size=0.5,
     alpha = NA, linetype = "solid"),

diff --git a/R/geom-vline.r b/R/geom-vline.r
@@ -40,21 +40,5 @@ GeomVline <- proto2("GeomVline", Geom,
   default_aes = aes(colour = "black", size = 0.5, linetype = 1, alpha = NA),
   required_aes = "xintercept",
 
-  guide_geom = function(self) "vline",
-
-  draw_legend = function(self, data, ...) {
-    data <- aesdefaults(data, self$default_aes, list(...))
-
-    ggname(
-      self$my_name(),
-      segmentsGrob(0.5, 0, 0.5, 1, default.units = "npc",
-        gp = gpar(
-          col = alpha(data$colour, data$alpha),
-          lwd = data$size * .pt,
-          lty = data$linetype,
-          lineend = "butt"
-        )
-      )
-    )
-  }
+  guide_geom = legend_vline
 )