Heatmapping Washington, DC Rental Price Changes using OpenStreetMaps

Percentage change of median price per square foot from July 2012 to July 2013:

Percentage change of median price from July 2012 to July 2013:

Last November I made a  choropleth of median rental prices in the San Francisco Bay Area using data from my company, Kwelia.  I have wanted to figure out how to plot a similar heat map over an actual map tile, so I once again took some Kwelia data to plot both percentage change of median price and percentage change of price per sqft from July 2012 to this past month (yep, we have realtime data.)

How it’s made:

While the google maps API through R is very good, I decided to use the OpenStreetMap package because I am a complete supporter of open source projects (which is why I love R).

First, you have to download the shape files, in this case I used census tracts from the Us Census tigerlines.   Then you need to read to read it into R using the maptools package like this and merge your data to the shape file:

library("maptools")
zip=readShapeSpatial( "tl_2010_11001_tract10.shp" )

##merge data with shape file
 zip$geo_id=paste("1400000US", zip$GEOID10, sep="")
 zip$ppsqftchange <- dc$changeppsqft[match(zip$geo_id,dc$geo_id , nomatch = NA )]
 zip$pricechange <- dc$changeprice[match(zip$geo_id,dc$geo_id , nomatch = NA )]

Then you pull down the map tile from the OpenStreetMaps. I used the max and mins from the actual shape file to get the four corners of the tile to pull down the two above maps (“waze” and “stamen-toner”)

map = openproj(openmap(c(lat= max(as.numeric(as.character(zip$INTPTLAT10))),   lon= min(as.numeric(as.character(zip$INTPTLON10)))),
 c(lat= min(as.numeric(as.character(zip$INTPTLAT10))),   lon= max(as.numeric(as.character(zip$INTPTLON10)))),type="stamen-toner"))

Finally, plotting the project. The one thing different from plotting the choropleths from the Bay area is adjusting the transparency of the colors. To adjust the transparency you need to add two extra numbers (00 is fully transparent and 99 is solid) to the end of the colors as you will see in the  annotations.

##grab nine colors
 colors=brewer.pal(9, "YlOrRd")
 ##make nine breaks in the value
 brks=classIntervals(zip1$pricechange, n=9, style="quantile")$brks
 ##apply the breaks to the colors
 cols <- colors[findInterval(zip1$pricechange, brks, all.inside=TRUE)]
 ##changing the color to an alpha (transparency) of 60%
 cols <- paste0( cols, "60")
 is.na(cols) <- grepl("NA", cols)
 ##changing the color to an alpha (transparency) of 60%
 colors <- paste0( colors, "60")

 ##plot the open street map
 plot(map)
 ##add the shape file with the percentage changes to the osm 
 plot( zip , col = cols , axes=F , add=TRUE)
 ##adding the ledgend with breaks at 75%(cex) and without border(bty)
 legend('right', legend= leglabs( round(brks , 1 ) ) , fill = colors , bty="n", cex=.75)