Отрегулируйте дискретную высоту оси Y для количества сегментов в фасетах

Question

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

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

Сначала я столкнулся с проблемами, связанными с разницей в расстоянии между белками / сегментами по осям Y вразные грани.Мне удалось решить эту проблему с помощью функции ggplot: coord_fixed, используя указанное соотношение.Однако по-прежнему высоты осей Y в каждом фасете не соответствуют количеству сегментов.Кроме того, coord_fixed выдает ошибку при попытке facet_wrap(scales = "free_y"), так как не допускает свободных осей.

Как убрать дополнительный интервал по осям y / контролировать высоту yоси в каждом фасете?

Вот пример кода:

library(ggplot2)
library(dplyr)
d_list <- lapply(paste("protein", seq(1,100,1)), function(protein){
  #The full length the protein
  prot_length <- sample(seq(100,500,1), size = 1)

  #The organism the protein belongs to
  org_name <- sample(paste("organism", seq(1,5,1), sep = "_"), 1)

  #The start and end of the segments of interest - 15 amino acids long
  start <- sample(seq(1,prot_length-14,1),sample(1:20,1))
  end <- start + 14

  #The patient/group the segments of interest originate from
  group <- sample(paste("patient", seq(1,3,1), sep = "_"), length(start), T)

  data.frame(protein_name = rep(protein,length(start)),
             protein_length = rep(prot_length, length(start)),
             start = start,
             end = end,
             organism_name = rep(org_name,length(start)),
             group = group)
})

d <- do.call("rbind", sample(d_list, 20))

d %>%
  arrange(., organism_name, desc(protein_length)) %>%
  mutate(., protein_name = factor(protein_name, levels = unique(protein_name))) %>%
  ggplot(., aes(x = 1, xend = protein_length, y = protein_name, yend = protein_name)) +
  geom_segment(color = rgb(0,0,0), size = 1) +
  geom_segment(aes(x = start, xend = end, y = protein_name, yend = protein_name, color = as.factor(group)),
               size = 0.7) +
  scale_x_continuous(breaks = seq(0,500,100), labels = seq(0,500,100)) +
  scale_y_discrete(label = NULL, drop = T) +
  scale_color_manual(values = c("firebrick1", "dodgerblue1", "darkgoldenrod1")) +
  facet_wrap(~organism_name, ncol = 1, drop = T) +
  theme_minimal() + 
  labs(color = "Group", y = "Proteins", x = "Amino Acid Position") +
  theme(axis.title.x = element_text(size = 15, face = "bold", vjust = 0.5), 
        axis.text.x = element_text(size = 12), 
        panel.grid.minor.x = element_blank(),
        axis.title.y = element_text(size = 15, face = "bold", vjust = 0.5), 
        panel.grid.major.y = element_blank(), 
        panel.grid.minor.y = element_blank(),
        legend.title = element_text(size = 15, face = "bold"), 
        legend.text = element_text(size = 12)) +
  coord_fixed(ratio = 2)

Answer 1

Изменить, чтобы объединить facet_wrap позиции полосы с facet_grid свободными размерами панели

(Примечание: я увеличил размеры сегментов, потому что их было действительно трудно увидеть ...)

# data d was created with set.seed(123)

# generate plot without either facet option
p <- d %>%
  arrange(organism_name, desc(protein_length)) %>%
  mutate(protein_name = factor(protein_name, 
                               levels = unique(protein_name))) %>%      
  ggplot(aes(x = 1, xend = protein_length, 
             y = protein_name, yend = protein_name)) +
  geom_segment(color = rgb(0, 0, 0), size = 4) +
  geom_segment(aes(x = start, xend = end, y = protein_name, 
                   yend = protein_name, color = as.factor(group)),
               size = 3) +
  scale_x_continuous(breaks = seq(0,500,100), labels = seq(0,500,100)) +
  scale_y_discrete(label = NULL, drop = T) +
  scale_color_manual(values = c("firebrick1", "dodgerblue1", "darkgoldenrod1")) +
  theme_minimal() + 
  labs(color = "Group", y = "Proteins", x = "Amino Acid Position") +
  theme(axis.title.x = element_text(size = 15, face = "bold", vjust = 0.5), 
        axis.text.x = element_text(size = 12),
        panel.grid.minor.x = element_blank(),
        axis.title.y = element_text(size = 15, face = "bold", vjust = 0.5), 
        panel.grid.major.y = element_blank(), 
        panel.grid.minor.y = element_blank(),
        legend.title = element_text(size = 15, face = "bold"), 
        legend.text = element_text(size = 12))

# create two versions of the plot using facet_grid / facet_wrap, 
# with scales set to "free_y" for both, but also space = "free_y" for facet_grid
# (facet_wrap doesn't have this option)
p.grid <- p + facet_grid(organism_name ~ ., scales = "free_y", space = "free_y")
p.wrap <- p + facet_wrap(~ organism_name, ncol = 1, scales = "free_y")

# convert both into grob objects
gp.grid <- ggplotGrob(p.grid)
gp.wrap <- ggplotGrob(p.wrap)

# apply the panel heights of the facet_grid version to the facet_wrap one
gp.wrap$heights[gp.wrap$layout[grep("panel", gp.wrap$layout$name), "t"]] <- 
  gp.grid$heights[gp.grid$layout[grep("panel", gp.grid$layout$name), "t"]]

# plot the facet_wrap version
grid::grid.draw(gp.wrap)

Оригинальный ответ

Звучит так, будто вы ищете facet_grid вместо facet_wrap. Это позволяет изменять разрывы осей и высоту фасетов, если установить для scales & space значение "free_y":

d %>%
  arrange(organism_name, desc(protein_length)) %>%
  mutate(protein_name = factor(protein_name, 
                               levels = unique(protein_name))) %>%      
  ggplot(aes(x = 1, xend = protein_length, 
             y = protein_name, yend = protein_name)) +
  geom_segment(color = rgb(0, 0, 0), size = 1) +
  geom_segment(aes(x = start, xend = end, y = protein_name, 
                   yend = protein_name, color = as.factor(group)),
               size = 0.7) +
  scale_x_continuous(breaks = seq(0,500,100), labels = seq(0,500,100)) +
  scale_y_discrete(label = NULL, drop = T) +
  scale_color_manual(values = c("firebrick1", "dodgerblue1", "darkgoldenrod1")) +
  facet_grid(organism_name ~ ., drop = T,
             scales = "free_y", space = "free_y") +
  theme_minimal() + 
  labs(color = "Group", y = "Proteins", x = "Amino Acid Position") +
  theme(axis.title.x = element_text(size = 15, face = "bold", vjust = 0.5), 
        axis.text.x = element_text(size = 12),
        panel.grid.minor.x = element_blank(),
        axis.title.y = element_text(size = 15, face = "bold", vjust = 0.5), 
        panel.grid.major.y = element_blank(), 
        panel.grid.minor.y = element_blank(),
        legend.title = element_text(size = 15, face = "bold"), 
        legend.text = element_text(size = 12))