CODEWITHSUNDEEP
rggplot2waffle-chart
Luca
Luca

Reputation: 65

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.

Upvotes: 3

Views: 1040

Answers (2)

Luca
Luca

Reputation: 65

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.

Upvotes: 1

tjebo
tjebo

Reputation: 23747

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)

Upvotes: 1

Related Questions