我有一个数据框列表,用于创建ggplots 列表,然后使用组装成一个绘图网格cowplot。然后,我需要附加一个共享的标题,字幕和标题。我想以一种方式来实现这些标签,使其具有与主题元素(大小,字体等)相同的主题,就像它们是由labs而不是由所创建的cowplot::draw_label。
在我的实际情况下,我有几个choropleth,每个choropleth都有自己的单位和比例,这就是为什么我不能只是一个方面,而是需要彼此独立地构建图。
这是数据的简化版本,以及我已加载的软件包:
library(tidyverse)
library(cowplot)
dfs <- list(
adults_no_diploma = structure(list(
tract = c("09003405100", "09003405200", "09003405300", "09003405401", "09003405402", "09003405500", "09003405600", "09003405700", "09003405800", "09003405900"),
value = c(0.08, 0.108, 0.095, 0.099, 0.105, 0.103, 0.161, 0.279, 0.056, 0.055)),
row.names = c(NA, -10L), class = c("tbl_df", "tbl", "data.frame")),
severe_cost_burden = structure(list(
tract = c("09003405100", "09003405200", "09003405300", "09003405401", "09003405402", "09003405500", "09003405600", "09003405700", "09003405800", "09003405900"),
value = c(0.128, 0.147, 0.165, 0.1, 0.151, 0.11, 0.179, 0.184, 0.14, 0.038)),
row.names = c(NA, -10L), class = c("tbl_df", "tbl", "data.frame"))
)
Run Code Online (Sandbox Code Playgroud)
我正在使用自定义主题(再次是简化版本):
theme_georgia <- function(...) {
theme_gray(base_family = "Georgia", ...) +
theme(plot.title = element_text(face = "bold"))
}
plots <- dfs %>%
imap(~{
ggplot(.x, aes(x = value)) +
geom_density() +
ggtitle(.y) +
theme_georgia()
})
gridded <- plot_grid(plotlist = plots, nrow = 1)
Run Code Online (Sandbox Code Playgroud)
在cowplot注解小插图之后,我可以创建标题ggdraw() + draw_label("Socio-economic measures")并手动设置诸如字体大小之类的东西,但是我更希望以某种方式将该标签定义为标题;也就是说,主题将对其应用所有plot.title内容,并且创建字幕和标题也是如此。
我当前的解决方法是为标题和副标题添加一个空的ggplot,labs为标题添加一个空白,并使用垂直堆叠它们cowplot::plot_grid。
title_gg <- ggplot() +
labs(title = "Socio-economic measures", subtitle = "By census tract, 2016") +
theme_georgia()
plot_grid(title_gg, gridded, ncol = 1, rel_heights = c(0.15, 1))
Run Code Online (Sandbox Code Playgroud)

解决方法是可以的,但我喜欢您所提供的简洁性和一致性draw_label。相反,我可以一个个地添加这些主题元素来模仿标题:
title_theme <- ggdraw() +
draw_label("Socio-economic measures",
fontfamily = theme_georgia()$text$family,
fontface = theme_georgia()$plot.title$face, x = 0.05, hjust = 0)
plot_grid(title_theme, gridded, ncol = 1, rel_heights = c(0.2, 1))
Run Code Online (Sandbox Code Playgroud)

我的问题是,是否有任何方法可以将这些方法结合起来以提取所有相关主题元素并draw_label快速提供给它们,或者以某种方式告诉draw_label这件事是标题,应该获得标题主题元素,而另一件事是副标题,并且以此类推。我想象这样的魔术:
ggdraw() +
draw_label("Socio-economic measures", theme_georgia()$plot.title_elements)
Run Code Online (Sandbox Code Playgroud)
要么:
ggdraw() +
draw_label("Socio-economic measures", type = "title") + theme_georgia()
Run Code Online (Sandbox Code Playgroud)
@Claus Wilke 的解决方案完成了工作,但我受到启发,编写了一个包装函数draw_label,以获得模仿主题元素所需的样式。我在这里发帖是为了防止它对其他人有用,尽管这可能是一个奇怪的用例。
此函数采用主题函数,或者如果theme省略,则从 获取当前主题theme_get。它还采用主题元素的名称,例如"plot.title",从中获取样式calc_element。cowplot::draw_label所有必需的参数以及...诸如xor中的其他任何内容都传递给hjust。
library(tidyverse)
library(cowplot)
draw_label_theme <- function(label, theme = NULL, element = "text", ...) {
if (is.null(theme)) {
theme <- ggplot2::theme_get()
}
if (!element %in% names(theme)) {
stop("Element must be a valid ggplot theme element name")
}
elements <- ggplot2::calc_element(element, theme)
cowplot::draw_label(label,
fontfamily = elements$family,
fontface = elements$face,
colour = elements$color,
size = elements$size,
...
)
}
title <- ggdraw() +
draw_label_theme("Socio-economic measures",
theme = theme_georgia(), element = "plot.title",
x = 0.05, hjust = 0, vjust = 1)
subtitle <- ggdraw() +
draw_label_theme("By census tract, 2016",
theme = theme_georgia(), element = "plot.subtitle",
x = 0.05, hjust = 0, vjust = 1)
Run Code Online (Sandbox Code Playgroud)
现在唯一困难的部分是将内容整齐地排列在 中rel_heights,我可以在这里做更多的事情。可能有定位信息可以从主题中提取出来并用于设置高度。
plot_grid(title, subtitle, gridded, ncol = 1, rel_heights = c(0.1, 0.1, 1))
Run Code Online (Sandbox Code Playgroud)

像这样?
library(ggplot2)
library(cowplot)
theme_georgia <- function(...) {
theme_gray(base_family = "Georgia", ...) +
theme(plot.title = element_text(face = "bold"))
}
title_theme <- calc_element("plot.title", theme_georgia())
ggdraw() +
draw_label(
"Socio-economic measures",
fontfamily = title_theme$family,
fontface = title_theme$face,
size = title_theme$size
)
Run Code Online (Sandbox Code Playgroud)

由reprex 包(v0.2.0)于2018年 6 月 21 日创建。