查看: 884|回复: 41

[R语言] 画了一个upSet/韦恩图,却不会提取里面的交集元素?

  [复制链接]
回帖奖励 6 奥币 回复本帖可获得 3 奥币奖励! 每人限 1 次(中奖概率 50%)

迅猛龙

Rank: 8Rank: 8

主题
31
注册时间
2016.1.8
在线时间
611 小时

发表于 2022.5.31 17:31:05 | 显示全部楼层 |阅读模式
本帖最后由 platove 于 2022.5.31 17:47 编辑

> 介绍下如何提取多个集合间的交集元素。

## 巧用 Vennerable 包提取集合间的交集

```
BiocManager::install("RBGL") # 安装依赖
install.packages("Vennerable", repos="http://R-Forge.R-project.org")
library(Vennerable) # 加载R包
```

```
data(StemCell) # 使用内置数据集
str(StemCell) # 该数据集一共4个列表
List of 4
$ OCT4 : chr [1:623] "AASDH" "ABTB2" "ACCN4" "ACD" ...
$ SOX2 : chr [1:1279] "182-FIP" "AASDH" "ABCA5" "ABCB10" ...
$ NANOG: chr [1:1687] "13CDNA73" "AASDH" "ABCA5" "ABCB10" ...
$ E2F4 : chr [1:1273] "76P" "7h3" "AAMP" "AATF" ...
```

```
p <- Venn(StemCell) # 4个列表取交集
# 提取其中3个列表的交集
p2 <- p[, c("OCT4", "SOX2", "NANOG")]
plot(p2, doWeights = TRUE) # 画图展示

# png("venny.png",width=8*300,height=8*300,res=300)
# plot(p2, doWeights = TRUE)
# dev.off()
```



```
# 如上图所示,p2中3个列表共有的元素为353个
> length(p2@IntersectionSets$`111`)
[1] 353

# 看看p2里面到底都有啥
> str(p2)
Formal class 'Venn' [package "Vennerable"] with 2 slots
  ..@ IndicatorWeight : num [1:8, 1:4] 0 1 0 1 0 1 0 1 0 0 ...
  .. ..- attr(*, "dimnames")=List of 2
  .. .. ..$ : NULL
  .. .. ..$ : chr [1:4] "OCT4" "SOX2" "NANOG" ".Weight"
  ..@ IntersectionSets:List of 8
  .. ..$ 000: chr [1:821] "76P" "7h3" "AAMP" "AATF" ...
  .. ..$ 001: chr [1:762] "13CDNA73" "ABCG2" "ABHD2" "ACADM" ...
  .. ..$ 010: chr [1:383] "182-FIP" "ABLIM1" "ACIN1" "ACOX1" ...
  .. ..$ 011: chr [1:492] "ABCA5" "ABCB10" "ABCB7" "ABHD11" ...
  .. ..$ 100: chr [1:139] "ADRA2A" "ALOXE3" "ARMCX5" "ARPC5" ...
  .. ..$ 101: chr [1:80] "ALKBH" "AMIGO2" "ASCL2" "BC010732" ...
  .. ..$ 110: chr [1:51] "ABTB2" "ANKHD1" "AUH" "C1QA" ...
  .. ..$ 111: chr [1:353] "AASDH" "ACCN4" "ADAMTS16" "ADAMTSL1" ...

# 提取p2中3个列表共有的元素
# 1代表存在,0代表不存在
# 111代表在3个列表都存在的元素
# 列表的前后顺序可用str(p2)查看
# 这里的111对应"OCT4" "SOX2" "NANOG"共有的元素
> p2@IntersectionSets$`111`
[1] "AASDH"           "ACCN4"           "ADAMTS16"        "ADAMTSL1"
[5] "ADD3"            "ADRA1A"          "ANKRD1"          "ANKRD15"
[9] "APOBEC3G"        "ARID1B"          "ARSD"            "ATBF1"
[13] "ATP6V1G1"        "BAMBI"           "BC020923"        "BC026345"
[17] "BC061909"        "BC069363"        "BDH"             "BHLHB5"
[21] "BMP7"            "C12orf2"         "C15orf29"        "C6orf111"
[25] "C7orf16"         "C7orf33"         "C9orf74"         "CA2"
[29] "CA4"             "CABLES1"         "CACNA2D1"        "CAPZA2"
[33] "CCL2"            "CD82"            "CD99L2"          "CDYL"
[37] "CEI"             "CHRNA1"          "COL12A1"         "COMMD3"
[41] "COMMD7"          "CPS1"            "CPT1A"           "CSAD"

# 大伙可以试试其他交集元素的提取
# p2@IntersectionSets$`110`
# p2@IntersectionSets$`100`
# p2@IntersectionSets$`001`
```

## 自写函数提取集合间的交集元素

```
# 自定义函数1
fromList <- function (input) {
  elements <- unique(unlist(input))
  data <- unlist(lapply(input, function(x) {
      x <- as.vector(match(elements, x))
      }))
  data[is.na(data)] <- as.integer(0)
  data[data != 0] <- as.integer(1)
  data <- data.frame(matrix(data, ncol = length(input), byrow = F))
  data <- data[which(rowSums(data) != 0), ]
  names(data) <- names(input)
  row.names(data) <- elements
  return(data)
  }

# 自定义函数2
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]])=='numeric'){   #Now uses numeric instead of integer
                ar[] <- paste(item, '>= 1')
                i <- i + 1
            }
        } else {
            if (class(x[[item]])=='numeric'){
                ar[] <- paste(item, '== 0')
                i <- i + 1
            }
        }
    }
    do.call(filter_, ar) %>% column_to_rownames() -> x
    return(x)
}
```

```
# 构造一个含2个集合的列表
> lst <- list(
    a=c("CARD11_0","EZH2_0","HOXD11_0","FGFR1_0","FGFR1_1"),
    b=c("EZH2_0","EZH2_0","HOXD11_0","FGFR1_0","FGFR1_0"))

# 列表转换成数据框
> d <- fromList(lst)

# 格式为0/1矩阵
> d
         a b
CARD11_0 1 0
EZH2_0   1 1
HOXD11_0 1 1
FGFR1_0  1 1
FGFR1_1  1 0
```

```
# a独有元素
> get_intersect_members(d,"a")
         a b
CARD11_0 1 0
FGFR1_1  1 0

# a/b交集元素
> get_intersect_members(d,"a","b")
         a b
EZH2_0   1 1
HOXD11_0 1 1
FGFR1_0  1 1
```

生息益站致力于:生物信息或基因测序数据分析、软件算法、科研绘图、Python/Perl/R代码分享。


更多优质内容请扫码或点击下方名片,关注“生信益站”公众号。










本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有帐号?立即注册

x
新的一天加油!
回复

使用道具 举报

迅猛龙

Rank: 8Rank: 8

主题
31
注册时间
2016.1.8
在线时间
611 小时

 楼主| 发表于 2022.6.2 08:40:07 | 显示全部楼层
回帖有奖励,我试试
新的一天加油!
回复 支持 反对

使用道具 举报

迅猛龙

Rank: 8Rank: 8

主题
31
注册时间
2016.1.8
在线时间
611 小时

 楼主| 发表于 2022.5.31 17:34:24 | 显示全部楼层
新的一天加油!
回复

使用道具 举报

迅猛龙

Rank: 8Rank: 8

主题
31
注册时间
2016.1.8
在线时间
611 小时

 楼主| 发表于 2022.5.31 17:48:37 | 显示全部楼层
新的一天加油!
回复

使用道具 举报

迅猛龙

Rank: 8Rank: 8

主题
31
注册时间
2016.1.8
在线时间
611 小时

 楼主| 发表于 2022.6.1 08:38:25 | 显示全部楼层
本帖最后由 platove 于 2022.6.2 14:48 编辑

新的一天加油!
回复

使用道具 举报

钵水母

Rank: 3Rank: 3

主题
0
注册时间
2018.12.14
在线时间
17 小时

发表于 2022.6.1 10:47:16 | 显示全部楼层
新的一天加油!
回复 支持 反对

使用道具 举报

迅猛龙

Rank: 8Rank: 8

主题
31
注册时间
2016.1.8
在线时间
611 小时

 楼主| 发表于 2022.6.1 11:54:39 | 显示全部楼层
加油
新的一天加油!
回复

使用道具 举报

迅猛龙

Rank: 8Rank: 8

主题
31
注册时间
2016.1.8
在线时间
611 小时

 楼主| 发表于 2022.6.1 14:08:18 | 显示全部楼层
新的一天加油!
回复

使用道具 举报

迅猛龙

Rank: 8Rank: 8

主题
31
注册时间
2016.1.8
在线时间
611 小时

 楼主| 发表于 2022.6.1 15:59:02 | 显示全部楼层
新的一天加油!
回复

使用道具 举报

迅猛龙

Rank: 8Rank: 8

主题
31
注册时间
2016.1.8
在线时间
611 小时

 楼主| 发表于 2022.6.1 19:47:38 | 显示全部楼层
新的一天加油!
回复

使用道具 举报

迅猛龙

Rank: 8Rank: 8

主题
31
注册时间
2016.1.8
在线时间
611 小时

 楼主| 发表于 2022.6.2 14:22:15 | 显示全部楼层
新的一天加油!
回复

使用道具 举报

迅猛龙

Rank: 8Rank: 8

主题
3
注册时间
2021.6.22
在线时间
54 小时

发表于 2022.6.2 14:53:23 | 显示全部楼层

回帖奖励 +3 奥币

学习
回复

使用道具 举报

钵水母

Rank: 3Rank: 3

主题
0
注册时间
2018.12.14
在线时间
17 小时

发表于 2022.6.2 15:20:40 | 显示全部楼层
学习一下
回复

使用道具 举报

迅猛龙

Rank: 8Rank: 8

主题
31
注册时间
2016.1.8
在线时间
611 小时

 楼主| 发表于 2022.6.2 17:49:33 | 显示全部楼层
新的一天加油!
回复

使用道具 举报

帝王蝶

Rank: 4

主题
0
注册时间
2016.10.5
在线时间
43 小时

发表于 2022.6.3 18:49:15 | 显示全部楼层

回帖奖励 +3 奥币

回复

使用道具 举报

迅猛龙

Rank: 8Rank: 8

主题
3
注册时间
2021.6.22
在线时间
54 小时

发表于 2022.6.3 19:17:19 | 显示全部楼层
学习
回复

使用道具 举报

帝王蝶

Rank: 4

主题
0
注册时间
2016.10.5
在线时间
43 小时

发表于 2022.6.4 18:23:50 | 显示全部楼层
回复

使用道具 举报

迅猛龙

Rank: 8Rank: 8

主题
3
注册时间
2021.6.22
在线时间
54 小时

发表于 2022.6.5 17:27:04 | 显示全部楼层
周五啦!
回复

使用道具 举报

迅猛龙

Rank: 8Rank: 8

主题
31
注册时间
2016.1.8
在线时间
611 小时

 楼主| 发表于 2022.6.6 08:34:21 | 显示全部楼层
新的一天加油!
回复

使用道具 举报

迅猛龙

Rank: 8Rank: 8

主题
31
注册时间
2016.1.8
在线时间
611 小时

 楼主| 发表于 2022.6.6 14:00:28 | 显示全部楼层
新的一天加油!
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

快速回复 返回顶部 返回列表