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

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

Комплексный график

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

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

ПОЛУЧИТЬ НЕКОТОРЫЕ ДАННЫЕ ДЛЯ УСТАНОВКИ

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)

DEFINE BARPLOT

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, но я не смог понять, как это сделать. Кроме того, если какой-либо из моего кода является чрезмерно многословным или есть более простой, более элегантный способ сделать то, что я уже сделал, пожалуйста, не стесняйтесь прокомментировать это.

Ответ 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://stackoverflow.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: /info/54626/left-align-two-graph-edges-ggplot/383026#383026
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