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

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

编辑：如果您确实有重复的行，我会事先用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),]
})

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

1 个答案: