r - 使用 ggplot、gtable 和 cowplot 固定图例框的宽度
问题描述
我想用 R 制作一个看起来像用 Mac 的 Numbers 制作的样本的图。我正在为情节和图例框之间的空间而苦苦挣扎。这是我想要实现的示例:
在一些用户的帮助下(请参阅帖子末尾以供参考),我已经非常接近了。这是我目前的功能:
library(tidyverse)
library(cowplot)
library(gtable)
library(grid)
library(patchwork)
custom_barplot <- function(dataset, x_value, y_value, fill_value, nfill, xlab, ylab, y_limit, y_steps,legend_labels) {
# Example color set to choose from
colors=c("#CF232B","#942192","#000000","#f1eef6","#addd8e","#d0d1e6","#31a354","#a6bddb")
# user function for adjusting the size of key-polygons in legend
draw_key_polygon2 <- function(data, params, size) {
lwd <- min(data$size, min(size) / 4)
grid::rectGrob(
width = grid::unit(0.8, "npc"),
height = grid::unit(0.8, "npc"),
gp = grid::gpar(
col = data$colour,
fill = alpha(data$fill, data$alpha),
lty = data$linetype,
lwd = lwd * .pt,
linejoin = "mitre"
))
}
# user function for the plot itself
plot <- function(dataset, x_value, y_value, fill_value, nfill, xlab, ylab, y_limit, y_steps,legend,legend_labels)
{ggplot(data=dataset, mapping=aes(x={{x_value}}, y={{y_value}}, fill={{fill_value}})) +
geom_col(position=position_dodge(width=0.85),width=0.8,key_glyph="polygon2",show.legend=legend) +
geom_smooth(aes(color={{fill_value}}),method="lm",formula=y~x, se=FALSE,show.legend=legend, linetype="dashed") +
labs(x=xlab,y=ylab) +
theme(text=element_text(size=9,color="black"),
panel.background = element_rect(fill="white"),
panel.grid = element_line(color = "black",linetype="solid",size= 0.3),
panel.grid.minor = element_blank(),
panel.grid.major.x=element_blank(),
axis.text=element_text(size=9),
axis.line.x=element_line(color="black"),
axis.ticks= element_blank(),
legend.text=element_text(size=9),
legend.position = "right",
legend.justification = "top",
legend.title = element_blank(),
legend.key.size = unit(4,"mm"),
legend.key = element_rect(fill="white"),
plot.margin=unit(c(1,0.25,0.5,0.5),"cm")) +
scale_y_continuous(breaks= seq(from=0, to=y_limit,by=y_steps),
limits=c(0,y_limit+1),
expand=c(0,0)) +
scale_x_continuous(breaks=min(data[,deparse(ensym(x_value))],na.rm=TRUE):max(data[,deparse(ensym(x_value))],na.rm=TRUE)) +
scale_fill_manual(values = colors[1:nfill],labels={{legend_labels}})+
scale_color_manual(values= colors[1:nfill],labels=paste("Trend ",{{legend_labels}},sep=""))+
guides(color=guide_legend(override.aes=list(fill=NA),order=2),fill=guide_legend(override.aes = list(linetype=0),order=1))}
# taking the legend of the plot and removing the first column of the gtable within the legend
p_legend <- #cowplot::get_legend(plot(dataset, {{x_value}}, {{y_value}}, {{fill_value}}, nfill, xlab, ylab, y_limit, y_steps,legend=TRUE))
gtable_squash_cols(cowplot::get_legend(plot(dataset, {{x_value}}, {{y_value}}, {{fill_value}},nfill, xlab, ylab, y_limit, y_steps,legend=TRUE,legend_labels)),1)
# printing the plot without legend
p_main <- plot(dataset, {{x_value}}, {{y_value}}, {{fill_value}}, nfill, xlab, ylab, y_limit, y_steps,legend=FALSE,legend_labels = NULL)
#joining it all together
Obj<- p_main+plot_spacer() + p_legend +
plot_layout(widths=c(12.5,1.5,4))
return(Obj)
}
我的问题是,图例框的宽度似乎会根据标签的大小进行调整,因此绘图和图例之间的距离不会保持不变。
示例数据:
set.seed(9)
data <- data.frame(Cat=c(rep("A",times=5),rep("B",times=5),rep("C", times=5)),
year=rep(c(2015,2016,2017,2018,2019),times=3),
count=c(sample(seq(60,80),replace=TRUE,size=5),sample(seq(100,140),replace=TRUE,size=5),sample(seq(20,30),replace=TRUE,size=5)))
我制作了四个只有标签不同的图:
plt <- custom_barplot(dataset=data %>% filter(year %in% c(2015,2016,2017)),
x_value=year,
y_value=count,
fill_value=Cat,
nfill=3,
xlab="Year",
ylab="Count",
y_limit=140,
y_steps=20,
legend_labels=c("A","B","C"))
plt_2 <- custom_barplot(dataset=data %>% filter(year %in% c(2015,2016,2017)),
x_value=year,
y_value=count,
fill_value=Cat,
nfill=3,
xlab="Year",
ylab="Count",
y_limit=140,
y_steps=20,
legend_labels=c("Long Label A","Long Label B","Long Label C"))
plt_3 <- custom_barplot(dataset=data %>% filter(year %in% c(2015,2016,2017)),
x_value=year,
y_value=count,
fill_value=Cat,
nfill=3,
xlab="Year",
ylab="Count",
y_limit=140,
y_steps=20,
legend_labels=c("Xtra Long Label A","Xtra Long Label B","Xtra Long Label C"))
plt_4 <- custom_barplot(dataset=data %>% filter(year %in% c(2015,2016,2017)),
x_value=year,
y_value=count,
fill_value=Cat,
nfill=3,
xlab="Year",
ylab="Count",
y_limit=140,
y_steps=20,
legend_labels=c("Super Xtra Long Label A","Super Xtra Long Label B","Super Xtra Long Label C"))
我需要情节和图例之间的空间保持不变,不要介意图例中标签的长度。我宁愿那个标签没有完全显示(所以我看到我必须缩短它)。这些图表用于具有tufte 讲义样式的文档中,图例应与注释位于同一区域。
你知道如何保持空间不变吗?
参考:
解决方案
我认为最简单的解决方案是简单地对图例中的文本应用换行。您可以这样做,stringr::str_wrap()
以提供如下结果:
这是对您的函数的一个非常小的编辑,它允许用户控制文本换行:
custom_barplot <- function(dataset, x_value, y_value, fill_value, nfill, xlab, ylab, y_limit, y_steps, legend_labels, wrap_labels = 20) {
# Example color set to choose from
colors <- c("#CF232B", "#942192", "#000000", "#f1eef6", "#addd8e", "#d0d1e6", "#31a354", "#a6bddb")
# user function for adjusting the size of key-polygons in legend
draw_key_polygon2 <- function(data, params, size) {
lwd <- min(data$size, min(size) / 4)
grid::rectGrob(
width = grid::unit(0.8, "npc"),
height = grid::unit(0.8, "npc"),
gp = grid::gpar(
col = data$colour,
fill = alpha(data$fill, data$alpha),
lty = data$linetype,
lwd = lwd * .pt,
linejoin = "mitre"
)
)
}
# user function for the plot itself
plot <- function(dataset, x_value, y_value, fill_value, nfill, xlab, ylab, y_limit, y_steps, legend, legend_labels) {
ggplot(data = dataset, mapping = aes(x = {{ x_value }}, y = {{ y_value }}, fill = {{ fill_value }})) +
geom_col(position = position_dodge(width = 0.85), width = 0.8, key_glyph = "polygon2", show.legend = legend) +
geom_smooth(aes(color = {{ fill_value }}), method = "lm", formula = y ~ x, se = FALSE, show.legend = legend, linetype = "dashed") +
labs(x = xlab, y = ylab) +
theme(
text = element_text(size = 9, color = "black"),
panel.background = element_rect(fill = "white"),
panel.grid = element_line(color = "black", linetype = "solid", size = 0.3),
panel.grid.minor = element_blank(),
panel.grid.major.x = element_blank(),
axis.text = element_text(size = 9),
axis.line.x = element_line(color = "black"),
axis.ticks = element_blank(),
legend.text = element_text(size = 9),
legend.position = "right",
legend.justification = "top",
legend.title = element_blank(),
legend.key.size = unit(4, "mm"),
legend.key = element_rect(fill = "white"),
plot.margin = unit(c(1, 0.25, 0.5, 0.5), "cm")
) +
scale_y_continuous(
breaks = seq(from = 0, to = y_limit, by = y_steps),
limits = c(0, y_limit + 1),
expand = c(0, 0)
) +
scale_x_continuous(breaks = min(data[, deparse(ensym(x_value))], na.rm = TRUE):max(data[, deparse(ensym(x_value))], na.rm = TRUE)) +
scale_fill_manual(values = colors[1:nfill], labels = stringr::str_wrap({{ legend_labels }}, wrap_labels)) +
scale_color_manual(values = colors[1:nfill], labels = stringr::str_wrap(paste("Trend ", {{ legend_labels }}, sep = ""), wrap_labels)) +
guides(color = guide_legend(override.aes = list(fill = NA), order = 2), fill = guide_legend(override.aes = list(linetype = 0), order = 1))
}
# taking the legend of the plot and removing the first column of the gtable within the legend
p_legend <- # cowplot::get_legend(plot(dataset, {{x_value}}, {{y_value}}, {{fill_value}}, nfill, xlab, ylab, y_limit, y_steps,legend=TRUE))
gtable_squash_cols(cowplot::get_legend(plot(dataset, {{ x_value }}, {{ y_value }}, {{ fill_value }}, nfill, xlab, ylab, y_limit, y_steps, legend = TRUE, legend_labels)), 1)
# printing the plot without legend
p_main <- plot(dataset, {{ x_value }}, {{ y_value }}, {{ fill_value }}, nfill, xlab, ylab, y_limit, y_steps, legend = FALSE, legend_labels = NULL)
# joining it all together
Obj <- p_main + plot_spacer() + p_legend +
plot_layout(widths = c(12.5, 1.5, 4))
return(Obj)
}
推荐阅读
- ios - 为什么 iOS 数据保护委托会被意外调用?
- javascript - [未处理的承诺拒绝:TypeError:null 不是对象(评估'_reactNativeImageCropPicker.default.openPicker')]
- node.js - Reactjs 将地址存储在数组中
- java - 如何使用 Java 中的 Scanner 创建具有指定行大小的二维数组而不指定列大小?
- python - 为什么字典值在while循环中设置为零?
- javascript - 使用带有 react 的 filepond 并希望验证或阻止同名上传
- android - 如果用户在应用程序 kotlin 中授权,我如何在编辑文本中显示来自 API 的数据?
- python - python selenium SessionNotCreatedException 错误
- asp.net-core - 如何在 .Net Core 2.2 Web API 微服务之间进行通信
- java - 我无法读取拼图文件