我需要将重叠的细分汇总为一个所有关联细分的细分。
请注意,简单的脚手架无法检测非重叠但相连的线段之间的连接,有关说明请参见示例。如果要在我的地块上下雨,我正在寻找干燥的地面。
到目前为止,我已经通过迭代算法解决了这个问题,但是我想知道是否有更优雅,更直接的方法解决这个问题。我敢肯定不是第一个面对它的人。
我当时正在考虑进行非等价的滚动联接,但是未能实现
library(data.table)
(x <- data.table(start = c(41,43,43,47,47,48,51,52,54,55,57,59),
end = c(42,44,45,53,48,50,52,55,57,56,58,60)))
# start end
# 1: 41 42
# 2: 43 44
# 3: 43 45
# 4: 47 53
# 5: 47 48
# 6: 48 50
# 7: 51 52
# 8: 52 55
# 9: 54 57
# 10: 55 56
# 11: 57 58
# 12: 59 60
setorder(x, start)[, i := .I] # i is just a helper for plotting segments
plot(NA, xlim = range(x[,.(start,end)]), ylim = rev(range(x$i)))
do.call(segments, list(x$start, x$i, x$end, x$i))
x$grp <- c(1,3,3,2,2,2,2,2,2,2,2,4) # the grouping I am looking for
do.call(segments, list(x$start, x$i, x$end, x$i, col = x$grp))
(y <- x[, .(start = min(start), end = max(end)), k=grp])
# grp start end
# 1: 1 41 42
# 2: 2 47 58
# 3: 3 43 45
# 4: 4 59 60
do.call(segments, list(y$start, 12.2, y$end, 12.2, col = 1:4, lwd = 3))
编辑:
这真是太好了,谢谢,cummax和cumsum可以完成这项工作,Uwe's Answer比Davids的评论要好。
end[.N]
可能得到错误的结果,请尝试以下示例数据x
。
max(end)
在所有情况下都是正确的,而且速度更快。
x <- data.table(start = c(11866, 12696, 13813, 14011, 14041),
end = c(13140, 14045, 14051, 14039, 14045))
min(start)
和start[1L]
给出的结果相同(因为x
是按开始顺序排序的),后者更快。cumsum(cummax(shift(end, fill = 0)) < start)
比cumsum(c(0, start[-1L] > cummax(head(end, -1L))))
快得多。答案 0 :(得分:6)
OP要求将重叠的段汇总为一个包含所有连接段的段。
这是另一种使用cummax()
和cumsum()
来标识重叠或相邻段的组的解决方案:
x[order(start, end), grp := cumsum(cummax(shift(end, fill = 0)) < start)][
, .(start = min(start), end = max(end)), by = grp]
grp start end 1: 1 41 42 2: 2 43 45 3: 3 47 58 4: 4 59 60
免责声明:我在SO的其他地方看到过这种聪明的方法,但我不记得确切的位置。
修改:
与David Arenburg has pointed out一样,不必单独创建grp
变量。可以在by =
参数中即时完成此操作:
x[order(start, end), .(start = min(start), end = max(end)),
by = .(grp = cumsum(cummax(shift(end, fill = 0)) < start))]
可以修改OP的图以显示汇总的段(快速段和脏段):
plot(NA, xlim = range(x[,.(start,end)]), ylim = rev(range(x$i)))
do.call(segments, list(x$start, x$i, x$end, x$i))
x[order(start, end), .(start = min(start), end = max(end)),
by = .(grp = cumsum(cummax(shift(end, fill = 0)) < start))][
, segments(start, grp + 0.5, end, grp + 0.5, "red", , 4)]
答案 1 :(得分:5)
您可以尝试使用GenomicRanges
方法。在输出中,每一行都是一个组。
library(GenomicRanges)
x_gr <- with(x, GRanges(1, IRanges(start, end)))
as.data.table(reduce(x_gr, min.gapwidth=0))[,2:3]
start end
1: 41 42
2: 43 45
3: 47 58
4: 59 60
可以使用Gviz
进行视觉检查。在这里,人们必须知道该软件包是为生物学家和遗传信息构建的。后面的图案是DNA碱基。因此,必须减去段末端的1以获得正确的图。
library(Gviz)
ga <- Gviz::GenomeAxisTrack()
xgr <- with(x, GRanges(1, IRanges(start, end = end - 1)))
xgr_red <- reduce(xgr, min.gapwidth=1)
ga <- GenomeAxisTrack()
GT <- lapply(xgr, GeneRegionTrack)
GT_red <- lapply(xgr_red, GeneRegionTrack, fill = "lightblue")
plotTracks(c(ga, GT, GT_red),from = min(x$start), to = max(x$start)+2)