Skip to content

Instantly share code, notes, and snippets.

@blmoore blmoore/USemploymentPlot.R
Last active Aug 29, 2015

Embed
What would you like to do?
for blogpost
require("zoo")
require("ggplot2")
# unemployment
u <- read.csv("Employment.csv", header=T)
u <- melt(u, "Year")
unemployment <- data.frame(date=as.yearmon(do.call(paste, u[,1:2]), "%Y %b"),
rate=u$value)
unemployment <- unemployment[unemployment$date > as.yearmon("2008-12"),]
u2 <- unemployment
colnames(u2) <- c("date", "rate")
n <- read.csv("netChange.csv", header=T)
n <- melt(n, "Year")
# Check (!) dates are the same in each input, else repeat parse
all.equal(net.change$date, unemployment$date) # TRUE
net.change <- data.frame(date=unemployment$date,
change=n$value)
net.change <- net.change[net.change$date > as.yearmon("2008-12"),]
n2 <- net.change
colnames(n2) <- c("date", "rate")
n2$panel <- "Net change in number of jobs (000s)"
u2$panel <- "Unemployment rate (%)"
both <- rbind(u2, n2)
# First: hacky ggplot2 plot
p <- ggplot(both, aes(x=as.Date(date), y=rate)) +
facet_grid(panel~., scale="free_y") +
layer(data=u2, geom="smooth", method="loess") +
layer(data=u2, geom="point") +
layer(data=n2, geom="bar", stat="identity") +
theme_bw() + labs(y="", x="") +
ggtitle("United States employment statistics (2009 - 2013)")
ggsave(p, file="ggplot_svg.svg")
# Or separate plots, but mis-aligned
require("gridExtra")
grid.arrange(
ggplot(unemployment, aes(x=as.Date(date), y=rate)) +
geom_smooth(method="loess") + geom_point() +
labs(x="", y="Unemployment rate (%)") +
theme_classic(),
ggplot(net.change, aes(x=as.Date(date), y=change)) +
geom_bar(stat="identity") +
labs(y="Net change per month (000s of employees)",
x="") + theme_classic()
, ncol=1)
## base R version
dev.off()
## This recreates the original figure as close as possible (well, ish)
pdf("recreated.pdf", 7, 5)
par(mar=c(3,4.5,5,4.2), mgp=c(1.8,.65,0))
# sort by date
net.change <- net.change[order(net.change$date),]
# original starts at 09
net.change <- net.change[net.change$date > as.yearmon("2008-12"),]
#par(yaxs="i")
bpos <- barplot(net.change$change, plot=F)
x <- as.Date(net.change$date)
# scale will be integer (== month)
plot(1:length(x), net.change$change, type="n", ylim=c(-1000, 600),
frame=F, axes=F, xlab="", ylab="", xlim=c(2.7, length(x)-1.7))
rect(xleft=1:length(x)-.3, xright=1:length(x)+.3,
ybottom=0, ytop=net.change$change, col="#4F81BD", lend=2)
abline(h=0, lwd=1)
## Awful code, avert your eyes
labs <- format(as.Date(as.character(
cut(as.Date(seq(x[1], x[length(x)], length.out=5),
format= "%m/%Y"), breaks="years"))), "%m/%d%/%y")
labs <- c(gsub("01","1", labs), "")
axis(1, at=seq(1, length(x), length.out=6), tick=F,
labels=labs, las = 1)
axis(2, at=seq(-1000, 600, by=200), las=1, tck=-0.015)
mtext("Number jobs lost/created", side=2, col="#1F497D", line=3)
## now unemployment
unemployment <- unemployment[order(unemployment$date),]
unemployment <- unemployment[unemployment$date > as.yearmon("2008-12"),]
par(new=T)
# set up same plot
plot(1:length(x), unemployment$rate, type="n", ylim=c(6.5, 10),
frame=F, axes=F, xlab="", ylab="", xlim=c(2.7, length(x)-1.7))
lines(1:length(x), unemployment$rate, col="#C0504D", lwd=3.5)
axis(4, las=1, tck=-.015)
#mtext("Percent unemployed", side=4, col="#4F81BD", line=1, las=0, adj=0)
legend("bottom", legend=c("Unemployment rate", "1 month Net Change (000's)"),
col=c("#C0504D", "#4F81BD"), lty=c(1, NA), lwd=c(3.5, NA),
fill=c(0, "#4F81BD"), merge=T, border=NA, text.font=2)
text(length(x)*1.12, (par("usr")[4] + par("usr")[3])/2, "Percent unemployed",
srt = 270, xpd = TRUE, col="#1F497D")
mtext("United States Employment Statistics\n Jan 2009 - Dec 2013", side=3,
col="#1F497D", cex=1.4, line=2, font=2)
mtext("Monthly change, seasonally adjusted", side=3, cex=1.1, line=1)
dev.off()
## This is the same figure but with a few minor improvements
dev.off()
svg("new.svg", 7.5, 5)
par(mar=c(5.5,4.5,5,3.8), mgp=c(1.8,.7,0))
net.change <- net.change[order(net.change$date),]
net.change <- net.change[net.change$date > as.yearmon("2008-12"),]
bpos <- barplot(net.change$change, plot=F)
x <- as.Date(net.change$date)
# scale will be integer (== month)
plot(1:length(x), net.change$change, type="n", ylim=c(-1000, 600),
frame=F, axes=F, xlab="", ylab="", xlim=c(2.7, length(x)-1.7))
rect(xleft=1:length(x)-.3, xright=1:length(x)+.3,
ybottom=0, ytop=net.change$change, col="#4F81BD", lend=2)
abline(h=0, lwd=1)
labs <- format(as.Date(as.character(cut(as.Date(seq(x[1], x[length(x)], length.out=10),
format= "%M %Y"), breaks="months"))), "%b %Y")
axis(1, at=seq(1, length(x), length.out=length(labs)),
labels=labs, las=3)
axis(2, at=seq(-1000, 600, by=200), las=1)
mtext("Net change in employment per month (1000s of jobs)",
side=2, col="#1F497D", line=3)
## now unemployment
unemployment <- unemployment[order(unemployment$date),]
unemployment <- unemployment[unemployment$date > as.yearmon("2008-12"),]
par(new=T)
# set up same plot
plot(1:length(x), unemployment$rate, type="n", ylim=c(6.5, 10),
frame=F, axes=F, xlab="", ylab="", xlim=c(2.7, length(x)-1.7))
lines(1:length(x), unemployment$rate, col="#C0504D", lwd=3.5)
axis(4, las=1)
text(length(x)*1.1, (par("usr")[4] + par("usr")[3])/2, "Percent unemployed",
srt = 270, xpd = TRUE, col="#C0504D")
text(length(x)*.85, ((par("usr")[4] + par("usr")[3])/4) *1.65, "Unemployment rate",
xpd = TRUE, col="#C0504D")
text(length(x)*.215, ((par("usr")[4] + par("usr")[3])/4) *1.75, "Jobs created or lost",
xpd = TRUE, col="#4F81BD")
mtext("United States Employment Statistics\n Jan 2009 - Dec 2013", side=3,
col="#1F497D", cex=1.4, line=2, font=2)
mtext("Monthly change, seasonally adjusted", side=3, cex=1.1, line=1)
dev.off()
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.