简体   繁体   English

基于颜色和形状的嵌套图例

[英]Nested legend based on colour and shape

I want to make an xy plot of nested groups (Group and Subgroup) where points are colored by Group and have shape by Subgroup.我想制作嵌套组(组和子组)的 xy 图,其中点按组着色并按子组具有形状。 A minimal example is below:一个最小的例子如下:

DATA<-data.frame(
  Group=c(rep("group1",10),rep("group2",10),rep("group3",10) ),
  Subgroup = c(rep(c("1.1","1.2"),5), rep(c("2.1","2.2"),5), rep(c("3.1","3.2"),5)),
  x=c(rnorm(10, mean=5),rnorm(10, mean=10),rnorm(10, mean=15)),
  y=c(rnorm(10, mean=3),rnorm(10, mean=4),rnorm(10, mean=5))
)
ggplot(DATA, aes(x=x, y=y,colour=Group, shape=Subgroup) ) +
  geom_point(size=3) 

One option to achieve your desired result would be via the ggnewscale package which allows for multiple scales and legends for the same aesthetic.实现您想要的结果的一种选择是通过ggnewscale包,它允许多个比例和图例以实现相同的美感。

To this end we have to为此我们必须

  1. split the data by GROUP and plot each GROUP via a separate geom_point layer.GROUP拆分数据并通过单独的geom_point图层绘制每个GROUP
  2. Additionally each GROUP gets a separate shape scale and legend which via achieve via ggnewscale::new_scale .此外,每个GROUP都有一个单独的形状比例和图例,通过ggnewscale::new_scale实现。
  3. Instead of making use of the color aesthetic we set the color for each group as an argument for which I make use of a named vector of colors我们没有使用color美学,而是将每个组的颜色设置为一个参数,为此我使用了一个命名的颜色向量
  4. Instead of copying and pasting the code for each group I make use of purrr::imap to loop over the splitted dataset and add the layers dynamically.我没有复制和粘贴每个组的代码,而是使用purrr::imap循环分割的数据集并动态添加图层。

One more note: In general the order of legends is by default set via a "magic algorithm".还有一点需要注意:一般来说,图例的顺序是通过“魔法算法”默认设置的。 To get the groups in the right order we have to explicitly set the order via guide_legend .要以正确的顺序获取组,我们必须通过guide_legend显式设置顺序。

library(ggplot2)
library(ggnewscale)
library(dplyr)
library(purrr)
library(tibble)

DATA_split <- split(DATA, DATA$Group)

# Vector of colors and shapes
colors <- setNames(scales::hue_pal()(length(DATA_split)), names(DATA_split))
shapes <- setNames(scales::shape_pal()(length(unique(DATA$Shape))), unique(DATA$Shape))

ggplot(mapping = aes(x = x, y = y)) +
  purrr::imap(DATA_split, function(x, y) {
    # Get Labels
    labels <- x[c("Shape", "Subgroup")] %>% 
      distinct(Shape, Subgroup) %>% 
      deframe()
    # Get order
    order <- as.numeric(gsub("^.*?(\\d+)$", "\\1", y))
    list(
      geom_point(data = x, aes(shape = Shape), color = colors[[y]], size = 3),
      scale_shape_manual(values = shapes, labels = labels, name = y, guide = guide_legend(order = order)),
      new_scale("shape")
    )
  })

DATA数据

set.seed(123)

DATA <- data.frame(
  Group = c(rep("group1", 10), rep("group2", 10), rep("group3", 10)),
  Subgroup = c(rep(c("1.1", "1.2"), 5), rep(c("2.1", "2.2"), 5), rep(c("3.1", "3.2"), 5)),
  Shape = as.character(c(rep(c(1, 2), 15))),
  x = c(rnorm(10, mean = 5), rnorm(10, mean = 10), rnorm(10, mean = 15)),
  y = c(rnorm(10, mean = 3), rnorm(10, mean = 4), rnorm(10, mean = 5))
)

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM