Как быстрее вычислить CJ по группам? (перекрестное соединение data.table)

Question 1

Мне нужно использовать большой набор данных для вычисления (много раз) перекрестного соединения по группам, и это довольно медленно. Не могли бы вы подсказать мне более быстрый способ сделать это?

Пример игрушки:

set.seed(1)
totletter <- 10
LLL <- LETTERS[1:totletter]
nID <- 100000
neach <- 5
nnn <- rep(1:nID, each=neach)  # In my real problem each is not constant
myDT <- data.table(id=paste0("ID",nnn), group=sample(LLL,nID*neach,replace=T))

А теперь функцию я хочу сделать быстрее. Объединение буквы каждой группы со всеми возможными буквами.

combi <- myDT[,CJ( unique(group) ,LLL), by=id]

На моем компьютере это занимает 92 секунды для nID = 100000 групп.
И около 920 секунд для nID = 1M. (Мне нужно на 1м).

Я знаю, что это связано с аналогичными проблемами. Выполнение любой функции во многих подгруппах происходит медленно:

https://github.com/Rdatatable/data.table/issues/3988 https://github.com/Rdatatable/data.table/issues/3739

Мне просто нужен какой-нибудь трюк, чтобы сделать это быстрее для СиДжея.

r performance group-by data.table

1

skan 24 Окт 2019 в 01:14

Answer

Думаю, возникает резонный вопрос: что вы собираетесь делать с таким большим количеством комби. В любом случае здесь 2 варианта:

1) Получите уникальные группы по идентификатору, затем выполните перекрестное соединение (см. Ссылку)

ug <- myDT[, unique(group), id]
ug[, c(.SD, .(LLL=LLL)), seq_len(ug[, .N])][, (1) := NULL]

2) Получите уникальные группы, затем CJ индексы и извлекающую строку, соответствующую этим индексам

ug <- myDT[, unique(group), id]
idx <- CJ(ug[,seq_len(.N)], seq_along(LLL))
ug[idx$V1, c(.SD, .(LLL=LLL[idx$V2]))]

Временный код:

set.seed(1L)
totletter <- 10
LLL <- LETTERS[1:totletter]
nID <- 1e5
neach <- 5
nnn <- rep(1:nID, each=neach)  # In my real problem each is not constant
myDT <- data.table(id=paste0("ID",nnn), group=sample(LLL,nID*neach,replace=T))

mtd0 <- function() myDT[,CJ( unique(group) ,LLL), by=id]

mtd1 <- function() {
    ug <- myDT[, unique(group), id]
    ug[, c(.SD, .(LLL=LLL)), seq_len(ug[, .N])][, (1) := NULL]
}

mtd2 <- function() {
    ug <- myDT[, unique(group), id]
    idx <- CJ(ug[,seq_len(.N)], seq_along(LLL))
    ug[idx$V1, c(.SD, .(LLL=LLL[idx$V2]))]
}    

combi <- mtd0()
setorder(combi, id, V1, LLL)
ans1 <- mtd1()
setorder(ans1, id, V1, LLL)
ans2 <- mtd2()
setorder(ans2, id, V1, LLL)
identical(combi, ans1)
# [1] TRUE
identical(ans1, ans2)
# [1] TRUE

bench::mark(mtd0(), mtd1(), mtd2(), check=FALSE)

Время:

# A tibble: 3 x 13
  expression      min   median `itr/sec` mem_alloc `gc/sec` n_itr  n_gc total_time result                   memory                 time     gc              
  <bch:expr> <bch:tm> <bch:tm>     <dbl> <bch:byt>    <dbl> <int> <dbl>   <bch:tm> <list>                   <list>                 <list>   <list>          
1 mtd0()        1.14m    1.14m    0.0146    1.84GB    0.583     1    40      1.14m <df[,3] [4,094,950 x 3]> <df[,3] [522,766 x 3]> <bch:tm> <tibble [1 x 3]>
2 mtd1()        1.67s    1.67s    0.600   265.05MB    1.80      1     3      1.67s <df[,3] [4,094,950 x 3]> <df[,3] [1,753 x 3]>   <bch:tm> <tibble [1 x 3]>
3 mtd2()     926.29ms 926.29ms    1.08    257.22MB    1.08      1     1   926.29ms <df[,3] [4,094,950 x 3]> <df[,3] [23,859 x 3]>  <bch:tm> <tibble [1 x 3]>

Справка:

Перекрестное соединение двух таблиц данных: https://github.com/ Rdatatable / data.table / issues / 1717 # issuecomment-515002560

Отредактируйте, чтобы адресовать комментарий OP:

На самом деле, помимо использования памяти методом OP, я думаю, что использование by замедляет работу, как видно из эмпирических таймингов ниже:

set.seed(1L)
totletter <- 10
LLL <- LETTERS[1:totletter]
nID <- 1e5
neach <- 5
nnn <- rep(1:nID, each=neach)  # In my real problem each is not constant
myDT <- data.table(id=paste0("ID",nnn), group=sample(LLL,nID*neach,replace=T))

mtd00 <- function() myDT[,CJ(unique(group), LLL), by=id]
mtd01 <- function() myDT[,CJ(group, LLL, unique=TRUE), by=id]
mtd02 <- function() myDT[, .(group=unique(group)), id][, CJ(group ,LLL), by=id]

mtd1 <- function() {
    ug <- myDT[, unique(group), id]
    ug[, c(.SD, .(LLL=LLL)), seq_len(ug[, .N])][, (1) := NULL]
}

mtd2 <- function() {
    ug <- myDT[, unique(group), id]
    idx <- CJ(ug[,seq_len(.N)], seq_along(LLL))
    ug[idx$V1, c(.SD, .(LLL=LLL[idx$V2]))]
}

Тайминги :

# A tibble: 5 x 13
  expression      min   median `itr/sec` mem_alloc `gc/sec` n_itr  n_gc total_time result                   memory                 time     gc              
  <bch:expr> <bch:tm> <bch:tm>     <dbl> <bch:byt>    <dbl> <int> <dbl>   <bch:tm> <list>                   <list>                 <list>   <list>          
1 mtd00()       1.16m    1.16m   0.0143     1.84GB    0.588     1    41      1.16m <df[,3] [4,094,950 x 3]> <df[,3] [515,150 x 3]> <bch:tm> <tibble [1 x 3]>
2 mtd01()       1.72m    1.72m   0.00969    1.85GB    0.427     1    44      1.72m <df[,3] [4,094,950 x 3]> <df[,3] [599,409 x 3]> <bch:tm> <tibble [1 x 3]>
3 mtd02()       1.05m    1.05m   0.0159     1.85GB    0.620     1    39      1.05m <df[,3] [4,094,950 x 3]> <df[,3] [528,108 x 3]> <bch:tm> <tibble [1 x 3]>
4 mtd1()        1.45s    1.45s   0.691    265.11MB    1.38      1     2      1.45s <df[,3] [4,094,950 x 3]> <df[,3] [4,130 x 3]>   <bch:tm> <tibble [1 x 3]>
5 mtd2()        1.11s    1.11s   0.900    257.38MB    1.80      1     2      1.11s <df[,3] [4,094,950 x 3]> <df[,3] [467 x 3]>     <bch:tm> <tibble [1 x 3]>

5

chinsoon12 25 Окт 2019 в 00:45

Question 2