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

Я создаю куски параллельных задач, чтобы каждый параллельный работник при обработке вызывал много строк, чтобы снизить накладные расходы на связь. Я вижу значительное ускорение распараллеливания в моей системе.

РЕДАКТИРОВАТЬ: если у вас есть дублированные строки, я бы удалил их заранее с 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),]
})