tlorusso / traveltime

traveltime - Traveltime API Wrapper for R
https://tlorusso.github.io/traveltime/vignette.html
18 stars 3 forks source link

Multiple coordinates #6

Open bjornsh opened 3 years ago

bjornsh commented 3 years ago

Fantastic package! Any chance you could provide a solution for querying multiple coordinates? The following does not work

traveltimes = c("59.85784, 17.64629", "59.95784, 17.84629") %>% map(.,~traveltime_map(appId=appID, apiKey=apiKey, location=.x, traveltime=1800, type="public_transport", departure="2021-02-23T14:00:00+01:00") %>% mutate(location=.x))

and neither does

list(c(59.854373, 17.650896),c(60.17643, 18.18830992)) %>% map(.,~traveltime_map(appId=appID, apiKey=apiKey, location=.x, traveltime=1800, type="public_transport", departure="2021-02-23T14:00:00+01:00") %>% mutate(location=.x))

The latter generates the following error, supposedly as a vector is required

Error: Problem with mutate() input location. x Input location can't be recycled to size 1. i Input location is .x. i Input location must be size 1, not 2.

tlorusso commented 3 years ago

Hey @bjornsh,

Thanks for bringing this up. Indeed, the package does not yet allow to pass mutliple coordinates in an user-friendly an easy manner. At the moment, a working solution looks like this:

coords <- list(c(47.378610,8.54000),c(47.378610,8.54000))

purrr::map_dfr(1:length(coords), ~traveltime_map(appId="AppId",
                                 apiKey="ApiKey",
                                 location=coords[[.x]],
                                 traveltime=14400,
                                 type="public_transport",
                                 arrival="2021-01-23T14:00:00Z"))
ccb2n19 commented 2 years ago

Hello there,

I came up with a solution to this while using Travel Time for accessibility analysis. Thought it might be helpful for people here.

The input I usually have is an sf object of several points. Using this, I want to create isochrones with different modes and travel times.

I wanted a mutate_isochrone function, which worked in a similarly simple way to dplyr mutate, or the ggmap mutate_geocode. I wanted this function to deal with some of the complexity of converting the data in preparation for the traveltime_map. I also wanted to avoid specifying things like the API key with each function call.

Here's a worked example, including the function. If there's any desire to work something like this into the package itself, I'd be happy to help.

First, create an sf tibble to use as the input and set some parameters to use for the isochrones.

library(dplyr)
library(tidyr)
library(sf)
library(ggmap)

badi <- tibble(
    place = c("Freibad Letzigraben", "Flussbad Oberer Letten")
  ) %>%
  ggmap::mutate_geocode(
    location = place
  ) %>%
  st_as_sf(
    crs = 4326,
    coords = c("lon", "lat")
  ) %>%
  st_transform(
    21781 # Transformed to the Swiss projection, so that this example is close to a real-world one
  ) %>%
  tidyr::expand_grid( # This function creates all possible combinations between each row in a table ...
    minutes = c(10, 20), # ... and additional sets of values. Perfect for this kind of purpose
    mode = "public_transport",
    time = "2022-07-01T18:00:00+01:00"
  ) %>%
  st_as_sf()

mutate_isochrone includes two other functions within it. geometry_as_vector to convert the sf geometry column to a numeric vector of coordinates in the right order. tt_simp to set the API key and ID 'up front', and change the names of a few inputs so they're clearer to me.

geometry_as_vector <- function(x) {
  x %>%
    st_coordinates() %>%
    as.numeric() %>%
    rev()
}

library(traveltime)
tt_simp <- function(coords, minutes, mode, time) {
  traveltime::traveltime_map(
    appId = tt_id,
    apiKey = tt_key,
    location = coords,
    traveltime = 60 * minutes,
    type = mode,
    departure = time
  )
}

# tt_key <- # Your key
# 
# tt_id <- # Your id

mutate_isochrone, itself.

library(purrr)

mutate_isochrone <- function(x) {

  x %>%
    st_transform(4326) %>% # Convert to WGS84
    mutate(
      coords = geometry %>%
        map(
          ~.x %>% geometry_as_vector # Convert the points to coordinates
        )
    ) %>%
    st_drop_geometry() %>%
    mutate(
      isochrone = pmap(
        dplyr::lst(coords, minutes, mode, time), # Specify the fields of the table to pass to the Travel Time function
        tt_simp # Apply the function
      )
    ) %>%
    tidyr::unnest(
      isochrone # Get the isochrone out from the list column 
    ) %>%
    st_as_sf(
      crs = 4326 # Convert the table to an sf object
    ) %>%
    st_transform(
      x %>% st_crs() # Change back to the original projection
    )

}

Applied to the set of points:

isochrones <- badi %>%
  mutate_isochrone()

Plot the results.

library(tmap)

plot <- isochrones %>%
  arrange(desc(minutes)) %>%
  tm_shape() +
  tm_fill(
    col = "minutes",
    alpha = 0.5,
    style = "cat"
  ) +
badi %>%
  tm_shape() +
  tm_symbols(
    shape = 21,
    border.col = "black",
    border.lwd = 2
  ) +
  tm_text(
    "place",
    ymod = 1
  )

isochrones