-
Notifications
You must be signed in to change notification settings - Fork 83
/
add_sub.R
118 lines (111 loc) · 5.39 KB
/
add_sub.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
#' Add annotation underneath a plot
#'
#' This function can add an arbitrary label or mathematical expression underneath
#' the plot, similar to the \code{sub} parameter in base R. It is mostly superseded now by the
#' `caption` argument to [ggplot2::labs()], and it is recommended to use `caption` instead of
#' `add_sub()` whenever possible.
#'
#' The exact location where the
#' label is placed is controlled by the parameters \code{x}, \code{y}, \code{hjust}, and
#' \code{vjust}. By default, all these parameters are set to 0.5, which places the label
#' centered underneath the plot panel. A value of \code{x = 0} indicates the left boundary
#' of the plot panel and a value of \code{x = 1} indicates the right boundary. The parameter
#' \code{hjust} works just as elsewhere in ggplot2. Thus, \code{x = 0, hjust = 0} places
#' the label left-justified at the left boundary of the plot panel, \code{x = 0.5, hjust = 0.5}
#' places the label centered underneath the plot panel, and \code{x = 1, hjust = 1} places
#' it right-justified at the right boundary of the plot panel. \code{x}-values below 0 or
#' above 1 are allowed, and they move the label beyond the limits of the plot panel.
#'
#' The \code{y} coordinates are relative to the added vertical space that is introduced
#' underneath the x-axis label to place the annotation. A value of \code{y=0} indicates
#' the bottom-most edge of that space and a value of \code{y=1} indicates the top-most
#' edge of that space. The total height of the added space is given by the height needed
#' to draw the label plus the value of \code{vpadding}. Thus, if \code{y=0, vjust=0} then
#' the extra padding is added entirely above the label, if \code{y=1, vjust=1} then the
#' extra padding is added entirely below the label, and if \code{y=0.5, vjust=0.5} (the
#' default) then the extra padding is added equally above and below the label. As is the
#' case with \code{x}, \code{y}-values outside the range 0-1 are allowed. In particular,
#' for sufficiently large values of \code{y}, the label will eventually be located inside
#' the plot panel.
#'
#' @param plot A ggplot object or gtable object derived from a ggplot object.
#' @param label The label with which the plot should be annotated. Can be a plotmath expression.
#' @param x The x position of the label
#' @param y The y position of the label
#' @param hjust Horizontal justification
#' @param vjust Vertical justification
#' @param vpadding Vertical padding. The total vertical space added to the label, given in grid
#' units. By default, this is added equally above and below the label. However, by changing the
#' y and vjust parameters, this can be changed.
#' @param fontfamily The font family
#' @param fontface The font face ("plain", "bold", etc.)
#' @param color,colour Text color
#' @param size Point size of text
#' @param angle Angle at which text is drawn
#' @param lineheight Line height of text
#' @return A gtable object holding the modified plot.
#' @examples
#' library(ggplot2)
#' theme_set(theme_half_open())
#' p1 <- ggplot(mtcars, aes(mpg, disp)) + geom_line(colour = "blue") + background_grid(minor='none')
#' ggdraw(add_sub(p1, "This is an annotation.\nAnnotations can span multiple lines."))
#'
#' # You can also do this repeatedly.
#' p2 <- add_sub(p1, "This formula has no relevance here:", y = 0, vjust = 0)
#' p3 <- add_sub(p2, expression(paste(a^2+b^2, " = ", c^2)))
#' ggdraw(p3)
#'
#' #This code also works with faceted plots:
#' plot.iris <- ggplot(iris, aes(Sepal.Length, Sepal.Width)) +
#' geom_point() + facet_grid(. ~ Species) + stat_smooth(method = "lm") +
#' background_grid(major = 'y', minor = "none") + # add thin horizontal lines
#' panel_border() # and a border around each panel
#' p2 <- add_sub(plot.iris, "Annotation underneath a faceted plot, left justified.", x = 0, hjust = 0)
#' ggdraw(p2)
#'
#' # Finally, it is possible to move the annotation inside of the plot if desired.
#' ggdraw(add_sub(p1, "Annotation inside plot", vpadding=grid::unit(0, "lines"),
#' y = 6, x = 0.03, hjust = 0))
#' @export
add_sub <- function(plot, label, x = 0.5, y = 0.5, hjust = 0.5, vjust = 0.5, vpadding = grid::unit(1, "lines"),
fontfamily = "", fontface = "plain", color = "black", size = 14, angle = 0,
lineheight = 0.9, colour)
{
if (!missing(colour)) {
color <- colour
}
text_par <- grid::gpar(col = color,
fontsize = size,
fontfamily = fontfamily,
fontface = fontface,
lineheight = lineheight)
# render the annotation
ann.grob <- grid::textGrob(label, x = grid::unit(x, "npc"), y = grid::unit(y, "npc"),
hjust = hjust, vjust = vjust, rot = angle, gp = text_par)
gt <- as_gtable(plot)
# locate xlab
xi <- gt$layout[gt$layout$name == "xlab",]
if (nrow(xi) == 1)
{
t <- xi$b+1; l <- xi$l; b <- xi$b+1; r <- xi$r
}
else
{
# if we can't locate xlab, locate title for left/right boundary
xi <- gt$layout[gt$layout$name == "title",]
if (nrow(xi) == 1)
{
t <- length(gt$heights)-1; b <- t; l <- xi$l; r <- xi$r
}
else
{
# failsave
t <- length(gt$heights)-1; b <- t; l <- 1; r <- length(gt$widths)
print(c(t,b,l,r))
}
}
g <- gtable::gtable_add_rows(gt, grid::unit(1, "grobheight", ann.grob) + vpadding, t-1)
g <- gtable::gtable_add_grob(g, ann.grob, t, l, b, r, clip = "off", name="sub")
# return
g
}