Как найти дополнительные строки в матрице в R

Question

У меня есть эта матрица:

      [,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?

Answer 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,]

При этом используется манхэттенское расстояние для поиска строк, для которых сумма разностей равна количеству столбцов, следовательно, все элементы различны.

Answer 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

Answer 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")))