Trame de données imbriquées de calcul de distance par paires

Question

Je cherche un moyen de calculer la distance de séparation entre les points par paire et de stocker les résultats pour chaque point individuel dans une trame de données imbriquée qui l'accompagne. Par exemple, j'ai cette trame de données (du paquet de cartes) qui contient des informations sur les villes américaines, y compris leurs emplacements physiques. J'ai jeté le reste de l'information et imbriqué les coordonnées dans une trame de données imbriquée. J'ai l'intention d'utiliser distHaversine() du paquet geosphere pour calculer ces distances. J'ai examiné dans l'utilisation de la famille de fonctions de carte couplée à muter, mais j'ai un moment difficile. Les résultats escomptés sont sous la forme comme suit:

    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) 

Avec les tibbles sep_dist recherche quelque chose comme ceci:

   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 

Où l'emplacement est le point qui est comparé au nom (dans ce cas Abilene) .

Answer 1

Nous pouvons développer une «grille» avec toute la combinaison du nom de l'emplacement et des coordonnées, mais supprimer la combinaison avec le même nom d'emplacement. Après cela, utilisez map2_dbl pour appliquer la fonction distHaversine.

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 

Pour créer la sortie finale, nous pouvons group_by en fonction du nom et nest toutes les autres colonnes souhaitées.

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]> 

Et chaque trame de données dans le data ressemble maintenant à ceci.

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 offre la possibilité de comparer à toutes les distances avec distm

données

Reproductible

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 

Tidy au format souhaité

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