我想要两个情节的组合情节+他们的传奇:
library(ggplot2)
library(grid)
library(gridExtra)
dsamp <- diamonds[sample(nrow(diamonds), 1000), ]
p1 <- qplot(price, carat, data=dsamp, colour=clarity)
p2 <- qplot(price, depth, data=dsamp, colour=clarity)
g <- ggplotGrob(p1 + theme(legend.position="bottom"))$grobs
legend <- g[[which(sapply(g, function(x) x$name) == "guide-box")]]
grid.arrange(arrangeGrob(p1+theme(legend.position="right"),p2+theme(legend.position="none"),legend,ncol=3,widths=c(3/7,3/7,1/7)))
但是我不想猜测图和图例的宽度(并指定ncol
),但要从p1
和p2
as shown here中提取。
所以我希望我需要这样的东西(来自链接的改编代码):
grid_arrange_shared_legend_row <- function(...) {
plots <- list(...)
g <- ggplotGrob(plots[[1]] + theme(legend.position="right"))$grobs
legend <- g[[which(sapply(g, function(x) x$name) == "guide-box")]]
lwidth <- sum(legend$width)
grid.arrange(
do.call(arrangeGrob, lapply(plots, function(x)
x + theme(legend.position="none"))),
legend,
ncol = length(plots)+1,
widths = unit.c(rep(unit(1, "npc") - lwidth, length(plots)), lwidth))
}
grid_arrange_shared_legend_row(p1, p2)
但这并不是将两个图排列成一行而是一列:
这个问题与to this one here类似,但不同之处在于我也要求改编宽度。我正在使用代码提取来自该问题+答案和github。
答案 0 :(得分:8)
为什么不使用facetting?
library(reshape2)
dmelt <- melt(dsamp, id.vars = c("price", "clarity"), measure.vars = c("carat", "depth"))
ggplot(dmelt, aes(x = price, y = value, color = clarity)) +
geom_point() +
facet_wrap(~ variable, scales = "free")
答案 1 :(得分:2)
我经常使用facet_wrap
或facet_grid
作为@Roland建议。
前段时间我不得不使用grid.arrange
(我希望y轴上的标签按特定顺序着色),这就是我提出的功能:
ggplot_shared_info <- function(...) {
plots <- list(...)
g <- ggplotGrob(plots[[1]])$grobs
legend <- g[[which(sapply(g, function(x) x$name) == "guide-box")]]
title <- g[[grep("plot.title", sapply(g, function(x) x$name))]]
xaxis <- g[[grep("axis.title.x", sapply(g, function(x) x$name))]]
yaxis <- g[[grep("axis.title.y", sapply(g, function(x) x$name))]]
lwidth <- sum(legend$width)
theight <- sum(title$height)
xheight <- sum(xaxis$height)
ywidth <- sum(yaxis$width)
grid.arrange(
title,
arrangeGrob(
yaxis,
do.call(arrangeGrob, c(lapply(plots, function(x)
x + theme(legend.position="none",
plot.title = element_blank(),
axis.title = element_blank())),
nrow = 1)),
legend,
nrow = 1,
widths = grid::unit.c(ywidth, unit(1, "npc") - ywidth - lwidth, lwidth)
),
xaxis,
heights = grid::unit.c(theight, unit(1, "npc") - theight - xheight, xheight),
ncol = 1
)
}
编辑:现在,用户可以确定哪些列出的地块元素应该“加入”。
ggplot_shared_info <- function(..., elements = c('legend', 'title', 'yaxis', 'xaxis')) {
plots <- list(...)
g <- ggplotGrob(plots[[1]])$grobs
legend <- g[[which(sapply(g, function(x) x$name) == "guide-box")]]
lwidth <- sum(legend$width)
title <- g[[grep("plot.title", sapply(g, function(x) x$name))]]
theight <- sum(title$height)
xaxis <- g[[grep("axis.title.x", sapply(g, function(x) x$name))]]
xheight <- sum(xaxis$height)
yaxis <- g[[grep("axis.title.y", sapply(g, function(x) x$name))]]
ywidth <- sum(yaxis$width)
plots <- lapply(plots, function(x, elements = elements){
if('legend' %in% elements) x <- x + theme(legend.position="none")
if('title' %in% elements) x <- x + theme(plot.title = element_blank())
if('xaxis' %in% elements) x <- x + theme(axis.title.x = element_blank())
if('yaxis' %in% elements) x <- x + theme(axis.title.y = element_blank())
x
}, elements = elements)
plots <- do.call(arrangeGrob, c(plots, nrow = 1))
if('legend' %in% elements)
plots <- arrangeGrob(plots, legend, nrow = 1, widths = grid::unit.c(unit(1, "npc") - lwidth, lwidth))
if('yaxis' %in% elements)
plots <- arrangeGrob(yaxis, plots, nrow = 1, widths = grid::unit.c(ywidth, unit(1, "npc") - ywidth))
if('title' %in% elements)
plots <- arrangeGrob(title, plots, ncol = 1, heights = grid::unit.c(theight, unit(1, "npc") - theight))
if('xaxis' %in% elements)
plots <- arrangeGrob(plots, xaxis, ncol = 1, heights = grid::unit.c(unit(1, "npc") - xheight, xheight))
grid.arrange(plots)
}