如何有条件地总结组中的其他条目 - R

Question

在我的数据集中，我有不同项目超时的笛卡尔坐标，由 EventID、event_type、ID 号、x 位置、y 位置、身份类型、广泛类别和框架 ID 号标识。我需要做的是为每个 EventID、event_type 对和框架 ID 号遍历每个 ID 号并计算具有不同广泛类别的其他 ID 号与当前行的最小距离。我想避免为此使用 for 循环，因为数据集有几百万行。

我尝试将其公式化为 group_by 并使用 dplyr 汇总调用，但无法完全理解如何在当前行 x 上调用函数，y 对所有其他 x 和 ys 调用，然后选择条件最低限度。

two_dim_euclid = function(x1, x2, y1, y2){
  a <- sqrt((x1 - x2)^2 + (y1 - y2)^2)
  return(a)
}


# Example Data
df <- data.frame(stringsAsFactors = FALSE,
                 EventID = c(1003, 1003, 1003, 1003),
                 event_type = c(893, 893, 893, 893),
                 ID_number = c(80427, 2346, 24954, 27765),
                 x = c(86.07, 72.4, 43.08, 80.13),
                 y = c(35.58, 26.43, 34.8, 34.79),
                 identity_type = c("A", "C", "B", "B"),
                 broad_category = c("set1", "set1", "set2", "set2"),
                 frame_id = c(1, 1, 1, 1))
df
#  EventID event_type ID_number x     y     identity_type broad_category frame_id
#1 1003    893        80427     86.07 35.58 A             set1           1
#2 1003    893        2346      72.40 26.43 C             set1           1
#3 1003    893        24954     43.08 34.80 B             set2           1
#4 1003    893        27765     80.13 34.79 B             set2           1

对于第 1 行，预期结果将返回 5.992303，它会查找所有不属于 set1 且具有相同 EventID、event_type 和 frame_id 的条目，然后返回给定这些参数的最小欧几里得距离。

另外，我想对每个身份类型为 A 的条目执行此操作。但是，identity_type 和 broad_category 并不总是捆绑在一起。 A 可以属于 set1 或 set2。

Answer 1

这是一个依赖dist() 的基本方法。

res <- as.matrix(dist(cbind(df$x, df$y)))
res[res == 0] <- Inf

apply(res, 1, min)

        1         2         3         4 
 5.992303 11.386066 30.491299  5.992303 

# or potentially  more performant
res[cbind(seq_len(nrow(res)), max.col(-res))]

[1]  5.992303 11.386066 30.491299  5.992303

data.table 的一种潜在方法是进行笛卡尔连接，但它需要大量内存并且可能会更慢：

library(data.table)
dt <- as.data.table(df)
dt[, ID := .I]

CJ.dt = function(X,Y) {
  stopifnot(is.data.table(X),is.data.table(Y))
  k = NULL
  X = X[, c(k=1, .SD)]
  setkey(X, k)
  Y = Y[, c(k=1, .SD)]
  setkey(Y, NULL)
  X[Y, allow.cartesian=TRUE][, k := NULL][]
}
CJ.dt(dt, dt)[ID != i.ID, min(sqrt((x - i.x)^2 + (y-i.y)^2)), by = i.ID]

   i.ID        V1
1:    1  5.992303
2:    2 11.386066
3:    3 30.491299
4:    4  5.992303

对于 data.table 笛卡尔连接，请参见此处： R: data.table cross-join not working

Answer 2

虽然我不确定您的标准，但如果您想迭代，似乎必须以某种方式使用 for 循环。我相信其他人可以为您提供非常快速的 Rcpp 解决方案。同时，这里有一种可能的方式与基础 R。

# In the future, please provide the code to create your example data
dat <- structure(list(EventID = c(1003L, 1003L, 1003L, 1003L), 
                  event_type = c(893L, 893L, 893L, 893L), 
                  ID_number = c(80427L, 2346L, 24954L, 27765L), 
                  x = c(86.07, 72.4, 43.08, 80.13), 
                  y = c(35.58, 26.43, 34.8, 34.79), 
                  identity_type = structure(c(1L, 3L, 2L, 2L), 
                                            .Label = c("A", "B", "C"), 
                                            class = "factor"), 
                  broad_category = structure(c(1L,  1L, 2L, 2L), 
                                             .Label = c("set1", "set2"), 
                                             class = "factor"), 
                  frame_id = c(1L,  1L, 1L, 1L)), 
             .Names = c("EventID", "event_type", "ID_number","x", "y", 
                        "identity_type", "broad_category", "frame_id"), 
             class = "data.frame", row.names = c("1", "2", "3", "4"))

# Define your criteria here
dat$uniqueID <- paste0(dat$EventID, dat$event_type, dat$frame_id, dat$broad_category)
# made your function have two 2 dim vectors instead since that's simpler for passing in
two_dim_euclid = function(a, b) return(sqrt((a[1] - b[1])^2 + (a[2] - b[2])^2))

n <- nrow(dat)
vec <- numeric(n)
for(i in 1:n){
  vec[i] = sum(apply(dat[dat$uniqueID != dat$uniqueID[i], c("x","y")], 1, 
                     function(r) two_dim_euclid(dat[i,c("x","y")], r)), na.rm = T)
  if(i%%10000 == 0) cat(i,"completed...\n") # Progress check since >1mil rows
}
dat$result <- vec