library(hubway) # devtools::install_github("hrbrmstr/hubway")
library(raster)
library(dplyr)
library(ggplot2)
library(tigris)
library(sp)
library(rgeos)
library(ggrepel)
library(leaflet)
library(ggthemes)
The hubway API exposes a single function, get_stations() that returns a data_frame of Hubway stations (with all the metadata) and their status.
hubs <- get_stations()
We can get an overview of all the stations with leaflet:
leaflet() %>%
addTiles() %>%
addMarkers(hubs$lon, hubs$lat,
popup=sprintf("%s\n(%s)", hubs$name, hubs$short_name))
Or at the console (wrap this with View(), esp if using RStudio):
arrange(select(hubs, name, short_name), name)
## # A tibble: 162 x 2
## name short_name
## <chr> <chr>
## 1 359 Broadway - Broadway at Fayette Street M32026
## 2 Agganis Arena - 925 Comm Ave. A32002
## 3 Alewife Station at Russell Field M32033
## 4 Allston Green District - Commonwealth Ave & Griggs St A32017
## 5 Ames St at Main St M32037
## 6 Andrew Station - Dorchester Ave at Humboldt Pl C32012
## 7 Aquarium Station - 200 Atlantic Ave. B32004
## 8 B.U. Central - 725 Comm. Ave. A32003
## 9 Back Bay / South End Station C32003
## 10 Beacon St / Mass Ave B32016
## # ... with 152 more rows
I have a set of stations that I “need” to monitor since I commute to/from Boston North station to where I work a couple days a week in Cambridge. I’ve already looked them up:
my_stations <- c("A32025", "D32022", "D32003", "M32019", "M32032", "M32003", "D32016", "D32000")
df <- filter(hubs, short_name %in% my_stations)
Now, a leaflet map is all well and good, but I like ggplot2 maps. It would be nice to have something to put dots on. I thought it’d be interesting to plot them on the streets they’re on. We can use the tigris package for this.
First, we’ll get the roads for the two counties (Boston is in Suffolk county and Cambridge is in Middlesex county).
suffolk <- roads("MA", "Suffolk")
middlesex <- roads("MA", "Middlesex")
Now, we’ll bring in a function made by Robin Lovelace that makes it easier to clip shapefiles, since we only want to focus on the roads that are within the bounding box of the statons we’re interested in.
gClip <- function(shp, bb){
if(class(bb) == "matrix") b_poly <- as(extent(as.vector(t(bb))), "SpatialPolygons")
else b_poly <- as(extent(bb), "SpatialPolygons")
gIntersection(shp, b_poly, byid = TRUE)
}
Here’s how to make said bounding box. I used expand_range() since we want a bit of a buffer around the points:
x <- expand_range(range(df$lon), add=0.002)
y <- expand_range(range(df$lat), add=0.002)
area <- as.matrix(data.frame(min=c(x[1],y[1]), max=c(x[2],y[2]), row.names=c("x", "y")))
Now, we’ll clip these lines and turn them into something we can foritfy for use with ggplot2:
gClip(suffolk, area) %>%
SpatialLinesDataFrame(., data=data.frame(x=1:length(.)), FALSE) -> bos_roads
gClip(middlesex, area) %>%
SpatialLinesDataFrame(., data=data.frame(x=1:length(.)), FALSE) -> cam_roads
And, now we’ll do said fortifying:
bos_roads <- fortify(bos_roads)
cam_roads <- fortify(cam_roads)
Those operations can take a bit, so we can save some time by caching the fortified shapes and load them when we need them if we plan on doing this often:
save(bos_roads, cam_roads, file="boscam.rda")
We’d do the following to get our fortified data frames back:
And, now we just do standard ggplot idioms to plot some points with some labels and a legend to let us know how many bikes are available.
ggplot(df) +
geom_path(aes(long, lat, group=group, order=order), bos_roads, size=0.1, color="#2b2b2b") +
geom_path(aes(long, lat, group=group, order=order), cam_roads, size=0.1, color="#2b2b2b") +
geom_point(aes(lon, lat, color=num_bikes_available>0), size=2) +
geom_label_repel(aes(lon, lat, label=sprintf("%s/%s", num_bikes_available, capacity)),
family="Arial Narrow", size=3) +
scale_color_manual(name="Bikes Avail?", values=c(`TRUE`="#1a9850", `FALSE`="#d73027")) +
coord_map() +
labs(title=sprintf("Hubway Dock Status as of %s", as.character(Sys.time()))) +
theme_map(base_family="Arial Narrow") +
theme(legend.position=c(0.2, 0.01)) +
theme(legend.key=element_blank()) +
theme(legend.direction="horizontal") +
theme(plot.title=element_text(face="bold", size=16))

IycgLS0tCiMnIHRpdGxlOiAiV29ya2luZyB3aXRoIHRoZSBIdWJ3YXkgJ0FQSSciCiMnIGF1dGhvcjogIkBocmJybXN0ciIKIycgZGF0ZTogIiIKIycgb3V0cHV0OgojJyAgIGh0bWxfZG9jdW1lbnQ6CiMnICAgICB0aGVtZTogc2ltcGxleAojJyAgICAgY29kZV9kb3dubG9hZDogdHJ1ZQojJyAtLS0KCiMrIG1lc3NhZ2U9RkFMU0UKbGlicmFyeShodWJ3YXkpICMgZGV2dG9vbHM6Omluc3RhbGxfZ2l0aHViKCJocmJybXN0ci9odWJ3YXkiKQpsaWJyYXJ5KHJhc3RlcikKbGlicmFyeShkcGx5cikKbGlicmFyeShnZ3Bsb3QyKQpsaWJyYXJ5KHRpZ3JpcykKbGlicmFyeShzcCkKbGlicmFyeShyZ2VvcykKbGlicmFyeShnZ3JlcGVsKQpsaWJyYXJ5KGxlYWZsZXQpCmxpYnJhcnkoZ2d0aGVtZXMpCgojJyBUaGUgYGh1YndheWAgQVBJIGV4cG9zZXMgYSBzaW5nbGUgZnVuY3Rpb24sIGBnZXRfc3RhdGlvbnMoKWAgdGhhdAojJyByZXR1cm5zIGEgYGRhdGFfZnJhbWVgIG9mIEh1YndheSBzdGF0aW9ucyAod2l0aCBhbGwgdGhlIG1ldGFkYXRhKQojJyBhbmQgdGhlaXIgc3RhdHVzLgoKIysgY2FjaGU9VFJVRQpodWJzIDwtIGdldF9zdGF0aW9ucygpCgojJyBXZSBjYW4gZ2V0IGFuIG92ZXJ2aWV3IG9mIGFsbCB0aGUgc3RhdGlvbnMgd2l0aCBsZWFmbGV0OgoKbGVhZmxldCgpICU+JQogIGFkZFRpbGVzKCkgJT4lCiAgYWRkTWFya2VycyhodWJzJGxvbiwgaHVicyRsYXQsCiAgICAgICAgICAgICBwb3B1cD1zcHJpbnRmKCIlc1xuKCVzKSIsIGh1YnMkbmFtZSwgaHVicyRzaG9ydF9uYW1lKSkKCiMnIE9yIGF0IHRoZSBjb25zb2xlICh3cmFwIHRoaXMgd2l0aCBgVmlldygpYCwgZXNwIGlmIHVzaW5nIFJTdHVkaW8pOgoKYXJyYW5nZShzZWxlY3QoaHVicywgbmFtZSwgc2hvcnRfbmFtZSksIG5hbWUpCgojJyBJIGhhdmUgYSBzZXQgb2Ygc3RhdGlvbnMgdGhhdCBJICJuZWVkIiB0byBtb25pdG9yIHNpbmNlIEkgY29tbXV0ZSB0by9mcm9tCiMnIEJvc3RvbiBOb3J0aCBzdGF0aW9uIHRvIHdoZXJlIEkgd29yayBhIGNvdXBsZSBkYXlzIGEgd2VlayBpbgojJyBDYW1icmlkZ2UuIEkndmUgYWxyZWFkeSBsb29rZWQgdGhlbSB1cDoKCm15X3N0YXRpb25zIDwtIGMoIkEzMjAyNSIsICJEMzIwMjIiLCAiRDMyMDAzIiwgIk0zMjAxOSIsICJNMzIwMzIiLCAiTTMyMDAzIiwgIkQzMjAxNiIsICJEMzIwMDAiKQoKZGYgPC0gZmlsdGVyKGh1YnMsIHNob3J0X25hbWUgJWluJSBteV9zdGF0aW9ucykKCiMnIE5vdywgYSBsZWFmbGV0IG1hcCBpcyBhbGwgd2VsbCBhbmQgZ29vZCwgYnV0IEkgbGlrZSBnZ3Bsb3QyIG1hcHMuIEl0IHdvdWxkIGJlCiMnIG5pY2UgdG8gaGF2ZSBzb21ldGhpbmcgdG8gcHV0IGRvdHMgb24uIEkgdGhvdWdodCBpdCdkIGJlIGludGVyZXN0aW5nIHRvIHBsb3QgdGhlbQojJyBvbiB0aGUgc3RyZWV0cyB0aGV5J3JlIG9uLiBXZSBjYW4gdXNlIHRoZSBgdGlncmlzYCBwYWNrYWdlIGZvciB0aGlzLgojJwojJyBGaXJzdCwgd2UnbGwgZ2V0IHRoZSByb2FkcyBmb3IgdGhlIHR3byBjb3VudGllcyAoQm9zdG9uIGlzIGluIFN1ZmZvbGsgY291bnR5CiMnIGFuZCBDYW1icmlkZ2UgaXMgaW4gTWlkZGxlc2V4IGNvdW50eSkuCgojKyBldmFsPUZBTFNFCnN1ZmZvbGsgPC0gcm9hZHMoIk1BIiwgIlN1ZmZvbGsiKQptaWRkbGVzZXggPC0gcm9hZHMoIk1BIiwgIk1pZGRsZXNleCIpCgojJyBOb3csIHdlJ2xsIGJyaW5nIGluIGEgZnVuY3Rpb24gbWFkZSBieSBSb2JpbiBMb3ZlbGFjZSB0aGF0IG1ha2VzIGl0IGVhc2llciB0bwojJyBjbGlwIHNoYXBlZmlsZXMsIHNpbmNlIHdlIG9ubHkgd2FudCB0byBmb2N1cyBvbiB0aGUgcm9hZHMgdGhhdCBhcmUgd2l0aGluCiMnIHRoZSBib3VuZGluZyBib3ggb2YgdGhlIHN0YXRvbnMgd2UncmUgaW50ZXJlc3RlZCBpbi4KCiMrIGV2YWw9RkFMU0UKZ0NsaXAgPC0gZnVuY3Rpb24oc2hwLCBiYil7CiAgaWYoY2xhc3MoYmIpID09ICJtYXRyaXgiKSBiX3BvbHkgPC0gYXMoZXh0ZW50KGFzLnZlY3Rvcih0KGJiKSkpLCAiU3BhdGlhbFBvbHlnb25zIikKICBlbHNlIGJfcG9seSA8LSBhcyhleHRlbnQoYmIpLCAiU3BhdGlhbFBvbHlnb25zIikKICBnSW50ZXJzZWN0aW9uKHNocCwgYl9wb2x5LCBieWlkID0gVFJVRSkKfQoKIycgSGVyZSdzIGhvdyB0byBtYWtlIHNhaWQgYm91bmRpbmcgYm94LiBJIHVzZWQgYGV4cGFuZF9yYW5nZSgpYCBzaW5jZSB3ZQojJyB3YW50IGEgYml0IG9mIGEgYnVmZmVyIGFyb3VuZCB0aGUgcG9pbnRzOgoKIysgZXZhbD1GQUxTRQp4IDwtIGV4cGFuZF9yYW5nZShyYW5nZShkZiRsb24pLCBhZGQ9MC4wMDIpCnkgPC0gZXhwYW5kX3JhbmdlKHJhbmdlKGRmJGxhdCksIGFkZD0wLjAwMikKYXJlYSA8LSBhcy5tYXRyaXgoZGF0YS5mcmFtZShtaW49Yyh4WzFdLHlbMV0pLCBtYXg9Yyh4WzJdLHlbMl0pLCByb3cubmFtZXM9YygieCIsICJ5IikpKQoKIycgTm93LCB3ZSdsbCBjbGlwIHRoZXNlIGxpbmVzIGFuZCB0dXJuIHRoZW0gaW50byBzb21ldGhpbmcgd2UgY2FuIGZvcml0ZnkKIycgZm9yIHVzZSB3aXRoIGdncGxvdDI6CgojKyBldmFsPUZBTFNFCmdDbGlwKHN1ZmZvbGssIGFyZWEpICU+JQogIFNwYXRpYWxMaW5lc0RhdGFGcmFtZSguLCBkYXRhPWRhdGEuZnJhbWUoeD0xOmxlbmd0aCguKSksIEZBTFNFKSAtPiBib3Nfcm9hZHMKCmdDbGlwKG1pZGRsZXNleCwgYXJlYSkgJT4lCiAgU3BhdGlhbExpbmVzRGF0YUZyYW1lKC4sIGRhdGE9ZGF0YS5mcmFtZSh4PTE6bGVuZ3RoKC4pKSwgRkFMU0UpIC0+IGNhbV9yb2FkcwoKIycgQW5kLCBub3cgd2UnbGwgZG8gc2FpZCBmb3J0aWZ5aW5nOgoKIysgZXZhbD1GQUxTRQpib3Nfcm9hZHMgPC0gZm9ydGlmeShib3Nfcm9hZHMpCmNhbV9yb2FkcyA8LSBmb3J0aWZ5KGNhbV9yb2FkcykKCiMnIFRob3NlIG9wZXJhdGlvbnMgY2FuIHRha2UgYSBiaXQsIHNvIHdlIGNhbiBzYXZlIHNvbWUgdGltZSBieSBjYWNoaW5nCiMnIHRoZSBmb3J0aWZpZWQgc2hhcGVzIGFuZCBsb2FkIHRoZW0gd2hlbiB3ZSBuZWVkIHRoZW0gaWYgd2UgcGxhbiBvbgojJyBkb2luZyB0aGlzIG9mdGVuOgoKIysgZXZhbD1GQUxTRQpzYXZlKGJvc19yb2FkcywgY2FtX3JvYWRzLCBmaWxlPSJib3NjYW0ucmRhIikKCiMnIFdlJ2QgZG8gdGhlIGZvbGxvd2luZyB0byBnZXQgb3VyIGZvcnRpZmllZCBkYXRhIGZyYW1lcyBiYWNrOgoKIysgZXZhbD1UUlVFLCBlY2hvPUZBTFNFCmxvYWQoImJvc2NhbS5yZGEiKQoKIycgQW5kLCBub3cgd2UganVzdCBkbyBzdGFuZGFyZCBnZ3Bsb3QgaWRpb21zIHRvIHBsb3Qgc29tZSBwb2ludHMgd2l0aAojJyBzb21lIGxhYmVscyBhbmQgYSBsZWdlbmQgdG8gbGV0IHVzIGtub3cgaG93IG1hbnkgYmlrZXMgYXJlIGF2YWlsYWJsZS4KCiMrIGZpZy5yZXRpbmE9MiwgZmlnLndpZHRoPTgsIGZpZy5oZWlnaHQ9NQpnZ3Bsb3QoZGYpICsKICBnZW9tX3BhdGgoYWVzKGxvbmcsIGxhdCwgZ3JvdXA9Z3JvdXAsIG9yZGVyPW9yZGVyKSwgYm9zX3JvYWRzLCBzaXplPTAuMSwgY29sb3I9IiMyYjJiMmIiKSArCiAgZ2VvbV9wYXRoKGFlcyhsb25nLCBsYXQsIGdyb3VwPWdyb3VwLCBvcmRlcj1vcmRlciksIGNhbV9yb2Fkcywgc2l6ZT0wLjEsIGNvbG9yPSIjMmIyYjJiIikgKwogIGdlb21fcG9pbnQoYWVzKGxvbiwgbGF0LCBjb2xvcj1udW1fYmlrZXNfYXZhaWxhYmxlPjApLCBzaXplPTIpICsKICBnZW9tX2xhYmVsX3JlcGVsKGFlcyhsb24sIGxhdCwgbGFiZWw9c3ByaW50ZigiJXMvJXMiLCBudW1fYmlrZXNfYXZhaWxhYmxlLCBjYXBhY2l0eSkpLAogICAgICAgICAgICAgICAgICAgZmFtaWx5PSJBcmlhbCBOYXJyb3ciLCBzaXplPTMpICsKICBzY2FsZV9jb2xvcl9tYW51YWwobmFtZT0iQmlrZXMgQXZhaWw/IiwgdmFsdWVzPWMoYFRSVUVgPSIjMWE5ODUwIiwgYEZBTFNFYD0iI2Q3MzAyNyIpKSArCiAgY29vcmRfbWFwKCkgKwogIGxhYnModGl0bGU9c3ByaW50ZigiSHVid2F5IERvY2sgU3RhdHVzIGFzIG9mICVzIiwgYXMuY2hhcmFjdGVyKFN5cy50aW1lKCkpKSkgKwogIHRoZW1lX21hcChiYXNlX2ZhbWlseT0iQXJpYWwgTmFycm93IikgKwogIHRoZW1lKGxlZ2VuZC5wb3NpdGlvbj1jKDAuMiwgMC4wMSkpICsKICB0aGVtZShsZWdlbmQua2V5PWVsZW1lbnRfYmxhbmsoKSkgKwogIHRoZW1lKGxlZ2VuZC5kaXJlY3Rpb249Imhvcml6b250YWwiKSArCiAgdGhlbWUocGxvdC50aXRsZT1lbGVtZW50X3RleHQoZmFjZT0iYm9sZCIsIHNpemU9MTYpKQoKCgoK