R语言 获取维恩图中的项目列表

63lcw9qa  于 2023-05-20  发布在  其他
关注(0)|答案(4)|浏览(122)

使用以下代码可以很容易地绘制维恩图:

library(VennDiagram)

set.seed(1) # For reproducibility of results
xx.1 <- list(A = sample(LETTERS, 15), B = sample(LETTERS, 15), 
             C = sample(LETTERS, 15), D = sample(LETTERS, 15))

venn.diagram(xx.1, filename ="1.tiff", height = 1000, width = 1000)

但是我如何计算每个字段中的项目?例如,我想知道在A中只有的两个字母是什么?

编辑

这是我的解决方案,它不是完美的,但可以给予所有的交集。

library(reshape)
library(R.utils)

## data
A <- data.frame(names = sample(LETTERS, 15), A = 1)
B <- data.frame(names = sample(LETTERS, 15), B = 1)
C <- data.frame(names = sample(LETTERS, 15), C = 1)
D <- data.frame(names = sample(LETTERS, 15), D = 1)

## a merged data frame.
xx.1 <- list(A = A, B= B, C= C, D = D)
xx.2 <- merge_recurse(xx.1)

## function
ff.vennFourItems <- function(X)
{
    ## get the items from venn diagram; for four sets, there are 15 fields;

    vennItems <- list()
    cate.n <- names(X)[2:5]

    for (i in 1:15)
    {
        xx.b <- intToBin(i)
        ## make it four bits;
        if (nchar(xx.b) != 4)
        {
            xx.b <- paste(paste(rep("0", 4 - nchar(xx.b)), collapse = ""), xx.b, sep ="") 
        }

        xx.b.1 <- unlist(strsplit(xx.b, ""))

        xx.1 <- X

        if(xx.b.1[1] == "0") { xx.1 <- xx.1[is.na(xx.1[, 2]), ] }
        else { xx.1 <-  xx.1[!is.na(xx.1[, 2]), ] }

        if(xx.b.1[2] == "0") { xx.1 <- xx.1[is.na(xx.1[, 3]), ] }
        else { xx.1 <-  xx.1[!is.na(xx.1[, 3]), ] }

        if(xx.b.1[3] == "0") { xx.1 <- xx.1[is.na(xx.1[, 4]), ] }
        else { xx.1 <-  xx.1[!is.na(xx.1[, 4]), ] }

        if(xx.b.1[4] == "0") { xx.1 <- xx.1[is.na(xx.1[, 5]), ] }
        else { xx.1 <-  xx.1[!is.na(xx.1[, 5]), ] }

        chipC <-  paste(paste(cate.n, collapse = "#"), xx.b, sep = "***")

        if (dim(xx.1)[1] == 0) 
        {
            xx.2 <- list(genes = dim(xx.1)[1], chipC = chipC, chipCN = i, detailChipS = xx.1, shortL = data.frame(genes = "noInteraction", cl = i, fullCl = chipC))
        }
        else
        {
            xx.2 <- list(genes = dim(xx.1)[1], chipC = chipC, chipCN = i, detailChipS = xx.1, shortL = data.frame(genes = as.character(xx.1[, 1]), cl = i, fullCl = chipC))
        }
        vennItems <- c(vennItems, list(xx.2))
    }

    vennItems
}

xx.3 <- ff.vennFourItems(xx.2)
str(xx.3)
List of 15
 $ :List of 5
  ..$ genes      : int 1
  ..$ chipC      : chr "A#B#C#D***0001"
  ..$ chipCN     : int 1
  ..$ detailChipS:'data.frame': 1 obs. of  5 variables:
  .. ..$ names: Factor w/ 25 levels "A","B","E","F",..: 25
  .. ..$ A    : num NA
  .. ..$ B    : num NA
  .. ..$ C    : num NA
  .. ..$ D    : num 1
  ..$ shortL     :'data.frame': 1 obs. of  3 variables:
  .. ..$ genes : Factor w/ 1 level "Z": 1
  .. ..$ cl    : int 1
  .. ..$ fullCl: Factor w/ 1 level "A#B#C#D***0001": 1
 $ :List of 5
  ..$ genes      : int 0
  ..$ chipC      : chr "A#B#C#D***0010"
  ..$ chipCN     : int 2
0vvn1miw

0vvn1miw1#

看一下?intersect?union?setdiff函数,以提取维恩图的不同字段。
我创建了这两个函数的一些list版本,以更好地获取不同隔间中的元素:

Intersect <- function (x) {  
  # Multiple set version of intersect
  # x is a list
  if (length(x) == 1) {
    unlist(x)
  } else if (length(x) == 2) {
    intersect(x[[1]], x[[2]])
  } else if (length(x) > 2){
    intersect(x[[1]], Intersect(x[-1]))
  }
}

Union <- function (x) {  
  # Multiple set version of union
  # x is a list
  if (length(x) == 1) {
    unlist(x)
  } else if (length(x) == 2) {
    union(x[[1]], x[[2]])
  } else if (length(x) > 2) {
    union(x[[1]], Union(x[-1]))
  }
}

Setdiff <- function (x, y) {
  # Remove the union of the y's from the common x's. 
  # x and y are lists of characters.
  xx <- Intersect(x)
  yy <- Union(y)
  setdiff(xx, yy)
}

所以,如果我们想看到共同的元素(即A、B、C和D的并集)或C和D中的并集,但不在A和B中的并集(在您的示例中,我们将执行以下操作。

set.seed(1)
xx.1 <- list(A = sample(LETTERS, 15), 
             B = sample(LETTERS, 15), 
             C = sample(LETTERS, 15), 
             D = sample(LETTERS, 15))
Intersect(xx.1)
#[1] "E" "L"
Setdiff(xx.1[c("C", "D")], xx.1[c("A", "B")])
#[1] "O" "P" "K" "H"

希望这有帮助!

编辑:系统获取所有组件

通过一些(我认为)巧妙地使用combn函数,索引,以及对lapply的良好理解,我们可以系统地使用所有元素:

# Create a list of all the combinations
combs <- 
  unlist(lapply(1:length(xx.1), 
                function(j) combn(names(xx.1), j, simplify = FALSE)),
         recursive = FALSE)
names(combs) <- sapply(combs, function(i) paste0(i, collapse = ""))
str(combs)
#List of 15
# $ A   : chr "A"
# $ B   : chr "B"
# $ C   : chr "C"
# $ D   : chr "D"
# $ AB  : chr [1:2] "A" "B"
# $ AC  : chr [1:2] "A" "C"
# $ AD  : chr [1:2] "A" "D"
# $ BC  : chr [1:2] "B" "C"
# $ BD  : chr [1:2] "B" "D"
# $ CD  : chr [1:2] "C" "D"
# $ ABC : chr [1:3] "A" "B" "C"
# $ ABD : chr [1:3] "A" "B" "D"
# $ ACD : chr [1:3] "A" "C" "D"
# $ BCD : chr [1:3] "B" "C" "D"
# $ ABCD: chr [1:4] "A" "B" "C" "D"

# "A" means "everything in A minus all others"
# "A", "B" means "everything in "A" and "B" minus all others" and so on
elements <- 
  lapply(combs, function(i) Setdiff(xx.1[i], xx.1[setdiff(names(xx.1), i)]))

n.elements <- sapply(elements, length)
print(n.elements)
#   A    B    C    D   AB   AC   AD   BC   BD   CD  ABC  ABD  ACD  BCD ABCD 
#   2    2    0    0    1    2    2    0    3    4    4    1    1    2    2
zwghvu4y

zwghvu4y2#

您也可以使用gplots包中的venn来获取venn图('ItemsList')每个部分中的项目列表。根据你的清单xx.1,它应该是:

ItemsList <- venn(xx.1, show.plot = FALSE)
  • ItemsList* 包含:

1.所有图表部分的矩阵以及这些部分中的项目计数,以及
1.每个维恩图部分中的项目列表。
获取计数:

lengths(attributes(ItemsList)$intersections)
# A       B     A:B     A:C     A:D     B:D     C:D   A:B:C   A:B:D   A:C:D   B:C:D A:B:C:D 
# 2       2       1       2       2       3       4       4       1       1       2       2
xzv2uavs

xzv2uavs3#

VennDiagram 包中,它有一个名为“calculate.overlap”的函数。

overlap <- calculate.overlap(xx.1)

overlap 就是你想要的:

$a6
[1] "C"

$a12
[1] "Z" "D" "R"

$a11
[1] "Y" "O" "V"

$a5
[1] "X" "B"

$a7
[1] "H" "F" "P" "S"

$a15
[1] "I"

$a4
[1] "L" "K" "G"

$a10
[1] "W" "J"

$a13
[1] "U"

$a8
character(0)

$a2
character(0)

$a9
character(0)

$a14
[1] "N" "M"

$a1
[1] "E"

$a3
[1] "Q" "A" "T"
mzaanser

mzaanser4#

How to obtain the list of elements from a Venn diagram中基于@itsDV7的 Package 器

getVennOverlap <- function(lsvenn = list(A = sort(sample(LETTERS, 15)),
                                     B = sort(sample(LETTERS, 15)),
                                     C = sort(sample(LETTERS, 15)),
                                     D = sort(sample(LETTERS, 15)))
                           ) {
  
  ItemsList <- gplots::venn(lsvenn, show.plot = FALSE)
  print(lengths(attributes(ItemsList)$intersections))
  return(attributes(ItemsList)$intersections)
}

测试

> getVennOverlap()
      A       B       D     A:B     A:C     A:D     B:C     B:D     C:D   A:B:C   A:B:D   A:C:D 
      1       1       1       1       2       1       3       1       1       1       3       3 
  B:C:D A:B:C:D 
      2       3 
$A
[1] "T"

$B
[1] "N"

$D
[1] "L"

$`A:B`
[1] "I"

...etc

相关问题