如何在 pdf 的多个页面上绘制多个 ggplot_gtable objects？
How to plot multiple ggplot_gtable objects on multiple pages of a pdf?
这不是一个重复的问题，虽然标题可能看起来相似。
假设我有一个函数 f1()，它绘制了 class "gTable,grob,gDesc" 的 object 一次。我正在使用 grid.draw() 绘制 object.
所以当我们调用时：
pdf("filename.pdf", height = 10, weight =12)
f1()
dev.off()
这将提供一页 pdf，这正是我想要的。
然而，当我想通过代码在一个 pdf 中包含两个图时：
pdf("filename.pdf")
f1()
f1()
dev.off()
我得到的是单页 pdf，只有第二页 plot.That 是第一页被第二页覆盖了。为了克服这个问题，我使用 grid.newpage() 但这会在 pdf 中添加一个额外的空白页。如何避免这种情况？只有在设置了参数的情况下，我才能使用额外的参数来创建新页面。但是我们还有其他选择吗？
我玩过 grid.arrange() 以及 pdf() 中的 onefile 参数，但没有任何效果。
此外，当我尝试在 R 图上绘制这些时 window 然后它会覆盖现有的打开图形设备。所以在第二次绘制后，我无法使用后退箭头查看第一个图。
back arrow of R plot window
编辑：绘制 class "gTable, grob, gDesc"
的 object 的示例 R 代码
xxx <- function(){
set.seed(1111)
dd <- diamonds[sample(1:nrow(diamonds), 1000, replace = TRUE), ]
dd$color <- sample(letters[1:2], 1000, replace = TRUE)
p <- ggplot(data = dd, aes(x = cut))
p1 <- p + geom_bar(fill = "orange", alpha = 1) + facet_wrap(~color)+
ggtitle("Main title")+scale_y_continuous("frequency", expand = c(0, 0))+
labs(x = "cut", y = "frequency")+
theme(panel.background = element_rect(colour = "white"),
axis.text.x = element_text(angle = 45, hjust = 1),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
legend.position = "bottom")
p2 <- p + geom_line(aes(y = price), alpha = 0)+
labs(x = "", y = "price")+expand_limits(y = 0) +
stat_summary(aes(y = price, group = 1, colour = "mean"), fun.y = "mean", geom = c("point"))+
stat_summary(aes(y = price, group = 1, colour = "mean"), fun.y = "mean", geom = c("line"))+
stat_summary(aes(y = price, group = 1, colour = "median"), fun.y = "median", geom = "point")+
stat_summary(aes(y = price, group = 1, colour = "median"), fun.y = "median", geom = "line")+
scale_colour_manual(name = "" ,breaks = c("mean", "median"), values = c("red", "blue"))+
facet_wrap(~color)+ylab("Exposures")+
theme(panel.background = element_rect(fill = NA, colour = "white"),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.border = element_rect(fill = NA, colour = "grey50"),
legend.position = "bottom")
xx <- ggplot_build(p1)
yy <- ggplot_build(p2)
nrow <- length(unique(xx$panel$layout$ROW))
ncol <- length(unique(xx$panel$layout$COL))
npanel <- length(xx$panel$layout$PANEL)
g1 <- ggplot_gtable(xx)
g2 <- ggplot_gtable(yy)
pp <- c(subset(g1$layout, grepl("panel", g1$layout$name), se = t:r))
g <- gtable_add_grob(g1, g2$grobs[grepl("panel", g1$layout$name)],
pp$t, pp$l, pp$b, pp$l)
func1 <- function(grob){
widths <- grob$widths
grob$widths[1] <- widths[3]
grob$widths[3] <- widths[1]
grob$vp[[1]]$layout$widths[1] <- widths[3]
grob$vp[[1]]$layout$widths[3] <- widths[1]
grob$children[[1]]$hjust <- 1 - grob$children[[1]]$hjust
grob$children[[1]]$vjust <- 1 - grob$children[[1]]$vjust
grob$children[[1]]$x <- unit(1, "npc") - grob$children[[1]]$x
grob
}
index <- which(g2$layout$name == "ylab")
ylab <- g2$grobs[[index]] # Extract that grob
ylab <- func1(ylab)
ylab$children[[1]]$rot <- ylab$children[[1]]$rot + 180
g <- gtable_add_cols(g, g2$widths[g2$layout[index, ]$l], pos = max(pp$r))
g <-gtable_add_grob(g,ylab, t = min(pp$t), l = max(pp$r)+1,
b = max(pp$b), r = max(pp$r)+1,
clip = "off", name = "2ndylab")
j = 1
k = 0
for(i in 1:npanel){
if ((i %% ncol == 0) || (i == npanel)){
k = k + 1
# swap the 2nd y-axis label
index <- which(g2$layout$name == "axis_l-1") # Which grob
yaxis <- g2$grobs[[index]] # Extract the grob
ticks <- yaxis$children[[2]]
ticks$widths <- rev(ticks$widths)
ticks$grobs <- rev(ticks$grobs)
ticks$grobs[[1]]$x <- ticks$grobs[[1]]$x - unit(1, "npc")
ticks$grobs[[2]] <- func1(ticks$grobs[[2]])
yaxis$children[[2]] <- ticks
if ((k == 1) || ((i == npanel) & (i%%ncol != 0)))#to ensure just once d secondary axisis printed
g <- gtable_add_cols(g,g2$widths[g2$layout[index,]$l], max(pp$r[j:i]))
g <- gtable_add_grob(g,yaxis,max(pp$t[j:i]),max(pp$r[j:i])+1, max(pp$b[j:i])
, max(pp$r[j:i]) + 1, clip = "off", name = "2ndaxis")
j = i + 1
}
}
pp <- c(subset(g2$layout, name == "guide-box", se = t:r))
g <- gtable_add_grob(g, g2$grobs[[which(g2$layout$name == "guide-box")]], t = pp$t,
l = pp$r, b = pp$b, r = pp$r )
grid.draw(g)
}
这是一个示例函数。因此，如果我调用以下代码：
pdf("zzz.pdf")
xxx()
xxx()
dev.off()
上面的例子只创建了一页pdf。如果你简单地调用
xxx()
xxx()
然后在R图中window我只能查看第二个图。由于第一个图被覆盖，后退箭头按钮被禁用。
解决方法是在第一个plot之后使用grid.newpage()，
xxx <- function() {gg <- ggplotGrob(ggplot()); grid.draw(gg)}
pdf("zzz.pdf")
xxx()
grid.newpage()
xxx()
dev.off()
您可能会发现使用函数 return 比绘制它更容易，并为要显示的此类对象的列表定义 print/draw 方法。有关此类策略，请参阅 gridExtra:::print.arrangelist，
xxx <- function() {gg <- ggplotGrob(ggplot()); gg}
plots <- marrangeGrob(replicate(3, xxx(), simplify = FALSE), nrow=1, ncol=1)
pdf("zzz.pdf")
print(plots)
dev.off()
这不是一个重复的问题，虽然标题可能看起来相似。
假设我有一个函数 f1()，它绘制了 class "gTable,grob,gDesc" 的 object 一次。我正在使用 grid.draw() 绘制 object.
所以当我们调用时：
pdf("filename.pdf", height = 10, weight =12)
f1()
dev.off()
这将提供一页 pdf，这正是我想要的。
然而，当我想通过代码在一个 pdf 中包含两个图时：
pdf("filename.pdf")
f1()
f1()
dev.off()
我得到的是单页 pdf，只有第二页 plot.That 是第一页被第二页覆盖了。为了克服这个问题，我使用 grid.newpage() 但这会在 pdf 中添加一个额外的空白页。如何避免这种情况？只有在设置了参数的情况下，我才能使用额外的参数来创建新页面。但是我们还有其他选择吗？
我玩过 grid.arrange() 以及 pdf() 中的 onefile 参数，但没有任何效果。
此外，当我尝试在 R 图上绘制这些时 window 然后它会覆盖现有的打开图形设备。所以在第二次绘制后，我无法使用后退箭头查看第一个图。 back arrow of R plot window
编辑：绘制 class "gTable, grob, gDesc"
的 object 的示例 R 代码xxx <- function(){
set.seed(1111)
dd <- diamonds[sample(1:nrow(diamonds), 1000, replace = TRUE), ]
dd$color <- sample(letters[1:2], 1000, replace = TRUE)
p <- ggplot(data = dd, aes(x = cut))
p1 <- p + geom_bar(fill = "orange", alpha = 1) + facet_wrap(~color)+
ggtitle("Main title")+scale_y_continuous("frequency", expand = c(0, 0))+
labs(x = "cut", y = "frequency")+
theme(panel.background = element_rect(colour = "white"),
axis.text.x = element_text(angle = 45, hjust = 1),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
legend.position = "bottom")
p2 <- p + geom_line(aes(y = price), alpha = 0)+
labs(x = "", y = "price")+expand_limits(y = 0) +
stat_summary(aes(y = price, group = 1, colour = "mean"), fun.y = "mean", geom = c("point"))+
stat_summary(aes(y = price, group = 1, colour = "mean"), fun.y = "mean", geom = c("line"))+
stat_summary(aes(y = price, group = 1, colour = "median"), fun.y = "median", geom = "point")+
stat_summary(aes(y = price, group = 1, colour = "median"), fun.y = "median", geom = "line")+
scale_colour_manual(name = "" ,breaks = c("mean", "median"), values = c("red", "blue"))+
facet_wrap(~color)+ylab("Exposures")+
theme(panel.background = element_rect(fill = NA, colour = "white"),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.border = element_rect(fill = NA, colour = "grey50"),
legend.position = "bottom")
xx <- ggplot_build(p1)
yy <- ggplot_build(p2)
nrow <- length(unique(xx$panel$layout$ROW))
ncol <- length(unique(xx$panel$layout$COL))
npanel <- length(xx$panel$layout$PANEL)
g1 <- ggplot_gtable(xx)
g2 <- ggplot_gtable(yy)
pp <- c(subset(g1$layout, grepl("panel", g1$layout$name), se = t:r))
g <- gtable_add_grob(g1, g2$grobs[grepl("panel", g1$layout$name)],
pp$t, pp$l, pp$b, pp$l)
func1 <- function(grob){
widths <- grob$widths
grob$widths[1] <- widths[3]
grob$widths[3] <- widths[1]
grob$vp[[1]]$layout$widths[1] <- widths[3]
grob$vp[[1]]$layout$widths[3] <- widths[1]
grob$children[[1]]$hjust <- 1 - grob$children[[1]]$hjust
grob$children[[1]]$vjust <- 1 - grob$children[[1]]$vjust
grob$children[[1]]$x <- unit(1, "npc") - grob$children[[1]]$x
grob
}
index <- which(g2$layout$name == "ylab")
ylab <- g2$grobs[[index]] # Extract that grob
ylab <- func1(ylab)
ylab$children[[1]]$rot <- ylab$children[[1]]$rot + 180
g <- gtable_add_cols(g, g2$widths[g2$layout[index, ]$l], pos = max(pp$r))
g <-gtable_add_grob(g,ylab, t = min(pp$t), l = max(pp$r)+1,
b = max(pp$b), r = max(pp$r)+1,
clip = "off", name = "2ndylab")
j = 1
k = 0
for(i in 1:npanel){
if ((i %% ncol == 0) || (i == npanel)){
k = k + 1
# swap the 2nd y-axis label
index <- which(g2$layout$name == "axis_l-1") # Which grob
yaxis <- g2$grobs[[index]] # Extract the grob
ticks <- yaxis$children[[2]]
ticks$widths <- rev(ticks$widths)
ticks$grobs <- rev(ticks$grobs)
ticks$grobs[[1]]$x <- ticks$grobs[[1]]$x - unit(1, "npc")
ticks$grobs[[2]] <- func1(ticks$grobs[[2]])
yaxis$children[[2]] <- ticks
if ((k == 1) || ((i == npanel) & (i%%ncol != 0)))#to ensure just once d secondary axisis printed
g <- gtable_add_cols(g,g2$widths[g2$layout[index,]$l], max(pp$r[j:i]))
g <- gtable_add_grob(g,yaxis,max(pp$t[j:i]),max(pp$r[j:i])+1, max(pp$b[j:i])
, max(pp$r[j:i]) + 1, clip = "off", name = "2ndaxis")
j = i + 1
}
}
pp <- c(subset(g2$layout, name == "guide-box", se = t:r))
g <- gtable_add_grob(g, g2$grobs[[which(g2$layout$name == "guide-box")]], t = pp$t,
l = pp$r, b = pp$b, r = pp$r )
grid.draw(g)
}
这是一个示例函数。因此，如果我调用以下代码：
pdf("zzz.pdf")
xxx()
xxx()
dev.off()
上面的例子只创建了一页pdf。如果你简单地调用
xxx()
xxx()
然后在R图中window我只能查看第二个图。由于第一个图被覆盖，后退箭头按钮被禁用。
解决方法是在第一个plot之后使用grid.newpage()，
xxx <- function() {gg <- ggplotGrob(ggplot()); grid.draw(gg)}
pdf("zzz.pdf")
xxx()
grid.newpage()
xxx()
dev.off()
您可能会发现使用函数 return 比绘制它更容易，并为要显示的此类对象的列表定义 print/draw 方法。有关此类策略，请参阅 gridExtra:::print.arrangelist，
xxx <- function() {gg <- ggplotGrob(ggplot()); gg}
plots <- marrangeGrob(replicate(3, xxx(), simplify = FALSE), nrow=1, ncol=1)
pdf("zzz.pdf")
print(plots)
dev.off()