#note: data and graphs appear roughly in the order they appear in the paper.
#some code is redundant and may involve more steps than stricly necessary,
#but this is done for for the sake of clarity.
library(foreign)#allow for import of Stata datasets
#note: you do not need to change working directory if data is already stored in R working directory
#if not, change the working directory to where the files are stored using the command below:
#setwd("C:\\Documents and Settings\\....")
#get 2006 Data
#use 2004 vars from 2006 data to account for GA switch of 3rd and 8th districts
#for s-v analyis
house.2006 <- read.dta("2006_house_data.dta")
attach.all(house.2006)
i2006 <- house.2006[,"incumb06"]#incumbency in 2006
unc2006 <- house.2006[,"uncontested06"]#uncontested in 2006
dvote.2006 <- house.2006$dvoteimputed#imputed vote in 2006
adv.2006 <- mean(dvote.2006) #mean avg. district vote (imputed)
winner.2006 <- house.2006$winner#winner of each race (1 for Dems, 0 for GOP
dem.seats.2006 <- mean(winner.2006) #percent of Dem seats (233/435); counting FL-13 for GOP
v2004 <- dlag06imputed #use imputed lagged vote to get 2004 vote for 2006 s-v prediction
i2004 <- incumb04 #incumbency in 04 for s-v prediction
#get data from all years for time-series plots
#need average district vote and dem per seats
#first get dem seats for 1946--2006; unit of observation here is the election year (i.e. "aggregate")
agg.house.data <- read.dta("House_1946-2006_aggregate.dta")
attach.all(agg.house.data)
unique.year.all <- unique(year)#create variable for each uniqye year
dem.seats <- dem.seats.per#Dem percentage of seats in House stemming from each election
#get total vote for 1946-2004
dem.per.total <- dem.per.total#dems percentage of total vote in each election
#get total vote for 2006
attach.all(house.2006)
dem.total.2006 <- sum(dem.total)/(sum(dem.total)+sum(gop.total))#total vote in 2006
#add on 2006 to total
dem.per.total[31] <- dem.total.2006#add 2006 to total vote vector (since it's not part of main dataset yet
#get average district vote for all years
###########################################
detach()
house.4604 <- read.dta("House_1946_2004_updated.dta") #1946-2004 data -- statecd is unit
attach.all(house.4604)
house.4604 <- house.4604[winner < 9,]#drop handful of 3rd party candidates
#not-including Bernie Sanders, who we count as a Democrat
detach()
attach.all(house.4604)
unique.year.4604 <- unique(year)#create year var for 1946-2004 (helps avoid confusion when looping)
adv <- rep(NA, length(unique.year.4604))#create empty vector for imputed avg. district vote, 1946-2004
for (i in 1:length(unique.year.4604)){
adv[i] <- mean(dvoteimputed[year==unique.year.4604[i]])#get adv for each year, 1946-2004
}
adv[31] <- adv.2006#add in 2006 (since it's not part of main dataset yet)
########################################################################
#FIGURE 1: Plot avg. dist. vote versus percent of seats time series for 1946-2000
year.at.vec <- c((seq(1946, 2006, by = 2)))#use to plot tick marks on x-axis
year.label.vec <- c("", "", "1950", "","","", "", "1960", "","","", "", "1970",
"","","", "", "1980", "","","", "", "1990", "","","", "", "2000","", "", "2006" )#x-axis labels
pdf("avd_vs_seats_allyears.pdf", height = 9, width = 21)
par(mfrow=c(1,1), mar = c(7,7.1,2,.5))#set up margins for plot
plot(unique.year.all, adv, axes = F, type = "n", xlab = "",
ylab = "", xlim = c(1946, 2010), ylim = c(.43,.68), xaxs="i", yaxs="i",
main = "")#call empty plot so can add shading first, or else shading would block out lines
#add shading for different periods of party control GOP: 1946-1948, 1952-54, 1994-2006
shade.color = "gray92"
polygon(x=c(1946, 1946, 1948, 1948),
y=par()$usr[c(3,4,4,3)],
col= shade.color, ## desired color
border=F) ## no border
polygon(x=c(1952, 1952, 1954, 1954),
y=par()$usr[c(3,4,4,3)],
col= shade.color, ## desired color
border=F) ## no border
polygon(x=c(1994, 1994, 2006, 2006),
y=par()$usr[c(3,4,4,3)],
col= shade.color, ## desired color
border=F) ## no border
points(unique.year.all, adv, type = "l")#points/line for avg. district vote
points(unique.year.all, dem.seats, type = "l", lty = 2)##points/line for dem percent of seats
axis(1, at = year.at.vec, labels = year.label.vec, las = 1, cex.axis = 1.8, mgp = c(2,1.5,0))
axis(2, las = 1, at = c(seq(.4, .70, by = .05)),
label = c("40", "45%", "50%", "55%", "60%", "65%", "70%"), cex.axis = 1.8,mgp = c(2,1.2,0))
segments(1946, .5, 2006, .5, col="gray", lwd=.5)#light line for 50%
text(1975, .52, "Average district vote\nfor Democrats", cex = 1.7)#labels for each line
segments(1973, .534, 1972.6, .547)
text(1982, .66, "Democrats' percentage\n of House seats", cex = 1.7)#labels for each line
segments(1978, .66, 1977.6, .65)
dev.off()
###################################################################
#FIGURE 2: historical seats-votes curves
#we are uses 1958-2004 (non 02 years) to validate.
#however, we use regressions from 1946-2004 to get coefficients to set parameter estimates below
#first, use 1946-2004
attach.all(house.4604)
house.4604no02 <- house.4604[year !=1952 & year != 1962 & year != 1972
& year !=1982 & year != 1992 & year != 2002,]
attach.all(house.4604no02)
unique.year.4604no02 <- unique(year)
coefs <- array(NA, c(length(unique.year.4604no02 ), 4)) #create empty matrix to store coefficients
resid.errors <- rep(NA, length(unique.year.4604no02 )) #empty vector to store residual errors
for (i in 1:length(unique.year.4604no02 )){#loop over each
fit <- lm(dvoteimputed ~ dlagimputed + incumb +
partycontrol, subset = year == unique.year.4604no02[i])
coefs[i,] <- coef(fit)
resid.errors[i] <- sigma.hat(fit)
}
#now use only 1958 on, non redistricting years (02)
attach.all(house.4604)
house.data.replicate <- house.4604[year > 1956 & year !=1952 & year != 1962 & year != 1972
& year !=1982 & year != 1992 & year != 2002,]
detach()
attach.all(house.data.replicate)
unique.year.rep <- unique(year)
keep <- ifelse(unique.year.all > 1956 & unique.year.all !=1952 & #use indicator to pull out adv and seats
unique.year.all != 1962 & unique.year.all != 1972 #for validation years only
& unique.year.all !=1982 & unique.year.all != 1992
& unique.year.all != 2002 & unique.year.all != 2006, 1, 0)
adv.rep <- adv[keep==1]
dem.seats.rep <- dem.seats[keep==1]
#set up vectors and parameter estimates for validation loop
n.sims <- 1000 #number of simulations
inc.impute <- .75 #for uncontested races
sbar.rep <- rep (NA, n.sims)#vector for predicted seats -- redrawn for each year.
axis.size <- 1 #control size of axis labels
predicted.seats <- rep(NA, length(unique.year.rep))#predicted number of seats, based on actual adv
predictive.error <- rep(NA, length(unique.year.rep))#predictive error of model
predictive.sd <- rep(NA, length(unique.year.rep)) #standard deviation of seats at actual adv
partisan.bias <- rep(NA, length(unique.year.rep))#partisan bias in each year (not used in paper)
################################################################################
#note: this loop will take a long time to run with 1,000 sims
#(could lower to 100 with no substantive interpretative loss)
#create Figure 2
pdf("Seats_Votes_Curves_Over_Time_all_years.pdf", height = 8, width = 10)
#use layout command to set up different size panels, so that we can plot y-axis labels in 1st column
#and x-axis labels on bottom row (i.e. not separate labels for each year.
#For more on layout command see Murrell's "R Graphics" book
left.panel.width <- .8 # control width of left-hand panel (see "widths" in layout command)
layout(rbind(c(20, 1, 2,3,4,5), c(21, 6, 7,8,9,10), #order so that each year first, then y-axis labels, then x-axis lables
c(22,11, 12, 13, 14, 15), c(23, 16, 17, 18, 19, 28),
c(30, 24, 25, 26, 27, 29)), # then column labels, then row labels
widths = cbind(c(left.panel.width,2,2,2,2,2), c(left.panel.width,2,2,2,2,2),c(left.panel.width,2,2,2,2,2),
c(left.panel.width,2,2,2,2,2),c(left.panel.width,2,2,2,2,2)),
heights = c(1,1,1,1,.6))#make last row smaller since it's just a label, no graph
#layout.show(30)#this shows how layout looks in R Window (but must be commented out when creating PDF)
for (i in 1:length(unique.year.rep)){#loop over validation years
rho <- mean(coefs[i:(i+4),2])#get rho by taking mean coef from 5 years leading up to election year
sigma <- mean(resid.errors[i:(1+4)])#get mean residual standard error from past 5 years
phi <- unique(incumb.effect[year == unique.year.rep[i]]) #get estimated incumbency advantage for particular election year
v.lag <- dlagimputed[year==unique.year.rep[i]]#imputed vote
inc.lag <- incumb.lag[year==unique.year.rep[i]]#lagged incumbency
inc <- incumb[year==unique.year.rep[i]]#incumbency status
unc <- uncontested[year==unique.year.rep[i]]#uncontested status
vbar.rep.lag <- mean(v.lag)#mean of vote from last election
vbar.rep.range <- round(vbar.rep.lag,2) + seq(-.1,.1,.0015) #create range from .45 to 55, at every .015 of seats
sbar.rep.expected <- rep (NA, length(vbar.rep.range))#set up vector for predicted seats over each interval in range
sbar.rep.sd <- rep (NA, length(vbar.rep.range))#set up vector for standard deviation of predicted seats
for (j in 1:length(vbar.rep.range)){#loop over intervals of vbar.rep
vbar.rep <- vbar.rep.range[j]
for (s in 1:n.sims){#loop ove simulations
v.adj.lag <- v.lag - phi*inc.lag #adjusted vote, taking out incumbency
normvote <- .5 + rho*(v.adj.lag - .5) #normal vote
locfree <- normvote + phi*inc #location free: normal vote plus adjusted vote
locfreenoisy <- rnorm(length(locfree), locfree, sigma) #add noise to loc.free var
withuncs <- ifelse(unc==-1, 1-inc.impute,#add in uncontesteds (.25 and .75)
ifelse (unc==1, inc.impute, locfreenoisy))
swingfree <- withuncs + mean(v.lag) - mean(withuncs) #take out swing
v.predict <- swingfree + vbar.rep - mean(swingfree) #get predicted vote
sbar.rep[s] <- mean(v.predict>.5)#predicted seats = percent of sims where predicted vote > .5
}
sbar.rep.expected[j] <- mean(sbar.rep) #for each interval, median predicted seats across simulations
sbar.rep.sd[j] <- sd(sbar.rep) #for each interval, get standard deviation of seats given votes across sims
}
predicted.seats[i]<- mean(sbar.rep.expected[round(vbar.rep.range,2)==round(adv.rep[i],2)])#use mean b/c it's possible for multiple values
#of vbar.rep.range to equal adv in a given year
predictive.error[i] <- dem.seats.rep[i] - predicted.seats[i]
partisan.bias[i] <- mean(2*(sbar.rep.expected[round(vbar.rep.range,2)==.50]-.5))
predictive.sd[i] <- mean(sbar.rep.sd[round(vbar.rep.range,2)==round(adv.rep[i],2)])
#first: within loop, plot each year
par(mar=c(2,2,2,2), pty ="s")#set margins for each panel; pty = s makes plots square
plot(adv.rep[i],dem.seats.rep[i],#plot adv vs. predicted seats
cex = 1.1, pch = 19, type="p", xlim = c(.4,.7), ylim=c(.4,.7),
main = unique.year.rep[i], xlab = "",
ylab = "", mgp = c(2,.5,0), axes = F, xaxs = "i", yaxs="i")#turn off axes so can use "axis" command for fine control
points(vbar.rep.range, sbar.rep.expected, type="l")#plot seats-votes
#lines(lowess(vbar.rep.range, sbar.rep.expected))#if you want to plot lowess
axis(1, at = c(.4,.5,.6,.7), label = c("40%","50%","60%","70%"), mgp = c(2,.5,0), cex.axis=axis.size)
axis(2,las = 1, at = c(.4,.5,.6,.7), label = c("40%","50%","60%","70%"), mgp = c(2,.5,0), cex.axis=axis.size)
lines (c(0,1),c(.5,.5), col="gray", lwd=.5)#add light lines at .5
lines (c(.5,.5),c(0,1), col="gray", lwd=.5)
box()
}
#outside loop: add labels
#first: y-axis (4 rows)
for (i in 1:4){
par(mar=c(0,0,0,0))
plot(.5,.5, xlim = c(.4, .7), ylim = c(.4, .7), type = "n", axes = F, xlab = "", ylab = "")#call empty plot to keep on same scale
text(.55, .55, "Democratic Share\nof House Seats", cex = 1.2, srt = 90, xpd = NA)
}
#second: x-axis (5 columns)
for (i in 1:5){
par(mar=c(0,0,0,0))
plot(.5,.5, xlim = c(.4, .7), ylim = c(.4, .7), type = "n", axes = F, xlab = "", ylab = "")#call empty plot to keep on same scale
text(.55, .65, "Avg. District Vote\nfor Democrats", cex = 1.2, xpd = NA)
}
dev.off()
rmse.predict <- sqrt(sum(predictive.error^2)/length(unique.year.rep))#Get RMSE for prediction;
#this is used for generating probabilities for 2006 and 2008
rmse.sd <- sqrt(sum(predictive.sd^2)/length(unique.year.rep))#RMSE of standard deviation of seats
################################################################################
#plot 2006 predicted seats-votes curve, plus actual election results
#note: if you haven't run loop above, set rmse.predict = to .0222
#paramater estimates for 2006
phi <- .08
rho <- .71
sigma <- .066
inc.impute <- .75 #for uncontested races
n.sims <- 1000
vbar.2004 <- mean(v2004)
vbar.range <- round(vbar.2004,2) + seq(-.1,.1,.002) #create range from 45 to 55
sbar.50 <- rep (NA, length(vbar.range))#vector for predicted seats (based on medians)
prob <- rep (NA, length(vbar.range)) #set up vector for prob. of winning house
for (j in 1:length(vbar.range)){#loop over intervals of vbar
vbar <- vbar.range[j]
sbar <- rep (NA, n.sims)
for (i in 1:n.sims){
v.adj2004 <- v2004 - phi*i2004 #adjusted vote, taking out incumbency
normvote2006 <- .5 + rho*(v.adj2004 - .5) #normal vote
locfree2006 <- normvote2006 + phi*i2006 #location free: normal vote plus adjusted vote
locfreenoisy2006 <- rnorm(length(locfree2006), locfree2006, sigma) #add noise to loc.free var
withuncs2006 <- ifelse (unc2006==-1, 1-inc.impute,
ifelse (unc2006==1, inc.impute, locfreenoisy2006))
swingfree2006 <- withuncs2006 + mean(v2004) - mean(withuncs2006) #take out swing
v2006 <- swingfree2006 + vbar - mean(swingfree2006)
#V2006 <- withuncs2006 + vbar + mean(v2004) - mean(withuncs2006) - mean(swingfree2006)
sbar[i] <- mean(v2006>.5)
}
sbar.50[j] <- mean(sbar)
prob[j] <- pnorm((sbar.50[j] - 0.5)/rmse.predict)#use empirical predictive error for historical regressions (above)
}
#get v.bars when prob. == 10, 50, 90%
ten.percent.value <- mean(vbar.range[round(prob,1) ==.10])
fifty.percent.value <- mean(vbar.range[round(prob,1) ==.50])
ninety.percent.value <- mean(vbar.range[round(prob,1) ==.90])
print(ten.percent.value)
print(fifty.percent.value)
print(ninety.percent.value)
#get predicted seats and probability based on adv. for 2006
pred.seats.2006 <- mean(sbar.50[vbar.range==round(adv.2006,3)])
seats.error.2006 <- dem.seats.2006 - pred.seats.2006
bias.2006 <- mean(2*(sbar.50[round(vbar.range,2)==.50]-.5))
prob.2006 <- prob[vbar.range == round(adv.2006,3)]
#get probability dems would have won house if they got the same adv as GOP in 1994
prob.1994 <- prob[vbar.range == round(1-adv[unique.year.all==1994],2)]
#get number of seats GOP would have won with dems average district vote.
gop.seats.pred <- 1-mean(sbar.50[vbar.range==round(1-adv.2006,3)])
#gop.seats.pred*435 = 249
######################################################
#Predicted SV Curve
axis.size <- 1.1 #control size of axis tick marks and numbers
axis.label <- 1.1 #control size of axis labels
pdf("Seats_Votes_2006_prob_combined.pdf", height = 4, width = 8)
par (mfrow=c(1,2), mar = c(7,6,2,3), pty = "s")
plot(vbar.range, sbar.50, type = "l",
ylab = "", xlab = "", axes = F, xaxs="i", yaxs="i",
ylim = c(.4, .6), xlim = c(.40,.6),,
main = "")
#lines(lowess(vbar.range, sbar.50))
axis(1, at = c(.40,.45, .50,.55,.60), label = c("40%", "", "50%", "", "60%"), mgp = c(2,.5,0), cex.axis = axis.size)
axis(2, at = c(.40,.45, .50,.55,.60), label = c("40%", "", "50%", "", "60%"), las = 2, mgp = c(2,.5,0), cex.axis = axis.size)
mtext("Average district vote\nfor Democrats", 1, cex = axis.label, line = 3.1)
mtext("Democratic share\nof House seats", 2, cex = axis.label, line=3.1)
abline(h=.5, col="gray", lwd=.5)
abline(v=.5, col="gray", lwd=.5)
points(adv.2006, dem.seats.2006, type = "p", pch = 19, cex = .8)
box()
#pdf("Probability_graph_2006.pdf", height = 4, width = 6)
par (mar = c(7,6,2,3))
plot (vbar.range, prob, type="l",
main = "",
xlab ="", ylab ="", axes = F, xaxs="i",
yaxs="i", xlim = c(.4,.6), ylim = c(0,1))
axis(1, at = c(.40,.45, .50,.55,.60), label = c("40%", "", "50%", "", "60%"), mgp = c(2,.5,0), , cex.axis = axis.size)
axis(2, at = c(seq(0,1,by =.25)), label = c(0,".25",".5",".75",1), las = 2, mgp = c(2,.5,0), cex.axis = axis.size)
mtext("Average district vote\nfor Democrats", 1, cex = axis.label, line = 3.1)
mtext("Probability Democrats\nControl House", 2, cex = axis.label, line =2.7)
abline (h=.5,col="gray", lwd=.5)#50% line
abline (h=.1, col="gray", lwd=.5)#10 % line
abline (h=.9, col="gray", lwd=.5)#90% line
#add point for actual avd vote and predicted probabloty
points(adv.2006, prob.2006, type = "p", pch = 19, cex = .8)
box()
dev.off()
##########################################################
#presenting histograms from 1996-2006 election
#use only uncontested races
attach.all(house.4604)
house.9604 <- house.4604[year>=1996,]
attach.all(house.9604)
year.9604 <- unique(year)
demwin <- na.omit(house.9604$dvote[house.9604$winner==1])#drop uncontesteds
gopwin <- 1- na.omit(house.9604$dvote[house.9604$winner==0])#drop uncontesteds; reverse to get gop share of vote
demwin.mean <- rep(NA, length(year.9604))#means for 1994-2004)
gopwin.mean <- rep(NA, length(year.9604))
demwin.2006 <- na.omit(house.2006$dvote[house.2006$winner==1]) #means for 2006
gopwin.2006 <- na.omit(1-house.2006$dvote[house.2006$winner==0])
#get means for each year, w/o uncontesteds
for (i in 1:length(year.9604)){# dem means by year for winner
keep <- year==year.9604[i] & winner == 1
demwin.mean[i] <- mean(dvote[keep], na.rm=T)
}
for (i in 1:length(year.9604)){#rep
keep <- year==year.9604[i] & winner == 0
gopwin.mean[i] <- 1 - mean(dvote[keep], na.rm=T)#
}
#histograms, 1994--2006
pdf("hists9406.pdf", height = 4, width = 14)
#use this for 1996-2006
layout(rbind(c(13, 1, 2,3,4,5, 6), c(14, 7,8,9,10, 11, 12), #order so that dems first, then gop,
c(21, 15, 16, 17, 18, 19, 20)), # then column labels, then row labels
widths = cbind(c(1.3,2,2,2,2,2,2), c(1.3,2,2,2,2,2,2),c(1.3,2,2,2,2,2,2)),
heights = c(2,2,1.5))
#layout.show(21)
par(mar = c(2, .5, 3.5,2))
#dems in top row, 1st: 1996-2004
for (i in 1:length(year.9604)){
keep <- year==year.9604[i]
demwin <- na.omit(house.9604$dvote[house.9604$winner==1 & keep])
hist(demwin, axes = F, main = "", xlab = "", ylab = "", xaxs = "i", yaxs="i",
xlim = c(.5,1), nclass=n.bins(demwin)-1)
abline(v=demwin.mean[i], lty = 2, lwd = 1.5)#draw line through mean
axis(1, at = c(seq(.5, 1, by = .25)), label = c(50, 75, "100%"),
mgp = c(2,.7,0), cex.axis = axis.size)
mtext(year.9604[i], 3, line = 1.5, cex = 1.5, font = 2)
}
#add 2006
hist(demwin.2006, main = "", axes = F, xlim = c(.5,1), xaxs ="i", yaxs="i",
xlab ="", ylab ="", nclass=n.bins(demwin.2006))
axis(1, at = c(seq(.5, 1, by = .25)), label = c(50, 75, "100%"),
mgp = c(2,.7,0), cex.axis = axis.size)
abline(v=mean(demwin.2006), lty = 2, lwd = 1.5)#draw line through mean
mtext(2006, 3, line = 1.5, cex = 1.5, font = 2)
#gop on bottom
par(mar = c(2, .5, 2, 2))
for (i in 1:length(year.9604)){
keep <- year==year.9604[i]
gopwin <- 1 - na.omit(house.9604$dvote[house.9604$winner==0 & keep])
hist(gopwin, main = "", axes = F, xlab = "", ylab = "", xaxs = "i", yaxs="i",
xlim = c(.5,1), nclass=n.bins(gopwin))
abline(v=gopwin.mean[i], lty = 2, lwd = 1.5)#draw line through mean
axis(1, at = c(seq(.5, 1, by = .25)), label = c(50, 75, "100%"),
mgp = c(2,.7,0), cex.axis = axis.size)
}
#add 2006
hist(gopwin.2006, main = "", axes = F, xlim = c(.5,1), xaxs ="i", yaxs="i",
xlab ="", ylab ="", nclass=n.bins(gopwin.2006))
axis(1, at = c(seq(.5, 1, by = .25)), label = c(50, 75, "100%"),
mgp = c(2,.7,0), cex.axis = axis.size)
abline(v=mean(gopwin.2006), lty = 2, lwd = 1.5)#draw line through mean
#add column labels
par(mar = c(3, .5, 3, .5))
plot(0,0, xlim = c(.5, 1), ylim = c(0, 30), type = "n", axes = F)#call empty plot to keep on same scale
text(.8, 15, "Democratic\nwinners", cex = 1.8)
par(mar = c(3, .5, 3, .5))
plot(0,0, xlim = c(.5, 1), ylim = c(0, 30), type = "n", axes = F)#call empty plot to keep on same scale
text(.8, 15, "Republican\nwinners", cex = 1.8)
#add x-axis labels in each panel of bottom row
par(mar = c(2,2,2,2))
for (i in 1:6){
plot(i,i, type = "n", axes = F)#call empty plot
mtext("Winner's share\nof 2-party vote", 3, line =-2.5, cex = 1.2)
}
dev.off()
##############################################################
#for statistics cited within text of paper:
#get number of incumbents (Rep. v. Dem) who won with less than 58\% of vote
attach(house.2006)
#table(winner, incumb06)
# incumb06
#winner -1 0 1
# 0 189 13 0
# 1 22 20 191
gop.win.58 <- ifelse(winner==0 & dvoteimputed > .42 & incumb06 == -1, 1, 0)
#47 out of 189 GOP incumbents who won with less than 58% of vote == 24%
dem.win.58 <- ifelse(winner==1 & dvoteimputed < .58 & incumb06 == 1, 1, 0)
#7 out of 191 Dem incumbents won with less than 58% == 4%
#get numbers of winners Rep. v. Dem) who won with less than 60% of vote
gop.win.60 <- ifelse(winner==0 & dvoteimputed > .4, 1, 0)
#78 GOP candidates won w/ less than 60% of vote
dem.win.60 <- ifelse(winner==1 & dvoteimputed < .6, 1, 0)
#40 Dem candidates won w/ less than 60% of vote
#total == 118 winners with less than 60%
#Thus, gop won 78/118 close races, or 66%
##################################################################
#PREDICTING THE 2008 SEATS VOTES CURVE
#reverse so that curve gives prob of Reps taking the House
#for incumbents: within each draw each has 90% chance of running
#paramater estimates for 2008 (same as 2006)
phi <- .08
rho <- .71
sigma <- .066
inc.impute <- .75 #for uncontested races
attach.all(house.2006)
i2006 <- incumb06
i2008 <- ifelse(winner ==1, 1,-1)
n.sims <- 1000
vbar.2006 <- adv.2006#mean vote for 2006
v2006 <- dvote.2006
vbar.2008.range <- round(vbar.2006,2) + seq(-.2,.2,.002) #create range from 45 to 55
sbar.2008.50 <- rep (NA, length(vbar.2008.range))
prob.2008 <- rep (NA, length(vbar.2008.range)) #set up vector for prob.2008. of winning house
for (j in 1:length(vbar.2008.range)){#loop over intervals of vbar.2008
vbar.2008 <- vbar.2008.range[j]
sbar.2008 <- rep (NA, n.sims)
for (i in 1:n.sims){
i.random <- runif(435)
i2008.draw <- ifelse(i.random < .90001, i2008, 0)
v.adj2006 <- v2006 - phi*i2006 #adjusted vote, taking out incumbency
normvote2008 <- .5 + rho*(v.adj2006 - .5) #normal vote
locfree2008 <- normvote2008 + phi*i2008.draw #location free: normal vote plus adjusted vote
locfreenoisy2008 <- rnorm(length(locfree2008), locfree2008, sigma) #add noise to loc.free var
swingfree2008 <- locfreenoisy2008 + mean(v2006) - mean(locfreenoisy2008) #take out swing
v2008 <- swingfree2008 + vbar.2008 - mean(swingfree2008)
sbar.2008[i] <- mean(v2008>.5)
}
sbar.2008.50[j] <- mean(sbar.2008)#mean
prob.2008[j] <- pnorm((sbar.2008.50[j] - 0.5)/rmse.predict)
}
#get v.bars when prob.2008. == 10, 50, 90%
ten.percent.value.2008 <- mean(vbar.2008.range[round(prob.2008,1) ==.10])
fifty.percent.value.2008 <- mean(vbar.2008.range[round(prob.2008,1) ==.50])
ninety.percent.value.2008 <- mean(vbar.2008.range[round(prob.2008,1) ==.90])
ten.percent.value.2008
fifty.percent.value.2008
ninety.percent.value.2008
#Predicted SV Curve
axis.size <- 1.1 #control size of axis tick marks and numbers
axis.label <- 1.1 #control size of axis labels
pdf("Seats_Votes_2008_prob_combined.pdf", height =4, width = 8)
par (mfrow=c(1,2), mar = c(7,6,2,3), pty = "s")
plot(vbar.2008.range, sbar.2008.50, type = "l",
ylab = "", xlab = "", axes = F, xaxs="i", yaxs="i",
ylim = c(.4, .6), xlim = c(.40,.6),,
main = "")
#lines(lowess(1-vbar.2008.range, sbar.2008.50))
axis(1, at = c(.40,.45, .50,.55,.60), label = c("40%", "", "50%", "", "60%"), mgp = c(2,.5,0), cex.axis = axis.size)
axis(2, at = c(.40,.45, .50,.55,.60), label = c("40%", "", "50%", "", "60%"), las = 2, mgp = c(2,.5,0), cex.axis = axis.size)
mtext("Average district vote\nfor Democrats", 1, cex = axis.label, line = 3.1)
mtext("Democratic share\nof House seats", 2, cex = axis.label, line=3.1)
abline(h=.5, col="gray", lwd=.5)
abline(v=.5, col="gray", lwd=.5)
box()
par (mar = c(7,6,2,3))
plot (vbar.2008.range, prob.2008, type="l",
main = "",
xlab ="", ylab ="", axes = F, xaxs="i",
yaxs="i", xlim = c(.4,.6), ylim = c(0,1))
axis(1, at = c(.40,.45, .50,.55,.60), label = c("40%", "", "50%", "", "60%"), mgp = c(2,.5,0), , cex.axis = axis.size)
axis(2, at = c(seq(0,1,by =.25)), label = c(0,".25",".5",".75",1), las = 2, mgp = c(2,.5,0), cex.axis = axis.size)
mtext("Average district vote\nfor Democrats", 1, cex = axis.label, line = 3.1)
mtext("Probability Democrats\nControl House", 2, cex = axis.label, line =2.7)
abline (h=.5,col="gray", lwd=.5)#50% line
abline (h=.1, col="gray", lwd=.5)#10 % line
abline (h=.9, col="gray", lwd=.5)#90% line
box()
dev.off()
#total vs. average, 1946-2006
year.at.vec <- c((seq(1946, 2006, by = 2)))
year.label.vec <- c("", "", "1950", "", "", "","", "1960", "","","", "", "1970",
"","","", "", "1980", "","","", "", "1990", "","","", "", "2000","", "", "2006")
pdf("Total_vs_Average.pdf", height =5, width = 13)
par(mfrow = c(1,1), mar = c(6,6, 2,1))
plot(unique.year.all, adv, type = "n",
ylim = c(.45, .6), main = "", xlab = "",ylab = "", axes = F, xaxs = "i", yaxs="i")
shade.color = "gray92"
polygon(x=c(1946, 1946, 1948, 1948),
y=par()$usr[c(3,4,4,3)],
col= shade.color, ## desired color
border=F) ## no border
polygon(x=c(1952, 1952, 1954, 1954),
y=par()$usr[c(3,4,4,3)],
col= shade.color, ## desired color
border=F) ## no border
polygon(x=c(1994, 1994, 2006, 2006),
y=par()$usr[c(3,4,4,3)],
col= shade.color, ## desired color
border=F) ## no border
points(unique.year.all, adv, type = "l")
points(unique.year.all, dem.per.total, type = "l", lty =2)
axis(1, at = year.at.vec, labels = year.label.vec, las = 1, cex.axis = 1.1, mgp = c(2,.5,0))
axis(2, las = 1, at = c(seq(.45, .60, by = .05)),
label = c("40%", "50%", "55%", "60%"), cex.axis = 1.2,mgp = c(2,.6,0))
mtext("Democratic share of\nthe two-party vote", 2, line = 3, cex = 1.4)
text(1968.2, .592, "Average District Vote")
segments(1965, .585, 1964.5, .58)
text(1971, .51, "Total Vote")
segments(1969, .51, 1968.25,.51)
segments(1946, .5, 2006, .5, col="gray", lwd=.5)#add light line for 50%
dev.off()