ggplot2：単一伝説

Question

を持つ単一の行に複数のプロット私はこのような二つのグラフの組み合わせプロット+彼らの伝説たい：私は幅を推測したくないしかし

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とp2as 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) 

が、これは1行に2つのプロットではなく、1列配置されていません。

を

この質問は同様のto this one hereですが、私は適応された幅も求めています。私はその質問+回答とgithubの両方からコード抽出を使用しています。

Answer 1

なぜファセットを使用しないのですか？

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") 

Answer 2

@Rolandが示唆したように私は通常facet_wrapまたはfacet_gridを使用しています。

しばらく前に私は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) 
}