韦恩图进阶！ggupset版upset plot

医学和生信笔记

发布于 2022-11-14 17:16:56

1.2K0

发布于 2022-11-14 17:16:56

文章被收录于专栏：医学和生信笔记医学和生信笔记

Try to learn everything about something!

书接上回！！！

大型连续剧韦恩图进阶：使用R语言画upset plot，它又来了！！！

前面用2篇推文介绍了如何使用venndiagram和ggvenndiagram画韦恩图，再用5篇推文详细介绍了使用upsetR和complexheatmap画upset plot。

我本来以为这就够了，但是最近又发现了upset plot的ggplot2版本，本着try to learn everything about something的原则，我又学了下这个ggupset包！

安装
加载R包和数据
基础画图
细节调整
组合图形
变换数据为需要的格式

安装

# 2选1
install.packages("ggupset")

devtools::install_github("const-ae/ggupset")

加载R包和数据

首先是加载R包。

library(ggplot2)
library(tidyverse, warn.conflicts = FALSE)
## -- Attaching packages ----------------------------- tidyverse 1.3.1 --
## v tibble  3.1.6     v dplyr   1.0.8
## v tidyr   1.2.0     v stringr 1.4.0
## v readr   2.0.1     v forcats 0.5.1
## v purrr   0.3.4
## -- Conflicts -------------------------------- tidyverse_conflicts() --
## x dplyr::filter() masks stats::filter()
## x dplyr::lag()    masks stats::lag()
library(ggupset)

“使用的数据集还是电影数据，tibble格式，来自IMDB的50000部电影以及它的信息，比如上映时间、时长、评分、类型等。其中有一列（Genres）是列表形式，代表的是电影类型。

tidy_movies
## # A tibble: 50,000 x 10
##    title       year length budget rating votes mpaa  Genres stars percent_rating
##    <chr>      <int>  <int>  <int>  <dbl> <int> <chr> <list> <dbl>          <dbl>
##  1 Ei ist ei~  1993     90   NA      8.4    15 ""    <chr>      1            4.5
##  2 Hamos sto~  1985    109   NA      5.5    14 ""    <chr>      1            4.5
##  3 Mind Bend~  1963     99   NA      6.4    54 ""    <chr>      1            0  
##  4 Trop (peu~  1998    119   NA      4.5    20 ""    <chr>      1           24.5
##  5 Crystania~  1995     85   NA      6.1    25 ""    <chr>      1            0  
##  6 Totale!, ~  1991    102   NA      6.3   210 ""    <chr>      1            4.5
##  7 Visibleme~  1995    100   NA      4.6     7 ""    <chr>      1           24.5
##  8 Pang shen~  1976     85   NA      7.4     8 ""    <chr>      1            0  
##  9 Not as a ~  1955    135    2e6    6.6   223 ""    <chr>      1            4.5
## 10 Autobiogr~  1994     87   NA      7.4     5 ""    <chr>      1            0  
## # ... with 49,990 more rows
glimpse(tidy_movies)
## Rows: 50,000
## Columns: 10
## $ title          <chr> "Ei ist eine geschissene Gottesgabe, Das", "Hamos sto a~
## $ year           <int> 1993, 1985, 1963, 1998, 1995, 1991, 1995, 1976, 1955, 1~
## $ length         <int> 90, 109, 99, 119, 85, 102, 100, 85, 135, 87, 94, 79, 89~
## $ budget         <int> NA, NA, NA, NA, NA, NA, NA, NA, 2000000, NA, NA, NA, NA~
## $ rating         <dbl> 8.4, 5.5, 6.4, 4.5, 6.1, 6.3, 4.6, 7.4, 6.6, 7.4, 5.0, ~
## $ votes          <int> 15, 14, 54, 20, 25, 210, 7, 8, 223, 5, 21, 36, 19, 26, ~
## $ mpaa           <chr> "", "", "", "", "", "", "", "", "", "", "", "", "", "",~
## $ Genres         <list> "Documentary", "Comedy", <>, <>, "Animation", "Comedy"~
## $ stars          <dbl> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1~
## $ percent_rating <dbl> 4.5, 4.5, 0.0, 24.5, 0.0, 4.5, 24.5, 0.0, 4.5, 0.0, 0.0~

我们可以看一下Genres这一列的内容：

head(tidy_movies$Genres)
## [[1]]
## [1] "Documentary"
## 
## [[2]]
## [1] "Comedy"
## 
## [[3]]
## character(0)
## 
## [[4]]
## character(0)
## 
## [[5]]
## [1] "Animation"
## 
## [[6]]
## [1] "Comedy"

可以看到里面记录的是电影类型，有的电影则没有类型。

基础画图

ggupset主要是提供了一个新的函数scale_x_upset()，用来画upset plot。它需要一个列表形式的横坐标。条形的部分是由geom_bar()完成的，理论上其他类型也是支持的哦！

tidy_movies %>%
  distinct(title, year, length, .keep_all=TRUE) %>%
  ggplot(aes(x=Genres)) +
    geom_bar() +
    scale_x_upset(n_intersections = 20) # 显示数量最多的前20个交集

plot of chunk unnamed-chunk-5

从这个图中可以很容易看出，drama类型的电影最多（1200+），然后是不知道是啥类型的电影（1000+），如果你还不知道怎门看这个图，请翻阅我upset plot推文的第一篇~

细节调整

由于这个包是基于ggplot2的，所以很多东西都是支持的，比如加个数量的标签，改变颜色等。

tidy_movies %>%
  distinct(title, year, length, .keep_all=TRUE) %>%
  ggplot(aes(x=Genres)) +
    geom_bar(fill = "skyblue",color = "skyblue") + # 自由调整颜色
    geom_text(stat='count', aes(label=after_stat(count)), vjust=-1) + # 加标签，熟悉的感觉
    scale_x_upset(n_intersections = 20) +
    scale_y_continuous(breaks = NULL, lim = c(0, 1350), name = "")

plot of chunk unnamed-chunk-6

除此之外，还有一些细节调整是针对下面的矩阵进行的，比如调整点的颜色和大小、线条、背景等等。

tidy_movies %>%
  distinct(title, year, length, .keep_all=TRUE) %>%
  ggplot(aes(x=Genres)) +
    geom_bar() +
    scale_x_upset(order_by = "degree") +
    theme_combmatrix(combmatrix.panel.point.color.fill = "tomato",
                     combmatrix.panel.point.color.empty = "grey80",
                     combmatrix.panel.line.size = 0,
                     combmatrix.panel.point.size = 3,
                     combmatrix.label.make_space = FALSE)

plot of chunk unnamed-chunk-7

#> Warning: Removed 1076 rows containing non-finite values (stat_count).

组合图形

组合图形就非常简单了，比upsetR简单强大多了，因为是支持ggplot2的。

tidy_movies %>%
  distinct(title, year, length, .keep_all=TRUE) %>%
  ggplot(aes(x=Genres, y=year)) +
    geom_violin() +
    scale_x_upset(order_by = "freq", n_intersections = 12)+
  theme_bw()

plot of chunk unnamed-chunk-8

下面是一个和热图组合的例子，首先我们需要一个长数据，对数据进行以下变换，注意这是使用了部分数据，并没有用全部的数据哦：

avg_rating <- tidy_movies %>%
  mutate(Genres_collapsed = sapply(Genres, function(x) paste0(sort(x), collapse="-"))) %>%
  mutate(Genres_collapsed = fct_lump(fct_infreq(as.factor(Genres_collapsed)), n=12)) %>%
  group_by(stars, Genres_collapsed) %>%
  summarize(percent_rating = sum(votes * percent_rating)) %>%
  group_by(Genres_collapsed) %>%
  mutate(percent_rating = percent_rating / sum(percent_rating)) %>%
  arrange(Genres_collapsed)
## `summarise()` has grouped output by 'stars'. You can override using
## the `.groups` argument.

avg_rating
## # A tibble: 130 x 3
## # Groups:   Genres_collapsed [13]
##    stars Genres_collapsed percent_rating
##    <dbl> <fct>                     <dbl>
##  1     1 Drama                    0.0437
##  2     2 Drama                    0.0411
##  3     3 Drama                    0.0414
##  4     4 Drama                    0.0433
##  5     5 Drama                    0.0506
##  6     6 Drama                    0.0717
##  7     7 Drama                    0.129 
##  8     8 Drama                    0.175 
##  9     9 Drama                    0.170 
## 10    10 Drama                    0.235 
## # ... with 120 more rows

然后就是画图，热图部分使用的是geom_tile()函数，这个函数非常棒，再之前的文献图表学习中也用到过这个函数哦！详情可见：

作者创造了一个新的函数aixs_combmatrix()，用来解决横坐标问题。

这个图，下面还是交集矩阵，上面是一个热图，横坐标代表电影类型，纵坐标表示评分，颜色深浅表示评分百分比。

# 红线代表每个类型的电影的平均分数
ggplot(avg_rating, aes(x=Genres_collapsed, y=stars, fill=percent_rating)) +
    geom_tile() +
    stat_summary_bin(aes(y=percent_rating * stars), fun = sum,  geom="point", 
                     shape="—", color="red", size=6) +
    axis_combmatrix(sep = "-", levels = c("Drama", "Comedy", "Short", 
                    "Documentary", "Action", "Romance", "Animation", "Other")) +
    scale_fill_viridis_c()

plot of chunk unnamed-chunk-10

变换数据为需要的格式

这个包提供的函数需要特殊的列表格式才行，作者怕你不知道怎么才能从一个普通的数据集变成列表格式的数据集，因此贴心的准备了一个小例子。

原数据是一个0-1矩阵（TRUE-FALSE）的格式。

data("gene_pathway_membership")
gene_pathway_membership[, 1:7]
##                                Aco1  Aco2  Aif1 Alox8   Amh Bmpr1b Cdc25a
## Actin dependent Cell Motility FALSE FALSE FALSE FALSE FALSE  FALSE  FALSE
## Chemokine Secretion            TRUE FALSE  TRUE  TRUE FALSE  FALSE  FALSE
## Citric Acid Cycle              TRUE  TRUE FALSE FALSE FALSE  FALSE  FALSE
## Mammalian Oogenesis           FALSE FALSE FALSE FALSE  TRUE   TRUE  FALSE
## Meiotic Cell Cycle            FALSE FALSE FALSE FALSE FALSE  FALSE   TRUE
## Neuronal Apoptosis            FALSE FALSE FALSE FALSE FALSE  FALSE  FALSE

接下来进行数据变换：

tidy_pathway_member <- gene_pathway_membership %>%
  as_tibble(rownames = "Pathway") %>%
  gather(Gene, Member, -Pathway) %>%
  filter(Member) %>%
  select(- Member)

tidy_pathway_member
## # A tibble: 44 x 2
##    Pathway             Gene  
##    <chr>               <chr> 
##  1 Chemokine Secretion Aco1  
##  2 Citric Acid Cycle   Aco1  
##  3 Citric Acid Cycle   Aco2  
##  4 Chemokine Secretion Aif1  
##  5 Chemokine Secretion Alox8 
##  6 Mammalian Oogenesis Amh   
##  7 Mammalian Oogenesis Bmpr1b
##  8 Meiotic Cell Cycle  Cdc25a
##  9 Meiotic Cell Cycle  Cdc25c
## 10 Chemokine Secretion Chia1 
## # ... with 34 more rows

最后一步，就得到了我们需要的格式！

tidy_pathway_member %>%
  group_by(Gene) %>%
  summarize(Pathways = list(Pathway))
## # A tibble: 37 x 2
##    Gene   Pathways 
##    <chr>  <list>   
##  1 Aco1   <chr [2]>
##  2 Aco2   <chr [1]>
##  3 Aif1   <chr [1]>
##  4 Alox8  <chr [1]>
##  5 Amh    <chr [1]>
##  6 Bmpr1b <chr [1]>
##  7 Cdc25a <chr [1]>
##  8 Cdc25c <chr [1]>
##  9 Chia1  <chr [1]>
## 10 Csf1r  <chr [1]>
## # ... with 27 more rows

然后就可以愉快的画图了。

tidy_pathway_member %>%
  group_by(Gene) %>%
  summarize(Pathways = list(Pathway)) %>%
  ggplot(aes(x = Pathways)) +
    geom_bar() +
    scale_x_upset()

plot of chunk unnamed-chunk-14

OK，这就是画upset plot的第3种方法了，你学会了吗？

以上就是今天的内容，希望对你有帮助哦！欢迎点赞、在看、关注、转发！

欢迎在评论区留言或直接添加我的微信！

完

欢迎关注公众号：医学和生信笔记

“医学和生信笔记 公众号主要分享：1.医学小知识、肛肠科小知识；2.R语言和Python相关的数据分析、可视化、机器学习等；3.生物信息学学习资料和自己的学习笔记！

本文参与腾讯云自媒体同步曝光计划，分享自微信公众号。

原始发表：2022-06-05，如有侵权请联系 cloudcommunity@tencent.com 删除

ggplot2

plot

本文分享自医学和生信笔记微信公众号，前往查看

如有侵权，请联系 cloudcommunity@tencent.com 删除。

本文参与腾讯云自媒体同步曝光计划，欢迎热爱写作的你一起参与！

ggplot2

plot

登录后参与评论

0 条评论

热度