Блог

Главная - Вопросы по программированию - Пересечение двух наборов координат для вычисления минимального расстояния? (tidyr geosphere R)

Пересечение двух наборов координат для вычисления минимального расстояния? (tidyr geosphere R)

#r #matrix #dplyr #tidyr #geosphere

#r #матрица #dplyr #tidyr #геосфера

Вопрос:

У меня есть набор из 2220 гнездовых координат (var1) и другой набор из 26 ориентиров (var2) в той же ограниченной области. Я хочу найти расстояние между каждой из 2224 координат до каждой точки в наборе из 26, чтобы создать новый фрейм данных со столбцами (координаты гнезда, координата ориентира минимального расстояния, расстояние в метрах).

Я застрял, пытаясь пересечь два набора, чтобы создать набор, в котором все координаты ориентира сопоставлены с каждой из координат гнезда.

 **nest**                **landmark**         **distance**

lat1, lon1              lat1, lon1            34
lat1, lon1              lat2, lon2            18
lat1, lon1              lat3, lon3            82
....
lat1, lon1              lat26,lon26           61
lat2, lon2              lat1, lon1            94
lat2, lon2              lat2, lon2            38
...
lat2,220, lon 2,220     lat 26,lon26          46

Я попытался пересечь (var1, var2), где var1 и var2 — это обе матрицы, содержащие значения широты и длины, а затем вычислить расстояние между каждой результирующей строкой (см. Ниже). Кажется, это работает, но я не думаю, что это дает мне точный результат, который я ожидаю. Количество результирующих строк от пересечения не согласуется с произведением числа этих наборов.

Я также хочу иметь возможность разделить результирующий набор со всеми значениями расстояния на группы по 26, где каждая группа содержит координаты гнезда (повторяющиеся для каждой строки), одну из 26 координат ориентира и расстояние между двумя точками. Оттуда я выберу строку с минимальным расстоянием.

 newset <- crossing(nests, landmarks)
mindist <- distHaversine(newset[1], newset[2], r=6378137)
newsetwdist <- cbind(newset, mindist)

sv <- split(newsetwdist,rep(1:56056,each=26))
#56056 was the resulting number of rows, even though I expected 57,720.

var3 <- lapply(sv, "[", 3) #returns a nested list of all distances for each nest
var4 <- lapply(var2, "[[", "mindist")

df = as.data.frame(do.call(rbind, lapply(var4, unlist)))
min.dist.from.landmark <- apply(df, 1, FUN=min)

Похоже, это должно быть легко исправить, любая помощь будет оценена.

Комментарии:

1. Пожалуйста, предоставьте образцы ваших данных, используя dput()

2. @rjen это сработало и намного быстрее, чем мое решение, спасибо!

Ответ №1:

Используя данные и формат данных, которые я создал для этого случая, вы можете сделать следующее.

 library(dplyr)
library(purrr)
library(tidyr)
library(geosphere)

crossing(nest, landmark) %>%
  mutate(nest_long_lat = map2(nest_long, nest_lat, ~ c(.x, .y)),
         mark_long_lat = map2(mark_long, mark_lat, ~ c(.x, .y)),
         distance = unlist(map2(mark_long_lat, nest_long_lat, ~ distGeo(.x, .y)))) %>%
  group_by(nest_long_lat) %>%
  mutate(min_distance = distance == min(distance)) %>%
  ungroup() %>%
  select(-nest_long_lat, -mark_long_lat)

# # A tibble: 57,720 x 6
#          nest_lat nest_long mark_lat mark_long distance min_distance
#          <dbl>    <dbl>     <dbl>    <dbl>     <dbl>    <lgl>       
# 1        46.5      49.1     48.4      49.8     215350.  TRUE        
# 2        46.5      49.1     48.6      48.7     229592.  FALSE       
# 3        46.5      49.1     48.8      49.9     255689.  FALSE       
# 4        46.5      49.1     48.9      48.4     268789.  FALSE       
# 5        46.5      49.1     49.3      50.1     312691.  FALSE       
# 6        46.5      49.1     49.3      49.2     309549.  FALSE       
# 7        46.5      49.1     49.6      51.6     390862.  FALSE       
# 8        46.5      49.1     49.7      50.8     371686.  FALSE       
# 9        46.5      49.1     49.8      50.6     377182.  FALSE       
# 10       46.5      49.1     49.9      49.9     376530.  FALSE       
# # … with 57,710 more rows

Данные

 nest <- tibble(nest_lat = rnorm(50, n = 2220),
               nest_long = rnorm(50, n = 2220))

landmark <- tibble(mark_lat = rnorm(50, n = 26),
                   mark_long = rnorm(50, n = 26))