双Y轴与facet_wrap一起使用 [英] dual y axis together with facet_wrap

问题描述

在我怎样才能在ggplot2的右边放置一个变换的比例？通过操作和合并ggplot2对象到gtable，显示了如何在同一个图中添加两个y轴。
从这个例子中，我设法扩展它来处理facet_wrap。看看下面的例子。

有三件事情不完美。

<李>规模总是放在最右边。如果它与最后一行中的图相连，它会更好

1. 如果所有图上分别有y轴（即，您将如果我将网格线留在（线条中），那么我们就可以使用这些线条这是注释掉）第二个阴谋的网格线出现在第一个阴谋的前面。



任何想法，如果有聪明的方法来解决这些公认的小问题？

  library（ggplot2）
 library（gtable）
 library （网格）
 
 p1 < -  ggplot（钻石，aes（y =克拉，x =价格））
 p1 < -  p1 + geom_point（color =red）
 p1 < -  p1 + facet_wrap（〜color）
 p1 < -  p1 + theme_bw（）％+替换％theme（panel.background = element_rect（fill = NA））＃使用白色主题并设置bg （），panel.grid.minor = element_blank（））＃删除网格线
 p1 
 
 
 p2 < -  ggp （钻石，aes（x =价格））
 p2 < -  p2 + geom_histogram（binwidth = 1000）
 p2 < -  p2 + facet_wrap（〜color）
 p2 < p2 + theme_bw（）％+替换％theme（panel.background = element_rect（fill = NA））
＃p2 < -  p2 +主题（panel.grid.major = element_blank（），panel.grid.minor = element_blank（））
 
 p2 
 
 
 
 ##将图表放在一起############### ### 
＃extract gtable 
 g1<  -  ggplot_gtable（ggplot_build（p1））
 g2<  -  ggplot_gtable（ggplot_build（p2））
 
＃重叠（子集（g1 $布局，grepl（面板，名称），se = t：r））
g < -  gtable_add_grob （g1，g2 $ grobs [grep（panel，g2 $ layout $ name）]，pp $ t，
 pp $ l，pp $ b，pp $ l）
 
 
 
＃轴调整
 ia<  -  which（grepl（axis_l，g2 $ layout $ name）| grepl（axis-l，g2 $ layout $ name））
 ga < -  g2 $ grobs [ia] 
 
 
 axis_idx<  -  as.numeric （sapply（ga，function（x）！is.null（x $ children $ axis））））
 
 for（i in 1：length（axis_idx））{
 ax< -  ga [[axis_idx [i]]] $ children $ axis 
 ax $ widths<  -  rev（ax $ widths）
 ax $ grobs<  -  rev（ax $ grobs）
 ax $ grobs [[1]] $ x <-ax $ grobs [[1]] $ x  -  unit（1，npc）+ unit（0.15，cm）
g < -  gtable_add_cols g，g2 $ widths [g2 $ layout [ia [axis_idx [i]]，] $ l]，length（g $ widths） -  1）
g < -  gtable_add_grob（g，ax，pp $ t [axis_idx [i]]，长度（g $ widths） -  i，pp $ b [axis_idx [i]]）
} 
 
 
 
＃剧情！ 
 grid.newpage（）
 grid.draw（g）
  

解决方案

这是一个调整，你应该能够进一步调整到你的满意度。制定出更加精确和一般的方法会让我花费更多的时间，而不是我此刻离开的时间。但是我认为你不需要额外的步骤就可以了。

前几个步骤不变。

  
 
在这里，我将您的程序复制到前两排的面板中，而不是在底部添加已调整的轴： ＃不要加回底部lhs轴
 for（i in 1：（length（axis_idx）-1））{
 ax<  -  ga [[axis_idx [i]]] $ children $ axis 
 ax $ widths<  -  rev（ax $ widths）
 ax $ grobs<  -  rev（ax $ grobs）
 ax $ grobs [[1]] $ x < -  ax $ grobs [[1]] $ x  - 单位（1，npc）+单位（0.15，cm）
g < -  gtable_add_cols（g，
 g2 $ widths [g2 $ layout [ ia [axis_idx [i]]，] $ l]，长度（g $ widths）-1）
g <-gtable_add_grob（g，
 ax，pp $ t [axis_idx [i]]，长度（g $ widths） -  i，pp $ b [axis_idx [i]]）
} 
  

在这里，我分别处理底部行。这是我没有概括的位。你需要调整滴答声和垂直轴之间的距离。你还需要概括索引的情况，其中底部只有一个情节，2个情节等。

 ＃在这里，我将索引i``修改为3，以迎合您的例子。 
i < -  length（axis_idx）
 ax <-ga [[axis_idx [i]]] $ children $ axis $ b $ ax ax $ widths<  -  rev（ax $ widths）
 ax $ grobs<  -  rev（ax $ grobs）
 ax $ grobs [[1]] $ x < -  ax $ grobs [[1]] $ x  -  unit（1，npc） +单位（0.15，cm）
g <-gtable_add_cols（g，g2 $ widths [3]，12）
g < -  gtable_add_grob（g，ax，pp $ t [axis_idx [i] ]，长度（g $ widths） -  9，pp $ b [axis_idx [i]]）
  

需要扩展的位数是12和9.可能需要调整的位是带有单位（0.15，cm）的行以获得更多空间比现在看起来还要多。

首先您的 g 对象的宽度 12 ，这是3乘3面板加3垂直轴。然后添加一列以迎合第二个轴，并获得宽度 15 。数字12选择在底部图的右边。数字9被选择将第二个轴放置在那里。我想。

At How can I put a transformed scale on the right side of a ggplot2? it was shown how to add two y-axis in the same plot by manipulation and merging ggplot2 objects with gtable. From the example there I managed to extend it to work with facet_wrap. See the example below.

There are however three things that are not perfect.

1. The scale is always put on the far right. It would be better if it connected with the plot in the last row
2. It doesn't work if there is y-axis on all plots separately (i.e. you put scales="free_y" in facet_wrap)
3. If I leave the grid-lines in (the line that is commented out) The grid-lines from the second plots appear in front of the first plot.

Any ideas if there is a smart way to fix these admittedly small issues?

library(ggplot2)
library(gtable)
library(grid)

p1 <- ggplot(diamonds, aes(y=carat,x=price))
p1 <- p1 + geom_point(color="red")
p1 <- p1 + facet_wrap(~ color)
p1 <- p1 + theme_bw()  %+replace%  theme(panel.background = element_rect(fill = NA)) # use white theme and set bg to transparent so they can merge nice
#p1 <- p1 + theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank()) # remove gridlines
p1


p2 <- ggplot(diamonds, aes(x=price))
p2 <- p2 + geom_histogram( binwidth = 1000)
p2 <- p2 +  facet_wrap(~ color)
p2 <- p2 + theme_bw()  %+replace%  theme(panel.background = element_rect(fill = NA))
#p2 <- p2 + theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank())

p2



## Putting plots together ##################
# extract gtable
g1 <- ggplot_gtable(ggplot_build(p1))
g2 <- ggplot_gtable(ggplot_build(p2))

# overlap the panel of 2nd plot on that of 1st plot
pp <- c(subset(g1$layout, grepl("panel",name) , se = t:r))
g <- gtable_add_grob(g1, g2$grobs[grep("panel",g2$layout$name)], pp$t, 
                     pp$l, pp$b, pp$l)



# axis tweaks
ia <- which(grepl("axis_l",g2$layout$name) |  grepl("axis-l",g2$layout$name)     )
ga <- g2$grobs[ia]


axis_idx <- as.numeric(which(sapply(ga,function(x) !is.null(x$children$axis))))

for(i in 1:length(axis_idx)){
  ax <- ga[[axis_idx[i]]]$children$axis
  ax$widths <- rev(ax$widths)
  ax$grobs <- rev(ax$grobs)
  ax$grobs[[1]]$x <- ax$grobs[[1]]$x - unit(1, "npc") + unit(0.15, "cm")
  g <- gtable_add_cols(g, g2$widths[g2$layout[ia[axis_idx[i]], ]$l], length(g$widths) - 1)
  g <- gtable_add_grob(g, ax, pp$t[axis_idx[i]], length(g$widths) - i, pp$b[axis_idx[i]])
}



# Plot!
grid.newpage()
grid.draw(g)

解决方案

Here is a tweak that you should be able to tweak further to your satisfaction. Working out something more precise and general would take me more time than I have left at this instant. But I think you'll have no difficulty in taking it the extra step.

The first few steps are unchanged.

Here I copy your procedure for the top 2 row-panels, not adding back the tweaked axes at the bottom:

# do not add back the bottom lhs axis
for(i in 1:(length(axis_idx)-1)) {
    ax <- ga[[axis_idx[i]]]$children$axis
    ax$widths <- rev(ax$widths)
    ax$grobs <- rev(ax$grobs)
    ax$grobs[[1]]$x <- ax$grobs[[1]]$x - unit(1, "npc") + unit(0.15, "cm")
    g <- gtable_add_cols(g, 
        g2$widths[g2$layout[ia[axis_idx[i]], ]$l], length(g$widths) - 1)
    g <- gtable_add_grob(g, 
        ax, pp$t[axis_idx[i]], length(g$widths) - i, pp$b[axis_idx[i]])
}

Here I treat the bottom row separately. This is the bit where I have not generalized. You'll need to tweak the distances between the ticks and the vertical axis a bit. You'll also need to generalize the indexing for cases where there is only one plot at the bottom, 2 plots, etc..

# Here I fix the index ``i`` to 3, to cater for your example.
i <- length(axis_idx)
    ax <- ga[[axis_idx[i]]]$children$axis
    ax$widths <- rev(ax$widths)
    ax$grobs <- rev(ax$grobs)
    ax$grobs[[1]]$x <- ax$grobs[[1]]$x - unit(1, "npc") + unit(0.15, "cm")
    g <- gtable_add_cols(g, g2$widths[3], 12)
    g <- gtable_add_grob(g, ax, pp$t[axis_idx[i]], length(g$widths) - 9, pp$b[axis_idx[i]])

The bits that need to be generalized are the numbers 12 and 9. The bit that probably needs to be tweaked is the line with unit(0.15, "cm") to get more space than there appears to be at the moment.

To begin with your g object has width 12, which is the 3 by 3 panel plus 3 vertical axes. Then you add a column to cater for the second axis, and you obtain a width of 15. The number 12 is chosen to be on the rhs of the bottom plot. The number 9 is chosen to place the second axis there. I think.

这篇关于双Y轴与facet_wrap一起使用的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！