Click Panoramas to Enlarge
# Population Growth Code
# 11:41 AM Wednesday, April 22, 2015 -RMF
# The data file below saves to CSV from OpenOffice without modification needed for R
# IT contains all population, UCR, NBIRS categories from 1990 - 2013 for WA Counties (nrow = 961 * ncol = 213)
# download.file("http://www.ofm.wa.gov/sac/dnld/cjdb90_13.xls",mode="wb")
# I haven't had much luck with automated R libraries that convert XLS,XLSX to CSV; I use Open Office to convert.
# Note: I use attach() and detach() in this code to more easily utilize subsetting like '[which(county != "STATE"),]'
# debug your attached objects with 'search()' if needed as attached objects remain until detached.
cjdb90_13 <- read.csv("cjdb90_13.csv", ,stringsAsFactors = FALSE)
# setwd("C:/Crime")
library(lattice)
library(reshape2)
library(dplyr)
library(ggplot2)
# No "STATE" (summary state figures)
attach(cjdb90_13)
cjdb_POP <- cjdb90_13[,c("county","year","POP_TOTAL")][which(county != "STATE"),]
detach(cjdb90_13)
#no KING,PIERCE,CLARK,SPOKANE,SNOHOMISH
cjdb_POP_small <- subset(cjdb_POP[,c("county","year","POP_TOTAL")],
county != "KING" & county != "PIERCE" & county != "CLARK" & county != "SPOKANE" & county != "SNOHOMISH")
#no KING,PIERCE,CLARK,SPOKANE,SNOHOMISH,THURSTON,KITSAP,YAKIMA,WHATCOM
cjdb_POP_smaller <- subset(cjdb_POP_small[,c("county","year","POP_TOTAL")],
county != "KITSAP" & county != "THURSTON" & county != "YAKIMA" & county != "WHATCOM")
arrange(with(cjdb_POP,cjdb_POP[which(year == 1990),]),desc(POP_TOTAL))
arrange(with(cjdb_POP,cjdb_POP[which(year == 2013),]),desc(POP_TOTAL))
# Some populations arranged. Note 'diff' and 'rate' formulas for measuring growth : 'diff = X2013 - X1990' , 'rate = 1 - (X1990/X2013)'
pop1 <- arrange(with(cjdb_POP,cjdb_POP[which(year == 1990),]),county)
pop2 <- arrange(with(cjdb_POP,cjdb_POP[which(year == 2013),]),county)
pop3 <- merge(pop1,pop2,all=TRUE)
pop4 <- data.frame(reshape::cast(pop3, county ~ year,value="POP_TOTAL"))
pop5 <- with(pop4,cbind(pop4,diff = X2013 - X1990, rate = 1 - (X1990/X2013)))
pop6 <- arrange(pop5,desc(rate))
pop7 <- arrange(pop5,desc(diff))
cjdb_POP1 <- data.frame(reshape::cast(cjdb_POP, county ~ year,value="POP_TOTAL"))
cjdb_POP2 <- data.frame(reshape::cast(cjdb_POP, year ~ county,value="POP_TOTAL"))
cjdb_POP2
# uncomment jpeg_create() as neeed in the code below.
# rename files to jpeg after creation with 'jpeg_create' . # from R 'graphics.off()
# I use cmd.exe : 'for /f %i in ('more list') do ren %i %i.jpg' where list is a file I create with 'copy con list'.
jpeg_create <- function() {
systime <- as.numeric(Sys.time())
# dev.new()
jpeg(filename = systime,
width = 1640, height = 1440, units = "px", pointsize = 24,
quality = 500, bg = "white", res = NA, family = "", restoreConsole = TRUE,
type = c("windows"))
Sys.sleep(2)
}
attach(cjdb_POP) #;jpeg_create()
ggplot(data=cjdb_POP,aes(x=year, y=POP_TOTAL, group = county, colour = county)) +
theme(legend.text=element_text(size=12),legend.key=element_rect(size=3)) +
geom_line() +
labs(
x = "All WA County Size and Growth, 1990 - 2013: KING at TOP",
y = "Population") +
geom_point( size=3, shape=21, fill="white")
detach(cjdb_POP)
attach(cjdb_POP_small) #;jpeg_create()
ggplot(data=cjdb_POP_small,aes(x=year, y=POP_TOTAL, group = county, colour = county)) +
theme(legend.text=element_text(size=12),legend.key=element_rect(size=3)) +
geom_line() +
labs(
x = "Smaller WA County Size and Growth, 1990 - 2013: NO KING,PIERCE,SNOHOMISH,SPOKANE,CLARK,",
y = "Population") +
geom_point( size=3, shape=21, fill="white")
detach(cjdb_POP_small)
attach(cjdb_POP_smaller)#;jpeg_create()
ggplot(data=cjdb_POP_smaller,aes(x=year, y=POP_TOTAL, group = county, colour = county)) +
theme(legend.text=element_text(size=12),legend.key=element_rect(size=3)) +
geom_line() +
labs(
x = "Smallest WA County Size and Growth, 1990 - 2013: Under 200K Only",
y = "Population") +
geom_point( size=3, shape=21, fill="white")
detach(cjdb_POP_smaller)
## Routines to look at growth from 2010 - 2014
## download.file("http://www.ofm.wa.gov/pop/april1/ofm_april1_population_final.xlsx",mode="wb")
## I haven't had much luck with automated R libraries that convert XLS,XLSX to CSV; I use Open Office (scalc.exe)
library(lattice)
library(reshape2)
library(dplyr)
# jpg function for charts. Finish with 'graphics.off()'. Charts have time-date stamped number.
# Require renaming with jpg extension
jpeg_create <- function() {
systime <- as.numeric(Sys.time())
# dev.new()
jpeg(filename = systime,
width = 1220, height = 824, units = "px", pointsize = 18,
quality = 500, bg = "white", res = NA, family = "", restoreConsole = TRUE,
type = c("windows"))
Sys.sleep(2)
}
#plot.new()
setwd("C:/Crime")
ofmPOP_14 <- read.csv("ofm_april1_population_final.csv", ,stringsAsFactors = TRUE)
ofmPOP_14$rate <- with(ofmPOP_14,1 - (X2010/X2014))
ofmPOP_14$diff <- with(ofmPOP_14,(X2014 - X2010))
attach(ofmPOP_14)
#Cities Only
JS <- Jurisdiction %in% grep(" County",Jurisdiction,invert=TRUE,value=TRUE)
c1 <- subset(ofmPOP_14, JS)
arrange(c1,desc(X2014))
c2 <- arrange(c1,desc(diff))
#jpeg_create();
with(c2[1:30,],barchart(Jurisdiction ~ diff))
c3 <- c2[1:30,]
#jpeg_create();
with(c3[with(c3,which(County != "King")),],barchart(Jurisdiction ~ diff))
#jpeg_create();
with(c2[1:30,],barchart(Jurisdiction ~ diff,xlab="Top WA growing cities 2010 - 2014."))
c3 <- c2[1:30,]
#jpeg_create();
with(c3[with(c3,which(County != "King")),],barchart(Jurisdiction ~ diff, xlab="Top growing cities 2010 - 2014 without King County"))
# group = diff, colour = diff
ggplot(data=c2[1:30,],aes(x=diff, y=Jurisdiction)) +
theme() +
geom_line() +
labs(
x = "WA Jurisdictions NOT Counties Growth, 2010 - 2014: Top 30",
y = "Population") +
geom_point( size=4, shape=21, fill=rainbow(30))
#Counties only
JS <- Jurisdiction %in% grep(" County",Jurisdiction,value=TRUE);c1 <- subset(ofmPOP_14, JS)
JS <- c1$Jurisdiction %in% grep("Incorporated *",c1$Jurisdiction,invert=TRUE,value=TRUE,perl=TRUE);c1 <- subset(c1, JS)
JS <- c1$Jurisdiction %in% grep("Unincorporated *",c1$Jurisdiction,invert=TRUE,value=TRUE,,perl=TRUE);c1 <- subset(c1, JS)
c2 <- arrange(c1,desc(diff))
with(c2[1:30,],barchart(Jurisdiction ~ diff,col="red",xlab="Top growing counties 2010 - 2014"))
with(c2[2:30,],barchart(Jurisdiction ~ diff,col="red",xlab="Top growing counties 2010 - 2014 without King County"))
# group = diff, colour = diff
ggplot(data=c2[1:30,],aes(x=diff, y=Jurisdiction)) +
theme() +
geom_line() +
labs(
x = "WA Counties Growth, 2010 - 2014: Top 30 Counties",
y = "Population") +
geom_point( size=4, shape=21, fill=rainbow(30))
# group = diff, colour = diff
ggplot(data=c2[2:30,],aes(x=diff, y=Jurisdiction)) +
theme() +
geom_line() +
labs(
x = "WA Counties Growth, 2010 - 2014: Top 30 Counties except King",
y = "Population") +
geom_point( size=4, shape=21, fill=rainbow(29))
# Top 30 at different growth rates
arrange(ofmPOP_14[which(rate > .1),],desc(X2014))
arrange(ofmPOP_14[which(rate > .05),],desc(X2014))
(arrange(ofmPOP_14[which(rate > .05),],desc(X2014))[,c(1,9)])
t1 <- (arrange(ofmPOP_14[which(rate > .05),],desc(diff))[,c(2,9)])
# t1 <- (arrange(ofmPOP_14[which(rate > .1),],desc(diff))[,c(2,9)])
# with KING County
with(t1[1:30,],barchart(Jurisdiction ~ diff))
# NO KING County
with(t1[2:30,],barchart(Jurisdiction ~ diff))
# All County Values (County,Incorporated,Unicorporated)
JS <- Jurisdiction %in% grep(" County",Jurisdiction,value=TRUE);c1 <- subset(ofmPOP_14, JS)
c2 <- arrange(c1,desc(diff))
with(c2[1:30,],barchart(Jurisdiction ~ diff))
with(c2[2:30,],barchart(Jurisdiction ~ diff))
# group = diff, colour = diff
ggplot(data=c2[3:30,],aes(x=diff, y=Jurisdiction)) +
theme() +
geom_line() +
labs(
x = "WA Growth, 2010 - 2014: Top 30 Jurisdictions",
y = "Population") +
geom_point( size=4, shape=21, fill=rainbow(28))
# group = diff, colour = diff
ggplot(data=c2[3:30,],aes(x=diff, y=Jurisdiction)) +
theme() +
geom_line() +
labs(
x = "WA Growth, 2010 - 2014: Top 30 Jurisdictions except King",
y = "Population") +
geom_point( size=4, shape=21, fill=rainbow(28))
detach(ofmPOP_14)
No comments:
Post a Comment