R - как выделить пространство экрана для сложных изображений ggplot

Question

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

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

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

СОЗДАЙТЕ НЕКОТОРЫЕ ДАННЫЕ ДЛЯ РАЗМЕЩЕНИЯ

pt_id = c(1:279) # DEFINE PATIENT IDs
smoke = rbinom(279,1,0.5) # DEFINE SMOKING STATUS
hpv = rbinom(279,1,0.3) # DEFINE HPV STATUS
data = data.frame(pt_id, smoke, hpv) # PRODUCE DATA FRAME

ДОБАВИТЬ АНАТОМИЧЕСКИЕ ДАННЫЕ САЙТА

data$site = sample(1:4, 279, replace = T)
data$site[data$site == 1] = "Hypopharynx"
data$site[data$site == 2] = "Larynx"
data$site[data$site == 3] = "Oral Cavity"
data$site[data$site == 4] = "Oropharynx"
data$site_known = 1  # HACK TO FACILITATE PRODUCING BARPLOTS

ДОБАВЬТЕ ДАННЫЕ ЧАСТОТЫ МУТАЦИИ

data$freq = sample(1:1000, 279, replace = F)

ОПРЕДЕЛИТЬ БАРПОЛ

require(ggplot2)
require(gridExtra)
bar = ggplot(data, aes(x = pt_id, y = freq)) + geom_bar(stat = "identity") +     theme(axis.title.x = element_blank(), axis.ticks.x = element_blank(), axis.text.x = element_blank()) + ylab("Number of Mutations")
# DEFINE BINARY PLOTS
smoke_status = ggplot(data, aes(x=pt_id, y=smoke, fill = "red")) + geom_bar(stat="identity") + theme(legend.position = "none", axis.title.x = element_blank(), axis.ticks.x = element_blank(), axis.text.x = element_blank()) + ylab("Smoking Status")
hpv_status = ggplot(data, aes(x=pt_id, y = hpv, fill = "red")) + geom_bar(stat="identity") + theme(legend.position = "none", axis.title.x = element_blank(), axis.ticks.x = element_blank(), axis.text.x = element_blank()) + ylab("HPV Status")
site_status = ggplot(data, aes(x=pt_id, y=site_known, fill = site)) +     geom_bar(stat="identity")

ИЗГОТОВИТЬ ЧЕТЫРЕ ГРАФА ВМЕСТЕ

grid.arrange(bar, smoke_status, hpv_status, site_status, nrow = 4)

Я подозреваю, что функции, необходимые для выполнения этих задач, уже включены в ggplot2 и gridExtra, но я не смог понять, как это сделать. Кроме того, если какой-либо из моих кодов слишком многословен или есть более простой, более элегантный способ сделать то, что я уже сделал - пожалуйста, не стесняйтесь комментировать это.

Answer 1

Вот шаги, чтобы получить макет, который вы описываете:

1) Извлеките легенду как отдельный гроб ("графический объект"). Затем мы можем выложить легенду отдельно от сюжетов.

2) Выровняйте по левому краю края четырех графиков так, чтобы левые края и шкалы Х были правильно выровнены. Код для этого происходит из этого SO ответа. Этот ответ имеет функцию для выравнивания произвольного числа графиков, но я не смог заставить это работать, когда я также хотел изменить пропорциональное пространство, выделенное для каждого графика, поэтому я в конечном итоге сделал это "длинным путем", регулируя каждый сюжет в отдельности.

3) Выложите сюжеты и легенду, используя grid.arrange а также arrangeGrob , heights Аргумент выделяет различные пропорции общего вертикального пространства для каждого графика. Мы также используем widths аргумент для выделения горизонтального пространства для графиков в одном широком столбце и легенды в другом узком столбце.

4) Сюжет для устройства любого размера, который вы хотите. Так вы получаете определенную форму или пропорции.

library(gridExtra)
library(grid)

# Function to extract the legend from a ggplot graph as a separate grob
# Source: https://stackru.com/a/12539820/496488
get_leg = function(a.gplot){
  tmp <- ggplot_gtable(ggplot_build(a.gplot))
  leg <- which(sapply(tmp$grobs, function(x) x$name) == "guide-box")
  legend <- tmp$grobs[[leg]]
  legend
}

# Get legend as a separate grob
leg = get_leg(site_status)

# Add a theme element to change the plot margins to remove white space between the plots
thm = theme(plot.margin=unit(c(0,0,-0.5,0),"lines"))

# Left-align the four plots 
# Adapted from: https://stackru.com/a/13295880/496488
gA <- ggplotGrob(bar + thm)
gB <- ggplotGrob(smoke_status + thm)
gC <- ggplotGrob(hpv_status + thm)
gD <- ggplotGrob(site_status + theme(plot.margin=unit(c(0,0,0,0), "lines")) + 
                  guides(fill=FALSE))

maxWidth = grid::unit.pmax(gA$widths[2:5], gB$widths[2:5], gC$widths[2:5], gD$widths[2:5])
gA$widths[2:5] <- as.list(maxWidth)
gB$widths[2:5] <- as.list(maxWidth)
gC$widths[2:5] <- as.list(maxWidth)
gD$widths[2:5] <- as.list(maxWidth)

# Lay out plots and legend
p = grid.arrange(arrangeGrob(gA,gB,gC,gD, heights=c(0.5,0.15,0.15,0.21)),
                 leg, ncol=2, widths=c(0.8,0.2))

Затем вы можете определить форму или соотношение сторон конечного графика, установив параметры устройства вывода. (Возможно, вам придется настроить размеры шрифта при создании базовых графиков, чтобы окончательный макет выглядел так, как вы хотите.) Вставленный ниже график представляет собой png, сохраненный непосредственно из окна графика RStudio. Вот как вы можете сохранить график в виде файла PDF (но есть много других "устройств", которые вы можете использовать (например, png, jpeg и т. Д.) Для сохранения в разных форматах):

pdf("myPlot.pdf", width=10, height=5)
p
dev.off()

Вы также спросили о более эффективном коде. Одна вещь, которую вы можете сделать, это создать список элементов графика, которые вы используете несколько раз, а затем просто добавить имя объекта списка к каждому графику. Например:

my_gg = list(geom_bar(stat="identity", fill="red"),
             theme(legend.position = "none", 
                   axis.title.x = element_blank(), 
                   axis.ticks.x = element_blank(), 
                   axis.text.x = element_blank()),
                   plot.margin = unit(c(0,0,-0.5,0), "lines"))

smoke_status = ggplot(data, aes(x=pt_id, y=smoke)) + 
                  labs(y="Smoking Status") +
                  my_gg