使用两个分组指定来创建一个“组合”分组变量

时间:2016-04-16 01:14:34

标签: r algorithm

给出data.frame:

df <- data.frame(grp1 = c(1,1,1,2,2,2,3,3,3,4,4,4),
                 grp2 = c(1,2,3,3,4,5,6,7,8,6,9,10))

#> df
#   grp1 grp2
#1     1    1
#2     1    2
#3     1    3
#4     2    3
#5     2    4
#6     2    5
#7     3    6
#8     3    7
#9     3    8
#10    4    6
#11    4    9
#12    4   10

两个coluns都是分组变量,因此已知列grp1中的所有1都被组合在一起,依此类推所有2,等等。grp2也是如此。已知所有1都相同,所有2都是相同的。

因此,如果我们查看第3行和第4行,基于第1列,我们知道前3行可以组合在一起,后3行可以组合在一起。然后,由于第3行和第4行共享相同的grp2值,我们知道所有6行实际上可以组合在一起。

基于相同的逻辑,我们可以看到最后六行也可以组合在一起(因为第7行和第10行共享相同的grp2)。

除了编写一组相当复杂的for()循环之外,还有更直接的方法吗?我还没有想过一个。

我希望获得的最终输出看起来像:

# > 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

感谢您对此主题的任何指示!

4 个答案:

答案 0 :(得分:5)

我会根据连接的组件定义图形和标签节点:

gmap = unique(stack(df))
gmap$node = seq_len(nrow(gmap))

oldcols = unique(gmap$ind)
newcols = paste0("node_", oldcols)
df[ newcols ] = lapply(oldcols, function(i)  with(gmap[gmap$ind == i, ], 
  node[ match(df[[i]], values) ]
))

library(igraph)
g = graph_from_edgelist(cbind(df$node_grp1, df$node_grp2), directed = FALSE)
gmap$group = components(g)$membership

df$group = gmap$group[ match(df$node_grp1, gmap$node) ]


   grp1 grp2 node_grp1 node_grp2 group
1     1    1         1         5     1
2     1    2         1         6     1
3     1    3         1         7     1
4     2    3         2         7     1
5     2    4         2         8     1
6     2    5         2         9     1
7     3    6         3        10     2
8     3    7         3        11     2
9     3    8         3        12     2
10    4    6         4        10     2
11    4    9         4        13     2
12    4   10         4        14     2

grp1grp2的每个唯一元素都是一个节点,df的每一行都是边缘。

答案 1 :(得分:4)

执行此操作的一种方法是通过矩阵定义基于组成员身份的行之间的链接。

此方法与 @Frank 的图表答案相关,但使用邻接矩阵而不是使用边来定义图表。这种方法的一个优点是它可以立即处理许多&gt; 2使用相同的代码对列进行分组。 (只要你编写了灵活地确定链接的函数。)缺点是你需要在行之间进行所有成对比较以构造矩阵,因此对于非常长的向量,它可能很慢。按原样, @Frank 的答案对于很长的数据会更好,或者如果你只有两列。

步骤

  1. 基于组比较行并将这些行定义为链接(即创建图形)
  2. 确定1中链接定义的图表的连通组件。
  3. 你可以做几种方式。下面我展示了一种蛮力方式,在这种方式中你可以折叠链接,直到使用矩阵乘法达到稳定的链接结构,2b)使用hclustcutree将链接结构转换为一个因子。您还可以在从矩阵创建的图表上使用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。折叠到1度链接的2度链接。也就是说,如果行由中间节点链接但没有直接链接,则通过在它们之间定义链接将它们归为同一组。

    一次迭代涉及: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中的稳定链接结构来定义组(图表的连接组件)。你可以通过各种方式做到这一点。

    一种方法是首先定义距离对象,然后使用hclustcutree。如果你考虑一下,我们想要将链接(A[i,j] == 1)定义为距离0.所以步骤是 a)定义在dist对象中链接为距离0, b) 从dist对象构造一个树, c)在零高度(即零距离)切割树:

    df$combinedGrp <- cutree(hclust(as.dist(1 - A)), h = 0)
    df
    

    在实践中,您可以在使用助手lump_links和{{1}的单个函数中对步骤 1 - 2 进行编码}}:

    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 } 以及 @rawr 的答案

    中的结构
    df

    PS

    这是一个使用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 的版本,它使与 @Frank 的回答更加清晰:

    igraph

答案 2 :(得分:2)

希望这个解决方案对您有所帮助:

假设:df是根据grp1订购的。

## split dataset using values of grp1
split_df <- split.default(df$grp2,df$grp1)

parent <- vector('integer',length(split_df))

## find out which combinations have values of grp2 in common
for (i in seq(1,length(split_df)-1)){
    for (j in seq(i+1,length(split_df))){
        inter <- intersect(split_df[[i]],split_df[[j]])

        if (length(inter) > 0){
            parent[j] <- i
        }
    }
}

ans <- vector('list',length(split_df))

index <- which(parent == 0)

## index contains indices of elements that have no element common
for (i in seq_along(index)){
    ans[[index[i]]] <- rep(i,length(split_df[[i]]))
}

rest_index <- seq(1,length(split_df))[-index]

for (i in rest_index){
    val <- ans[[parent[i]]][1]
    ans[[i]] <- rep(val,length(split_df[[i]]))
}

df$combinedGrp <- unlist(ans)

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

答案 3 :(得分:0)

基于https://stackoverflow.com/a/35773701/2152245,我使用了igraph的另一种实现方式,因为我已经有了sf的{​​{1}}个多边形的邻接矩阵:

st_intersects()

enter image description here