r - R:从表中删除主导行的快速方法是什么？

我正在寻找一种从表中删除所有主导行的快速方法(最好使用并行处理，以利用多核)。

所谓“支配行”，是指在所有列中小于或等于另一行的行。例如，在下表中:

tribble(~a, ~b, ~c,
        10,  5,  3,
        10,  4,  2,
         1,  4,  1,
         7,  3,  6)

第2行和第3行是主导行(在这种情况下，它们都由第1行主导)，应将其删除。第1行和第4行不受任何其他行支配，应保留，从而导致该表:

tribble(~a, ~b, ~c,
        10,  5,  3,
         7,  3,  6)

为了进一步说明，这是我希望加快速度的代码:

table1 = as_tibble(replicate(3, runif(500000)))
colnames(table1) = c("a", "b", "c")
table2 = table1
for (i in 1:nrow(table1)) {
  table2 = filter(table2,
    (a > table1[i,]$a | b > table1[i,]$b | c > table1[i,]$c) |
    (a == table1[i,]$a & b == table1[i,]$b & c == table1[i,]$c) )
}
filtered_table = table2

我有一些想法，但是想通了，我想问一下是否有知名的软件包/函数可以做到这一点。

更新:这是上述代码的相当简单的并行化，尽管如此，它仍可提供可靠的性能提升:

remove_dominated = function(table) {
  ncores = detectCores()
  registerDoParallel(makeCluster(ncores))
  # Divide the table into parts and remove dominated rows from each part
  tfref = foreach(part=splitIndices(nrow(table), ncores), .combine=rbind) %dopar% {
    tpref = table[part[[1]]:part[[length(part)]],]
    tp = tpref
    for (i in 1:nrow(tpref)) {
      tp = filter(tp,
                (a > tpref[i,]$a | b > tpref[i,]$b | c > tpref[i,]$c |
                (a == tpref[i,]$b & b == tpref[i,]$b & c == tpref[i,]$c) )
    }
    tp
  }
  # After the simplified parts have been concatenated, run a final pass to remove dominated rows from the full table
  t = tfref
  for (i in 1:nrow(tfref)) {
    t = filter(t,
            (a > tfref[i,]$a | b > tfref[i,]$b | c > tfref[i,]$c |
            (a == tfref[i,]$a & b == tfref[i,]$b & c == tfref[i,]$c) )
  }
  return(t)
}

最佳答案

EDIT2:下面的优化版本。

我觉得您可以比此解决方案做得更好，
但这可能不是那么简单。
在这里，我只是将每一行与其他每一行进行比较，
我只是以减少内存使用的方式来做，
但是n的执行时间复杂度几乎是平方的
(几乎是因为for循环可以提前终止)...

library(doParallel)

n <- 50000L
table1 <- replicate(3L, runif(n))

num_cores <- detectCores()
workers <- makeCluster(num_cores)
registerDoParallel(workers)

chunks <- splitIndices(n, num_cores)
system.time({
  is_dominated <- foreach(chunk=chunks, .combine=c, .multicombine=TRUE) %dopar% {
    # each chunk has many rows to be checked
    sapply(chunk, function(i) {
      a <- table1[i,]
      # this will check if any other row dominates row "i"
      for (j in 1L:n) {
        # no row should dominate itself
        if (i == j)
          next

        b <- table1[j,]
        if (all(b >= a))
          return(TRUE)
      }

      # no one dominates "a"
      FALSE
    })
  }
})

non_dominated <- table1[!is_dominated,]

我创建了许多并行任务，以便每个并行工作程序在调用时都必须处理许多行，
从而减少了通信开销。
我的确在系统中看到了相当大的并行化速度。

编辑:如果您确实有重复的行，
我会事先用unique删除它们。

在此版本中，我们重新整理了每个工作人员必须处理的行的索引，
由于每个工人必须为每个i处理不同的负载，
改组似乎有助于负载平衡。

使用ordering和min_col_val，我们只能检查在与i对应的列中绝对主导行ordering的行，
一旦违反该条件，break就会退出循环。
相比较而言，它似乎确实要快得多。

ids <- sample(1L:n)
chunks <- lapply(splitIndices(n, num_cores), function(chunk_ids) {
  ids[chunk_ids]
})

system.time({
  orderings <- lapply(1L:ncol(table1), function(j) { order(table1[, j], decreasing=TRUE) })

  non_dominated <- foreach(chunk=chunks, .combine=c, .multicombine=TRUE, .inorder=FALSE) %dopar% {
    chunk_ids <- sapply(chunk, function(i) {
      a <- table1[i,]

      for (col_id in seq_along(orderings)) {
        ordering <- orderings[[col_id]]
        min_col_val <- a[col_id]

        for (j in ordering) {
          if (i == j)
            next

          b <- table1[j,]

          if (b[col_id] < min_col_val)
            break

          if (all(b >= a))
            return(FALSE)
        }
      }

      # no one dominates "a"
      TRUE
    })

    chunk[chunk_ids]
  }

  non_dominated <- table1[sort(non_dominated),]
})