使用 ggplot2 的多个依赖级别 sunburst/doughnut 图表

Multiple, dependent-level sunburst/doughnut chart using ggplot2

我正在尝试创建一个双层 sunburst/doughnut 图(用于打印),其中第二层是第一层的详细视图。我已经阅读并理解 this tutorial,但我是 R 和 ggplot2 新手,在生成第二级时遇到问题。上述文章中的根级只有一个元素(有点多余),而我的根级有很多元素;其中,二级最少1个,最多10个。

假设我的数据有三列:nametypevalue;其中 nametype 分别定义根元素和二级元素。每个 name 恰好有 all 中的一个 type,这是 value 跨越 type 的总和(其中,至少有一个和, 在 names 中 type 的集合可能相交或互斥)。例如:

name  type    value
----- ------- ------
foo   all     444
foo   type1   123
foo   type2   321
bar   all     111
bar   type3   111
baz   all     999
baz   type1   456
baz   type3   543

我可以使用以下方法创建根级堆栈(在转换为极坐标之前):

data.all <- data[data$type == "all",]
ggplot(data.all, aes(x=1, y=data.all$value, fill=data.all$name)) + geom_bar(stat="identity")

二级堆栈需要的是 type 值在 name 值内对齐,与它们的值成比例:[​​=37=]

 +-----+  +-------+
 |     |  | type3 |
 | baz |  +-------+
 |     |  | type1 |
 +-----+  +-------+
 |     |  |       |
 | bar |  | type3 |
 |     |  |       |
 +-----+  +-------+
 |     |  | type2 |
 | foo |  +-------+
 |     |  | type1 |
-+-----+--+-------+-

(n.b., 这显然不是按比例的!)

我还需要 type 值的颜色一致(例如,type1 块的颜色对于 foobaz 应该相同,等等)

我想我可以通过将 nametype 列合并到一个新列中然后按此着色来做到这一点:

data.other <- data[data$type != "other",]
data.other$comb <- paste(data.other$name, data.other$type, sep=":")
ggplot(data.other, aes(x=2, y=data.other$value, fill=data.other$comb)) + geom_bar(stat="identity")

然而,这破坏了着色的一致性——显然,事后看来——而且,有趣的是,我完全不相信对齐是正确的。

我的 R/ggplot2 诞生可能很明显(抱歉!);我怎样才能实现我正在寻找的东西?


编辑 我也遇到了 this question and answer,但是我的数据看起来与他们的不同。如果我的数据可以被加工成相同的形状——我不知道该怎么做——那么我的问题就变成了他们的一个特例。

根据您推荐的网页,尝试以下操作:

library(ggplot2) 
library(dplyr) 
library(scales) 

toRead <- "name  type    value
foo   all     444
foo   type1   123
foo   type2   321
bar   all     111
bar   type3   111
baz   all     999
baz   type1   456
baz   type3   543"

data <- read.table(textConnection(toRead), header = TRUE)
closeAllConnections()



sum_total_value = sum(data$value)

firstLevel = data %>% summarize(total_value=sum(value))

sunburst_0 = ggplot(firstLevel) # Just a foundation
sunburst_1 = 
  sunburst_0 + 
  geom_bar(data=firstLevel, aes(x=1, y=total_value), fill='darkgrey', stat='identity') +
  geom_text(aes(x=1, y=sum_total_value/2, label=paste('Sum of all VALUE had', comma(total_value))), color='white')

sunburst_1
sunburst_1 + coord_polar('y')


sum_val = data %>% group_by(type) %>%
  summarize(total_value=sum(value)) %>%
  arrange(desc(total_value))


sunburst_2 <- sunburst_1 +
  geom_bar(data=sum_val,
           aes(x=2, y=total_value, fill=total_value),
           color='white', position='stack', stat='identity', size=0.6) + 
  geom_text(data=sum_val, aes(label=paste(type, total_value), x=2, y=total_value), position='stack')

sunburst_2

这给出了以下情节:

如果你想在极坐标上使用这个,你可以添加以下内容:

sunburst_2 + coord_polar('y')

这给你:

这可能只是完成了一部分,并且可能无法很好地扩展到更复杂的数据集。我对如何做到这一点非常好奇,并且有一个类似的更大的数据集,我正在尝试可视化工作,所以这实际上也帮助了我的工作:)

基本上我所做的是将数据集分成三个级别的数据框:一个父级别,基本上是虚拟数据,一个级别 1 df,每个名称下的所有类型的总和(我想我可以过滤你的数据对于 type == "all"——我的工作数据没有类似的列),2 级是所有外部节点。把它们都绑定在一起,做一个堆叠条形图,给它极坐标。

我为工作做的那个有更多的标签,而且它们很长,所以我用 ggrepel::geom_text_repel 作为标签。它们很快变得又笨又丑。

显然这里的美学有待改进,但我认为可以根据您的喜好对其进行美化。

library(tidyverse)

df <- "name  type    value
foo   all     444
foo   type1   123
foo   type2   321
bar   all     111
bar   type3   111
baz   all     999
baz   type1   456
baz   type3   543" %>% read_table2() %>%
    filter(type != "all") %>%
    mutate(name = as.factor(name) %>% fct_reorder(value, sum)) %>%
    arrange(name, value) %>%
    mutate(type = as.factor(type) %>% fct_reorder2(name, value))

lvl0 <- tibble(name = "Parent", value = 0, level = 0, fill = NA)

lvl1 <- df %>%
    group_by(name) %>%
    summarise(value = sum(value)) %>%
    ungroup() %>%
    mutate(level = 1) %>%
    mutate(fill = name)

lvl2 <- df %>%
    select(name = type, value, fill = name) %>%
    mutate(level = 2)


bind_rows(lvl0, lvl1, lvl2) %>%
    mutate(name = as.factor(name) %>% fct_reorder2(fill, value)) %>%
    arrange(fill, name) %>%
    mutate(level = as.factor(level)) %>%
    ggplot(aes(x = level, y = value, fill = fill, alpha = level)) +
        geom_col(width = 1, color = "gray90", size = 0.25, position = position_stack()) +
        geom_text(aes(label = name), size = 2.5, position = position_stack(vjust = 0.5)) +
        coord_polar(theta = "y") +
        scale_alpha_manual(values = c("0" = 0, "1" = 1, "2" = 0.7), guide = F) +
        scale_x_discrete(breaks = NULL) +
        scale_y_continuous(breaks = NULL) +
        scale_fill_brewer(palette = "Dark2", na.translate = F) +
        labs(x = NULL, y = NULL) +
        theme_minimal()

reprex package (v0.2.0) 创建于 2018-04-24。

可以使用 ggsunburst 来完成(正如 camille 所建议的)。 ggsunburst 读取 newick 和 csv(或任何分隔符分隔的)文件。 您需要安装最新版本 0.0.9 才能运行此示例

# first row with header is mandatory
# remove lines with type "all" from your data
# add colour as additional column
df <- read.table(header=T, text =
"parent node  size  colour
foo   type1   123 type1
foo   type2   321 type2
bar   type3   111 type3
baz   type1   456 type1
baz   type3   543 type3")

# write data.frame into csv file
write.table(df, file = 'df.csv', row.names = F, sep = ",")

# install ggsunburst 0.0.9
if (!require("ggplot2")) install.packages("ggplot2")
if (!require("rPython")) install.packages("rPython")
install.packages("http://genome.crg.es/~didac/ggsunburst/ggsunburst_0.0.9.tar.gz", repos=NULL, type="source")


library(ggsunburst)

sb <- sunburst_data('df.csv', type = "node_parent", sep = ',', node_attributes = 'colour')
sunburst(sb, rects.fill.aes = "colour", node_labels = T, node_labels.min = 25)

see your sunburst here

我一直在寻找一种使用 ggplot 绘制此类图的方法。 @camille 的回答真的很有帮助!我最终使用 this answer here too 为这个问题创建了一个稍微修改过的答案。

快一年了,但也许其他人仍在寻找此类答案!也许其他答案中提到的其他包更有用,但对于我们这些想留在 ggplot 中的人来说,希望这能有所帮助。

我认为我可以按照 OP 的要求进行操作(始终如一地为第二层着色),尽管我不确定这是最佳方式。

我没有使用 geom_col,而是使用了 geom_rect。这给了我们更大的灵活性,也让我们更好地控制每个矩形的绘制位置(堆叠条形图总是有顺序条形图堆叠的问题)。此外,奇怪的是,在极坐标中 geom_col 最终绘制了从 0 到 x 的所有饼图。所以@camille 不得不尝试使用填充物的透明度来获得想要的结果。在 geom_rect 中,我们可以设置 xminxmax 以获得我们想要的确切形状。

但是我们需要进行一些数据处理以使数据帧保持形状。

此外,我要制作的情节有一些第二层是空的。所以我稍微更改了数据集以包含一个额外的第一级 class 而没有第二级 class.

这是我的解决方案:

library(tidyverse)
library(ggplot2)
library(RColorBrewer)

df <- "name  type    value
foo   all     444
foo   type1   123
foo   type2   321
bar   all     111
bar   type3   111
baz   all     999
baz   type1   456
baz   type3   543
boz   -       222" %>% read_table2() %>% filter(type != 'all') %>% 
mutate(type=ifelse(type=='-', NA, type)) %>% arrange(name, value)

# here I create the columns xmin, xmax, ymin, ymax using cumsum function
# (be VERY careful with ordering of rows!)

# I also created a column 'colour' which I map to the asthetic 'colour' (colour of line of each rectangle)
# it is a boolean saying if a line should or should not be drawn.
# for empty second levels i want to draw an empty space (no fill and no line)

# define a padding space between the levels of the pie chart 
padding <- 0.05

# create df for level 0
lvl0 <- tibble(name = "Parent", value = 0, level = 0, fill = NA) %>%
  mutate(xmin=0, xmax=1, ymin=0, ymax=value) %>%
  mutate(x.avg=0, y.avg=0, colour=FALSE)

print(lvl0)

# create df for level 1
lvl1 <- df %>%
  group_by(name) %>%
  summarise(value = sum(value)) %>%
  ungroup() %>%
  mutate(level = 1) %>%
  mutate(fill = name) %>%
  mutate(xmin=1+padding, xmax=2, ymin=0, ymax=cumsum(value)) %>%
  mutate(ymin=lag(ymax, default=0),
         x.avg=(xmin+xmax)/2,
         y.avg=(ymin+ymax)/2,
         colour=TRUE)

print(lvl1)

# create df for level 2
lvl2 <- df %>%
  select(name = type, value, fill = name) %>%
  mutate(level = 2) %>%
  mutate(fill=paste0(fill, '_', name)) %>%
  mutate(xmin=2+padding, xmax=3, ymin=0, ymax=cumsum(value)) %>%
  mutate(ymin=lag(ymax, default=0),
         x.avg=(xmin+xmax)/2,
         y.avg=(ymin+ymax)/2,
         colour=ifelse(grepl('_NA', fill), FALSE, TRUE))

print(lvl2)

# this is my dirty workaround for defining the colours of levels 1 one 2 independently. Probably not the best way and 
# maybe it will not scale very well... But for this small data set it seemed to work...

# number of classes in each level (don't include NA)
n.classes.1 <- 4
n.classes.2 <- 3
n.classes.total <- n.classes.1 + n.classes.2

# get colour pallete for level 1
col.lvl1 <- brewer.pal(n.classes.total,"Dark2")[1:n.classes.1]
names(col.lvl1) <- as.character(unique(lvl1$name))

# get colour pallete for level 2 (don't include NA)
col.lvl2 <- brewer.pal(n.classes.total,"Dark2")[(n.classes.1+1):n.classes.total]
names(col.lvl2) <- as.character(unique(lvl2$name)[!is.na(unique(lvl2$name))])

# compile complete color pallete
fill.pallete <- c(col.lvl1)

for (l1 in as.character(unique(lvl1$name))) {
  for (l2 in as.character(unique(lvl2$name))) {
    if (!is.na(l2)) {
        name.type <- paste0(l1, '_', l2)
        aux <- col.lvl2[l2]
        names(aux) <- name.type
        fill.pallete <- c(fill.pallete, aux)        
    } else {
        # if level2 is NA, then assign transparent colour
        name.type <- paste0(l1, '_NA')
        aux <- NA
        names(aux) <- name.type
        fill.pallete <- c(fill.pallete, aux)        
    }
  }
}
print(fill.pallete)


# put all data frames together for ggplot

df.total <- bind_rows(lvl0, lvl1, lvl2) %>%
  mutate(name = as.factor(name) %>% fct_reorder2(fill, value)) %>%
  arrange(fill, name) %>%
  mutate(level = as.factor(level))

print(df.total)

# create plot (it helped me to look at the rectangular coordinates first before changing to polar!)

g <- ggplot(data=df.total, aes(fill = fill)) +
  geom_rect(aes(ymax=ymax, ymin=ymin, xmax=xmax, xmin=xmin, colour=colour), size = 0.1) +
  scale_fill_manual(values = fill.pallete, , guide = F, na.translate = FALSE) +
  scale_color_manual(values = c('TRUE'='gray20', 'FALSE'='#FFFFFF00'), 
                     guide = F, na.translate = FALSE) +
  geom_text(aes(x = x.avg, y = y.avg, label = name), size = rel(2.5)) +
  scale_x_discrete(breaks = NULL) +
  scale_y_continuous(breaks = NULL) +
  labs(x = NULL, y = NULL) +
  theme_minimal() +
  theme(panel.grid=element_blank()) + 
  coord_polar(theta = "y", start = 0, direction = -1)

print(g)

This is the resulting plot.