Skip to content

Commit 9cefab7

Browse files
thomasp85hadley
thomasp85
authored and
hadley
committed
Add tag label for adding identifier to plot (#2405)
* Add tag label for adding identifier to plot * Add plot.tag.position and modify default themes accordingly * Fix interplay between margin and justification * Set default tag size to rel(1.2) * Add brief description of use * Better error message * Fix wording in documentation * Add a few visual tests * Use justify_grobs for tag justification * Add generated visual test figures * Don't assign into unit vectors to avoid weird grid bug in R 3.2 (and possibly older) * Add comment describing the reason for the slightly weird reassembly of widths and heights * Fix visual tests for AppVeyor
1 parent f357128 commit 9cefab7

File tree

10 files changed

+335
-4
lines changed

10 files changed

+335
-4
lines changed

‎NEWS.md

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -76,6 +76,12 @@
7676
* Added `stat_qq_line()` to make it easy to add a simple line to a Q-Q plot. This
7777
line makes it easier to judge the fit of the theoretical distribution
7878
(@nicksolomon).
79+
80+
* Added `tag` label for adding identification tags to the plot. A tag is added
81+
with the `labs()` function and styling is handled through the `plot.tag` theme
82+
element. Position is specified with the `plot.tag.position` theme setting and
83+
defauls to `"topleft"`. Tags are useful for identifying subplots in a
84+
multiplot figure and often used in the scientific literature (@thomasp85).
7985

8086
### Scales
8187

‎R/plot-build.r

Lines changed: 74 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -242,6 +242,11 @@ ggplot_gtable.ggplot_built <- function(data) {
242242
subtitle <- element_render(theme, "plot.subtitle", plot$labels$subtitle, margin_y = TRUE)
243243
subtitle_height <- grobHeight(subtitle)
244244

245+
# Tag
246+
tag <- element_render(theme, "plot.tag", plot$labels$tag, margin_y = TRUE, margin_x = TRUE)
247+
tag_height <- grobHeight(tag)
248+
tag_width <- grobWidth(tag)
249+
245250
# whole plot annotation
246251
caption <- element_render(theme, "plot.caption", plot$labels$caption, margin_y = TRUE)
247252
caption_height <- grobHeight(caption)
@@ -261,6 +266,75 @@ ggplot_gtable.ggplot_built <- function(data) {
261266
plot_table <- gtable_add_grob(plot_table, caption, name = "caption",
262267
t = -1, b = -1, l = min(pans$l), r = max(pans$r), clip = "off")
263268

269+
plot_table <- gtable_add_rows(plot_table, unit(0, 'pt'), pos = 0)
270+
plot_table <- gtable_add_cols(plot_table, unit(0, 'pt'), pos = 0)
271+
plot_table <- gtable_add_rows(plot_table, unit(0, 'pt'), pos = -1)
272+
plot_table <- gtable_add_cols(plot_table, unit(0, 'pt'), pos = -1)
273+
274+
tag_pos <- theme$plot.tag.position
275+
if (length(tag_pos) == 2) tag_pos <- "manual"
276+
valid_pos <- c("topleft", "top", "topright", "left", "right", "bottomleft",
277+
"bottom", "bottomright")
278+
if (!(tag_pos == "manual" || tag_pos %in% valid_pos)) {
279+
stop("plot.tag.position should be a coordinate or one of ",
280+
paste(valid_pos, collapse = ', '), call. = FALSE)
281+
}
282+
283+
if (tag_pos == "manual") {
284+
xpos <- theme$plot.tag.position[1]
285+
ypos <- theme$plot.tag.position[2]
286+
tag_parent <- justify_grobs(tag, x = xpos, y = ypos,
287+
hjust = theme$plot.tag$hjust,
288+
vjust = theme$plot.tag$vjust,
289+
debug = theme$plot.tag$debug)
290+
plot_table <- gtable_add_grob(plot_table, tag_parent, name = "tag", t = 1,
291+
b = nrow(plot_table), l = 1,
292+
r = ncol(plot_table), clip = "off")
293+
} else {
294+
# Widths and heights are reassembled below instead of assigning into them
295+
# in order to avoid bug in grid 3.2 and below.
296+
if (tag_pos == "topleft") {
297+
plot_table$widths <- unit.c(tag_width, plot_table$widths[-1])
298+
plot_table$heights <- unit.c(tag_height, plot_table$heights[-1])
299+
plot_table <- gtable_add_grob(plot_table, tag, name = "tag",
300+
t = 1, l = 1, clip = "off")
301+
} else if (tag_pos == "top") {
302+
plot_table$heights <- unit.c(tag_height, plot_table$heights[-1])
303+
plot_table <- gtable_add_grob(plot_table, tag, name = "tag",
304+
t = 1, l = 1, r = ncol(plot_table),
305+
clip = "off")
306+
} else if (tag_pos == "topright") {
307+
plot_table$widths <- unit.c(plot_table$widths[-ncol(plot_table)], tag_width)
308+
plot_table$heights <- unit.c(tag_height, plot_table$heights[-1])
309+
plot_table <- gtable_add_grob(plot_table, tag, name = "tag",
310+
t = 1, l = ncol(plot_table), clip = "off")
311+
} else if (tag_pos == "left") {
312+
plot_table$widths <- unit.c(tag_width, plot_table$widths[-1])
313+
plot_table <- gtable_add_grob(plot_table, tag, name = "tag",
314+
t = 1, b = nrow(plot_table), l = 1,
315+
clip = "off")
316+
} else if (tag_pos == "right") {
317+
plot_table$widths <- unit.c(plot_table$widths[-ncol(plot_table)], tag_width)
318+
plot_table <- gtable_add_grob(plot_table, tag, name = "tag",
319+
t = 1, b = nrow(plot_table), l = ncol(plot_table),
320+
clip = "off")
321+
} else if (tag_pos == "bottomleft") {
322+
plot_table$widths <- unit.c(tag_width, plot_table$widths[-1])
323+
plot_table$heights <- unit.c(plot_table$heights[-nrow(plot_table)], tag_height)
324+
plot_table <- gtable_add_grob(plot_table, tag, name = "tag",
325+
t = nrow(plot_table), l = 1, clip = "off")
326+
} else if (tag_pos == "bottom") {
327+
plot_table$heights <- unit.c(plot_table$heights[-nrow(plot_table)], tag_height)
328+
plot_table <- gtable_add_grob(plot_table, tag, name = "tag",
329+
t = nrow(plot_table), l = 1, r = ncol(plot_table), clip = "off")
330+
} else if (tag_pos == "bottomright") {
331+
plot_table$widths <- unit.c(plot_table$widths[-ncol(plot_table)], tag_width)
332+
plot_table$heights <- unit.c(plot_table$heights[-nrow(plot_table)], tag_height)
333+
plot_table <- gtable_add_grob(plot_table, tag, name = "tag",
334+
t = nrow(plot_table), l = ncol(plot_table), clip = "off")
335+
}
336+
}
337+
264338
# Margins
265339
plot_table <- gtable_add_rows(plot_table, theme$plot.margin[1], pos = 0)
266340
plot_table <- gtable_add_cols(plot_table, theme$plot.margin[2])

‎R/theme-defaults.r

Lines changed: 15 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -188,6 +188,11 @@ theme_grey <- function(base_size = 11, base_family = "",
188188
hjust = 1, vjust = 1,
189189
margin = margin(t = half_line)
190190
),
191+
plot.tag = element_text(
192+
size = rel(1.2),
193+
hjust = 0.5, vjust = 0.5
194+
),
195+
plot.tag.position = 'topleft',
191196
plot.margin = margin(half_line, half_line, half_line, half_line),
192197

193198
complete = TRUE
@@ -449,6 +454,11 @@ theme_void <- function(base_size = 11, base_family = "",
449454
hjust = 1, vjust = 1,
450455
margin = margin(t = half_line)
451456
),
457+
plot.tag = element_text(
458+
size = rel(1.2),
459+
hjust = 0.5, vjust = 0.5
460+
),
461+
plot.tag.position = 'topleft',
452462

453463
complete = TRUE
454464
)
@@ -566,6 +576,11 @@ theme_test <- function(base_size = 11, base_family = "",
566576
hjust = 1, vjust = 1,
567577
margin = margin(t = half_line)
568578
),
579+
plot.tag = element_text(
580+
size = rel(1.2),
581+
hjust = 0.5, vjust = 0.5
582+
),
583+
plot.tag.position = 'topleft',
569584
plot.margin = margin(half_line, half_line, half_line, half_line),
570585

571586
complete = TRUE

‎R/theme-elements.r

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -345,6 +345,8 @@ el_def <- function(class = NULL, inherit = NULL, description = NULL) {
345345
plot.title = el_def("element_text", "title"),
346346
plot.subtitle = el_def("element_text", "title"),
347347
plot.caption = el_def("element_text", "title"),
348+
plot.tag = el_def("element_text", "title"),
349+
plot.tag.position = el_def("character"), # Need to also accept numbers
348350
plot.margin = el_def("margin"),
349351

350352
aspect.ratio = el_def("character")

‎R/theme.r

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -157,6 +157,12 @@
157157
#' inherits from `title`) left-aligned by default
158158
#' @param plot.caption caption below the plot (text appearance)
159159
#' (`element_text`; inherits from `title`) right-aligned by default
160+
#' @param plot.tag upper-left label to identify a plot (text appearance)
161+
#' (`element_text`; inherits from `title`) left-aligned by default
162+
#' @param plot.tag.position The position of the tag as a string ("topleft",
163+
#' "top", "topright", "left", "right", "bottomleft", "bottom", "bottomright)
164+
#' or a coordinate. If a string, extra space will be added to accomodate the
165+
#' tag.
160166
#' @param plot.margin margin around entire plot (`unit` with the sizes of
161167
#' the top, right, bottom, and left margins)
162168
#'
@@ -351,6 +357,8 @@ theme <- function(line,
351357
plot.title,
352358
plot.subtitle,
353359
plot.caption,
360+
plot.tag,
361+
plot.tag.position,
354362
plot.margin,
355363
strip.background,
356364
strip.background.x,

‎man/theme.Rd

Lines changed: 12 additions & 4 deletions
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

‎tests/figs/labels/defaults.svg

Lines changed: 58 additions & 0 deletions
Loading

0 commit comments

Comments
 (0)