查找到目的地的旅行时间相同的位置：基于运输时间的热图/等值线（反向等时等值线）

Note: 解决方案r /questions/tagged/r or python /questions/tagged/python是所期望的。

我正在尝试根据运输时间绘制轮廓。更清楚地说，我想将具有相似旅行时间（假设为 10 分钟间隔）的点聚集到特定点（目的地），并将它们映射为等值线或热图。

现在，我唯一的想法就是使用 R 包gmapsdistance https://cran.r-project.org/web/packages/gmapsdistance/gmapsdistance.pdf找出不同出发点的旅行时间，然后将它们聚类并绘制在地图上。但是，正如您所知，这绝不是一个可靠的解决方案。

This thread https://gis.stackexchange.com/questions/31057/creating-drive-time-polygon-around-map-pointGIS 社区和this one https://stackoverflow.com/questions/9403699/map-of-all-points-below-a-certain-time-of-travel对于 python 来说，说明了类似的问题，但对于在特定时间内到达的目的地而言。我想找到可以在一定时间内到达目的地的出发地。

现在，下面的代码显示了我的基本想法（使用 R）：

library(gmapsdistance)

set.api.key("YOUR.API.KEY") 

mdestination <- "40.7+-73"
morigin1 <- "40.6+-74.2"
morigin2 <- "40+-74"

gmapsdistance(origin = morigin1,
              destination = mdestination,
              mode = "transit")

gmapsdistance(origin = morigin2,
              destination = mdestination,
              mode = "transit")

这张地图也可能有助于理解这个问题：

使用这个answer https://stackoverflow.com/questions/40489162/draw-time-radius-around-lat-long-on-map/43771177#43771177我可以得到从出发点可以去的点，但我需要反转它并找到到达目的地的旅行时间等于或小于一定时间的点；

library(httr)
library(googleway)
library(jsonlite)

appId <- "TravelTime_APP_ID"
apiKey <- "TravelTime_API_KEY"
mapKey <- "GOOGLE_MAPS_API_KEY"

location <- c(40, -73)
CommuteTime <- (5 / 6) * 60 * 60

url <- "http://api.traveltimeapp.com/v4/time-map"

requestBody <- paste0('{ 
                      "departure_searches" : [ 
                      {"id" : "test", 
                      "coords": {"lat":', location[1], ', "lng":', location[2],' }, 
                      "transportation" : {"type" : "driving"} ,
                      "travel_time" : ', CommuteTime, ',
                      "departure_time" : "2017-05-03T07:20:00z"
                      } 
                      ] 
                      }')

res <- httr::POST(url = url,
                  httr::add_headers('Content-Type' = 'application/json'),
                  httr::add_headers('Accept' = 'application/json'),
                  httr::add_headers('X-Application-Id' = appId),
                  httr::add_headers('X-Api-Key' = apiKey),
                  body = requestBody,
                  encode = "json")

res <- jsonlite::fromJSON(as.character(res))

pl <- lapply(res$results$shapes[[1]]$shell, function(x){
  googleway::encode_pl(lat = x[['lat']], lon = x[['lng']])
})

df <- data.frame(polyline = unlist(pl))

df_marker <- data.frame(lat = location[1], lon = location[2])

google_map(key = mapKey) %>%
  add_markers(data = df_marker) %>%
  add_polylines(data = df, polyline = "polyline")

而且，行程时间地图平台文档 http://docs.traveltimeplatform.com/reference/time-map/#multi-origin-with-arrival-time谈论多始发地及到达时间这正是我想做的事情。但我需要对公共交通和驾驶（对于通勤时间不到一小时的地方）都这样做，而且我认为由于公共交通很棘手（基于您靠近的车站），也许热图是比等高线更好的选择。

这个答案基于获得（大致）等距点网格之间的起点-目的地矩阵。这是一项计算机密集型操作，不仅因为它需要对地图服务进行大量 API 调用，而且还因为服务器必须为每次调用计算一个矩阵。所需调用的数量随着网格中点的数量呈指数增长。

为了解决这个问题，我建议您考虑在本地计算机或本地服务器上运行映射服务器。 OSRM 项目提供了一个相对简单、免费且开源的解决方案，使您能够在 Linux docker 中运行 OpenStreetMap 服务器（https://github.com/Project-OSRM/osrm-backend https://github.com/Project-OSRM/osrm-backend）。拥有自己的本地地图服务器将允许您根据需要进行任意数量的 API 调用。 R 的 osrm 包允许您与 OpenStreetMaps 的 API 进行交互，包括放置到本地服务器的 API。

library(raster) # Optional
library(sp)
library(ggmap)
library(tidyverse)
library(osrm)
devtools::install_github("cmartin/ggConvexHull") # Needed to quickly draw the contours
library(ggConvexHull)

我在布鲁塞尔（比利时）城市群周围创建了一个由 96 个大致相等距离的点组成的网格。 该网格没有考虑地球曲率，在城市距离水平上，地球曲率可以忽略不计。

为了方便起见，我使用光栅包下载比利时的 ShapeFile 并提取布鲁塞尔市的节点。

  BE <- raster::getData("GADM", country = "BEL", level = 1)
  Bruxelles <- BE[BE$NAME_1 == "Bruxelles", ]

  df_grid <- makegrid(Bruxelles, cellsize = 0.02) %>% 
        SpatialPoints() %>%
        ## I convert the SpatialPoints object into a simple data.frame 
        as.data.frame() %>% 
        ## create a unique id for each point in the data.frame
        rownames_to_column() %>% 
        ## rename variables of the data.frame with more explanatory names.
        rename(id = rowname, lat = x2, lon = x1) 

 ## I point osrm.server to the OpenStreet docker running in my Linux machine. ... 
 ### ... Do not run this if you are getting your data from OpenStreet public servers.
 options(osrm.server = "http://127.0.0.1:5000/") 

 ## I obtain a list with distances (Origin Destination Matrix in ...
 ### ... minutes, origins and destinations)
 Distance_Tables <- osrmTable(loc = df_grid) 

 OD_Matrix <- Distance_Tables$durations %>% ## subset the previous list
                ## convert the Origin Destination Matrix into a tibble
                as_data_frame() %>%  
                rownames_to_column() %>% 
                ## make sure we have an id column for the OD tibble
                rename(origin_id = rowname) %>% 
                ## transform the tibble into long/tidy format
                gather(key = destination_id, value = distance_time, -origin_id) %>% 
                left_join(df_grid, by = c("origin_id" = "id")) %>% 
                ## set origin coordinates
                rename(origin_lon = lon, origin_lat = lat) %>% 
                left_join(df_grid, by = c("destination_id" = "id")) %>% 
                ## set destination coordinates
                rename(destination_lat = lat, destination_lon = lon) 

 ## Obtain a nice looking road map of Brussels
 Brux_map <- get_map(location = "bruxelles, belgique", 
                     zoom = 11, 
                     source = "google", 
                     maptype = "roadmap")

 ggmap(Brux_map) + 
   geom_point(aes(x = origin_lon, y = origin_lat), 
              data = OD_Matrix %>% 
                ## Here I selected point_id 42 as the desired target, ...
                ## ... just because it is not far from the City Center.
                filter(destination_id == 42), 
                size = 0.5) + 
   ## Draw a diamond around point_id 42                                      
   geom_point(aes(x = origin_lon, y = origin_lat), 
              data = OD_Matrix %>% 
                filter(destination_id == 42, origin_id == 42),
              shape = 5, size = 3) +  
   ## Countour marking a distance of up to 8 minutes
   geom_convexhull(alpha = 0.2, 
                   fill = "blue", 
                   colour = "blue",
                   data = OD_Matrix %>% 
                            filter(destination_id == 42, 
                            distance_time <= 8), 
                   aes(x = origin_lon, y = origin_lat)) + 
   ## Countour marking a distance of up to 16 minutes
   geom_convexhull(alpha = 0.2, 
                   fill = "red",
                   colour = "red",
                   data = OD_Matrix %>% 
                            filter(destination_id == 42, 
                                   distance_time <= 15), 
                   aes(x = origin_lon, y = origin_lat))

Results

蓝色等高线表示距市中心最多 8 分钟的距离。 红色轮廓代表最长 15 分钟的距离。