Добавьте второстепенные заголовки в facet_wraps

У меня есть фрейм данных, состоящий из восьми сайтов (т. е. A, B, C...H), распределенных по двум местам (т. Я сделал цифру для каждого сайта, используя North, однако я хотел бы добавить дополнительный заголовок столбца, обозначающий местоположение сайта. Как я могу это сделать?

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

library(ggplot2)
library(dplyr)

set.seed(123)

df <- data.frame(matrix(ncol = 4, nrow = 24))
colnames(df)[1:4] <- c('location','site','x','y')
df$location <- rep(c('North','North','North','South','South','South'),4)
df$site <- c('A','A','A','E','E','E','B','B','B','F','F','F',
             'C','C','C','G','G','G','D','D','D','H','H','H')
df$x <- rep(seq(0,12,4),6)
df$y <- rnorm(24,50,20)
df

Пример рисунка (отсутствует вторичный заголовок)

df %>%
  mutate(across(site, factor, levels = c('A','B','E','F',
                                         'C','D','G','H'))) %>%
  ggplot(aes(x = x, y = y)) +
  geom_point() +
  geom_line() +
  scale_x_continuous(breaks = seq(0,12,3),
                     limits = c(0,12)) +
  scale_y_continuous(breaks = seq(0,max(df$y),5)) +
  theme_bw() +
  facet_wrap(~site, nrow = 2)

Вот аналогичный вопрос SO (ссылка здесь), однако я не мог заставить его работать, когда уже была вызвана функция South, и было неясно, как этот ответ будет работать с несколькими заголовками на одной оси.

Вот пример вывода, который я ищу. Обратите внимание, что facet_wrap() — это вторичный заголовок оси X, и что два левых столбца — это scale_x_continuous() сайты, а два правых столбца — это df$location сайты.

Стоит ли изучать PHP в 2023-2024 годах?
Стоит ли изучать PHP в 2023-2024 годах?
Привет всем, сегодня я хочу высказать свои соображения по поводу вопроса, который я уже много раз получал в своем сообществе: "Стоит ли изучать PHP в...
Поведение ключевого слова "this" в стрелочной функции в сравнении с нормальной функцией
Поведение ключевого слова "this" в стрелочной функции в сравнении с нормальной функцией
В JavaScript одним из самых запутанных понятий является поведение ключевого слова "this" в стрелочной и обычной функциях.
Приемы CSS-макетирования - floats и Flexbox
Приемы CSS-макетирования - floats и Flexbox
Здравствуйте, друзья-студенты! Готовы совершенствовать свои навыки веб-дизайна? Сегодня в нашем путешествии мы рассмотрим приемы CSS-верстки - в...
Тестирование функциональных ngrx-эффектов в Angular 16 с помощью Jest
В системе управления состояниями ngrx, совместимой с Angular 16, появились функциональные эффекты. Это здорово и делает код определенно легче для...
Концепция локализации и ее применение в приложениях React ⚡️
Концепция локализации и ее применение в приложениях React ⚡️
Локализация - это процесс адаптации приложения к различным языкам и культурным требованиям. Это позволяет пользователям получить опыт, соответствующий...
Пользовательский скаляр GraphQL
Пользовательский скаляр GraphQL
Листовые узлы системы типов GraphQL называются скалярами. Достигнув скалярного типа, невозможно спуститься дальше по иерархии типов. Скалярный тип...
4
0
80
2
Перейти к ответу Данный вопрос помечен как решенный

Ответы 2

Основываясь на ответе akrun, вы можете скрыть полосу, установив соответствующие элементы пустыми в strip_nested(). Однако я не нашел способа удалить избыточное пространство.

library(ggh4x)
#> Loading required package: ggplot2
library(ggplot2)
library(dplyr)


set.seed(123)

df <- data.frame(matrix(ncol = 4, nrow = 24))
colnames(df)[1:4] <- c('location','site','x','y')
df$location <- rep(c('North','North','North','South','South','South'),4)
df$site <- c('A','A','A','E','E','E','B','B','B','F','F','F',
             'C','C','C','G','G','G','D','D','D','H','H','H')
df$x <- rep(seq(0,12,4),6)
df$y <- rnorm(24,50,20)
df %>%
  mutate(across(site, factor, levels = c('A','B','E','F',
                                         'C','D','G','H'))) %>%
  ggplot(aes(x = x, y = y)) +
  geom_point() +
  geom_line() +
  scale_x_continuous(breaks = seq(0,12,3),
                     limits = c(0,12)) +
  scale_y_continuous(breaks = seq(0,max(df$y),5)) +
  theme_bw() +
  facet_manual(
    vars(location, site), design = "ABEF\nCDGH",
    strip = strip_nested(
      text_x = list(element_text(), element_blank())[c(1,1,2,2,rep(1, 8))],
      background_x = list(element_rect(), element_blank())[c(1,1,2,2,rep(1, 8))]
    ))

Created on 2023-01-05 by the reprex package (v2.0.1)

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

Allan Cameron 05.01.2023 22:03

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

tassones 05.01.2023 22:26

@AllanCameron Мне интересно узнать, как вы планировали оформить вторичные заголовки.

tassones 05.01.2023 22:27

@tassones, вероятно, это ошибка, которую следует исправить.

teunbrand 05.01.2023 22:37

Лишнее пространство можно удалить с помощью отрицательного расстояния между панелями — см. мой пример.

Allan Cameron 05.01.2023 22:38

Хах, хитрый трюк! Хотя, вероятно, все же следует исправить.

teunbrand 05.01.2023 22:40
Ответ принят как подходящий

Чтобы оформить каждый подзаголовок по своему усмотрению, вы можете сделать что-то вроде:

library(ggh4x)

# Create blank headers for a dummy variable that we will use for rows
outer_rect <- list(element_blank(), element_blank())
outer_text <- list(element_blank(), element_blank())

# Create black headers for first row of location strips, blank otherwise
loc_rect <- list(element_rect(fill = "black"), element_rect(fill = "black"),
                 element_blank(), element_blank())
loc_text <- list(element_text(colour = "white", size = 14),
                 element_text(colour = "white", size = 14),
                 element_blank(), element_blank())

# Create 8 normal strips for the letter headers
final_rect <- elem_list_rect(fill = rep("gray", 8))
final_text <- elem_list_text(colour = rep("black", 8))

Теперь мы создаем фиктивную переменную, чтобы присвоить буквам соответствующие строки граней.

df %>%
  mutate(across(site, factor, levels = c('A','B','E','F',
                                         'C','D','G','H'))) %>%
  # This generates a dummy variable (1 for first row, 2 for second row)
  mutate(rownum = site %in%  c('C','D','G','H') + 1) %>%
  ggplot(aes(x = x, y = y)) +
  geom_point() +
  geom_line() +
  scale_x_continuous(breaks = seq(0,12,3),
                     limits = c(0,12)) +
  scale_y_continuous(breaks = seq(0,max(df$y),5)) +
  theme_bw() +
  facet_nested_wrap(rownum~location + site, nrow = 2,
                    strip = strip_nested(
                      background_x = c(outer_rect, loc_rect, final_rect),
                      text_x = c(outer_text, loc_text, final_text)
                    )) +
  theme(panel.spacing.y = unit(-10, "mm"))

это здорово, но немного сложно понять, что делает код. Не могли бы вы аннотировать это? Особенно то, что ..._rect, ..._text и mutate(rowsum =...). Я пытаюсь адаптировать это к сюжету с тремя строками, и у меня возникают проблемы (оглядываясь назад, я должен был сделать свой пример с тремя строками).

tassones 05.01.2023 23:17

Взгляните на мое обновление @tassones

Allan Cameron 05.01.2023 23:29

На всякий случай, если кто-нибудь столкнется с этой страницей в будущем... если у вас, например, три строки (т. е. всего 12 участков), вам нужно будет добавить дополнительный element_blank() к outer_rect и outer_text. Затем добавьте 2 дополнительных element_blank() к loc_treat и loc_text. Наконец, измените 8 номинальных полос на 12. Также убедитесь, что ваш rowsum равен 1 для сайтов первого ряда, 2 для второго и 3 для третьего.

tassones 06.01.2023 00:08

Другие вопросы по теме