我有一個資料框看起來像：
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回圈來實作這個想法，但顯然它很慢。有沒有更快的解決方案？贊賞！
uj5u.com熱心網友回復：
這是一種在成對的組上回圈但至少在成對內矢量化的方法：
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，因為它沒有利用距離函式的屬性，即distance(x, x) == 0和distance(x, y) == distance(y, x)對于所有組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
uj5u.com熱心網友回復：
您可以使用 計算每對x,y點之間的距離stats::dist()。使用 {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 包創建于 2022-03-01 (v2.0.1)
uj5u.com熱心網友回復：
這有幫助嗎？
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
uj5u.com熱心網友回復：
這是另一種方式
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)
輸出：
[,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
轉載請註明出處，本文鏈接：https://www.uj5u.com/net/436048.html
上一篇：你如何通過增加奇數進行迭代？