如何将grobs存储在列表中并将它们传递给grobTree()?

因此,我试图制作一个grobs列表,然后将它们传递到grobTree(),但我的列表项目不会作为grob通过do.call()读入。如何将grobs存储在列表中并将它们传递给grobTree()?

这里是我的代码:

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])))

当我尝试这一点,它的计算结果为假

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()调用不会创建从第1个到第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()? 的全部内容, 来源链接: utcz.com/qa/260851.html

回到顶部