【问题标题】:ggplot2: multiple plots in a single row with a single legendggplot2:单行中的多个图,带有一个图例
【发布时间】:2016-01-15 15:30:05
【问题描述】:

我想要两个情节的组合情节 + 他们的传说是这样的:

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),而是从p1p2as 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 中提取的代码。

【问题讨论】:

    标签: r plot ggplot2 gridextra


    【解决方案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")
    

    【讨论】:

    • 谢谢,这确实很好用。也许您也应该使用相同的代码回答另一个问题?它在我的谷歌搜索结果中非常高,对未来的用户来说是一个很好的参考!
    【解决方案2】:

    我通常按照@Roland 的建议使用facet_wrapfacet_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)
    }
    

    【讨论】:

    • 这很好用,应该更通用,谢谢!请注意,缺少标题将导致错误,即对于给定的示例应调用为:ggplot_shared_info(p1+ggtitle("p1"), p2)
    • 没想到!我将尝试编辑我的代码,以便用户可以确定他希望“共享”的情节的哪些元素。
    猜你喜欢
    • 1970-01-01
    • 1970-01-01
    • 2016-10-20
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 2021-01-15
    • 2020-05-06
    • 1970-01-01
    相关资源
    最近更新 更多