在R中结合grid_arrange_shared_legend（）和facet_wrap_labeller（） [英] Combining grid_arrange_shared_legend() and facet_wrap_labeller() in R
问题描述
我试图在R中结合 grid_arrange_shared_legend（）和 facet_wrap_labeller（）。更具体地说，我想绘制一个包含两个ggplot图的图，每个图都有多个面板，并且有一个共同的图例。我进一步想要斜体标签的一部分。前者可以通过 grid_arrange_shared_legend（）函数引入这里，后者可以通过 facet_wrap_labeller（）函数实现here 。然而，我还没有成功地将两者结合在一起。
下面是一个例子。
<
$ lt; - data.frame（
f1 = rep（LETTERS [1：3]，each = 100）; code> library（ggplot2）
set.seed（1）
d< ），
f2 = rep（字母[1：3]，100），
v1 = runif（3 * 100），
v2 = rnorm（3 * 100）
）
p1 < - ggplot（d，aes（v1，v2，color = f2））+ geom_point（）+ facet_wrap（〜f1）
p2 < - ggplot（d，aes（v1，v2 ，color = f2））+ geom_smooth（）+ facet_wrap（〜f1）
我可以将p1和p2在同一图中，并且使用 grid_arrange_shared_legend（）（从原始版本稍作修改）使用一个共同的图例。
<$ p $（< - list（...）
g< - ggplotGrob（plots [[1]] + ...
grid_arrange_shared_legend< theme（legend.position =right））$ grobs
legend< - g [[which（sapply（g，function（x）x $ name）==guide-box）]]
lheight< - sum（legend $ width）
grid。 （
do.call（arrangeGrob，lapply（plots，function（x）
x + theme（legend.position =none））），
legend，
ncol = 2，
widths = unit.c（unit（1，npc） - lheight，lheight））
}
grid_arrange_shared_legend（p1，p2）
这就是我得到的。
它可以通过 facet_wrap_labeller（）来将部分条形标签斜体显示出来。
facet_wrap_labeller< - function（gg.plot，labels = NULL）{
require（gridExtra）
g< - ggplotGrob（gg.plot）
gg< - g $ grobs
strips< - grep（strip_t，names（gg））
for（ii in seq_along（labels））{
modgrob< - getGrob（gg [[strips [ii]]]，strip.text，
grep = TRUE，global = TRUE）
gg [[strips [ii]]] $ children [[modgrob $ name]]< ; - editGrob（modgrob，label = labels [ii]）
}
g $ grobs< - gg
class（g）= c（arrange，ggplot，class（g ））
facet_wrap_labeller（p1，
labels = c（
expression（paste（A，italic（italic））），
表达式（paste（B，italic（italic））），
表达式（paste（C，italic（italic）））
）
）
然而，我不能以直截了当的方式将这两者结合在一起。
< code表达式（paste（A，italic（italic））），
表达式（paste（B ，斜体（斜体））），
表达式（paste（C，italic（italic）））
）
）
p4 < - facet_wrap_labeller（p2，
表达式（paste（A，italic（italic））），
表达式（paste（B，italic（italic））），
表达式（paste（C，italic（italic）））
）
）
grid_arrange_shared_legend（p3，p4）
＃plot_clone（p）函数
有谁知道如何修改其中一个或两个函数，以便它们可以合并？或者有没有其他方法可以实现这个目标？
您需要传递gtable而不是ggplot，
库（gtable）
库（ggplot2）
库（网格）
set.seed （1）
d< - data.frame（
f1 = rep（LETTERS [1：3]，each = 100），
f2 = rep（字母[1：3]，100 ），
v1 = runif（3 * 100），
v2 = rnorm（3 * 100）
）
p1 < - ggplot（d，aes（v1，v2，颜色= f2））+ geom_point（）+ facet_wrap（〜f1）
p2 <-ggplot（d，aes（v1，v2，color = f2））+ geom_smooth（）+ facet_wrap
$ b facet_wrap_labeller< - function（g，labels = NULL）{
gg< - g $ grobs
strips< - grep（strip_t （gg））
for（ii in seq_along（labels））{
oldgrob< - getGrob（gg [[strips [ii]]]，strip.text ，
grep = TRUE，global = TRUE）
newgrob < - editGrob（oldgrob，label = labels [ii]）
gg [[strips [ii]]] $ children [[oldgrob $名称]]< - newgrob
}
g $ grobs< - gg
g
}
combined_fun< - function（p1 ，p2，labs1）{
g1 < - ggplotGrob（p1 + theme（legend.position =right））
g2 < - ggplotGrob（p2 + theme（legend.position =none））
g1 < - facet_wrap_labeller（g1，labs1）
图例< - gtable_filter（g1，guide-box，trim = TRUE）
g1p <-g1 [， - （ncol（g1）-1）]
lw < - sum（legend $ width）
g12 < - rbind（g1p ，g2，size =first）
g12 $ widths < - unit.pmax（g1p $ widths，g2 $ widths）
g12 < - gtable_add_cols（g12，widths = lw）
g12
g12
}
test < - combined_fun（p1，p2，labs1 = c（
expression（paste（A，italic（italic））），
expression（paste（B，italic （斜体））），
表达式（粘贴（C ，斜体（斜体）））
）
）
grid.draw（test）
I am trying to combine grid_arrange_shared_legend() and facet_wrap_labeller() in R. More specifically, I want to draw a figure including two ggplot figures with multiple panels each and have a common legend. I further want to italicize part of the facet strip labels. The former is possible with the grid_arrange_shared_legend() function introduced here, and the latter can be achieved with the facet_wrap_labeller() function here. However, I have not been successful in combining the two.
Here's an example.
library("ggplot2")
set.seed(1)
d <- data.frame(
f1 = rep(LETTERS[1:3], each = 100),
f2 = rep(letters[1:3], 100),
v1 = runif(3 * 100),
v2 = rnorm(3 * 100)
)
p1 <- ggplot(d, aes(v1, v2, color = f2)) + geom_point() + facet_wrap(~f1)
p2 <- ggplot(d, aes(v1, v2, color = f2)) + geom_smooth() + facet_wrap(~f1)
I can place p1 and p2 in the same figure and have a common legend using grid_arrange_shared_legend() (slightly modified from the original).
grid_arrange_shared_legend <- function(...) {
plots <- list(...)
g <- ggplotGrob(plots[[1]] + theme(legend.position = "right"))$grobs
legend <- g[[which(sapply(g, function(x) x$name) == "guide-box")]]
lheight <- sum(legend$width)
grid.arrange(
do.call(arrangeGrob, lapply(plots, function(x)
x + theme(legend.position = "none"))),
legend,
ncol = 2,
widths = unit.c(unit(1, "npc") - lheight, lheight))
}
grid_arrange_shared_legend(p1, p2)
Here's what I get.
It is possible to italicize part of the strip label by facet_wrap_labeller().
facet_wrap_labeller <- function(gg.plot,labels=NULL) {
require(gridExtra)
g <- ggplotGrob(gg.plot)
gg <- g$grobs
strips <- grep("strip_t", names(gg))
for(ii in seq_along(labels)) {
modgrob <- getGrob(gg[[strips[ii]]], "strip.text",
grep=TRUE, global=TRUE)
gg[[strips[ii]]]$children[[modgrob$name]] <- editGrob(modgrob,label=labels[ii])
}
g$grobs <- gg
class(g) = c("arrange", "ggplot",class(g))
g
}
facet_wrap_labeller(p1,
labels = c(
expression(paste("A ", italic(italic))),
expression(paste("B ", italic(italic))),
expression(paste("C ", italic(italic)))
)
)
However, I cannot combine the two in a straightforward manner.
p3 <- facet_wrap_labeller(p1,
labels = c(
expression(paste("A ", italic(italic))),
expression(paste("B ", italic(italic))),
expression(paste("C ", italic(italic)))
)
)
p4 <- facet_wrap_labeller(p2,
labels = c(
expression(paste("A ", italic(italic))),
expression(paste("B ", italic(italic))),
expression(paste("C ", italic(italic)))
)
)
grid_arrange_shared_legend(p3, p4)
# Error in plot_clone(p) : attempt to apply non-function
Does anyone know how to modify either or both of the functions so that they can be combined? Or is there any other way to achieve the goal?
You need to pass the gtable instead of the ggplot,
library(gtable)
library("ggplot2")
library(grid)
set.seed(1)
d <- data.frame(
f1 = rep(LETTERS[1:3], each = 100),
f2 = rep(letters[1:3], 100),
v1 = runif(3 * 100),
v2 = rnorm(3 * 100)
)
p1 <- ggplot(d, aes(v1, v2, color = f2)) + geom_point() + facet_wrap(~f1)
p2 <- ggplot(d, aes(v1, v2, color = f2)) + geom_smooth() + facet_wrap(~f1)
facet_wrap_labeller <- function(g, labels=NULL) {
gg <- g$grobs
strips <- grep("strip_t", names(gg))
for(ii in seq_along(labels)) {
oldgrob <- getGrob(gg[[strips[ii]]], "strip.text",
grep=TRUE, global=TRUE)
newgrob <- editGrob(oldgrob,label=labels[ii])
gg[[strips[ii]]]$children[[oldgrob$name]] <- newgrob
}
g$grobs <- gg
g
}
combined_fun <- function(p1, p2, labs1) {
g1 <- ggplotGrob(p1 + theme(legend.position = "right"))
g2 <- ggplotGrob(p2 + theme(legend.position = "none"))
g1 <- facet_wrap_labeller(g1, labs1)
legend <- gtable_filter(g1, "guide-box", trim = TRUE)
g1p <- g1[,-(ncol(g1)-1)]
lw <- sum(legend$width)
g12 <- rbind(g1p, g2, size="first")
g12$widths <- unit.pmax(g1p$widths, g2$widths)
g12 <- gtable_add_cols(g12, widths = lw)
g12 <- gtable_add_grob(g12, legend,
t = 1, l = ncol(g12), b = nrow(g12))
g12
}
test <- combined_fun(p1, p2, labs1 = c(
expression(paste("A ", italic(italic))),
expression(paste("B ", italic(italic))),
expression(paste("C ", italic(italic)))
)
)
grid.draw(test)
这篇关于在R中结合grid_arrange_shared_legend（）和facet_wrap_labeller（）的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
