从数据框中删除所有包含相同元素的行,即使元素在 R 中的顺序不同

Remove all rows containing the same elements from dataframe, even though elements are in different order in R

这是我的数据:

mymat <- structure(c(3, 6, 9, 9, 1, 4, 1, 5, 9, 6, 6, 4, 1, 4), .Dim = c(7L, 2L))

有些行是重复的,其他几行包含相同的元素,尽管它们的排序不同。我希望删除包含相同元素的所有行,无论这些元素是相同的(重复的行)还是不同的顺序。这将仅保留 c(3, 5).

的第一行

我检查了以前的问题 here and here。但是,我的要求是删除所有这样的行,而不是留下这样的一行。

我的问题也不同于 this one,它删除了所有重复的行,因为我不仅查找重复的行,还查找包含相同元素集但排序不同的行。例如,行 c(6, 9)c(9, 6) 都应删除,因为它们都包含同一组元素。

我正在寻找不使用 for 循环的解决方案,因为我的真实数据很大并且 for 循环可能很慢。

注意:我的完整数据有 40k 行和 2 列。

你可以直接使用,下面一行代码:

mymat <- mymat[!mymat[,1] %in% mymat[,2], , drop = FALSE]

输出:

mymat
#>      [,1] [,2]
#> [1,]    3    5

reprex package (v0.3.0)

于 2021-09-24 创建

我加了一点数据,说明矩阵格式保持不变

mymat <- structure(c(3, 6, 9, 9, 1, 4, 1, 10, 12, 13, 14, 5, 9, 6, 6, 4, 1, 4, 11, 13, 12, 15), .Dim = c(11L, 2L))

dup <- duplicated(rbind(mymat, mymat[, c(2, 1)]))
dup_fromLast <- duplicated(rbind(mymat, mymat[, c(2, 1)]), fromLast = TRUE)

mymat_duprm <- mymat[!(dup_fromLast | dup)[1:(length(dup) / 2)], ]

mymat_duprm

作为矩阵:

tmp <- apply(mymat, 1, function(z) toString(sort(z)))
mymat[ave(tmp, tmp, FUN = length) == "1",, drop = FALSE]
#      [,1] [,2]
# [1,]    3    5

drop=FALSE 是必需的,只是因为(至少对于这个示例数据)过滤结果在一行中。虽然我怀疑您的真实数据(有 40k 行)会减少到这个程度,但我还是建议您将其保留在那里(“以防万一”,这只是防御性编程)。

您可以按行对数据进行排序并使用 duplicated -

tmp <- t(apply(mymat, 1, sort))
tmp[!(duplicated(tmp) | duplicated(tmp, fromLast = TRUE)), , drop = FALSE]

#     [,1] [,2]
#[1,]    3    5

对几个新解决方案以及一些已发布的解决方案进行基准测试:

library(Rfast)
library(microbenchmark)

mymat <- matrix(sample(100, 4000, replace = TRUE), nrow = 2000)

noDup <- function(m) {
  return(!(duplicated(m) | duplicated(m, fromLast = TRUE)))
}

combounique1 <- function(m) {
  return(m[noDup(rowSort(m)),])
}

combounique2 <- function(m) {
  msum <- rowsums(m)
  return(m[noDup(rowsums(m^2) + msum + (msum - 3)*abs(m[,1] - m[,2])),])
}

combounique3 <- function(m) {
  return(m[noDup(rowsums(m + 1/m)),])
}

combounique4 <- function(m) {
  # similar to Harrison Jones, but correct
  return(m[noDup(rbind(m, m[m[,1] != m[,2], 2:1]))[1:nrow(m)],])
}

combounique5 <- function(m) {
  # similar to Ronak Shah, but maintains ordering within rows
  tmp <- t(apply(m, 1, sort))
  return(m[noDup(tmp),])
}

r2evans <- function(m) {
  tmp <- apply(m, 1, function(z) toString(sort(z)))
  return(m[ave(tmp, tmp, FUN = length) == "1",, drop = FALSE])
}

microbenchmark(mymat1 <- combounique1(mymat),
               mymat2 <- combounique2(mymat),
               mymat3 <- combounique3(mymat),
               mymat4 <- combounique4(mymat),
               mymat5 <- combounique5(mymat),
               mymat6 <- r2evans(mymat))

                          expr     min       lq      mean   median       uq      max neval
 mymat1 <- combounique1(mymat)  7129.9  7642.30  9236.841  8205.45  9467.70  28363.7   100
 mymat2 <- combounique2(mymat)   171.0   197.30   219.341   215.75   225.45    385.5   100
 mymat3 <- combounique3(mymat)   144.2   166.95   187.340   182.50   192.30    306.7   100
 mymat4 <- combounique4(mymat) 14263.1 15343.90 17938.061 16417.30 19043.30  34884.9   100
 mymat5 <- combounique5(mymat) 48230.9 50773.75 57662.463 55041.90 60968.35 193804.2   100
      mymat6 <- r2evans(mymat) 66180.3 70835.30 78642.552 77299.85 81992.60 161034.5   100

> all(sapply(list(mymat1, mymat2, mymat3, mymat4, mymat5, mymat6), FUN = identical, mymat1))
[1] TRUE

请注意,combounique2combounique3 仅对整数值严格正确。这个想法是使用对称配对函数为每对整数获取唯一值,然后在其上使用 duplicated 。 (参见 https://math.stackexchange.com/questions/3162166/what-function-symmetric-and-has-unique-solution