РЕДАКТИРОВАТЬ
Хотя ответ ниже воспроизводит ожидаемый результат для небольшого выборочного набора данных, он не может дать правильный ответ для большого набора данных из 10 М строк, предоставленного OP.
Однако я решил оставить этот неправильный ответ из-за результатов тестов, которые показывают низкую производительность функции uniqueN().Кроме того, ответ содержит тесты гораздо более быстрых альтернативных решений.
Если я правильно понимаю, ОП хочет сохранить только те строки, в которых уникальные комбинации group_id1, group_id2, trait_id1 и trait_id2 встречаются в нескольких различных key1.
Это может быть достигнуто путем подсчета уникальных значений key1 в каждой группе group_id1, group_id2, trait_id1 и trait_id2 и путем выбора только тех комбинаций group_id1, group_id2, trait_id1 и trait_id2, где число больше единицы.Наконец, соответствующие строки извлекаются путем объединения:
library(data.table)
sel <- dt[, uniqueN(key1), by = .(group_id1, group_id2, trait_id1, trait_id2)][V1 > 1]
sel
group_id1 group_id2 trait_id1 trait_id2 V1
1: 1 2 3 1 2
2: 2 2 2 1 2
3: 2 1 1 2 2
4: 1 1 1 1 2
5: 1 1 2 2 2
6: 2 2 2 2 2
7: 1 1 1 2 2
8: 1 1 3 2 2
res <- dt[sel, on = .(group_id1, group_id2, trait_id1, trait_id2)][order(id), -"V1"]
res
id key1 group_id1 trait_id1 group_id2 trait_id2 extra
1: 1 2 1 3 2 1 u
2: 2 1 2 2 2 1 g
3: 5 2 2 1 1 2 g
4: 8 2 1 3 2 1 o
5: 9 2 1 1 1 1 d
6: 10 2 2 1 1 2 g
7: 13 1 2 1 1 2 c
8: 14 2 1 2 1 2 t
9: 15 1 1 3 2 1 y
10: 16 2 1 3 2 1 v
11: 19 2 2 2 2 2 y
12: 22 2 2 2 2 1 g
13: 24 2 1 1 1 2 i
14: 25 1 1 3 1 2 n
15: 26 1 2 2 2 2 y
16: 27 1 1 1 1 1 n
17: 28 1 1 1 1 2 h
18: 29 1 2 2 2 2 b
19: 30 2 1 3 1 2 k
20: 31 1 2 2 2 2 w
21: 35 1 1 2 1 2 q
22: 37 2 2 1 1 2 r
23: 39 1 1 1 1 2 o
id key1 group_id1 trait_id1 group_id2 trait_id2 extra
Это воспроизводит ожидаемый результат OP, но также самый быстрый способ в соответствии с запросом OP?
Сравнительный анализ, часть 1
Код OP для создания контрольных данных (но с 1 M строкамивместо 10 M строк) здесь используется:
set.seed(0)
n <- 1e6
p <- 1e5
m <- 5
dt <- data.table(id = 1:n,
key1 = sample(1:m, size = n, replace = TRUE),
group_id1 = sample(1:2, size = n, replace = TRUE),
trait_id1 = sample(1:p, size = n, replace = TRUE),
group_id2 = sample(1:2, size = n, replace = TRUE),
trait_id2 = sample(1:2, size = n, replace = TRUE),
extra = sample(letters, n, replace = TRUE))
Я был весьма удивлен, обнаружив, что решение с использованием uniqueN() не является самым быстрым:
Unit: milliseconds
expr min lq mean median uq max neval cld
old_way 489.4606 496.3801 523.3361 503.2997 540.2739 577.2482 3 a
new_way 9356.4131 9444.5698 9567.4035 9532.7265 9672.8987 9813.0710 3 c
uwe1 5946.4533 5996.7388 6016.8266 6047.0243 6052.0133 6057.0023 3 b
Код теста:
microbenchmark::microbenchmark(
old_way = {
DT <- copy(dt)
res <- intersect_this_by(DT,
key_by = c("key1"),
split_by = c("group_id1", "group_id2"),
intersect_by = c("trait_id1", "trait_id2"))
},
new_way = {
DT <- copy(dt)
res <- intersect_this_by2(DT,
key_by = c("key1"),
split_by = c("group_id1", "group_id2"),
intersect_by = c("trait_id1", "trait_id2"))
},
uwe1 = {
DT <- copy(dt)
sel <- DT[, uniqueN(key1), by = .(group_id1, group_id2, trait_id1, trait_id2)][V1 > 1]
res <- DT[sel, on = .(group_id1, group_id2, trait_id1, trait_id2)][
order(id)]
},
times = 3L)
Обратите внимание, что для каждого прогона используется свежая копия данных теста, чтобы избежать каких-либо побочных эффектов от предыдущих прогонов, например, индексов, установленных data.table.
Включение подробного режима
options(datatable.verbose = TRUE)
показывает, что большую часть времени тратится на вычисления uniqueN() для всех групп:
sel <- DT[, uniqueN(key1), by = .(group_id1, group_id2, trait_id1, trait_id2)][V1 > 1]
Detected that j uses these columns: key1
Finding groups using forderv ... 0.060sec
Finding group sizes from the positions (can be avoided to save RAM) ... 0.000sec
Getting back original order ... 0.050sec
lapply optimization is on, j unchanged as 'uniqueN(key1)'
GForce is on, left j unchanged
Old mean optimization is on, left j unchanged.
Making each group and running j (GForce FALSE) ...
collecting discontiguous groups took 0.084s for 570942 groups
eval(j) took 5.505s for 570942 calls
5.940sec
Это известная проблема .Однако альтернатива lenght(unique()) (для которой uniqueN() является аббревиатурой) приносит лишь умеренное ускорение 2.
Так что я начал искать способы избежать uniqueN() или lenght(unique()).
Бенчмаркинг, часть 2
Я нашел две альтернативы, которые достаточно быстрые.Оба создают таблицу данных уникальных комбинаций group_id1, group_id2, trait_id1, trait_id2, и key1 на первом шаге, подсчитывают количество различных значений key1для каждой группы group_id1, group_id2, trait_id1, trait_id2 и фильтр для счетчиков с большим значением:
sel <- DT[, .N, by = .(group_id1, group_id2, trait_id1, trait_id2, key1)][
, .N, by = .(group_id1, group_id2, trait_id1, trait_id2)][N > 1]
и
sel <- unique(DT, by = c("group_id1", "group_id2", "trait_id1", "trait_id2", "key1"))[
, .N, by = .(group_id1, group_id2, trait_id1, trait_id2)][N > 1]
Подробный вывод показываетчто время вычислений для этих вариантов значительно лучше.
Для бенчмаркинга используются только самые быстрые методы, но теперь с 10 М строками.Кроме того, каждый вариант пробуется с setkey() и setorder(), соответственно, примененными заранее:
microbenchmark::microbenchmark(
old_way = {
DT <- copy(dt)
res <- intersect_this_by(DT,
key_by = c("key1"),
split_by = c("group_id1", "group_id2"),
intersect_by = c("trait_id1", "trait_id2"))
},
uwe3 = {
DT <- copy(dt)
sel <- DT[, .N, by = .(group_id1, group_id2, trait_id1, trait_id2, key1)][
, .N, by = .(group_id1, group_id2, trait_id1, trait_id2)][N > 1]
res <- DT[sel, on = .(group_id1, group_id2, trait_id1, trait_id2)][
order(id)]
},
uwe3k = {
DT <- copy(dt)
setkey(DT, group_id1, group_id2, trait_id1, trait_id2, key1)
sel <- DT[, .N, by = .(group_id1, group_id2, trait_id1, trait_id2, key1)][
, .N, by = .(group_id1, group_id2, trait_id1, trait_id2)][N > 1]
res <- DT[sel, on = .(group_id1, group_id2, trait_id1, trait_id2)][
order(id)]
},
uwe3o = {
DT <- copy(dt)
setorder(DT, group_id1, group_id2, trait_id1, trait_id2, key1)
sel <- DT[, .N, by = .(group_id1, group_id2, trait_id1, trait_id2, key1)][
, .N, by = .(group_id1, group_id2, trait_id1, trait_id2)][N > 1]
res <- DT[sel, on = .(group_id1, group_id2, trait_id1, trait_id2)][
order(id)]
},
uwe4 = {
DT <- copy(dt)
sel <- unique(DT, by = c("group_id1", "group_id2", "trait_id1", "trait_id2", "key1"))[
, .N, by = .(group_id1, group_id2, trait_id1, trait_id2)][N > 1]
res <- DT[sel, on = .(group_id1, group_id2, trait_id1, trait_id2)][
order(id)]
},
uwe4k = {
DT <- copy(dt)
setkey(DT, group_id1, group_id2, trait_id1, trait_id2, key1)
sel <- unique(DT, by = c("group_id1", "group_id2", "trait_id1", "trait_id2", "key1"))[
, .N, by = .(group_id1, group_id2, trait_id1, trait_id2)][N > 1]
res <- DT[sel, on = .(group_id1, group_id2, trait_id1, trait_id2)][
order(id)]
},
uwe4o = {
DT <- copy(dt)
setorder(DT, group_id1, group_id2, trait_id1, trait_id2, key1)
sel <- unique(DT, by = c("group_id1", "group_id2", "trait_id1", "trait_id2", "key1"))[
, .N, by = .(group_id1, group_id2, trait_id1, trait_id2)][N > 1]
res <- DT[sel, on = .(group_id1, group_id2, trait_id1, trait_id2)][
order(id)]
},
times = 3L)
Результаты тестов для случая 10 M показывают, что оба варианта быстрее, чем OP intersect_this_by()функция и что при наборе и вводе в порядок ускоряется (с минимальным преимуществом для заказа).
Unit: seconds
expr min lq mean median uq max neval cld
old_way 7.173517 7.198064 7.256211 7.222612 7.297559 7.372506 3 d
uwe3 6.820324 6.833151 6.878777 6.845978 6.908003 6.970029 3 c
uwe3k 5.349949 5.412018 5.436806 5.474086 5.480234 5.486381 3 a
uwe3o 5.423440 5.432562 5.467376 5.441683 5.489344 5.537006 3 a
uwe4 6.270724 6.276757 6.301774 6.282790 6.317299 6.351807 3 b
uwe4k 5.280763 5.295251 5.418803 5.309739 5.487823 5.665906 3 a
uwe4o 4.921627 5.095762 5.157010 5.269898 5.274702 5.279506 3 a