如何在R中的矩阵中找到互补行答案

【问题标题】：How to find complementary rows in matrix in R如何在R中的矩阵中找到互补行
【发布时间】：2020-04-17 15:39:32
【问题描述】：

我有这个矩阵：

      [,1] [,2] [,3] [,4]
 [1,]    1    0    0    0
 [2,]    0    1    0    0
 [3,]    0    0    1    0
 [4,]    0    0    0    1
 [5,]    1    1    0    0
 [6,]    0    0    1    1
 [7,]    1    0    1    0
 [8,]    0    1    0    1
 [9,]    1    1    1    1

所以，有些行是互补的。在这个矩阵中，这些是：

[5,]    1    1    0    0
[6,]    0    0    1    1

和

[7,]    1    0    1    0
[8,]    0    1    0    1

我想做的是找到这些互补的行并只保留其中的第一行。预期的输出应该是这样的：

      [,1] [,2] [,3] [,4]
 [1,]    1    0    0    0
 [2,]    0    1    0    0
 [3,]    0    0    1    0
 [4,]    0    0    0    1
 [5,]    1    1    0    0
 [6,]    1    0    1    0
 [7,]    1    1    1    1

有没有办法在 R 中做到这一点？

【问题讨论】：

你能显示你的预期输出吗？
检查下面的答案。
不 - 我的意思是它会帮助其他人看到您的预期输出。您不提供，接受的答案也不提供！

标签： r matrix

【解决方案1】：

如果你的矩阵叫做m:

# find duplicate rows
dists <- as.matrix(dist(m, method = "manhattan"))
equals <- which(dists == ncol(m), arr.ind = TRUE, useNames = FALSE)

# remove symmetry (5,6 == 6,5)
equals <- equals[equals[,1] < equals[,2],]
to_drop <- equals[,2]

m <- m[-to_drop,]

这使用曼哈顿距离来查找差的总和等于列数的行，因此所有元素都不同。

【讨论】：

【解决方案2】：

在 base-R 中是运行此代码所需的全部内容。

样本数据：

mydata<- matrix(c(1,0,0,0,1,0,1,0,1,0,1,0,0,1,0,0,1,1,0,0,1,0,0,1,1,0,1,0,0,0,1,0,1,0,1,1),ncol=4)

代码

i=1
while(i <= nrow(mydata)){
  test <- matrix(rep(mydata[i,],nrow(mydata)),nrow=nrow(mydata),byrow=T)+mydata
  RowsToRemove <- grep(1,sapply(1:nrow(mydata),function(x) prod(test[x,]==1)))
  if(length(RowsToRemove)!=0){
    mydata <- mydata[-RowsToRemove,]
  }
  i=i+1
}

输出

> mydata
     [,1] [,2] [,3] [,4]
[1,]    1    0    0    0
[2,]    0    1    0    0
[3,]    0    0    1    0
[4,]    0    0    0    1
[5,]    1    1    0    0
[6,]    1    0    1    0
[7,]    1    1    1    1

【讨论】：

【解决方案3】：

使用xor()：

complements <- mapply(function(x,y) { all(xor(mat[x,], mat[y,]))}, x = 1:(nrow(mat)-1), y = 2:nrow(mat) )
names(complements) <- paste(x = 1:(nrow(mat)-1), y = 2:nrow(mat), sep = '')
complements
#    12    23    34    45    56    67    78    89 
# FALSE FALSE FALSE FALSE  TRUE FALSE  TRUE FALSE

提取匹配的第一行：

mat[(1:(nrow(mat)-1))[complements], ]
#      V1 V2 V3 V4
# [1,]  1  1  0  0
# [2,]  1  0  1  0

提取匹配的第二行：

mat[(2:nrow(mat))[complements], ]
#      V1 V2 V3 V4
# [1,]  0  0  1  1
# [2,]  0  1  0  1

编辑：

OP编辑好预期输出后，代码如下。

首先处理与第 1 行和第 2 行不互补的边缘情况，然后检查整个矩阵的补数。

ind <- unique( c(unlist( ifelse( all(xor(mat[1, ], mat[2, ])), 1, list(c(1,2)))),
                 mapply(function(x,y) { ifelse(all(xor(mat[x,], mat[y,])), x, y)}, x = 1:(nrow(mat)-1), y = 2:nrow(mat) )))
mat[ind, ]
#      V1 V2 V3 V4
# [1,]  1  0  0  0
# [2,]  0  1  0  0
# [3,]  0  0  1  0
# [4,]  0  0  0  1
# [5,]  1  1  0  0
# [6,]  1  0  1  0
# [7,]  1  1  1  1

数据：

mat <- structure(c(1L, 0L, 0L, 0L, 1L, 0L, 1L, 0L, 1L, 0L, 1L, 0L, 0L, 
1L, 0L, 0L, 1L, 1L, 0L, 0L, 1L, 0L, 0L, 1L, 1L, 0L, 1L, 0L, 0L, 
0L, 1L, 0L, 1L, 0L, 1L, 1L), .Dim = c(9L, 4L), .Dimnames = list(
    NULL, c("V1", "V2", "V3", "V4")))

【讨论】：

有人对我的答案投了反对票，但没有意识到 OP 稍后用预期的输出编辑了问题。