如何将 grob 存储在列表中并将它们传递给 grobTree()?
How can I store grobs in a list and pass them to grobTree()?
所以我试图制作一个 grobs 列表,然后将它们传递给 grobTree()
,但是我的列表项没有被 do.call()
作为 grobs 读入。
这是我的代码:
library(purrr)
library(grid)
library(gridExtra)
library(ggplot2)
qplot(displ, year, data = mpg)
title_segments <- c('Help ', 'me ', 'please', '!')
colors <- c('red', 'orange', 'green', 'blue')
nudge_x = 0
grobs <- NULL
grobs[1] <- list(gp = gpar(fontsize = 14, fontface = 'bold'))
grobs[2] <- list(textGrob(label = title_segments[1], name = "title1",
x = unit(2.33 - nudge_x, "lines"),
y = unit(-.5, "lines"),
hjust = 0, vjust = 0, gp = gpar(col = colors[1])))
if(length(title_segments) > 1){
x <- unit(2.24 - nudge_x, "lines")
more_grobs <- pmap(list(title_segments[-1], colors[-1],
seq_along(title_segments)[-1]), function(segment, color, i){
grob <- textGrob(label = segment, name = paste0('title', i, sep = ''),
x = x + grobWidth(paste0('title', i - 1, sep = '')),
y = unit(-.5, "lines"),
hjust = 0, vjust = 0, gp = gpar(col = color))
})
}
grobs <- c(grobs, more_grobs)
grobs <- do.call(what = grobTree, args = grobs) ### ERROR HERE
# Turn off clipping and draw plot
gb <- ggplot_build(last_plot())
gt <- ggplot_gtable(gb)
gt$layout$clip[gt$layout$name=="panel"] <- "off"
gg <- arrangeGrob(gt, top = grobs, padding = unit(2.6, "line"))
grid.newpage()
grid.draw(gg)
当我到达 do.call()
语句时发生错误,因为我的列表元素没有被读取为 grobs。
当我尝试这段代码时,它的计算结果为真。
var <- NULL
is.grob(var <- textGrob(label = title_segments[1], name = "title1",
x = unit(2.33 - nudge_x, "lines"),
y = unit(-.5, "lines"),
hjust = 0, vjust = 0, gp = gpar(col = colors[1])))
当我尝试这个位时,它的计算结果为 false
var2 <-NULL
var2[1] <- textGrob(label = title_segments[1], name = "title1",
x = unit(2.33 - nudge_x, "lines"),
y = unit(-.5, "lines"),
hjust = 0, vjust = 0, gp = gpar(col = colors[1])))
is.grob(var2[1])
编辑::这就是我试图通过 pmap 函数实现的目标。
grobs <- grobTree(
gp = gpar(fontsize = 14, fontface = 'bold'),
textGrob(label = title_segments[1], name = "title1",
x = unit(2.33 - nudge_x, "lines"),
y = unit(-.5, "lines"),
hjust = 0, vjust = 0, gp = gpar(col = colors[1])),
if(length(title_segments) > 1){
textGrob(label = title_segments[2], name = "title2",
x = grobWidth("title1") + unit(2.24 - nudge_x, "lines"),
y = unit(-.5, "lines"),
hjust = 0, vjust = 0, gp = gpar(col = colors[2]))
},
if(length(title_segments) > 2){
textGrob(label = title_segments[3], name = "title3",
x = grobWidth("title1") + grobWidth("title2") + unit(2.24 - nudge_x, "lines"),
y = unit(-.5, "lines"),
hjust = 0, vjust = 0, gp = gpar(col = colors[3]))
},
if(length(title_segments) > 3){
textGrob(label = title_segments[4], name = "title4",
x = grobWidth("title1") + grobWidth("title2") + grobWidth("title3") + unit(2.24 - nudge_x, "lines"),
y = unit(-.5, "lines"),
hjust = 0, vjust = 0, gp = gpar(col = colors[4]))
},
if(length(title_segments) > 4){
textGrob(label = title_segments[5], name = "title5",
x = grobWidth("title1") + grobWidth("title2") + grobWidth("title3") + grobWidth("title4") + unit(2.24 - nudge_x, "lines"),
y = unit(-.5, "lines"),
hjust = 0, vjust = 0, gp = gpar(col = colors[5]))
}
)
让我们尝试按书面形式回答问题。我读到的问题如下:
此代码有效:
grobs <- grobTree(
gp = gpar(fontsize = 14, fontface = 'bold'),
textGrob(label = title_segments[1], name = "title1",
x = unit(2.33 - nudge_x, "lines"),
y = unit(-.5, "lines"),
hjust = 0, vjust = 0, gp = gpar(col = colors[1])),
if(length(title_segments) > 1){
textGrob(label = title_segments[2], name = "title2",
x = grobWidth("title1") + unit(2.24 - nudge_x, "lines"),
y = unit(-.5, "lines"),
hjust = 0, vjust = 0, gp = gpar(col = colors[2]))
},
if(length(title_segments) > 2){
textGrob(label = title_segments[3], name = "title3",
x = grobWidth("title1") + grobWidth("title2") + unit(2.24 - nudge_x, "lines"),
y = unit(-.5, "lines"),
hjust = 0, vjust = 0, gp = gpar(col = colors[3]))
},
if(length(title_segments) > 3){
textGrob(label = title_segments[4], name = "title4",
x = grobWidth("title1") + grobWidth("title2") + grobWidth("title3") + unit(2.24 - nudge_x, "lines"),
y = unit(-.5, "lines"),
hjust = 0, vjust = 0, gp = gpar(col = colors[4]))
},
if(length(title_segments) > 4){
textGrob(label = title_segments[5], name = "title5",
x = grobWidth("title1") + grobWidth("title2") + grobWidth("title3") + grobWidth("title4") + unit(2.24 - nudge_x, "lines"),
y = unit(-.5, "lines"),
hjust = 0, vjust = 0, gp = gpar(col = colors[5]))
}
)
然而,这段代码是对之前代码的计算重新创建,它不会:
grobs <- NULL
grobs[1] <- list(gp = gpar(fontsize = 14, fontface = 'bold'))
grobs[2] <- list(textGrob(label = title_segments[1], name = "title1",
x = unit(2.33 - nudge_x, "lines"),
y = unit(-.5, "lines"),
hjust = 0, vjust = 0, gp = gpar(col = colors[1])))
if(length(title_segments) > 1){
x <- unit(2.24 - nudge_x, "lines")
more_grobs <- pmap(list(title_segments[-1], colors[-1],
seq_along(title_segments)[-1]), function(segment, color, i){
grob <- textGrob(label = segment, name = paste0('title', i, sep = ''),
x = x + grobWidth(paste0('title', i - 1, sep = '')),
y = unit(-.5, "lines"),
hjust = 0, vjust = 0, gp = gpar(col = color))
})
}
grobs <- c(grobs, more_grobs)
grobs <- do.call(what = grobTree, args = grobs) ### ERROR HERE
这是怎么回事?答案是问题出在前两行:
grobs <- NULL
grobs[1] <- list(gp = gpar(fontsize = 14, fontface = 'bold'))
赋值 grobs[1] <-
删除了列表元素 gp = ...
的命名,因此函数 grobTree()
不理解第一个参数不是 grob。修复很简单。将这两行替换为:
grobs <- list(gp = gpar(fontsize = 14, fontface = 'bold'))
现在一切正常了。 do.call()
行不再导致错误。但是,单词的间距仍然不对,因为 pmap()
调用不会创建从第一个到第 n 个的所有 grob 宽度的总和。相反,它只使用前一个 grob 的 grob 宽度。这个问题最好用递归函数解决,我觉得:
make_grobs <- function(words, colors, x, y, hjust = 0, vjust = 0, i = 0) {
n <- length(words)
colors <- rep_len(colors, n)
name <- paste0('title', i)
grob <- textGrob(label = words[1], name = name,
x = x, y = y, hjust = hjust, vjust = vjust,
gp = gpar(col = colors[1]))
if (n == 1) {
list(grob)
}
else {
c(list(grob),
make_grobs(words[-1], colors[-1],
x + grobWidth(grob), y, hjust, vjust, i + 1))
}
}
定义此函数后,整个可重现示例变为:
library(purrr)
library(grid)
library(gridExtra)
library(ggplot2)
title_segments <- c('Help ', 'me ', 'please', '!')
colors <- c('red', 'orange', 'green', 'blue')
nudge_x = 0
grobs <- do.call(what = grobTree,
args = c(make_grobs(title_segments, colors,
x = unit(2.33 - nudge_x, "lines"),
y = unit(-.5, "lines")),
list(gp = gpar(fontsize = 14, fontface = 'bold'))))
qplot(displ, year, data = mpg)
gb <- ggplot_build(last_plot())
gt <- ggplot_gtable(gb)
gt$layout$clip[gt$layout$name=="panel"] <- "off"
gg <- arrangeGrob(gt, top = grobs, padding = unit(2.6, "line"))
grid.newpage()
grid.draw(gg)
所以我试图制作一个 grobs 列表,然后将它们传递给 grobTree()
,但是我的列表项没有被 do.call()
作为 grobs 读入。
这是我的代码:
library(purrr)
library(grid)
library(gridExtra)
library(ggplot2)
qplot(displ, year, data = mpg)
title_segments <- c('Help ', 'me ', 'please', '!')
colors <- c('red', 'orange', 'green', 'blue')
nudge_x = 0
grobs <- NULL
grobs[1] <- list(gp = gpar(fontsize = 14, fontface = 'bold'))
grobs[2] <- list(textGrob(label = title_segments[1], name = "title1",
x = unit(2.33 - nudge_x, "lines"),
y = unit(-.5, "lines"),
hjust = 0, vjust = 0, gp = gpar(col = colors[1])))
if(length(title_segments) > 1){
x <- unit(2.24 - nudge_x, "lines")
more_grobs <- pmap(list(title_segments[-1], colors[-1],
seq_along(title_segments)[-1]), function(segment, color, i){
grob <- textGrob(label = segment, name = paste0('title', i, sep = ''),
x = x + grobWidth(paste0('title', i - 1, sep = '')),
y = unit(-.5, "lines"),
hjust = 0, vjust = 0, gp = gpar(col = color))
})
}
grobs <- c(grobs, more_grobs)
grobs <- do.call(what = grobTree, args = grobs) ### ERROR HERE
# Turn off clipping and draw plot
gb <- ggplot_build(last_plot())
gt <- ggplot_gtable(gb)
gt$layout$clip[gt$layout$name=="panel"] <- "off"
gg <- arrangeGrob(gt, top = grobs, padding = unit(2.6, "line"))
grid.newpage()
grid.draw(gg)
当我到达 do.call()
语句时发生错误,因为我的列表元素没有被读取为 grobs。
当我尝试这段代码时,它的计算结果为真。
var <- NULL
is.grob(var <- textGrob(label = title_segments[1], name = "title1",
x = unit(2.33 - nudge_x, "lines"),
y = unit(-.5, "lines"),
hjust = 0, vjust = 0, gp = gpar(col = colors[1])))
当我尝试这个位时,它的计算结果为 false
var2 <-NULL
var2[1] <- textGrob(label = title_segments[1], name = "title1",
x = unit(2.33 - nudge_x, "lines"),
y = unit(-.5, "lines"),
hjust = 0, vjust = 0, gp = gpar(col = colors[1])))
is.grob(var2[1])
编辑::这就是我试图通过 pmap 函数实现的目标。
grobs <- grobTree(
gp = gpar(fontsize = 14, fontface = 'bold'),
textGrob(label = title_segments[1], name = "title1",
x = unit(2.33 - nudge_x, "lines"),
y = unit(-.5, "lines"),
hjust = 0, vjust = 0, gp = gpar(col = colors[1])),
if(length(title_segments) > 1){
textGrob(label = title_segments[2], name = "title2",
x = grobWidth("title1") + unit(2.24 - nudge_x, "lines"),
y = unit(-.5, "lines"),
hjust = 0, vjust = 0, gp = gpar(col = colors[2]))
},
if(length(title_segments) > 2){
textGrob(label = title_segments[3], name = "title3",
x = grobWidth("title1") + grobWidth("title2") + unit(2.24 - nudge_x, "lines"),
y = unit(-.5, "lines"),
hjust = 0, vjust = 0, gp = gpar(col = colors[3]))
},
if(length(title_segments) > 3){
textGrob(label = title_segments[4], name = "title4",
x = grobWidth("title1") + grobWidth("title2") + grobWidth("title3") + unit(2.24 - nudge_x, "lines"),
y = unit(-.5, "lines"),
hjust = 0, vjust = 0, gp = gpar(col = colors[4]))
},
if(length(title_segments) > 4){
textGrob(label = title_segments[5], name = "title5",
x = grobWidth("title1") + grobWidth("title2") + grobWidth("title3") + grobWidth("title4") + unit(2.24 - nudge_x, "lines"),
y = unit(-.5, "lines"),
hjust = 0, vjust = 0, gp = gpar(col = colors[5]))
}
)
让我们尝试按书面形式回答问题。我读到的问题如下:
此代码有效:
grobs <- grobTree(
gp = gpar(fontsize = 14, fontface = 'bold'),
textGrob(label = title_segments[1], name = "title1",
x = unit(2.33 - nudge_x, "lines"),
y = unit(-.5, "lines"),
hjust = 0, vjust = 0, gp = gpar(col = colors[1])),
if(length(title_segments) > 1){
textGrob(label = title_segments[2], name = "title2",
x = grobWidth("title1") + unit(2.24 - nudge_x, "lines"),
y = unit(-.5, "lines"),
hjust = 0, vjust = 0, gp = gpar(col = colors[2]))
},
if(length(title_segments) > 2){
textGrob(label = title_segments[3], name = "title3",
x = grobWidth("title1") + grobWidth("title2") + unit(2.24 - nudge_x, "lines"),
y = unit(-.5, "lines"),
hjust = 0, vjust = 0, gp = gpar(col = colors[3]))
},
if(length(title_segments) > 3){
textGrob(label = title_segments[4], name = "title4",
x = grobWidth("title1") + grobWidth("title2") + grobWidth("title3") + unit(2.24 - nudge_x, "lines"),
y = unit(-.5, "lines"),
hjust = 0, vjust = 0, gp = gpar(col = colors[4]))
},
if(length(title_segments) > 4){
textGrob(label = title_segments[5], name = "title5",
x = grobWidth("title1") + grobWidth("title2") + grobWidth("title3") + grobWidth("title4") + unit(2.24 - nudge_x, "lines"),
y = unit(-.5, "lines"),
hjust = 0, vjust = 0, gp = gpar(col = colors[5]))
}
)
然而,这段代码是对之前代码的计算重新创建,它不会:
grobs <- NULL
grobs[1] <- list(gp = gpar(fontsize = 14, fontface = 'bold'))
grobs[2] <- list(textGrob(label = title_segments[1], name = "title1",
x = unit(2.33 - nudge_x, "lines"),
y = unit(-.5, "lines"),
hjust = 0, vjust = 0, gp = gpar(col = colors[1])))
if(length(title_segments) > 1){
x <- unit(2.24 - nudge_x, "lines")
more_grobs <- pmap(list(title_segments[-1], colors[-1],
seq_along(title_segments)[-1]), function(segment, color, i){
grob <- textGrob(label = segment, name = paste0('title', i, sep = ''),
x = x + grobWidth(paste0('title', i - 1, sep = '')),
y = unit(-.5, "lines"),
hjust = 0, vjust = 0, gp = gpar(col = color))
})
}
grobs <- c(grobs, more_grobs)
grobs <- do.call(what = grobTree, args = grobs) ### ERROR HERE
这是怎么回事?答案是问题出在前两行:
grobs <- NULL
grobs[1] <- list(gp = gpar(fontsize = 14, fontface = 'bold'))
赋值 grobs[1] <-
删除了列表元素 gp = ...
的命名,因此函数 grobTree()
不理解第一个参数不是 grob。修复很简单。将这两行替换为:
grobs <- list(gp = gpar(fontsize = 14, fontface = 'bold'))
现在一切正常了。 do.call()
行不再导致错误。但是,单词的间距仍然不对,因为 pmap()
调用不会创建从第一个到第 n 个的所有 grob 宽度的总和。相反,它只使用前一个 grob 的 grob 宽度。这个问题最好用递归函数解决,我觉得:
make_grobs <- function(words, colors, x, y, hjust = 0, vjust = 0, i = 0) {
n <- length(words)
colors <- rep_len(colors, n)
name <- paste0('title', i)
grob <- textGrob(label = words[1], name = name,
x = x, y = y, hjust = hjust, vjust = vjust,
gp = gpar(col = colors[1]))
if (n == 1) {
list(grob)
}
else {
c(list(grob),
make_grobs(words[-1], colors[-1],
x + grobWidth(grob), y, hjust, vjust, i + 1))
}
}
定义此函数后,整个可重现示例变为:
library(purrr)
library(grid)
library(gridExtra)
library(ggplot2)
title_segments <- c('Help ', 'me ', 'please', '!')
colors <- c('red', 'orange', 'green', 'blue')
nudge_x = 0
grobs <- do.call(what = grobTree,
args = c(make_grobs(title_segments, colors,
x = unit(2.33 - nudge_x, "lines"),
y = unit(-.5, "lines")),
list(gp = gpar(fontsize = 14, fontface = 'bold'))))
qplot(displ, year, data = mpg)
gb <- ggplot_build(last_plot())
gt <- ggplot_gtable(gb)
gt$layout$clip[gt$layout$name=="panel"] <- "off"
gg <- arrangeGrob(gt, top = grobs, padding = unit(2.6, "line"))
grid.newpage()
grid.draw(gg)