计算数据框中组间最小距离的有效/最快方法

Question

我有一个数据框看起来像：

x y group
1 2  1 
1 3  1
1 4  2
1 5  2
1 6  3
...

对于每个组，我想找到与其“最近”组的距离。 这里，最近的定义为到该组的距离最短的组； 距离被定义为这两个组的所有成员之间的最短距离。 例如，组 1 中的所有成员与组 2 中的所有成员之间的距离为：

(1,2) -> (1,4) = 2
(1,2) -> (1,5) = 3
(1,3) -> (1,4) = 1
(1,3) -> (1,5) = 2

1 是最短的，因此组 1 和组 2 之间的距离为 1。同样的想法，组 1 内的所有成员与组内的所有成员之间的距离为：

(1,2) -> (1,6) = 4
(1,3) -> (1,6) = 3

因此第 1 组和第 3 组之间的距离为 3。由于 3 > 1，因此第 1 组的最近邻居是第 2 组，距离为 1。我想将此指标应用于一个非常大的数据集，并且我能够使用嵌套 for 循环实现这个想法，但显然它很慢。 有没有更快的解决方案？ 赞赏！

Answer 1

这是一种循环遍历成对组但至少在成对内向量化的方法：

d <- data.frame(x = 1L, y = 2:6, group = c(1L, 1L, 2L, 2L, 3L))
m <- do.call(rbind, d[c("x", "y")])
l <- lapply(split(seq_len(ncol(m)), d$group), function(j) m[, j, drop = FALSE])
rm(m); gc()

distance <- function(x, y) {
    j <- rep(seq_len(ncol(x)), each = ncol(y))
    min(sqrt(colSums((x[, j, drop = FALSE] - as.vector(y))^2)))
}

D <- outer(l, l, Vectorize(distance))
D
##   1 2 3
## 1 0 1 3
## 2 1 0 1
## 3 3 1 0

不过，我会避免使用outer ，因为它没有利用距离 function 的属性，即distance(x, x) == 0和distance(x, y) == distance(y, x) for all组x和y 。 为了更有效地获得outer结果，我会这样做：

D <- matrix(0, length(l), length(l))
D[lower.tri(D)] <- combn(length(l), 2L, function(i) distance(l[[i[1L]]], l[[i[2L]]]))
D <- D + t(D)
D
##      [,1] [,2] [,3]
## [1,]    0    1    3
## [2,]    1    0    1
## [3,]    3    1    0

Answer 2

您可以使用stats::dist()计算每对x和y点之间的距离。 使用 {broom} 和 {dplyr} 对结果进行一些操作后，您可以找到每对groups内的最小距离。

library(dplyr)
library(broom)

df <- data.frame(
  x = rep(1, 5),
  y = 2:6,
  group = c(1, 1, 2, 2, 3)
)

item_groups <- df %>% 
  transmute(item = factor(row_number()), group)

dist(df[c("x", "y")]) %>% 
  broom::tidy() %>% 
  left_join(item_groups, by = c("item1" = "item")) %>% 
  left_join(item_groups, by = c("item2" = "item"), suffix = c(".1", ".2")) %>% 
  group_by(group.1, group.2) %>% 
  filter(group.1 != group.2, distance == min(distance))

#> # A tibble: 3 x 5
#> # Groups:   group.1, group.2 [3]
#>   item1 item2 distance group.1 group.2
#>   <fct> <fct>    <dbl>   <dbl>   <dbl>
#> 1 2     3            1       1       2
#> 2 2     5            3       1       3
#> 3 4     5            1       2       3

^{由reprex package (v2.0.1) 创建于 2022-03-01}

Answer 3

这有帮助吗？

library(tidyverse)
data <- tribble(
      ~x, ~y, ~group,
      1,2, 1,
      1,3, 1,
      1,4, 2,
      1,5, 2,
      1,6, 3
    )
    data %>% 
      mutate(sum_of_x_y = x+y) %>% 
      group_by(group)%>% 
      summarize(min_group =  min(sum_of_x_y))

# group min_group
# <dbl> <dbl>
# 1 3           
# 2 5           
# 3 7   

Answer 4

这是另一种方式

g = length(unique(df$grp))

matrix(
  df[, `:=`(con = 1)][df,allow.cartesian=T,on="con"] %>% 
  .[,dist:=sqrt((x-i.x)^2 + (y-i.y)^2)] %>% 
  .[, min(dist), by=.(grp,i.grp)] %>% 
  .[order(grp, i.grp),V1],g,g)

Output：

     [,1] [,2] [,3]
[1,]    0    1    3
[2,]    1    0    1
[3,]    3    1    0

如果你有太多的点来做完整的笛卡尔连接，你可以这样做，你为每一对做：

df[,con:=1]

func <- function(df) {
  df[df,allow.cartesian=T,on="con"] %>% 
    .[,dist:=sqrt((x-i.x)^2 + (y-i.y)^2)] %>% 
    .[grp!=i.grp, min(dist), by=.(grp,i.grp)][1,V1]
}

grps = unique(df$grp)
vals = apply(combn(grps,2), 2, \(p) func(df[grp %in% p]))
M = matrix(0, length(grps),length(grps))
M[lower.tri(M)] <- vals
M[upper.tri(M)] <- vals

     [,1] [,2] [,3]
[1,]    0    1    3
[2,]    1    0    1
[3,]    3    1    0