Paarweise Entfernungsberechnung verschachtelter Datenrahmen

Question

Ich suche nach einer Möglichkeit, den Trennungsabstand zwischen Punkten paarweise zu berechnen und die Ergebnisse für jeden einzelnen Punkt in einem begleitenden verschachtelten Datenrahmen zu speichern.

Zum Beispiel habe ich diesen Datenrahmen (aus dem Kartenpaket), der Informationen über uns Städte einschließlich ihrer physischen Standorte enthält. Ich habe den Rest der Information verworfen und die Koordinaten in einem verschachtelten Datenrahmen verschachtelt. Ich beabsichtige, distHaversine() aus dem Paket geosphere zu verwenden, um diese Entfernungen zu berechnen.

library(tidyverse) 

df <- maps::us.cities %>% 
    slice(1:20) %>% 
    group_by(name) %>% 
    nest(long, lat, .key = coords) 

        name   coords 
        <chr>   <list> 
1   Abilene TX <tibble [1 x 2]> 
2    Akron OH <tibble [1 x 2]> 
3   Alameda CA <tibble [1 x 2]> 
4   Albany GA <tibble [1 x 2]> 
5   Albany NY <tibble [1 x 2]> 
...(With 15 more rows) 

Ich habe in die Verwendung der Karte Familie von Funktionen mit muate gekoppelt untersucht, aber ich habe eine schwierige Zeit. Die gewünschten Ergebnisse sind in Form wie folgt:

    name   coords   sep_dist 
        <chr>   <list>   <list> 
1   Abilene TX <tibble [1 x 2]> <tibble [19 x 2]> 
2    Akron OH <tibble [1 x 2]> <tibble [19 x 2]> 
3   Alameda CA <tibble [1 x 2]> <tibble [19 x 2]> 
4   Albany GA <tibble [1 x 2]> <tibble [19 x 2]> 
5   Albany NY <tibble [1 x 2]> <tibble [19 x 2]> 
...(With 15 more rows) 

Mit den sep_dist Tibbles etwas wie folgt aussehen:

   location distance 
        <chr>  <dbl> 
1    Akron OH  1003 
2   Alameda CA  428 
3   Albany GA  3218 
4   Albany NY  3627 
5   Albany OR  97 
...(With 14 more rows)      -distances completely made up 

Wo Ort der Punkt ist, dass (in diesem Fall Abilene) nach Namen verglichen wird, .

Answer 1

Wir können ein "Gitter" mit allen Kombinationen aus Ortsnamen und Koordinaten erweitern, aber die Kombination mit dem gleichen Ortsnamen entfernen. Verwenden Sie anschließend map2_dbl, um die distHaversine-Funktion anzuwenden.

library(tidyverse) 
library(geosphere) 

df2 <- df %>% 
    # Create the grid 
    mutate(name1 = name) %>% 
    select(starts_with("name")) %>% 
    complete(name, name1) %>% 
    filter(name != name1) %>% 
    left_join(df, by = "name") %>% 
    left_join(df, by = c("name1" = "name")) %>% 
    # Grid completed. Calcualte the distance by distHaversine 
    mutate(distance = map2_dbl(coords.x, coords.y, distHaversine)) 

df2 
# A tibble: 380 x 5 
     name   name1   coords.x   coords.y distance 
     <chr>   <chr>   <list>   <list>  <dbl> 
1 Abilene TX  Akron OH <tibble [1 x 2]> <tibble [1 x 2]> 1881904.4 
2 Abilene TX  Alameda CA <tibble [1 x 2]> <tibble [1 x 2]> 2128576.9 
3 Abilene TX  Albany GA <tibble [1 x 2]> <tibble [1 x 2]> 1470577.2 
4 Abilene TX  Albany NY <tibble [1 x 2]> <tibble [1 x 2]> 2542025.1 
5 Abilene TX  Albany OR <tibble [1 x 2]> <tibble [1 x 2]> 2429367.3 
6 Abilene TX Albuquerque NM <tibble [1 x 2]> <tibble [1 x 2]> 702287.5 
7 Abilene TX Alexandria LA <tibble [1 x 2]> <tibble [1 x 2]> 700093.2 
8 Abilene TX Alexandria VA <tibble [1 x 2]> <tibble [1 x 2]> 2161594.6 
9 Abilene TX Alhambra CA <tibble [1 x 2]> <tibble [1 x 2]> 1718967.5 
10 Abilene TX Aliso Viejo CA <tibble [1 x 2]> <tibble [1 x 2]> 1681868.8 
# ... with 370 more rows 

die endgültige Ausgabe zu erstellen, können wir auf den Namen group_by basiert und nest alle anderen gewünschten Spalten.

df3 <- df2 %>% 
    select(-starts_with("coord")) %>% 
    group_by(name) %>% 
    nest() 

df3 
# A tibble: 20 x 2 
        name    data 
        <chr>   <list> 
1   Abilene TX <tibble [19 x 2]> 
2    Akron OH <tibble [19 x 2]> 
3   Alameda CA <tibble [19 x 2]> 
4   Albany GA <tibble [19 x 2]> 
5   Albany NY <tibble [19 x 2]> 
6   Albany OR <tibble [19 x 2]> 
7  Albuquerque NM <tibble [19 x 2]> 
8  Alexandria LA <tibble [19 x 2]> 
9  Alexandria VA <tibble [19 x 2]> 
10   Alhambra CA <tibble [19 x 2]> 
11  Aliso Viejo CA <tibble [19 x 2]> 
12    Allen TX <tibble [19 x 2]> 
13   Allentown PA <tibble [19 x 2]> 
14    Aloha OR <tibble [19 x 2]> 
15   Altadena CA <tibble [19 x 2]> 
16 Altamonte Springs FL <tibble [19 x 2]> 
17   Altoona PA <tibble [19 x 2]> 
18   Amarillo TX <tibble [19 x 2]> 
19    Ames IA <tibble [19 x 2]> 
20   Anaheim CA <tibble [19 x 2]> 

Und jeder Datenrahmen in der data sieht nun wie folgt.

df3$data[[1]] 
# A tibble: 19 x 2 
        name1 distance 
        <chr>  <dbl> 
1    Akron OH 1881904.4 
2   Alameda CA 2128576.9 
3   Albany GA 1470577.2 
4   Albany NY 2542025.1 
5   Albany OR 2429367.3 
6  Albuquerque NM 702287.5 
7  Alexandria LA 700093.2 
8  Alexandria VA 2161594.6 
9   Alhambra CA 1718967.5 
10  Aliso Viejo CA 1681868.8 
11    Allen TX 296560.4 
12   Allentown PA 2342363.5 
13    Aloha OR 2457938.8 
14   Altadena CA 1719207.6 
15 Altamonte Springs FL 1805480.9 
16   Altoona PA 2102993.0 
17   Amarillo TX 361520.0 
18    Ames IA 1194234.7 
19   Anaheim CA 1694698.9 

Answer 2

geosphere bietet die Möglichkeit, mit distm

Reproduzierbare Daten

set.seed(1) 
df <- data.frame(name=letters[1:4], 
       lon=runif(4)*10, 
       lat=runif(4)*10) 

distm

library(geosphere) 
ans <- as.data.frame(distm(df[,2:3], df[,2:3], fun=distHaversine)) 

     # a  b  c  d 
# 1  0.0 784506.1 894320.6 877440.5 
# 2 784506.1  0.0 226504.3 647666.7 
# 3 894320.6 226504.3  0.0 486290.8 
# 4 877440.5 647666.7 486290.8  0.0 

Ordentlich in gewünschtem Format

All-to-alle Entfernungen zu vergleichen,

colnames(ans) <- df$name 
library(dplyr) 
library(tidyr) 
desired <- ans %>% 
      gather(pos1, distance) %>% 
      mutate(pos2 = rep(df$name, nrow(df))) %>% 
      filter(pos1!=pos2) %>% 
      select(pos1, pos2, distance) 

    # pos1 pos2 distance 
# 1  a b 784506.1 
# 2  a c 894320.6 
# 3  a d 877440.5 
# 4  b a 784506.1 
# 5  b c 226504.3 
# 6  b d 647666.7 
# 7  c a 894320.6 
# 8  c b 226504.3 
# 9  c d 486290.8 
# 10 d a 877440.5 
# 11 d b 647666.7 
# 12 d c 486290.8