R: Надежное преобразование между объектами gtable и ggplot. Как заставить лимон :: reposition_legend () работать после ggplot_build ()?

Question

У меня под рукой довольно сложный случай с ggplot2. Я попытался проиллюстрировать это MWE, используя данные iris ниже.

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

Это все хорошо, я использую lemon::reposition_legend() для этого, и это работает.

Однако мне нужно изменить кучу вещей на графике (а именно добавить значимые результаты испытаний и другие вещи, которые не имеют отношения к этому вопрос), и я вынужден использовать ggplot_build() на своем выходном графике для этой цели.

После использования ggplot_build() для изменения моего графика я, похоже, больше не могу успешно использовать reposition_legend() ...

Ознакомьтесь с моим MWE ниже.

Сначала я загружаю нужные мне пакеты и определяю функцию shift_legend() (которая использует reposition_legend()), основываясь на ответе на этот вопрос .

library(tidyr)
library(ggplot2)
library(ggplotify)
library(gtable)
library(cowplot)
library(purrr)
library(lemon)
library(grid)
shift_legend <- function(p) {
  pnls <- NULL
  if (class(p)[1] == "gtable") pnls <- p
  else if (class(p)[2] == "ggplot") pnls <- plot_to_gtable(p)
  else stop("Please provide a ggplot or a gtable object")

  pnls <- gtable_filter(pnls, "panel")
  pnls <- setNames(pnls$grobs, pnls$layout$name)
  pnls <- keep(pnls, ~identical(.x, zeroGrob()))

  res <- NULL
  if(length(pnls) > 0) res <- reposition_legend( p, "center", panel=names(pnls) )
  else res <- p
  return(res)
}

Затем я загружаю данные iris и успешно строю свой график с shift_legend().

data(iris)
summary(iris)
iris_long <- gather(iris, "Variable", "Value", -Species)
P <- ggplot(iris_long, aes(x=Variable, y=Value)) +
  geom_boxplot(aes(fill=Variable), position=position_dodge(.9)) +
  facet_wrap(.~Species, ncol=2) +
  theme_light() +
  theme(legend.key.size = unit(0.5, "inch"))
out_file_name <- "test.pdf"
pdf(file=out_file_name, height=10, width=10, onefile=FALSE)
print(
  grid.draw(shift_legend(P))
)
dev.off()

Это приводит ко всем выводам хорошо до здесь: Обратите внимание, что это соглашение, которое я хочу иметь возможность eproduce (после использования ggplot_build), с легендой, занимающей пустое пространство граней.

Но теперь мне нужно использовать ggplot_build() для добавления и изменения вещей в моем сюжете. После этого я могу построить его нормально, не используя reposition_legend().

P2 <- ggplot_build(P)
#Do a bunch of things here...
out_file_name2 <- "test2.pdf"
pdf.options(reset=TRUE, onefile=FALSE)
pdf(file=out_file_name2, height=10, width=10)
print(
  plot(ggplot_gtable(P2))
)
dev.off()

, что приводит к следующему:

Но я все еще хочу изменить положение легенды, поэтому я пытаюсь использовать reposition_legend() снова для преобразования объекта ggplot_built в объект gtable (который, согласно документации функции , он может также принимать в качестве входных данных).

out_file_name22 <- "test22.pdf"
pdf.options(reset=TRUE, onefile=FALSE)
pdf(file=out_file_name22, height=10, width=10)
print(
  grid.draw(shift_legend(
    ggplot_gtable(P2)
  ))
)
dev.off()

Здесь я получаю эту ошибку:

Ошибка в reposition_legend (p, "center", panel = names (pnls)): легенда не указана в аргументах или не может извлечь легенду из сюжета.

Я попытался снова преобразовать объект gtable в ggplot, используя ggplotify::as.ggplot(). На этот раз я не получил никаких ошибок, но легенда не была перенесена, как ожидалось ...

out_file_name222 <- "test222.pdf"
pdf.options(reset=TRUE, onefile=FALSE)
pdf(file=out_file_name222, height=10, width=10)
print(
  grid.draw(shift_legend(
    as.ggplot(ggplot_gtable(P2))
  ))
)
dev.off()

Выдает это:

Помогите пожалуйста!

РЕДАКТИРОВАТЬ

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

Быть P исходным сюжетом то, что мне нужно изменить, находится в фрейме данных ggplot_build(P)$data.

Этот фрейм данных выглядит следующим образом:

> ggplot_build(P)$data
[[1]]
      fill ymin lower middle upper ymax           outliers notchupper notchlower x PANEL group ymin_final ymax_final  xmin  xmax weight colour size alpha shape
1  #F8766D  1.2 1.400   1.50 1.575  1.7 1.1, 1.0, 1.9, 1.9  1.5391030  1.4608970 1     1     1        1.0        1.9 0.625 1.375      1 grey20  0.5    NA    19
2  #7CAE00  0.1 0.200   0.20 0.300  0.4           0.5, 0.6  0.2223446  0.1776554 2     1     2        0.1        0.6 1.625 2.375      1 grey20  0.5    NA    19
3  #00BFC4  4.3 4.800   5.00 5.200  5.8                     5.0893783  4.9106217 3     1     3        4.3        5.8 2.625 3.375      1 grey20  0.5    NA    19
4  #C77CFF  2.9 3.200   3.40 3.675  4.2           4.4, 2.3  3.5061367  3.2938633 4     1     4        2.3        4.4 3.625 4.375      1 grey20  0.5    NA    19
5  #F8766D  3.3 4.000   4.35 4.600  5.1                  3  4.4840674  4.2159326 1     2     1        3.0        5.1 0.625 1.375      1 grey20  0.5    NA    19
6  #7CAE00  1.0 1.200   1.30 1.500  1.8                     1.3670337  1.2329663 2     2     2        1.0        1.8 1.625 2.375      1 grey20  0.5    NA    19
7  #00BFC4  4.9 5.600   5.90 6.300  7.0                     6.0564120  5.7435880 3     2     3        4.9        7.0 2.625 3.375      1 grey20  0.5    NA    19
8  #C77CFF  2.0 2.525   2.80 3.000  3.4                     2.9061367  2.6938633 4     2     4        2.0        3.4 3.625 4.375      1 grey20  0.5    NA    19
9  #F8766D  4.5 5.100   5.55 5.875  6.9                     5.7231705  5.3768295 1     3     1        4.5        6.9 0.625 1.375      1 grey20  0.5    NA    19
10 #7CAE00  1.4 1.800   2.00 2.300  2.5                     2.1117229  1.8882771 2     3     2        1.4        2.5 1.625 2.375      1 grey20  0.5    NA    19
11 #00BFC4  5.6 6.225   6.50 6.900  7.9                4.9  6.6508259  6.3491741 3     3     3        4.9        7.9 2.625 3.375      1 grey20  0.5    NA    19
12 #C77CFF  2.5 2.800   3.00 3.175  3.6      3.8, 2.2, 3.8  3.0837922  2.9162078 4     3     4        2.2        3.8 3.625 4.375      1 grey20  0.5    NA    19
   linetype
1     solid
2     solid
3     solid
4     solid
5     solid
6     solid
7     solid
8     solid
9     solid
10    solid
11    solid
12    solid

Я изменяю его аспекты, например annotation (неприменимо в это MWE) и colour.

Однако, если, как предложено, я пытаюсь изменить легенду о P до , используя ggplot_build() для извлечения и изменения соответствующей информации, Я должен сделать следующее:

P2 <- as.ggplot(shift_legend(P))
ggplot_build(P2)$data

Первая команда открывает новое окно печати, что нежелательно.

Вторая команда производит это:

> ggplot_build(P2)$data
[[1]]
  x y PANEL group
1 0 0     1    -1
2 1 1     1    -1

[[2]]
  PANEL group xmin xmax ymin ymax
1     1    -1    0    1    0    1

Это совсем не похоже на фрейм данных data, который я изменяю в P ... Любая подсказка, где его найти, если возможно, в P2 сейчас?

E DIT 2

Точно так же вы видите пример моих реальных блокпостов, чтобы понять, почему изменение ggplot_build(P)$data важно для меня.

Нет способа показать только существенные попарные сравнения с geom_signif().

Я использую geom_signif() с фиктивным текстом для заполнения кадра данных аннотации, к которому я могу получить доступ в ggplot_build(P)$data[[3]], а затем добавляю мои фактические значения значимости в столбец $annotation, и поднабор кадра данных соответственно, чтобы показать только существенные сравнения. Там у меня есть полный контроль, и я могу изменить цвета сравнений в соответствии со значимостью, у какой группы есть более высокое среднее значение, et c, et c.

Я спросил это некоторое время go здесь , и с тех пор, как я обработал это и обернул его в функцию.

Как видите, это противоречит моей функции shift_legend, так как я, кажется, не могу найти способ для доступа к фрейму данных data ...

Это то, что я имею до сих пор со своими реальными данными, я поместил легенду внизу, но было бы оптимальным, чтобы она занимала пространство пустых граней, особенно потому, что у меня есть случаи, когда есть больше пустых граней.

Answer 1

Я пересмотрел этот ответ на основе дополнительной информации из ОП.

Мы начнем с загрузки библиотек и создания графика. Для этого примера я добавил дополнительный слой текстовых объектов, которым можно манипулировать в результирующем объекте ggplot_built, поскольку для ОП требуется:

library(tidyr)
library(ggplot2)
library(ggplotify)
library(gtable)
library(cowplot)
library(purrr)
library(lemon)
library(grid)

data(iris)

iris_long   <- gather(iris, "Variable", "Value", -Species)
text_labels <- data.frame(text = "Text", x = 2, y = 3, stringsAsFactors = FALSE)

P <- ggplot(iris_long, aes(x = Variable, y = Value)) +
     geom_boxplot(aes(fill = Variable), position = position_dodge(.9)) +
     geom_text(data = text_labels, aes(x = x, y = y, label = text)) +
     facet_wrap(.~Species, ncol = 2) +
     theme_light() +
     theme(legend.key.size = unit(0.5, "inch"))

Теперь мы конвертируем в объект ggplot_built и манипулируем им как необходимо. Здесь мы просто вручную изменим цвет текста с помощью P2$data[[2]]

# Convert to ggplot_built
P2 <- ggplot_build(P)

# Do stuff with P2$data
P2$data[[2]]$colour <- rep("red", 3)

# We have changed P2 successfully
grid.draw(ggplot_gtable(P2))

Теперь мы хотим добавить легенду к фаска. Мы берем копию легенды с нашего сюжета, используя ggplot_gtable:

P3 <- reposition_legend(ggplot_gtable(P2), "center", 
                        legend = g_legend(ggplot_gtable(P2)), 
                        panel = "panel-2-2")

Однако это создает новую проблему: у нас есть правильно размещенная легенда, но у нас также есть старая, которой мы больше не владеем want:

Затем мы исправим это, найдя ненужный гроб, и заменим его зерогробом:

legend_grob <- which(sapply(P3$grobs, function(x) x$name) == "guide-box")
P3$grobs[[legend_grob]] <- zeroGrob()

Теперь у нас все еще будет пустое пространство с правой стороны нашего графика, который нам не нужен, поэтому мы применяем отрицательный блок справа:

P3 <- gtable_add_padding(P3, unit(c(0,-.15, 0, 0), "npc")

Теперь мы можем построить результат с grid.draw:

grid.newpage()
grid.draw(P3)

Обратите внимание, что мы сохранили изменения, которые мы сделали вручную, для объекта ggplot_built.

Таким образом, ваша функция преобразования ggplot_built объекта в график с легендой, перемещенной в фасет, будет выглядеть примерно так:

legend_as_facet <- function(P2)
{
  # Convert the ggplot_built object to a gtable
  P2       <- ggplot_gtable(P2)

  # Find the name of the panel on the bottom right of the plot
  panels   <- grep("panel", P2$layout$name, value = TRUE)
  panelmat <- sapply(strsplit(panels, "-"), function(x) as.numeric(x[2:3]))
  maxpanel <- paste("panel", max(panelmat[2,]), max(panelmat[2,]), sep = "-")

  # Draw the legend in the bottom right panel
  P3 <- reposition_legend(P2, "center", legend = g_legend(P2), panel = maxpanel)

  # Draw a zero grob in place of the existing legend
  legend_grob <- which(sapply(P3$grobs, function(x) x$name) == "guide-box")
  P3$grobs[[legend_grob]] <- zeroGrob()

  # Apply negative padding to remove the empty space on the right
  P3 <- gtable_add_padding(P3, unit(c(0,-.15, 0, 0), "npc"))

  # Draw the result
  grid.newpage()
  grid.draw(P3)
}

Это означает, что ваш рабочий процесс будет:

P2 <- ggplot_build(P)

# Do stuff with P2$data

legend_as_facet(P2)

^{Создано в 2020-02-19 с помощью пакета представитель (v0.3.0)}