Итерации в R с функцией, которая требует четырех векторов - PullRequest
Новая
       40

Итерации в R с функцией, которая требует четырех векторов

2 голосов
/ 05 июня 2019

Я пытаюсь найти расстояние между несколькими городами, используя функцию distHaversine в пакете геосферы. Этот код требует множества аргументов:

Долгота и широта первого места. Долгота и широта второго места. Радиус Земли в любых единицах (я использую r = 3961 для миль).

Когда я ввожу это как вектор, оно легко работает: 

HongKong <- c(114.17, 22.31)
GrandCanyon <- c(-112.11, 36.11)

library(geosphere)
distHaversine(HongKong, GrandCanyon, r=3961)
#[1] 7399.113 distance in miles

Однако мои фактические наборы данных выглядят так: 

library(dplyr)
location1 <- tibble(person = c("Sally", "Jane", "Lisa"),
current_loc = c("Bogota Colombia", "Paris France", "Hong Kong China"),
lon = c(-74.072, 2.352, 114.169),
lat = c(4.710, 48.857, 22.319))

location2 <- tibble(destination = c("Atlanta United States", "Rome Italy", "Bangkok Thailand", "Grand Canyon United States"),
              lon = c(-84.388, 12.496, 100.501, -112.113),
              lat = c(33.748, 41.903, 13.756, 36.107))

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

Я знаю, что должен быть способ использования pmap_dbl () purrr, но я не могу понять это.

Бонусные баллы, если в вашем коде используется обратная точка и если есть простой способ создать столбец, который определяет ближайший пункт назначения. Спасибо!

В идеальном мире я бы получил это: 

solution <- tibble(person = c("Sally", "Jane", "Lisa"),
                    current_loc = c("Bogota Colombia", "Paris France", "Hong Kong China"),
                    lon = c(-74.072, 2.352, 114.169),
                    lat = c(4.710, 48.857, 22.319),
                   dist_Atlanta = c(1000, 2000, 7000),
                   dist_Rome = c(2000, 500, 3000),
                   dist_Bangkok = c(7000, 5000, 1000),
                   dist_Grand = c(1500, 4000, 7500),
                   nearest = c("Atlanta United State", "Rome Italy", "Bangkok Thailand"))

Примечание: числа в столбцах dist являются случайными; однако они будут выводиться из функции distHaversine (). Название этих столбцов является произвольным - его не нужно так называть. Кроме того, если ближайший столбец выходит за рамки этого вопроса, я думаю, что смогу его выяснить.

Ответы [ 2 ]

2 голосов
/ 05 июня 2019

distHaversine принимает только одну пару значений lat и lon за раз, поэтому нам нужно посылать все комбинации строк location1 и location2 одну за другой в функцию. Один из способов использования sapply будет 

library(geosphere)


location1[paste0("dist_", stringr::word(location2$destination))] <- 
        t(sapply(seq_len(nrow(location1)), function(i) 
            sapply(seq_len(nrow(location2)), function(j) {
   distHaversine(location1[i, c("lon", "lat")], location2[j, c("lon", "lat")], r=3961)
})))

location1$nearest <- location2$destination[apply(location1[5:8], 1, which.min)]

location1

# A tibble: 3 x 9
#  person current_loc         lon   lat dist_Atlanta dist_Rome dist_Bangkok dist_Grand nearest              
#  <chr>  <chr>             <dbl> <dbl>        <dbl>     <dbl>        <dbl>      <dbl> <chr>                
#1 Sally  Bogota Colombia  -74.1   4.71        2114.     5828.       11114.      3246. Atlanta United States
#2 Jane   Paris France       2.35 48.9         4375.      687.        5871.      5329. Rome Italy           
#3 Lisa   Hong Kong China  114.   22.3         8380.     5768.        1075.      7399. Bangkok Thailand
1 голос
/ 05 июня 2019

Используя форму tidyverse и map purrr, как вы и просили, я нашел решение, все в одной трубе. 

library(tidyverse)
library(geosphere)

# renaming lon an lat variables in each df

location1 <- location1 %>%
 rename(lon.act = lon, lat.act = lat)

location2 <- location2 %>%
  rename(lon.dest = lon, lat.dest = lat)

# geting distances
merge(location1, location2, all = TRUE) %>%
  group_by(person,current_loc, destination) %>%
  nest() %>%
  mutate( act = map(data, `[`, c("lon.act", "lat.act")) %>%
            map(as.numeric),
          dest = map(data, `[`, c("lon.dest", "lat.dest")) %>%
            map(as.numeric),
          dist = map2(act, dest, ~distHaversine(.x, .y, r = 3961))) %>%
  unnest(data, dist) %>%
  group_by(person) %>%
  mutate(mindis = dist == min(dist))
...