Данные реструктуризации для анализа географической близости в R

У меня есть набор данных географических координат людей, который выглядит следующим образом:

Person  Latitude    Longitude
  1     46.0614     -23.9386
  2     48.1792      63.1136
  3     59.9289      66.3883
  4     42.8167      58.3167
  5     43.1167      63.25

Я планирую рассчитать географическую близость на двоичном уровне, используя пакет geosphere в R. Для этого мне нужно создать набор данных, который выглядит следующим образом:

Person1 Person2 LatitudeP1  LongitudeP1 LatitudeP2  LongitudeP2
   1       2     46.0614    -23.9386     48.1792     63.1136
   1       3     46.0614    -23.9386     59.9289     66.3883
   1       4     46.0614    -23.9386     42.8167     58.3167
   1       5     46.0614    -23.9386     43.1167     63.25
   2       3     48.1792     63.1136     59.9289     66.3883
   2       4     48.1792     63.1136     42.8167     58.3167
   2       5     48.1792     63.1136     43.1167     63.25
   3       4     59.9289     66.3883     42.8167     58.3167
   3       5     59.9289     66.3883     43.1167     63.25
   4       5     42.8167     58.3167     43.1167     63.25

Таким образом, результирующие данные имеют строку для каждой возможной диады в наборе данных и включают в себя координаты обоих индивидов в диаде. "LatitudeP1" и "LongitudeP1" - это координаты "Person1" в диаде, а "LatitudeP2" и "LongitudeP2" - это координаты "Person2" в диаде. Кроме того, не имеет значения, какой идентификатор указан как Персона1 против Персоны2, так как географическое расстояние не является направленным отношением.

Источник

2 ответа

Решение

Просто беру возможные комбинации (combn) из Person 1–5, и поднабор широты / долготы из ваших исходных данных:

dat <- read.table(header = TRUE, text="Person  Latitude    Longitude
1     46.0614     -23.9386
2     48.1792      63.1136
3     59.9289      66.3883
4     42.8167      58.3167
5     43.1167      63.25")

tmp <- t(combn(nrow(dat),2))

#      [,1] [,2]
# [1,]    1    2
# [2,]    1    3
# [3,]    1    4
# [4,]    1    5
# [5,]    2    3
# [6,]    2    4
# [7,]    2    5
# [8,]    3    4
# [9,]    3    5
# [10,]    4    5

res <- cbind(tmp,
             do.call('cbind', lapply(1:2, function(x) 
               mapply(`[`, dat[, 2:3], MoreArgs = list(i=tmp[, x])))))
colnames(res) <- c('Person1','Person2','LatitudeP1','LongitudeP1',
                   'LatitudeP2','LongitudeP2')

data.frame(res)

#    Person1 Person2 LatitudeP1 LongitudeP1 LatitudeP2 LongitudeP2
# 1        1       2    46.0614    -23.9386    48.1792     63.1136
# 2        1       3    46.0614    -23.9386    59.9289     66.3883
# 3        1       4    46.0614    -23.9386    42.8167     58.3167
# 4        1       5    46.0614    -23.9386    43.1167     63.2500
# 5        2       3    48.1792     63.1136    59.9289     66.3883
# 6        2       4    48.1792     63.1136    42.8167     58.3167
# 7        2       5    48.1792     63.1136    43.1167     63.2500
# 8        3       4    59.9289     66.3883    42.8167     58.3167
# 9        3       5    59.9289     66.3883    43.1167     63.2500
# 10       4       5    42.8167     58.3167    43.1167     63.2500
Источник

Если вы хотите попарные расстояния, и вы используете пакет geosphereпочему бы не использовать distm(...) вместо того, чтобы прыгать через все эти огненные обручи:

# df is the dataset from your question
library(geosphere)
distm(df[,3:2],fun=distHaversine)   # distance in *meters*
#         [,1]      [,2]    [,3]      [,4]      [,5]
# [1,]       0 6224407.2 5743824 6243068.1 6553157.4
# [2,] 6224407       0.0 1324950  704260.1  563654.6
# [3,] 5743824 1324949.8       0 1982326.1 1883584.1
# [4,] 6243068  704260.1 1982326       0.0  403183.0
# [5,] 6553157  563654.6 1883584  403183.0       0.0

Вы также можете использовать fossil пакет.

library(fossil)
earth.dist(df[,3:2],dist=FALSE)     # distance in *kilometers*
#          [,1]      [,2]     [,3]      [,4]      [,5]
# [1,]    0.000 6219.1967 5739.016 6237.8420 6547.6718
# [2,] 6219.197    0.0000 1323.841  703.6706  563.1828
# [3,] 5739.016 1323.8407    0.000 1980.6667 1882.0073
# [4,] 6237.842  703.6706 1980.667    0.0000  402.8455
# [5,] 6547.672  563.1828 1882.007  402.8455    0.0000

Обратите внимание, что эти функции ожидают долготу, а затем широту, поэтому вы должны передавать столбцы 3:2, а не 2:3.

РЕДАКТИРОВАТЬ Ответ на комментарий ОП.

"Edge list" звучит так, как будто вы хотите получить igraph объект. Вы можете использовать матрицу расстояний в качестве матрицы смежности в igraphи расстояния будут автоматически заполнять веса в списке ребер.

library(igraph)
library(geosphere)
g <- graph.adjacency(distm(df[,3:2],fun=distHaversine),
                     mode="undirected",weighted=TRUE)
set.seed(1)   # for reproducible plot
plot(g, layout=layout.fruchterman.reingold(g,weights=E(g)$weight))


get.data.frame(g,"edges")
#    from to    weight
# 1     1  2 6224407.2
# 2     1  3 5743824.5
# 3     1  4 6243068.1
# 4     1  5 6553157.4
# 5     2  3 1324949.8
# 6     2  4  704260.1
# 7     2  5  563654.6
# 8     3  4 1982326.1
# 9     3  5 1883584.1
# 10    4  5  403183.0
Источник
Другие вопросы по тегам