HERE Isolines Investigation
Dylan Nagy
University of Pittsburgh Graduate School of Public Healthdylan.nagy@pitt.edu
Introduction
This exercise investigates isolines (equivalent to isochrones) created by the HERE Isoline API. HERE’s API for creating catchment areas allows for specifying if the areas should be drawn by distance (in meters), time, or by consumption in watt hours, and also allows a user to indicate the date and time at the starting location when creating an isochrone to simulate real-world traffic. The accuracy of these isolines and the efficiency of creating them are compared to isochrones made with Mapbox and Open Source Routing Machine (OSRM) and with drive time calculations to points of interest using the Bing Maps Routing API.
Step 1: Install and load libraries
# Use pacman package to load packages used for exercise
library(pacman)
p_load(dplyr, rjson, lubridate, kableExtra, httr, geojsonR, sf,
sp, hereR, osrm, gtools, slickR, leaflet)Step 2: Load points
This exercise first compared wider catchment areas–up to a two hour drive–created by HERE and OSRM. The second part of the exercise then compared a more narrow 1-hour catchment area created by HERE and Mapbox. All catchment areas started at City Hall in Philadelphia, PA. Locations of Wawa convenience stores, pulled from a public web scraper in March 2019, within a 2.5 hour drive of Philadelphia City Hall were used to analyze the results.
# Load Wawa points from working directory
wawa <- read.csv("./data/Wawa-Points.csv") %>%
dplyr::select("store_number", "longitude", "latitude")
# Convert to spatial
wawa.sf <- st_as_sf(x = wawa,
coords = c("longitude", "latitude"),
crs = "+proj=longlat +datum=WGS84 +no_defs")
wawa.sp <- as(wawa.sf, "Spatial")
# Create a 2.5 hour catchment area from Philadelphia City Hall
start <- read.csv("./data/Philadelphia-Points.csv")[1,]
start.sf <- st_as_sf(x = start,
coords = c("lon", "lat"),
crs = "+proj=longlat +datum=WGS84 +no_defs")
wawa_region <- isoline(
poi = start.sf,
range = 2.5 * 60 * 60,
range_type = "time",
datetime <- as.POSIXct(paste0(Sys.Date()," 10:00"))
)
wawa_region.sp <- as(wawa_region, "Spatial")
# Keep only Wawa locations in that region
wawa.sp <- wawa.sp[!is.na(over(wawa.sp, wawa_region.sp)$rank),]
colnames(wawa.sp@coords) <- c("longitude", "latitude")
# Display locations
plot(wawa_region.sp, lwd = 3,
main = "Philadelphia Metropolitan Wawa Locations",
sub = "(March 2019)")
plot(wawa.sp, col = "#ab1b2c", add = TRUE)
Step 3: Calculate drive times
Drive times from City Hall in Philadelphia to all of the Wawa locations within a 2.5 hour catchment area from City Hall were calculated by the Bing Maps routing API. The travel time in minutes for a car was calculated for each Wawa location using traffic conditions at 10AM on 10/27/2021.
Bing Maps API key available here.
# Load City Hall location
city_hall <- read.csv("./data/Philadelphia-Points.csv")[1,]
# Calculate drive time in minutes between City Hall and Wawa locations
wawa.points <- data.frame(wawa.sp) %>% dplyr::select(-"optional")
for (i in 1:nrow(wawa.points)){
url <- paste("http://dev.virtualearth.net/REST/V1/Routes/",
"Driving",
"?wp.0=",paste0(city_hall$lat,"+",city_hall$lon),
"&wp.1=",paste0(wawa.points$latitude[i],"+",wawa.points$longitude[i]),
"&dt=",paste0(format(ymd(Sys.Date()), "%m/%d/%Y"),"+10:00:00"),
"&tt=","Departure",
"&key=",key,
sep="")
suppressWarnings(json_bing <- fromJSON(paste(readLines(url), collapse=""),
unexpected.escape = "skip"))
travelDuration <- json_bing$resourceSets[[1]]$resources[[1]]$travelDuration
wawa.points$time[i] <- round(travelDuration/60,1)
}
# Add correct catchment area to points
wawa.points$iso_goal <- ceiling(wawa.points$time / 15) * 15
# Convert to spatial
wawa.points.sf <- st_as_sf(x = wawa.points,
coords = c("longitude", "latitude"),
crs = "+proj=longlat +datum=WGS84 +no_defs")
wawa.points.sp <- as(wawa.points.sf, "Spatial")
# Display first 10 points for example
wawa.points[1:10,] %>%
kbl(caption = "First 10 Wawa Locations with Drive Time in Minutes from
Philadelphia City Hall and Catchment Area Goal",
align = "r", row.names = FALSE) %>%
kable_minimal("hover")| store_number | longitude | latitude | time | iso_goal |
|---|---|---|---|---|
| 7 | -75.42108 | 39.82568 | 25.5 | 30 |
| 8 | -75.35954 | 39.96646 | 29.1 | 30 |
| 9 | -75.29904 | 39.92103 | 28.5 | 30 |
| 11 | -75.25752 | 39.95245 | 23.1 | 30 |
| 12 | -75.30154 | 39.94694 | 34.5 | 45 |
| 14 | -75.27854 | 39.96137 | 28.1 | 30 |
| 19 | -75.27990 | 39.91028 | 24.5 | 30 |
| 21 | -75.21390 | 40.10659 | 30.9 | 45 |
| 23 | -75.30939 | 39.88034 | 18.1 | 30 |
| 25 | -75.59163 | 39.94382 | 38.9 | 45 |
Step 4: Two hour comparison
Build HERE isolines
The first part of this analysis compared HERE with OSRM for creating catchment areas that extend byeond a 1 hour drive time. Each isochrone (HERE calls them isolines) will include 15-minute catchment areas from 0 to 15 minutes up to 105 to 120 minutes. This step built the isolines for HERE.
HERE API key can be created here.
# Build isolines using HERE API
# Track how long it takes to build the isolines
start.time <- Sys.time()
# Download data from HERE API
here2hr <- isoline(
poi = start.sf,
range = seq(15, 120, 15) * 60,
range_type = "time",
datetime <- as.POSIXct(paste0(Sys.Date()," 10:00"))
)
# Create spatial polygons data frame
here2hr.sp <- as(here2hr, "Spatial")
# Add information for graphics and further analyses
here2hr.sp@data$name <- here2hr.sp$range / 60
here2hr.sp@data$drive_times <- factor(paste0(here2hr.sp@data$rank,
". ", as.numeric(here2hr.sp@data$name) - 15,
" to ", here2hr.sp@data$name, " min"))
# Stop timer for isolines creation
stop.time <- Sys.time()
here2hr.time.diff <- round(difftime(stop.time, start.time, units = c("mins")), 2)
# Create a color palette for the HERE 2 hour catchment areas
here2hr.colors <- c("#006837", "#1a9850", "#66bd63", "#a6d96a",
"#fdae61", "#f46d43", "#d73027", "#a50026")
here2hr.pal <- colorFactor(here2hr.colors, here2hr.sp@data$drive_times)
# Remove data that is no longer needed
rm(start.time, stop.time)
# Check HERE 2 hour polygons
plot(here2hr.sp)
Build OSRM isochrones
There is no API Key required to build isochrones with OSRM.
# Track how long it takes to build the isochrones
start.time <- Sys.time()
# Set resolution to a number between 30 and 100 (30 is default)
res <- 70
# Download data from OSRM API
osrm2hr <- osrmIsochrone(loc = c(points$lon[1], points$lat[1]),
breaks = seq(from = 0,to = 120, by = 15), res = res,
returnclass = "sp")
# Add information for graphics and further analyses
osrm2hr$name <- osrm2hr$max
osrm2hr@data$drive_times <- factor(paste0(osrm2hr@data$id,
". ", osrm2hr@data$min,
" to ", osrm2hr@data$max, " min"))
# Stop timer for isochrone creation
stop.time <- Sys.time()
osrm2hr.time.diff <- round(difftime(stop.time, start.time, units = c("mins")), 2)
# Create a color palette for the OSRM 2 hour catchment areas
osrm2hr.colors <- c("#053061", "#2166ac", "#4393c3", "#92c5de",
"#b2abd2", "#8073ac", "#542788", "#2d004b")
osrm2hr.pal <- colorFactor(osrm2hr.colors, osrm2hr@data$drive_times)
# Remove data that is no longer needed
rm(start.time, stop.time)
#Check OSRM 2 hour polygons
plot(osrm2hr)
Step 5: Two hour maps
HERE isolines map
In the interactive map below, created with the Leaflet package for R, all Wawa locations located within a 2.5 hour drive from City Hall in Philadelphia are plotted and color-coded by which catchment area they should fit into. Underneath those points are the catchment areas created by the HERE isolines with the same color palette as the Wawa points. The isolines and drive times were simulated using traffic starting at 10:00 AM EST.
# Color palette for Wawa locations
wawa.here2hr.pal <- colorFactor(here2hr.colors, domain = c(here2hr.sp$name))
#Plot HERE isolines with points of interest
leaflet() %>%
setView(start$lon-.8, start$lat, zoom = 7) %>%
addProviderTiles("CartoDB.Positron", group="Greyscale") %>%
addPolygons(fill=TRUE, stroke=TRUE, color = "black",
fillColor = ~here2hr.pal(here2hr.sp@data$drive_times),
weight=0.5, fillOpacity=0.35,
data = here2hr.sp, popup = here2hr.sp@data$drive_times,
group = "Drive Time") %>%
addCircles(wawa.points$lon, wawa.points$lat,
color = wawa.here2hr.pal(as.factor(wawa.points$iso_goal)),
radius = 5, opacity = 1) %>%
# Add a legend
addLegend("bottomleft", pal = here2hr.pal, values = here2hr.sp@data$drive_time,
opacity = 0.35, title = "HERE 2 Hour Isolines")OSRM isochrones map
The interactive map below behaves like the graphic above, but displays the 2 hour isochrones created by OSRM.
# Plot OSRM 2 hour isochrones with points of interest
wawa.osrm2hr.pal <- colorFactor(osrm2hr.colors, domain = c(osrm2hr$name))
#Plot OSRM isochrones with points of interest
leaflet() %>%
setView(start$lon-.8, start$lat, zoom = 7) %>%
addProviderTiles("CartoDB.Positron", group="Greyscale") %>%
addPolygons(fill=TRUE, stroke=TRUE, color = "black",
fillColor = ~osrm2hr.pal(osrm2hr@data$drive_times),
weight=0.5, fillOpacity=0.35,
data = osrm2hr, popup = osrm2hr@data$drive_times,
group = "Drive Time") %>%
addCircles(wawa.points$lon, wawa.points$lat,
color = wawa.osrm2hr.pal(as.factor(wawa.points$iso_goal)),
radius = 5, opacity = 1) %>%
# Add a legend
addLegend("bottomleft", pal = osrm2hr.pal, values = osrm2hr@data$drive_time,
opacity=0.35, title = "OSRM 2 Hour Isochrones")Step 6: Two hour analysis
This step added the catchment areas for each isochrone generation method (HERE and OSRM) to all Wawa locations within a 2.5 hour drive of City Hall in Philadelphia. Both sets of isochrones correctly omitted locations that were more than a two hour drive away from City Hall. HERE’s isolines placed most of the locations in the correct catchment area, but OSRM’s isochrones placed less than half of the Wawa locations in the correct 15-minute time band.
# Use same projections
here2hr.sp@proj4string@projargs <- wawa.points.sp@proj4string@projargs
osrm2hr@proj4string@projargs <- wawa.points.sp@proj4string@projargs
# Add catchment areas to Wawa locations
wawa.points.sp$here <- over(wawa.points.sp, here2hr.sp)$name
wawa.points.sp$osrm <- over(wawa.points.sp, osrm2hr)$name
wawa.points.sp@data[is.na(wawa.points.sp@data)] <- 999
# Analyze catchment areas
wawa.points.sp$accurate <-
ifelse(wawa.points.sp$here == wawa.points.sp$iso_goal &
wawa.points.sp$osrm == wawa.points.sp$iso_goal, "both",
ifelse(wawa.points.sp$here == wawa.points.sp$iso_goal &
wawa.points.sp$osrm != wawa.points.sp$iso_goal, "here",
ifelse(wawa.points.sp$here != wawa.points.sp$iso_goal &
wawa.points.sp$osrm == wawa.points.sp$iso_goal, "osrm", "neither")))
# Overall catchment area accuracy
count(wawa.points.sp@data, accurate) %>%
mutate(count = n,
percent = round(n/sum(n),4) * 100) %>%
select(-n) %>%
arrange(desc(count)) %>%
kbl(caption = "Frequency of Overall Accurate Catchment Area Placements by Isochrone API",
align = "r", row.names = FALSE) %>%
kable_minimal("hover")| accurate | count | percent |
|---|---|---|
| here | 228 | 41.30 |
| both | 174 | 31.52 |
| neither | 99 | 17.93 |
| osrm | 51 | 9.24 |
# Group data by catchment area goals
iso2hr.counts <- wawa.points.sp@data %>%
dplyr::count(iso_goal, accurate) %>%
tidyr::spread(accurate, n) %>%
select(iso_goal, both, here, osrm, neither) %>%
rowwise %>%
mutate(total = sum(c(both, here, osrm, neither), na.rm = TRUE),
both_pct = 100 * round(both / total, 4),
here_pct = 100 * round(sum(here, both, na.rm = TRUE) / total, 4),
osrm_pct = 100 * round(sum(osrm, both, na.rm = TRUE) / total, 4),
none_pct = 100 * round(neither / total, 4)) %>%
replace(is.na(.), 0)
# Catchment area accuracy by groups
iso2hr.counts %>%
dplyr::select(iso_goal:total) %>%
mutate(osrm = cell_spec(osrm, "html",
color = ifelse(osrm < here, "red", "black"))) %>%
kbl(caption = "Frequency of Accurate Catchment Area Placements by Isochrone API",
align = "r", format = "html", escape = F, row.names = FALSE) %>%
kable_minimal("hover") %>%
column_spec(column = 1:6, width = "1.5in")| iso_goal | both | here | osrm | neither | total |
|---|---|---|---|---|---|
| 15 | 29 | 7 | 0 | 0 | 36 |
| 30 | 78 | 33 | 28 | 7 | 146 |
| 45 | 41 | 52 | 16 | 19 | 128 |
| 60 | 15 | 45 | 3 | 14 | 77 |
| 75 | 4 | 56 | 3 | 17 | 80 |
| 90 | 6 | 21 | 1 | 14 | 42 |
| 105 | 0 | 9 | 0 | 10 | 19 |
| 120 | 1 | 5 | 0 | 7 | 13 |
| 135 | 0 | 0 | 0 | 5 | 5 |
| 150 | 0 | 0 | 0 | 6 | 6 |
# Percent of catchment area accuracy by groups
iso2hr.counts %>%
dplyr::select(iso_goal, both_pct:none_pct, total) %>%
mutate(osrm_pct = cell_spec(osrm_pct, "html",
color = ifelse(osrm_pct < here_pct, "red", "black"))) %>%
kbl(caption = "Percent of Accurate Catchment Area Placements by Isochrone API
(counts ''both'' as correct for HERE and OSRM)",
align = "r", format = "html", escape = F, row.names = FALSE) %>%
kable_minimal("hover") %>%
column_spec(column = 1:6, width = "1.5in")| iso_goal | both_pct | here_pct | osrm_pct | none_pct | total |
|---|---|---|---|---|---|
| 15 | 80.56 | 100.00 | 80.56 | 0.00 | 36 |
| 30 | 53.42 | 76.03 | 72.6 | 4.79 | 146 |
| 45 | 32.03 | 72.66 | 44.53 | 14.84 | 128 |
| 60 | 19.48 | 77.92 | 23.38 | 18.18 | 77 |
| 75 | 5.00 | 75.00 | 8.75 | 21.25 | 80 |
| 90 | 14.29 | 64.29 | 16.67 | 33.33 | 42 |
| 105 | 0.00 | 47.37 | 0 | 52.63 | 19 |
| 120 | 7.69 | 46.15 | 7.69 | 53.85 | 13 |
| 135 | 0.00 | 0.00 | 0 | 100.00 | 5 |
| 150 | 0.00 | 0.00 | 0 | 100.00 | 6 |
Note: Cells in red indicate a catchment area where HERE was more accurate than OSRM.
The HERE isolines generated above took 0.03 minutes to create, and the OSRM isochrones took 6.56 minutes to create. HERE isolines correctly placed 74.31% of the Wawa locations within a 2 hour drive of City Hall in Philadelphia, and the OSRM isochrone with resolution = 70 correctly placed 41.59% of those same locations. The HERE isolines outperformed OSRM’s isochrones with catchment area placement at all 15-minute intervals within a 2 hour drive. Neither method included a location further than 2 hours from City Hall in their catchment areas.
# Plot 2 hour catchment areas over each other
plot(here2hr.sp, col = rgb(red = 1, green = 0, blue = 0), lwd = 3,
main = "Isochrone Comparison Plot:\nHERE in Red, OSRM in Blue")
plot(osrm2hr, col = rgb(red = 0, green = 0, blue = 1, alpha = 0.5),
add = TRUE, lwd = 3)
Step 7: One hour comparison
Build HERE isolines
The second part of this analysis compared isolines created by HERE with isochrones created by Mapbox to analyze if one method created more accurate catchment areas up to one hour from the starting location, City Hall in Philadelphia.
# Build isolines using HERE API
# Track how long it takes to build the isolines
start.time <- Sys.time()
# Download data from HERE API
here1hr <- isoline(
poi = start.sf,
range = seq(15, 60, 15) * 60,
range_type = "time",
datetime <- as.POSIXct(paste0(Sys.Date()," 10:00"))
)
# Name catchment areas
here1hr$name <- here1hr$range / 60
# Create spatial polygons data frame
here1hr.sp <- as(here1hr, "Spatial")
# Add information for graphics and further analyses
here1hr.sp@data$name <- here1hr.sp$range / 60
here1hr.sp@data$id <- 1:nrow(here1hr.sp@data)
here1hr.sp@data$drive_times <- factor(paste0(here1hr.sp@data$id,
". ", as.numeric(here1hr.sp@data$name) - 15,
" to ", here1hr.sp@data$name, " min"))
# Stop timer for isoline creation
stop.time <- Sys.time()
here1hr.time.diff <- round(difftime(stop.time, start.time, units = c("mins")), 2)
# Create a color palette for the 1 hour HERE catchment areas
here1hr.colors <- c("#a6d96a", "#66bd63", "#1a9850", "#006837")
here1hr.pal <- colorFactor(here1hr.colors, here1hr.sp@data$drive_times)
# Remove data that is no longer needed
rm(start.time, stop.time)
# Check HERE 1 hour polygons
plot(here1hr.sp)
Build Mapbox isochrone
Mapbox token available here.
# Track how long it takes to build the isochrones
start.time <- Sys.time()
# Compile coordinates for the starting point (City Hall)
coord <- paste0(start$lon,",",start$lat)
# Create catchment area breaks (drive time minutes)
sub1 <- "15"
sub2 <- "30"
sub3 <- "45"
sub4 <- "60"
time <- paste0(sub1,",",sub2,",",sub3,",",sub4)
# Download data from Mapbox API
iso.url <- paste("https://api.mapbox.com/isochrone/v1/mapbox/driving/",coord,
"?contours_minutes=",time,"&polygons=true&access_token=",token,sep = "")
# Compile each individual catchment area polygon
r <- GET(url = iso.url)
r.header <- headers(r)
rr <- content(r, "text")
rrr <- FROM_GeoJson(rr)
sr1 <- Polygon(rrr[["features"]][[1]][["geometry"]][["coordinates"]], hole = TRUE)
srs1 <- Polygons(list(sr1), sub1)
sr2 <- Polygon(rrr[["features"]][[2]][["geometry"]][["coordinates"]], hole = TRUE)
srs2 <- Polygons(list(sr2), sub2)
sr3 <- Polygon(rrr[["features"]][[3]][["geometry"]][["coordinates"]], hole = TRUE)
srs3 <- Polygons(list(sr3), sub3)
sr4 <- Polygon(rrr[["features"]][[4]][["geometry"]][["coordinates"]], hole = TRUE)
srs4 <- Polygons(list(sr4), sub4)
# Combine catchment area polygons into one shapefile
poly <- SpatialPolygons(list(srs4, srs3, srs2, srs1), 1:4)
mapbox1hr <- SpatialPolygonsDataFrame(poly,data = data.frame(name = c(4,3,2,1),
row.names = row.names(poly)))
# Add projection
proj4string(mapbox1hr) <- "+proj=longlat +datum=WGS84 +no_defs"
# Add information for graphics and further analyses
mapbox1hr@data$name <- c(sub1, sub2, sub3, sub4)
mapbox1hr@data$id <- 1:nrow(mapbox1hr@data)
mapbox1hr@data$drive_times <- factor(paste0(mapbox1hr@data$id,
". ", as.numeric(mapbox1hr@data$name) - 15,
" to ", mapbox1hr@data$name, " min"))
# Stop timer for isochrones creation
stop.time <- Sys.time()
mb1hr.time.diff <- round(difftime(stop.time, start.time, units = c("mins")), 2)
# Create a color palette for the Mapbox 1 hour catchment areas
mb1hr.colors <- c("#f1b6da", "#de77ae", "#c51b7d", "#8e0152")
mb1hr.pal <- colorFactor(mb1hr.colors, mapbox1hr@data$drive_times)
# Remove data that is no longer needed
rm(coord, sub1, sub2, sub3, sub4, time, iso.url, r, r.header, rr, rrr,
sr1, srs1, sr2, srs2, sr3, srs3, sr4, srs4, poly, start.time, stop.time)
# Check 1 hour Mapbox polygons
plot(mapbox1hr)
Step 8: One hour maps
HERE isolines map
The interactive map below displays the 1 hour isolines created by HERE (in 15-minute drive time intervals) from City Hall in Philadelphia. All Wawa locations identified within a 1.5 hour drive are plotted for analysis.
# Color palette for Wawa locations
wawa.here1hr.pal <- colorFactor(here1hr.colors, domain = c(here1hr.sp$name))
wawa90min.points <- wawa.points[wawa.points$iso_goal <= 90,]
wawa90min.points.sp <- wawa.points.sp[wawa.points.sp$iso_goal <= 90, -c(4:6)]
#Plot HERE isolines with points of interest
leaflet() %>%
setView(start$lon-.2, start$lat, zoom = 8) %>%
addProviderTiles("CartoDB.Positron", group="Greyscale") %>%
addPolygons(fill=TRUE, stroke=TRUE, color = "black",
fillColor = ~here1hr.pal(here1hr.sp@data$drive_times),
weight=0.5, fillOpacity=0.35,
data = here1hr.sp, popup = here1hr.sp@data$drive_times,
group = "Drive Time") %>%
addCircles(wawa90min.points$lon, wawa90min.points$lat,
color = wawa.here1hr.pal(as.factor(wawa90min.points$iso_goal)),
radius = 5, opacity = 1) %>%
# Add a legend
addLegend("bottomleft", pal = here1hr.pal, values = here1hr.sp@data$drive_time,
opacity = 0.35, title = "HERE 1 Hour Isolines")Mapbox isochrones map
The interactive map below behaves like the graphic above, but displays the 1 hour isochrones created by Mapbox.
# Color palette for Wawa locations
wawa.mb1hr.pal <- colorFactor(mb1hr.colors, domain = c(mapbox1hr$name))
#Plot mapbox isochrones with points of interest
leaflet() %>%
setView(start$lon-.2, start$lat, zoom = 8) %>%
addProviderTiles("CartoDB.Positron", group="Greyscale") %>%
addPolygons(fill=TRUE, stroke=TRUE, color = "black",
fillColor = ~mb1hr.pal(mapbox1hr@data$drive_times),
weight=0.5, fillOpacity=0.35,
data = mapbox1hr, popup = mapbox1hr@data$drive_times,
group = "Drive Time") %>%
addCircles(wawa90min.points$lon, wawa90min.points$lat,
color = wawa.mb1hr.pal(as.factor(wawa90min.points$iso_goal)),
radius = 5, opacity = 1) %>%
# Add a legend
addLegend("bottomleft", pal = mb1hr.pal, values = mapbox1hr@data$drive_time,
opacity=0.35, title = "Mapbox 1 Hour Isochrones")Step 9: One hour analysis
This step added the catchment areas for both sets of isochrones (HERE and Mapbox) to all Wawa locations within a 1.5 hour drive of City Hall in Philadelphia. Both isochrones correctly omitted locations that were more than a one hour drive away from City Hall, and both accurately placed most locations within a 1 hour drive from City Hall. The results, displayed below, showed that HERE was more accurate than Mapbox with catchment area placements overall and for most 15-minute time band.
# Use same projections
here1hr.sp@proj4string@projargs <- wawa90min.points.sp@proj4string@projargs
mapbox1hr@proj4string@projargs <- wawa90min.points.sp@proj4string@projargs
# Add catchment areas to Wawa locations
wawa90min.points.sp$here <- over(wawa90min.points.sp, here1hr.sp)$name
wawa90min.points.sp$mapbox <- over(wawa90min.points.sp, mapbox1hr)$name
wawa90min.points.sp@data[is.na(wawa90min.points.sp@data)] <- 999
# Analyze catchment areas
wawa90min.points.sp$accurate <-
ifelse(wawa90min.points.sp$here == wawa90min.points.sp$iso_goal &
wawa90min.points.sp$mapbox == wawa90min.points.sp$iso_goal, "both",
ifelse(wawa90min.points.sp$here == wawa90min.points.sp$iso_goal &
wawa90min.points.sp$mapbox != wawa90min.points.sp$iso_goal, "here",
ifelse(wawa90min.points.sp$here != wawa90min.points.sp$iso_goal &
wawa90min.points.sp$mapbox == wawa90min.points.sp$iso_goal, "mapbox", "neither")))
# Overall catchment area accuracy
count(wawa90min.points.sp@data, accurate) %>%
mutate(count = n,percent = round(n/sum(n),4) * 100) %>%
select(-n) %>%
arrange(desc(count)) %>%
kbl(caption = "Frequency of Overall Accurate Catchment Area Placements by Isochrone API",
align = "r", row.names = FALSE) %>%
kable_minimal("hover")| accurate | count | percent |
|---|---|---|
| both | 220 | 43.22 |
| neither | 200 | 39.29 |
| here | 78 | 15.32 |
| mapbox | 11 | 2.16 |
# Group data by catchment area goals
iso1hr.counts <- wawa90min.points.sp@data %>%
dplyr::count(iso_goal, accurate) %>%
tidyr::spread(accurate, n) %>%
select(iso_goal, both, here, mapbox, neither) %>%
rowwise %>%
mutate(total = sum(c(both, here, mapbox, neither), na.rm = TRUE),
both_pct = 100 * round(both / total, 4),
here_pct = 100 * round(sum(here, both, na.rm = TRUE) / total, 4),
mapbox_pct = 100 * round(sum(mapbox, both, na.rm = TRUE) / total, 4),
none_pct = 100 * round(neither / total, 4)) %>%
replace(is.na(.), 0)
# Catchment area accuracy by groups
iso1hr.counts %>%
dplyr::select(iso_goal:total) %>%
mutate(mapbox = cell_spec(mapbox, "html",
color = ifelse(mapbox < here, "red", "black"))) %>%
kbl(caption = "Frequency of Accurate Catchment Area Placements by Isochrone API",
align = "r", format = "html", escape = F, row.names = FALSE) %>%
kable_minimal("hover") %>%
column_spec(column = 1:6, width = "1.5in")| iso_goal | both | here | mapbox | neither | total |
|---|---|---|---|---|---|
| 15 | 26 | 3 | 3 | 4 | 36 |
| 30 | 101 | 23 | 3 | 19 | 146 |
| 45 | 57 | 35 | 5 | 31 | 128 |
| 60 | 36 | 17 | 0 | 24 | 77 |
| 75 | 0 | 0 | 0 | 80 | 80 |
| 90 | 0 | 0 | 0 | 42 | 42 |
# Percent of catchment area accuracy by groups
iso1hr.counts %>%
dplyr::select(iso_goal, both_pct:none_pct, total) %>%
mutate(mapbox_pct = cell_spec(mapbox_pct, "html",
color = ifelse(mapbox_pct < here_pct, "red", "black"))) %>%
kbl(caption = "Percent of Accurate Catchment Area Placements by Isochrone API
(counts ''both'' as correct for HERE and Mapbox)",
align = "r", format = "html", escape = F, row.names = FALSE) %>%
kable_minimal("hover") %>%
column_spec(column = 1:6, width = "1.5in")| iso_goal | both_pct | here_pct | mapbox_pct | none_pct | total |
|---|---|---|---|---|---|
| 15 | 72.22 | 80.56 | 80.56 | 11.11 | 36 |
| 30 | 69.18 | 84.93 | 71.23 | 13.01 | 146 |
| 45 | 44.53 | 71.88 | 48.44 | 24.22 | 128 |
| 60 | 46.75 | 68.83 | 46.75 | 31.17 | 77 |
| 75 | 0.00 | 0.00 | 0 | 100.00 | 80 |
| 90 | 0.00 | 0.00 | 0 | 100.00 | 42 |
Note: Cells in red indicate a catchment area where HERE was more accurate than Mapbox.
The HERE isolines generated above took 0.07 minutes to create, and the Mapbox isochrone took 0.04 minutes to create. HERE isolines correctly placed 77% of the Wawa locations within a 1 hour drive of City Hall in Philadelphia, and the Mapbox isochrones correctly placed 59.69% of those same locations. The HERE isolines outperformed Mapbox’s isochrones with catchment area placement at all 15-minute intervals between a 15 and 60 minute drive. Neither method included a location further than 1 hour from City Hall in their catchment areas.
# Plot 1 hour catchment areas over each other
plot(here1hr.sp, col = rgb(red = 0, green = 1, blue = 0), lwd = 3,
main = "Isochrone Comparison Plot:\nHERE in Green, Mapbox in Red")
plot(mapbox1hr, col = rgb(red = 1, green = 0, blue = 0, alpha = 0.5), add = TRUE,
lwd = 3)
Conclusion
HERE’s isolines API created more accurate catchment areas than both OSRM and Mapbox when compared to drive times calculated from Bing Maps. Additionally, HERE’s isolines generated in a fraction of the time of OSRM’s isochrones, and in a comparable time to Mapbox’s isochrones. HERE’s isolines API also appears to allow for more input options than OSRM and Mapbox, giving more flexibility with how they will be used.