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

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

1 голос
/ 24 октября 2019

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

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

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. (Мне нужно это за 1M).

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

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

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

1 Ответ

4 голосов
/ 24 октября 2019

Я думаю, что разумный вопрос - что вы собираетесь делать с таким большим количеством комбинаций? В любом случае здесь есть 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]>

Ссылка:

Перекрестное объединение 2 data.tables: 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]>
...