Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

How can i plot multiple isochrone polygons using OSRM in R?

Tags:

r

maps

osrm

I have successfully managed to recreate the drive time polygon in R using This Example Post

The above post only deals with ONE single polygon with isochrones

Problem - I want to plot MULTIPLE drive time polygons on 5 different map points

I have managed to do this in a VERY laborious fashion by creating 5 seperate isochrones, and then adding 5 polygons to my Leaflet Map

#Preparing multiple dependancies----
packages <- c("readxl","dplyr","leaflet","htmltools", "sp", "osrm")
install.packages(packages)
lapply(packages, library,character.only=TRUE)

###

#Loading in Locations----
Location <- read_excel("filepath.xlsx", sheet=1)

###

#Extract Lon and Lat and create spatial dataframe
xy <- Location[, c(3,4)]

spatialdf <- SpatialPointsDataFrame(coords = xy, data = Location, proj4string = CRS("+proj=longlat +datum=WGS84 +ellps=WGS84 +towgs84=0,0,0"))
class(spatialdf)

#Create Isochrone points
iso1 <- osrmIsochrone(loc = c(-2.3827439,53.425705), breaks = seq(from = 0, to = 60, by = 5))
iso2 <- osrmIsochrone(loc = c(-0.85074928,51.325871), breaks = seq(from = 0, to = 60, by = 5)) 
iso3 <- osrmIsochrone(loc = c(-2.939367,51.570344), breaks = seq(from = 0, to = 60, by = 5)) 
iso4 <- osrmIsochrone(loc = c(-3.9868026,55.823102), breaks = seq(from = 0, to = 60, by = 5)) 
iso5 <- osrmIsochrone(loc = c(-0.92104073,53.709006), breaks = seq(from = 0, to = 60, by = 5))


#Create Drive Time Interval descriptions
iso1@data$drive_times <- factor(paste(iso1@data$min, "to", iso1@data$max, "mins"))
iso2@data$drive_times <- factor(paste(iso2@data$min, "to", iso2@data$max, "mins"))
iso3@data$drive_times <- factor(paste(iso3@data$min, "to", iso3@data$max, "mins"))
iso4@data$drive_times <- factor(paste(iso4@data$min, "to", iso4@data$max, "mins"))
iso5@data$drive_times <- factor(paste(iso5@data$min, "to", iso5@data$max, "mins"))

#Create Colour Palette for each time interval
factPal1 <- colorFactor(rev(heat.colors(12)), iso1@data$drive_times)
factPal2 <- colorFactor(rev(heat.colors(12)), iso2@data$drive_times)
factPal3 <- colorFactor(rev(heat.colors(12)), iso3@data$drive_times)
factPal4 <- colorFactor(rev(heat.colors(12)), iso4@data$drive_times)
factPal5 <- colorFactor(rev(heat.colors(12)), iso5@data$drive_times)

#Draw Map
leaflet()%>%
  addProviderTiles("CartoDB.Positron", group="Greyscale")%>%
  addMarkers(data=spatialdf,lng=spatialdf$Longitude, lat=spatialdf$Latitude, popup = htmlEscape(~`Locate`))%>%
  addPolygons(fill = TRUE, stroke = TRUE, color = "black",fillColor = ~factPal1(iso1@data$drive_times), weight = 0.5, fillOpacity = 0.2, data=iso1, popup = iso1@data$drive_times, group = "Drive Time")%>%
  addPolygons(fill = TRUE, stroke = TRUE, color = "black",fillColor = ~factPal2(iso2@data$drive_times), weight = 0.5, fillOpacity = 0.2, data=iso2, popup = iso2@data$drive_times, group = "Drive Time")%>%
  addPolygons(fill = TRUE, stroke = TRUE, color = "black",fillColor = ~factPal3(iso3@data$drive_times), weight = 0.5, fillOpacity = 0.2, data=iso3, popup = iso3@data$drive_times, group = "Drive Time")%>%
  addPolygons(fill = TRUE, stroke = TRUE, color = "black",fillColor = ~factPal4(iso4@data$drive_times), weight = 0.5, fillOpacity = 0.2, data=iso4, popup = iso4@data$drive_times, group = "Drive Time")%>%
  addPolygons(fill = TRUE, stroke = TRUE, color = "black",fillColor = ~factPal5(iso5@data$drive_times), weight = 0.5, fillOpacity = 0.2, data=iso5, popup = iso5@data$drive_times, group = "Drive Time")%>%
  addLegend("bottomright", pal = factPal1, values = iso1@data$drive_times, title = "Drive Time")  

Not sure why i cannot just refer to the Spatial dataframe that i made ? like this...

iso <- osrmIsochrone(loc = c(spatialdf$Longitude,spatialdf$Latitude), breaks = seq(from = 0, to = 60, by = 5))

This gives me the error: break values do not fit the raster values

and then just use 1 polygon to map all of them? like this...

leaflet()%>%
  addProviderTiles("CartoDB.Positron", group="Greyscale")%>%
  addMarkers(data=spatialdf,lng=spatialdf$Longitude, lat=spatialdf$Latitude, popup = htmlEscape(~`Locate`))%>%
  addPolygons(fill = TRUE, stroke = TRUE, color = "black",fillColor = ~factPal(iso@data$drive_times), weight = 0.5, fillOpacity = 0.2, data=iso, popup = iso@data$drive_times, group = "Drive Time")%>%
  addLegend("bottomright", pal = factPal, values = iso@data$drive_times, title = "Drive Time")  
like image 690
mojo3340 Avatar asked Apr 05 '18 09:04

mojo3340


2 Answers

Consider a DRY-er (i.e., Don't Repeat Yourself) approach by building a list of items and then iterate through the piping chain:

# LIST OF COORDS
loc_list <- list(c(-2.3827439, 53.425705), c(-0.85074928, 51.325871), 
                 c(-2.939367,51.570344), c(-3.9868026, 55.823102), 
                 c(-0.92104073, 53.709006))

isoc_items <- lapply(loc_list, function(i) {
    iso <- osrmIsochrone(loc = i, breaks = seq(from = 0, to = 60, by = 5))
    iso@data$drive_times <- factor(paste(iso@data$min, "to", iso@data$max, "mins"))

    # NAMED LIST OF TWO ITEMS 
    list(iso = iso, factPal = colorFactor(rev(heat.colors(12)), iso@data$drive_times))
})


leaflet()%>%
  addProviderTiles("CartoDB.Positron", group="Greyscale")%>%
  addMarkers(data = spatialdf, lng = spatialdf$Longitude, 
             lat = spatialdf$Latitude, popup = htmlEscape(~`Locate`))%>%

  # ITERATE TO ADD POLYGONS
  for (item in isoc_items) { 
      addPolygons(fill = TRUE, stroke = TRUE, color = "black", 
                  fillColor = ~item$factPal(item$iso@data$drive_times), 
                  weight = 0.5, fillOpacity = 0.2, data = item$iso, 
                  popup = item$iso@data$drive_times, group = "Drive Time")%>%
  }

  addLegend("bottomright", pal = isoc_items[[1]]$factPal, 
            values = isoc_items[[1]]$iso@data$drive_times, title = "Drive Time") 
like image 70
Parfait Avatar answered Nov 16 '22 06:11

Parfait


@Parfait has a good use of lapply that I would keep, so I won't recreate it for my answer. For your question of only looking to refer to one spatial polygon dataframe in your call to addPolygon you can use rbind once they are created. Note this only uses one colorFactor set.

#Create Isochrone points
iso1 <- osrmIsochrone(loc = c(-2.3827439,53.425705), breaks = seq(from = 0, to = 60, by = 5))
iso2 <- osrmIsochrone(loc = c(-0.85074928,51.325871), breaks = seq(from = 0, to = 60, by = 5)) 
iso3 <- osrmIsochrone(loc = c(-2.939367,51.570344), breaks = seq(from = 0, to = 60, by = 5)) 
iso4 <- osrmIsochrone(loc = c(-3.9868026,55.823102), breaks = seq(from = 0, to = 60, by = 5)) 
iso5 <- osrmIsochrone(loc = c(-0.92104073,53.709006), breaks = seq(from = 0, to = 60, by = 5))

iso <- rbind(iso1, iso2,iso3,iso4,iso5)

#Create Drive Time Interval descriptions
iso@data$drive_times <- factor(paste(iso@data$min, "to", iso@data$max, "mins"))

#Create Colour Palette for each time interval
factPal <- colorFactor(rev(heat.colors(12)), iso@data$drive_times)

#Draw Map
leaflet()%>%
  addProviderTiles("CartoDB.Positron", group="Greyscale")%>%
  # addMarkers(data=spatialdf,lng=spatialdf$Longitude, lat=spatialdf$Latitude, popup = htmlEscape(~`Locate`))%>%
  addPolygons(fill = TRUE, stroke = TRUE, color = "black",fillColor = ~factPal(iso@data$drive_times), weight = 0.5, fillOpacity = 0.2, data=iso, popup = iso@data$drive_times, group = "Drive Time") %>%
addLegend("bottomright", pal = factPal, values = iso@data$drive_times, title = "Drive Time")  
like image 2
RPyStats Avatar answered Nov 16 '22 07:11

RPyStats