Merge pull request #1582 from hrbrmstr/master

Subtitles for ggplot2

Author: hadley

.gitignore

@@ -3,3 +3,4 @@
 .RData
 inst/doc
 .httr-oauth
+.*.Rnb.cached

NEWS.md

@@ -1,9 +1,22 @@
-# ggplot2 2.1.0.9000
+# ggplot2 2.1.0.9000 
 
 * `x` and `y` scales are now symmetric regarding the list of
   aesthetics they accept: `xmin_final`, `xmax_final`, `xlower`,
   `xmiddle` and `xupper` are now valid `x` aesthetics.
 
+* `ggtitle()` and `labs()` take a `subtitle` parameter which makes it
+  possible to add a subtitle below the main plot title. (@hrbrmstr)
+  
+* `labs()` takes a `caption` parameter that will set the label for
+  the annotation text below the plot panels. (@JanSchulz)
+  
+* The main plot title and subtitle are left-justified (`hjust = 0`) by
+  default. The `caption` annotation below the plot will be right-justified
+  by default. (@hrbrmstr)
+  
+* Minor code formatting issues in examples and function parameters were
+  fixed. (@hrbrmstr)
+
 # ggplot2 2.1.0
 
 ## New features

R/coord-map.r

@@ -46,7 +46,7 @@
 #'
 #' # Other projections
 #' nzmap + coord_map("cylindrical")
-#' nzmap + coord_map("azequalarea",orientation=c(-36.92,174.6,0))
+#' nzmap + coord_map("azequalarea", orientation = c(-36.92,174.6,0))
 #'
 #' states <- map_data("state")
 #' usamap <- ggplot(states, aes(long, lat, group = group)) +
@@ -71,7 +71,7 @@
 #'
 #' # World map, using geom_path instead of geom_polygon
 #' world <- map_data("world")
-#' worldmap <- ggplot(world, aes(x=long, y=lat, group=group)) +
+#' worldmap <- ggplot(world, aes(x = long, y = lat, group = group)) +
 #'   geom_path() +
 #'   scale_y_continuous(breaks = (-2:2) * 30) +
 #'   scale_x_continuous(breaks = (-4:4) * 45)

R/geom-polygon.r

@@ -31,9 +31,9 @@
 #' )
 #'
 #' # Currently we need to manually merge the two together
-#' datapoly <- merge(values, positions, by=c("id"))
+#' datapoly <- merge(values, positions, by = c("id"))
 #'
-#' (p <- ggplot(datapoly, aes(x=x, y=y)) + geom_polygon(aes(fill=value, group=id)))
+#' (p <- ggplot(datapoly, aes(x = x, y = y)) + geom_polygon(aes(fill = value, group = id)))
 #'
 #' # Which seems like a lot of work, but then it's easy to add on
 #' # other features in this coordinate system, e.g.:
@@ -43,7 +43,7 @@
 #'   y = cumsum(runif(50,max = 0.1))
 #' )
 #'
-#' p + geom_line(data = stream, colour="grey30", size = 5)
+#' p + geom_line(data = stream, colour = "grey30", size = 5)
 #'
 #' # And if the positions are in longitude and latitude, you can use
 #' # coord_map to produce different map projections.

R/guide-colorbar.r

@@ -75,7 +75,7 @@
 #' p1 + guides(fill = guide_colorbar(nbin = 100))
 #'
 #' # make top- and bottom-most ticks invisible
-#' p1 + scale_fill_continuous(limits = c(0,20), breaks=c(0, 5, 10, 15, 20),
+#' p1 + scale_fill_continuous(limits = c(0,20), breaks = c(0, 5, 10, 15, 20),
 #'  guide = guide_colorbar(nbin=100, draw.ulim = FALSE, draw.llim = FALSE))
 #'
 #' # guides can be controlled independently

R/labels.r

@@ -15,9 +15,12 @@ update_labels <- function(p, labels) {
   p
 }
 
-#' Change axis labels and legend titles
+#' Change axis labels, legend titles, plot title/subtitle and below-plot
+#' caption.
 #'
-#' @param label The text for the axis or plot title.
+#' @param label The text for the axis, plot title or caption below the plot.
+#' @param subtitle the text for the subtitle for the plot which will be
+#'        displayed below the title. Leave \code{NULL} for no subtitle.
 #' @param ... a list of new names in the form aesthetic = "new name"
 #' @export
 #' @examples
@@ -28,6 +31,15 @@ update_labels <- function(p, labels) {
 #' p + ylab("New y label")
 #' p + ggtitle("New plot title")
 #'
+#' # Can add a subtitle to plots with either of the following
+#' p + ggtitle("New plot title", subtitle = "A subtitle")
+#' p + labs(title = "New plot title", subtitle = "A subtitle")
+#'
+#' # Can add a plot caption underneath the whole plot (for sources, notes or
+#' # copyright), similar to the \code{sub} parameter in base R, with the
+#' # following
+#' p + labs(caption = "(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)
@@ -38,7 +50,7 @@ update_labels <- function(p, labels) {
 #' p + labs(colour = "Cylinders")
 #'
 #' # Can also pass in a list, if that is more convenient
-#' p + labs(list(title = "Title", x = "X", y = "Y"))
+#' p + labs(list(title = "Title", subtitle = "Subtitle", x = "X", y = "Y"))
 labs <- function(...) {
   args <- list(...)
   if (is.list(args[[1]])) args <- args[[1]]
@@ -51,15 +63,17 @@ labs <- function(...) {
 xlab <- function(label) {
   labs(x = label)
 }
+
 #' @rdname labs
 #' @export
 ylab <- function(label) {
   labs(y = label)
 }
+
 #' @rdname labs
 #' @export
-ggtitle <- function(label) {
-  labs(title = label)
+ggtitle <- function(label, subtitle = NULL) {
+  labs(title = label, subtitle = subtitle)
 }
 
 # Convert aesthetic mapping into text labels

R/plot-build.r

@@ -250,13 +250,29 @@ ggplot_gtable <- function(data) {
   title <- element_render(theme, "plot.title", plot$labels$title, expand_y = TRUE)
   title_height <- grobHeight(title)
 
+  # Subtitle
+  subtitle <- element_render(theme, "plot.subtitle", plot$labels$subtitle, expand_y = TRUE)
+  subtitle_height <- grobHeight(subtitle)
+
+  # whole plot annotation
+  caption <- element_render(theme, "plot.caption", plot$labels$caption, expand_y = TRUE)
+  caption_height <- grobHeight(caption)
+
   pans <- plot_table$layout[grepl("^panel", plot_table$layout$name), ,
     drop = FALSE]
 
+  plot_table <- gtable_add_rows(plot_table, subtitle_height, pos = 0)
+  plot_table <- gtable_add_grob(plot_table, subtitle, name = "subtitle",
+    t = 1, b = 1, l = min(pans$l), r = max(pans$r), clip = "off")
+
   plot_table <- gtable_add_rows(plot_table, title_height, pos = 0)
   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, caption_height, pos = -1)
+  plot_table <- gtable_add_grob(plot_table, caption, name = "caption",
+    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/position-dodge.r

@@ -15,7 +15,7 @@
 #' # see ?geom_boxplot and ?geom_bar for more examples
 #'
 #' # To dodge items with different widths, you need to be explicit
-#' df <- data.frame(x=c("a","a","b","b"), y=2:5, g = rep(1:2, 2))
+#' df <- data.frame(x = c("a","a","b","b"), y = 2:5, g = rep(1:2, 2))
 #' p <- ggplot(df, aes(x, y, group = g)) +
 #'   geom_bar(
 #'     stat = "identity", position = "dodge",

R/quick-plot.r

@@ -31,7 +31,7 @@
 #' \donttest{
 #' qplot(1:10, rnorm(10), colour = runif(10))
 #' qplot(1:10, letters[1:10])
-#' mod <- lm(mpg ~ wt, data=mtcars)
+#' mod <- lm(mpg ~ wt, data = mtcars)
 #' qplot(resid(mod), fitted(mod))
 #'
 #' f <- function() {
@@ -57,7 +57,7 @@
 #' qplot(factor(cyl), wt, data = mtcars, geom = c("boxplot", "jitter"))
 #' qplot(mpg, data = mtcars, geom = "dotplot")
 #' }
-qplot <- function(x, y = NULL, ..., data, facets = NULL, margins=FALSE,
+qplot <- function(x, y = NULL, ..., data, facets = NULL, margins = FALSE,
                   geom = "auto", xlim = c(NA, NA),
                   ylim = c(NA, NA), log = "", main = NULL,
                   xlab = deparse(substitute(x)), ylab = deparse(substitute(y)),

R/scale-discrete-.r

@@ -30,7 +30,7 @@
 #'
 #' # Use limits to adjust the which levels (and in what order)
 #' # are displayed
-#' d + scale_x_discrete(limits=c("Fair","Ideal"))
+#' d + scale_x_discrete(limits = c("Fair","Ideal"))
 #'
 #' # you can also use the short hand functions xlim and ylim
 #' d + xlim("Fair","Ideal", "Good")

R/scale-hue.r

@@ -21,16 +21,16 @@
 #' d + scale_colour_hue(expression(clarity[beta]))
 #'
 #' # Adjust luminosity and chroma
-#' d + scale_colour_hue(l=40, c=30)
-#' d + scale_colour_hue(l=70, c=30)
-#' d + scale_colour_hue(l=70, c=150)
-#' d + scale_colour_hue(l=80, c=150)
+#' d + scale_colour_hue(l = 40, c = 30)
+#' d + scale_colour_hue(l = 70, c = 30)
+#' d + scale_colour_hue(l = 70, c = 150)
+#' d + scale_colour_hue(l = 80, c = 150)
 #'
 #' # Change range of hues used
-#' d + scale_colour_hue(h=c(0, 90))
-#' d + scale_colour_hue(h=c(90, 180))
-#' d + scale_colour_hue(h=c(180, 270))
-#' d + scale_colour_hue(h=c(270, 360))
+#' d + scale_colour_hue(h = c(0, 90))
+#' d + scale_colour_hue(h = c(90, 180))
+#' d + scale_colour_hue(h = c(180, 270))
+#' d + scale_colour_hue(h = c(270, 360))
 #'
 #' # Vary opacity
 #' # (only works with pdf, quartz and cairo devices)

R/stat-summary.r

@@ -70,7 +70,7 @@
 #'
 #' # A set of useful summary functions is provided from the Hmisc package:
 #' stat_sum_df <- function(fun, geom="crossbar", ...) {
-#'   stat_summary(fun.data=fun, colour="red", geom=geom, width=0.2, ...)
+#'   stat_summary(fun.data = fun, colour = "red", geom = geom, width = 0.2, ...)
 #' }
 #' d <- ggplot(mtcars, aes(cyl, mpg)) + geom_point()
 #' # The crossbar geom needs grouping to be specified when used with
@@ -84,7 +84,7 @@
 #' if (require("ggplot2movies")) {
 #' set.seed(596)
 #' mov <- movies[sample(nrow(movies), 1000), ]
-#'  m2 <- ggplot(mov, aes(x= factor(round(rating)), y=votes)) + geom_point()
+#'  m2 <- ggplot(mov, aes(x = factor(round(rating)), y = votes)) + geom_point()
 #'  m2 <- m2 + stat_summary(fun.data = "mean_cl_boot", geom = "crossbar",
 #'                          colour = "red", width = 0.3) + xlab("rating")
 #' m2

R/theme-defaults.r

@@ -42,7 +42,7 @@
 #'
 #' @examples
 #' p <- ggplot(mtcars) + geom_point(aes(x = wt, y = mpg,
-#'      colour=factor(gear))) + facet_wrap(~am)
+#'      colour = factor(gear))) + facet_wrap(~am)
 #'
 #' p
 #' p + theme_gray()
@@ -126,8 +126,19 @@ theme_grey <- function(base_size = 11, base_family = "") {
     plot.background =    element_rect(colour = "white"),
     plot.title =         element_text(
                            size = rel(1.2),
+                           hjust = 0,
                            margin = margin(b = half_line * 1.2)
                          ),
+    plot.subtitle =      element_text(
+                           size = rel(0.9),
+                           hjust = 0,
+                           margin = margin(b = half_line * 0.9)
+                         ),
+    plot.caption =       element_text(
+                           size = rel(0.9),
+                           hjust = 1,
+                           margin = margin(b = half_line * 0.9)
+                         ),
     plot.margin =        margin(half_line, half_line, half_line, half_line),
 
     complete = TRUE

R/theme-elements.r

@@ -278,6 +278,8 @@ 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.caption        = el_def("element_text", "title"),
   plot.margin         = el_def("margin"),
 
   aspect.ratio        = el_def("character")

R/theme.r

@@ -187,7 +187,14 @@ print.theme <- function(x, ...) utils::str(x)
 #'   plot.background  \tab background of the entire plot
 #'                    (\code{element_rect}; inherits from \code{rect}) \cr
 #'   plot.title       \tab plot title (text appearance)
-#'                    (\code{element_text}; inherits from \code{title}) \cr
+#'                    (\code{element_text}; inherits from \code{title})
+#'                    left-aligned by default\cr
+#'   plot.subtitle    \tab plot subtitle (text appearance)
+#'                    (\code{element_text}; inherits from \code{title})
+#'                    left-aligned by default\cr
+#'   plot.caption     \tab caption below the plot (text appearance)
+#'                    (\code{element_text}; inherits from \code{title})
+#'                    right-aligned by default\cr
 #'   plot.margin      \tab margin around entire plot
 #'                    (\code{unit} with the sizes of the top, right, bottom, and
 #'                     left margins) \cr
@@ -254,6 +261,11 @@ print.theme <- function(x, ...) utils::str(x)
 #' p + theme(plot.title = element_text(size = rel(2)))
 #' p + theme(plot.title = element_text(size = rel(2), colour = "blue"))
 #'
+#' # Add a subtitle and adjust bottom margin
+#' p + labs(title = "Vehicle Weight-Gas Mileage Relationship",
+#'          subtitle = "You need to wrap long subtitleson manually") +
+#'     theme(plot.subtitle = element_text(margin = margin(b = 20)))
+#'
 #' # Changing plot look with themes
 #' DF <- data.frame(x = rnorm(400))
 #' m <- ggplot(DF, aes(x = x)) +

R/utilities.r

@@ -77,7 +77,8 @@ uniquecols <- function(df) {
 #' @param finite If \code{TRUE}, will also remove non-finite values.
 #' @keywords internal
 #' @export
-remove_missing <- function(df, na.rm=FALSE, vars = names(df), name="", finite = FALSE) {
+remove_missing <- function(df, na.rm = FALSE, vars = names(df), name = "",
+                           finite = FALSE) {
   stopifnot(is.logical(na.rm))
 
   vars <- intersect(vars, names(df))