R绘制韦恩图 | Venn图 | UpSetR图

网页版venn图

维恩(Venn)图绘制工具大全（在线+R包）
在线数据可视化系列一：维恩图 - 内含推荐指数

如果对venn图颜值要求较高，强烈推荐venneuler

理由：

面积比例代表数量，信息含量更高
可以直接与ggplot对接，自定义修改

参考代码：human/singleCell/HSCR/2-HSCR_additional_analysis.ipynb

Venn

解决方案有好几种：

网页版，无脑绘图，就是麻烦，没有写代码方便
极简版，gplots::venn
文艺版，venneuler，不好安装rJava，参见Y叔
酷炫版，VennDiagram

特别注意：

目前主流的韦恩图最多只支持5个类别，多了不能使用韦恩图，也不好看。

UpSet某种程度上可以显示多于5个类别，但是结果不是很直观，不推荐，图也很难解读。

library(ComplexHeatmap)
m = make_comb_mat(venn.list)
UpSet(m)

1. 网页版的就不说了，非常简单，直接输入数据就行；

2-30 Venn Diagrams (non-proportional) - 常用的web版
2-6 Venn Diagrams (non-proportional)
http://bioinfogp.cnb.csic.es/tools/venny/index.html
http://genevenn.sourceforge.net/

local

https://github.com/linguoliang/VennPainter
https://sysbio.uni-ulm.de/?Software:VennMaster
http://omics.pnl.gov/software/venn-diagram-plotter

R版的输入都是一种数据结构list，可以单独出来。

2. 极简版

options(repr.plot.width=4, repr.plot.height=5)
vp <- gplots::venn(list(Nup=names(moduleListN_DEG[["up"]]), Ndown=names(moduleListN_DEG[["down"]]),
                 Gup=names(moduleListG_DEG[["up"]]), Gdown=names(moduleListG_DEG[["down"]])))

R绘制韦恩图 | Venn图 | UpSetR图

3. 还没成功过，需安装rJava，代码如下：

set.seed(2017-11-08)
x <- matrix(sample(0:4, 40, TRUE, c(.5, .1, .1, .1, .1)), ncol=4)
colnames(x) <- LETTERS[1:4]
yyplot::ggvenn(x)

4. VennDiagram，只能保存图为文件（三种可选：tiff, png or svg），非常实用和美观，但是不能做下游美化。

library(VennDiagram)
venn.diagram(list(Nup=names(moduleListN_DEG[["up"]]), Ndown=names(moduleListN_DEG[["down"]]),
                 Gup=names(moduleListG_DEG[["up"]]), Gdown=names(moduleListG_DEG[["down"]])), 
             fill=c("red","green","blue","yellow"), alpha=c(0.5,0.5,0.5,0.5), 
             imagetype = "tiff", category.names = rep("", 4),
             height = 600, width = 600, resolution = 100,
             cex=2, cat.fontface=4, filename="VennDiagram.tiff")

参考：

R作图在R中绘制韦恩图的几种方法和一些漂亮的venn图

ggplot2版本的维恩图 - Y叔公众号

UpSetR

超过4个类别以上就不推荐使用韦恩图了，非常不直观，此时可以用UpSetR图替代。

https://github.com/hms-dbmi/UpSetR

UpSet: Visualizing Intersecting Sets

教程：

转UpSet图为ggplot?

一图告诉你venn plot和upset plot的关系

UpSetR的输入数据比较奇特，不是list格式的数据，而是0、1格式的data.frame

第一列是Name（全集）；后面每一列都是一个set，如果set里的数据在全集里，那么就是1，不在则是0；

以下是准备输入输入数据的代码：

all.genes <- unique(c(HSCR_5c3.DEG, HSCR_10c2.DEG, HSCR_20c7.DEG, HSCR_23c9.DEG, HSCR_1c11.DEG, HSCR_17c8.DEG))
length(all.genes)

DEG.UpSetR.df <- data.frame(Name=all.genes, `HSCR#5`=as.integer(all.genes %in% HSCR_5c3.DEG),
                                           `HSCR#10`=as.integer(all.genes %in% HSCR_10c2.DEG),
                                           `HSCR#20`=as.integer(all.genes %in% HSCR_20c7.DEG),
                                           `HSCR#23`=as.integer(all.genes %in% HSCR_23c9.DEG),
                                           `HSCR#1`=as.integer(all.genes %in% HSCR_1c11.DEG),
                                           `HSCR#17`=as.integer(all.genes %in% HSCR_17c8.DEG)
                           )

Y叔的经典代码：

require(UpSetR)
movies <- read.csv( system.file("extdata", "movies.csv", package = "UpSetR"), header=T, sep=";" )
p1 <- upset(movies)

# head(movies)

# p1

require(ggplotify)
g1 <- as.ggplot(p1)

library(yyplot)

require(yyplot)
g2 <- ggvenn(movies[, c(3,6,9,15,17)])

require(ggimage)
g3 <- g1 + geom_subview(subview = g2 + theme_void(), x=.7, y=.7, w=.6, h=.6)

# g3

我的代码

问题：

1. 无法精准控制set的order；

2. 无法在列名里保留#号；

require(UpSetR)
p1 <- upset(DEG.UpSetR.df, nsets = 6, text.scale = 2, keep.order = T, 
            sets = rev(c("HSCR.5", "HSCR.10", "HSCR.20", "HSCR.1", "HSCR.17", "HSCR.23")),
            intersections = list(list("HSCR.5", "HSCR.10", "HSCR.20"),
                                 list("HSCR.5", "HSCR.10", "HSCR.20", "HSCR.1"),
                                 list("HSCR.23", "HSCR.17"),
                                 list("HSCR.23", "HSCR.1", "HSCR.17"),
                                 list("HSCR.5", "HSCR.10", "HSCR.20", "HSCR.23", "HSCR.1", "HSCR.17")
                                 ))

require(ggplotify)
g1 <- as.ggplot(p1)

拆解ggvenn函数，精准控制order和color

y <- venneuler(DEG.UpSetR.df[, 2:7])
d <- data.frame(y$centers, diameters = y$diameters, labels = y$labels, 
    stringsAsFactors = FALSE)

d$labels <- plyr::mapvalues(d$labels, from = c("HSCR.5", "HSCR.10", "HSCR.20", "HSCR.23", "HSCR.1", "HSCR.17"),
                          to = c("HSCR#5", "HSCR#10", "HSCR#20", "HSCR#23", "HSCR#1", "HSCR#17"))

d$labels <- factor(d$labels, levels = c("HSCR#5", "HSCR#10", "HSCR#20", "HSCR#1", "HSCR#17", "HSCR#23"))

geom_circle <- rvcheck::get_fun_from_pkg("yyplot", "geom_circle")

require(yyplot)
require(ggplot2)
# require(ggforce)
g2 <- ggplot(d) + geom_circle(aes_(x0 = ~x, y0 = ~y, r = ~diameters/2, fill = ~labels, color = ~labels), size=1.5) + 
        # geom_text(aes_(x = ~x, y = ~y, label = ~labels)) + 
        coord_fixed() + 
        theme_void() +
        scale_color_manual(values = sample.colors) +
        scale_fill_manual(values = alpha(sample.colors, .2))
g2

组合

options(repr.plot.width=10, repr.plot.height=7)
cowplot::plot_grid(g1,g2,ncol = 2)

取出交集函数，https://github.com/hms-dbmi/UpSetR/issues/85

get_intersect_members <- function (x, ...){
  require(dplyr)
  require(tibble)
  x <- x[,sapply(x, is.numeric)][,0<=colMeans(x[,sapply(x, is.numeric)],na.rm=T) & colMeans(x[,sapply(x, is.numeric)],na.rm=T)<=1]
  n <- names(x)
  x %>% rownames_to_column() -> x
  l <- c(...)
  a <- intersect(names(x), l)
  ar <- vector('list',length(n)+1)
  ar[[1]] <- x
  i=2
  for (item in n) {
    if (item %in% a){
      if (class(x[[item]])=='integer'){
        ar[[i]] <- paste(item, '>= 1')
        i <- i + 1
      }
    } else {
      if (class(x[[item]])=='integer'){
        ar[[i]] <- paste(item, '== 0')
        i <- i + 1
      }
    }
  }
  do.call(filter_, ar) %>% column_to_rownames() -> x
  return(rownames(x))
}