Как условно подвести итоги по другим записям в группе - R - PullRequest
Новая
       29

Как условно подвести итоги по другим записям в группе - R

1 голос
/ 11 мая 2019

В моем наборе данных у меня есть декартовы координаты различных элементов сверхурочных, идентифицированных с помощью EventID, event_type, идентификационного номера, позиции x, y позиции, типа идентификации, широкой категории и номера идентификатора кадра. Что мне нужно сделать, так это пройти по каждому идентификатору EventID, паре event_type и номеру кадра, пройти через каждый номер идентификатора и вычислить, какой другой номер идентификатора с другой широкой категорией имеет минимальное расстояние от текущей строки. Я бы не хотел использовать для этого циклы 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

Ожидаемый результат вернет 5.992303 для строки 1, он ищет все записи, не принадлежащие set1 с одинаковыми EventID, event_type и frame_id, а затем возвращает минимальное евклидово расстояние с учетом этих параметров.

Кроме того, я хочу сделать это для каждой записи с типом идентификации A. Но, identity_type и broad_category не всегда связаны друг с другом. A может принадлежать либо set1, либо set2.

1 Ответ

0 голосов
/ 11 мая 2019

Хотя я не уверен в ваших критериях, похоже, что вы ДОЛЖНЫ использовать циклы 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
...