Совмещение осей графиков R на одной стороне сетки вместе

У меня есть 6 сюжетов, которые я пытаюсь построить вместе на сетке. Мне удалось построить 3 основных из них, хорошо выровненных так, чтобы оси Y начинались в одной и той же точке, вот так:

Но после того, как я добавил в сетку второй столбец графиков (треугольники), я потерял выравнивание в первом столбце. Это выглядело примерно так:

Совмещение осей графиков R на одной стороне сетки вместе

Вот код для построения этой сетки. Я поигрался с параметром align и небольшой шириной, но мне не удалось заставить все это работать вместе:

plot_grid(pq1_plop, pq1_status, pq2_plop, pq2_status, pq3_plop, pq3_status, 
          align = "hv", 
          nrow = 3, 
          ncol = 2,
          rel_widths = c(10, 1)
          )

Есть ли способ построить их с выровненными вместе осями левой стороны? Данные для участков:

> dput(pq1_agged)
structure(list(mean_name = structure(2:6, .Label = c("", "Arrival Logistics and Greetings", 
"Organization of Activity", "Schedule and Offering", "Space Adequacy", 
"Transitions"), class = "factor"), mean_2018 = c(3.60416668653488, 
3.31623927752177, 2.75, 3.125, 3.55555558204651), SY_mean = c(3.3468468479208, 
3.62688970565796, 3.24204542961988, 3.58294574604478, 0), PSELI_mean = c(3.38333333333333, 
3.65522875505335, 3.08235294678632, 3.53529411203721, 0), mean_2017 = c(3.625, 
3.75000002980232, 3.02499997615814, 3.59166663885117, 4), aptsayoy = c("apt", 
"apt", "apt", "apt", "apt"), status = c(2, 2, 2, 2, 2)), row.names = c(NA, 
-5L), class = "data.frame")
> dput(pq2_agged)
structure(list(mean_name = structure(c(2L, 3L, 4L, 11L, 6L, 7L, 
8L, 9L, 10L), .Label = c("", "Helps Youth Socially", "Informal Time: Staff Performance", 
"Social-Emotional Environment", "Staff Build Relationships and Support Individual Youth", 
"Staff Positively Guide Behavior", "Supportive Adults Present", 
"Supportive Social Environment", "Youth Relations with Adults", 
"Youth Relations with Peers", "Staff Build Relationships & Support Individual Youth"
), class = "factor"), mean_2018 = c(NaN, 3.625, 3.19385969011407, 
3.16666666666667, 3.390625, NaN, NaN, 3.19999996821086, 3), SY_mean = c(0, 
3.48106062412262, 3.72575757720254, 3.41504833864611, 3.69877295267014, 
0, 0, 3.32984494885733, 3.62687339339145), PSELI_mean = c(3.45057719920105, 
3.40740741623773, 3.74117646497839, 3.49967318422654, 3.59940157217138, 
3.55519480519481, 3.58463203390955, 3.48692812639124, 3.60947714132421
), mean_2017 = c(NaN, 3.16666674613953, 3.58333335424724, 3.3905701888235, 
3.66687555062143, NaN, NaN, 3.53654969365973, 3.64473684837944
), aptsayoy = c("sayoy", "apt", "apt", "apt", "apt", "sayoy", 
"sayoy", "apt", "apt"), status = c(NA, 6, 2, 2, 2, NA, NA, 2, 
2)), row.names = c(NA, -9L), class = "data.frame")
> dput(pq3_agged)
structure(list(mean_name = structure(2:14, .Label = c("", "Helps Youth Academically", 
"Homework Organization", "Informal Time: Youth Engagement and Behavior", 
"Level of Youth Participation", "Nature of Activity", "Opportunities for Leadership and Responsibility", 
"Staff Effectively Manage HW Time", "Staff Promote Engagement and Stimulate Thinking", 
"Staff Provide Individualized HW Support", "Youth Enjoy and Feel Engaged", 
"Youth Feel Challenged", "Youth Have Choice and Autonomy", "Youth Participation in HW Time"
), class = "factor"), mean_2018 = c(NaN, 3.16666666666667, 3.54464280605316, 
2.62666670481364, 2.03333330154419, NaN, 3.33333337306976, 2.43095239003499, 
3.10000002384186, NaN, NaN, NaN, 2.5), SY_mean = c(2.36415087054335, 
2.36415087054335, 2.36415087054335, 2.36415087054335, 2.36415087054335, 
2.36415087054335, 2.36415087054335, 2.36415087054335, 2.36415087054335, 
2.36415087054335, 2.36415087054335, 2.36415087054335, 2.36415087054335
), PSELI_mean = c(2.69552668942001, 0, 3.60119046105279, 3.10980392904843, 
2.78676470588235, 2.29307360050482, 0, 3.16247088768903, 0, 3.83008658008658, 
3.48051948851837, 2.43499278093313, 0), mean_2017 = c(NaN, 3.5, 
3.57142853736877, 3.22543858226977, 2.04495615080783, NaN, 3.61111108462016, 
2.82832081066935, 3.30000003178914, NaN, NaN, NaN, 3), aptsayoy = c("sayoy", 
"apt", "apt", "apt", "apt", "sayoy", "apt", "apt", "apt", "sayoy", 
"sayoy", "sayoy", "apt"), status = c(NA, 2, 2, 2, 2, NA, 2, 2, 
2, NA, NA, NA, 2)), row.names = 2:14, class = "data.frame")

А вот и созданные мной сюжеты:

library(stringr)
library(cowplot)
pq1_plop <-  ggplot(pq1_agged, aes(y=mean_name, x=mean_2018)) + 
  geom_vline(xintercept = 3, size = 0.5, color = "#00C4F3") + #Benchmark static line
  geom_text(data=data.frame(x=3,y=5), aes(x, y), label = "Benchmark", hjust=1, vjust=-.2, colour = "#4c4c4c") +
  geom_point(aes(x = SY_mean), color = "#FD5B14", fill = "#FD5B14", size=4, pch=3) + 
  geom_point(aes(x = PSELI_mean), color = "#2B85BA", fill = "#2B85BA", size=4, pch=3) +
  geom_point(aes(x = mean_2017), color = "#BCA8DC", fill = "#BCA8DC", size=4, pch=16) + 
  geom_point(color = "#612CB5", fill = "#612CB5", size=4, pch=16) + 
  #guides(fill=TRUE) + 
  #guides(colour = "colorbar", size = "legend", shape = "legend") + 
  #xlim(1, 4) +
  #xlab("Average Score") +
  ylab("Program Organization \n & Structure") + 
  scale_y_discrete(labels = function(mean_2018) str_wrap(mean_2018, width = 60)) +
  scale_x_continuous(sec.axis = dup_axis(), lim = c(1, 4)) + 
  theme_bw() + 
  theme(legend.text = element_text(colour = "black", size = 8),
        legend.position = "middle",
        axis.title.x =element_blank(),
        axis.text.x = element_blank(),
        axis.ticks.x = element_blank(),
        #axis.line.x.top = element_blank(),
        #axis.text.x.top = element_text(size=8),
        axis.title.y = element_text(angle = 0, vjust = 0.5),
        panel.grid.minor.x = element_line(colour = "#cccccc",
                                          linetype = "solid"),
        panel.grid.major.x = element_line(colour = "#b2b2b2",
                                          linetype = "solid"),
        panel.grid.major.y = element_line(colour = "#7f7f7f",
                                          linetype = "solid"),
        panel.border = element_blank()
  )

pq2_plop <-  ggplot(pq2_agged, aes(y=mean_name, x=mean_2018)) + 
  geom_vline(xintercept = 3, size = 0.5, color = "#00C4F3") + #Benchmark static line
  geom_point(aes(x = SY_mean), color = "#FD5B14", fill = "#FD5B14", size=4, pch=3) + 
  geom_point(aes(x = PSELI_mean), color = "#2B85BA", fill = "#2B85BA", size=4, pch=3) +
  geom_point(aes(x = mean_2017), color = "#BCA8DC", fill = "#BCA8DC", size=4, pch=16) +
  geom_point(color = "#612CB5", fill = "#612CB5", size=4, pch=16) + 
  #guides(fill=NA) + 
  #guides(colour = "colorbar", size = "legend", shape = "legend") + 
  xlim(1, 4) +
  #xlab("Average Score") +
  ylab("Supportive Environment") + 
  scale_y_discrete(labels = function(mean_2018) str_wrap(mean_2018, width = 60)) + 
  theme_bw() + 
  theme(legend.text = element_text(colour = "black",size=10),
        legend.position = "middle",
        axis.title.x = element_blank(),
        axis.text.x = element_blank(),
        axis.ticks.x = element_blank(),
        axis.line.x  = element_blank(),
        axis.title.y = element_text(angle = 0, vjust = 0.5),
        panel.grid.minor.x = element_line(colour = "#cccccc",
                                          linetype = "solid"),
        panel.grid.major.x = element_line(colour = "#b2b2b2",
                                          linetype = "solid"),
        panel.grid.major.y = element_line(colour = "#7f7f7f",
                                          linetype = "solid"),
        panel.border = element_blank()
  )

pq3_plop <-  ggplot(data = pq3_agged, aes(y=mean_name, x=mean_2018,fill='lightgreen')) + 
  geom_vline(xintercept = 3, size = 0.5, color = "#00C4F3") + #Benchmark static line
  geom_point(aes(x = SY_mean), color = "#FD5B14", fill = "#FD5B14", size=4, pch=3) + 
  geom_point(aes(x = PSELI_mean), color = "#2B85BA", fill = "#2B85BA", size=4, pch=3) +
  geom_point(aes(x = mean_2017), color = "#BCA8DC", fill = "#BCA8DC", size=4, pch=16) +
  geom_point(color = "#612CB5", fill = "#612CB5", size=4, pch=16) + 
  #guides(fill = guide_legend(reverse=TRUE)) + 
  #guides(colour = "colorbar", size = "legend", shape = "legend") + 
  xlim(1, 4) +
  #xlab("Average Score") +
  ylab("Engagement in Activities \n and Learning") + 
  scale_fill_identity(name = 'the fill', guide = 'legend', labels = c('m1')) +
  scale_colour_manual(name = 'the colour', 
                      values =c('black'='black','red'='red'), 
                      labels = c('c2','c1')) + 
  scale_y_discrete(labels = function(mean_2018) str_wrap(mean_2018, width = 60)) + 
  theme_bw() + 
  theme(legend.text = element_text(colour = "black",size=10),
        legend.position = "top",
        legend.background = element_rect(fill = "blue"),
        axis.title.x = element_blank(),
        #axis.line.x = element_blank(),
        axis.text.x = element_text(size = 8), 
        axis.title.y = element_text(angle = 0, vjust = 0.5), 
        panel.grid.minor.x = element_line(colour = "#cccccc",
                                          linetype = "solid"),
        panel.grid.major.x = element_line(colour = "#b2b2b2",
                                          linetype = "solid"),
        panel.grid.major.y = element_line(colour = "#7f7f7f",
                                          linetype = "solid"),
        panel.border = element_blank()
  )


#Start plotting
pq1_status <- ggplot(pq1_agged, aes(x = "", y = mean_name)) + 
  geom_point(aes(fill = as.factor(status), color = as.factor(status), shape = as.factor(status)), size = 2, show.legend = FALSE) +
  scale_shape_manual(values = c("2" = 25, "6" = 24, "8" = 15)) +
  theme_bw() + 
  scale_fill_manual(values = c("2" = "red", "6" = "green", "8" = "grey")) +
  scale_color_manual(values = c("2" = "red", "6" = "green", "8" = "grey")) + 
  xlab(NULL) +
  theme(axis.title.x=element_blank(),
        axis.text.x=element_blank(),
        axis.ticks.x=element_blank(),
        axis.title.y=element_blank(),
        axis.text.y=element_blank(),
        axis.ticks.y=element_blank(),
        panel.border = element_blank(),
        panel.grid.major = element_blank(),
        panel.grid.minor = element_blank()
  )

pq2_status <- ggplot(pq2_agged, aes(x = "", y = mean_name)) + 
  geom_point(aes(fill = as.factor(status), color = as.factor(status), shape = as.factor(status)), size = 2, show.legend = FALSE) +
  scale_shape_manual(values = c("2" = 25, "6" = 24, "8" = 15)) +
  theme_bw() + 
  scale_fill_manual(values = c("2" = "red", "6" = "green", "8" = "grey")) +
  scale_color_manual(values = c("2" = "red", "6" = "green", "8" = "grey")) +  
  xlab(NULL) +
  theme(axis.title.x=element_blank(),
        axis.text.x=element_blank(),
        axis.ticks.x=element_blank(),
        axis.title.y=element_blank(),
        axis.text.y=element_blank(),
        axis.ticks.y=element_blank(),
        panel.border = element_blank(),
        panel.grid.major = element_blank(),
        panel.grid.minor = element_blank()
  )

pq3_status <- ggplot(pq3_agged, aes(x = "", y = mean_name)) + 
  geom_point(aes(fill = as.factor(status), color = as.factor(status), shape = as.factor(status)), size = 2, show.legend = FALSE) +
  scale_shape_manual(values = c("2" = 25, "6" = 24, "8" = 15)) +
  theme_bw() + 
  scale_fill_manual(values = c("2" = "red", "6" = "green", "8" = "grey")) +
  scale_color_manual(values = c("2" = "red", "6" = "green", "8" = "grey")) + 
  xlab(NULL) +
  theme(axis.title.x=element_blank(),
        axis.text.x=element_blank(),
        axis.ticks.x=element_blank(),
        axis.title.y=element_blank(),
        axis.text.y=element_blank(),
        axis.ticks.y=element_blank(),
        panel.border = element_blank(),
        panel.grid.major = element_blank(),
        panel.grid.minor = element_blank()
  )

Добавлены переменные данных и графика

— 11.01.2019 22:39

Предположительно нам стоит загрузить cowplot и stringr (или tidyverse)? Если для запуска кода требуются эти или другие пакеты, добавьте их в код.

— 13.01.2019 00:53

Да, это единственные два пакета, которые здесь используются. Добавил их в

— 14.01.2019 16:25

r ggplot2 plot alignment

11.01.2019 21:54

Стоит ли изучать PHP в 2026-2027 годах?

Привет всем, сегодня я хочу высказать свои соображения по поводу вопроса, который я уже много раз получал в своем сообществе: "Стоит ли изучать PHP в...

Поведение ключевого слова "this" в стрелочной функции в сравнении с нормальной функцией

В JavaScript одним из самых запутанных понятий является поведение ключевого слова "this" в стрелочной и обычной функциях.

Приемы CSS-макетирования - floats и Flexbox

Здравствуйте, друзья-студенты! Готовы совершенствовать свои навыки веб-дизайна? Сегодня в нашем путешествии мы рассмотрим приемы CSS-верстки - в...

Тестирование функциональных ngrx-эффектов в Angular 16 с помощью Jest

В системе управления состояниями ngrx, совместимой с Angular 16, появились функциональные эффекты. Это здорово и делает код определенно легче для...

Концепция локализации и ее применение в приложениях React ⚡️

Локализация - это процесс адаптации приложения к различным языкам и культурным требованиям. Это позволяет пользователям получить опыт, соответствующий...

Пользовательский скаляр GraphQL

Листовые узлы системы типов GraphQL называются скалярами. Достигнув скалярного типа, невозможно спуститься дальше по иерархии типов. Скалярный тип...

1 298

Перейти к ответу Данный вопрос помечен как решенный

Ответы 3

Вы можете использовать patchwork. В настоящее время существует пара пакетов, которые могут выравнивать графики (например, cowplot, egg, ggpubr), однако в этом более сложном случае у меня работал только patchwork (и он относительно прост в использовании; синтаксис интуитивно понятен).

# devtools::install_github("thomasp85/patchwork")
library(patchwork)

pq1_plop + pq1_status + pq2_plop + pq2_status + pq3_plop + pq3_status +
plot_layout(ncol = 2, widths = c(10, 1))

С patchwork вы просто добавляете (+) один график ggplot2 к другому и в конце указываете макет (используя plot_layout).

Из любопытства, что за черная линия справа?

— 17.01.2019 23:14

@Camille Я кадрировал изображение :) Похоже, какое-то другое окно

— 17.01.2019 23:20

Спасибо, это работает с R, за что проголосовали, но мой последний инструмент визуализации (PowerBI) не поддерживает patchwork, поэтому я не смог реализовать это

— 21.01.2019 23:14

14.01.2019 19:41

Вы также можете использовать

grid.arrange(pq1_plop,pq1_status,pq2_plop,pq2_status,pq3_plop,pq3_status, ncol=2)

Вы уверены, что это соответствует ожидаемому выходному OP?

— 20.01.2019 19:51

Да, в моем первоначальном решении использовался grid.arrange(), который хорошо работал только с первыми тремя графиками. Но после того, как я добавил в левые 3 графика * _status, grid.arrange() не отображал правильно.

— 21.01.2019 23:16

14.01.2019 20:50

Ответ принят как подходящий

Вообще говоря, это мог будет одним файлом с cowplot:

plot_grid(pq1_plop, pq1_status, pq2_plop, pq2_status, pq3_plop, pq3_status,
          ncol = 2, nrow = 3, align = "v")

Но поскольку ваши графики *_status ведут себя немного неправильно, нам нужно построить вложенная сетка сюжета:

plot_grid(plot_grid(pq1_plop, pq2_plop, pq3_plop, 
                    ncol = 1, rel_heights = c(5, 9, 13), align = "v"), 
          plot_grid(pq1_status, pq2_status, pq3_status, 
                    ncol = 1, rel_heights = c(5, 9, 13)), 
          nrow = 1, rel_widths = c(10, 1))

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

То же самое с patchwork:

pq1_plop + pq1_status + pq2_plop + pq2_status + pq3_plop + pq3_status +
    plot_layout(ncol = 2, widths = c(10, 1), heights = c(5, 9, 13))

Ах прекрасно, это работает. Как вы узнали, что графики * _status работают некорректно? Что именно было не так или происходило, что вызвало несоосность? Я подумал / предположил, что это были другие 3 сюжета, поэтому я редактировал их все время.

— 21.01.2019 23:12

20.01.2019 19:25