ggplot2: разделите легенду на две колонки, каждая со своим названием

Ответ 1

Вы можете переместить категорию "Очень хорошо" во второй столбец легенды, добавив уровень фиктивного фактора и установив свой цвет в белый цвет в легенде, чтобы его не было видно. В приведенном ниже коде мы добавляем пустой уровень фактора между "Хорошим" и "Очень хорошим", так что теперь у нас есть шесть уровней. Затем мы используем scale_fill_manual, чтобы установить цвет этого пустого уровня на "белый". drop=FALSE заставляет ggplot сохранять пустой уровень в легенде. Может быть более элегантный способ контролировать, где ggplot помещает значения легенды, но по крайней мере это выполнит задание.

diamonds$cut = factor(diamonds$cut, levels=c("Fair","Good"," ","Very Good",
                                             "Premium","Ideal"))

ggplot(diamonds, aes(color, fill=cut)) + geom_bar() + 
  scale_fill_manual(values=c(hcl(seq(15,325,length.out=5), 100, 65)[1:2], 
                             "white",
                             hcl(seq(15,325,length.out=5), 100, 65)[3:5]),
                    drop=FALSE) +
  guides(fill=guide_legend(ncol=2)) +
  theme(legend.position="bottom")

ОБНОВЛЕНИЕ: Я надеюсь, что есть лучший способ добавить названия в каждую группу в легенде, но единственным вариантом, который я могу предложить сейчас, является прибегнуть к grobs, который всегда дает у меня головная боль. Приведенный ниже код адаптирован из ответа на этот вопрос SO. Он добавляет два текстовых grobs, по одному для каждой метки, но метки должны быть расположены вручную, что является огромной болью. Код для сюжета также должен быть изменен, чтобы создать больше места для легенды. Кроме того, несмотря на то, что я отключил отсечение для всех грызунов, этикетки все еще обрезаны легендарным гном. Вы можете позиционировать метки за пределами обрезанной области, но тогда они слишком далеки от легенды. Я надеюсь, что кто-то, кто действительно знает, как работать с грызунами, может исправить это и в целом улучшить код ниже (@baptiste, вы там?).

library(gtable)

p = ggplot(diamonds, aes(color, fill=cut)) + geom_bar() + 
  scale_fill_manual(values=c(hcl(seq(15,325,length.out=5), 100, 65)[1:2], 
                             "white",
                             hcl(seq(15,325,length.out=5), 100, 65)[3:5]),
                    drop=FALSE) +
  guides(fill=guide_legend(ncol=2)) +
  theme(legend.position=c(0.5,-0.26),  
        plot.margin=unit(c(1,1,7,1),"lines")) +
  labs(fill="") 

# Add two text grobs
p = p + annotation_custom(
    grob = textGrob(label = "First\nGroup", 
                    hjust = 0.5, gp = gpar(cex = 0.7)),
    ymin = -2200, ymax = -2200, xmin = 3.45, xmax = 3.45) +
  annotation_custom(
    grob = textGrob(label = "Second\nGroup",
                    hjust = 0.5, gp = gpar(cex = 0.7)),
    ymin = -2200, ymax = -2200, xmin = 4.2, xmax = 4.2)

# Override clipping
gt <- ggplot_gtable(ggplot_build(p))
gt$layout$clip <- "off"
grid.draw(gt)

И вот результат:

Ответ 2

Это добавляет названия легенды gtable. Он использует технику @eipi10 для перемещения категории "очень хорошо" во второй столбец легенды (спасибо).

Метод извлекает легенду из сюжета. Легенда gtable можно манипулировать. Здесь дополнительная строка добавляется в gtable, а заголовки добавляются в новую строку. Легенда (после небольшой доработки) возвращается в сюжет.

library(ggplot2)
library(gtable)
library(grid)

diamonds$cut = factor(diamonds$cut, levels=c("Fair","Good"," ","Very Good",
                                             "Premium","Ideal"))

p = ggplot(diamonds, aes(color, fill = cut)) + 
       geom_bar() + 
       scale_fill_manual(values = 
              c(hcl(seq(15, 325, length.out = 5), 100, 65)[1:2], 
              "white",
              hcl(seq(15, 325, length.out = 5), 100, 65)[3:5]),
              drop = FALSE) +
  guides(fill = guide_legend(ncol = 2, title.position = "top")) +
  theme(legend.position = "bottom", 
        legend.key = element_rect(fill = "white"))

# Get the ggplot grob
g = ggplotGrob(p)

# Get the legend
leg = g$grobs[[which(g$layout$name == "guide-box")]]$grobs[[1]]

# Set up the two sub-titles as text grobs
st = lapply(c("First group", "Second group"), function(x) {
   textGrob(x, x = 0, just = "left", gp = gpar(cex = 0.8)) } )

# Add a row to the legend gtable to take the legend sub-titles
leg = gtable_add_rows(leg, unit(1, "grobheight", st[[1]]) + unit(0.2, "cm"), pos =  3)

# Add the sub-titles to the new row
leg = gtable_add_grob(leg, st, 
            t = 4, l = c(2, 6), r = c(4, 8), clip = "off")

# Add a little more space between the two columns
leg$widths[[5]] = unit(.6, "cm")

# Move the legend to the right
 leg$vp = viewport(x = unit(.95, "npc"), width = sum(leg$widths), just = "right")

# Put the legend back into the plot
g$grobs[[which(g$layout$name == "guide-box")]] = leg

# Draw the plot
grid.newpage()
grid.draw(g)

Ответ 3

Следуя идее @eipi10, вы можете добавить названия заголовков в виде меток со значениями white:

diamonds$cut = factor(diamonds$cut, levels=c("Title 1           ","Fair","Good"," ","Title 2","Very Good",
                                         "Premium","Ideal"))

ggplot(diamonds, aes(color, fill=cut)) + geom_bar() + 
   scale_fill_manual(values=c("white",hcl(seq(15,325,length.out=5), 100, 65)[1:2], 
                              "white","white",
                              hcl(seq(15,325,length.out=5), 100, 65)[3:5]),
                     drop=FALSE) +
   guides(fill=guide_legend(ncol=2)) +
   theme(legend.position="bottom", 
         legend.key = element_rect(fill=NA),
         legend.title=element_blank())

Я ввел некоторые пробелы после "Title 1 " чтобы разделить столбцы и улучшить дизайн, но может быть возможность увеличить пространство.

Единственная проблема в том, что я понятия не имею, как изменить формат надписей "title" (я пробовал bquote или expression но это не сработало).

_____________________________________________________________

В зависимости от графика, который вы пытаетесь использовать, правильное выравнивание легенды может быть лучшей альтернативой, и этот прием выглядит лучше (ИМХО). Он разделяет легенду на две части и лучше использует пространство. Все, что вам нужно сделать, это изменить ncol обратно на 1, а "bottom" (legend.position) на "right":

diamonds$cut = factor(diamonds$cut, levels=c("Title 1","Fair","Good"," ","Title 2","Very Good","Premium","Ideal"))


ggplot(diamonds, aes(color, fill=cut)) + geom_bar() + 
   scale_fill_manual(values=c("white",hcl(seq(15,325,length.out=5), 100, 65)[1:2], 
                              "white","white",
                              hcl(seq(15,325,length.out=5), 100, 65)[3:5]),
                     drop=FALSE) +
   guides(fill=guide_legend(ncol=1)) +
   theme(legend.position="bottom", 
         legend.key = element_rect(fill=NA),
         legend.title=element_blank())

В этом случае, возможно, имеет смысл оставить заголовок в этой версии, удалив legend.title=element_blank()

Ответ 4

Используя cowplot, вам просто нужно cowplot легенды отдельно, а затем сшить вещи обратно вместе. Это требует использования scale_fill_manual чтобы убедиться, что цвета совпадают на всех графиках, и есть много места для того, чтобы поиграть с позицией легенды и т.д.

Сохраните используемые цвета (здесь, используя RColorBrewer)

cut_colors <-
  setNames(brewer.pal(5, "Set1")
           , levels(diamonds$cut))

Сделайте базовый сюжет - без легенды:

full_plot <-
  ggplot(diamonds, aes(color, fill=cut)) + geom_bar() + 
  scale_fill_manual(values = cut_colors) +
  theme(legend.position="none")

Создайте два отдельных графика, ограниченных разрезами внутри группы, которые мы хотим. Мы не планируем строить это; мы просто будем использовать легенды, которые они генерируют. Обратите внимание, что я использую dplyr для простоты фильтрации, но это не является строго необходимым. Если вы делаете это для более чем двух групп, возможно, стоит lapply усилия, чтобы использовать split и lapply для создания списка графиков вместо того, чтобы делать каждую вручную.

for_first_legend <-
  diamonds %>%
  filter(cut %in% c("Fair", "Good")) %>%
  ggplot(aes(color, fill=cut)) + geom_bar() + 
  scale_fill_manual(values = cut_colors
                    , name = "First Group")


for_second_legend <-
  diamonds %>%
  filter(cut %in% c("Very Good", "Premium", "Ideal")) %>%
  ggplot(aes(color, fill=cut)) + geom_bar() + 
  scale_fill_manual(values = cut_colors
                    , name = "Second Group")

Наконец, plot_grid сюжет и легенды вместе с помощью plot_grid. Обратите внимание, что я использовал theme_set(theme_minimal()) перед запуском сюжета, чтобы получить тему, которая мне лично нравится.

plot_grid(
  full_plot
  , plot_grid(
    get_legend(for_first_legend)
    , get_legend(for_second_legend)
    , nrow = 1
  )
  , nrow = 2
  , rel_heights = c(8,2)
)

Ответ 5

Этому вопросу уже несколько лет, но есть пакет, появившийся после того, как этот вопрос был задан, Relayer (на github), который может помочь здесь. Это позволяет определить новую эстетику, поэтому здесь мы рисуем fill2 дважды, один раз с эстетикой fill и один раз с эстетикой fill2, генерируя отдельную легенду для каждого с использованием scale_fill_manual.

library(ggplot2)
library(dplyr)
library(relayer)

cut.levs <- levels(diamonds$cut)
cut.values <- setNames(rainbow(length(cut.levs)), cut.levs)

ggplot(diamonds, aes(color)) +
  geom_bar(aes(fill = cut)) + 
  geom_bar(aes(fill2 = cut)) %>% rename_geom_aes(new_aes = c(fill = "fill2")) +
  guides(fill=guide_legend(order = 1)) +
  theme(legend.position="bottom") +
  scale_fill_manual(aesthetics = "fill", values = cut.values,
                    breaks = cut.levs[1:2], name = "First Grouop:") +
  scale_fill_manual(aesthetics = "fill2", values = cut.values,
                    breaks = cut.levs[-(1:2)], name = "Second Group:")

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

guides(fill = guide_legend(order = 1, ncol = 1),
  fill2 = guide_legend(ncol = 1)) +