R:从表中删除支配行的快速方法是什么？

Question

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

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

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)
}

Answer 1

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

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

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

---

在这个版本中，我们打乱了每个工作人员必须处理的行的索引，由于每个 worker 必须为每个 i 处理不同的负载，洗牌似乎有助于负载平衡。

使用 ordering 和 min_col_val 我们可以只检查在对应于 ordering 的列中绝对支配行 i 的行>,一旦违反该条件，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),]
})