У меня есть фрейм данных, состоящий из восьми сайтов (т. е. 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
сайты.
Основываясь на ответе 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)
@teunbrand, если вы столкнетесь с методом удаления избыточного пробела между верхней и нижней строкой, поделитесь им. Я и другие хотели бы знать.
@AllanCameron Мне интересно узнать, как вы планировали оформить вторичные заголовки.
@tassones, вероятно, это ошибка, которую следует исправить.
Лишнее пространство можно удалить с помощью отрицательного расстояния между панелями — см. мой пример.
Хах, хитрый трюк! Хотя, вероятно, все же следует исправить.
Чтобы оформить каждый подзаголовок по своему усмотрению, вы можете сделать что-то вроде:
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
На всякий случай, если кто-нибудь столкнется с этой страницей в будущем... если у вас, например, три строки (т. е. всего 12 участков), вам нужно будет добавить дополнительный element_blank()
к outer_rect
и outer_text
. Затем добавьте 2 дополнительных element_blank()
к loc_treat
и loc_text
. Наконец, измените 8 номинальных полос на 12. Также убедитесь, что ваш rowsum
равен 1 для сайтов первого ряда, 2 для второго и 3 для третьего.
Я собирался опубликовать что-то подобное, за исключением того, что заголовки местоположения были оформлены в соответствии с вопросом. Однако требуется больше кода, поэтому я оставлю это маэстро!