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包和数据
- 基础画图
- 细节调整
- 组合图形
- 变换数据为需要的格式
安装
代码语言：javascript复制# 2选1
install.packages("ggupset")
devtools::install_github("const-ae/ggupset")
加载R包和数据
首先是加载R包。
代码语言：javascript复制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)
代码语言：javascript复制“使用的数据集还是电影数据，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
除此之外，还有一些细节调整是针对下面的矩阵进行的，比如调整点的颜色和大小、线条、背景等等。
代码语言：javascript复制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
代码语言：javascript复制#> 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
下面是一个和热图组合的例子，首先我们需要一个长数据，对数据进行以下变换，注意这是使用了部分数据，并没有用全部的数据哦：
代码语言：javascript复制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()，用来解决横坐标问题。
这个图，下面还是交集矩阵，上面是一个热图，横坐标代表电影类型，纵坐标表示评分，颜色深浅表示评分百分比。
代码语言：javascript复制# 红线代表每个类型的电影的平均分数
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）的格式。
代码语言：javascript复制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
接下来进行数据变换：
代码语言：javascript复制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
最后一步，就得到了我们需要的格式！
代码语言：javascript复制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
然后就可以愉快的画图了。
代码语言：javascript复制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.生物信息学学习资料和自己的学习笔记！
