извлечение отдельных деталей сюжета из комбинированного сюжета в `cowplot` для модульных тестов

Я пытаюсь написать модульные тесты для функций, где я использую cowplot::plot_grid() для объединения ggplot2 графиков. Например,

# setup
set.seed(123)
library(ggplot2)

# creating basic plots
p1 <- ggplot(aes(x = as.factor(am), y = wt), data = mtcars) + 
  geom_point() + 
  labs(title = "Dataset: mtcars", subtitle = "Source: `base` package")
p2 <- ggplot(aes(x = vore, y = brainwt), data = msleep) + 
  geom_point() + 
  labs(title = "Dataset: msleep", subtitle = "Source: `ggplot2` package")

# combined plot
(p <- cowplot::plot_grid(p1, p2, labels = c("(i)", "(ii)")))
#> Warning: Removed 27 rows containing missing values (geom_point).

Создано 05 января 2019 г. с помощью пакета reprex (v0.2.1)

Для ggplot2 графиков я могу построить график и извлечь эти детали.

# extracting title and subtitle (example with p1)
pb1 <- ggplot2::ggplot_build(p1)
pb1$plot$labels$title
#> [1] "Dataset: mtcars"
pb1$plot$labels$subtitle
#> [1] "Source: `base` package"

Но как я могу извлечь такие подробности об отдельных участках из объединенного сюжета?

совмещенный участок под застройку

pb <- ggplot2::ggplot_build(p)

Итак, например, как я могу извлечь субтитры для p1 из pb?


r ggplot2 testthat cowplot
person Indrajeet Patil    schedule 05.01.2019    source источник

Ответы (1)


arrow_upward
2
arrow_downward

Мы можем сделать следующее:

p <- cowplot::plot_grid(p1, p2, labels = c("(i)", "(ii)"))

fun <- function(p, what) {
  unlist(sapply(p$layers, function(x) {
    idx <- which(x$geom_params$grob$layout$name == what)
    x$geom_params$grob$grobs[[idx]]$children[[1]]$label
  }))
}
fun(p, "title")
# [1] "Dataset: mtcars" "Dataset: msleep"
fun(p, "subtitle")
# [1] "Source: `base` package"    "Source: `ggplot2` package"

При таком подходе от дополнительного использования ggplot_build не будет никакой выгоды, так как нам все равно нужно будет перейти к элементу layers.

Я считаю, что нет более короткого способа сделать это. Логично, что нам нужно углубиться в layers, поскольку pb$plot$labels$title касается всего сюжета, а наш p представляет собой комбинацию двух.

Если вы хотите извлечь некоторые другие элементы, это должно быть вполне выполнимо, если посмотреть, скажем, в случае первого слоя,

p$layers[[1]]$geom_params$grob
# TableGrob (12 x 9) "layout": 18 grobs
#     z         cells       name                                          grob
# 1   0 ( 1-12, 1- 9) background       zeroGrob[plot.background..zeroGrob.151]
# 2   5 ( 6- 6, 4- 4)     spacer                                zeroGrob[NULL]
# 3   7 ( 7- 7, 4- 4)     axis-l           absoluteGrob[GRID.absoluteGrob.136]
# 4   3 ( 8- 8, 4- 4)     spacer                                zeroGrob[NULL]
# 5   6 ( 6- 6, 5- 5)     axis-t                                zeroGrob[NULL]
# 6   1 ( 7- 7, 5- 5)      panel                      gTree[panel-1.gTree.120]
# 7   9 ( 8- 8, 5- 5)     axis-b           absoluteGrob[GRID.absoluteGrob.128]
# 8   4 ( 6- 6, 6- 6)     spacer                                zeroGrob[NULL]
# 9   8 ( 7- 7, 6- 6)     axis-r                                zeroGrob[NULL]
# 10  2 ( 8- 8, 6- 6)     spacer                                zeroGrob[NULL]
# 11 10 ( 5- 5, 5- 5)     xlab-t                                zeroGrob[NULL]
# 12 11 ( 9- 9, 5- 5)     xlab-b titleGrob[axis.title.x.bottom..titleGrob.139]
# 13 12 ( 7- 7, 3- 3)     ylab-l   titleGrob[axis.title.y.left..titleGrob.142]
# 14 13 ( 7- 7, 7- 7)     ylab-r                                zeroGrob[NULL]
# 15 14 ( 4- 4, 5- 5)   subtitle       titleGrob[plot.subtitle..titleGrob.148]
# 16 15 ( 3- 3, 5- 5)      title          titleGrob[plot.title..titleGrob.145]
# 17 16 (10-10, 5- 5)    caption          zeroGrob[plot.caption..zeroGrob.150]
# 18 17 ( 2- 2, 2- 2)        tag              zeroGrob[plot.tag..zeroGrob.149]

затем выбираем правильный grob в соответствии с его name и смотрим, скажем,

str(p$layers[[1]]$geom_params$grob$grobs[[15]])

где довольно легко найти то, что мы хотим

p$layers[[1]]$geom_params$grob$grobs[[15]]$children[[1]]$label
# [1] "Source: `base` package"
person Julius Vainora    schedule 05.01.2019
comment
@IndrajeetPatil, в конце концов, я сомневаюсь, что можно сделать что-то короче. Я добавил некоторые подробности о том, как извлечь некоторые другие элементы. - person Julius Vainora; 05.01.2019