3

I am trying to get the same customized colour scale for a faceted waffle chart in R, using package waffle from https://github.com/hrbrmstr/waffle and ggplot2::facet_wrap.

Below a reproducible example:

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))

The colour palette looks like this:

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

enter image description here

Note that both the order of the values and the levels are the same in both datasets:

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

I now join the two datasets together:

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

Then I plot this using waffle:

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))

enter image description here

However, the colours don't correspond to the assigned fill (Genus). For instance, the first 4 entries of the legend as plotted (Adscita, Lasiommata, Aglais, Polyommatus) should be shades of blue, not green. Additionally, some levels of Genus have been dropped altogether, like Cheilosia, Bombus and Didea. This behaviour persists using other geoms or removing the facet.

The desired result is to have each unique value of the Genus variable of the same colour across the two facets, as assigned in the custom palette in bar and visualized in the barplot above.

markus
  • 25,843
  • 5
  • 39
  • 58
Luca
  • 65
  • 5
  • Hi, I am in fact using the github package from: https://github.com/hrbrmstr/waffle, I shall edit the question to make it more clear. The package takes special aesthetics in place of usual x and y specifications – Luca Mar 06 '20 at 16:24
  • Just to add to this, the same undesired behaviour appears also in a more usual ggplot call: `ggplot(foobar, aes(x = Genus, fill = Genus, y = n)) + geom_col() + facet_wrap(.~Ploidy, ncol = 1, strip.position = "bottom") + scale_fill_manual(values = foobar$colour, name = NULL)` – Luca Mar 06 '20 at 16:27
  • I just tried this: `ggplot(foobar, aes(x = Genus, fill = colour, y = log(n))) + geom_col() + facet_wrap(.~Ploidy, ncol = 1, strip.position = "bottom") + # scale_fill_manual(values = foobar$colour, name = NULL) scale_fill_identity() + theme(axis.text.x = element_text(angle = 90))` https://imgur.com/a/Fl3Om9x It does seem to solve the ordering problem, but this method is not applicable to the waffle geom, which is what I'm trying to achieve. – Luca Mar 06 '20 at 16:37

2 Answers2

1

This what you want? Using scale_fill_identity(drop = FALSE)

generally probably better to just use your variable for aesthetic and then map the colors to it with a named vector in scale_..._manual. I have added the named vector as a label now. drop = FALSE to show unused levels

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() 

Created on 2020-03-06 by the reprex package (v0.3.0)

tjebo
  • 21,977
  • 7
  • 58
  • 94
  • This is really close to the desired result! Is there a way to match the order of the legend labels to the original order of Genus? Like `levels(bar$Genus)` – Luca Mar 06 '20 at 16:53
  • I'd factorise `Genus` and reorder the levels based on the count. – tjebo Mar 06 '20 at 16:54
  • Apologies, perhaps I haven't been clear: I would like both the data in the plot and the legend to be displayed in the same order as `bar$Genus`, as provided in the initial example. It doesn't look like the data is sorted by count in the plot, and in any case that's not desired. I've tried to supply manual `breaks` to `scale_fill_identity` but it doesn't produce a legend anymore. – Luca Mar 06 '20 at 17:04
  • 1
    Sorry, I found the mistake I was making. Setting the call to `scale_fill_identity(guide = 'legend', labels = a, breaks = bar$colour, drop = FALSE)` did the trick. Many thanks for the help Tjebo! – Luca Mar 06 '20 at 17:13
1

Thanks to Tjebo, I was able to solve the problem. Posting here the result for posterity:

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))

enter image description here

Now the legend correctly corresponds to the custom palette bar$colour, and it's displayed in the same order as the original factor bar$Genus.

Luca
  • 65
  • 5