R: What is a fast way to remove dominated rows from a table?

Question

I'm looking for a fast way to remove all dominated rows from a table (preferably using parallel processing, to take advantage of multiple cores).

By "dominated row", I mean a row that is less than or equal to another row in all columns. For example, in the following table:

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

Rows 2 and 3 are dominated rows (in this case they are both dominated by row 1), and should be removed. Rows 1 and 4 are not dominated by any other row and should be preserved, resulting in this table:

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

To further illustrate, here is the kind of code I'm looking to speed up:

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

I have some ideas, but figured I'd ask if there might be well-known packages/functions that do this.

---

UPDATE: Here is a fairly simple parallelization of the above code, which nevertheless provides a solid performance boost:

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: optimized version below.

I have a feeling that you can do better than this solution, but it is probably not so trivial. Here I just compare each row to every other row, I just do it in a way that memory utilization is reduced, but execution time complexity is almost quadratic in n (almost because the for-loop can terminate early)...

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

I create chunks of parallel tasks so that each parallel worker has to process many rows when it is called, so that communication overhead is reduced. I do see a considerable parallelization speed-up in my system.

EDIT: if you do have duplicated rows, I would remove them beforehand with unique.

---

In this version we shuffle the indices of the rows that each worker has to process, due to the fact that each worker has to deal with different loads for each i, shuffling seems to help with load balance.

With ordering and min_col_val we can check only rows that definitely dominate row i in the column corresponding to ordering, and break out of the loop once that condition is violated. It does seem to be considerably faster in comparison.

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