Merge pull request #1 from JanSchulz/subs

Add whole plot annotations

Author: hrbrmstr

R/labels.r

@@ -32,6 +32,11 @@ update_labels <- function(p, labels) {
 #' p + ggtitle("New plot title", subtitle = "A subtitle")
 #' p + labs(title = "New plot title", subtitle = "A subtitle")
 #'
+#' # Can add plot annotations underneath the whole plot (for sources, notes or
+#' # copyright), similar to the \code{sub} parameter in base R, with the
+#' # following
+#' p + labs(sub = "(based on data from ...)")
+#'
 #' # This should work independently of other functions that modify the
 #' # the scale names
 #' p + ylab("New y label") + ylim(2, 4)

R/plot-build.r

@@ -254,6 +254,10 @@ ggplot_gtable <- function(data) {
   subtitle <- element_render(theme, "plot.subtitle", plot$labels$subtitle, expand_y = TRUE)
   subtitle_height <- grobHeight(subtitle)
 
+  # whole plot annotation
+  annotation <- element_render(theme, "plot.annotation", plot$labels$annotation, expand_y = TRUE)
+  annotation_height <- grobHeight(annotation)
+
   pans <- plot_table$layout[grepl("^panel", plot_table$layout$name), ,
     drop = FALSE]
 
@@ -265,6 +269,10 @@ ggplot_gtable <- function(data) {
   plot_table <- gtable_add_grob(plot_table, title, name = "title",
     t = 1, b = 1, l = min(pans$l), r = max(pans$r), clip = "off")
 
+  plot_table <- gtable_add_rows(plot_table, annotation_height, pos = -1)
+  plot_table <- gtable_add_grob(plot_table, annotation, name = "annotation",
+    t = -1, b = -1, l = min(pans$l), r = max(pans$r), clip = "off")
+
   # Margins
   plot_table <- gtable_add_rows(plot_table, theme$plot.margin[1], pos = 0)
   plot_table <- gtable_add_cols(plot_table, theme$plot.margin[2])

R/theme-defaults.r

@@ -134,6 +134,11 @@ theme_grey <- function(base_size = 11, base_family = "") {
                            hjust = 0,
                            margin = margin(b = half_line * 0.9)
                          ),
+    plot.annotation =    element_text(
+                           size = rel(0.9),
+                           hjust = 0,
+                           margin = margin(b = half_line * 0.9)
+                         ),
     plot.margin =        margin(half_line, half_line, half_line, half_line),
 
     complete = TRUE

R/theme-elements.r

@@ -279,6 +279,7 @@ el_def <- function(class = NULL, inherit = NULL, description = NULL) {
   plot.background     = el_def("element_rect", "rect"),
   plot.title          = el_def("element_text", "title"),
   plot.subtitle       = el_def("element_text", "title"),
+  plot.annotation     = el_def("element_text", "title"),
   plot.margin         = el_def("margin"),
 
   aspect.ratio        = el_def("character")

R/theme.r

@@ -189,7 +189,10 @@ print.theme <- function(x, ...) utils::str(x)
 #'   plot.title       \tab plot title (text appearance)
 #'                    (\code{element_text}; inherits from \code{title})
 #'                    left-aligned by default\cr
-#'   plot.subtitle    \tab plot title (text appearance)
+#'   plot.subtitle    \tab plot subtitle (text appearance)
+#'                    (\code{element_text}; inherits from \code{title})
+#'                    left-aligned by default\cr
+#'   plot.sub         \tab annotations below the plot (text appearance)
 #'                    (\code{element_text}; inherits from \code{title})
 #'                    left-aligned by default\cr
 #'   plot.margin      \tab margin around entire plot

tests/testthat/test-labels.r

@@ -13,6 +13,11 @@ test_that("Setting guide labels", {
     expect_identical(labs(title = "my title",
                           subtitle = "my subtitle")$subtitle, "my subtitle")
 
+    # whole plot annotations
+    expect_identical(labs(annotation = "my notice")$annotation, "my notice")
+    expect_identical(labs(title = "my title",
+                          annotation = "my notice")$annotation, "my notice")
+
     # Colour
     expect_identical(labs(colour = "my label")$colour, "my label")
     # American spelling