Ручная цветовая шкала в граненой вафельной диаграмме ggplot

Я пытаюсь получить такую ​​же индивидуальную цветовую шкалу для граненой вафельной диаграммы в R, используя пакет waffleиз https://github.com/hrbrmstr/waffle иggplot2::facet_wrap.

Ниже воспроизводимый пример:

foo <- 
  data.frame(Genus = c("Hemipenthes","Thecophora","Cheilosia","Cheilosia","Chrysotoxum","Chrysotoxum","Dasysyrphus","Dasysyrphus","Didea","Episyrphus","Eristalis","Eristalis","Eumerus","Eumerus","Eupeodes","Eupeodes","Helophilus","Megasyrphus","Melanostoma","Meliscaeva","Merodon","Merodon","Myathropa","Neoascia","Parasyrphus","Parasyrphus","Platycheirus","Scaeva","Scaeva","Sphaerophoria","Sphaerophoria","Syrphus","Syrphus","Xanthandrus","Andrena","Apis","Bombus","Bombus","Ceratina","Lasioglossum","Lasioglossum","Sphecodes","Sphecodes","Polistes","Macroglossum","Macroglossum","Polyommatus","Aglais","Argynnis","Lasiommata","Lasiommata","Adscita","Thrips","Thrips"), 
             Ploidy = c("4x","4x","4x","8x","4x","8x","4x","8x","8x","4x","4x","8x","4x","8x","4x","8x","4x","4x","8x","4x","4x","8x","4x","8x","4x","8x","8x","4x","8x","4x","8x","4x","8x","4x","4x","8x","4x","8x","8x","4x","8x","4x","8x","8x","4x","8x","4x","8x","4x","4x","8x","4x","4x","8x"), 
             n = as.numeric(c("2","2","0","0","38","0","2","0","0","0","569","35","0","0","63","8","0","2","3","4","20","1","2","1","17","0","2","9","0","21","4","48","61","1","25","15","0","0","0","38","5","0","0","0","0","0","4","1","0","21","2","1","0","0")), 
             stringsAsFactors = F)
foo$Genus <- factor(foo$Genus, levels = unique(foo$Genus))
foo$Ploidy <- factor(foo$Ploidy, levels = c("4x", "8x"))

bar <- 
  data.frame(Genus = c("Hemipenthes","Thecophora","Cheilosia","Chrysotoxum","Dasysyrphus","Didea","Episyrphus","Eristalis","Eumerus","Eupeodes","Helophilus","Megasyrphus","Melanostoma","Meliscaeva","Merodon","Myathropa","Neoascia","Parasyrphus","Platycheirus","Scaeva","Sphaerophoria","Syrphus","Xanthandrus","Andrena","Apis","Bombus","Ceratina","Lasioglossum","Sphecodes","Polistes","Macroglossum","Polyommatus","Aglais","Argynnis","Lasiommata","Adscita","Thrips"), 
                  colour = c("#F2F5EA","#E6ECD5","#DAE2C0","#CED9AC","#C2CF97","#B5C682","#A9BC6E","#9DB359","#91A944","#85A030","#79961B","#739211","#6E8B10","#69850F","#647E0E","#5F780E","#5A720D","#556B0C","#50650B","#4B5F0B","#46580A","#415209","#3C4C08","#F4C0B7","#E98170","#DE4328","#d92405","#BA1E04","#9B1903","#7C1402","#7897F1","#3563EB","#3563eb","#2C52C3","#23429C","#1A3175","#eac124"), 
                  stringsAsFactors = F)
bar$Genus <- factor(bar$Genus, levels = unique(bar$Genus))

Цветовая палитра выглядит так:

barplot(rep(1, nrow(bar)), col = bar$colour, names.arg = bar$Genus, las = 2, cex.names = .75)

Обратите внимание, что порядок значений и уровней одинаков в обоих наборах данных:

all(unique(foo$Genus) == unique(bar$Genus))
TRUE

Теперь я объединяю два набора данных вместе:

foobar <- plyr::join(foo, bar) # preserves row order

Затем я рисую это с помощью вафли:

library(ggplot)
library(waffle)
library(hrbrthemes)
ggplot(foobar, aes(fill = Genus, values = n)) + 
  geom_waffle(colour = "white", n_rows = 20, flip = T) + 
  facet_wrap(.~Ploidy, nrow = 1, strip.position = "bottom") +
  scale_fill_manual(values = foobar$colour, name = NULL) +
  scale_x_discrete() +
  scale_y_continuous(labels = function(x) x * 20, expand = c(0,0)) +
  coord_equal() +
  theme_minimal(base_family = "Roboto Condensed") +
  theme(panel.grid = element_blank(), axis.ticks.y = element_line()) +
  guides(fill = guide_legend(reverse = T))

Однако цвета не соответствуют назначенной заливке (Genus). Например, первые 4 записи легенды (Adscita, Lasiommata, Aglais, Polyommatus) должны быть оттенками синего, а не зеленого. Кроме того, некоторые уровниGenusбыли отброшены полностью, как и Cheilosia, Bombus и Didea. Такое поведение сохраняется при использовании других геометрий или удалении фасета.

Желаемый результат - чтобы каждое уникальное значение Genus переменная одного цвета на двух фасетах, как указано в пользовательской палитре в bar и визуализирован на диаграмме выше.

Источник

2 ответа

Решение

Это то, чего ты хочешь? С помощьюscale_fill_identity(drop = FALSE)

как правило, вероятно, лучше просто использовать вашу переменную для эстетики, а затем сопоставить ей цвета с именованным вектором в scale_..._manual. Я добавил названный вектор в качестве метки.drop = FALSE показать неиспользуемые уровни

library(ggplot2)
#devtools::install_github("hrbrmstr/waffle")
library(waffle)

a <- unique(as.character(foobar$Genus))
names(a) <- unique(foobar$colour)

ggplot(foobar, aes(fill = colour, values = n)) + 
  geom_waffle(colour = "white", n_rows = 20, flip = T) + 
  facet_wrap(.~Ploidy, nrow = 1, strip.position = "bottom") +
  scale_fill_identity(guide = 'legend', labels = a, drop = FALSE) +
  labs(fill = 'Genus') +
  scale_y_continuous(labels = function(x) x * 20, expand = c(0,0)) +
  coord_equal()

Создано 06.03.2020 пакетом REPEX (v0.3.0)

Источник

Благодаря Tjebo мне удалось решить проблему. Публикуем здесь результат для потомков:

ggplot(foobar, aes(fill = colour, values = n)) + 
  geom_waffle(colour = "white", n_rows = 20, flip = T) + 
  facet_wrap(.~Ploidy, nrow = 1, strip.position = "bottom") +
  scale_fill_identity(guide = 'legend', labels = a, breaks = bar$colour, drop = FALSE) +
  labs(fill = 'Genus') +
  coord_equal() + 
  scale_x_discrete() +
  scale_y_continuous(labels = function(x) x * 20, expand = c(0,0)) +
  theme_minimal(base_family = "Roboto Condensed") +
  theme(panel.grid = element_blank(), axis.ticks.y = element_line()) +
  guides(fill = guide_legend(reverse = T))

https://i.stack.imgur.com/7GCFy.png

Теперь легенда правильно соответствует настраиваемой палитре. bar$colour, и он отображается в том же порядке, что и исходный коэффициент bar$Genus.

Источник
Другие вопросы по тегам