Search code examples
rggplot2waffle-chart

Manual colour scale in faceted ggplot waffle chart


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.


Solution

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