Более эффективное объединение памяти в R

Question

Рассмотрим следующее data.tables. Первый представляет собой набор сегментов с начальными и конечными координатами для каждой группы "chr":

    library(data.table)
    set.seed(1L)
    n = 20e5L; k = 100e3L
    idx1 = sample(n, 5000, TRUE)
    idx2 = sample(n, 5000, TRUE)

    d1 = unique(data.table(chr = sample(c(1:22), n, TRUE), 
                    segment.start = pmin(idx1, idx2), 
                    segment.end = pmax(idx1, idx2)))
    setkey(d1, chr, segment.start, segment.end)

#   chr segment.start segment.end
#    1           213     1073538
#    1           242     1571071
#    1           401      270962
#    1          1142      832856
#    1          1211     1906488
#    1          1313      609844

Второй набор данных имеет одинаковую переменную группировки "chr" и позиции "pos" в каждой группе:

    d2 = unique(data.table(chr = sample(c(1:22), k, TRUE), 
                           pos = sample(n, k, TRUE)))
    d2[, pos2 := pos]
    setkey(d2, chr, pos, pos2)

#  chr  pos pos2
#    1  774  774
#    1  870  870
#    1 1312 1312
#    1 2256 2256
#    1 2611 2611
#    1 2727 2727

В настоящее время я использую data.table :: foverlaps , чтобы получить количество начальных / конечных сегментов в d1, которые перекрываются с "pos" в d2 по группе "chr":

    outdf <- foverlaps(d2, d1) [, .(count = sum(!is.na(segment.start))), by = .(chr,pos, pos2) ][, pos2 := NULL ]

#  chr  pos count
#    1  774     3
#    1  870     3
#    1 1312     5
#    1 2256    11
#    1 2611    14
#    1 2727    16

Если посмотреть на вывод Profvis , использование памяти для этого примера набора данных достигает пика около 9,5 ГБ, а на фактических наборах данных, с которыми я работаю, - память использование достигает пика около 85 ГБ.

Кто-нибудь знает более эффективный способ памяти для получения желаемого результата без существенного увеличения времени выполнения?

Answer 1

Вы можете попробовать что-нибудь подобное, как показано ниже ...

Но у меня недостаточно опыта с profvis() для интерпретации результатов. Хотя это быстрее ...

d2[, N := d1[ d2, 
              on = .(chr, segment.start <= pos, segment.end >= pos), 
              .N, 
              by=.EACHI, 
              allow.cartesian = TRUE]$N ]

бенчмаркинг

microbenchmark::microbenchmark(
  wimpel = {
    dt1 <- copy(d1)
    dt2 <- copy(d2)
    d2[, N := d1[ d2, 
                  on = .(chr, segment.start <= pos, segment.end >= pos), 
                  .N, 
                  by=.EACHI, 
                  allow.cartesian = TRUE]$N ]
    },
  your_solution = {
    dt1 <- copy(d1)
    dt2 <- copy(d2)
    outdf <- foverlaps(d2, d1)[, .(count = sum(!is.na(segment.start))), by = .(chr,pos, pos2) ][, pos2 := NULL ]
  },
  times = 3L
  )

# Unit: seconds
#          expr      min        lq     mean    median       uq       max neval
#        wimpel  7.62565  7.781653  7.96709  7.937655  8.13781  8.337965     3
# your_solution 13.89000 14.032308 14.09881 14.174619 14.20321 14.231810     3