Эффективный метод преобразования множества диапазонов в кадре данных с частотой отдельных элементов?
Я работаю в R. У меня есть кадр данных, который содержит начальную и конечную позиции на хромосоме (где целое число представляет собой координату на хромосоме) Пример:
start end
1 5
3 7
4 10
12 7 (inverted is also allowed)
8 15
Я хочу, чтобы подсчитать, сколько раз координата присутствует во всех этих диапазонах. Итак, для приведенного выше примера выход будет следующим:
position count
1 1
2 1
3 2
4 3
5 3
6 2
7 3
8 3
9 3
10 3
11 2
12 2
13 1
14 1
15 1
У меня есть 62000+ таких диапазонов, где каждый диапазон составляет не менее 1000 позиций. Я знаю, как сделать это преобразование, но я не знаю, как это сделать эффективно, то есть через пару секунд.
Текущий (неэффективный код)
positions <- c()
for(i in seq(nrow(a))){
positions <- c(positions, seq(a[i,3], a[i,4]))
}
table(positions)
"a" - это мой кадр данных, а начальная и конечная координаты находятся в третьем и четвертом столбцах соответственно.
Один из столбцов в кадре данных содержит символы, поэтому для использования apply мне нужно было бы создать новый кадр данных (потребляя лишнее пространство) или потребоваться преобразовать в целые числа внутри функции apply (дополнительно время). Извините, за то, что вы не сообщили об этом раньше.
Ответы
Ответ 1
Для очень быстрого кода с data.table см. ответ от docendo discimus
(+ ориентир)
Вот пример некоторых других решений:
set.seed(42)
N <- 1000
df <- data.frame(start=sample.int(10*N, N))
df$end <- df$start + sample(3:20, N, rep=TRUE)
library("microbenchmark")
microbenchmark(unit = "relative",
ori = { positions <- c()
for(i in seq(nrow(df))){
positions <- c(positions, seq(df[i,1], df[i,2]))
}
table(positions) },
a = table(unlist(apply(df, 1, function(x) x[1]:x[2]))), # my solution, similar: KenS, EricSchutte
m1 = table(unlist(mapply(seq, df$start, df$end))), # my variant of Sotos' solution
m2 = table(unlist(mapply(':', df$start, df$end))), # my variant of Sotos' solution
M1 = table(unlist(Map(seq, df$start, df$end))), # my variant of Sotos' solution
M2 = table(unlist(Map(':', df$start, df$end))), # Sotos
l = table(unlist(lapply(seq_len(nrow(df)), function(i) seq(df$start[i], df$end[i])))), # lmo
t = { temp <- unlist(lapply(seq_len(nrow(df)), function(i) seq(df$start[i], df$end[i]))) # lmo tabulate()
cbind(sort(unique(temp)), tabulate(temp)) },
d = table(do.call(c, mapply(seq, df$start, df$end))), # @989 (comment to the answer from Sotos)
dd = table(do.call(c, mapply(seq.int, df$start, df$end))), # docendo discimus (comment to this answer)
f = { pos <- data.frame(x=(min(df):max(df)),n=0) # Andrew Gustar
for(i in seq_along(df$start)){
low=min(df$start[i])-pos$x[1]+1
high=max(df$end[i])-pos$x[1]+1
pos$n[low:high] <- pos$n[low:high]+1
} }
)
# Unit: relative
# expr min lq mean median uq max neval cld
# ori 7.163767 7.219099 7.573688 7.379160 7.912435 7.899586 100 e
# a 1.194627 1.194855 1.211432 1.209485 1.213118 1.711994 100 a
# m1 1.645659 1.660294 1.711141 1.686973 1.710461 2.217141 100 b
# m2 1.005302 1.007125 1.017115 1.009618 1.017207 1.576201 100 a
# M1 1.642688 1.645174 1.733173 1.673924 1.686253 2.218028 100 b
# M2 1.000000 1.000000 1.000000 1.000000 1.000000 1.000000 100 a
# l 3.487924 3.512732 3.801530 3.665725 4.188701 4.216375 100 d
# t 2.670636 2.711345 2.961449 2.869190 3.066150 3.745984 100 c
# d 1.652376 1.650798 1.721377 1.665901 1.712064 2.187129 100 b
# dd 1.040941 1.045652 1.060601 1.047534 1.053305 1.592163 100 a
# f 8.287098 8.486854 9.052884 9.046376 9.126318 25.210722 100 f
Решение с tabulate() выдает предупреждения.
Ответ 2
Одна идея,
as.data.frame(table(unlist(Map(`:`, df$start, df$end))))
# Var1 Freq
#1 1 1
#2 2 1
#3 3 2
#4 4 3
#5 5 3
#6 6 2
#7 7 3
#8 8 3
#9 9 3
#10 10 3
#11 11 2
#12 12 2
#13 13 1
#14 14 1
#15 15 1
Ответ 3
Это примерно тот же алгоритм, который вы используете, но должен быть быстрее.
myNums <- unlist(lapply(seq_len(nrow(df)), function(i) seq(df$start[i], df$end[i])))
table(myNums)
myNums
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
1 1 2 3 3 2 3 3 3 3 2 2 1 1 1
Еще более быстрый метод заключается в использовании tabulate, а не table. Например,
temp <- unlist(lapply(seq_len(nrow(df)), function(i) seq(df$start[i], df$end[i])))
cbind(sort(unique(temp)), tabulate(temp))
который возвращает матрицу
[,1] [,2]
[1,] 1 1
[2,] 2 1
[3,] 3 2
[4,] 4 3
[5,] 5 3
[6,] 6 2
[7,] 7 3
[8,] 8 3
[9,] 9 3
[10,] 10 3
[11,] 11 2
[12,] 12 2
[13,] 13 1
[14,] 14 1
[15,] 15 1
работает на 50% быстрее для данного набора данных.
Unit: microseconds
expr min lq mean median uq max neval cld
table 223.233 237.6305 250.0329 245.8985 253.4545 423.944 100 b
tabulate 142.835 159.0860 166.9775 167.3540 175.7650 195.009 100 a
Ответ 4
Я предлагаю решение data.table, так как мы заинтересованы в производительности. Подход выглядит следующим образом:
library(data.table)
setDT(df)
df[, list(seq.int(start, end)), by = 1:nrow(df)][, .N, by = V1]
И он работает очень хорошо по сравнению с другими решениями, несмотря на операцию по строке.
Здесь находится эталон для строк 1e4:
set.seed(42)
N <- 1e4
vals = 1:100
df <- data.frame(start=sample(vals, N, replace = TRUE), end = sample(vals, N, replace = TRUE))
library(data.table)
library("microbenchmark")
dt <- copy(df)
setDT(dt)
microbenchmark(unit = "relative", times = 10,
jogo = table(unlist(Map(seq, df$start, df$end))), # jogo
sotos = table(unlist(Map(':', df$start, df$end))), # Sotos
lmo = table(unlist(lapply(seq_len(nrow(df)), function(i) seq(df$start[i], df$end[i])))), # lmo
orig_989 = table(do.call(c, mapply(seq, df$start, df$end))), # @989 (comment to the answer from Sotos)
mod_989 = table(do.call(c, mapply(seq.int, df$start, df$end))), # docendo discimus (comment to this answer)
dd = dt[, list(seq.int(start, end)), by = 1:nrow(dt)][, .N, by = V1]
)
Unit: relative
expr min lq mean median uq max neval cld
jogo 8.794179 8.735461 19.226146 8.584978 8.637774 52.782168 10 ab
sotos 10.669810 10.623685 8.984351 10.437937 10.164045 4.846189 10 ab
lmo 21.319154 21.117393 27.452902 22.558436 22.913901 43.403024 10 b
orig_989 9.190209 8.725191 7.532509 8.730023 8.516305 3.948500 10 ab
mod_989 5.372087 5.097636 5.067462 5.305532 6.214493 3.188091 10 ab
dd 1.000000 1.000000 1.000000 1.000000 1.000000 1.000000 10 a
Ответ 5
Я создаю последовательность для каждой строки в df, например. c(1,2,3,4,5) для первой строки. используя:
all.pos <- apply(df, 1, function(x){x[1]:x[2]})
all.pos <- unlist(all.pos)
# 1 2 3 4 5 3 4 5 6 7 4 5 6 7 8 9 10 12 11 10 9 8 7 8 9
# 10 11 12 13 14 15
Таблица подсчитывает, как часто каждая позиция возникает в all.pos.
table(all.pos)
# 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
# 1 1 2 3 3 2 3 3 3 3 2 2 1 1 1
Ответ 6
Другой подход, избегая table, перебирая диапазоны и добавляя 1 к соответствующим значениям каждый раз...
ranges <- data.frame(start=c(1,3,4,12,8), end=c(5,7,10,7,15) )
pos <- data.frame(x=(min(ranges):max(ranges)),n=0)
for(i in seq_along(ranges$start)){
low=min(ranges$start[i])-pos$x[1]+1
high=max(ranges$end[i])-pos$x[1]+1
pos$n[low:high] <- pos$n[low:high]+1
}
pos
x n
1 1 1
2 2 1
3 3 2
4 4 3
5 5 3
6 6 2
7 7 3
8 8 3
9 9 3
10 10 3
11 11 2
12 12 2
13 13 1
14 14 1
15 15 1
Ответ 7
Первое, что придумало, может быть не самым лучшим, но при использовании применения вещи должны значительно ускориться.
df <- data.frame(start=c(1,3,4,12,8), end=c(5,7,10,7,15) )
positions <- apply(df, 1, function (x) {
seq(x[1], x[2])
})
table(unlist(positions))
дает..
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
1 1 2 3 3 2 3 3 3 3 2 2 1 1 1
