Как я могу хранить гробы в списке и передавать их в grobTree()?
Поэтому я пытаюсь составить список гробов, а затем передать их в grobTree(), но мои пункты списка не читаются как гроб do.call(),
Вот мой код:
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() утверждение, потому что мои элементы списка не читаются как гробы.
Когда я пробую этот кусочек кода, он оценивается как истина.
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]))
}
)
1 ответ
Решение
Попробуем ответить на вопрос как написано. Вопрос, который я прочитал, звучит так:
Этот код работает:
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() не понимает, что первый аргумент - это не гроб. Исправить это просто. Замените эти две строки:
grobs <- list(gp = gpar(fontsize = 14, fontface = 'bold'))
Теперь все работает, вроде. do.call() Строка больше не вызывает ошибку. Тем не менее, расстояние между словами все еще не правильно, потому что pmap() call не создает сумму всех ширин гробов от первого до n-го. Вместо этого он использует только ширину гроба предыдущего гроба. Эта проблема лучше всего решается с помощью рекурсивной функции, я думаю:
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)
