ggplot - централизовать заголовок facet_grid и отображать его только один раз

Я создал график в ggplot с двумя переменными внутри facet_grid.

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

Например, нули и единицы в первом ряду (верхняя грань) появятся только один раз и в середине.

В моем исходном графике количество графиков на грань не равно. Таким образом, объединение двух графиков с использованием patchwork/ cowplot / ggpubr не очень хорошо работает.
Я предпочитаю решение/хак только с использованием ggplot.

введите здесь описание изображения

Пример данных:

df <- head(mtcars, 5)

Пример сюжета:

df %>% 
  ggplot(aes(gear, disp)) + 
  geom_bar(stat = "identity") + 
  facet_grid(~am + carb,
             space = "free_x", 
             scales = "free_x") +
  ggplot2::theme(
    panel.spacing.x = unit(0,"cm"), 
    axis.ticks.length=unit(.25, "cm"), 
    strip.placement = "outside",
    legend.position = "top",
    legend.justification = "center",
    legend.direction = "horizontal",
    legend.key.size = ggplot2::unit(1.5, "lines"),
    # switch off the rectangle around symbols
    legend.key = ggplot2::element_blank(),
    legend.key.width = grid::unit(2, "lines"),
    # # facet titles
    strip.background = ggplot2::element_rect(
      colour = "black",
      fill = "white"),
    panel.background = ggplot2::element_rect(
      colour = "white",
      fill = "white"), 
    panel.grid.major = element_blank(),
    panel.grid.minor = element_blank())

Изменить - новые данные

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

structure(list(par = c("Par1", "Par1", "Par1", "Par1", "Par1", 
"Par1", "Par1", "Par1", "Par1", "Par1", "Par1", "Par1", "Par1", 
"Par1", "Par1", "Par1", "Par1", "Par1", "Par1", "Par1", "Par1", 
"Par1", "Par1", "Par1", "Par1", "Par1", "Par1", "Par2", "Par2", 
"Par2"), channel_1 = structure(c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 11L, 11L, 11L, 11L, 
11L, 11L, 11L, 11L, 11L, 1L, 1L, 1L), .Label = c("Center", "Left \nFrontal", 
"Left \nFrontal Central", "Left \nCentral Parietal", "Left \nParietal Ooccipital", 
"Left", "Right \nFrontal", "Right \nFrontal Central", "Right \nCentral Parietal", 
"Right \nParietal Ooccipital", "Right"), class = "factor"), freq = structure(c(1L, 
1L, 1L, 2L, 2L, 2L, 3L, 3L, 3L, 1L, 1L, 1L, 2L, 2L, 2L, 3L, 3L, 
3L, 1L, 1L, 1L, 2L, 2L, 2L, 3L, 3L, 3L, 3L, 3L, 3L), .Label = c("Alpha", 
"Beta", "Gamma"), class = "factor"), group = c("a", "b", "c", 
"a", "b", "c", "a", "b", "c", "a", "b", "c", "a", "b", "c", "a", 
"b", "c", "a", "b", "c", "a", "b", "c", "a", "b", "c", "a", "b", 
"c"), m = c(0.488630500442935, 0.548666228768508, 0.0441536349332613, 
0.304475866391531, 0.330039488441422, 0.0980622573307064, 0.0963996979198171, 
0.301679466108907, 0.240618782227119, 0.35779695722622, 0.156116647839907, 
0.0274546218676152, 0.0752501569920047, 0.289342864254614, 0.770518960576786, 
0.548130676907356, 0.180158614358946, 0.238520826021687, 0.406326198917495, 
0.159739769132509, 0.140739952534666, 0.295427640977557, 0.106130817023844, 
0.214006898241167, 0.31081727835652, 0.366982521446529, 0.264432086988446, 
0.0761271112139142, 0.0811642772125171, 0.0700455890939194), 
    se = c(0.00919040825504951, 0.00664655073810519, 0.0095517721611042, 
    0.00657090455386036, 0.00451135146762504, 0.0188625074573698, 
    0.00875378313351897, 0.000569521129673224, 0.00691447732630984, 
    0.000241814142091401, 0.0124584589176995, 0.00366855139256551, 
    0.0072981677277562, 0.0160663614099261, 0.00359337442316408, 
    0.00919725279757502, 0.040856967817406, 0.00240910563984416, 
    0.0152236046767608, 0.00765487375180611, 0.00354140237391633, 
    0.00145468584619171, 0.0185141245423404, 0.000833307847848054, 
    0.0038193622895167, 0.0206130436440409, 0.0066911922721337, 
    7.3079999953491e-05, 0.0246233416039572, 0.00328150956514463
    )), row.names = c(NA, -30L), class = c("tbl_df", "tbl", "data.frame"
))

Сюжет:

df %>%
  ggplot(aes(channel_1, m, 
             group = group,
             fill = group, 
             color = group)) +
  facet_grid(~par + freq,
             space="free_x", 
             scales="free_x") +
  geom_errorbar(
    aes(min = m - se, ymax = m + se, alpha = 0.01), 
    width = 0.2, size = 2, color = "black", 
    position = position_dodge(width = 0.6)) +
  geom_bar(stat = "identity",
           position = position_dodge(width = 0.6),
           # color = "black", 
           # fill = "white",
           width = 0.6, 
           size = 2, aes(alpha = 0.01))  + 
  scale_shape_manual(values = c(1, 8, 5)) + 
  labs(
    color = "",
    fill = "", 
    shape = "") +
  guides(
    color = FALSE,
    shape = FALSE) +
  scale_alpha(guide = "none")

введите здесь описание изображения


person DJV    schedule 23.03.2020    source источник
comment
Надо было раньше поискать дубликаты, ха-ха! Но я узнал кое-что новое, так что это было не так уж плохо :)   -  person tjebo    schedule 24.03.2020


Ответы (2)


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

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

df <- head(mtcars,5)
df <- df %>% mutate(am_carb = factor(paste(am,carb,sep = '_'), 
                      labels = c( ' 1','2','1','4')))
##note!! the blank space in ' 1' label is on purpose!!! this is to make those labels unique, otherwise it would consider both '1' the same category!!

p1 <-
  df %>% 
  ggplot(aes(gear, disp)) + 
  geom_bar(stat = "identity") + 
  facet_grid(~am_carb, scales = "free_x") +
theme(panel.spacing.x = unit(0,"cm"),
      plot.margin = margin(t = -2),
      strip.background = element_rect(colour = "black",fill = "white"),
      panel.background = element_rect(colour = "white", fill = "white"), 
      panel.grid.major = element_blank(),
      panel.grid.minor = element_blank())

p2 <-
  df %>% 
  ggplot(aes(gear, disp)) + 
  geom_blank() + 
  facet_grid(~ am, scales = "free_x") +
  theme(panel.spacing.x = unit(0,"cm"),
        axis.text = element_blank(),
        axis.ticks = element_blank(),
        axis.title = element_blank(),
        plot.margin = margin(b = -2),
        strip.background = element_rect(colour = "black",fill = "white"),
        panel.background = element_rect(colour = "white", fill = "white"), 
        panel.grid.major = element_blank(),
        panel.grid.minor = element_blank())


p2/p1 + plot_layout(heights = c(0.1,100) )

Создано 24 марта 2020 г. с помощью пакета reprex (v0.3.0)

обновление новыми данными – некоторые более сложные аспекты. Действительно, лоскутное шитье здесь сложное. Легче объединить поддельные грани с ковшом после преобразования поддельных граней в объект сетки и изменения ширины. Все в пределах cowplot.

mydat <- structure(list(par = c("Par1", "Par1", "Par1", "Par1", "Par1", "Par1", "Par1", "Par1", "Par1", "Par1", "Par1", "Par1", "Par1", "Par1", "Par1", "Par1", "Par1", "Par1", "Par1", "Par1", "Par1", "Par1", "Par1", "Par1", "Par1", "Par1", "Par1", "Par2", "Par2", "Par2"), channel_1 = structure(c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 11L, 11L, 11L, 11L, 11L, 11L, 11L, 11L, 11L, 1L, 1L, 1L), .Label = c("Center", "Left \nFrontal", "Left \nFrontal Central", "Left \nCentral Parietal", "Left \nParietal Ooccipital", "Left", "Right \nFrontal", "Right \nFrontal Central", "Right \nCentral Parietal", "Right \nParietal Ooccipital", "Right"), class = "factor"), freq = structure(c(1L, 1L, 1L, 2L, 2L, 2L, 3L, 3L, 3L, 1L, 1L, 1L, 2L, 2L, 2L, 3L, 3L, 3L, 1L, 1L, 1L, 2L, 2L, 2L, 3L, 3L, 3L, 3L, 3L, 3L), .Label = c("Alpha", "Beta", "Gamma"), class = "factor"), group = c("a", "b", "c", "a", "b", "c", "a", "b", "c", "a", "b", "c", "a", "b", "c", "a", "b", "c", "a", "b", "c", "a", "b", "c", "a", "b", "c", "a", "b", "c"), m = c(0.488630500442935, 0.548666228768508, 0.0441536349332613, 0.304475866391531, 0.330039488441422, 0.0980622573307064, 0.0963996979198171, 0.301679466108907, 0.240618782227119, 0.35779695722622, 0.156116647839907, 0.0274546218676152, 0.0752501569920047, 0.289342864254614, 0.770518960576786, 0.548130676907356, 0.180158614358946, 0.238520826021687, 0.406326198917495, 0.159739769132509, 0.140739952534666, 0.295427640977557, 0.106130817023844, 0.214006898241167, 0.31081727835652, 0.366982521446529, 0.264432086988446, 0.0761271112139142, 0.0811642772125171, 0.0700455890939194), se = c(0.00919040825504951, 0.00664655073810519, 0.0095517721611042, 0.00657090455386036, 0.00451135146762504, 0.0188625074573698, 0.00875378313351897, 0.000569521129673224, 0.00691447732630984, 0.000241814142091401, 0.0124584589176995, 0.00366855139256551, 0.0072981677277562, 0.0160663614099261, 0.00359337442316408, 0.00919725279757502, 0.040856967817406, 0.00240910563984416, 0.0152236046767608, 0.00765487375180611, 0.00354140237391633, 0.00145468584619171, 0.0185141245423404, 0.000833307847848054, 0.0038193622895167, 0.0206130436440409, 0.0066911922721337, 7.3079999953491e-05, 0.0246233416039572, 0.00328150956514463)), row.names = c(NA, -30L), class = c("tbl_df", "tbl", "data.frame"))

library(tidyverse)
library(cowplot)
#> 
#> ********************************************************
#> Note: As of version 1.0.0, cowplot does not change the
#>   default ggplot2 theme anymore. To recover the previous
#>   behavior, execute:
#>   theme_set(theme_cowplot())
#> ********************************************************

mydat <- mydat %>% mutate(par_freq = factor(paste(par,freq,sep = '_'), labels = c('Alpha', 'Beta', 'Gamma', 'Gamma ' )))

p1 <-
  mydat %>% 
    ggplot(aes(channel_1, m, group = group, fill = group, color = group)) +
  geom_bar(stat = "identity") + 
  facet_grid( ~ par_freq, scales = "free_x", space="free_x") +
  theme(panel.spacing.x = unit(0,"cm"),
        plot.margin = margin(t = -2),
        strip.background = element_rect(colour = "black",fill = "white"),
        panel.background = element_rect(colour = "white", fill = "white"), 
        panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        legend.position = 'none')

p2 <-
  mydat %>%
    ggplot(aes(channel_1, m, group = group, fill = group, color = group)) +
    geom_blank() + 
    facet_grid(~ par) +
    theme(panel.spacing.x = unit(0,"cm"),
          axis.text = element_blank(),
          axis.ticks = element_blank(),
          axis.title = element_blank(),
          plot.margin = margin(b = -2),
          strip.background = element_rect(colour = "black",fill = "white"),
          panel.background = element_rect(colour = "white", fill = "white"), 
          panel.grid.major = element_blank(),
          panel.grid.minor = element_blank())


gt <-  cowplot::as_gtable(p2)
gt$widths[5] <- 8*gt$widths[7]
cowplot::plot_grid(gt, p1, align = "v", axis = 'l',nrow = 2, rel_heights = c(5, 100))
# you need to play around with the values unfortunately. 

Создано 24 марта 2020 г. с помощью пакета reprex (v0.3.0)

Некоторые дополнительные соображения

Я думал, что такой хак не обойти, потому что gtable_layout исходного сюжета (с двумя переменными фасета) показывает, что вся полоса фасета — это один гроб! Этот ответ доказал мою неправоту - grob содержит вложенную таблицу для обеих полос!. Но есть более простое решение благодаря пакету ggnomics - см. мой второй ответ

p_demo <-   ggplot(mydat, aes(channel_1, m)) + 
  geom_bar(stat = "identity") + 
  facet_grid(~par +freq , space = "free_x",  scales = "free_x") +
  theme(panel.spacing.x = unit(0,"cm"))

gt <-  cowplot::as_gtable(p_demo)
gtable::gtable_show_layout(gt)

Создано 24 марта 2020 г. с помощью пакета reprex (v0.3.0)

person tjebo    schedule 23.03.2020
comment
patchwork — фантастический пакет. Однако моя проблема в том, что мои исходные два графика имеют разный размер. Таким образом, если я не использую Facet_Grid вместе, соотношение выглядит очень плохо. - person DJV; 24.03.2020
comment
И спасибо за ответ :). Я отредактировал свой вопрос. - person DJV; 24.03.2020
comment
Конечно и спасибо! Пожалуйста, посмотрите мое редактирование - person DJV; 24.03.2020
comment
Боже, это кошмар ;). Надеюсь, повторить это снова не составит труда! На самом деле я безуспешно начал смотреть на то, чтобы просто рисовать прямоугольники над заголовками фасетов (stackoverflow.com/questions/60827811/) - person DJV; 24.03.2020

Извините, что добавляю второй ответ, но я считаю, что он достаточно отличается, чтобы заслужить отдельный ответ. Я должен был подумать о пакете ggnomics раньше, что делает эту задачу очень простой!

 #devtools::install_github("teunbrand/ggnomics")
  library(ggnomics)
#> Loading required package: ggplot2
  library(tidyverse)

  mydat<- head(mtcars, 5)
  mydat %>% 
    ggplot(aes(gear, disp)) + 
    geom_bar(stat = "identity") + 
    facet_nested(~am + carb) +
    theme(panel.spacing.x = unit(0,"cm"), 
          axis.ticks.length=unit(.25, "cm"), 
          strip.placement = "inside",
          strip.background = element_rect( colour = "black", fill = "white"),
          panel.background = element_rect( colour = "black", fill = "white"))

Создано 24 марта 2020 г. с помощью пакета reprex (v0.3.0)

person tjebo    schedule 24.03.2020
comment
Удивительно! Благодарю вас! Я чувствую, что не могу принять оба ваших ответа. Вы хотите дать тот же ответ и здесь (stackoverflow.com/questions/60827811/)? - person DJV; 24.03.2020
comment
И кстати, после получения ошибки кажется, что между ggnomics и новым ggplot есть конфликты (github .com/teunbrand/ggnomics/issues/37). Так, автор предлагает использовать пакет ggh4x (github.com/teunbrand/ggh4x), если вы хотите использовать facet_nested. И еще раз спасибо! - person DJV; 24.03.2020