3

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

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

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

1 回答 1

2

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，打乱似乎有助于负载平衡。

使用orderingand我们可以只检查在 对应的列min_col_val中绝对占主导地位的行，并且一旦违反该条件就退出循环。相比之下，它似乎要快得多。iorderingbreak

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),]
})
于 2018-06-20T07:40:55.470 回答