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来计数高阶交互的一种可能方法：

通过对行中类别之间的所有匹配值进行分组来对宽格式进行投射（对于dcast语法，@ chinsoon12的信用）。
标识与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))

计算所有可能的交点

1 个答案: