R按重叠范围分组答案

【问题标题】：R group by overlapping rangesR按重叠范围分组
【发布时间】：2021-01-27 15:49:54
【问题描述】：

我有一个数据框，其中行包含范围。我想确定范围组，其中每个范围与组中至少一个其他行重叠超过 75%。分组应作为索引变量添加到原始数据中。

示例数据如下：

df <- data.frame(label = c("A", "B", "C", "D", "E", "F"),
                 start = c(16, 18, 37, 62, 15, 45),
                 stop = c(22, 24, 55, 66, 23, 55))

生成的 df 应如下所示：

label       start   stop   ID
"A"         6       22     1
"B"         6       24     1
"C"         37      55     2
"D"         62      66     3
"E"         15      23     1
"F"         45      55     2

首先我尝试了dplyr 选项与mutate 和lag，但随后分组取决于行的顺序并且不适用于所有情况。接下来我尝试使用seq_along 进行for 循环，但我无法解决问题。希望你们中的一个可以...

【问题讨论】：

您对 75% 的比较是有方向的。例如，考虑范围 1-4 和 2-9。第一个与第二个共享其范围的 75%，但第二个没有回报。查看您的数据，"E" (15-23) 与 "A" 重叠 7/8 或 87.5%，但 "A" 与 "E" 重叠仅 7/16 或 43.75%。
没错，我想使用最高百分比作为分组标准。在这种情况下，与另一个范围重叠 >75% 的范围将最终在同一组中。所以在A 和E 的例子中，它们应该被组合在一起。

标签： r range grouping overlap

【解决方案1】：

overlap <- function(A, B) {
  shared <- pmax(0, min(A[2], B[2]) - max(A[1], B[1]))
  max(shared / c(diff(A), diff(B)))
}

eg <- expand.grid(a = seq_len(nrow(df)), b = seq_len(nrow(df)))
eg <- eg[eg$a < eg$b,]

together <- cbind(
  setNames(df[eg$a,], paste0(names(df), "1")),
  setNames(df[eg$b,], paste0(names(df), "2"))
)
together <- within(together, {
  shared  = pmax(0, pmin(stop1, stop2) - pmax(start1, start2))
  overlap = pmax(shared / (stop1 - start1), shared / (stop2 - start2))
})[, c("label1", "label2", "overlap")]

bigenough <- together[together$overlap >= 0.75,]
groups <- split(bigenough$label2, bigenough$label1)

for (ltr in df$label) {
  ind <- (ltr == names(groups)) | sapply(groups, `%in%`, x = ltr)
  groups <- c(
    setNames(list(unique(c(ltr, names(groups[ind]), unlist(groups[ind])))), ltr),
    groups[!ind]
  )
}

groups <- data.frame(
  ID = rep(seq_along(groups), lengths(groups)),
  label = unlist(groups)
)

结果：

merge(df, groups, by = "label")
#   label start stop ID
# 1     A    16   22  2
# 2     B    18   24  2
# 3     C    37   55  1
# 4     D    62   66  3
# 5     E    15   23  2
# 6     F    45   55  1

您要求一种不使用for 循环的方法。由于我们需要一次迭代（循环）来处理上一次迭代的结果，lapply 对我们不起作用。但是，我们可以使用Reduce：

# groups <- split(...)

groups <- Reduce(function(grps, ltr) {
  ind <- (ltr == names(grps)) | sapply(grps, `%in%`, x = ltr)
  c(setNames(list(unique(c(ltr, names(grps[ind]), unlist(grps[ind])))), ltr),
    grps[!ind])
}, df$label, init = groups)
# $F
# [1] "F" "C"
# $E
# [1] "E" "B" "A"
# $D
# [1] "D"

# groups <- data.frame(ID = ...)
# merge(df, groups, ...)

（然后是上面的最后一个groups <- data.frame(..) 调用）。这同样有效。唯一的问题是 Reduce 是使用 for (https://github.com/wch/r-source/blob/d22ee2fc0dc8142b23eed9f46edf76ea9d3ca69a/src/library/base/R/funprog.R) :-)

【讨论】：

非常感谢！您对我如何调整此代码以在 for 循环中运行它有什么建议吗？如果我现在尝试，它会给出 Error in (ltr == names(groups)) | sapply(groups, `%in%`, x = ltr) : operations are possible only for numeric, logical or complex types 错误。
查看我的编辑，一种用Reduce 替换我的for 循环的方法，Reduce 是类似于lapply 的函数式编程工具之一。