Skip to content

Add tag label for adding identifier to plot #2405

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 13 commits into from
May 9, 2018
Merged

Add tag label for adding identifier to plot #2405

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
13 commits
Select commit Hold shift + click to select a range
92e955a
Add tag label for adding identifier to plot
thomasp85 Jan 17, 2018
7421718
Add plot.tag.position and modify default themes accordingly
thomasp85 Jan 18, 2018
f1f8e1e
Fix interplay between margin and justification
thomasp85 Jan 22, 2018
c08bad2
Set default tag size to rel(1.2)
thomasp85 May 3, 2018
c937a19
Add brief description of use
thomasp85 May 8, 2018
5321b6a
Better error message
thomasp85 May 8, 2018
19d8c84
Fix wording in documentation
thomasp85 May 8, 2018
b385981
Add a few visual tests
thomasp85 May 8, 2018
12646f8
Use justify_grobs for tag justification
thomasp85 May 8, 2018
4ebe9e1
Add generated visual test figures
thomasp85 May 9, 2018
4fb2b23
Don't assign into unit vectors to avoid weird grid bug in R 3.2 (and …
thomasp85 May 9, 2018
31f9831
Add comment describing the reason for the slightly weird reassembly o…
thomasp85 May 9, 2018
dfa0bc3
Fix visual tests for AppVeyor
thomasp85 May 9, 2018
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
6 changes: 6 additions & 0 deletions NEWS.md
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -76,6 +76,12 @@
* Added `stat_qq_line()` to make it easy to add a simple line to a Q-Q plot. This
line makes it easier to judge the fit of the theoretical distribution
(@nicksolomon).

* Added `tag` label for adding identification tags to the plot. A tag is added
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I think you need a brief explanation of what you might use a tag for here

Copy link
Member Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Fixed in 5f70fd8

with the `labs()` function and styling is handled through the `plot.tag` theme
element. Position is specified with the `plot.tag.position` theme setting and
defauls to `"topleft"`. Tags are useful for identifying subplots in a
multiplot figure and often used in the scientific literature (@thomasp85).

### Scales

Expand Down
74 changes: 74 additions & 0 deletions R/plot-build.r
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -242,6 +242,11 @@ ggplot_gtable.ggplot_built <- function(data) {
subtitle <- element_render(theme, "plot.subtitle", plot$labels$subtitle, margin_y = TRUE)
subtitle_height <- grobHeight(subtitle)

# Tag
tag <- element_render(theme, "plot.tag", plot$labels$tag, margin_y = TRUE, margin_x = TRUE)
tag_height <- grobHeight(tag)
tag_width <- grobWidth(tag)

# whole plot annotation
caption <- element_render(theme, "plot.caption", plot$labels$caption, margin_y = TRUE)
caption_height <- grobHeight(caption)
Expand All @@ -261,6 +266,75 @@ ggplot_gtable.ggplot_built <- function(data) {
plot_table <- gtable_add_grob(plot_table, caption, name = "caption",
t = -1, b = -1, l = min(pans$l), r = max(pans$r), clip = "off")

plot_table <- gtable_add_rows(plot_table, unit(0, 'pt'), pos = 0)
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Why do we need all these new rows and cols?

Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This goes back to the discussion of whether plot tags should live in their own table cells or not. I've come around to @thomasp85 position that there may be valid uses for it, in particular when people try to (ab)use plot tags for things we're not envisioning right now. The moment people use entire words or phrases as plot tags, having them in separate cells will be useful. And I know from writing my book that that's something I have done with the cowplot::plot_grid() function, so it's not a made-up scenario.

Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Should they always be added even when there isn't a tag? I don't have sense of if adding new rows/cols will disrupt existing code

Copy link
Member Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

The idea here, which is formed both by my work with facets and my extensions, is that it is much nicer to have a predictable gtable layout to work with. This is also why rows and columns are added for axes and strips on all sides even if they aren’t drawn. If any external code depend on the gtable layout it will break either way when users start to add tags, but doing it this way makes it much easier to fix as you don’t need any gtable introspection to see if a tag is added, and where.

There is nothing inside ggplot2 that breaks so this is more a breaking change for extensions

plot_table <- gtable_add_cols(plot_table, unit(0, 'pt'), pos = 0)
plot_table <- gtable_add_rows(plot_table, unit(0, 'pt'), pos = -1)
plot_table <- gtable_add_cols(plot_table, unit(0, 'pt'), pos = -1)

tag_pos <- theme$plot.tag.position
if (length(tag_pos) == 2) tag_pos <- "manual"
valid_pos <- c("topleft", "top", "topright", "left", "right", "bottomleft",
"bottom", "bottomright")
if (!(tag_pos == "manual" || tag_pos %in% valid_pos)) {
stop("plot.tag.position should be a coordinate or one of ",
paste(valid_pos, collapse = ', '), call. = FALSE)
}

if (tag_pos == "manual") {
xpos <- theme$plot.tag.position[1]
ypos <- theme$plot.tag.position[2]
tag_parent <- justify_grobs(tag, x = xpos, y = ypos,
hjust = theme$plot.tag$hjust,
vjust = theme$plot.tag$vjust,
debug = theme$plot.tag$debug)
plot_table <- gtable_add_grob(plot_table, tag_parent, name = "tag", t = 1,
b = nrow(plot_table), l = 1,
r = ncol(plot_table), clip = "off")
} else {
# Widths and heights are reassembled below instead of assigning into them
# in order to avoid bug in grid 3.2 and below.
if (tag_pos == "topleft") {
plot_table$widths <- unit.c(tag_width, plot_table$widths[-1])
plot_table$heights <- unit.c(tag_height, plot_table$heights[-1])
plot_table <- gtable_add_grob(plot_table, tag, name = "tag",
t = 1, l = 1, clip = "off")
} else if (tag_pos == "top") {
plot_table$heights <- unit.c(tag_height, plot_table$heights[-1])
plot_table <- gtable_add_grob(plot_table, tag, name = "tag",
t = 1, l = 1, r = ncol(plot_table),
clip = "off")
} else if (tag_pos == "topright") {
plot_table$widths <- unit.c(plot_table$widths[-ncol(plot_table)], tag_width)
plot_table$heights <- unit.c(tag_height, plot_table$heights[-1])
plot_table <- gtable_add_grob(plot_table, tag, name = "tag",
t = 1, l = ncol(plot_table), clip = "off")
} else if (tag_pos == "left") {
plot_table$widths <- unit.c(tag_width, plot_table$widths[-1])
plot_table <- gtable_add_grob(plot_table, tag, name = "tag",
t = 1, b = nrow(plot_table), l = 1,
clip = "off")
} else if (tag_pos == "right") {
plot_table$widths <- unit.c(plot_table$widths[-ncol(plot_table)], tag_width)
plot_table <- gtable_add_grob(plot_table, tag, name = "tag",
t = 1, b = nrow(plot_table), l = ncol(plot_table),
clip = "off")
} else if (tag_pos == "bottomleft") {
plot_table$widths <- unit.c(tag_width, plot_table$widths[-1])
plot_table$heights <- unit.c(plot_table$heights[-nrow(plot_table)], tag_height)
plot_table <- gtable_add_grob(plot_table, tag, name = "tag",
t = nrow(plot_table), l = 1, clip = "off")
} else if (tag_pos == "bottom") {
plot_table$heights <- unit.c(plot_table$heights[-nrow(plot_table)], tag_height)
plot_table <- gtable_add_grob(plot_table, tag, name = "tag",
t = nrow(plot_table), l = 1, r = ncol(plot_table), clip = "off")
} else if (tag_pos == "bottomright") {
plot_table$widths <- unit.c(plot_table$widths[-ncol(plot_table)], tag_width)
plot_table$heights <- unit.c(plot_table$heights[-nrow(plot_table)], tag_height)
plot_table <- gtable_add_grob(plot_table, tag, name = "tag",
t = nrow(plot_table), l = ncol(plot_table), 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])
Expand Down
15 changes: 15 additions & 0 deletions R/theme-defaults.r
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -188,6 +188,11 @@ theme_grey <- function(base_size = 11, base_family = "",
hjust = 1, vjust = 1,
margin = margin(t = half_line)
),
plot.tag = element_text(
size = rel(1.2),
hjust = 0.5, vjust = 0.5
),
plot.tag.position = 'topleft',
plot.margin = margin(half_line, half_line, half_line, half_line),

complete = TRUE
Expand Down Expand Up @@ -449,6 +454,11 @@ theme_void <- function(base_size = 11, base_family = "",
hjust = 1, vjust = 1,
margin = margin(t = half_line)
),
plot.tag = element_text(
size = rel(1.2),
hjust = 0.5, vjust = 0.5
),
plot.tag.position = 'topleft',

complete = TRUE
)
Expand Down Expand Up @@ -566,6 +576,11 @@ theme_test <- function(base_size = 11, base_family = "",
hjust = 1, vjust = 1,
margin = margin(t = half_line)
),
plot.tag = element_text(
size = rel(1.2),
hjust = 0.5, vjust = 0.5
),
plot.tag.position = 'topleft',
plot.margin = margin(half_line, half_line, half_line, half_line),

complete = TRUE
Expand Down
2 changes: 2 additions & 0 deletions R/theme-elements.r
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -345,6 +345,8 @@ el_def <- function(class = NULL, inherit = NULL, description = NULL) {
plot.title = el_def("element_text", "title"),
plot.subtitle = el_def("element_text", "title"),
plot.caption = el_def("element_text", "title"),
plot.tag = el_def("element_text", "title"),
plot.tag.position = el_def("character"), # Need to also accept numbers
plot.margin = el_def("margin"),

aspect.ratio = el_def("character")
Expand Down
8 changes: 8 additions & 0 deletions R/theme.r
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -157,6 +157,12 @@
#' inherits from `title`) left-aligned by default
#' @param plot.caption caption below the plot (text appearance)
#' (`element_text`; inherits from `title`) right-aligned by default
#' @param plot.tag upper-left label to identify a plot (text appearance)
#' (`element_text`; inherits from `title`) left-aligned by default
#' @param plot.tag.position The position of the tag as a string ("topleft",
#' "top", "topright", "left", "right", "bottomleft", "bottom", "bottomright)
#' or a coordinate. If a string, extra space will be added to accomodate the
#' tag.
#' @param plot.margin margin around entire plot (`unit` with the sizes of
#' the top, right, bottom, and left margins)
#'
Expand Down Expand Up @@ -351,6 +357,8 @@ theme <- function(line,
plot.title,
plot.subtitle,
plot.caption,
plot.tag,
plot.tag.position,
plot.margin,
strip.background,
strip.background.x,
Expand Down
16 changes: 12 additions & 4 deletions man/theme.Rd
View file
Open in desktop

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

58 changes: 58 additions & 0 deletions tests/figs/labels/defaults.svg
View file
Open in desktop
Loading
Sorry, something went wrong. Reload?
Sorry, we cannot display this file.
Sorry, this file is invalid so it cannot be displayed.
Loading