添加“浮动”在facet_wrap图中显示轴标签 [英] add "floating" axis labels in facet_wrap plot
问题描述
我遇到与中，Andrie建议可以完成手动在 grid 中，但我不知道如何开始。
如果我没有记错，那么如何将所有标签添加到最后一列下的同一行以及如何将这些最后一个标签提升到下一行，都存在疑问。所以这里是两种情况下的函数：
编辑：因为这就像 print.ggplot （见 getAnywhere（print.ggplot））我已经添加了一些行来保存功能。
编辑2：我改进了一点：不需要指定 nrow 和 ncol
$ b $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $
$ pos - 在哪里添加新标签
＃newpage，vp - see？print.ggplot
facetAdjust< - function（x，pos = c（up，down），
newpage = is.null（vp），vp = NULL）
{
＃print.ggplot的一部分
ggplot2 ::: set_last_plot（x）
if（newpage）
grid.newpage（）
pos< - match.arg（pos）
p< - ggplot_build（x）
gtable< - ggplot_gtable（p）
＃找到尺寸
dims< - apply（p $ panel $ layout [2：3]，2，max）
nrow < - dims [1]
ncol < - dims [2]
＃在图中面板的数量
面板< - sum（grepl（panel，names（gtable $ grobs）））
space< - ncol * nrow
＃缺少面板
n< - 空格 - 面板
＃检查是否需要修改
if（panels！= space）{
＃indices of面板来修复
idx< - （space - ncol - n + 1）:( space - ncol）
＃将最后一个现有面板的x轴复制到所选面板
＃in
以上的行gtable $ grobs [paste0（axis_b，idx）]< - list（gtable $ grobs [[paste0（axis_b，panels）]]）
if（pos == down）{
＃if pos == down然后将标签向下移动到与
＃相同的水平最后面板的x轴
行
}
}
＃再次成为print.ggplot的一部分，绘制调整后的版本
if（is.null（vp））{
grid.draw（gtable）
}
else {
if（is.character（vp））
seekViewport（vp）$ b $ else pushViewport（vp）
grid.draw（gtable）
upViewport（）
}
隐形（p）
}
$ b
以下是它的样子
d < - ggplot（钻石，aes（克拉，价格，fill = ..density ..））+
xlim（0，2）+ stat_binhex（na.rm = TRUE）+主题（aspect.ratio = 1）+
facet_wrap（〜color）
facetAdjust（d）
facetAdjust（d ，down）
编辑3：
这是另一种解决方案n，上面的一个也没有问题。
有一些问题想要将 ggsave 与 facetAdjust 。因为 ggsave 的源代码中有两个部分：，所以 > print（plot）和 default_name（plot）以防手动提供文件名（根据？ggsave不过，它似乎不应该起作用）。因此，给定一个文件名，有一个解决方法（在某些情况下可能带有副作用）：
gtable 对象，但是我们使用 class（gtable）< -c（facetAdjust，gtable，ggplot ）。通过这种方式，可以使用 ggsave 和 print（plot）按要求工作（见 print.facetAdjust ） facetAdjust< - function（x，pos = c （up，down））
{
pos< - match.arg（pos）
p< - ggplot_build（x）
gtable< - ggplot_gtable（ p）; dev.off（）
dims< - apply（p $ panel $ layout [2：3]，2，max）
nrow < - dims [1]
ncol < - dims [2]
面板< - sum（grepl（panel，names（gtable $ grobs）））
space < - ncol * nrow
n < - space - panels
if（panels！= space）{
idx< - （space - ncol - n + 1）:( space - ncol）
gtable $ grobs [paste0（axis_b，idx） ]< - list（gtable $ grobs [[paste0（axis_b，panels）]]）
if（pos ==down）{
rows< - grep（paste0（axis_b （paste0（），$，$，$，$， gtable $布局$布局[row，c（t，b）]< - gtable $ layout [lastAxis，c（ （gtable）< -c（facetAdjust，gtable，ggplot）; gtable
$ / code> 打印函数与<$ c $的区别仅在几行c> ggplot2 ::: print.ggplot ：
print.facetAdjust< - function（x ，newpage = is.null（vp），vp = NULL）{
if（newpage）
grid.newpage（）
if（is.null（vp））{
grid.draw（x）
} else {
if（is.character（vp））
seekViewport（vp）
else pushViewport（vp）
grid.draw （x）
upViewport（）
}
隐形（x）
}
d < - ggplot（钻石，aes（克拉，价格，填充=。 .density ..））+
xlim（0，2）+ stat_binhex（na.rm = TRUE）+ theme（aspect.ratio = 1）+
facet_wrap（〜color）
p< ; - facetAdjust（d）＃无输出
print（p）＃与旧版本facetAdjust（）相同的输出
ggsave（name.pdf，p）＃Works，文件名是必要的
I have the same problem as this user - I have a 'jagged' faceted plot, in which the bottom row has fewer panels than the other rows, and I would like to have x-axis ticks on the bottom of each column.
The suggested solution for that problem was to set scales="free_x". (In ggplot 0.9.2.1; I believe the behavior I'm looking for was default in earlier versions.) That's a poor solution in my case: my actual axis labels will be rather long, so putting them under each row will occupy too much room. The results are something like this:
x <- gl(3, 1, 15, labels=paste("this is a very long axis label ", letters[1:5]))
y <- rnorm(length(x))
l <- gl(5, 3, 15)
d <- data.frame(x=x, y=y, l=l)
ggplot(d, aes(x=x, y=y)) + geom_point() + facet_wrap(~l, scales="free_x") +
theme(axis.text.x=element_text(angle=90, hjust=1))
In a comment here, Andrie suggests that it can be done manually in grid but I have no idea how to get started on that.
If I remember right, there were questions on both how to add all labels to the same line under the last column and how to lift these last labels up to the next row. So here is the function for both cases:
Edit: since this is like a substitute for print.ggplot (see getAnywhere(print.ggplot)) I have added some lines from it to preserve functionality.
Edit 2: I have improved it a bit more: no need to specify nrow and ncol anymore, plots with all the panels can be printed too.
library(grid)
# pos - where to add new labels
# newpage, vp - see ?print.ggplot
facetAdjust <- function(x, pos = c("up", "down"),
newpage = is.null(vp), vp = NULL)
{
# part of print.ggplot
ggplot2:::set_last_plot(x)
if(newpage)
grid.newpage()
pos <- match.arg(pos)
p <- ggplot_build(x)
gtable <- ggplot_gtable(p)
# finding dimensions
dims <- apply(p$panel$layout[2:3], 2, max)
nrow <- dims[1]
ncol <- dims[2]
# number of panels in the plot
panels <- sum(grepl("panel", names(gtable$grobs)))
space <- ncol * nrow
# missing panels
n <- space - panels
# checking whether modifications are needed
if(panels != space){
# indices of panels to fix
idx <- (space - ncol - n + 1):(space - ncol)
# copying x-axis of the last existing panel to the chosen panels
# in the row above
gtable$grobs[paste0("axis_b",idx)] <- list(gtable$grobs[[paste0("axis_b",panels)]])
if(pos == "down"){
# if pos == down then shifting labels down to the same level as
# the x-axis of last panel
rows <- grep(paste0("axis_b\\-[", idx[1], "-", idx[n], "]"),
gtable$layout$name)
lastAxis <- grep(paste0("axis_b\\-", panels), gtable$layout$name)
gtable$layout[rows, c("t","b")] <- gtable$layout[lastAxis, c("t")]
}
}
# again part of print.ggplot, plotting adjusted version
if(is.null(vp)){
grid.draw(gtable)
}
else{
if (is.character(vp))
seekViewport(vp)
else pushViewport(vp)
grid.draw(gtable)
upViewport()
}
invisible(p)
}
And here is how it looks
d <- ggplot(diamonds, aes(carat, price, fill = ..density..)) +
xlim(0, 2) + stat_binhex(na.rm = TRUE) + theme(aspect.ratio = 1) +
facet_wrap(~ color)
facetAdjust(d)
facetAdjust(d, "down")
Edit 3:
This is an alternative solution, the one above is fine as well.
There are some issues when one wants to use ggsave together with facetAdjust. A plot of class of ggplot is required because of two parts in the source code of ggsave: print(plot) and default_name(plot) in case one does not provide a filename manually (according to ?ggsave it seems that it is not supposed to work, though). Hence, given a filename, there is a workaround (possibly with side effects in some cases):
First, let us consider the separate function that achieves the main effect of floating axis. Normally, it would return a gtable object, however we use class(gtable) <- c("facetAdjust", "gtable", "ggplot"). In this way, it is allowed to use ggsave and print(plot) works as required (see below for print.facetAdjust)
facetAdjust <- function(x, pos = c("up", "down"))
{
pos <- match.arg(pos)
p <- ggplot_build(x)
gtable <- ggplot_gtable(p); dev.off()
dims <- apply(p$panel$layout[2:3], 2, max)
nrow <- dims[1]
ncol <- dims[2]
panels <- sum(grepl("panel", names(gtable$grobs)))
space <- ncol * nrow
n <- space - panels
if(panels != space){
idx <- (space - ncol - n + 1):(space - ncol)
gtable$grobs[paste0("axis_b",idx)] <- list(gtable$grobs[[paste0("axis_b",panels)]])
if(pos == "down"){
rows <- grep(paste0("axis_b\\-[", idx[1], "-", idx[n], "]"),
gtable$layout$name)
lastAxis <- grep(paste0("axis_b\\-", panels), gtable$layout$name)
gtable$layout[rows, c("t","b")] <- gtable$layout[lastAxis, c("t")]
}
}
class(gtable) <- c("facetAdjust", "gtable", "ggplot"); gtable
}
The function for printing which differs only by few lines from ggplot2:::print.ggplot:
print.facetAdjust <- function(x, newpage = is.null(vp), vp = NULL) {
if(newpage)
grid.newpage()
if(is.null(vp)){
grid.draw(x)
} else {
if (is.character(vp))
seekViewport(vp)
else pushViewport(vp)
grid.draw(x)
upViewport()
}
invisible(x)
}
Example:
d <- ggplot(diamonds, aes(carat, price, fill = ..density..)) +
xlim(0, 2) + stat_binhex(na.rm = TRUE) + theme(aspect.ratio = 1) +
facet_wrap(~ color)
p <- facetAdjust(d) # No output
print(p) # The same output as with the old version of facetAdjust()
ggsave("name.pdf", p) # Works, a filename is necessary
这篇关于添加“浮动”在facet_wrap图中显示轴标签的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
