select 所有组合中最好的组合 data.table r

Question

假设有几个公司组合产生某个最佳值，如何有效地select每个公司只出现一次的唯一最佳组合data.table方式？

样本数据：

require(data.table)
set.seed(1234)
allcombs <- data.table(val=sample(1:20,15), t(combn(LETTERS[1:6], 2)))
setnames(allcombs, paste0("V",1:2), paste0("firm",1:2))
copy_sets = copy(allcombs)

allcombs
    val firm1 firm2
 1:  16     A     B
 2:   5     A     C
 3:  12     A     D
 4:  15     A     E
 5:   9     A     F
 6:  19     B     C
 7:   6     B     D
 8:   4     B     E
 9:   2     B     F
10:   7     C     D
11:  14     C     E
12:  10     C     F
13:  11     D     E
14:  20     D     F
15:  13     E     F

我可以用一个循环来做到这一点：

all_elements = unique(c(allcombs$firm1, allcombs$firm2))
selected_pairs = data.table()
while (length(all_elements) > 0){
  selected_pairs <- rbind(selected_pairs, allcombs[allcombs[firm1 == all_elements[1] | firm2 == all_elements[1], .I[which.max(val)]]])
  all_elements <- setdiff(all_elements, unlist(allcombs[allcombs[firm1 == all_elements[1] | firm2 == all_elements[1], .I[which.max(val)]],.(firm1,firm2)]))
  allcombs <- allcombs[firm1 %in% all_elements & firm2 %in% all_elements]
}

这是我想要的：

selected_pairs
   val firm1 firm2
1:  16     A     B
2:  14     C     E
3:  20     D     F

感谢任何帮助！

Answer 1

如果我理解正确，OP 想要 select 每个公司只出现一次的独特最佳组合。

下面的代码选择具有最高 val 的组合，将包含 firm1 或 firm2 的所有其他行标记为 done 并且迭代地继续剩余的行，直到所有行都完成。通过引用更新 rank 列 来完成簿记，即不复制。

d <- copy(allcombs) setorder(d, -val) d[, rank := NA_integer_] r = 0L remain <- d[, .I] while (length(remain) > 0) { r <- r + 1L idx <- remain[d[remain, which.max(val)]] d[idx, rank := r] lut <- d[idx, .(firm = c(firm1, firm2), rank = NA_integer_)] d[lut, on = c("firm1==firm", "rank"), rank := 0] d[lut, on = c("firm2==firm", "rank"), rank := 0] remain <- d[, .I[is.na(rank)]] } d[rank > 0]

val firm1 firm2 rank <int> <char> <char> <int> 1: 20 D F 1 2: 19 B C 2 3: 15 A E 3

请注意，此处的结果与 OP 的结果不同，因为 data.table 是按递减 val 排序的，而 OP 的代码按照公司名称出现在 [=17= 中的顺序遍历行] 和 firm2.

我觉得这是武断的，不是决定性的。 OP 的方法将 select 仅在当前 firm1 实例的组合中是次优的，而不是所有剩余行的整体最优。

编辑 2

这是上述代码的简化版本，它使用额外的 行 IDrn 列而不是 remain 向量：

d <- copy(allcombs) d[, rank := NA_integer_] # append bookkeeping column d[, rn := .I] # append row id r = 0L while (any(is.na(d$rank))) { r <- r + 1L idx <- d[is.na(rank), rn[which.max(val)]] d[idx, rank := r] lut <- d[idx, .(firm = c(firm1, firm2), rank = NA_integer_)] d[lut, on = c("firm1==firm", "rank"), rank := 0L] d[lut, on = c("firm2==firm", "rank"), rank := 0L] } d[rank > 0]

编辑 1

出于好奇，我试图重现 OP 的预期结果。因此，这是上面代码的一个变体，它循环遍历唯一的公司名称：

d <- copy(allcombs) firms <- d[, unique(c(firm1, firm2))] # firms <- rev(d[, unique(c(firm1, firm2))]) d[, rank := NA_integer_] d[, rn := .I] # append row id r = 0L for (f in firms) { r <- r + 1L idx <- d[is.na(rank) & (firm1 == f | firm2 == f), rn[which.max(val)]] d[idx, rank := r] lut <- d[idx, .(firm = c(firm1, firm2), rank = NA_integer_)] d[lut, on = c("firm1==firm", "rank"), rank := 0L] d[lut, on = c("firm2==firm", "rank"), rank := 0L] if (!any(is.na(d$rank))) break } d[rank > 0] val firm1 firm2 rank rn 1: 16 A B 1 1 2: 14 C E 3 11 3: 20 D F 4 14

如上所述，结果可能取决于公司名称在 firm1 和 firm2 中出现的顺序。

这可以通过颠倒公司名称的顺序来证明

firms <- rev(d[, unique(c(firm1, firm2))])

现在，代码 returns

val firm1 firm2 rank rn 1: 15 A E 2 4 2: 19 B C 4 6 3: 20 D F 1 14

簿记列尚未删除以进行演示。

select 所有组合中最好的组合 data.table r

select best comb among all combination data.table r

r

data.table

编辑 2

编辑 1