Heatmap/Contours based on Transportation Time (Reverse Isochronic Contours)

后端 未结 2 1888
悲&欢浪女
悲&欢浪女 2021-01-31 11:01

Note: Solutions in r, python, java, or if necessary, c++ or c# are desired.

I am trying to draw contours based on transportation time.

2条回答
  •  一生所求
    2021-01-31 11:23

    This answer is based on obtaining an origin-destination matrix between a grid of (roughly) equally distant points. This is a computer intensive operation not only because it requires a good number of API calls to mapping services, but also because the servers must calculate a matrix for each call. The number of required calls grows exponentially along the number of points in the grid.

    To tackle this problem, I would suggest that you consider running on your local machine or on a local server a mapping server. Project OSRM offers a relatively simple, free, and open-source solution, enabling you to run an OpenStreetMap server into a Linux docker (https://github.com/Project-OSRM/osrm-backend). Having your own local mapping server will allow you to make as many API calls as you desire. R's osrm package allows you to interact with OpenStreetMaps' APIs, Including those placed to a local server.

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

    I create a grid of 96 roughly equally distant points around Bruxelles (Belgium) conurbation. This grid does not take into consideration the earths curvature, which is negligible at the level of city distances.

    For convenience, I employ the raster package to download a ShapeFile of Belgium and extract the nodes for Brussels city.

      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

    The blue contour represent distances to the city center of up to 8 minutes. The red contour represent distances of up to 15 minutes.

提交回复
热议问题