Unemployment.R

plot.heat <- function(tmp,state.map,z,title=NULL,breaks=NULL,cex.legend=1,bw=.2,col.vec=NULL,main=NULL,plot.legend=TRUE, ...) {
    tmp@data$zCat <- cut(tmp@data[,z],breaks,include.lowest=TRUE)
    cutpoints <- levels(tmp@data$zCat)
    if (is.null(col.vec)) col.vec <- heat.colors(length(levels(tmp@data$zCat)))
    cutpointsColors <- col.vec
    levels(tmp@data$zCat) <- cutpointsColors
    cols <- as.character(tmp$zCat)
    ##cols <- "white"
    plot(tmp,border=cols, lwd=bw,axes = FALSE, las = 1,col=as.character(tmp@data$zCat),main="A", ...)
    if (!is.null(state.map)) {
        plot(state.map,add=TRUE,lwd=1, border="white")
    }
    if (plot.legend) legend("bottomleft", cutpoints, fill = cutpointsColors,bty="n",title=title,cex=cex.legend)
}

##merge sp objects with data
merge.sp <- function(tmp,data,by="uf") {
  by.loc <- match(by,names(data))
  by.data <- data[,by.loc]
  data <- data[,-by.loc]
  tmp@data <- data.frame(tmp@data,
                         data[match(tmp@data[,by],by.data),]
                         )
  tmp
}



library(maptools)
## map data from http://www.census.gov/geo/www/cob/co2000.html
state.map <- readShapeSpatial("maps/st99_d00_shp/st99_d00.shp")
county.map <- readShapeSpatial("maps/co99_d00_shp/co99_d00.shp")


unemp <- read.csv("http://datasets.flowingdata.com/unemployment09.csv", header = F, stringsAsFactors = F)
names(unemp) <- c("id", "state_fips", "county_fips", "name", "year", "?", "?", "?", "rate")
unemp$fips <- with(unemp, paste(as.character(state_fips), as.character(county_fips), sep=";"))


county.map$state_fips <- as.numeric(as.character(county.map$STATE))
county.map$county_fips <- as.numeric(as.character(county.map$COUNTY))
county.map$fips <- with(county.map@data,paste(as.character(state_fips),as.character(county_fips),sep=";"))
county.map$rate <- NULL




m <- merge.sp(county.map, unemp, "fips")
m0 <- m
m <- m[m$state_fips%in%unemp$state_fips,]
##exclude ak
m <- m[!grepl("AK$|HI$|GU$|PR$", m$name),]


labelpos <- data.frame(do.call(rbind, lapply(m@polygons, function(x) x@labpt)))
names(labelpos) <- c("x","y")


library(RColorBrewer)

png(file="~/tmp.png", width=1200, height=1000)
plot.heat(m,state.map,z="rate",breaks=c(seq(0, 10, by = 2), 35), col.vec=(brewer.pal(6,"PuRd")), xlim=c(-125,-70), ylim=c(28,48), bw=.01, plot.legend=FALSE)
dev.off()