计算所有可能的交叉点

Question

我们有一个数据框，其中一列用于类别，一列用于离散值。我们希望获取所有类别组合的所有可能交集（公共值的数量）。

我想出了以下代码。但是，那里有更短的东西吗？我确信有一种更好的方法可以做到这一点，一个专门的功能可以做到这一点。当然，下面的代码可以缩短，例如使用purrr:map，但这不是我的问题。

## prepare an example data set
df <- data.frame(category=rep(LETTERS[1:5], each=20),
                 value=sample(letters[1:10], 100, replace=T))

cats <- unique(df$category)
n <- length(cats)

## all combinations of 1...n unique elements from category
combinations <- lapply(1:n, function(i) combn(cats, i, simplify=FALSE))
combinations <- unlist(combinations, recursive=FALSE)
names(combinations) <- sapply(combinations, paste0, collapse="")

## for each combination of categories, get the values which belong
## to this category
intersections <- lapply(combinations, 
          function(co) 
             lapply(co, function(.x) df$value[ df$category == .x ]))
intersections <- lapply(intersections, 
    function(.x) Reduce(intersect, .x))
intersections <- sapply(intersections, length)

这给我们带来了我想要的结果：

> intersections
    A     B     C     D     E    AB    AC    AD    AE    BC 
   20    20    20    20    20    10     8     8     9     8 
   BD    BE    CD    CE    DE   ABC   ABD   ABE   ACD   ACE 
    8     9     7     8     8     8     8     9     7     8 
  ADE   BCD   BCE   BDE   CDE  ABCD  ABCE  ABDE  ACDE  BCDE 
    8     7     8     8     7     7     8     8     7     7 
ABCDE 
    7 

问题：有没有办法以更少的模糊度达到相同的结果？

Answer 1

这是一种可能的方法，data.table 强制转换 data.frame，model.matrix 计算高阶交互：

1. 通过对行中类别之间的所有匹配值进行分组来转换为宽格式（@chinsoon12 的 dcast 语法）。

2. 识别与model.matrix 的所有高阶交互并对列求和。

library(data.table)

df_wide <- dcast(setDT(df), value + rowid(category, value) ~ category, fun.aggregate = length, fill = 0)
head(df_wide)
#>    value category A B C D E
#> 1:     a        1 1 1 1 1 1
#> 2:     a        2 1 0 0 1 1
#> 3:     a        3 0 0 0 1 0
#> 4:     b        1 1 1 1 0 1
#> 5:     b        2 1 0 1 0 1
#> 6:     c        1 1 1 1 1 1

colSums(model.matrix(~(A + B + C + D + E)^5, data = df_wide))[-1]
#>         A         B         C         D         E       A:B       A:C 
#>        20        20        20        20        20        13        11 
#>       A:D       A:E       B:C       B:D       B:E       C:D       C:E 
#>        12        12        11        13        13        11        13 
#>       D:E     A:B:C     A:B:D     A:B:E     A:C:D     A:C:E     A:D:E 
#>        10         8         9         9         7         9         7 
#>     B:C:D     B:C:E     B:D:E     C:D:E   A:B:C:D   A:B:C:E   A:B:D:E 
#>         8         9         7         8         5         7         5 
#>   A:C:D:E   B:C:D:E A:B:C:D:E 
#>         5         6         4

数据

set.seed(1)
df <- data.frame(category=rep(LETTERS[1:5], each=20),
    value=sample(letters[1:10], 100, replace=T))