计算跨组的共现答案

【问题标题】：Count co-occurences across groups计算跨组的共现
【发布时间】：2021-10-18 15:26:25
【问题描述】：

我想计算一个变量在各组中的共现次数。我确信count 或pivot_ 有一个简单的{dplyr}/{tidyr} 解决方案，但我被卡住了。谢谢您的帮助！下面是我的输入和潜在输出的代表（我不关心输出的格式，也可以是列联表）。请注意，变量的顺序无关紧要，即“green”然后“blue”与“blue”然后“green”相同。

library(dplyr)

df_in <- tribble(
  ~id, ~color,
  1, "green",
  1, "blue",
  2, "blue",
  2, "green",
  3, "blue",
  3, "red"
)

df_out <- tribble(
  ~colors, ~n,
  "blue-green", 2,
  "blue-red", 1
)

或作为列联表： | |蓝色|绿色|红色| | ----- | - | - | - | |蓝色 | - | 2 | 1 | |绿色 | 2 | - | 0 | |红色 | 1 | 0 | - |

【问题讨论】：

标签： r dplyr count tidyr contingency

【解决方案1】：

你可以试试

library(tidyverse)
df_in %>% 
 group_by(id) %>% 
 summarise(color = toString(sort(color)), .groups = "drop") %>%
 count(color)
# A tibble: 2 x 2
color           n
<chr>        <dbl>
1 blue, green     2
2 blue, red       1

当然，您可以将paste 与collapse="-" 或glue::glue_collapse(sort(color), sep = "-") 一起使用，而不是使用toString。此外，如果颜色在组内的排序不相似，我添加了 sort。

【讨论】：

【解决方案2】：

这是基础 R 中的单行代码：

as.data.frame(table(
                 sapply( split(df_in, df_in$id), 
                      function(d) paste( sort(d$color), sep="", collapse="-") ) )
              )
#---------------------------------
        Var1 Freq
1 blue-green    2
2   blue-red    1

如果您对列联表感到满意，请取消 as.data.frame 调用：

table( sapply( split(df_in, df_in$id), 
             function(d) paste( sort(d$color), sep="", collapse="-")))
#------------------
blue-green   blue-red 
         2          1

到目前为止，我看到的任何解决方案的问题是没有“配对创建”。您的示例可能代表也可能不代表最复杂的可能输入。如果基于id 的拆分中有三个不同的项目，那么您尚未指定应如何处理这些项目。

【讨论】：

一些变体可能是：table(sapply(split(df_in$color, df_in$id), \(x) paste(sort(x), collapse="-")))、table(aggregate(color ~ id, df_in, \(x) paste(sort(x), collapse="-"))$color) 或 table(sapply(by(df_in$color, df_in$id, sort), paste, collapse="-"))
@GKi。同意。我认为如果 OP 需要为每个 id 配对两种以上不同的颜色，则可能会使用 combn 和 apply on columns。

【解决方案3】：

这是使用widyr 包的一个：

library(widyr)
df_in %>% 
  pairwise_count(color, id, upper = TRUE) %>%
  # remove pairs with same colours
  rowwise() %>% 
  mutate(pairs = toString(sort(c(item1, item2)))) %>% 
  ungroup() %>% 
  filter(!duplicated(pairs))
#> # A tibble: 2 × 4
#>   item1 item2     n pairs      
#>   <chr> <chr> <dbl> <chr>      
#> 1 blue  green     2 blue, green
#> 2 red   blue      1 blue, red

^{由reprex package (v2.0.0) 于 2021-08-16 创建}

widyr 是一个简洁的小包，它为“在宽矩阵上数学上方便”的整洁数据提供函数，然后将结果转换回整洁的格式。根据我的经验，这个包非常快捷方便。

【讨论】：

这需要一个额外的步骤来删除额外的对，尽管它似乎解决了我在其他两个解决方案中发现的问题，它们实际上并没有从不同的项目创建对。
@IRTFM 有什么问题？请编辑您的数据以说明您的意思。
啊，我明白了。我一定在你的问题中错过了这个。
@Roman。该示例没有提供特定 id 中有两种以上不同颜色的情况。因此，无法判断用例中是否会发生这种情况，以及是否会发生这种情况，也没有关于如何处理的指导。
@IRTFM 你能提供一些颜色不同的数据吗？

【解决方案4】：

我们可以得到邻接矩阵A，使用table和crossprod，也可以长形式显示，然后使用igraph包显示图形。

A <- crossprod(table(df_in))
diag(A) <- 0

A # as symmetric matrix
##        color
## color   blue green red
##   blue     0     2   1
##   green    2     0   0
##   red      1     0   0

A[upper.tri(A)] <- 0
A  # lower triangular matrix
##        color
## color   blue green red
##   blue     0     0   0
##   green    2     0   0
##   red      1     0   0

A |>
  as.data.frame.table() |>
  subset(Freq > 0) |>
  with(data.frame(pairs = paste(color, color.1, sep = "-"), n = Freq))
##        pairs n
## 1 green-blue 2
## 2   red-blue 1

绘制图表

library(igraph)
g <- graph_from_adjacency_matrix(A, "undirected")

# combine parallel edges
E(g)$weight <- 1
gg <- simplify(g, edge.attr.comb = list(weight = "sum"))

set.seed(123)
plot(gg, vertex.size = 30, edge.label = E(gg)$weight, 
  vertex.color = adjustcolor(names(V(gg)), 0.5))

【讨论】：