Создание пользовательской легенды в гистограмме с несколькими цветовыми палитрами

Из других вопросов и ответов мне удалось создать гистограмму с несколькими цветовыми палитрами.

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

Вопрос: как создать пользовательскую легенду, которая печатает 3 цветовые палитры в виде матрицы 4x3, по крайней мере, с именами строк (количество цилиндров), например:

library(tidyr)

 purples %>% full_join(reds) %>% full_join(blues) %>% spread(manufacturer, colr)

# A tibble: 4 x 4
    cyl    audi    ford    <NA>
* <int>   <chr>   <chr>   <chr>
1     4 #FEE5D9 #EFF3FF #F2F0F7
2     5 #FCAE91 #BDD7E7 #CBC9E2
3     6 #FB6A4A #6BAED6 #9E9AC8
4     8 #CB181D #2171B5 #6A51A3

но затем с цветовыми кодами, замененными красивыми цветными ячейками легенды. Несколько связано с эти вопросы и ответы, но затем с легендами в сетке, а не над каждым разное.


r bar-chart ggplot2 legend geom-bar
person TemplateRex    schedule 26.08.2016    source источник
comment
Должно ли это быть mm <- dd %>%, а не mm <- gg_dd %>% в вашем примере?   -  person eipi10    schedule 26.08.2016
comment
Извините, неправильная ссылка на альтернативу tableGrob выше. Попробуйте здесь< /a> вместо этого. Как я уже писал, это может быть проще, чем хакерские легенды.   -  person Henrik    schedule 26.08.2016
comment
Пожалуйста, dput свою табличку (точнее, ее версию data.frame, чтобы не загружать ненужные пакеты).   -  person Henrik    schedule 26.08.2016
comment
Вы также можете растопить свою табличку и использовать geom_tile, чтобы создать тепловую карту ваших цветов.   -  person Henrik    schedule 26.08.2016
comment
Я думаю, что идея geom_tile будет немного похожа на легенду, сделанную в этом ответе   -  person aosmith    schedule 26.08.2016

Ответы (1)


arrow_upward
1
arrow_downward

Полное рабочее решение:

library(dplyr)
library(ggplot2)
library(gridExtra)
library(RColorBrewer)
library(tidyr)

cyl <- sort(unique(mpg$cyl))
ncat <- length(cyl)          # 4 types of cylinders

dd <- mpg %>% 
        group_by(manufacturer, cyl) %>% 
        summarise(n = n()) %>%
        ungroup() 

# create palettes
purples <- tibble(cyl, colr = brewer.pal(ncat, "Purples"))
reds    <- tibble(manufacturer = "audi", cyl, colr = brewer.pal(ncat, "Reds"))
blues   <- tibble(manufacturer = "ford", cyl, colr = brewer.pal(ncat, "Blues"))

# merge them with the data
dd_p <- dd %>% filter(!(manufacturer %in% c("audi", "ford"))) %>% left_join(purples)
dd_r <- dd %>% filter(manufacturer == "audi") %>% left_join(reds)
dd_b <- dd %>% filter(manufacturer == "ford") %>% left_join(blues)

mm <- dd %>%
        group_by(manufacturer) %>%
        summarise(mcyl = weighted.mean(cyl, n)) %>%
        arrange(mcyl) %>%
        ungroup()

gg_dd <- rbind(dd_p, dd_r, dd_b) %>%
        left_join(mm)

main_plot <- gg_dd %>% 
        ggplot(mapping = aes(x = reorder(manufacturer, mcyl), y = n, fill = colr)) + 
        geom_bar(stat = "identity", position = "fill") +
        coord_flip() +
        scale_fill_identity() 

combined_legend<- purples %>% 
        full_join(reds) %>% 
        full_join(blues) %>%
        mutate(manufacturer = ifelse(is.na(manufacturer), "generic", manufacturer)) %>% ggplot(mapping = aes(y = manufacturer, x = factor(cyl), fill = colr)) + 
        geom_tile() + 
        scale_fill_identity() + 
        coord_fixed()

grid.arrange(main_plot, combined_legend, heights=c(10,2), ncol=1)

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

person TemplateRex    schedule 26.08.2016