一种方法是通过一个矩阵来定义基于组成员身份的行之间的链接。
这种方法与 @Frank 的图形答案有关，但使用邻接矩阵而不是使用边来定义图形。这种方法的一个优点是它可以立即处理具有相同代码的许多 > 2 个分组列。 （只要您编写灵活确定链接的函数。）缺点是您需要在行之间进行所有成对比较来构造矩阵，因此对于非常长的向量可能会很慢。照原样，@Frank 的答案对于非常长的数据或只有两列的情况会更好。
步骤是
- 根据组比较行并将这些行定义为链接（即创建图表）
- 确定由 1 中的链接定义的图的连通分量。
你可以做 2 几种方法。下面我展示了一种蛮力方法，您 2a) 折叠链接，直到使用矩阵乘法达到稳定的链接结构，以及 2b) 使用 hclust 和 cutree 将链接结构转换为因子。您还可以在从矩阵创建的图形上使用igraph::clusters。
1. 构造行之间的邻接矩阵（成对链接的矩阵）
（即，如果它们在同一组中，则矩阵条目为 1，否则为 0）。首先制作一个判断两行是否链接的辅助函数
linked_rows <- function(data){
## helper function
## returns a _function_ to compare two rows of data
## based on group membership.
## Use Vectorize so it works even on vectors of indices
Vectorize(function(i, j) {
## numeric: 1= i and j have overlapping group membership
common <- vapply(names(data), function(name)
data[i, name] == data[j, name],
FUN.VALUE=FALSE)
as.numeric(any(common))
})
}
我在outer中使用它来构造一个矩阵，
rows <- 1:nrow(df)
A <- outer(rows, rows, linked_rows(df))
2a. 将 2 度链接折叠为 1 度链接。也就是说，如果行通过中间节点链接但不直接链接，则通过定义它们之间的链接将它们集中在同一组中。
一次迭代涉及：i) 矩阵相乘得到 A 的平方，以及
ii) 将方阵中的任何非零项设置为 1（就好像它是一阶成对链接）
## define as a function to use below
lump_links <- function(A) {
A <- A %*% A
A[A > 0] <- 1
A
}
重复此操作直到链接稳定
oldA <- 0
i <- 0
while (any(oldA != A)) {
oldA <- A
A <- lump_links(A)
}
2b. 使用A 中的稳定链接结构来定义组（图的连接组件）。您可以通过多种方式做到这一点。
一种方法是先定义一个距离对象，然后使用hclust 和cutree。如果您考虑一下，我们希望将链接 (A[i,j] == 1) 定义为距离 0。因此步骤是 a) 将链接定义为 dist 对象中的距离 0，b) em> 从 dist 对象构造一棵树，c) 在零高度（即零距离）处切割树：
df$combinedGrp <- cutree(hclust(as.dist(1 - A)), h = 0)
df
在实践中，您可以将步骤 1 - 2 编码在使用帮助器 lump_links 和 linked_rows 的单个函数中：
lump <- function(df) {
rows <- 1:nrow(df)
A <- outer(rows, rows, linked_rows(df))
oldA <- 0
while (any(oldA != A)) {
oldA <- A
A <- lump_links(A)
}
df$combinedGrp <- cutree(hclust(as.dist(1 - A)), h = 0)
df
}
这适用于原始 df 以及 @rawr 答案中的结构
df <- data.frame(grp1 = c(1,1,1,2,2,2,3,3,3,4,4,4,5,5,6,7,8,9),
grp2 = c(1,2,3,3,4,5,6,7,8,6,9,10,11,3,12,3,6,12))
lump(df)
grp1 grp2 combinedGrp
1 1 1 1
2 1 2 1
3 1 3 1
4 2 3 1
5 2 4 1
6 2 5 1
7 3 6 2
8 3 7 2
9 3 8 2
10 4 6 2
11 4 9 2
12 4 10 2
13 5 11 1
14 5 3 1
15 6 12 3
16 7 3 1
17 8 6 2
18 9 12 3
PS
这是一个使用igraph的版本，这使得与@Frank的答案的联系更加清晰：
lump2 <- function(df) {
rows <- 1:nrow(df)
A <- outer(rows, rows, linked_rows(df))
cluster_A <- igraph::clusters(igraph::graph.adjacency(A))
df$combinedGrp <- cluster_A$membership
df
}