Question

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

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

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

这是依赖exports.trip = async (options) => { try{ const result = await osrm.trip(options) return result; }catch(err){ throw err; } });的基本方式。

dist()

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

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笛卡尔联接，请参见此处： 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

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

2 个答案: