多面ggplot华夫饼图中的手动色标

时间:2020-03-06 14:22:01

标签: r ggplot2 waffle-chart

我正在尝试使用https://github.com/hrbrmstr/wafflewaffle中的软件包ggplot2::facet_wrap为R中的多面华夫饼图获得相同的自定义色标。

下面是可复制的示例:

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)

enter image description here

请注意,两个数据集中值的顺序和级别都相同:

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

enter image description here

但是,颜色与分配的填充(Genus)不对应。 例如,绘制的图例的前4个条目(Adscita,Lasiommata,Aglais,Polyommatus)应为蓝色而不是绿色。此外,Genus的某些级别已被完全删除,例如Cheilosia,Bombus和Didea。使用其他几何图形或除去构面后,此行为仍然存在。

理想的结果是在两个方面都具有相同颜色的Genus变量的每个唯一值,如在bar中的自定义调色板中分配并在上面的小节中可视化。

2 个答案:

答案 0 :(得分:1)

这是你想要的吗?使用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() 

reprex package(v0.3.0)于2020-03-06创建

答案 1 :(得分:1)

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

enter image description here

现在,图例正确对应于自定义调色板bar$colour,并且以与原始因子bar$Genus相同的顺序显示。

相关问题